Rosetta Code

Subleq: Difference between revisions

Page Discussion

Subleq (view source)

Revision as of 16:38, 10 February 2024

6,357 bytes added ,  3 months ago
m
→‎{{header|Wren}}: Changed to Wren S/H
(→‎{{header|SNOBOL}}: Add implementation)
m (→‎{{header|Wren}}: Changed to Wren S/H)
 
(11 intermediate revisions by 5 users not shown)
Line 17:
:#   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.
 
Line 33:
 
<pre>start:
0f 11 ff subleq (zero), (message), -1 ; subtract 0 from next character value to print;
; terminate if it's <=0
11 ff ff subleq (message), -1, -1 ; output character at message
1011 01ff ff subleq (neg1message), (start+-1), -1 ; output character
10 0301 ff subleq (neg1), (start+31), -1 ; modify above two instructions by subtracting -1
0f10 0f03 00ff subleq (zeroneg1), (zerostart+3), start-1 ; (adding 1) to their target addresses
0f 0f 00 subleq (zero), (zero), start ; if 0-0 <= 0 (i.e. always) goto start
 
; useful constants
zero:
Line 1,198 ⟶ 1,200:
 
=={{header|BASIC}}==
{{works with|GW-BASIC}}
<syntaxhighlight lang="gwbasic">10 DEFINT A-Z: DIM M(8192)
{{works with|QBasic}}
<syntaxhighlight lang="basic">10 DEFINT A-Z: DIM M(8192)
20 INPUT "Filename";F$
30 OPEN "I",1,F$
Line 1,220 ⟶ 1,224:
<pre>Filename? HELLO.SUB
Hello, world!</pre>
 
==={{header|BASIC256}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">dim memoria(255)
contador = 0
 
input "SUBLEQ> ", codigo
 
while instr(codigo, " ")
memoria[contador] = int(left(codigo, instr(codigo, " ") - 1))
codigo = mid(codigo, instr(codigo, " ") + 1, length(codigo))
contador += 1
end while
 
memoria[contador] = int(codigo)
contador = 0
do
a = memoria[contador]
b = memoria[contador + 1]
c = memoria[contador + 2]
contador += 3
if a = -1 then
input "SUBLEQ> ", caracter
memoria[b] = asc(caracter)
else
if b = -1 then
print chr(memoria[a]);
else
memoria[b] -= memoria[a]
if memoria[b] <= 0 then contador = c
end if
end if
until contador < 0</syntaxhighlight>
 
==={{header|FreeBASIC}}===
<syntaxhighlight lang="vbnet">
Dim As Integer memoria(255), contador = 0
Dim As String codigo, caracter
 
Input "SUBLEQ> ", codigo
 
While Instr(codigo, " ")
memoria(contador) = Val(Left(codigo, Instr(codigo, " ") - 1))
codigo = Mid(codigo, Instr(codigo, " ") + 1)
contador += 1
Wend
 
memoria(contador) = Val(codigo)
contador = 0
Do
Dim As Integer a = memoria(contador)
Dim As Integer b = memoria(contador + 1)
Dim As Integer c = memoria(contador + 2)
contador += 3
If a = -1 Then
Input "SUBLEQ> ", caracter
memoria(b) = Asc(caracter)
Else
If b = -1 Then
Print Chr(memoria(a));
Else
memoria(b) -= memoria(a)
If memoria(b) <= 0 Then contador = c
End If
End If
Loop Until contador < 0
Sleep</syntaxhighlight>
{{out}}
<pre>SUBLEQ> 15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0
Hello, world!</pre>
 
==={{header|Gambas}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">Public memoria[255] As Integer
 
Public Sub Main()
Dim contador As Integer = 0
Dim codigo As String, caracter As String
Print "SUBLEQ> ";
Input codigo
While InStr(codigo, " ")
memoria[contador] = Val(Left(codigo, InStr(codigo, " ") - 1))
codigo = Mid(codigo, InStr(codigo, " ") + 1)
contador += 1
Wend
memoria[contador] = Val(codigo)
contador = 0
Do
Dim a As Integer = memoria[contador]
Dim b As Integer = memoria[contador + 1]
Dim c As Integer = memoria[contador + 2]
contador += 3
If a = -1 Then
Print "SUBLEQ> ";
Input caracter
memoria[b] = Asc(caracter)
Else
If b = -1 Then
Print Chr(memoria[a]);
Else
memoria[b] -= memoria[a]
If memoria[b] <= 0 Then contador = c
End If
End If
Loop Until contador < 0
 
End</syntaxhighlight>
 
==={{header|GW-BASIC}}===
The [[#BASIC|BASIC]] solution works without any changes.
 
==={{header|QBasic}}===
The [[#BASIC|BASIC]] solution works without any changes.
 
==={{header|Yabasic}}===
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">dim memoria(255)
contador = 0
input "SUBLEQ> " codigo$
while instr(codigo$, " ")
memoria(contador) = val(left$(codigo$, instr(codigo$, " ") - 1))
codigo$ = mid$(codigo$,instr(codigo$," ")+1,len(codigo$))
contador = contador + 1
wend
 
memoria(contador) = val(codigo$)
contador = 0
repeat
a = memoria(contador)
b = memoria(contador+ 1)
c = memoria(contador+ 2)
contador = contador + 3
if a = -1 then
input "SUBLEQ> " caracter$
memoria(b) = asc(caracter$)
else
if b = -1 then
print chr$(memoria(a));
else
memoria(b) = memoria(b) - memoria(a)
if memoria(b) <= 0 contador = c
fi
fi
until contador < 0
end</syntaxhighlight>
 
=={{header|BBC BASIC}}==
Line 1,744 ⟶ 1,897:
 
=={{header|Commodore BASIC}}==
The onlysample changeprogram is the one from the task description iswith thata slightly different text string: it starts with the charactercontrol codescode areto changedconvert to PETSCII.mixed-case mode (14), and the rest
is in PETSCII rather than standard ASCII.
 
<syntaxhighlight lang="basic">100 READ N:REM SIZE OF PROGRAM
110 DIM M%(N-1)
Line 1,768 ⟶ 1,923:
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, 104200, 69, 76, 76, 79, 44, 32, 87, 79, 82, 76, 68, 33, 13, 0</syntaxhighlight>
 
{{Out}}
Line 1,952 ⟶ 2,107:
A>subleq hello.sub
Hello, world!</pre>
 
=={{header|EasyLang}}==
{{trans|FreeBASIC}}
<syntaxhighlight>
global inpos inp$ .
func inp .
if inpos = 0
inp$ = input
if error = 1
return 255
.
inpos = 1
.
if inpos <= len inp$
h = strcode substr inp$ inpos 1
inpos += 1
return h
.
inpos = 0
return 10
.
proc subleq . mem[] .
repeat
a = mem[p]
b = mem[p + 1]
c = mem[p + 2]
p += 3
if a = -1
mem[b] = inp
elif b = -1
write strchar mem[a]
else
mem[b] -= mem[a]
if mem[b] <= 0
p = c
.
.
until p < 0
.
.
prog[] = [ 15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0 ]
arrbase prog[] 0
#
subleq prog[]
#
input_data
dummy data
</syntaxhighlight>
 
 
=={{header|Forth}}==
Line 2,017 ⟶ 2,221:
</pre>
And the linefeed (character(10)) had been sent forth, but is not apparent because it just ended the line.
 
 
=={{header|FreeBASIC}}==
<syntaxhighlight lang="freebasic">
Dim As Integer memoria(255), contador = 0
Dim As String codigo, caracter
 
Input "SUBLEQ> ", codigo
 
While Instr(codigo, " ")
memoria(contador) = Val(Left(codigo, Instr(codigo, " ") - 1))
codigo = Mid(codigo, Instr(codigo, " ") + 1)
contador += 1
Wend
 
memoria(contador) = Val(codigo)
contador = 0
Do
Dim As Integer a = memoria(contador)
Dim As Integer b = memoria(contador + 1)
Dim As Integer c = memoria(contador + 2)
contador += 3
If a = -1 Then
Input "SUBLEQ> ", caracter
memoria(b) = Asc(caracter)
Else
If b = -1 Then
Print Chr(memoria(a));
Else
memoria(b) -= memoria(a)
If memoria(b) <= 0 Then contador = c
End If
End If
Loop Until contador < 0
Sleep
</syntaxhighlight>
{{out}}
<pre>
SUBLEQ> 15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0
Hello, world!
</pre>
 
 
=={{header|Go}}==
Line 3,198 ⟶ 3,360:
<pre>
Hello, world!
</pre>
 
=={{header|RPL}}==
{{works with|HP|48G}}
« 'Ram' DUP ROT ←ptr + GET 1 + GET
» '<span style="color:blue">PEEKind</span>' STO <span style="color:grey">@ ''( n → Ram[Ram[←ptr + n]] )''</span>
« 0 "" → ←ptr stdout
« { } + RDM 'Ram' STO
'''WHILE''' ←ptr 0 ≥ '''REPEAT'''
'''CASE'''
'Ram' ←ptr 1 + GET -1 == '''THEN'''
'Ram' 2 <span style="color:blue">PEEKind</span> '''DO UNTIL''' KEY '''END''' PUT '''END'''
'Ram' ←ptr 2 + GET -1 == '''THEN'''
'stdout' 1 <span style="color:blue">PEEKind</span> CHR STO+ '''END'''
2 <span style="color:blue">PEEKind</span> 1 <span style="color:blue">PEEKind</span> -
'Ram' DUP ←ptr 2 + GET 1 + 3 PICK PUT
0 ≤ '''THEN'''
1 SF '''END'''
1 CF
'''END'''
'''IF''' 1 FS? '''THEN'''
'Ram' ←ptr 3 + GET '←ptr' STO
'''ELSE'''
3 '←ptr' STO+
'''END'''
'''END'''
stdout
» » '<span style="color:blue">SUBLEQ</span>' STO <span style="color:grey">@ ''( [ program ] mem_size → stdout ] )''</span>
 
[ 15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0 ] 256 <span style="color:blue">SUBLEQ</span>
{{out}}
<pre>
1: "Hello, world!
"
</pre>
 
Line 3,272 ⟶ 3,469:
}</syntaxhighlight>
{{Out}}See it running in your browser by [https://scastie.scala-lang.org/f4MszRqZR5qtxI6YwarJhw Scastie (JVM)].
 
=={{header|SETL}}==
<syntaxhighlight lang="setl">program subleq;
if command_line(1) = om then
print("error: no file given");
stop;
end if;
 
mem := readprog(command_line(1));
 
loop init ip := 0; while ip >= 0 do
a := mem(ip) ? 0;
b := mem(ip+1) ? 0;
c := mem(ip+2) ? 0;
ip +:= 3;
if a = -1 then
mem(b) := ichar (getchar ? "\0");
elseif b = -1 then
putchar(char ((mem(a) ? 0) mod 256));
elseif (mem(b) +:= -(mem(a) ? 0)) <= 0 then
ip := c;
end if;
end loop;
 
proc readprog(fname);
if (f := open(fname, "r")) = om then
print("error: cannot open file");
stop;
end if;
 
mem := {};
mp := 0;
loop doing getb(f, n); while n/=om do
mem(mp) := n;
mp +:= 1;
end loop;
close(f);
return mem;
end proc;
end program;</syntaxhighlight>
{{out}}
<pre>$ cat hello.sub
15 17 -1 17 -1 -1 16 1 -1 16 3 -1 15 15 0 0 -1 72 101 108 108 111 44 32 119 111 114 108 100 33 10 0
$ setl subleq.setl hello.sub
Hello, world!</pre>
 
=={{header|Sidef}}==
Line 3,410 ⟶ 3,652:
DONE EQ(SIZE(OUTBUF),0) :S(END)
OUTPUT = OUTBUF
END</syntaxhighlight>
 
{{Out}}
Line 3,616 ⟶ 3,858:
=={{header|Wren}}==
{{trans|Kotlin}}
<syntaxhighlight lang="ecmascriptwren">import "io" for Stdin, Stdout
 
var subleq = Fn.new { |program|
PureFox
9,476

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/345533...352700"