Merge branch 'libc-init'

sandy-slin · Mar 1, 2012 · d44323a · d44323a
2 parents ed33817 + 78e02b7
commit d44323a
Show file tree

Hide file tree

Showing 9 changed files with 205 additions and 44 deletions.
diff --git a/red-system/compiler.r b/red-system/compiler.r
@@ -2039,20 +2039,22 @@ system-dialect: context [
 			pc: next pc
 		]
 
-		run: func [obj [object!] src [block!] file [file!] /no-header /runtime][
+		run: func [obj [object!] src [block!] file [file!] /no-header /runtime /no-events][
 			runtime: to logic! runtime
 			job: obj
 			pc: src
 			script: secure-clean-path file
 			unless no-header [comp-header]
-			emitter/target/on-global-prolog runtime
+			unless no-events [emitter/target/on-global-prolog runtime]
 			comp-dialect
-			case [
-				runtime [
-					emitter/target/on-global-epilog yes	;-- postpone epilog event after comp-runtime-epilog
-				]
-				not job/runtime? [
-					emitter/target/on-global-epilog no
+			unless no-events [
+				case [
+					runtime [
+						emitter/target/on-global-epilog yes	;-- postpone epilog event after comp-runtime-epilog
+					]
+					not job/runtime? [
+						emitter/target/on-global-epilog no
+					]
 				]
 			]
 		]
@@ -2102,6 +2104,19 @@ system-dialect: context [
 			]
 		]
 	]
+
+	comp-start: has [script][
+		emitter/start-prolog
+		script: secure-clean-path runtime-path/start.reds
+ 		compiler/run/no-events job loader/process script script
+ 		emitter/start-epilog
+
+		;-- selective clean-up of compiler's internals
+ 		remove/part find compiler/globals 'system 2		;-- avoid 'system redefinition clash
+ 		remove/part find emitter/symbols 'system 4
+		clear compiler/definitions
+		clear compiler/aliased-types
+	]
 
 	comp-runtime-prolog: has [script][
 		script: secure-clean-path runtime-path/common.reds
@@ -2183,6 +2198,8 @@ system-dialect: context [
 
 			clean-up
 			loader/init
+
+			unless opts/use-natives? [comp-start]		;-- init libC properly
 			if opts/runtime? [comp-runtime-prolog]
 
 			set-verbose-level opts/verbosity

diff --git a/red-system/emitter.r b/red-system/emitter.r
@@ -155,7 +155,7 @@ emitter: context [
 	get-func-ref: func [name [word!] /local entry][
 		entry: find/last symbols name
 		if entry/2/1 = 'native [
-			repend symbols [		;-- copy 'native entry to a 'global entry
+			repend symbols [							;-- copy 'native entry to a 'global entry
 				name reduce ['native-ref all [entry/2/2 entry/2/2 - 1] make block! 1]
 			]
 			entry: skip tail symbols -2 
@@ -561,6 +561,19 @@ emitter: context [
 		]
 	]
 
+	start-prolog: does [								;-- libc init prolog
+		append compiler/functions [						;-- create a fake function to
+			***_start [0 native cdecl []]				;-- let the linker write the entry point
+		]
+		append symbols [
+			***_start [native 0 []]
+		]
+	]
+
+	start-epilog: does [								;-- libc init epilog
+		poke second find/last symbols '***_start 2 tail-ptr - 1	;-- save the "main" entry point
+	]
+
 	init: func [link? [logic!] job [object!]][
 		if link? [
 			clear code-buf

diff --git a/red-system/runtime/common.reds b/red-system/runtime/common.reds
@@ -97,32 +97,10 @@ form-type: func [
 	]
 ]
 
-#switch OS [
-	Windows  [
-	  #define LIBC-file	"msvcrt.dll"
-	  #define LIBM-file "msvcrt.dll"  
-	]
-	Syllable [
-	  #define LIBC-file	"libc.so.2"
-	  #define LIBM-file "libm.so.2"  
-	]
-	MacOSX	 [
-	  #define LIBC-file	"libc.dylib"
-	  #define LIBM-file	"libc.dylib"
-	]
-	#default [
-		#either config-name = 'Android [	;-- @@ see if declaring it as an OS wouldn't be too costly
-			#define LIBC-file	"libc.so"
-			#define LIBM-file	"libm.so"
-		][
-			#define LIBC-file	"libc.so.6"	;-- Linux
-			#define LIBM-file	"libm.so.6"	
-		]
-	]
-]
+#include %lib-names.reds
 
 #either use-natives? = no [					;-- C bindings or native counterparts
-	#include %lib-C.reds
+	#include %libc.reds
 ][
 	#include %lib-natives.reds
 ]

diff --git a/red-system/runtime/lib-names.reds b/red-system/runtime/lib-names.reds
@@ -0,0 +1,34 @@
+Red/System [
+	Title:   "Red/System OS-independent runtime"
+	Author:  "Nenad Rakocevic"
+	File: 	 %lib-names.reds
+	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
+	License: {
+		Distributed under the Boost Software License, Version 1.0.
+		See https://github.com/dockimbel/Red/blob/master/red-system/runtime/BSL-License.txt
+	}
+]
+
+#switch OS [
+	Windows  [
+	  #define LIBC-file	"msvcrt.dll"
+	  #define LIBM-file "msvcrt.dll"  
+	]
+	Syllable [
+	  #define LIBC-file	"libc.so.2"
+	  #define LIBM-file "libm.so.2"  
+	]
+	MacOSX	 [
+	  #define LIBC-file	"libc.dylib"
+	  #define LIBM-file	"libc.dylib"
+	]
+	#default [
+		#either config-name = 'Android [	;-- @@ see if declaring it as an OS wouldn't be too costly
+			#define LIBC-file	"libc.so"
+			#define LIBM-file	"libm.so"
+		][
+			#define LIBC-file	"libc.so.6"	;-- Linux
+			#define LIBM-file	"libm.so.6"	
+		]
+	]
+]
diff --git a/red-system/runtime/lib-C.reds → red-system/runtime/libc.reds b/red-system/runtime/lib-C.reds → red-system/runtime/libc.reds
@@ -71,4 +71,4 @@ prin-float: func [f [float!] return: [float!]][
 prin-float32: func [f [float32!] return: [float32!]][
 	printf ["%.7g" as-float f]
 	f
-]
+]
diff --git a/red-system/runtime/linux.reds b/red-system/runtime/linux.reds
@@ -37,9 +37,17 @@ Red/System [
 ;-------------------------------------------
 ;-- Retrieve command-line information from stack
 ;-------------------------------------------
-system/args-count:	pop
-system/args-list:	as str-array! system/stack/top
-system/env-vars:	system/args-list + system/args-count + 1
+#either use-natives? = yes [
+	system/args-count:	pop
+	system/args-list:	as str-array! system/stack/top
+	system/env-vars:	system/args-list + system/args-count + 1
+][
+	;-- the current stack is pointing to main(int argc, void **argv, void **envp) C layout
+	;-- we avoid the double indirection by reusing our variables from %start.reds
+	system/args-count:	***__argc
+	system/args-list:	as str-array! ***__argv
+	system/env-vars:	system/args-list + system/args-count + 1
+]
 
 
 #include %POSIX.reds
