PreviousUpNext

15.4.422  src/lib/compiler/back/low/tools/arch/sourcecode-making-junk.pkg

## sourcecode-making-junk.pkg -- derived from ~/src/sml/nj/smlnj-110.60/MLRISC/Tools/ADL/mdl-compile.sml
#
# See overview comments in
#     src/lib/compiler/back/low/tools/arch/sourcecode-making-junk.api

# Compiled by:
#     src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages.lib



###               "I visualize a time when we
###                will be to robots what
###                dogs are to humans, and I'm
###                rooting for the machines."
###
###                       -- Claude Shannon


stipulate
    package ard =  architecture_description;                                    # architecture_description                              is from   src/lib/compiler/back/low/tools/arch/architecture-description.pkg
    package cst =  adl_raw_syntax_constants;                                    # adl_raw_syntax_constants                              is from   src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-constants.pkg
    package err =  adl_error;                                                   # adl_error                                             is from   src/lib/compiler/back/low/tools/line-number-db/adl-error.pkg
    package fil =  file__premicrothread;                                        # file__premicrothread                                  is from   src/lib/std/src/posix/file--premicrothread.pkg
    package htb =  hashtable;                                                   # hashtable                                             is from   src/lib/src/hashtable.pkg
    package spp =  simple_prettyprinter;                                        # simple_prettyprinter                                  is from   src/lib/prettyprint/simple/simple-prettyprinter.pkg
    package mst =  adl_symboltable;                                             # adl_symboltable                                       is from   src/lib/compiler/back/low/tools/arch/adl-symboltable.pkg
    package raw =  adl_raw_syntax_form;                                         # adl_raw_syntax_form                                   is from   src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-form.pkg
    package rsu =  adl_raw_syntax_unparser;                                     # adl_raw_syntax_unparser                               is from   src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-unparser.pkg
    package rrs =  adl_rewrite_raw_syntax_parsetree;                            # adl_rewrite_raw_syntax_parsetree                      is from   src/lib/compiler/back/low/tools/adl-syntax/adl-rewrite-raw-syntax-parsetree.pkg
    package rsj =  adl_raw_syntax_junk;                                         # adl_raw_syntax_junk                                   is from   src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-junk.pkg
    package rsp =  adl_raw_syntax_predicates;                                   # adl_raw_syntax_predicates                             is from   src/lib/compiler/back/low/tools/arch/adl-raw-syntax-predicates.pkg
