Subleq: Difference between revisions
(Improved formatting. Added output.) |
|||
| Line 2,111: | Line 2,111: | ||
=={{header|Nim}}== |
=={{header|Nim}}== |
||
<lang nim>import streams |
<lang nim>import streams |
||
type |
type |
||
Interpreter = object |
Interpreter = object |
||
mem: seq[int] |
mem: seq[int] |
||
ip: int |
ip: int |
||
input,output: Stream |
input, output: Stream |
||
proc load(prog: |
proc load(prog: openArray[int]; inp, outp: Stream): Interpreter = |
||
Interpreter(mem: prog, input: inp, output: outp) |
|||
proc run(i: var Interpreter) = |
proc run(i: var Interpreter) = |
||
| Line 2,134: | Line 2,136: | ||
i.ip = C |
i.ip = C |
||
let test = @[15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1 |
let test = @[15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1, |
||
101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33, 10, 0] |
72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33, 10, 0] |
||
var intr = load(test, newFileStream(stdin), newFileStream(stdout)) |
var intr = load(test, newFileStream(stdin), newFileStream(stdout)) |
||
try: |
try: |
||
intr.run() |
intr.run() |
||
except IndexDefect: |
except IndexDefect: |
||
echo "ip: ", intr.ip |
echo "ip: ", intr.ip |
||
echo "mem: ", intr.mem |
echo "mem: ", intr.mem</lang> |
||
</lang> |
|||
{{out}} |
|||
<pre>Hello, world!</pre> |
|||
=={{header|Objeck}}== |
=={{header|Objeck}}== |
||
Revision as of 22:02, 17 April 2021
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 (it will then 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 stored in the address given by B. C is unused.
- 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 result stored back in address B). If the result is zero or negative, the number in C becomes the new instruction pointer.
- If the instruction pointer becomes negative, execution halts.
Your solution should accept as input a program to execute on the machine, separately from the input fed to the emulated machine once it is running.
This program 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, the 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 into another character set if your implementation runs in a non-ASCII-compatible environment.
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
11 ff ff output (message)
10 01 ff subleq (neg1), (start+1), -1
10 03 ff subleq (neg1), (start+3), -1
0f 0f 00 subleq (zero), (zero), 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
<lang 11l>F subleq(&a)
V i = 0
L i >= 0
I a[i] == -1
a[a[i + 1]] = :stdin.read(1).code
E I a[i + 1] == -1
print(Char(code' a[a[i]]), end' ‘’)
E
a[a[i + 1]] -= a[a[i]]
I a[a[i + 1]] <= 0
i = a[i + 2]
L.continue
i += 3
subleq(&[15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1, 72,
101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33, 10, 0])</lang>
- Output:
Hello, world!
8080 Assembly
<lang 8080asm> ;;; --------------------------------------------------------------- ;;; SUBLEQ for CP/M. The word size is 16 bits, and the program ;;; is given 16 Kwords (32 KB) of memory. (If the system doesn't ;;; have enough, the program will not run.) ;;; I/O is via the console; since it cannot normally be redirected, ;;; CR/LF translation is on by default. It can be turned off with ;;; the 'R' switch. ;;; --------------------------------------------------------------- ;;; CP/M system calls getch: equ 1h putch: equ 2h puts: equ 9h fopen: equ 0Fh fread: equ 14h ;;; RAM locations fcb1: equ 5ch ; FCB 1 (automatically preloaded with 1st file name) fcb2: equ 6ch ; FCB 2 (we're abusing this one for the switch) dma: equ 80h ; default DMA is located at 80h bdos: equ 5h ; CP/M entry point memtop: equ 6h ; First reserved memory address (below this is ours) ;;; Constants CR: equ 13 ; CR and LF LF: equ 10 EOF: equ 26 ; EOF marker (as we don't have exact filesizes) MSTART: equ 2048 ; Reserve 2K of memory for this program + the stack MSIZE: equ 32768 ; Reserve 32K of memory (16Kwords) for the SUBLEQ code PB: equ 0C6h ; PUSH B opcode. org 100h ;;; -- Memory initialization -------------------------------------- ;;; The fastest way to zero out a whole bunch of memory on the 8080 ;;; is to push zeroes onto the stack. Since we need to do 32K, ;;; and it's slow already to begin with, let's do it that way. lxi d,MSTART+MSIZE ; Top address we need lhld memtop ; See if we even have enough memory call cmp16 ; Compare the two xchg ; Put top address in HL lxi d,emem ; Memory error message jnc die ; If there isn't enough memory, stop. sphl ; Set the stack pointer to the top of memory lxi b,0 ; 2 zero bytes to push xra a ; Zero out A. ;;; Each PUSH pushes 2 zeroes. 256 * 64 * 2 = 32768 zeroes. ;;; In the interests of "speedy" (ha!) execution, let's unroll this ;;; loop a bit. In the interest of the reader, let's not write out ;;; 64 lines of "PUSH B". 'PB' is set to the opcode for PUSH B, and ;;; 4*16=64. This costs some memory, but since we're basically ;;; assuming a baller >48K system anyway to run any non-trivial ;;; SUBLEQ code (ha!), we can spare the 64 bytes. memini: db PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB db PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB db PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB db PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB, PB,PB,PB,PB inr a ; This will loop around 256 times jnz memini push b ;;; This conveniently leaves SP pointing just below SUBLEQ memory. ;;; -- Check the raw switch --------------------------------------- ;;; CP/M conveniently parses the command line for us, under the ;;; assumption that there are two whitespace-separated filenames, ;;; which are also automatically made uppercase. ;;; We only have to see if the second filename starts with 'R'. lda fcb2+1 ; Filename starts at offset 1 in the FCB cpi 'R' ; Is it 'R'? jnz readfl ; If not, go read the file (in FCB1). lxi h,chiraw ; If so, rewrite the jumps to use the raw fns shld chin+1 lxi h,choraw shld chout+1 ;;; -- Parse the input file --------------------------------------- ;;; The input file should consist of signed integers written in ;;; decimal, separated by whitespace. (For simplicity, we'll call ;;; all control characters whitespace). CP/M can only read files ;;; 128 bytes at a time, so we'll process it 128 bytes at a time ;;; as well. readfl: lda fcb1+1 ; See if a file was given cpi ' ' ; If not, the filename will be empty (spaces) lxi d,eusage ; Print the usage string if that is the case jz die mvi c,fopen ; Otherwise, try to open the file. lxi d,fcb1 call bdos inr a ; FF is returned on error lxi d,efile ; Print 'file error' and stop. jz die ;;; Start parsing 16-bit numbers lxi h,MSTART ; Start of SUBLEQ memory push h ; Keep that on the stack skipws: call fgetc ; Get character from file jc rddone ; If EOF, we're done cpi ' '+1 ; Is it whitespace? jc skipws ; Then get next character rdnum: lxi h,0 ; H = accumulator to store the number mov b,h ; Set B if number should be negative. cpi '-' ; Did we read a minus sign? jnz rddgt ; If not, then this should be a digit. inr b ; But if so, set B, call fgetc ; and get the next character. jc rddone rddgt: sui '0' ; Make ASCII digit cpi 10 ; Which should now be less than 10 jnc fmterr ; Otherwise, print an error and stop mov d,h ; Set HL=HL*10 mov e,l ; DE = HL dad h ; HL *= 2 dad h ; HL *= 4 dad d ; HL *= 5 dad h ; HL *= 10 mvi d,0 ; Add in the digit mov e,a dad d call fgetc ; Get next character jc rdeof ; EOF while reading number cpi ' '+1 ; Is it whitespace? jnc rddgt ; If not, then it should be the next digit xchg ; If so, write the number to SUBLEQ memory pop h ; Number in DE and pointer in HL call wrnum ; Write the number push h ; Put the pointer back jmp skipws ; Then skip to next number and parse it rdeof: xchg ; EOF, but we still have a number to write pop h ; Number in DE and pointer in HL call wrnum ; Write the number push h rddone: pop h ; We're done, discard pointer ;;; -- Run the SUBLEQ code ---------------------------------------- lxi h,MSTART ; Initialize IP ;;; At the start of step, HL = IP (in system memory) step: mov e,m ; Load A into DE inx h mov d,m inx h mov c,m ; Load B into BC inx h mov b,m inx h mov a,e ; Check if A=-1 ana d inr a jz sbin ; If so, read input mov a,b ; Otherwise, check if B=-1 ana c inr a jz sbout ; If so, write output ;;; Perform the SUBLEQ instruction push h ; Store the IP (-2) on the stack mov a,d ; Obtain [A] (set DE=[DE]) ani 3Fh ; Make sure address is in 16K words mov d,a lxi h,MSTART ; Add to start address twice dad d ; (SUBLEQ addresses words, we're addressing dad d ; bytes) mov e,m ; Load low byte inx h mov d,m ; Load high byte mov a,b ; Obtain [B] (set BC=[BC]) ani 3Fh ; This adress should also be in the 16K words mov b,a lxi h,MSTART ; Add to start address twice, again dad b dad b mov c,m ; Load low byte inx h mov b,m ; Load high byte mov a,c ; BC (B) -= DE (A) sub e ; Subtract low bytes mov c,a mov a,b ; Subtract high bytes sbb d mov b,a mov m,b ; HL is still pointing to the high byte of [B] dcx h mov m,c ; Store the low byte back too pop h ; Restore IP ral ; Check sign bit of [B] (which is still in A) jc sujmp ; If set, it's negative, and we need to jump rar ora c ; If we're still here, it wasn't set. OR with jz sujmp ; low bit, if zero then we also need to jump inx h ; We don't need to jump, so we should ignore C; inx h ; increment the IP to advance past it. jmp step ; Next step sujmp: mov c,m ; We do need to jump, load BC=C inx h mov a,m ; High byte into A ral ; See if it is negative jc quit ; If so, stop rar ani 3Fh ; Don't jump outside the address space mov b,a ; High byte into B lxi h,MSTART ; Calculate new IP dad b dad b jmp step ; Do next step ;;; Input: A=-1 sbin: inx h ; Advance IP past C inx h xchg ; IP in DE mov a,b ; Calculate address for BC (B) ani 3Fh mov b,a lxi h,MSTART dad b dad b call chin ; Read character mov m,a ; Store in low byte inx h mvi m,0 ; Store zero in high byte xchg ; IP back in HL jmp step ; Next step ;;; Output: B=-1 sbout: inx h ; Advance IP past C inx h xchg ; IP in DE and A in HL mov a,h ; Calculate address for A ani 3Fh mov h,a dad h lxi b,MSTART dad b mov a,m ; Retrieve low byte (character) call chout ; Write character xchg ; IP back in HL jmp step ; Next step quit: rst 0 ;;; -- Write number to SUBLEQ memory ------------------------------ ;;; Assuming: DE holds the number, B=1 if number should be negated, ;;; HL holds the pointer to SUBLEQ memory. wrnum: dcr b ; Should the number be negated? jnz wrpos ; If not, just write it dcx d ; Otherwise, negate it: decrement, mov a,e ; Then complement low byte, cma mov e,a mov a,d ; Then complement high byte cma mov d,a ; And then write it wrpos: mov m,e ; Write low byte inx h ; Advance pointer mov m,d ; Write high byte inx h ; Advance pointer ret ;;; -- Read file byte by byte ------------------------------------- ;;; The next byte from the file in FCB1 is returned in A, and all ;;; other registers are preserved. When 128 bytes have been read, ;;; the next record is loaded automatically. Carry set on EOF. fgetc: push h ; Keep HL registers lda fgptr ; Where are we in the record? ana a jz nxtrec ; If at 0 (rollover), load new record. frecc: mvi h,0 ; HL = A mov l,a inr a ; Next A sta fgptr ; Write A back mov a,m ; Retrieve byte pop h ; Restore HL registers cpi EOF ; Is it EOF? rnz ; If not, we're done (ANA clears carry) stc ; But otherwise, set carry ret nxtrec: push d ; Keep the other registers too push b mvi c,fread ; Read record from file lxi d,fcb1 call bdos dcr a ; A=1 on EOF jz fgeof inr a ; A<>0 = error lxi d,efile jnz die mvi a,80h ; If we're still here, record read correctly sta fgptr ; Set pointer back to beginning of DMA. pop b ; Restore B and D pop d jmp frecc ; Get first character from the record. fgeof: stc ; On EOF (no more records), set carry jmp resbdh ; And restore the registers fgptr: db 0 ; Pointer (80h-FFh) into DMA area. Reload on 0. ;;; -- Compare DE to HL ------------------------------------------- cmp16: mov a,d ; Compare high bytes cmp h rnz ; If they are not equal, we know the ordering mov a,e ; If they are equal, compare lower bytes cmp l ret ;;; -- Register-preserving I/O routines --------------------------- chin: jmp chitr ; These are rewritten to jump to the raw I/O chout: jmp chotr ; instructions to turn translation off. ;;; -- Read character into A with translation --------------------- chitr: call chiraw ; Get raw character cpi CR ; Is it CR? rnz ; If not, return character unchanged mvi a,LF ; Otherwise, return LF (terminal sends only CR) ret ;;; -- Read character into A. ------------------------------------- chiraw: push h ; Save all registers except A push d push b mvi c,getch ; Get character from terminal call bdos ; Character ends up in A jmp resbdh ; Restore registers afterwards ;;; -- Write character in A to terminal with translation ---------- chotr: cpi LF ; Is it LF? jnz choraw ; If not, just print it mvi a,CR ; Otherwise, print a CR first, call choraw mvi a,LF ; And then a LF. (fall through) ;;; -- Write character in A to terminal --------------------------- choraw: push h ; Store all registers push d push b push psw mvi c,putch ; Write character to terminal mov e,a call bdos ;;; -- Restore registers ------------------------------------------ restor: pop psw ; Restore all registers resbdh: pop b ; Restore B D H pop d pop h ret ;;; -- Make parse error message and stop -------------------------- ;;; A should hold the offending character _after_ '0' has already ;;; been subtracted. fmterr: adi '0' ; Undo subtraction of ASCII 0 lxi h,eiloc ; Write the characters in the error message mov m,a inx h mvi b,4 ; Max. 4 more characters fmtelp: call fgetc ; Get next character jc fmtdne ; If EOF, stop mov m,a ; If not, store the character inx h ; Advance pointer dcr b ; Should we do more characters? jnz fmtelp ; If so, go get another fmtdne: lxi d,einv ; Print 'invalid integer' error message. ;;; -- Print an error message and stop ---------------------------- die: mvi c,puts call bdos rst 0 ;;; -- Error messages --------------------------------------------- eusage: db 'SUBLEQ <file> [R]: Run the SUBLEQ program in <file>.$' efile: db 'File error$' emem: db 'Memory error$' einv: db 'Invalid integer: ' eiloc: db ' $' </lang>
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.
<lang asm> ;;; ------------------------------------------------------------- ;;; SUBLEQ interpreter that runs under MS-DOS. ;;; The word size is 16 bits, and the SUBLEQ program gets a 64KB ;;; (that is, 32K Subleq words) address space. ;;; The SUBLEQ program is read from a text file given on the ;;; command line, I/O is done via the console. ;;; Console I/O is normally raw, but with the /T parameter, ;;; line ending translation is done (CRLF <> LF). ;;; ------------------------------------------------------------- bits 16 cpu 8086 ;;; MS-DOS system calls getch: equ 1h ; Get character putch: equ 2h ; Print character puts: equ 9h ; Print string fopen: equ 3Dh ; Open file fclose: equ 3Eh ; Close file fread: equ 3Fh ; Read from file alloc: equ 48h ; Allocate memory block resize: equ 4Ah ; Change size of memory block exit: equ 4Ch ; Exit to DOS ;;; Constants RBUFSZ: equ 1024 ; 1K read buffer CR: equ 13 ; CR and LF LF: equ 10 ;;; RAM locations cmdlen: equ 80h ; Length of command line cmdlin: equ 81h ; Contents of command line org 100h section .text clc ; Make sure string instructions go forward ;;; -- Memory initialization ------------------------------------ ;;; This is a .COM file. This means MS-DOS gives us all available ;;; memory starting at CS:0, and CS=DS=ES=SS. This means in order ;;; to allocate a separate 64k segment for the SUBLEQ memory ;;; space, we will first need to free all memory we're not using. ;;; ------------------------------------------------------------- memini: mov sp,memtop ; Point SP into memory we will be keeping mov dx,emem ; Set up a pointer to the memory error msg mov ah,resize ; Reallocate current block mov bx,sp ; Size is in paragraphs (16 bytes), and the mov cl,4 ; assembler will not let me shift a label at shr bx,cl ; compile time, so we'll do it at runtime. inc bx ; BX=(memtop>>4)+1; memtop in last paragraph. int 21h jnc .alloc ; Carry not set = allocate memory jmp die ; Otherwise, error (jump > 128 bytes) ;;; Allocate a 64K block for the SUBLEQ program's address space .alloc: mov ah,alloc ; Allocate 64K (4096 paragraphs) for the mov bx,4096 ; SUBLEQ program. Because that is the size of int 21h ; an 8086 segment, we get free wraparound, jnc .zero ; and we don't have to worry about bounds jmp die ; checking. ;;; Zero out the memory we're given .zero: push ax ; Keep SUBLEQ segment on stack. mov es,ax ; Let ES point into our SUBLEQ segment. mov cx,32768 ; 32K words = 64K bytes to set to zero. xor ax,ax ; We don't have to care about where DI is, rep stosw ; since we're doing all of ES anyway. ;;; -- Parse the command line and open the file ----------------- ;;; A filename should be given on the command line, which should ;;; be a text file containing (possibly negative) integers ;;; written in base 10. For "efficiency", we read the file 1K ;;; at a time into a buffer, rather than character by character. ;;; We also handle the '/T' parameter here. ;;; ------------------------------------------------------------- rfile: mov dx,usage ; Print 'usage' message if no argument mov di,cmdlin ; 0-terminate command line for use with fopen xor bh,bh ; We'll use BX to index into the command line mov bl,[cmdlen] ; Length of command line test bl,bl ; If it's zero, no argument was given jnz .term ; If not zero, go ahead jmp die ; Otherwise, error (again, jump > 128 bytes) .term: mov [di+bx],bh ; Otherwise, 0-terminate mov ax,ds ; Let ES point into our data segment mov es,ax ; (in order to use SCASB). .skp: mov al,' ' ; Skip any preceding spaces mov cx,128 ; Max. command line length repe scasb dec di ; As usual, SCASB goes one byte too far mov al,[di] ; If we're at zero now, we don't have an test al,al ; argument either, so same error. jnz .parm ; (Again, jump > 128 bytes) jmp die .parm cmp al,'/' ; Input parameter? jne .open ; If not, this is the filename, open it inc di ; If so, is it 'T' or 't'? mov al,[di] inc di ; Skip past it mov dl,[di] ; And is the next one a space again? cmp dl,' ' je .testp ; If so, it's potentially valid .perr: mov dx,eparm ; If not, print error message jmp die .testp: or al,32 ; Make lowercase cmp al,'t' ; 'T'? jne .perr ; If not, print error message inc byte [trans] ; If so, turn translation on jmp .skp ; And then get the filename .open: mov ax,fopen<<8 ; Open file for reading (AL=0=O_RDONLY) mov dx,di ; 0-terminated path on the command line int 21h jnc .read ; Carry not set = file opened mov dx,efile ; Otherwise, file error (we don't much care jmp die ; which one, that's too much work.) .read: pop es ; Let ES be the SUBLEQ segment (which we xor di,di ; pushed earlier), and DI point to 1st word. mov bp,ax ; Keep the file handle in BP. xor cx,cx ; We have read no bytes yet. ;;; -- Read and parse the file ---------------------------------- ;;; We need to read 16-bit signed integers from the file, ;;; in decimal. The integers are separated by whitespace, which ;;; for simplicity's sake we'll say is ASCII space and _all_ ;;; control characters. BP, CX and SI are used as state to ;;; emulate character-based I/O, and so must be preserved; ;;; furthermore, DI is used as a pointer into the SUBLEQ memory. ;;; ------------------------------------------------------------- skipws: call fgetc ; Get next character jc fdone ; If we get EOF, we're done. cmp al,' ' ; Is it whitespace? (0 upto ' ' inclusive) jbe skipws ; Then keep skipping rdnum: xor dl,dl ; DL is set if number is negative xor bx,bx ; BX will keep the number cmp al,'-' ; Is first character a '-'? jne .dgt ; If not, it's positive inc dx ; Otherwise, set DL, call fgetc ; and get next character. jc fdone .dgt: mov dh,al ; Store character in DH sub dh,'0' ; Subtract '0' cmp dh,9 ; Digit is [0..9]? jbe .dgtok ; Then it is OK jmp fmterr ; Otherwise, format error (jump > 128) .dgtok: mov ax,bx ; BX *= 10 (without using MUL or SHL BX,CL; shl bx,1 ; since we can't spare the registers). shl bx,1 add bx,ax shl bx,1 mov al,dh ; Load digit into AL cbw ; Sign extend (in practice just sets AH=0) add bx,ax ; Add it into BX call fgetc ; Get next character jc dgteof ; EOF while reading num is special cmp al,' ' ; If it isn't whitespace, ja .dgt ; then it's the next digit. test dl,dl ; Otherwise, number is done. Was it negative? jz .wrnum ; If not, write it to SUBLEQ memory neg bx ; Otherwise, negate it .wrnum: mov ax,bx ; ...and _then_ write it. stosw jmp skipws ; Skip any other wspace and get next number dgteof: test dl,dl ; If we reached EOF while reading a number, jz .wrnum ; we need to do the same conditional negation neg bx ; and write out the number that was still in .wrnum: mov ax,bx ; BX. stosw fdone: mov ah,fclose ; When we're done, close the file. mov bx,bp ; (Not strictly necessary since we've only int 21h ; read, so we don't care about errors.) ;;; -- Run the SUBLEQ code -------------------------------------- ;;; SI = instruction pointer. An instruction A B C is loaded into ;;; BX DI AX respectively. Note that SUBLEQ addresses words, ;;; whereas the 8086 addresses bytes, so the addresses all need ;;; to be shifted left once before being used. ;;; ------------------------------------------------------------- subleq: xor si,si ; Start with IP=0 mov cl,[trans] ; CL = \r\n translation on or off mov ax,es ; Set DS=ES=SUBLEQ segment mov ds,ax ;;; Load instruction .step: lodsw ; Load A mov bx,ax ; BP = A lodsw ; Load B mov di,ax ; DI = B lodsw ; Load C (AX=C) ;;; Check for special cases inc bx ; BX=-1 = read byte jz .in ; If ++BP==0, then read character dec bx ; Restore BX inc di ; If ++DI==0, then write character jz .out dec di ; Restore DI ;;; Do the SUBLEQ instruction shl di,1 ; Addresses must be doubled since SUBLEQ shl bx,1 ; addresses words and we're addressing bytes mov dx,[di] ; Retrieve [B] sub dx,[bx] ; DX = [B] - [A] mov [di],dx ; [B] = DX jg .step ; If [B]>[A], (i.e. [B]-[A]>=0), do next step shl ax,1 ; Otherwise, AX*2 (C) becomes the new IP mov si,ax jnc .step ; If high bit was 0, next step mov ax,exit<<8 ; But otherwise, it was negative, so we stop int 21h ;;; Read a character from standard input .in: mov ah,getch ; Input: read character into AL int 21h cmp al,CR ; Is it CR? je .crin ; If not, just store the character .sto: xor ah,ah ; Character goes in low byte of word shl di,1 ; Word address to byte address mov [di],ax ; Store character in memory at B jmp .step ; And do next step ;;; Pressing enter only returns CR; not CR LF on two reads, ;;; therefore on CR we give LF instead when translation is on. .crin: test cl,cl ; Do we even want translation? jz .sto ; If not, just store the CR and leave it mov al,LF ; But if so, use LF instead jmp .sto ;;; Write a character to standard output .out: shl bx,1 ; Load character from [A] mov dl,[bx] ; We only need the low byte mov ah,putch ; Set AH to print the character cmp dl,LF ; Is it LF? je .lfo ; Then handle it separately .wr: int 21h jmp .step ; Do next step ;;; LF needs to be translated into CR LF, so we need to print the ;;; CR first and then the LF, if translation is on. .lfo: test cl,cl ; Do we even want translation? jz .wr ; If not, just print the LF mov dl,CR ; If so, print a CL first int 21h mov dl,LF ; And then a LF jmp .wr ;;; -- Subroutine: get byte from file buffer. -------------------- ;;; If the buffer is empty, fill with more bytes from file. ;;; On EOF, return with carry set. ;;; Input: BP = file handle, CX = bytes left in buffer, ;;; SI = current pointer into buffer. ;;; Output: AL = byte, CX and SI moved, other registers preserved ;;; ------------------------------------------------------------- fgetc: test cx,cx ; Bytes left? jz .read ; If not, read from file .buf: lodsb ; Otherwise, get byte from buffer dec cx ; One fewer byte left ret ; And we're done. (TEST clears carry, LODSB ; and DEC don't touch it, so it's clear.) .read: push ax ; Keep AX, BX, DX push bx push dx mov ah,fread ; Read from file, mov bx,bp ; BP = file handle, mov cx,RBUFSZ ; Fill up entire buffer if possible, mov dx,fbuf ; Starting at the start of buffer, mov si,dx ; Also start returning bytes from there. int 21h jc .err ; Carry set = read error mov cx,ax ; CX = amount of bytes read pop dx ; Restore AX, BX, DX pop bx pop ax test cx,cx ; If CX not zero, we now have data in buffer jnz .buf ; So get first byte from buffer stc ; But if not, EOF, so set carry and return ret .err: mov dx,efile ; On error, print the file error message jmp die ; and stop ;;; Parse error (invalid digit) --------------------------------- ;;; Invalid character is in AL. BP, CX, SI still set to read from ;;; file. fmterr: mov dx,ds ; Set ES=DS mov es,dx mov dl,5 ; Max. 5 characters mov di,eparse.dat ; DI = empty space in error message .wrch: stosb ; Store character in error message call fgetc ; Get next character jc .done ; No more chars = stop dec dl ; If room left, jnz .wrch ; write next character .done: mov dx,eparse ; Use error message with offender written in ; And fall through to stop the program ;;; Print the error message in [DS:DX] and terminate with ;;; errorlevel 2. die: mov ah,puts int 21h mov ax,exit<<8 | 2 int 21h section .data usage: db 'SUBLEQ [/T] <file> - Run the SUBLEQ program in <file>.$' efile: db 'Error reading file.$' eparm: db 'Invalid parameter.$' emem: db 'Memory allocation failure.$' eparse: db 'Invalid integer at: ' .dat: db ' $' ; Spaces to be filled in by error routine trans: db 0 ; Will be set if CRLF translation is on section .bss fbuf: resb RBUFSZ ; File buffer stack: resw 128 ; 128 words for main stack (should be enough) memtop: equ $</lang>
Ada
<lang 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;</lang>
>./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
<lang algol68># 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
)
)
</lang>
- Output:
Hello, world!
ALGOL W
<lang algolw>% 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.</lang>
- Output:
Hello, world!
APL
<lang APL>#!/usr/local/bin/apl -s -- ⎕IO←0 ⍝ Index origin 0 is more intuitive with 'pointers' ∇Subleq;fn;text;M;A;B;C;X
→(5≠⍴⎕ARG)/usage ⍝ There should be one (additional) argument
fn←⊃⎕ARG[4] ⍝ This argument should be the file name
→(≢0⍴text←⎕FIO[26]fn)/filerr ⍝ Load the file
text[(text∊⎕TC)/⍳⍴text]←' ' ⍝ Control characters to spaces
text[(text='-')/⍳⍴text]←'¯' ⍝ Negative numbers get high minus
M←⍎text ⍝ The memory starts with the numbers in the text
pc←0 ⍝ Program counter starts at PC
instr: (A B C)←3↑pc↓M ⍝ Read instruction
M←'(1+A⌈B⌈C⌈⍴M)↑M'⎕EA'M⊣M[A,B,C]' ⍝ Extend the array if necessary
pc←pc+3 ⍝ PC is incremented by 3
→(A=¯1)/in ⍝ If A=-1, read input
→(B=¯1)/out ⍝ If B=-1, write output
→(0<M[B]←M[B]-M[A])/instr ⍝ Do SUBLEQ instruction
pc←C ⍝ Set PC if necessary
→(C≥0)×instr ⍝ Next instruction if C≥0
in: X←(M[B]←1⎕FIO[41]1)⎕FIO[42]1 ⋄ →instr out: X←M[A]⎕FIO[42]1 ⋄ →instr
usage: 'subleq.apl <file> - Run the SUBLEQ program in <file>' ⋄ →0 filerr: 'Error loading: ',fn ⋄ →0 ∇
Subleq )OFF </lang>
ARM Assembly
<lang> @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@ 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 = .</lang>
- 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!
AWK
<lang AWK>
- syntax: GAWK -f SUBLEQ.AWK SUBLEQ.TXT
- converted from Java
BEGIN {
instruction_pointer = 0
} { printf("%s\n",$0)
for (i=1; i<=NF; i++) {
if ($i == "*") {
ncomments++
break
}
mem[instruction_pointer++] = $i
}
} END {
if (instruction_pointer == 0) {
print("error: nothing to run")
exit(1)
}
printf("input: %d records, %d instructions, %d comments\n\n",NR,instruction_pointer,ncomments)
instruction_pointer = 0
do {
a = mem[instruction_pointer]
b = mem[instruction_pointer+1]
if (a == -1) {
getline <"con"
mem[b] = $1
}
else if (b == -1) {
printf("%c",mem[a])
}
else {
mem[b] -= mem[a]
if (mem[b] < 1) {
instruction_pointer = mem[instruction_pointer+2]
continue
}
}
instruction_pointer += 3
} while (instruction_pointer >= 0)
exit(0)
} </lang>
- 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!
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. <lang bbcbasic>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</lang>
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!
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).
<lang befunge>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</lang>
- 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!
C
Takes the subleq instruction file as input, prints out usage on incorrect invocation. <lang C>
- include<stdlib.h>
- include<stdio.h>
void subleq(int* code){ int ip = 0, a, b, c, nextIP,i; 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>"); else processFile(argV[1]); return 0; } </lang> 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#
<lang csharp>using System;
namespace Subleq {
class Program {
static void Main(string[] args) {
int[] mem = {
15, 17, -1, 17, -1, -1, 16, 1, -1, 16,
3, -1, 15, 15, 0, 0, -1, 72, 101, 108,
108, 111, 44, 32, 119, 111, 114, 108, 100, 33,
10, 0,
};
int instructionPointer = 0;
do {
int a = mem[instructionPointer];
int b = mem[instructionPointer + 1];
if (a == -1) {
mem[b] = Console.Read();
}
else if (b == -1) {
Console.Write((char)mem[a]);
}
else {
mem[b] -= mem[a];
if (mem[b] < 1) {
instructionPointer = mem[instructionPointer + 2];
continue;
}
}
instructionPointer += 3;
} while (instructionPointer >= 0);
}
}
}</lang>
- Output:
Hello, world!
C++
<lang cpp>
- 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;
} </lang>
- Output:
subleq test.txt 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. <lang cobol>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.</lang>
- Output:
READING SUBLEQ PROGRAM... 0032 WORDS READ. BEGINNING RUN... Hello, world! HALTED AFTER 0073 INSTRUCTIONS.
Common Lisp
<lang 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)))</lang>
- Output:
Hello, world!
D
<lang 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);
}</lang>
- Output:
Hello, world!
Delphi
<lang Delphi> program SubleqTest;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
var
mem: array of Integer; instructionPointer: Integer; a, b: Integer;
begin
mem := [15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1, 72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33, 10, 0]; instructionPointer := 0;
repeat a := mem[instructionPointer]; b := mem[instructionPointer + 1];
if a = -1 then
begin
read(mem[b]);
end
else if b = -1 then
begin
write(ansichar(mem[a]));
end
else
begin
mem[b] := mem[b] - mem[a];
if (mem[b] < 1) then
begin
instructionPointer := mem[instructionPointer + 2];
Continue;
end;
end;
inc(instructionPointer, 3);
until (instructionPointer >= length(mem)) or (instructionPointer < 0);
readln;
end. </lang>
Forth
Note that Forth is stack oriented. Hence, the code is toggled in in reverse. <lang>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</lang>
- 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.
<lang Fortran>
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.
</lang> 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
<lang 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) } }</lang> 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. <lang Haskell>{-# 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]
</lang>
J
<lang 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
)</lang>
Example:
<lang J> 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!</lang>
Java
<lang 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); }
}</lang>
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. <lang jq># 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])</lang>
- Output:
<lang sh>$ jq -r -j -n -f subleq.jq Hello, world!</lang>
Julia
Module: <lang julia>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 </lang>
Main: <lang julia>using .Subleq
print(Subleq.interpret("15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101
108 108 111 44 32 119 111 114 108 100 33 10 0"))
</lang>
- Output:
Hello, world!
Kotlin
<lang scala>// 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)
}</lang>
- Output:
Hello, world!
Logo
<lang 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</lang>
- 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
<lang 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")</lang>
MiniScript
<lang MiniScript>memory = [] step = 3 currentAddress = 0 out = ""
process = function(address)
A = memory[address].val
B = memory[address + 1].val
C = memory[address + 2].val
nextAddress = address + step
if A == -1 then
memory[B] = input
else if B == -1 then
globals.out = globals.out + char(memory[A].val)
else
memory[B] = str(memory[B].val - memory[A].val)
if memory[B] < 1 then nextAddress = C
end if
return nextAddress
end function
print memory = input("Enter SUBLEQ program").split
print print "Running Program" print "-------------------" processing = currentAddress < memory.len while processing
currentAddress = process(currentAddress)
if currentAddress >= memory.len or currentAddress == -1 then
processing = false
end if
end while
print out print "-------------------" print "Execution Complete"</lang>
- 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
<lang modula2>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.</lang>
Nim
<lang nim>import streams
type
Interpreter = object mem: seq[int] ip: int input, output: Stream
proc load(prog: openArray[int]; inp, outp: Stream): Interpreter =
Interpreter(mem: prog, input: inp, output: outp)
proc run(i: var Interpreter) =
while i.ip >= 0:
let A = i.mem[i.ip]
let B = i.mem[i.ip+1]
let C = i.mem[i.ip+2]
i.ip += 3
if A == -1:
i.mem[B] = ord(i.input.readChar)
elif B == -1:
i.output.write(chr(i.mem[A]))
else:
i.mem[B] -= i.mem[A]
if i.mem[B] <= 0:
i.ip = C
let test = @[15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1,
72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33, 10, 0]
var intr = load(test, newFileStream(stdin), newFileStream(stdout))
try:
intr.run()
except IndexDefect:
echo "ip: ", intr.ip echo "mem: ", intr.mem</lang>
- Output:
Hello, world!
Objeck
<lang 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);
}
}</lang>
Hello, world!
Oforth
<lang 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</lang>
ooRexx
version 1
reformatted and long variable names that suit all Rexxes. <lang oorexx>/*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</lang>
- Output:
Hello, world!
version 2
Using an array object instead of a stem for cells.
Array indexes must be positive!
<lang oorexx>/*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</lang>
Pascal
<lang 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.</lang>
- 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
<lang 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;
}
}
}</lang>
- Output:
Hello, world!
Phix
<lang 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] = 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})</lang>
- Output:
Hello, world!
PicoLisp
<lang 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)) ) ) ) )</lang>
Output:
Hello, world!
PowerShell
<lang 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
}
} </lang> <lang PowerShell> Invoke-Subleq -Program 15,17,-1,17,-1,-1,16,1,-1,16,3,-1,15,15,0,0,-1,72,101,108,108,111,44,32,119,111,114,108,100,33,10,0 </lang>
- Output:
Hello, world!
Python
<lang 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])</lang>
R
<lang rsplus> mem <- c(15, 17, -1, 17, -1, -1, 16, 1,
-1, 16, 3, -1, 15, 15, 0, 0,
-1, 72, 101, 108, 108, 111, 44,
32, 119, 111, 114, 108, 100,
33, 10, 0)
getFromMemory <- function(addr) { memaddr + 1 } # because first element in mem is mem1 setMemory <- function(addr, value) { memaddr + 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
} </lang>
- Output:
Hello, world!
Racket
The negative addresses are treated as -1.
<lang Racket>#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)</lang>
- Output:
Hello, world!
Raku
(formerly Perl 6)
<lang perl6>my @hello-world = <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>;
my @memory = @hello-world; 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] = getc.ord;
} elsif $b < 0 {
print @memory[$a].chr;
} else {
if (@memory[$b] -= @memory[$a]) <= 0 {
$ip = $c;
}
}
}</lang>
- 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. <lang rexx>/*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</lang>
- output when using the default input:
Hello, world!
Ruby
<lang Ruby>class Computer
def initialize program
@memory = program.map{|instruction| instruction.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]
@memory[b] = difference
@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</lang> 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
<lang Scala>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)
}</lang>
- Output:
See it running in your browser by Scastie (JVM).
Sidef
<lang ruby>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
}
}</lang>
- 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. <lang basic> 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</lang>
- 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.
Swift
<lang swift>func subleq(_ inst: inout [Int]) {
var i = 0
while i >= 0 {
if inst[i] == -1 {
inst[inst[i + 1]] = Int(readLine(strippingNewline: true)!.unicodeScalars.first!.value)
} else if inst[i + 1] == -1 {
print(String(UnicodeScalar(inst[inst[i]])!), terminator: "")
} else {
inst[inst[i + 1]] -= inst[inst[i]]
if inst[inst[i + 1]] <= 0 {
i = inst[i + 2]
continue
}
}
i += 3
}
}
var prog = [
15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, 15, 15, 0, 0, -1, 72, 101, 108, 108, 111, 44, 32, 119, 111, 114, 108, 100, 33, 10, 0
]
subleq(&prog) </lang>
- Output:
Hello, world!
Tcl
<lang 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} </lang>
- Output:
Hello, world!
uBasic/4tH
<lang>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</lang>
- Output:
Hello, world! 0 OK, 0:2010
UNIX Shell
dash
<lang bash>#!/bin/sh
mem="15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0 "
i=0 for v in $mem do
eval 'mem_'$i=$v i=$(( $i + 1 ))
done
get_m () {
eval echo '$mem_'$1
} set_m () {
eval 'mem_'$1=$2
}
ADDR=0 STEP=0
while [ ${STEP} -lt 9999 ] do
STEP=$(( $STEP + 1 ))
A=$(get_m $ADDR)
B=$(get_m $(($ADDR + 1)) )
C=$(get_m $(($ADDR + 2)) )
ADDR=$((ADDR + 3))
if [ $B -lt 0 ]; then
get_m $A | awk '{printf "%c",$1}'
else
set_m $B $(( $(get_m $B) - $(get_m $A) ))
if [ $(get_m $B) -le 0 ]; then
if [ $C -eq -1 ]; then
echo "Total step:"$STEP
exit 0
fi
ADDR=$C
fi
fi
done echo "Total step:"$STEP </lang>
bash
<lang bash>#!/bin/sh
mem=(15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0 )
ADDR=0 STEP=0
while $((STEP++ )) -lt 300 do
A=${mem[$ADDR]}
B=${mem[(($ADDR + 1))]}
C=${mem[(($ADDR + 2))]}
ADDR=$((ADDR + 3))
if $B -lt 0 ; then
printf '%b' '\x'$(printf '%x' ${mem[$A]})
else
mem[$B]=$((${mem[$B]} - ${mem[$A]}))
if [[ ${mem[$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 </lang>
Wren
<lang ecmascript>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)</lang>
- Output:
Hello, world!
zkl
<lang 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;
}
}</lang> <lang zkl>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);</lang>
- 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.
<lang zxbasic> 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</lang>
- Output:
Hello, world!
- Programming Tasks
- Solutions by Programming Task
- 11l
- 8080 Assembly
- 8086 Assembly
- Ada
- ALGOL 68
- ALGOL W
- APL
- ARM Assembly
- AWK
- BBC BASIC
- Befunge
- C
- C sharp
- C++
- COBOL
- Common Lisp
- D
- Delphi
- Forth
- Fortran
- Go
- Haskell
- J
- Java
- Jq
- Julia
- Kotlin
- Logo
- Lua
- MiniScript
- Modula-2
- Nim
- Objeck
- Oforth
- OoRexx
- Pascal
- Perl
- Phix
- PicoLisp
- PowerShell
- Python
- R
- Racket
- Raku
- REXX
- Ruby
- Scala
- Sidef
- Sinclair ZX81 BASIC
- Swift
- Tcl
- UBasic/4tH
- UNIX Shell
- Wren
- Zkl
- ZX Spectrum Basic