Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
2
Task/Subleq/00-META.yaml
Normal file
2
Task/Subleq/00-META.yaml
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
---
|
||||
from: http://rosettacode.org/wiki/Subleq
|
||||
48
Task/Subleq/00-TASK.txt
Normal file
48
Task/Subleq/00-TASK.txt
Normal file
|
|
@ -0,0 +1,48 @@
|
|||
[[eso:Subleq|Subleq]] is an example of a [[wp:One_instruction_set_computer|One-Instruction Set Computer (OISC)]].
|
||||
|
||||
It is named after its only instruction, which is '''SU'''btract and '''B'''ranch if '''L'''ess than or '''EQ'''ual 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.
|
||||
|
||||
<pre>15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0</pre>
|
||||
|
||||
The above "machine code" corresponds to something like this in a hypothetical assembler language for a signed 8-bit version of the machine:
|
||||
|
||||
<pre>start:
|
||||
0f 11 ff subleq (zero), (message), -1
|
||||
11 ff ff subleq (message), -1, -1 ; output character at 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</pre>
|
||||
<br><br>
|
||||
|
||||
16
Task/Subleq/11l/subleq.11l
Normal file
16
Task/Subleq/11l/subleq.11l
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
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])
|
||||
345
Task/Subleq/8080-Assembly/subleq.8080
Normal file
345
Task/Subleq/8080-Assembly/subleq.8080
Normal file
|
|
@ -0,0 +1,345 @@
|
|||
;;; ---------------------------------------------------------------
|
||||
;;; 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 ' $'
|
||||
290
Task/Subleq/8086-Assembly/subleq.8086
Normal file
290
Task/Subleq/8086-Assembly/subleq.8086
Normal file
|
|
@ -0,0 +1,290 @@
|
|||
;;; -------------------------------------------------------------
|
||||
;;; 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 $
|
||||
47
Task/Subleq/ALGOL-68/subleq.alg
Normal file
47
Task/Subleq/ALGOL-68/subleq.alg
Normal file
|
|
@ -0,0 +1,47 @@
|
|||
# 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
|
||||
)
|
||||
)
|
||||
66
Task/Subleq/ALGOL-W/subleq.alg
Normal file
66
Task/Subleq/ALGOL-W/subleq.alg
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
% 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.
|
||||
29
Task/Subleq/APL/subleq.apl
Normal file
29
Task/Subleq/APL/subleq.apl
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
#!/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
|
||||
149
Task/Subleq/ARM-Assembly/subleq.arm
Normal file
149
Task/Subleq/ARM-Assembly/subleq.arm
Normal file
|
|
@ -0,0 +1,149 @@
|
|||
@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
|
||||
@@@ 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 = .
|
||||
42
Task/Subleq/AWK/subleq.awk
Normal file
42
Task/Subleq/AWK/subleq.awk
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
# 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)
|
||||
}
|
||||
68
Task/Subleq/Ada/subleq.ada
Normal file
68
Task/Subleq/Ada/subleq.ada
Normal file
|
|
@ -0,0 +1,68 @@
|
|||
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;
|
||||
26
Task/Subleq/Arturo/subleq.arturo
Normal file
26
Task/Subleq/Arturo/subleq.arturo
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
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
|
||||
19
Task/Subleq/BASIC/subleq.basic
Normal file
19
Task/Subleq/BASIC/subleq.basic
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
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
|
||||
28
Task/Subleq/BBC-BASIC/subleq.basic
Normal file
28
Task/Subleq/BBC-BASIC/subleq.basic
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
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
|
||||
79
Task/Subleq/BCPL/subleq.bcpl
Normal file
79
Task/Subleq/BCPL/subleq.bcpl
Normal file
|
|
@ -0,0 +1,79 @@
|
|||
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)
|
||||
$)
|
||||
$)
|
||||
17
Task/Subleq/BQN/subleq-1.bqn
Normal file
17
Task/Subleq/BQN/subleq-1.bqn
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
# 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
|
||||
14
Task/Subleq/BQN/subleq-2.bqn
Normal file
14
Task/Subleq/BQN/subleq-2.bqn
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
$ 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
|
||||
!
|
||||
5
Task/Subleq/Befunge/subleq.bf
Normal file
5
Task/Subleq/Befunge/subleq.bf
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
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
|
||||
46
Task/Subleq/C++/subleq.cpp
Normal file
46
Task/Subleq/C++/subleq.cpp
Normal file
|
|
@ -0,0 +1,46 @@
|
|||
#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;
|
||||
}
|
||||
37
Task/Subleq/C-sharp/subleq.cs
Normal file
37
Task/Subleq/C-sharp/subleq.cs
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
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);
|
||||
}
|
||||
}
|
||||
}
|
||||
49
Task/Subleq/C/subleq.c
Normal file
49
Task/Subleq/C/subleq.c
Normal file
|
|
@ -0,0 +1,49 @@
|
|||
#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;
|
||||
}
|
||||
90
Task/Subleq/CLU/subleq.clu
Normal file
90
Task/Subleq/CLU/subleq.clu
Normal file
|
|
@ -0,0 +1,90 @@
|
|||
% 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
|
||||
81
Task/Subleq/COBOL/subleq.cobol
Normal file
81
Task/Subleq/COBOL/subleq.cobol
Normal file
|
|
@ -0,0 +1,81 @@
|
|||
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.
|
||||
24
Task/Subleq/Commodore-BASIC/subleq.basic
Normal file
24
Task/Subleq/Commodore-BASIC/subleq.basic
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
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
|
||||
21
Task/Subleq/Common-Lisp/subleq.lisp
Normal file
21
Task/Subleq/Common-Lisp/subleq.lisp
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
(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)))
|
||||
33
Task/Subleq/D/subleq.d
Normal file
33
Task/Subleq/D/subleq.d
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
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);
|
||||
}
|
||||
44
Task/Subleq/Delphi/subleq.delphi
Normal file
44
Task/Subleq/Delphi/subleq.delphi
Normal file
|
|
@ -0,0 +1,44 @@
|
|||
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.
|
||||
61
Task/Subleq/Draco/subleq.draco
Normal file
61
Task/Subleq/Draco/subleq.draco
Normal file
|
|
@ -0,0 +1,61 @@
|
|||
\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
|
||||
14
Task/Subleq/Forth/subleq.fth
Normal file
14
Task/Subleq/Forth/subleq.fth
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
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
|
||||
29
Task/Subleq/Fortran/subleq.f
Normal file
29
Task/Subleq/Fortran/subleq.f
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
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.
|
||||
31
Task/Subleq/FreeBASIC/subleq.basic
Normal file
31
Task/Subleq/FreeBASIC/subleq.basic
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
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
|
||||
47
Task/Subleq/Go/subleq.go
Normal file
47
Task/Subleq/Go/subleq.go
Normal file
|
|
@ -0,0 +1,47 @@
|
|||
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)
|
||||
}
|
||||
}
|
||||
29
Task/Subleq/Haskell/subleq.hs
Normal file
29
Task/Subleq/Haskell/subleq.hs
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
{-# 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]
|
||||
27
Task/Subleq/J/subleq-1.j
Normal file
27
Task/Subleq/J/subleq-1.j
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
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
|
||||
)
|
||||
2
Task/Subleq/J/subleq-2.j
Normal file
2
Task/Subleq/J/subleq-2.j
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
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!
|
||||
22
Task/Subleq/Janet/subleq.janet
Normal file
22
Task/Subleq/Janet/subleq.janet
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
(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))))))))
|
||||
35
Task/Subleq/Java/subleq.java
Normal file
35
Task/Subleq/Java/subleq.java
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
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);
|
||||
}
|
||||
}
|
||||
32
Task/Subleq/Jq/subleq-1.jq
Normal file
32
Task/Subleq/Jq/subleq-1.jq
Normal file
|
|
@ -0,0 +1,32 @@
|
|||
# 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])
|
||||
2
Task/Subleq/Jq/subleq-2.jq
Normal file
2
Task/Subleq/Jq/subleq-2.jq
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
$ jq -r -j -n -f subleq.jq
|
||||
Hello, world!
|
||||
30
Task/Subleq/Julia/subleq-1.julia
Normal file
30
Task/Subleq/Julia/subleq-1.julia
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
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
|
||||
4
Task/Subleq/Julia/subleq-2.julia
Normal file
4
Task/Subleq/Julia/subleq-2.julia
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
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"))
|
||||
31
Task/Subleq/Kotlin/subleq.kotlin
Normal file
31
Task/Subleq/Kotlin/subleq.kotlin
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
// 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)
|
||||
}
|
||||
39
Task/Subleq/Logo/subleq.logo
Normal file
39
Task/Subleq/Logo/subleq.logo
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
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
|
||||
22
Task/Subleq/Lua/subleq.lua
Normal file
22
Task/Subleq/Lua/subleq.lua
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
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")
|
||||
23
Task/Subleq/Mathematica/subleq.math
Normal file
23
Task/Subleq/Mathematica/subleq.math
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
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;
|
||||
]
|
||||
39
Task/Subleq/MiniScript/subleq.mini
Normal file
39
Task/Subleq/MiniScript/subleq.mini
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
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"
|
||||
40
Task/Subleq/Modula-2/subleq.mod2
Normal file
40
Task/Subleq/Modula-2/subleq.mod2
Normal file
|
|
@ -0,0 +1,40 @@
|
|||
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.
|
||||
35
Task/Subleq/Nim/subleq.nim
Normal file
35
Task/Subleq/Nim/subleq.nim
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
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
|
||||
38
Task/Subleq/Objeck/subleq.objeck
Normal file
38
Task/Subleq/Objeck/subleq.objeck
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
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);
|
||||
}
|
||||
}
|
||||
16
Task/Subleq/Oforth/subleq.fth
Normal file
16
Task/Subleq/Oforth/subleq.fth
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
: 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
|
||||
38
Task/Subleq/OoRexx/subleq-1.rexx
Normal file
38
Task/Subleq/OoRexx/subleq-1.rexx
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
/*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
|
||||
36
Task/Subleq/OoRexx/subleq-2.rexx
Normal file
36
Task/Subleq/OoRexx/subleq-2.rexx
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
/*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
|
||||
61
Task/Subleq/Pascal/subleq.pas
Normal file
61
Task/Subleq/Pascal/subleq.pas
Normal file
|
|
@ -0,0 +1,61 @@
|
|||
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.
|
||||
25
Task/Subleq/Perl/subleq.pl
Normal file
25
Task/Subleq/Perl/subleq.pl
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
#!/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;
|
||||
}
|
||||
}
|
||||
}
|
||||
23
Task/Subleq/Phix/subleq.phix
Normal file
23
Task/Subleq/Phix/subleq.phix
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #008080;">procedure</span> <span style="color: #000000;">subleq</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #004080;">integer</span> <span style="color: #000000;">ip</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">0</span>
|
||||
<span style="color: #008080;">while</span> <span style="color: #000000;">ip</span><span style="color: #0000FF;">>=</span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #004080;">integer</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">,</span><span style="color: #000000;">c</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">ip</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">..</span><span style="color: #000000;">ip</span><span style="color: #0000FF;">+</span><span style="color: #000000;">3</span><span style="color: #0000FF;">]</span>
|
||||
<span style="color: #000000;">ip</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">3</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">=-</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">b</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()=</span><span style="color: #004600;">JS</span><span style="color: #0000FF;">?</span><span style="color: #008000;">'?'</span><span style="color: #0000FF;">:</span><span style="color: #7060A8;">getc</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">))</span>
|
||||
<span style="color: #008080;">elsif</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">=-</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">a</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">])</span>
|
||||
<span style="color: #008080;">else</span>
|
||||
<span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">b</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">a</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">code</span><span style="color: #0000FF;">[</span><span style="color: #000000;">b</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]<=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #000000;">ip</span> <span style="color: #0000FF;">:=</span> <span style="color: #000000;">c</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
|
||||
|
||||
<span style="color: #000000;">subleq</span><span style="color: #0000FF;">({</span><span style="color: #000000;">15</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">17</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">16</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">16</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span>
|
||||
<span style="color: #000000;">15</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">15</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">72</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">101</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">108</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">108</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">111</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">44</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">32</span><span style="color: #0000FF;">,</span>
|
||||
<span style="color: #000000;">119</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">111</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">114</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">108</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">100</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">33</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">10</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">})</span>
|
||||
<!--
|
||||
14
Task/Subleq/PicoLisp/subleq.l
Normal file
14
Task/Subleq/PicoLisp/subleq.l
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
(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)) ) ) ) )
|
||||
37
Task/Subleq/PowerShell/subleq-1.psh
Normal file
37
Task/Subleq/PowerShell/subleq-1.psh
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
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
|
||||
}
|
||||
}
|
||||
1
Task/Subleq/PowerShell/subleq-2.psh
Normal file
1
Task/Subleq/PowerShell/subleq-2.psh
Normal file
|
|
@ -0,0 +1 @@
|
|||
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
|
||||
19
Task/Subleq/PureBasic/subleq.basic
Normal file
19
Task/Subleq/PureBasic/subleq.basic
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
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()
|
||||
23
Task/Subleq/Python/subleq.py
Normal file
23
Task/Subleq/Python/subleq.py
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
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])
|
||||
38
Task/Subleq/Quackery/subleq.quackery
Normal file
38
Task/Subleq/Quackery/subleq.quackery
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
( 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$
|
||||
26
Task/Subleq/R/subleq.r
Normal file
26
Task/Subleq/R/subleq.r
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
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
|
||||
}
|
||||
23
Task/Subleq/REXX/subleq.rexx
Normal file
23
Task/Subleq/REXX/subleq.rexx
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
/*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
|
||||
28
Task/Subleq/Racket/subleq.rkt
Normal file
28
Task/Subleq/Racket/subleq.rkt
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
#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)
|
||||
22
Task/Subleq/Raku/subleq.raku
Normal file
22
Task/Subleq/Raku/subleq.raku
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
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;
|
||||
43
Task/Subleq/Ruby/subleq.rb
Normal file
43
Task/Subleq/Ruby/subleq.rb
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
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
|
||||
69
Task/Subleq/SNOBOL4/subleq.sno
Normal file
69
Task/Subleq/SNOBOL4/subleq.sno
Normal file
|
|
@ -0,0 +1,69 @@
|
|||
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
|
||||
19
Task/Subleq/Scala/subleq.scala
Normal file
19
Task/Subleq/Scala/subleq.scala
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
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)
|
||||
}
|
||||
16
Task/Subleq/Sidef/subleq.sidef
Normal file
16
Task/Subleq/Sidef/subleq.sidef
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
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
|
||||
}
|
||||
}
|
||||
33
Task/Subleq/Sinclair-ZX81-BASIC/subleq.basic
Normal file
33
Task/Subleq/Sinclair-ZX81-BASIC/subleq.basic
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
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
|
||||
28
Task/Subleq/Swift/subleq.swift
Normal file
28
Task/Subleq/Swift/subleq.swift
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
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)
|
||||
24
Task/Subleq/Tcl/subleq.tcl
Normal file
24
Task/Subleq/Tcl/subleq.tcl
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
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}
|
||||
42
Task/Subleq/UNIX-Shell/subleq-1.sh
Normal file
42
Task/Subleq/UNIX-Shell/subleq-1.sh
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
#!/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
|
||||
23
Task/Subleq/UNIX-Shell/subleq-2.sh
Normal file
23
Task/Subleq/UNIX-Shell/subleq-2.sh
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
#!/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"
|
||||
28
Task/Subleq/Wren/subleq.wren
Normal file
28
Task/Subleq/Wren/subleq.wren
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
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)
|
||||
52
Task/Subleq/XPL0/subleq.xpl0
Normal file
52
Task/Subleq/XPL0/subleq.xpl0
Normal file
|
|
@ -0,0 +1,52 @@
|
|||
\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
|
||||
31
Task/Subleq/ZX-Spectrum-Basic/subleq.basic
Normal file
31
Task/Subleq/ZX-Spectrum-Basic/subleq.basic
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
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
|
||||
9
Task/Subleq/Zkl/subleq-1.zkl
Normal file
9
Task/Subleq/Zkl/subleq-1.zkl
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
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;
|
||||
}
|
||||
}
|
||||
3
Task/Subleq/Zkl/subleq-2.zkl
Normal file
3
Task/Subleq/Zkl/subleq-2.zkl
Normal file
|
|
@ -0,0 +1,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);
|
||||
Loading…
Add table
Add a link
Reference in a new issue