diff options
| -rw-r--r-- | gcc/ChangeLog.MELT | 13 | ||||
| -rw-r--r-- | gcc/melt/warmelt-macro.melt | 9 | ||||
| -rw-r--r-- | gcc/melt/warmelt-modes.melt | 16 | ||||
| -rw-r--r-- | gcc/melt/warmelt-outobj.melt | 71 |
4 files changed, 94 insertions, 15 deletions
diff --git a/gcc/ChangeLog.MELT b/gcc/ChangeLog.MELT index e2db46a2202..6be13b001d3 100644 --- a/gcc/ChangeLog.MELT +++ b/gcc/ChangeLog.MELT @@ -1,4 +1,17 @@ +2013-10-12 Basile Starynkevitch <basile@starynkevitch.net> + + {{more specific code for bootstrapping first translation}} + * melt/warmelt-macro.melt (mexpand_defmacro) + (mexpand_at_macro_expansion): Error when the module context don't + have a mocx_macrolist, i.e. for the first module. + + * melt/warmelt-outobj.melt (class_first_module_context): New + internal class. + (compile_first_bootstrap_list_sexpr): New function. + + * melt/warmelt-modes.melt (translateinit_docmd): Call it. + 2013-10-11 Basile Starynkevitch <basile@starynkevitch.net> * melt/warmelt-first.melt: Add a comment about forbidden macros in diff --git a/gcc/melt/warmelt-macro.melt b/gcc/melt/warmelt-macro.melt index 9a1070e1821..05e945dc32a 100644 --- a/gcc/melt/warmelt-macro.melt +++ b/gcc/melt/warmelt-macro.melt @@ -3685,6 +3685,10 @@ $EXPORT_VALUES to be visible outside its module.}#) :smacinst_defmacro sdefmacro )) ) + (when (not (is_list maclist)) + (error_at loc "macros, i.e. DEFMACRO, are forbidden in this module $1" + (get_field :mocx_modulename modctx)) + (return)) (debug "mexpand_defmacro bodytup=" bodytup) (put_fields mbind :mbind_defmacro sdefmacro) (debug "mexpand_defmacro sdefmacro=" sdefmacro "\n old maclist=" maclist @@ -3761,9 +3765,12 @@ is ($DEFMACRO @var{funame} @var{formals} [:doc @var{documentation}] (maclist (get_field :mocx_macrolist modctx)) (curpair (pair_tail (list_first cont))) (bodytup (expand_pairlist_as_tuple curpair modinienv mexpander modctx)) - (maclist (get_field :mocx_macrolist modctx)) ) (debug "mexpand_at_macro_expansion bodytup=" bodytup "\n.. modinienv=" modinienv "\n.. maclist=" maclist) + (when (not (is_list maclist)) + (error_at loc "macros, i.e. AT_MACRO_EXPANSION, are forbidden in this module $1" + (get_field :mocx_modulename modctx)) + (return)) (assert_msg "check bodytup" (is_multiple bodytup) bodytup) (foreach_in_multiple (bodytup) diff --git a/gcc/melt/warmelt-modes.melt b/gcc/melt/warmelt-modes.melt index caf433c44b8..a183657d3d1 100644 --- a/gcc/melt/warmelt-modes.melt +++ b/gcc/melt/warmelt-modes.melt @@ -4464,14 +4464,14 @@ ASSERT_MSG) is enabled" (split_string_comma discr_string (make_stringconst discr_string progarglist)) ) (:else - (errormsg_plain "invalid arg or arglist to translateinit mode") + (error_at () "invalid arg $1 or arglist $2 to translateinit mode" progarg progarglist) (return)))) (outarg (make_stringconst discr_string (melt_argument "output"))) (basnam (cond ( (is_string outarg) outarg) ( (is_string inarg) (make_string_nakedbasename discr_string inarg)) (:else - (errormsg_plain "invalid translateinit mode") + (error_at () "invalid translateinit mode inarg $1 outarg $2" inarg outarg) (return) ))) ) @@ -4481,7 +4481,7 @@ ASSERT_MSG) is enabled" (string_suffixed basnam ".c") (string_suffixed basnam ".cc")) (progn - (errormsg_strv "tranlateinit mode needs a base name without suffix" + (error_at () "tranlateinit mode needs a base name $1 without suffix" basnam) (return) )) @@ -4491,7 +4491,7 @@ ASSERT_MSG) is enabled" ((is_list inarg) (list_every inarg (lambda (curarg) - (informsg_strv "reading from file" curarg) + (inform_at () "translateinit reading from file $1" curarg) (let ( (curead (read_file curarg)) ) (assert_msg "check rlist" (is_list rlist) rlist) @@ -4500,12 +4500,8 @@ ASSERT_MSG) is enabled" (list_append2list rlist curead))))) ) (debug "after read translateinit_mode rlist=" rlist) - ;; we pass a null initial environment, so that - ;; MELT_HAS_INITIAL_ENVIRONMENT is emitted as 0, to avoid spurious - ;; warnings about unexistent EXPORT_VALUE routine in early - ;; initialization of warmelt-first.melt. This is crazy magic - ;; which happens to work. - (compile_list_sexpr rlist () basnam) + ;; special magic for the initial first file + (compile_first_bootstrap_list_sexpr rlist basnam) ;; we trigger explicitly a full GC to stress the runtime. The ;; translateinit mode is not useful to the casual user. (full_garbcoll 10000) diff --git a/gcc/melt/warmelt-outobj.melt b/gcc/melt/warmelt-outobj.melt index 2931d065d62..ab7293661a5 100644 --- a/gcc/melt/warmelt-outobj.melt +++ b/gcc/melt/warmelt-outobj.melt @@ -6977,17 +6977,79 @@ if (1) return; (let ( (xlist (macroexpand_toplevel_list lsexp inienv macroexpand_1 modctx)) (:long lenxlist (list_length xlist)) ) - (debug "compile_list_sexpr after macroexpansion modctx=" modctx) - ;; - (debug "compile_list_sexpr before translation modctx=" modctx) + (debug "compile_list_sexpr after macroexpansion and before translation modctx=" debug_less modctx) ;; (translate_macroexpanded_list xlist modnamstr modctx ncx inienv () compile2obj_initproc) - (debug "compile_list_sexpr after translation modctx=" modctx) + (debug "compile_list_sexpr after translation modctx=" debug_less modctx) ))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defclass class_first_module_context + :doc #{$CLASS_FIRST_MODULE_CONTEXT is for compiling the bootstrapped first module warmelt-first. For Gurus.}# + :super class_module_context + :fields ( + )) + +;; compile a list of sexpressions as a the first bootstrapping module ie bootstrap warmelt-first +(defun compile_first_bootstrap_list_sexpr (lsexp modnamstr) + (debug "compile_first_bootstrap_list_sexpr modnamstr=" modnamstr " lsexp=" debug_less lsexp) + (shortbacktrace_dbg "compile_list_sexpr" 10) + (assert_msg "check lsexp" (is_list lsexp) lsexp) + (assert_msg "check modnamstr" (is_string modnamstr) modnamstr) + (assert_msg "compile_first_bootstrap_list_sexpr modulename not ended with MELT_DYNLOADED_SUFFIX." + (not (string_dynloaded_suffixed modnamstr)) modnamstr) + (assert_msg "compile_first_bootstrap_list_sexpr modulename not ended with .melt" + (not (string_suffixed modnamstr ".melt")) modnamstr) + (assert_msg "compile_first_bootstrap_list_sexpr modulename not ended with .c" + (not (string_suffixed modnamstr ".c")) modnamstr) + (assert_msg "compile_first_bootstrap_list_sexpr modulename not ended with .cc" + (not (string_suffixed modnamstr ".cc")) modnamstr) + (code_chunk + check_warmelt_first_bootstrapping_chunk #{ + /* compile_first_bootstrap_list_sexpr $CHECK_WARMELT_FIRST_BOOTSTRAPPING_CHUNK */ + melt_checkmsg ("bootstrapping first file", + melt_flag_bootstrapping + && melt_string_str((melt_ptr_t) $MODNAMSTR) + && strstr(melt_string_str((melt_ptr_t) $MODNAMSTR), "first")) ; + }#) + (let ( + (modnakedname (make_string_nakedbasename discr_string modnamstr)) + (modctx (instance class_first_module_context + :mocx_modulename modnakedname + :mocx_expfieldict (make_mapstring discr_map_strings 490) + :mocx_expclassdict (make_mapstring discr_map_strings 240) + :mocx_initialenv () + :mocx_funcount (make_integerbox discr_integer 0) + :mocx_filetuple () + :mocx_cheaderlist (make_list discr_list) + :mocx_cimplementlist (make_list discr_list) + ;; :mocx_cflags (make_list discr_list) + ;; :mocx_linkflags (make_list discr_list) + :mocx_packagepclist (make_list discr_list) + :mocx_gendevlist (make_list discr_list) + :mocx_errorhandler (lambda (v) (fatal_compile_error modnamstr v)) + :mocx_varcount (make_integerbox discr_integer 0) + :mocx_varlist (make_list discr_list) + :mocx_hookdict (make_mapstring discr_map_strings 31) + :mocx_macrolist () ;; no macro list because macros are forbidden in first + )) + (ncx (create_normcontext modctx)) + ) + (debug "compile_first_bootstrap_list_sexpr modctx=" debug_less modctx "\n ncx=" debug_less ncx) + (assert_msg "compile_first_bootstrap_list_sexpr check initial_environment" + (is_a initial_environment class_environment) initial_environment) + (assert_msg "check ncx" (is_a ncx class_normalization_context) ncx) + (let ( (xlist (macroexpand_toplevel_list lsexp initial_environment macroexpand_1 modctx)) + (:long lenxlist (list_length xlist)) + ) + (debug "compile_first_bootstrap_list_sexpr after macroexpansion and before translation modctx=" debug_less modctx) + (inform_at () "compile first got $1 expanded expressions in $2" lenxlist modnamstr) + ;; + (translate_macroexpanded_list xlist modnamstr modctx ncx initial_environment () compile2obj_initproc) + ))) ;;;;;********************************************************** ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -7744,6 +7806,7 @@ notice for file named $NAME.}# ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (export_values compile_list_sexpr + compile_first_bootstrap_list_sexpr eval generate_gplv3plus_copyright_notice_c_comment get_code_buffer_limit |