herein

    # This package is referenced in:
    #     src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages.pkg

    package   sourcecode_making_junk
    :         Sourcecode_Making_Junk                                            # Sourcecode_Making_Junk                                is from   src/lib/compiler/back/low/tools/arch/sourcecode-making-junk.api
    {
        # Code Generation methods

        Seal = WEAK_SEAL        # foo: (weak) Bar
             | STRONG_SEAL      # foo:        Bar
             ;

        Module = String;
        Arguments = List( String );
        Api_Name = String;

        infix my ++ ;

        ++ = spp::CONS;

        toupper =  string::map  char::to_upper;
        tolower =  string::map  char::to_lower;

        fun make_api_name              architecture_description  name =  string::to_mixed (name + "_" + (ard::architecture_name_of  architecture_description)       );  # E.g., Registerkinds_Intel32
        fun make_package_name          architecture_description  name =  string::to_lower (name + "_" + (ard::architecture_name_of  architecture_description)       );  # E.g., registerkinds_intel32
        fun make_generic_package_name  architecture_description  name =  string::to_lower (name + "_" + (ard::architecture_name_of  architecture_description) + "_g");  # E.g., registerkinds_intel32_g

        fun make_sig_con ""       _           =>  spp::NOP;
            make_sig_con api_name WEAK_SEAL   =>  spp::PUNCTUATION ": (weak) "  ++  spp::ALPHABETIC api_name;
            make_sig_con api_name STRONG_SEAL =>  spp::PUNCTUATION ": "         ++  spp::ALPHABETIC api_name;
        end;

        fun make_api  architecture_description  name  body
            =
            spp::INDENTED_LINE (  spp::ALPHABETIC "api"
                               ++ spp::ALPHABETIC (make_api_name  architecture_description  name)
                               ++ spp::ALPHABETIC "{"
                               )
            ++ spp::INDENTED_BLOCK (rsu::decls body)
            ++ spp::INDENTED_LINE (spp::ALPHABETIC "};")
            ;

        # For better readability, these functions should all
        # take record arguments instead of being curried.           XXX SUCKO FIXME.

        fun make_generic'  architecture_description  name_making_fn  args  seal api_name  body
           =
           spp::INDENT
           ++ spp::ENTER_DEEPLY_INDENTED_BLOCK
               ++ spp::ALPHABETIC "generic package"
               ++ spp::ALPHABETIC (name_making_fn (ard::architecture_name_of architecture_description))
               ++ spp::MAYBE_BLANK
               ++ spp::PUNCTUATION "("
               ++ spp::ENTER_INDENTED_BLOCK
                   ++ spp::NEWLINE ++ spp::INDENT ++ spp::PUNCTUATION "#"
                   ++ spp::NEWLINE ++ spp::INDENT
                   ++ rsu::decl args
               ++ spp::LEAVE_INDENTED_BLOCK
               ++ spp::INDENT
               ++ spp::PUNCTUATION ")"
               ++ spp::NEWLINE
               ++ spp::INDENT
               ++ make_sig_con api_name seal 
               ++ spp::NEWLINE ++ spp::INDENT
               ++ spp::PUNCTUATION "{"
               ++ spp::NEWLINE
               ++ spp::INDENTED_BLOCK (rsu::decls body)
               ++ spp::INDENT
               ++ spp::PUNCTUATION "};"
               ++ spp::NEWLINE
           ++ spp::LEAVE_INDENTED_BLOCK
           ;

        fun make_generic  architecture_description  name_making_fn  args  seal api_name  body
            =
            make_generic'  architecture_description  name_making_fn  (raw::VERBATIM_CODE args)  seal api_name  body;


        fun make_package  architecture_description  base_package_name  api_name  body
            =
            spp::INDENTED_LINE
                (   spp::ALPHABETIC "package"
                     ++  spp::ALPHABETIC (make_package_name  architecture_description  base_package_name)
                     ++  make_sig_con  api_name  STRONG_SEAL
                     ++  spp::ALPHABETIC "{"
                )
            ++  spp::INDENTED_BLOCK (spp::INDENTED_LINE (spp::PUNCTUATION "#"))
            ++  spp::INDENTED_BLOCK (rsu::decls body)
            ++  spp::INDENTED_LINE  (spp::PUNCTUATION "};")
            ;

        fun make_code body                                                              # Nowhere invoked.
            =
            spp::INDENTED_BLOCK  (rsu::decls  body);


        fun make_sourcecode_filename                                                    # Our main call is in   src/lib/compiler/back/low/tools/arch/adl-rtl-comp-g.pkg
              #                                                                         # We're also called in  src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages-g.pkg
              #
              { architecture_description:       ard::Architecture_Description,          # E.g. from  "src/lib/compiler/back/low/intel32/one_word_int.architecture-description".
                subdir:                 String,                                         # E.g.       "code".
                make_filename:          String -> String                                # E.g.       maps "intel32" -> "registerkinds-intel32.codemade.pkg".
              } 
            =
            filename                                                                    # E.g.       "src/lib/compiler/back/low/intel32/code/registers-intel32.pkg"
            where
                fun get_name
                      ( subdir,                                                         # E.g.       "code".
                        make_filename                                                   # E.g.       maps "intel32" -> "registerkinds-intel32.codemade.pkg".
                      )
                    = 
                    winix__premicrothread::path::cat
                      (
                        subdir,
                        make_filename (tolower (ard::architecture_name_of  architecture_description))
                      );

                filename =  winix__premicrothread::path::cat
                              (
                                winix__premicrothread::path::dir (ard::architecture_description_file_of  architecture_description),
                                get_name (subdir, make_filename)
                              );
            end;


        # Emit text into a file:
        #
        fun write_textfile
                architecture_description
                created_by_package                                                                              # E.g. "src/lib/compiler/back/low/tools/arch/make-sourcecode-for-registerkinds-xxx-package.pkg".
                subdir                                                                                          # Relative to file containing architecture description.
                make_filename
                new_body                                                                                        # New file contents except for header text.
            =
            if (*err::error_count <= 0)
                #
                filename =  make_filename( tolower (ard::architecture_name_of  architecture_description) );             # E.g.                                                 "registerkinds-intel32.codemade.pkg"
                filepath =  make_sourcecode_filename  { architecture_description, subdir, make_filename };              # E.g.       "src/lib/compiler/back/low/intel32/code/registerkinds-intel32.codemade.pkg"

#               file =  module_name (module + ".pkg");     # For testing 

                old_text =
                    {   stream = fil::open_for_read  filepath;
                        #
                        fil::read_n (stream, 1024*1024)
                        then
                            fil::close_input  stream;
                    }
                    except _ = "";

                now = date::strftime                                                                    # E.g. "2011-04-28:00:36:27"
                          "%Y-%m-%d:%H:%M:%S"
                          (date::from_time_local (time::get_current_time_utc ()));

                new_header
                  = "## " + filename + "\n"
                  + "#\n"
                  + "# This file generated at   " + now + "   by\n"
                  + "#\n"
                  + "#     " + created_by_package + "\n"
                  + "#\n"
                  + "# from the architecture description file\n"
                  + "#\n"
                  + "#     " + ard::architecture_description_file_of  architecture_description  +  "\n"
                  + "#\n"
                  + "# Edits to this file will be LOST on next system rebuild.\n"
                  + "\n"
                  + "\n"
                  ;

                old_body =  if (string::length_in_bytes old_text > string::length_in_bytes new_header)    string::extract (old_text, string::length_in_bytes new_header, NULL);
                            else                                                        "";
                            fi;

                if (*err::error_count == 0)
                    #
                    print  ("              sourcecode-making-junk.pkg:   Generating              " + filepath + " ... ");

                    if (old_body == new_body)                                                                   # We don't compare headers because the dates will always differ.
                        #
                        print "file is unchanged.\n";
                    else
                        new_text = new_header + new_body;

                        dir = winix__premicrothread::path::dir  filepath;

                        winix__premicrothread::file::make_directory dir            except _ = ();

                        stream = fil::open_for_write  filepath;

                        fil::write (stream, new_text);
                        fil::close_output stream;

                        print "done.\n";
                    fi;
                fi;

            fi;


        # Emit code into a file: 
        #
        fun write_sourcecode_file
              {
                architecture_description,
                created_by_package,                                                                             # E.g. "src/lib/compiler/back/low/tools/arch/make-sourcecode-for-registerkinds-xxx-package.pkg".
                subdir,                                                                                         # Relative to file containing architecture description.
                make_filename,
                code
              }
            =
            {   new_text
                    =
                    string::cat
                      [
                        spp::prettyprint_expression_to_string (spp::PUSH_MODE "code" ++ spp::CAT code),

                        "",
                        string::from_char '\^L',
                        "\n",
                        "##########################################################################\n",
                        "#   The following is support for outline-minor-mode in emacs.            #\n",
                        "#  ^C @ ^T hides all Text. (Leaves all headings.)                        #\n",
                        "#  ^C @ ^A shows All of file.                                            #\n",
                        "#  ^C @ ^Q Quickfolds entire file. (Leaves only top-level headings.)     #\n",
                        "#  ^C @ ^I shows Immediate children of node.                             #\n",
                        "#  ^C @ ^S Shows all of a node.                                          #\n",
                        "#  ^C @ ^D hiDes all of a node.                                          #\n",
                        "#  ^HFoutline-mode gives more details.                                   #\n",
                        "#  (Or do ^HI and read emacs:outline mode.)                              #\n",
                        "#                                                                        #\n",
                        "# Local variables:                                                       #\n",
                        "# mode: outline-minor                                                    #\n",
                        "# outline-regexp: \"[{ \\t]*\\\\(fun \\\\)\"                                    #\n",
                        "# End:                                                                   #\n",
                        "##########################################################################\n"
                      ];
                #
                write_textfile  architecture_description  created_by_package  subdir  make_filename  new_text;
            };


        fun error_handler  architecture_description  make_name_fn
            =
            rsj::error_fun_fn  (make_name_fn (ard::architecture_name_of  architecture_description));


        # Emit a function that dispatches
        # to subfunctions according to the
        # register kind:
        #
        fun make_query_by_registerkind  architecture_description  name'                                         # Invoked (only) in   src/lib/compiler/back/low/tools/arch/adl-gen-instruction-props.pkg
            =
            {   registersets =  ard::registersets_of  architecture_description;

                client_defined
                    =  
                    list::filter
                        #
                        (\\ raw::REGISTER_SET { name, alias, ... }
                            =
                            not (not_null alias)                           and
                            not (rsp::is_predefined_registerkind  name)   and
                            not (rsp::is_pseudo_registerkind      name)
                        )
                        #
                        registersets;


                newly_defined
                    =
                    case  client_defined
                        #
                        [] => [ raw::CLAUSE(  [ raw::WILDCARD_PATTERN ],  NULL,  rsj::app ("error",  rsj::string_constant_in_expression  name')) ];
                        #
                        _  => [ raw::CLAUSE([ raw::IDPAT "k" ], NULL,
                                #       
                                fold_backward
                                    #
                                    (\\ (raw::REGISTER_SET { name, alias, ... }, e)
                                        =
                                        raw::IF_EXPRESSION
                                          (
                                            rsj::app ( "=",
                                                    raw::TUPLE_IN_EXPRESSION [ rsj::id "k",
                                                               raw::ID_IN_EXPRESSION (raw::IDENT (["C"], name))
                                                             ]
                                                  ),
                                            rsj::id (name' + name),
                                            e
                                          )
                                    )
                                    #
                                    (rsj::app  ("error", rsj::string_constant_in_expression  name'))  client_defined)
                              ];
                    esac;


                predefined
                    =
                    fold_backward
                        #
                        (\\ (raw::REGISTER_SET { name, alias, ... }, c)
                            =
                            if (rsp::is_predefined_registerkind     name
                            and   not (rsp::is_pseudo_registerkind  name))
                                #
                                raw::CLAUSE
                                  (
                                    [ raw::CONSPAT (raw::IDENT(["C"], name), NULL)],
                                    NULL,
                                    case alias   NULL      =>  rsj::id (name' + name);
                                                 THE alias =>  rsj::app (name', raw::ID_IN_EXPRESSION (raw::IDENT(["C"], alias)));
                                    esac
                                  )
                                !
                                c;
                            else
                                c;
                            fi
                        )
                        #
                        newly_defined
                        registersets;


                raw::FUN_DECL [ raw::FUN (name', predefined) ];
            };


        # Map all real registersets in 'architecture_description' by 'f':
        #
        fun forall_user_registersets  architecture_description  f
            = 
            map f
                (list::filter
                    (\\ raw::REGISTER_SET { name, alias, ... }
                        =
                        not (rsp::is_pseudo_registerkind  name)
                        and not (not_null alias)
                    )
                    (ard::registersets_of  architecture_description)
                );
    };                                                                          # package   architecture_description
end;                                                                            # stipulate


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext