John Leuner <[EMAIL PROTECTED]> writes:
> I've been working on an experimental port of jolt-burg. The main difference is
> that my implementation language is Common Lisp and that my compiler targets
> relocatable ELF object files.
Interesting!
I was inspired by you, and tried my hand at getting similar changes
into jolt2. The attached patch should apply cleanly on top of SVN
-r407, followed by my jolt2-fixes.patch that I posted earlier.
Here is the function/examples2/slink/README file (also included in the
attached jolt2-slink.patch) for more information:
SLINK 0.2
*********
Slink is the beginning of a statically-linking compiler extension for
Jolt2 (think "Static LINK" or "System LINK"). It was partly inspired
by John Leuner's Common Lisp port of jolt-burg that creates
relocatable ELF objects. I'm basically attempting to land the same
kinds of features in COLA proper without changing too much of the
existing compiler machinery.
It has many limitations, but is a proof-of-concept and will probably
evolve (the main direction for evolution is to make the changes less
and less dependent on patching Jolt2's Id sources directly, and
instead accomplish its features at runtime via slink.k and friends).
The centerpiece of this system is slink-compile, which currently can
only generate i386 assembly code. The following new syntax is
introduced:
(define (slink SYMBOL))
Import SYMBOL from the system linker. If running with the dynamic
compiler, this is equivalent to:
(active SYMBOL (dlsym "SYMBOL"))
If under the static compiler (slink-compile), this will cause future
references to SYMBOL to be resolved at link time rather than
runtime.
(define (slink SYMBOL) EXPRESSION)
Create a region of memory containing the results of EXPRESSION.
SYMBOL is exported to the system linker. Only expressions resulting
in integers, strings, floats, and lambdas currently work.
To get a feel for things, run "make test" which exercises slink both
at runtime and compile time. You'll notice that the results of this
execution are a binary executable (slinktest) with no runtime
dependency on COLA.
IMPLEMENTATION
**************
I did a lot of work creating a bunch of slink-specific methods in the
existing COLA compiler. Now I'm gradually undoing as much of that
work as possible to leave only the core features in Jolt2, so that the
rest can be just another unprivileged application.
Once you understand what the slink syntax does, it shouldn't be too
hard to follow what I needed to do to get things working. A "grep -i
slink *.st" is very informative (and half the reason I needed to find
a catchy name that wouldn't be buried in the other identifiers).
Toplevel Jolt expressions are gathered up and attached to the system's
initialisation functions so that they are executed at program start
(for i386, using the same method as C++ constructors).
The syntax and actives systems will need to be revisited, probably to
do something like Scheme-48 where a "load-syntax" or "require-syntax"
will import only the syntax elements into the namespace (thereby
avoiding problems with importing undesired lambdas and toplevel code
evaluation by accident).
It would be really nice to implement a few more CodeGenerator backends
to bypass assembly language entirely and generate binaries.
Slink has a naive three-region model for assembler output. First
comes a bss section with all the variables, then a data section with
all the strings, then finally a text section with all the compiled
functions. To my knowledge, this is adequate for the platforms on
which COLA already runs, but of course it would be good to be able to
provide something akin to linker scripts in the future to allow much
more flexible layout.
Have fun,
--
Michael FIG <[EMAIL PROTECTED]> //\
http://michael.fig.org/ \//
Generate assembler from Jolt code.
diff -r 531fb2c16da1 function/examples2/slink/README
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/function/examples2/slink/README Wed Apr 23 23:40:24 2008 -0600
@@ -0,0 +1,76 @@
+SLINK 0.2
+*********
+
+Slink is the beginning of a statically-linking compiler extension for
+Jolt2 (think "Static LINK" or "System LINK"). It was partly inspired
+by John Leuner's Common Lisp port of jolt-burg that creates
+relocatable ELF objects. I'm basically attempting to land the same
+kinds of features in COLA proper without changing too much of the
+existing compiler machinery.
+
+It has many limitations, but is a proof-of-concept and will probably
+evolve (the main direction for evolution is to make the changes less
+and less dependent on patching Jolt2's Id sources directly, and
+instead accomplish its features at runtime via slink.k and friends).
+
+The centerpiece of this system is slink-compile, which currently can
+only generate i386 assembly code. The following new syntax is
+introduced:
+
+(define (slink SYMBOL))
+ Import SYMBOL from the system linker. If running with the dynamic
+ compiler, this is equivalent to:
+
+ (active SYMBOL (dlsym "SYMBOL"))
+
+ If under the static compiler (slink-compile), this will cause future
+ references to SYMBOL to be resolved at link time rather than
+ runtime.
+
+(define (slink SYMBOL) EXPRESSION)
+ Create a region of memory containing the results of EXPRESSION.
+ SYMBOL is exported to the system linker. Only expressions resulting
+ in integers, strings, floats, and lambdas currently work.
+
+To get a feel for things, run "make test" which exercises slink both
+at runtime and compile time. You'll notice that the results of this
+execution are a binary executable (slinktest) with no runtime
+dependency on COLA.
+
+IMPLEMENTATION
+**************
+
+I did a lot of work creating a bunch of slink-specific methods in the
+existing COLA compiler. Now I'm gradually undoing as much of that
+work as possible to leave only the core features in Jolt2, so that the
+rest can be just another unprivileged application.
+
+Once you understand what the slink syntax does, it shouldn't be too
+hard to follow what I needed to do to get things working. A "grep -i
+slink *.st" is very informative (and half the reason I needed to find
+a catchy name that wouldn't be buried in the other identifiers).
+
+Toplevel Jolt expressions are gathered up and attached to the system's
+initialisation functions so that they are executed at program start
+(for i386, using the same method as C++ constructors).
+
+The syntax and actives systems will need to be revisited, probably to
+do something like Scheme-48 where a "load-syntax" or "require-syntax"
+will import only the syntax elements into the namespace (thereby
+avoiding problems with importing undesired lambdas and toplevel code
+evaluation by accident).
+
+It would be really nice to implement a few more CodeGenerator backends
+to bypass assembly language entirely and generate binaries.
+
+Slink has a naive three-region model for assembler output. First
+comes a bss section with all the variables, then all the data
+elements, then a text section with all the compiled functions. To my
+knowledge, this is adequate for the platforms on which COLA already
+runs, but of course it would be good to be able to provide something
+akin to linker scripts in the future to allow much more flexible
+layout.
+
+Have fun,
+
+Michael FIG <[EMAIL PROTECTED]>, 2008-04-17
diff -r 531fb2c16da1 function/examples2/slink/main.k
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/function/examples2/slink/main.k Wed Apr 23 23:40:24 2008 -0600
@@ -0,0 +1,26 @@
+(define (slink printf))
+(printf "Hello from constructor\n")
+(define zot 0x123456)
+;;(slink mylist '(1 2 3 "foo" 0.3456))
+(define baz zot)
+(define (slink zot_addr) zot)
+
+(define (slink hello)
+ (lambda (progname argc)
+; FIXME: For when we can import only macros from "syntax.k"
+; (printf "Have an int: 0x%x@(0x%x==0x%x), and a copy [EMAIL PROTECTED]"
+; zot (addrof zot) zot_addr baz (addrof baz))
+ (printf "Have an int: [EMAIL PROTECTED], and a copy 0x%x\n"
+ zot zot_addr baz)
+ (printf "Goodbye, world (%s with %d arguments)!\n" progname argc)))
+
+(define test2
+ (lambda ()
+ (printf "Another test from constructor\n")))
+
+(define (slink main)
+ (lambda (argc argv)
+ (hello (long@ argv) (- argc 1))
+ 0))
+
+(test2)
diff -r 531fb2c16da1 function/examples2/slink/slink.k
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/function/examples2/slink/slink.k Wed Apr 23 23:40:24 2008 -0600
@@ -0,0 +1,46 @@
+(define slink-compile
+ (lambda (path)
+ (let ((pathstr [String value_: path])
+ (filename pathstr)
+ (file [File openIfPresent: filename]))
+ (or file (let ()
+ (set filename [[[Options libdir] , '"/"] , pathstr])
+ (set file [File openIfPresent: filename])))
+ (or file (let ()
+ (set filename [[[Options progdir] , '"/"] , pathstr])
+ (set file [File openIfPresent: filename])))
+ (if file
+ (let ((outname [pathstr , '".s"]))
+ [StdErr nextPutAll: '";; slink-compile "]
+ [StdErr nextPutAll: filename]
+ [StdErr cr]
+
+ (let ((parser [ColaFunctionGrammar parserOn: file])
+ (CodeGenerator (import "CodeGenerator"))
+ (gen [[CodeGenerator default] static])
+ (SlinkEnvironment (import "SlinkEnvironment"))
+ (env [SlinkEnvironment new])
+ (Compiler (import "Compiler"))
+ (CompilerOptions (import "CompilerOptions"))
+ (File (import "File"))
+ (out [File create: outname])
+ (expr 0))
+
+; [CompilerOptions verboseTree: '1]
+ (while (set expr [parser next])
+ [Compiler compile: expr for: gen with: env])
+; [CompilerOptions verboseTree: 0]
+
+ [StdErr nextPutAll: '";; write output to "]
+ [StdErr nextPutAll: outname]
+ [StdErr cr]
+
+ [gen toStream: out]
+ [out close])
+
+ [StdErr nextPutAll: '";; slink-compile is finished"]
+ [StdErr cr])
+ (let ()
+ [StdErr nextPutAll: '";; cannot open "]
+ [StdErr nextPutAll: pathstr]
+ [StdErr cr])))))
diff -r 531fb2c16da1 function/examples2/slink/test.k
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/function/examples2/slink/test.k Wed Apr 23 23:40:24 2008 -0600
@@ -0,0 +1,9 @@
+((define (slink hello) (lambda (msg) (printf "hello %s\n" msg))) "the first time")
+(define zot hello)
+(define (slink zorgar) (let () 42))
+(printf "these should match %x == %x but this %d == 42!\n" hello zot zorgar)
+(hello "the second time")
+(zot "the third time")
+
+(load "main.k")
+(hello "from test.k" 666)
diff -r 531fb2c16da1 function/jolt2/CodeGenerator-arm.st
--- a/function/jolt2/CodeGenerator-arm.st Wed Apr 23 12:20:22 2008 -0600
+++ b/function/jolt2/CodeGenerator-arm.st Wed Apr 23 23:40:24 2008 -0600
@@ -29,9 +29,9 @@
ARMCodeGenerator : CodeGenerator ( tempsSize registerList r0 r1 ip sp lr pc )
-ARMCodeGenerator new
-[
- self := super new.
+ARMCodeGenerator newScope
+[
+ self := super newScope.
tempsSize := 0.
ccrs
add: (r0 := Register withClass: I4 name: 'r0' encoding: 0);
diff -r 531fb2c16da1 function/jolt2/CodeGenerator-i386.st
--- a/function/jolt2/CodeGenerator-i386.st Wed Apr 23 12:20:22 2008 -0600
+++ b/function/jolt2/CodeGenerator-i386.st Wed Apr 23 23:40:24 2008 -0600
@@ -29,9 +29,9 @@
Intel32CodeGenerator : CodeGenerator ( tempsSize eax ecx edx ebx esp ebp esi edi cx cl )
-Intel32CodeGenerator new
-[
- self := super new.
+Intel32CodeGenerator newScope
+[
+ self := super newScope.
tempsSize := 0.
ccrs
add: (eax := Register withClass: I4 name: '%eax' encoding: 0x40);
@@ -153,62 +153,123 @@ Intel32CodeGenerator emit: call argument
"----------------------------------------------------------------"
-StaticIntel32CodeGenerator : Intel32CodeGenerator ()
-
-StaticIntel32CodeGenerator addrgp4 :d :v [ StdOut nextPutAll: ' movl '; nextPut: $$; print: v; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator addrjp4 :d :l [ StdOut nextPutAll: ' movl $L'; print: l ordinal; nextPut: $,; print: d; cr ]
-
-StaticIntel32CodeGenerator addlI: i R: d [ StdOut nextPutAll: ' addl '; nextPut: $$; print: i; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator addlI_: i R: d [ StdOut nextPutAll: ' addl '; nextPut: $$; print: (SmallInteger value_: i); nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator addlR: s R: d [ StdOut nextPutAll: ' addl '; print: s; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator andlR: s R: d [ StdOut nextPutAll: ' andl '; print: s; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator callMb: b [ StdOut nextPutAll: ' call ('; print: b; nextPutAll: ')\n' ]
-StaticIntel32CodeGenerator cltd [ StdOut nextPutAll: ' cltd\n' ]
-StaticIntel32CodeGenerator cmplI: i R: d [ StdOut nextPutAll: ' cmpl '; nextPut: $$; print: i; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator cmplI_: i Md: d b: b [ StdOut nextPutAll: ' cmpl '; nextPut: $$; print: (SmallInteger value_: i); nextPut: $,; print: d; nextPut: $(; print: b; nextPut: $); cr]
-StaticIntel32CodeGenerator cmplR: s R: d [ StdOut nextPutAll: ' cmpl '; print: s; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator define: l [ StdOut nextPutAll: 'L'; print: l ordinal; nextPut: $:; cr ]
-StaticIntel32CodeGenerator idivlR: s [ StdOut nextPutAll: ' idivl '; print: s; cr ]
-StaticIntel32CodeGenerator imullR: s R: d [ StdOut nextPutAll: ' imull '; print: s; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator jeL: l [ StdOut nextPutAll: ' je L'; print: l ordinal; cr ]
-StaticIntel32CodeGenerator jgeL: l [ StdOut nextPutAll: ' jge L'; print: l ordinal; cr ]
-StaticIntel32CodeGenerator jmpL: l [ StdOut nextPutAll: ' jmp L'; print: l ordinal; cr ]
-StaticIntel32CodeGenerator jmpMb: b [ StdOut nextPutAll: ' jmp *'; print: b; cr ]
-StaticIntel32CodeGenerator jneL: l [ StdOut nextPutAll: ' jne L'; print: l ordinal; cr ]
-StaticIntel32CodeGenerator lealMd: d b: b R: r [ StdOut nextPutAll: ' leal '; print: d; nextPut: $(; print: b; nextPutAll: '),'; print: r; cr]
-StaticIntel32CodeGenerator lealMd_: d b: b R: r [ StdOut nextPutAll: ' leal '; print: (SmallInteger value_: d); nextPut: $(; print: b; nextPutAll: '),'; print: r; cr]
-StaticIntel32CodeGenerator movbR: r Mb: b [ StdOut nextPutAll: ' movb '; print: r; nextPutAll: ',('; print: b; nextPut: $); cr ]
-StaticIntel32CodeGenerator movlI_: i R: d [ StdOut nextPutAll: ' movl '; nextPut: $$; print: (SmallInteger value_: i); nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator movlMb: b R: r [ StdOut nextPutAll: ' movl ('; print: b; nextPutAll: '),'; print: r; cr]
-StaticIntel32CodeGenerator movlMd: d b: b R: r [ StdOut nextPutAll: ' movl '; print: d; nextPut: $(; print: b; nextPutAll: '),'; print: r; cr]
-StaticIntel32CodeGenerator movlMd_: d R: r [ StdOut nextPutAll: ' movl '; print: (SmallInteger value_: d); nextPut: $,; print: r; cr ]
-StaticIntel32CodeGenerator movlR: r Mb: b [ StdOut nextPutAll: ' movl '; print: r; nextPutAll: ',('; print: b; nextPut: $); cr ]
-StaticIntel32CodeGenerator movlR: s Md: d b: b [ StdOut nextPutAll: ' movl '; print: s; nextPut: $,; print: d; nextPut: $(; print: b; nextPut: $); cr]
-StaticIntel32CodeGenerator movlR: s R: d [ s == d ifFalse: [StdOut nextPutAll: ' movl '; print: s; nextPut: $,; print: d; cr] ]
-StaticIntel32CodeGenerator movsblMb: s R: d [ StdOut nextPutAll: ' movsbl ('; print: s; nextPutAll: '),'; print: d; cr ]
-StaticIntel32CodeGenerator movswlMb: s R: d [ StdOut nextPutAll: ' movswl ('; print: s; nextPutAll: '),'; print: d; cr ]
-StaticIntel32CodeGenerator movwR: r Mb: b [ StdOut nextPutAll: ' movw '; print: r; nextPutAll: ',('; print: b; nextPut: $); cr ]
-StaticIntel32CodeGenerator neglR: d [ StdOut nextPutAll: ' negl '; print: d; cr ]
-StaticIntel32CodeGenerator notlR: d [ StdOut nextPutAll: ' notl '; print: d; cr ]
-StaticIntel32CodeGenerator orlR: s R: d [ StdOut nextPutAll: ' orl '; print: s; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator poplR: d [ StdOut nextPutAll: ' popl '; print: d; cr ]
-StaticIntel32CodeGenerator pushlR: s [ StdOut nextPutAll: ' pushl '; print: s; cr ]
-StaticIntel32CodeGenerator ret [ StdOut nextPutAll: ' ret\n' ]
-StaticIntel32CodeGenerator sallR: s R: d [ StdOut nextPutAll: ' sall '; print: s; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator sarlR: s R: d [ StdOut nextPutAll: ' sarl '; print: s; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator seteR: d [ StdOut nextPutAll: ' sete '; print: d; cr ]
-StaticIntel32CodeGenerator setgR: d [ StdOut nextPutAll: ' setg '; print: d; cr ]
-StaticIntel32CodeGenerator setgeR: d [ StdOut nextPutAll: ' setge '; print: d; cr ]
-StaticIntel32CodeGenerator setlR: d [ StdOut nextPutAll: ' setl '; print: d; cr ]
-StaticIntel32CodeGenerator setleR: d [ StdOut nextPutAll: ' setle '; print: d; cr ]
-StaticIntel32CodeGenerator setneR: d [ StdOut nextPutAll: ' setne '; print: d; cr ]
-StaticIntel32CodeGenerator shllR: s R: d [ StdOut nextPutAll: ' shll '; print: s; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator shrlR: s R: d [ StdOut nextPutAll: ' shrl '; print: s; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator sublI: i R: d [ StdOut nextPutAll: ' subl '; nextPut: $$; print: i; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator sublI_: i R: d [ StdOut nextPutAll: ' subl '; nextPut: $$; print: (SmallInteger value_: i); nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator sublR: s R: d [ StdOut nextPutAll: ' subl '; print: s; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator testlR: s R: d [ StdOut nextPutAll: ' testl '; print: s; nextPut: $,; print: d; cr ]
-StaticIntel32CodeGenerator xorlR: s R: d [ StdOut nextPutAll: ' xorl '; print: s; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator : Intel32CodeGenerator (bss data text ctor lambdas extern)
+StaticIntel32CodeGenerator new
+[
+ self := super new.
+ bss := IdentitySet new.
+ data := WriteStream on: (String new: 8192).
+ ctor := WriteStream on: (String new: 8192).
+ lambdas := WriteStream on: (String new: 8192).
+ text := ctor.
+]
+
+StaticIntel32CodeGenerator newScope
+[
+ | newGen saveBss saveData saveCtor saveLambdas saveText |
+ saveBss := bss.
+ saveData := data.
+ saveCtor := ctor.
+ saveLambdas := lambdas.
+ saveText := text.
+ self := super newScope.
+ bss := saveBss.
+ data := saveData.
+ ctor := saveCtor.
+ lambdas := saveLambdas.
+ text := saveText.
+]
+
+StaticIntel32CodeGenerator toStream: out
+[
+ | hdr dataPfx ctorPtr label textPfx ctorPfx ctorSfx |
+ hdr := '# Generated by COLA ', self versionString, '\n'.
+
+ dataPfx := data position == 0 ifTrue: [''] ifFalse: ['\t.data\n'].
+ textPfx := (ctor position + lambdas position) == 0 ifTrue: [''] ifFalse: ['\n\t.text\n'].
+
+ ctor position == 0
+ ifTrue: [ctorPtr := ''. ctorPfx := ''. ctorSfx := '']
+ ifFalse: [ label := 'L', Label new ordinal asString.
+ ctorPtr := '\n\t.section .ctors\n\t.long ', label, '\n'.
+ ctorPfx := label, ':\n'.
+ ctorSfx := '\tret\n'].
+
+ out nextPutAll: hdr.
+ bss do: [:elt | out nextPutAll: '\t.lcomm '; nextPutAll: elt asString; nextPutAll: ', 4'; cr].
+
+ out nextPutAll: dataPfx.
+ out nextPutAll: (String size: data position value_: data collection _stringValue).
+
+ out nextPutAll: ctorPtr.
+
+ out nextPutAll: textPfx.
+
+ out nextPutAll: ctorPfx.
+ out nextPutAll: (String size: ctor position value_: ctor collection _stringValue).
+ out nextPutAll: ctorSfx.
+
+ out nextPutAll: (String size: lambdas position value_: lambdas collection _stringValue).
+]
+
+StaticIntel32CodeGenerator define: l
+[
+ text == ctor ifFalse: [text nextPutAll: 'L'; print: l ordinal; nextPut: $:; cr]
+]
+
+StaticIntel32CodeGenerator addrgp4 :d :v [ text nextPutAll: ' movl $'; print: v; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator addlI: i R: d [ text nextPutAll: ' addl '; nextPut: $$; print: i; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator addlI_: i R: d [ text nextPutAll: ' addl '; nextPut: $$; print: (SmallInteger value_: i); nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator addlR: s R: d [ text nextPutAll: ' addl '; print: s; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator andlR: s R: d [ text nextPutAll: ' andl '; print: s; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator callMb: b [ text nextPutAll: ' call *'; print: b; cr ]
+StaticIntel32CodeGenerator cltd [ text nextPutAll: ' cltd'; cr ]
+StaticIntel32CodeGenerator cmplI: i R: d [ text nextPutAll: ' cmpl '; nextPut: $$; print: i; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator cmplI_: i Md: d b: b [ text nextPutAll: ' cmpl '; nextPut: $$; print: (SmallInteger value_: i); nextPut: $,; print: d; nextPut: $(; print: b; nextPut: $); cr]
+StaticIntel32CodeGenerator cmplR: s R: d [ text nextPutAll: ' cmpl '; print: s; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator idivlR: s [ text nextPutAll: ' idivl '; print: s; cr ]
+StaticIntel32CodeGenerator imullR: s R: d [ text nextPutAll: ' imull '; print: s; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator jeL: l [ text nextPutAll: ' je L'; print: l ordinal; cr ]
+StaticIntel32CodeGenerator jgeL: l [ text nextPutAll: ' jge L'; print: l ordinal; cr ]
+StaticIntel32CodeGenerator jmpL: l [ text nextPutAll: ' jmp L'; print: l ordinal; cr ]
+StaticIntel32CodeGenerator jmpMb: b [ text nextPutAll: ' jmp *'; print: b; cr ]
+StaticIntel32CodeGenerator jneL: l [ text nextPutAll: ' jne L'; print: l ordinal; cr ]
+StaticIntel32CodeGenerator lealMd: d b: b R: r [ text nextPutAll: ' leal '; print: d; nextPut: $(; print: b; nextPutAll: '),'; print: r; cr]
+StaticIntel32CodeGenerator lealMd_: d b: b R: r [ text nextPutAll: ' leal '; print: (SmallInteger value_: d); nextPut: $(; print: b; nextPutAll: '),'; print: r; cr]
+StaticIntel32CodeGenerator lealS: s R: r [ text nextPutAll: ' leal '; nextPutAll: s; nextPut: $,; print: r; cr]
+StaticIntel32CodeGenerator movbR: r Mb: b [ text nextPutAll: ' movb '; print: r; nextPutAll: ',('; print: b; nextPut: $); cr ]
+StaticIntel32CodeGenerator movlI_: i R: d [ text nextPutAll: ' movl '; nextPut: $$; print: (SmallInteger value_: i); nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator movlMb: b R: r [ text nextPutAll: ' movl ('; print: b; nextPutAll: '),'; print: r; cr]
+StaticIntel32CodeGenerator movlMd: d b: b R: r [ text nextPutAll: ' movl '; print: d; nextPut: $(; print: b; nextPutAll: '),'; print: r; cr]
+StaticIntel32CodeGenerator movlMd_: d R: r [ text nextPutAll: ' movl '; print: (SmallInteger value_: d); nextPut: $,; print: r; cr ]
+StaticIntel32CodeGenerator movlR: r Mb: b [ text nextPutAll: ' movl '; print: r; nextPutAll: ',('; print: b; nextPut: $); cr ]
+StaticIntel32CodeGenerator movlR: s Md: d b: b [ text nextPutAll: ' movl '; print: s; nextPut: $,; print: d; nextPut: $(; print: b; nextPut: $); cr]
+StaticIntel32CodeGenerator movlR: s R: d [ s == d ifFalse: [text nextPutAll: ' movl '; print: s; nextPut: $,; print: d; cr] ]
+StaticIntel32CodeGenerator movlS: s R: d [ text nextPutAll: ' movl '; nextPutAll: s; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator movsblMb: s R: d [ text nextPutAll: ' movsbl ('; print: s; nextPutAll: '),'; print: d; cr ]
+StaticIntel32CodeGenerator movswlMb: s R: d [ text nextPutAll: ' movswl ('; print: s; nextPutAll: '),'; print: d; cr ]
+StaticIntel32CodeGenerator movwR: r Mb: b [ text nextPutAll: ' movw '; print: r; nextPutAll: ',('; print: b; nextPut: $); cr ]
+StaticIntel32CodeGenerator neglR: d [ text nextPutAll: ' negl '; print: d; cr ]
+StaticIntel32CodeGenerator notlR: d [ text nextPutAll: ' notl '; print: d; cr ]
+StaticIntel32CodeGenerator orlR: s R: d [ text nextPutAll: ' orl '; print: s; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator poplR: d [ text nextPutAll: ' popl '; print: d; cr ]
+StaticIntel32CodeGenerator pushlR: s [ text nextPutAll: ' pushl '; print: s; cr ]
+StaticIntel32CodeGenerator ret [ text == ctor ifFalse: [text nextPutAll: ' ret'; cr] ]
+StaticIntel32CodeGenerator sallR: s R: d [ text nextPutAll: ' sall '; print: s; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator sarlR: s R: d [ text nextPutAll: ' sarl '; print: s; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator seteR: d [ text nextPutAll: ' sete '; print: d; cr ]
+StaticIntel32CodeGenerator setgR: d [ text nextPutAll: ' setg '; print: d; cr ]
+StaticIntel32CodeGenerator setgeR: d [ text nextPutAll: ' setge '; print: d; cr ]
+StaticIntel32CodeGenerator setlR: d [ text nextPutAll: ' setl '; print: d; cr ]
+StaticIntel32CodeGenerator setleR: d [ text nextPutAll: ' setle '; print: d; cr ]
+StaticIntel32CodeGenerator setneR: d [ text nextPutAll: ' setne '; print: d; cr ]
+StaticIntel32CodeGenerator shllR: s R: d [ text nextPutAll: ' shll '; print: s; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator shrlR: s R: d [ text nextPutAll: ' shrl '; print: s; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator sublI: i R: d [ text nextPutAll: ' subl '; nextPut: $$; print: i; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator sublI_: i R: d [ text nextPutAll: ' subl '; nextPut: $$; print: (SmallInteger value_: i); nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator sublR: s R: d [ text nextPutAll: ' subl '; print: s; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator testlR: s R: d [ text nextPutAll: ' testl '; print: s; nextPut: $,; print: d; cr ]
+StaticIntel32CodeGenerator xorlR: s R: d [ text nextPutAll: ' xorl '; print: s; nextPut: $,; print: d; cr ]
Intel32CodeGenerator spilli4: reg to: tmp [ self movlR: reg Md: tmp offset b: esp ]
Intel32CodeGenerator reloadi4: reg from: tmp [ self movlMd: tmp offset b: esp R: reg ]
@@ -299,7 +360,7 @@ CodeGenerator versionString [ ^self defa
CodeGenerator default [ ^Intel32CodeGenerator ]
-Intel32CodeGenerator static [ ^StaticIntel32CodeGenerator ]
+Intel32CodeGenerator static [ ^StaticIntel32CodeGenerator new ]
Intel32CodeGenerator dynamic [ ^DynamicIntel32CodeGenerator ]
Intel32CodeGenerator versionString
@@ -315,15 +376,63 @@ CodeGenerator isDynamic [ ^false ]
CodeGenerator isDynamic [ ^false ]
DynamicIntel32CodeGenerator isDynamic [ ^true ]
-StaticIntel32CodeGenerator defineVariable: name
-[
- StdOut nextPutAll: ' .data\n'.
- StdOut nextPutAll: name; nextPutAll: ': .long _'; nextPutAll: name; cr.
- StdOut nextPutAll: ' .text\n'.
-]
-
-DynamicIntel32CodeGenerator defineVariable: name
-[
+StaticIntel32CodeGenerator slinkName: name
+[
+ | uscore |
+ {
+#if defined(__MACH__) || defined(__CYGWIN__) || defined(__WIN32__)
+ v_uscore = 1;
+#endif
+ }.
+ ^uscore ifTrue: ['_', name] ifFalse: [name]
+]
+
+StaticIntel32CodeGenerator slinkVariable: name [ bss add: name ]
+StaticIntel32CodeGenerator slinkImport: name []
+StaticIntel32CodeGenerator slinkExport: name translate: aForm with: aCompiler
+[
+ | ext result |
+ extern := self slinkName: name.
+ result := aForm translate: aCompiler.
+ (extern and: [result name == #slink or: [result name == #slinki]])
+ ifTrue: [data nextPutAll: '\n\t.globl '; nextPutAll: extern; cr;
+ nextPutAll: '\t.set '; nextPutAll: extern; nextPut: $,; nextPutAll: result arg; cr.
+ extern := nil].
+ ^nil
+]
+
+StaticIntel32CodeGenerator compileLambda: form with: aCompiler
+[
+ | save label |
+ save := text.
+ text == ctor ifTrue: [text := lambdas].
+ extern ifTrue: [ text cr; nextPutAll: '\t.globl '; nextPutAll: extern; cr;
+ nextPutAll: extern; nextPut: $:; cr.
+ extern := nil ].
+ label := aCompiler compileLambda: form.
+ text := save.
+ ^SLINK new arg: ('L', label ordinal asString)
+]
+
+StaticIntel32CodeGenerator translateData_: _bytes length: aLength
+[
+ | name comma s |
+ extern
+ ifTrue: [ name := extern.
+ data cr; nextPutAll: '\t.globl '; nextPutAll: name; cr.
+ extern := nil ]
+ ifFalse: [ name := 'L', (Label new ordinal asString) ].
+
+ s := String size: aLength value_: _bytes.
+ data nextPutAll: name; nextPut: $:.
+ 0 to: aLength - 1 do:
+ [:i | i \\ 8 == 0 ifTrue: [data cr; nextPutAll: '\t.byte '. comma := ''].
+ data nextPutAll: comma; nextPutAll: '0x'; print_x: (s at: i) _integerValue.
+ comma := ', '
+ ].
+ data cr.
+
+ ^SLINK new arg: name
]
"----------------------------------------------------------------"
@@ -353,6 +462,8 @@ Intel32Grammar := [
at: #VOID add: #(label ) do: [:op :gen | gen define: op ];
at: #REG add: #(cnsti4 ) do: [:op :gen | gen movlI_: op arg R: op output ];
at: #REG add: #(cnstp4 ) do: [:op :gen | gen movlI_: op arg R: op output ];
+ at: #REG add: #(slink ) do: [:op :gen | gen lealS: op arg R: op output ];
+ at: #REG add: #(slinki ) do: [:op :gen | gen movlS: op arg R: op output ];
at: #REG add: #(parami4 ) do: [:op :gen | ];
at: #REG add: #(addrfp4 ) do: [:op :gen | gen movlR: gen ebp R: op output ];
at: #REG add: #(addrgp4 ) do: [:op :gen | gen movlI_: op arg _address R: op output ];
@@ -367,7 +478,7 @@ Intel32Grammar := [
movlR: gen ecx R: op output ];
at: #REG add: #(comi4 REG ) do: [:op :gen | gen notlR: op output ];
at: #REG add: #(negi4 REG ) do: [:op :gen | gen neglR: op output ];
- at: #REG add: #(calli4 REG ) do: [:op :gen | gen calli4: op ];
+ at: #REG add: #(calli4 REG ) do: [:op :gen | gen calli4: op];
at: #REG add: #(asgni1 REG REG) do: [:op :gen | gen movlR: op lhs output R: gen ecx;
movbR: gen cl Mb: op rhs output ];
at: #REG add: #(asgni2 REG REG) do: [:op :gen | gen movlR: op lhs output R: gen ecx;
@@ -452,7 +563,7 @@ StaticIntel32CodeGenerator generate: tre
StaticIntel32CodeGenerator generate: tree
[
self finaliseFrame.
- tree printOn: StdOut indent: 0. StdOut cr.
+ "tree printOn: StdOut indent: 0. StdOut cr."
tree generate: self.
^Array with: 0 with: 0.
]
diff -r 531fb2c16da1 function/jolt2/CodeGenerator-ppc.st
--- a/function/jolt2/CodeGenerator-ppc.st Wed Apr 23 12:20:22 2008 -0600
+++ b/function/jolt2/CodeGenerator-ppc.st Wed Apr 23 23:40:24 2008 -0600
@@ -39,9 +39,9 @@ PowerPCRegister location [ ^location ]
PowerPCCodeGenerator : CodeGenerator ( r0 r1 r2 r3 r11 r12 )
-PowerPCCodeGenerator new
-[
- self := super new.
+PowerPCCodeGenerator newScope
+[
+ self := super newScope.
r0 := PowerPCRegister withClass: I4 name: 'r0' encoding: 0.
r1 := PowerPCRegister withClass: I4 name: 'r1' encoding: 1.
r2 := PowerPCRegister withClass: I4 name: 'r2' encoding: 2.
diff -r 531fb2c16da1 function/jolt2/CodeGenerator.st
--- a/function/jolt2/CodeGenerator.st Wed Apr 23 12:20:22 2008 -0600
+++ b/function/jolt2/CodeGenerator.st Wed Apr 23 23:40:24 2008 -0600
@@ -28,11 +28,16 @@ CodeGenerator : Object ( ccrs csrs spill
CodeGenerator withLabels: labelCollection
[
- self := self new.
+ self := self newScope.
labels := labelCollection.
]
CodeGenerator new
+[
+ self := self newScope
+]
+
+CodeGenerator newScope
[
self := super new.
ccrs := RegisterSet new.
@@ -111,6 +116,36 @@ CodeGenerator relocateLabels_: _addr
labels do: [:label | label relocate_: _addr]
]
+CodeGenerator slinkVariable: name []
+CodeGenerator slinkImport: name [^name _dlsym]
+CodeGenerator slinkExport: name translate: aForm with: aCompiler
+[
+ | entry value |
+ aForm isSymbol ifTrue: [aForm := Expression with: #addrof with: aForm].
+ entry := aCompiler compile: aForm.
+ value := entry call.
+ entry free.
+ ^value
+]
+
+CodeGenerator compileLambda: form with: aCompiler
+[
+ ^ADDRJP4 new arg: (aCompiler compileLambda: form)
+]
+
+CodeGenerator translateData_: _bytes length: aLength
+[
+ | _mem |
+ {
+ size_t size= ((long)v_aLength) >> 1;
+ char *mem= malloc(size + 1);
+ memcpy(mem, v__bytes, size);
+ mem[size]= '\0';
+ v__mem= (oop)mem;
+ }.
+ ^CNSTP4 new arg: _mem
+]
+
CodeGenerator enter :e [ self emitPrologue ]
CodeGenerator parami4 :s []
CodeGenerator drop :s []
diff -r 531fb2c16da1 function/jolt2/Compiler.st
--- a/function/jolt2/Compiler.st Wed Apr 23 12:20:22 2008 -0600
+++ b/function/jolt2/Compiler.st Wed Apr 23 23:40:24 2008 -0600
@@ -37,6 +37,7 @@ Variable withName: nameSymbol
]
Variable translateRvalue: compiler [ ^INDIRI4 new lhs: (self translateLvalue: compiler) ]
+Variable name [ ^name ]
GlobalVariable : Variable ( _storage )
@@ -61,6 +62,30 @@ GlobalVariable translateLvalue: compiler
GlobalVariable printOn: aStream [ aStream print: name; nextPut: $=; print_x: _storage ]
+
+SlinkConstant : Variable ()
+
+SlinkConstant translateLvalue: compiler
+[
+ compiler error: 'cannot write: ', name.
+]
+SlinkConstant translateRvalue: compiler
+[
+ ^SLINK new arg: name asString
+]
+
+SlinkVariable : Variable ()
+
+SlinkVariable translateLvalue: compiler
+[
+ ^SLINK new arg: name asString
+]
+SlinkVariable translateRvalue: compiler
+[
+ ^SLINKI new arg: name asString
+]
+
+SlinkVariable printOn: aStream [ aStream print: name ]
LocalVariable : Variable ( location )
@@ -115,6 +140,8 @@ Environment : SlotDictionary ( syntax ac
Environment new [ ^super basicNew ]
+Environment isGlobal [ ^false ]
+
Environment lookupVariable: name [ ^(active ifTrue: [active at: name ifAbsent: []]) ifNil: [self at: name ifAbsent: []] ]
Environment lookupSyntax: name [ ^ syntax ifTrue: [syntax at: name ifAbsent: []] ]
@@ -132,9 +159,16 @@ Environment defineActive: name
GlobalEnvironment : Environment ()
+GlobalEnvironment isGlobal [ ^true ]
GlobalEnvironment defineVariable: name [ ^self at: name put: (GlobalVariable withName: name) ]
GlobalEnvironment defineVariable: name value_: _value [ ^self at: name put: (GlobalVariable withName: name value_: _value) ]
-
+GlobalEnvironment defineSlink: name value_: _value [ ^self defineVariable: name value_: _value ]
+
+SlinkEnvironment : Environment ()
+
+SlinkEnvironment isGlobal [ ^true ]
+SlinkEnvironment defineVariable: name [ ^self at: name put: (SlinkVariable withName: name) ]
+SlinkEnvironment defineSlink: name value_: _value [ ^self at: name put: (SlinkConstant withName: name) ]
LocalEnvironment : Environment ( parent )
@@ -151,6 +185,7 @@ LocalEnvironment lookupSyntax: name [ ^(
LocalEnvironment defineVariable: name [ ^self at: name put: (LocalVariable withName: name) ]
LocalEnvironment defineParameter: name [ ^self at: name put: (ParameterVariable withName: name) ]
+LocalEnvironment defineSlink: name value_: _value [ ^parent defineSlink: name value_: _value ]
TheGlobalEnvironment := [ GlobalEnvironment new ]
@@ -171,10 +206,10 @@ Symbol _dlsym_: _string { _return (oop)_
Compiler : Object ( environment allLabels generatorType breaks continues postProcessors labels )
-Compiler withGeneratorType: genType
+Compiler withGeneratorType: genType withEnvironment: theEnv
[
self := super new.
- environment := TheGlobalEnvironment.
+ environment := theEnv.
allLabels := OrderedCollection new.
generatorType := genType.
breaks := OrderedCollection new.
@@ -204,6 +239,7 @@ Compiler lookupVariable: name
Compiler defineActive: name [ ^environment defineActive: name ]
Compiler defineVariable: name [ ^environment defineVariable: name ]
+Compiler defineSlink: name value_: _value [ ^environment defineSlink: name value_: _value ]
Compiler defineParameter: name [ ^environment defineParameter: name ]
Compiler defineSyntax: name [ ^environment defineSyntax: name ]
@@ -262,7 +298,7 @@ SyntaxTable := [
at: #return put: #xReturn:;
at: #label put: #xLabel:;
at: #goto put: #xGoto:;
- at: #extern put: #xExtern:;
+ at: #'define-slink' put: #xDefineSlink:;
yourself
]
@@ -282,12 +318,12 @@ Compiler translateInteger: anInteger
Compiler translateFloat: aFloat
[
- ^CNSTP4 new arg: aFloat
+ ^generatorType translateData_: aFloat length: (SmallInteger value_: aFloat _sizeof)
]
Compiler translateString: aString
[
- ^CNSTP4 new arg: aString _strdup
+ ^generatorType translateData_: aString _stringValue length: aString size + 1
]
Compiler translateSymbol: aSymbol
@@ -628,7 +664,7 @@ Compiler xQuote: expr
Compiler xQuote: expr
[
| literal |
- expr size == 2 ifFalse: [self errorAgumentCount: expr].
+ expr size == 2 ifFalse: [self errorArgumentCount: expr].
literal := expr second.
(literal isSmallInteger or: [literal isNil]) ifFalse: [CompilerLiterals addLast: literal].
^CNSTP4 new arg: literal
@@ -671,7 +707,7 @@ Compiler defineVariable: name from: form
[
| var value |
(form size <= 3) ifFalse: [self errorSyntax: form].
- var := self lookupVariable: name ifAbsent: [self defineVariable: name].
+ var := self lookupVariable: name ifAbsent: [generatorType slinkVariable: name. self defineVariable: name].
value := form size == 3
ifTrue: [form third translate: self]
ifFalse: [CNSTI4 new arg: nil].
@@ -680,7 +716,7 @@ Compiler defineVariable: name from: form
^ASGNI4 new lhs: value; rhs: (var translateLvalue: self).
]
-Compiler defineAccessor: accessor from: expr "(define (foo bar...) baz) -> (set-foo bar... baz)"
+Compiler defineAccessor: accessor from: expr "(define (foo bar...) baz) -> (define-foo bar... baz)"
[
| setter syntax |
(accessor isArray and: [accessor size > 0 and: [accessor first isSymbol]]) ifFalse: [self errorSyntax: accessor].
@@ -830,13 +866,15 @@ Compiler xLet: form
Compiler xLambda: form
[
- ^ADDRJP4 new arg: (self compileLambda: form)
+ ^generatorType compileLambda: form with: self
]
Compiler compileLambda: form
[
- | block entry last gen stats |
- self := self withGeneratorType: generatorType.
+ | block entry last gen stats topEnv |
+ topEnv := environment.
+ [ topEnv isGlobal not ] whileTrue: [ topEnv := topEnv parent ].
+ self := self withGeneratorType: generatorType withEnvironment: topEnv.
(block := Block new)
scope: self beginScope;
add: (entry := self newLabel);
@@ -889,14 +927,16 @@ Compiler xGoto: form
^BRA new destination: label
]
-Compiler xExtern: form
-[
- | name var |
- (form size == 2 and: [(name := form second) isSymbol]) ifFalse: [self errorSyntax: form].
- var := self lookupVariable: name ifAbsent: [self defineVariable: name].
- var value_: name _dlsym.
- generatorType defineVariable: name.
- ^CNSTP4 new arg: var _value
+"(define-slink SYMBOL): Import SYMBOL from the system linker
+ (define-slink SYMBOL EXPRESSION): Export SYMBOL to the system linker, with value EXPRESSION"
+Compiler xDefineSlink: form
+[
+ | name addr |
+ (form size <= 3 and: [(name := form second) isSymbol]) ifFalse: [self errorSyntax: form].
+ form size == 2
+ ifTrue: [ addr := generatorType slinkImport: name ]
+ ifFalse: [ addr := generatorType slinkExport: name translate: form third with: self ].
+ ^(self defineSlink: name value_: addr) translateRvalue: self.
]
Compiler xCompile: form
@@ -952,10 +992,15 @@ Compiler postProcess: aFunction [ pos
"----------------------------------------------------------------"
-Compiler compile: anObject for: codeGeneratorType
+Compiler compile: anObject
+[
+ ^self compile: anObject for: generatorType with: environment
+]
+
+Compiler compile: anObject for: codeGeneratorType with: anEnvironment
[
| block entry tree gen |
- self := self withGeneratorType: codeGeneratorType.
+ self := self withGeneratorType: codeGeneratorType withEnvironment: anEnvironment.
(block := Block new)
add: (entry := self newLabel);
add: ENTER new.
@@ -981,7 +1026,12 @@ Compiler compile: anObject for: codeGene
Object compile
[
- Compiler compile: self for: CodeGenerator default static
+ ^self compileWith: SlinkEnvironment new
+]
+
+Object compileWith: anEnvironment
+[
+ Compiler compile: self for: CodeGenerator default static with: anEnvironment
]
Object eval
@@ -993,7 +1043,7 @@ Object _eval
[
| entry value |
CompilerOptions verboseList ifTrue: [self compile].
- entry := Compiler compile: self for: CodeGenerator default dynamic.
+ entry := Compiler compile: self for: CodeGenerator default dynamic with: TheGlobalEnvironment.
value := entry call.
entry free.
^value
diff -r 531fb2c16da1 function/jolt2/Instruction.st
--- a/function/jolt2/Instruction.st Wed Apr 23 12:20:22 2008 -0600
+++ b/function/jolt2/Instruction.st Wed Apr 23 23:40:24 2008 -0600
@@ -511,6 +511,8 @@ INDIRI2 : Unary () INDIRI2 name [ ^#ind
INDIRI2 : Unary () INDIRI2 name [ ^#indiri2 ]
INDIRI4 : Unary () INDIRI4 name [ ^#indiri4 ]
LEI4 : Binary () LEI4 name [ ^#lei4 ]
+SLINK : Leaf () SLINK name [ ^#slink ]
+SLINKI : Leaf () SLINKI name [ ^#slinki ]
LTI4 : Binary () LTI4 name [ ^#lti4 ]
MODI4 : Binary () MODI4 name [ ^#modi4 ]
MULI4 : Binary () MULI4 name [ ^#muli4 ]
diff -r 531fb2c16da1 function/jolt2/boot.k
--- a/function/jolt2/boot.k Wed Apr 23 12:20:22 2008 -0600
+++ b/function/jolt2/boot.k Wed Apr 23 23:40:24 2008 -0600
@@ -157,6 +157,7 @@
(lambda (path)
(let ((file [File openIfPresent: [String value_: path]]))
(or file (set file [File openIfPresent: [[[Options libdir] , '"/"] , [String value_: path]]]))
+ (or file (set file [File openIfPresent: [[[Options progdir] , '"/"] , [String value_: path]]]))
(if file
(let ()
(herald path)
@@ -194,7 +195,7 @@
;; Add features that aren't present in the original grammar.
(define ColaFunctionGrammar (import "ColaFunctionGrammar"))
(define Integer (import "Integer"))
-['{
+(define new-grammar '{
// Add character literals ($CHAR)
atom = number | charLiteral | identifier | string
charLiteral = '$' char->0 <- [self @ '0]
@@ -217,7 +218,10 @@
;
EXTENDS: ColaFunctionGrammar // Import from the default grammar.
expression // Start term
- } name: 'JoltBurgCompatibleFunctionGrammar]
+ })
+
+[new-grammar name: 'ColaFunctionGrammar]
+(export "ColaFunctionGrammar" new-grammar)
(load "syntax.k")
(load "debug.k")
diff -r 531fb2c16da1 function/objects/File.st
--- a/function/objects/File.st Wed Apr 23 12:20:22 2008 -0600
+++ b/function/objects/File.st Wed Apr 23 23:40:24 2008 -0600
@@ -22,6 +22,8 @@
{ include "tag.h" }
+{ include <errno.h> }
+
File : Object ( _fd name )
File isFile [ ^true ]
@@ -54,6 +56,7 @@ File println: anObject [ self print:
File println: anObject [ self print: anObject; cr ]
File print: aNumber base: base [ aNumber printOn: self base: base ]
File print: aNumber base: base width: width [ aNumber printOn: self base: base width: width ]
+File print_x: o [ self print: (Integer value_: o) base: 16 ]
File cr [ self nextPut: $\n ]
File cr: n [ n timesRepeat: [self cr] ]
File space [ self nextPut: $ ]
@@ -77,15 +80,23 @@ File next: size putAll: aString
| _bytes _size |
_bytes := aString _bytes.
_size := size _integerValue.
- { _return _O(write((int)self->v__fd, (void *)v__bytes, (size_t)v__size)); }.
-]
-
-File print_x: _pointer
-{
- char buf[1024];
- int size= sprintf(buf, "%x", (int)v__pointer);
- _return _O(write((int)self->v__fd, (void *)buf, (size_t)size));
-}
+ {
+ size_t position= 0;
+ size_t remaining= (size_t)v__size;
+ while (remaining)
+ {
+ int count= write((int)self->v__fd, ((char *)v__bytes) + position, remaining);
+ if (count >= 0)
+ {
+ position += count;
+ remaining -= count;
+ }
+ else if (errno != EINTR)
+ break;
+ }
+ _return _O(position);
+ }
+]
File read: aCollection [ ^self read: aCollection size: aCollection size ]
File read: aCollection size: size [ ^self read: aCollection at: 0 size: size ]
_______________________________________________
fonc mailing list
fonc@vpri.org
http://vpri.org/mailman/listinfo/fonc
