I've been lurking on this list for a while and playing with Parrot. I
have created a little stack language not entirely unlike Forth I've come
to calling Parakeet. Consider the most trivial example:
0> 2 2 + println
4
0>
Two integers are pushed on the stack, the word "+" adds them leaving the
result on the stack which the word "println" prints on its own line.
New words can be defined with 'def ... end':
0> def square dup * end
0> 16 square println
256
0>
This defines the word "square" whose body is composed of "dup *". New
words are compiled directly to PIR. You can see the PIR code of defined
words with "see":
0> see square
.include "languages/parakeet/macros.imc"
.sub _square
.POP
.PUSH
.PUSH
.POP2
.TOS = .NOS * .TOS
.PUSH
ret
.end
0>
(Obviously this is not the most optimal code, but could easily be
optimized to cache the top two stack elements in registers at all
times).
There is some primitive support for pmc objects with "findtype" and
"new":
0> "PerlInt" findtype new println
0
0>
The string "PerlInt" is pushed on the stack, the word "findtype" finds
the type code and pushes it on the stack, which is instantiated with
"new". These words map to their Parrot opcode equivalents. Simple
variables can be created with the word "var"
0> 4 var x
0> x println
4
0>
Parakeet is a stack language like Forth but is very machine specific to
Parrot. There are no "cells" or access to "memory", the stack is
heterogeneous and can hold any PMC. There is no return stack, since
Parrot handles that with 'jsr ... ret'.
Flow control currently consists of 'if/then' and 'do/loop':
0> def decide if 5 then end
0> 1 decide println
5
0> 0 decide
0>
The word "decide" pushes the integer 5 onto the stack if the top of the
stack is true, it does nothing otherwise. Here is its PIR:
0> see decide
.include "languages/parakeet/macros.imc"
.sub _decide
.POP
unless .TOS, endif2
.TOS = new .PerlInt
.TOS = 1
.PUSH
endif2:
ret
.end
Parakeet is incomplete, but I'd like to keep working on it if the Parrot
team is interested in another language. I have run up against some
problems, however, that I have been unable to solve or find solutions
for in the docs. For example:
0> def shoot do "bang" println loop end
0> see shoot
.include "languages/parakeet/macros.imc"
.sub _shoot
.POP2
push .CSTACK, .NOS
push .CSTACK, .TOS
do2:
.TOS = new .PerlString
.TOS = "bang"
.PUSH
.POP
print .TOS
print "\n"
pop .TOS, .CSTACK
pop .NOS, .CSTACK
inc .TOS
push .CSTACK, .NOS
push .CSTACK, .TOS
ne .TOS, .NOS, do2
pop .TOS, .CSTACK
pop .NOS, .CSTACK
ret
.end
0>
The word "shoot" should print the string "bang" inside a loop whose
limit and start are on the data stack (in the above code, the CSTACK is
the control stack to hold the current loop values, not the data stack):
0> 4 0 shoot
pop .NOS, .CSTACK
findtypepop .NOS, .CSTACK
findtypepop .NOS, .CSTACK
findtypepop .NOS, .CSTACK
findtype0>
It does print four things, but not the four things I was expecting! I
have having some other problems with resolving variables names:
0> def bob var x end
0> see bob
.include "languages/parakeet/macros.imc"
.sub _bob
.POP
.VARS["x"] = .TOS
ret
.end
Now when I try to run it:
0> 4 bob
Key not a string!
[EMAIL PROTECTED]
I suspect maybe these two problems are related. Anyone spot it? Cuz
I'm stumped.
If you are interested in playing with it and seeing what it is all about
I have attached the two .imc files that you need to run it. Just put
the two files in languages/parakeet and point Parrot to parakeet.imc and
you will get the interpreter prompt.
In my analysis I've found the Parrot VM to be very cool and quite fast.
I've had a lot of experience with the Python VM and it's "C loop"
interpreter design.
I have no idea how the two currently compare (but soon we'll find out
which way the pie flies ;) but it looks to me that Parrot's JIT
compiling VM with lots of on-processor register space is going to
present some clear competition to Python's stack-based VM implemented in
a C loop. No matter who wins at OSCON the Python VM will have to
embrace these optimizations to remain viable. We'll see.
-Michel
.macro IPROMPT "> " .endm
.macro CPROMPT "... " .endm
.const int Space = 32
.const int Tab = 9
# Registers used by machine.
.macro PIRC P29 .endm
.macro PASMC P28 .endm
.macro TOS P27 .endm # Top Of Stack
.macro NOS P26 .endm # Next On Stack
.macro USERS P25 .endm # Hash of User words
.macro VARS P24 .endm # Hash of variables
.macro CSTACK P23 .endm # control stack
.macro OPTIONS P22 .endm # misc. machine options
.macro WORDS P21 .endm # hash of core words
.macro LEVEL I31 .endm # current namespace level
.macro BODY S31 .endm # Body of to-be-compiled word
.macro CURR S30 .endm # current word
.macro SRC S29 .endm # remaining source line to be interpreted
.macro COMPILING .LEVEL > 0 .endm
.macro INTERPRETING .LEVEL == 0 .endm
.macro emit(s)
concat .BODY, .s
.endm
.macro addWord(name, lbl)
set_addr $I0, .lbl
.WORDS[.name] = $I0
.endm
# errors
.macro checkNotEmpty
depth $I0
if $I0 > 0 goto .$NoError
new $P0, .Exception
$P0["_message"] = "Stack is Empty!"
throw $P0
.local $NoError:
.endm
# stackies
.macro POP
.checkNotEmpty
restore .TOS
.endm
.macro POP2
.checkNotEmpty
restore .TOS
.checkNotEmpty
restore .NOS
.endm
.macro PUSH
save .TOS
.endm
# Parakeet is a stack machine language for the Parrot VM a bit like
# the Forth programming language. Parakeet is extremely simple and
# interactive. Just run the file through Parrot and you will get an
# interpreter prompt. From there, you can type in Parakeet code.
.include "languages/parakeet/macros.imc"
.sub _main @MAIN
.param PerlArray argv
$I0 = argv
# name of the program
.local string program_name
program_name = shift argv
.local pmc stdin
getstdin stdin
.LEVEL = 0
newsub $P0, .Exception_Handler, _handler
set_eh $P0
# currently I keep track of my own vars in a hash, I'd like to use
# the lexical stuff but I can't get it to work right.
# new_pad .LEVEL
# store_lex -1, "argv", argv
compreg .PASMC, "PASM"
compreg .PIRC, "PIR"
.WORDS = new .PerlHash
.USERS = new .PerlHash
.VARS = new .PerlHash
.CSTACK = new .PerlArray
.addWord("def", _DEF)
.addWord("end", _END)
.addWord("var", _VAR)
.addWord("findtype", _FINDTYPE)
.addWord("new", _NEW)
.addWord("bye", _BYE)
.addWord("see", _SEE)
.addWord("throw", _THROW)
.addWord("print", _PRINT)
.addWord("println", _PRINTLN)
.addWord("drop", _DROP)
.addWord("dup", _DUP)
.addWord("if", _IF)
.addWord("then", _THEN)
.addWord("else", _ELSE)
.addWord("do", _DO)
.addWord("loop", _LOOP)
.addWord("for", _FOR)
.addWord("next", _NEXT)
.addWord("+", _ADD)
.addWord("-", _SUB)
.addWord("*", _MUL)
.addWord("/", _DIV)
BeginInteraction:
if .COMPILING goto CompilePrompt
depth $I0
print $I0
print .IPROMPT
goto Prompted
CompilePrompt:
print .CPROMPT
Prompted:
readline .SRC, stdin
length $I0, .SRC
dec $I0
substr .SRC, .SRC, 0, $I0
BeginCollecting:
.CURR = ""
bsr EatLeadingWhitespace
bsr CollectWord
if .CURR == "" goto BeginInteraction
Comment:
substr $S0, .CURR, 0, 1
unless $S0 == "#" goto Zero
goto BeginInteraction
Zero:
unless .CURR == "0" goto Integer
if .COMPILING goto CompileZero
.TOS = new .PerlInt
.TOS = 0
.PUSH
goto BeginCollecting
CompileZero:
.emit(".TOS = new .PerlInt\n")
.emit(".TOS = 0\n")
.emit(".PUSH\n")
goto BeginCollecting
Integer:
$I0 = .CURR
unless $I0 > 0 goto String
if .COMPILING goto CompileInteger
.TOS = new .PerlInt
.TOS = $I0
.PUSH
goto BeginCollecting
CompileInteger:
.emit(".TOS = new .PerlInt\n")
.emit(".TOS = ")
.emit(.CURR)
.emit("\n.PUSH\n")
goto BeginCollecting
String:
# This is lame-o. figure out Rx4 to parse out string literals
substr $S0, .CURR, 0, 1
unless $S0 == "\"" goto Word
length $I0, .CURR
dec $I0
dec $I0
substr .CURR, .CURR, 1, $I0
.TOS = new .PerlString
.TOS = .CURR
if .COMPILING goto CompileString
.PUSH
goto BeginCollecting
CompileString:
.emit(".TOS = new .PerlString\n.TOS = \"")
.emit(.CURR)
.emit("\"\n.PUSH\n")
goto BeginCollecting
Word:
.TOS = .WORDS[.CURR]
$I0 = typeof .TOS
if $I0 == .PerlUndef goto Variable
$I0 = .TOS
jsr $I0
goto BeginCollecting
Variable:
.TOS = .VARS[.CURR]
$I0 = typeof .TOS
if $I0 == .PerlUndef goto User
if .COMPILING goto CompileVariable
.PUSH
# if .COMPILING goto CompileVariable
# newsub $P1, .Exception_Handler, _var_not_found
# set_eh $P1
# find_lex .TOS, .CURR
# .PUSH
# goto BeginCollecting
# _var_not_found:
# clear_eh
# goto User
CompileVariable:
.emit(".TOS = .VARS[\"")
.emit(.CURR)
.emit("\"]\n.PUSH\n")
# .emit("$S0 = ")
# .emit(.CURR)
# .emit("\"\nfind_lex .TOS, $S0\"")
# .emit(".PUSH\n")
goto BeginCollecting
User:
.TOS = .USERS[.CURR]
$I0 = typeof .TOS
if $I0 == .PerlUndef goto UnknownWord
$I0 = .TOS[1]
if .COMPILING goto CompileUser
jsr $I0
goto BeginCollecting
CompileUser:
.emit("set $I0, ")
$S0 = $I0
.emit($S0)
.emit("\njsr $I0\n")
goto BeginCollecting
UnknownWord:
print "Unknown Word: "
print .CURR
print "\n"
.LEVEL = 0
goto BeginInteraction
_handler:
print "An Exception was thrown: "
set S0, P5["_message"] # P5 is the exception object
print S0
print "\n"
.LEVEL = 0
goto BeginInteraction
End:
goto BeginInteraction
# Helper routines taken from forth.pasm. Should use RX4.
EatLeadingWhitespace:
length $I1, .SRC
eq $I1, 0, DoneLeadingWhitespace
set $I3, 0
ord $I2, .SRC, $I3
eq $I2, Space, StartLeadingWhitespace
eq $I2, Tab, StartLeadingWhitespace
branch DoneLeadingWhitespace
StartLeadingWhitespace:
inc $I3
eq $I1, $I1, FinishLeadingWhitespace
ord $I2, .SRC, $I3
eq $I2, Space, StartLeadingWhitespace
eq $I2, Tab, StartLeadingWhitespace
FinishLeadingWhitespace:
substr .SRC, 0, $I3, ""
DoneLeadingWhitespace:
ret
CollectWord:
length $I1, .SRC
eq $I1, 0, DoneCollectWord
set $I3, 0
NextCharCollectWord:
eq $I3, $I1, EndDarkspace
ord $I2, .SRC, $I3
eq $I2, Space, EndDarkspace
eq $I2, Tab, EndDarkspace
inc $I3
branch NextCharCollectWord
EndDarkspace:
substr .CURR, .SRC, 0, $I3, ""
DoneCollectWord:
ret
# Word definitions
# Define a new word in the current lexical scope.
_DEF:
# save the parent word compilation will resume at
save .BODY
save .CURR
bsr EatLeadingWhitespace
bsr CollectWord
inc .LEVEL
save .CURR
.BODY = ".include \"languages/parakeet/macros.imc\"\n"
.emit(".sub ")
.emit("_")
.emit(.CURR)
.emit("\n")
ret
#
# End the word being currently compiled.
_END:
unless .LEVEL == 0 goto _DOEND
print "Nothing to end!\n"
ret
_DOEND:
.emit("ret\n")
.emit(".end\n")
print .BODY
compile $P0, .PIRC, .BODY
$P1 = new .PerlString
$P1 = .BODY
setprop $P0, "__asm__", $P1
restore .CURR
.USERS[.CURR] = $P0
dec .LEVEL
restore .CURR
restore .BODY
ret
#
# See a word's asm source. Interpret only.
_SEE:
unless .INTERPRETING goto _BLIND
bsr EatLeadingWhitespace
bsr CollectWord
.TOS = .USERS[.CURR]
$I0 = typeof .TOS
if $I0 == .PerlUndef goto _NOSEEUM
getprop $P0, "__asm__", .TOS
print $P0
ret
_NOSEEUM:
print "Can't see word: "
print .CURR
print "\n"
_BLIND:
ret
#
# See ya.
_BYE:
if .COMPILING goto _CBYE
end
_CBYE:
.emit("end\n")
ret
#
# Create a new varible in the current lexical scope.
_VAR:
bsr EatLeadingWhitespace
bsr CollectWord
unless .INTERPRETING goto _CVAR
.POP
.VARS[.CURR] = .TOS
ret
# .POP
# newsub $P1, .Exception_Handler, _var_not_found2
# set_eh $P1
# find_lex $P0, .CURR
# _var_not_found2:
# clear_eh
# store_lex -1, .CURR, .TOS
# ret
# assign $P0, .TOS
# ret
_CVAR:
$P0 = new .PerlInt # place-holder
$P0 = 0
.VARS[.CURR] = $P0
.emit(".POP\n")
.emit(".VARS[\"")
.emit(.CURR)
.emit("\"] = .TOS\n")
# .TOS = new .PerlInt
# store_lex -1, .CURR, .TOS
# .emit(".POP\n$S0 = \"")
# .emit(.CURR)
# .emit("\"\nfind_lex $P0, $S0\n")
# .emit("assign $P0, .TOS\n")
ret
#
# Exceptions.
_THROW:
if .COMPILING goto _CTHROW
.POP
throw .TOS
ret
_CTHROW:
.emit(".POP\n")
.emit("throw .TOS\n")
ret
#
# I/O
_PRINT:
if .COMPILING goto _CPRINT
.POP
print .TOS
ret
_CPRINT:
.emit(".POP\n")
.emit("print .TOS\n")
ret
_PRINTLN:
if .COMPILING goto _CPRINTLN
.POP
print .TOS
print "\n"
ret
_CPRINTLN:
.emit(".POP\n")
.emit("print .TOS\n")
.emit("print \"\\n\"\n")
ret
#
# Control Flow
# if/else/then
_IF:
unless .COMPILING goto _ENDIF
inc .LEVEL
.emit(".POP\n")
.emit("unless .TOS, endif")
$S0 = .LEVEL
.emit($S0)
.emit("\n")
_ENDIF:
ret
_ELSE:
unless .COMPILING goto _ENDELSE
_ENDELSE:
ret
_THEN:
unless .COMPILING goto _ENDTHEN
.emit("endif")
$S0 = .LEVEL
.emit($S0)
.emit(":\n")
dec .LEVEL
_ENDTHEN:
ret
# do/loop
_DO:
unless .COMPILING goto _ENDDO
# bsr EatLeadingWhitespace
# bsr CollectWord
inc .LEVEL
.emit(".POP2\n")
.emit("push .CSTACK, .NOS\n")
.emit("push .CSTACK, .TOS\n")
# .emit(".VARS[\"")
# .emit(.CURR)
# .emit("\"] = .TOS\n")
.emit("do")
$S0 = .LEVEL
.emit($S0)
.emit(":\n")
_ENDDO:
ret
_LOOP:
unless .COMPILING goto _ENDLOOP
.emit("pop .TOS, .CSTACK\n")
.emit("pop .NOS, .CSTACK\n")
.emit("inc .TOS\n")
# .emit(".VARS[\"")
# .emit(.CURR)
# .emit("\"] = .TOS\n")
.emit("push .CSTACK, .NOS\n")
.emit("push .CSTACK, .TOS\n")
.emit("ne .TOS, .NOS, do")
$S0 = .LEVEL
.emit($S0)
.emit("\n")
.emit("pop .TOS, .CSTACK\n")
.emit("pop .NOS, .CSTACK\n")
dec .LEVEL
_ENDLOOP:
ret
# for/next
_FOR:
unless .COMPILING goto _ENDFOR
_ENDFOR:
ret
_NEXT:
unless .COMPILING goto _ENDNEXT
_ENDNEXT:
ret
#
# Instantiate a new object whose type is on the stack
_NEW:
if .COMPILING goto _CNEW
.POP
$I0 = .TOS
.TOS = new $I0
.PUSH
ret
_CNEW:
.emit(".POP\n")
.emit("$I0 = .TOS\n")
.emit(".TOS = new $I0\n")
.emit(".PUSH\n")
ret
#
# Find a type whose name is a string on the stack.
_FINDTYPE:
if .COMPILING goto _CFINDTYPE
.POP
$S0 = .TOS
find_type $I0, $S0
.TOS = $I0
.PUSH
ret
_CFINDTYPE:
.emit(".POP\n")
.emit("$S0 = .TOS\n")
.emit("find_type $I0, $S0\n")
.emit(".TOS = $I0\n")
.emit(".PUSH\n")
ret
# Stack
_DROP:
if .COMPILING goto _CDROP
.POP
ret
_CDROP:
.emit(".POP\n")
ret
_DUP:
if .COMPILING goto _CDUP
.POP
.PUSH
.PUSH
ret
_CDUP:
.emit(".POP\n")
.emit(".PUSH\n")
.emit(".PUSH\n")
ret
# Math
_ADD:
if .COMPILING goto _CADD
.POP2
.TOS = .NOS + .TOS
.PUSH
ret
_CADD:
.emit(".POP2\n")
.emit(".TOS = .NOS + .TOS\n")
.emit(".PUSH\n")
ret
_SUB:
if .COMPILING goto _CSUB
.POP2
.TOS = .NOS - .TOS
.PUSH
ret
_CSUB:
.emit(".POP2\n")
.emit(".TOS = .NOS - .TOS\n")
.emit(".PUSH\n")
ret
_MUL:
if .COMPILING goto _CMUL
.POP2
.TOS = .NOS * .TOS
.PUSH
ret
_CMUL:
.emit(".POP2\n")
.emit(".TOS = .NOS * .TOS\n")
.emit(".PUSH\n")
ret
_DIV:
if .COMPILING goto _CDIV
.POP2
.TOS = .NOS / .TOS
.PUSH
ret
_CDIV:
.emit(".POP2\n")
.emit(".TOS = .NOS / .TOS\n")
.emit(".PUSH\n")
ret
.end
