home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / ada / adaed-1.11 / adaed-1 / Adaed-1.11.0a / pack.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-07  |  12.5 KB  |  424 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. /* pack.c: translation of pack.stl */
  10.  
  11. #define GEN
  12.  
  13. #include "hdr.h"
  14. #include "libhdr.h"
  15. #include "vars.h"
  16. #include "segment.h"
  17. #include "gvars.h"
  18. #include "ops.h"
  19. #include "type.h"
  20. #include "setprots.h"
  21. #include "statprots.h"
  22. #include "procprots.h"
  23. #include "miscprots.h"
  24. #include "maincaseprots.h"
  25. #include "genprots.h"
  26. #include "gutilprots.h"
  27. #include "gmiscprots.h"
  28. #include "libprots.h"
  29. #include "segmentprots.h"
  30. #include "smiscprots.h"
  31. #include "packprots.h"
  32.  
  33. extern Segment    CODE_SEGMENT, DATA_SEGMENT, DATA_SEGMENT_MAIN;
  34.  
  35.  
  36. /*
  37.  * Chapter 7: Packages
  38.  *  The only problem with packages is the possible presence of tasks
  39.  *  objects in the specification part and the point of their activation
  40.  *  as defined by the RM: on the 'begin' of the package body, if it
  41.  *  exists.
  42.  */
  43.  
  44. void gen_package(Node pack_node)                            /*;gen_package*/
  45. {
  46.     Tuple    tup;
  47.     Node    id_node, decl_node, private_node;
  48.     int     save_tasks_declared;
  49.     Tuple    save_subprog_specs;
  50.     Symbol    package_name;
  51.  
  52.     save_tasks_declared = TASKS_DECLARED;
  53.     TASKS_DECLARED      = FALSE;
  54.     save_subprog_specs  = SUBPROG_SPECS;
  55.     SUBPROG_SPECS       = tup_new(0);
  56.  
  57. #ifdef TRACE
  58.     if (debug_flag)
  59.         gen_trace_node("GEN_PACKAGE", pack_node);
  60. #endif
  61.  
  62.     id_node = N_AST1(pack_node);
  63.     decl_node = N_AST2(pack_node);
  64.     private_node = N_AST3(pack_node);
  65.     package_name = N_UNQ(id_node);
  66.  
  67.     next_local_reference(package_name);
  68.  
  69.     gen_kv(I_PUSH_IMMEDIATE, mu_word, int_const_null_task);
  70.     if (save_tasks_declared) {
  71.         gen_c(I_LINK_TASKS_DECLARED, "save current tasks_declared");
  72.         gen_ks(I_DECLARE, mu_word, package_name);
  73.     }
  74.     else {
  75.         gen_ks(I_DECLARE, mu_word, package_name);
  76.         /* mu_word? */
  77.         gen_ksc(I_POP, mu_word, package_name, "initialize tasks declared");
  78.     }
  79.  
  80.     compile(decl_node);
  81.     compile(private_node);
  82.  
  83.     if (TASKS_DECLARED || save_tasks_declared)
  84.         gen_s(I_POP_TASKS_DECLARED, package_name);
  85.  
  86.     /* needs body already checked by FE */
  87.     tup = tup_new(3);
  88.     tup[1] = (char *) TASKS_DECLARED;
  89.     tup[2] = (char *) 0;
  90.     tup[3] = (char *) tup_copy(SUBPROG_SPECS);
  91.     MISC(package_name) = (char *) tup;
  92.     /* insert warning check in case symbol not package  ds 9-8-85*/
  93.     if (!(NATURE(package_name) == na_package
  94.       || NATURE(package_name)==na_package_spec)) {
  95.         chaos("pack.c: genpack - setting MISC for symbol ");
  96.     }
  97.  
  98.     TASKS_DECLARED = save_tasks_declared;
  99.     SUBPROG_SPECS  = save_subprog_specs;
  100.  
  101. }
  102.  
  103. void gen_package_body(Node body_node)                    /*;gen_package_body*/
  104. {
  105.     /* Process package body that is not a library unit */
  106.  
  107.     Tuple    tup;
  108.     Symbol    package_name;
  109.     int save_tasks_declared;
  110.     Tuple    save_subprog_specs;
  111.     Node    id_node, decl_node, stmts_node, handler_node;
  112.  
  113. #ifdef TRACE
  114.     if (debug_flag)
  115.         gen_trace_node("GEN_PACKAGE_BODY", body_node);
  116. #endif
  117.  
  118.     id_node = N_AST1(body_node);
  119.     decl_node = N_AST2(body_node);
  120.     stmts_node = N_AST3(body_node);
  121.     handler_node = N_AST4(body_node);
  122.     package_name = N_UNQ(id_node);
  123.  
  124.     save_tasks_declared = TASKS_DECLARED;
  125.     tup = (Tuple) MISC(package_name);
  126.     TASKS_DECLARED = (tup != (Tuple)0) ? (int) tup[1] : FALSE;
  127.  
  128.     save_subprog_specs  = SUBPROG_SPECS;
  129.     /* Note that SUBPROG_SPECS now stored in 3rd MISC entry   ds 7-9-85*/
  130.     SUBPROG_SPECS = (tup != (Tuple)0) ? tup_copy((Tuple) tup[3]) : tup_new(0);
  131.  
  132.     /* trivial case: this is a dummy package body and no task declared in */
  133.     /*             the specification part. */
  134.     /*
  135.      *   if blk=[] and not TASKS_DECLARED then
  136.      *    TASKS_DECLARED := save_tasks_declared;
  137.      *    return;
  138.      *   end if;
  139.      */
  140.  
  141.     if (TASKS_DECLARED || save_tasks_declared) {
  142.         gen_ksc(I_PUSH, mu_word, package_name, "retrieve tasks_declared");
  143.         gen(I_LINK_TASKS_DECLARED);
  144.     }
  145.  
  146.     /*
  147.      *   if blk = [] then    $ dummy body, TASKS_DECLARED always TRUE
  148.      *    generate(I_ACTIVATE);
  149.      *   else
  150.      */
  151.     compile(decl_node);
  152.     if (TASKS_DECLARED) {
  153.         gen(I_ACTIVATE);
  154.     }
  155.     else if (save_tasks_declared) {
  156.         gen_sc(I_POP_TASKS_DECLARED, package_name, "discard one level");
  157.     }
  158.  
  159.     compile_body(OPT_NODE, stmts_node, handler_node, TRUE);
  160.     /*   end if; */
  161.  
  162.     TASKS_DECLARED = save_tasks_declared;
  163.     SUBPROG_SPECS  = save_subprog_specs;
  164. }
  165.  
  166. void unit_package_spec(Node pack_node)                    /*;unit_package_spec*/
  167. {
  168.     /*
  169.      * Compilation of a library package spec.
  170.      * As it is a compilation unit, there is no task link to be preserved
  171.      */
  172.  
  173.     Node    id_node, decl_node, private_node;
  174.     Symbol    package_name, package_proc;
  175.     Tuple    tup;
  176.     Tuple    local_reference_map_new();
  177.     Symbol package_tasks;
  178.  
  179. #ifdef TRACE
  180.     if (debug_flag)
  181.         gen_trace_node("UNIT_PACKAGE_SPEC", pack_node);
  182. #endif
  183.  
  184.     id_node = N_AST1(pack_node);
  185.     decl_node = N_AST2(pack_node);
  186.     private_node = N_AST3(pack_node);
  187.     package_name = N_UNQ(id_node);
  188.  
  189.     TASKS_DECLARED = FALSE;
  190.     CURRENT_LEVEL  = 1;
  191.     LAST_OFFSET      = -SFP_SIZE;
  192.     MAX_OFFSET      = 0;
  193.     /* TBSL: see if can free current local reference map before allocating
  194.      * new one    ds 23-may 
  195.      */
  196.     LOCAL_REFERENCE_MAP = local_reference_map_new();
  197.  
  198.     /* Create associated name for initialization proc for spec. */
  199.     /*package_proc           = package_name+'_spec';*/
  200.     package_proc = sym_new(na_procedure);
  201.     assoc_symbol_put(package_name, INIT_SPEC, package_proc);
  202.     new_symbol(package_proc, na_procedure, symbol_none, tup_new(0), (Symbol)0);
  203.     ORIG_NAME(package_proc) = ORIG_NAME(package_name);
  204.     generate_object(package_proc);
  205.     CURRENT_DATA_SEGMENT = select_entry(SELECT_DATA, package_proc, SLOTS_DATA);
  206.     CURRENT_CODE_SEGMENT = select_entry(SELECT_CODE, package_proc, SLOTS_CODE);
  207. #ifdef MACHINE_CODE
  208.     if (list_code) {
  209.         to_gen_int("       data slot #", CURRENT_DATA_SEGMENT);
  210.         to_gen_int("       code slot #", CURRENT_CODE_SEGMENT);
  211.         to_gen(" ");
  212.     }
  213. #endif
  214.     next_global_reference_r(package_proc, CURRENT_CODE_SEGMENT, 0);
  215.  
  216.     /* Create associated name for initialization of inner tasks.*/
  217.     /*package_tasks        = package_name+'_tasks';*/
  218.     package_tasks = sym_new(na_obj);
  219.     assoc_symbol_put(package_name, INIT_TASKS, package_tasks);
  220.     /* SETL version gives package_tasks signature with null tuple.
  221.     * This does not correspond to usual form of signature
  222.     * for na_obj, namely a node. Hence in C we set it to
  223.     * null pointer.
  224.     */
  225.     new_symbol(package_tasks, na_obj, symbol_none, (Tuple)0, 
  226.       (Symbol)package_tasks);
  227.     generate_object(package_tasks);
  228.     /* TBSL: see if byte is appropriate: 
  229.      * next_global_reference_word(package_tasks, [0]);
  230.      */
  231.     next_global_reference_word(package_tasks, 0);
  232.  
  233.     gen(I_LEAVE_BLOCK);
  234.     gen(I_RAISE);
  235.  
  236.     compile(decl_node);
  237.     compile(private_node);
  238.  
  239.     if (TASKS_DECLARED)
  240.         gen_s(I_POP_TASKS_DECLARED, package_tasks);
  241.     gen(I_ENTER_BLOCK);
  242.     gen(I_LEAVE_BLOCK);
  243.     MAX_OFFSET = offset_max(MAX_OFFSET, LAST_OFFSET);
  244.     /* calculate the size of local objects and don't assume it is zero 
  245.     * because it is a package spec. It will not be zero in the case of 
  246.     * nested packages.
  247.     */
  248.     gen_ic(I_DATA, MAX_OFFSET-SFP_SIZE, "Local variables");/*GBSL*/
  249.     gen(I_END);
  250.  
  251.     tup = tup_new(3);
  252.     tup[1] = (char *) TASKS_DECLARED;
  253.     tup[2] = (char *) SPECS_DECLARED;
  254.     tup[3] = (char *) SUBPROG_SPECS; /* note 3rd comp was formerly signature*/
  255.     MISC(package_name)       = (char *) tup;
  256.     CODE_SEGMENT_MAP = segment_map_put(CODE_SEGMENT_MAP, CURRENT_CODE_SEGMENT,
  257.       CODE_SEGMENT);
  258. }
  259.  
  260. void unit_package_body(Node body_node)                    /*;unit_package_body*/
  261. {
  262.     /*
  263.      * Compilation of a library package body.
  264.      * As it is a compilation unit, there is no task link to be preserved
  265.      */
  266.  
  267.     Node    id_node, decl_node, stmts_node, handler_node;
  268.     Symbol    package_name, package_proc, name, temp_name;
  269.     Tuple    tup, stub_tup;
  270.     int        si;
  271.     Segment    stemplate;
  272.     struct    tt_subprog *tptr;
  273.     int        i, n, stub_cs; 
  274.     unsigned int patch_addr;
  275.     Stubenv    ev;
  276.     Tuple    local_reference_map_new();
  277.  
  278. #ifdef TRACE
  279.     if (debug_flag)
  280.         gen_trace_node("UNIT_PACKAGE_BODY", body_node);
  281. #endif
  282.  
  283.     id_node = N_AST1(body_node);
  284.     decl_node = N_AST2(body_node);
  285.     stmts_node = N_AST3(body_node);
  286.     handler_node = N_AST4(body_node);
  287.     package_name = N_UNQ(id_node);
  288.     tup = (Tuple) MISC(package_name);
  289.     TASKS_DECLARED = (tup != (Tuple)0) ? (int) tup[1] : FALSE;
  290.  
  291.     SUBPROG_SPECS = (tup != (Tuple)0) ? tup_copy((Tuple) tup[3]) : tup_new(0);
  292.  
  293.     /* trivial case: this is a dummy package body and no task declared in */
  294.     /* the specification part. If it is a subunit, we must generate it */
  295.     /* anyhow, as the corresponding call has been generated. */
  296.     /*
  297.      *   if blk=[] and not TASKS_DECLARED and not is_subunit(unit_name) then
  298.      *    return;
  299.      *   end if;
  300.      */
  301.  
  302.     /* Create associated name for proc. to elaborate body. */
  303.     /* package_proc           = package_name+'_body';*/
  304.     /* Only add the package_proc to GENERATED_OBJECTS if it is not
  305.      * a subunit because in the case of a subunit it already exists
  306.      * in the unit which contained the stub.
  307.      */
  308.     if (is_subunit(unit_name)) {
  309.         package_proc = assoc_symbol_get(package_name, INIT_BODY);
  310.     }
  311.     else {
  312.         package_proc = sym_new(na_procedure);
  313.         assoc_symbol_put(package_name, INIT_BODY, package_proc);
  314.         generate_object(package_proc);
  315.     }
  316.     NATURE   (package_proc) = na_procedure;
  317.     TYPE_OF  (package_proc) = symbol_none;
  318.     SIGNATURE(package_proc) = tup_new(0);
  319.     ORIG_NAME(package_proc) = ORIG_NAME(package_name);
  320.     CURRENT_DATA_SEGMENT = select_entry(SELECT_DATA, package_proc, SLOTS_DATA);
  321.     if (is_subunit(unit_name)) {
  322.         si = stub_numbered(unit_name);
  323.         stub_tup = (Tuple) stub_info[si];
  324.         ev = (Stubenv) stub_tup[2];
  325.         /*CURRENT_LEVEL     = STUB_ENV(unit_name)(10);*/
  326.         /* CURRENT_LEVEL = ev->ev_current_level; */
  327.         CURRENT_LEVEL = current_level_get(unit_name);
  328.         CURRENT_CODE_SEGMENT = select_entry(SELECT_CODE, package_proc,
  329.           SLOTS_CODE_BORROWED);
  330.         /* package_procedure object and template already generated */
  331.     }
  332.     else {
  333.         CURRENT_LEVEL       = 1;
  334.         CURRENT_CODE_SEGMENT = select_entry(SELECT_CODE, package_proc,
  335.           SLOTS_CODE);
  336.         next_global_reference_r(package_proc, CURRENT_CODE_SEGMENT, 0);
  337.     }
  338.     LAST_OFFSET           = -SFP_SIZE;
  339.     MAX_OFFSET           = 0;
  340.     /* TBSL: see if can free prior value of local reference map DS 23-may*/
  341.     LOCAL_REFERENCE_MAP = local_reference_map_new();
  342.     /* TBSL: see if can free current value of relay set */
  343.     RELAY_SET           = tup_new(0);
  344. #ifdef MACHINE_CODE
  345.     if (list_code) {
  346.         to_gen_int("       data slot # ", CURRENT_DATA_SEGMENT);
  347.         to_gen_int("       code slot # ", CURRENT_CODE_SEGMENT);
  348.         to_gen(" ");
  349.     }
  350. #endif
  351.     gen(I_LEAVE_BLOCK);
  352.     gen(I_RAISE);
  353.  
  354.     if (TASKS_DECLARED) {
  355.         gen_ks(I_PUSH, mu_word, assoc_symbol_get(package_name, INIT_TASKS));
  356.         gen(I_LINK_TASKS_DECLARED);
  357.     }
  358.  
  359.     compile(decl_node);
  360.     if (TASKS_DECLARED)
  361.         gen(I_ACTIVATE);
  362.  
  363.     compile_body(OPT_NODE, stmts_node, handler_node, FALSE);
  364.  
  365.     /*MAX_OFFSET max= abs LAST_OFFSET;*/
  366.     MAX_OFFSET = offset_max(MAX_OFFSET, LAST_OFFSET);
  367.     /* GBSL: check that MAX_OFFSET and SFP_SIZE in bytes, else need to adjust*/
  368.     gen_ic(I_DATA, MAX_OFFSET-SFP_SIZE, "size of local objects");/*GBSL*/
  369.     gen(I_END);
  370.  
  371.     /* This subprogram has no parameters... */
  372.  
  373.     if (is_subunit(unit_name)) {
  374.         si = stub_numbered(unit_name); /* get stub index */
  375.         stub_tup = (Tuple) stub_info[si];
  376.         ev = (Stubenv) stub_tup[2];
  377.         ev->ev_relay_set = RELAY_SET; /* see if copy needed below*/
  378.         /*STUB_ENV(unit_name)(8) = RELAY_SET;*/
  379.         /*STUB_ENV(unit_name)(9) = DANGLING_RELAY_SETS;*/
  380.         ev->ev_dangling_relay_set  = DANGLING_RELAY_SETS;
  381.     }
  382.     else if (tup_size(RELAY_SET) != 0 || tup_size(DANGLING_RELAY_SETS) != 0) {
  383.         chaos("Relay set at level 1");
  384.     }
  385.  
  386.     /* Remaining elements in SUBPROG_PATCH are procedures declared in a */
  387.     /* package spec whose body is separate. Generate corresponding */
  388.     /* procedure templates. Those templates must be declared as */
  389.     /* generated objects, as they will be referenced by other units. */
  390.     /* Information in symbol tables is irrelevant, and left as OM. */
  391.  
  392.     n = tup_size(SUBPROG_PATCH);
  393.     /*loop forall patch_addr = SUBPROG_PATCH(name) do*/
  394.     for (i = 1; i <= n; i+=2) {
  395.         name = (Symbol) SUBPROG_PATCH[i];
  396.         patch_addr = (unsigned int) SUBPROG_PATCH[i+1];
  397.         temp_name = new_unique_name("proc_template"); /* associated name */
  398.         assoc_symbol_put(name, PROC_TEMPLATE, temp_name);
  399.         generate_object(temp_name);
  400.         stub_cs = select_entry(SELECT_CODE, name, SLOTS_CODE_BORROWED);
  401.         stemplate = template_new(TT_SUBPROG, -1, WORDS_SUBPROG, (int **)&tptr);
  402.         tptr->cs = stub_cs;
  403.         tptr->relay_slot = stub_cs; /* relay_slot */
  404.         next_global_reference_template(temp_name, stemplate);
  405.         segment_free(stemplate);
  406.         reference_of(temp_name);
  407.         segment_set_pos(CODE_SEGMENT, patch_addr, 0);
  408.         segment_put_ref(CODE_SEGMENT, REFERENCE_SEGMENT, (int)REFERENCE_OFFSET);
  409.         segment_set_pos(CODE_SEGMENT, 0, 2); /* reposition to end */
  410.     }
  411.  
  412.     CODE_SEGMENT_MAP = segment_map_put(CODE_SEGMENT_MAP, CURRENT_CODE_SEGMENT,
  413.       CODE_SEGMENT);
  414.  
  415. #ifdef MACHINE_CODE
  416.     if (list_code) {
  417.         to_gen(" ");
  418.         to_gen(" --- Local reference map :");
  419.         to_gen_int("       Parameter offset = ", MAX_OFFSET);
  420.         print_ref_map_local();
  421.     }
  422. #endif
  423. }
  424.