diff --git a/red-system/runtime/start.reds b/red-system/runtime/start.reds
@@ -0,0 +1,102 @@
+Red/System [
+	Title:   "Red/System OS-independent runtime"
+	Author:  "Nenad Rakocevic"
+	File: 	 %start.reds
+	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
+	License: {
+		Distributed under the Boost Software License, Version 1.0.
+		See https://github.com/dockimbel/Red/blob/master/red-system/runtime/BSL-License.txt
+	}
+]
+
+#include %lib-names.reds
+
+__stack!: alias struct! [
+	top		[pointer! [integer!]]
+	frame	[pointer! [integer!]]
+]
+
+system: declare struct! [							;-- trimmed down temporary system definition
+	stack		[__stack!]							;-- stack virtual access
+]
+
+
+#switch OS [
+	Windows []										;-- nothing to do, initialization occurs in DLL init entry point
+	MacOSX  []										;-- nothing to do @@
+	Syllable [
+		#import [LIBC-file cdecl [
+			libc-start: "__libc_start_main" [
+				main 			[function! []]
+				argv 			[pointer! [integer!]]
+				envp 			[pointer! [integer!]]
+				init 			[function! []]
+				finish 			[function! []]
+				stack-end 		[pointer! [integer!]]
+			]
+		]]
+
+		;; Clear the frame pointer. The SVR4 ELF/i386 ABI suggests this, to
+		;; mark the outermost frame.
+		system/stack/frame: as pointer! [integer!] 0
+
+		;; Extract arguments from the call stack (which was setup by the
+		;; kernel).
+		;; esp:   dummy value
+		;; esp+4: **argv
+		***__argv: system/stack/top + 1
+		***__argv: as [pointer! [integer!]] ***__argv/value
+		;; esp+8: **envp
+		***__envp: system/stack/top + 2
+		***__envp: as [pointer! [integer!]] ***__envp/value
+
+		;; Before pushing arguments for `libc-start`, align the stack to a
+		;; 128-bit boundary, to prevent misaligned access penalities.
+		system/stack/top: as pointer! [integer!] (FFFFFFF0h and as integer! ***__argv)
+
+		;; The call to `libc-start` takes 6 4-byte arguments (passed on the
+		;; stack). To keep the stack 128-bit aligned even after the call, we
+		;; push some garbage.
+		push 0
+		push 0
+
+		;; Finally, call into libc's startup routine.
+		***__stack_end: system/stack/top
+		libc-start :***_start ***__argv ***__envp null null ***__stack_end		
+	]
+	#default [										;-- for SVR4 fully conforming UNIX platforms
+		#import [LIBC-file cdecl [
+			libc-start: "__libc_start_main" [
+				main 			[function! []]
+				argc 			[integer!]
+				argv 			[pointer! [integer!]]
+				init 			[function! []]
+				finish 			[function! []]
+				loader-finish 	[function! []]
+				stack-end 		[pointer! [integer!]]
+			]
+		]]
+
+		;; Clear the frame pointer. The SVR4 ELF/i386 ABI suggests this, to
+		;; mark the outermost frame.
+		system/stack/frame: as pointer! [integer!] 0
+
+		;; Extract arguments from the call stack (which was setup by the
+		;; kernel).
+		***__argc: pop
+		***__argv: system/stack/top
+
+		;; Before pushing arguments for `libc-start`, align the stack to a
+		;; 128-bit boundary, to prevent misaligned access penalities.
+		system/stack/top: as pointer! [integer!] (FFFFFFF0h and as integer! ***__argv)
+
+		;; The call to `libc-start` takes 7 4-byte arguments (passed on the
+		;; stack). To keep the stack 128-bit aligned even after the call, we
+		;; push some garbage.
+		push 0
+
+		;; Finally, call into libc's startup routine.
+		***__stack_end: system/stack/top
+		libc-start :***_start ***__argc ***__argv null null null ***__stack_end
+	]
+]
diff --git a/red-system/runtime/syllable.reds b/red-system/runtime/syllable.reds
@@ -34,11 +34,20 @@ Red/System [
 ;-------------------------------------------
 ;-- Retrieve command-line information from stack
 ;-------------------------------------------
-pop											;-- dummy value
-system/args-list: as str-array! pop			;-- &argv
-system/env-vars: as str-array! pop			;-- &envp
 
-***-on-start: func [/local c argv][
+#either use-natives? = yes [
+	pop										;-- dummy value
+	system/args-list: as str-array! pop		;-- &argv
+	system/env-vars:  as str-array! pop		;-- &envp
+
+][
+	;-- the current stack is pointing to main(int argc, void **argv, void **envp) C layout
+	;-- we avoid the double indirection by reusing our variables from %start.reds
+	system/args-list: as str-array! ***__argv
+	system/env-vars:  as str-array! ***__envp
+]
+
+***-get-argc: func [/local c argv][
 	argv: system/args-list
 	c: 0
 	while [argv/item <> null][
@@ -47,6 +56,6 @@ system/env-vars: as str-array! pop			;-- &envp
 	]
 	system/args-count: c
 ]
-***-on-start
-
+***-get-argc
+	
 #include %POSIX.reds
diff --git a/red-system/targets/IA-32.r b/red-system/targets/IA-32.r
@@ -304,7 +304,7 @@ make target-class [
 
 	emit-set-stack: func [value /frame][
 		if verbose >= 3 [print [">>>emitting SET-STACK" mold value]]
-		emit-load value
+		unless tag? value [emit-load value]
 		either frame [
 			emit #{89C5}							;-- MOV ebp, eax		
 		][