diff --git a/red-system/compiler.r b/red-system/compiler.r index 80baa88feb..44eac707f3 100644 --- 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 index 8869b4f832..7ee7a09647 100644 --- 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 index 02e61d2dea..93ef3dfcff 100644 --- 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 new file mode 100644 index 0000000000..3890a4b1c0 --- /dev/null +++ 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" + ] + ] +] \ No newline at end of file diff --git a/red-system/runtime/lib-C.reds b/red-system/runtime/libc.reds similarity index 99% rename from red-system/runtime/lib-C.reds rename to red-system/runtime/libc.reds index e49130613a..9e97b3f616 100644 --- a/red-system/runtime/lib-C.reds +++ b/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 -] \ No newline at end of file +] diff --git a/red-system/runtime/linux.reds b/red-system/runtime/linux.reds index f99b2c4a25..091c750d4d 100644 --- 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 new file mode 100644 index 0000000000..c6177abf94 --- /dev/null +++ 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 index f7fb9c98a9..790a071cd8 100644 --- 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 index 8ed26d1b31..561f8a3a33 100644 --- 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 ][