" BEGIN fort_macros.incl.alm " " Written: June 1976, R. A. Barnes " " Modified: " 22 June 84, MM - Install typeless functions support. " 28 Mar 84, HH - Install HFP support. " 10 January 1982, TO - Add 'emit_entry_defs' (simple). " 3 January 1982, TO - Add 'even' pseudo for ext_cg optimization " of DO-loop top label. " 29 Nov 82, HH - 361: Remove 'get_format_var'. " 21 September 1982, TO - Add emit_storage_args. " 7 September 1982, TO - Add emit_cleanup_args. " 1 September 1982, TO - Add if/unless_cleanup. " 1 September 1982, TO - Add if/unless_storage_created, if/unless_VLA. " 3 May 1982, TO - Add (if/unless)_char_star_function. " 3 May 1982, TO - Add (if/unless)_check_multiply. " 27 July 1981, CRD - Add get_format_var. " 2 June 1981, CRD - Add push_sf_arg_count. " 24 September 1980, CRD - Change desc_ptr_in_base to be a simple " macro (desc_ptr_in_pr3), and add arg_ptr_in_pr1. " 16 July 1980, CRD - Add (if unless)_variable_arglist. " 15 July 1980, CRD - Add set_needs_descriptors " 23 June 1980, CRD - Add (if unless)_ansi77. " 11 June 1980, CRD - add push_operand_count. " 17 April 1980, CRD - add set_next_operand. " 4 March 1980, CRD - add many new macros for concatenation. " 23 February 1980, RAB - add float_power_of_two " 7 February 1980, CRD - Add int_to_char1 and char1_to_int. " 27 January 1980, RAB - Add force_ql. " 24 January 1980, CRD - Add desc_ptr_in_base. " 18 January 1980, CRD - Add free_descriptors. " 27 December 1979, RAB - Add refresh_regs_if_next_is_jump and " note_eligible_ind_var_use for register optimizer " 30 November 1979, RAB - Add (if unless)_global, " (if unless)_induction_var, (if unless)_fb17, " (if unless)_global_ind_var, assign_index, compare_index, " test_index, increment_index, and decrement_index " macros for the register optimizer. " 3 November 1979, RAB - Remove obsolete version 1 macros indirect_scan " and finish_indirect_scan. Add load_xreg, load_preg, and " refresh_regs macros for the register optimizer. " 16 October 1979, CRD - add two new macros, set_inds_valid and " ind_to_a. set_inds_valid is used to update the " machine state when an instruction has been emitted that " (1) set the indicators, (2) modifies the eaq, and (3) " leaves the indicators valid for some register other than " the one it modifies. ind_to_a is used to force logical " temporaries from the indicators to the A register without " losing the fact that indicators are valid for the A, as " use_ind does. " 15 October 1979, CRD - change if_ind and unless_ind to take an " eaq_name. " 25 July 1979, CRD - add tables of opcodes in comments. " 25 July 1979, CRD - add many more meta macros. " 24 July 1979, CRD - add def_left, def_1op, and def_1op_left meta " macros. This localizes macro definitions and reduces the " possibility of misdefining a macro instruction. " 23 July 1979, CRD - add def_simple_cond, def_1op_cond meta macros. " Use if_bit to compress some if/unless pairs into a single " opcode. " 23 July 1979, CRD - add def_simple meta macro, move opcodes of simple " macro instructions to left half. " 20 July 1979, CRD - remove obsolete version 1 optimizer macros " 18 Nov 1978, RAB - macros to support centralized rounding: " round, set_rounded, store no_update. " 29 March 1978, DSL - Change insert_bits to free_temp (39) " January, February 1978 DSL - Add new macros for version II optimizer. " 20 December 1977 DSL - have v1opt and v2opt macros use the same " macro numbers. " 1 December 1977, D. S. Levin to add macros for v2 optimizer and " restructure. " 1 May 1977, R.A. Barnes to add store macro " April 1976, G. D. Chang to add the save_state macro. " META MACROS USED TO CREATE LANGUAGE MACROS " " int_dat_var " macro int_dat_var ife &1,var zero -1,inhibit+&2 ifend_exit ifint &1 zero &1,inhibit+&2 ifend_exit zero 0,&1n+inhibit+&2 &end " " array " macro array &(&=&x,1&[ vfd &;,&]18/&i&) equ &2,&x-1 &end " " scan_label " macro scan_label ife &1,next zero &3,&2 ifend_exit ife &1,continue zero &4,&2 ifend_exit zero &1,&2 &end " " if_mac2 " macro if_mac2 ife &3,op1 zero &4,&1+2048*&2+768+inhibit+&5 ifend ine &3,op1 zero &4,&1+2048*&2+256*&3+inhibit+&5 ifend &end " " if_mac1 " macro if_mac1 ife &2,< if_mac2 &1,0,&3,&4,&5 ifend_exit ife &2,> if_mac2 &1,1,&3,&4,&5 ifend_exit ife &2,= if_mac2 &1,2,&3,&4,&5 ifend_exit ife &2,^= if_mac2 &1,3,&3,&4,&5 ifend_exit ife &2,<= if_mac2 &1,4,&3,&4,&5 ifend_exit ife &2,>= if_mac2 &1,5,&3,&4,&5 ifend_exit &end " " rest_of_error " macro rest_of_error ife &1,() ifend_exit ife &1,ascii vfd 18/&U,10/&l2,1/1,7/67 use .strings. &U: aci "&2" use .text. rest_of_error &FQ3 ifend_exit zero 0,&1+inhibit+67 rest_of_error &FQ2 &end " " def_simple " macro def_simple macro &1 zero &2,inhibit+6 &&end &end " " def_simple_cond " macro def_simple_cond macro if_&1 zero &&1,if_bit+inhibit+&2 &&end macro unless_&1 zero &&1,inhibit+&2 &&end &end " " def_1op_cond " macro def_1op_cond macro if_&1 zero &&2,&&1+if_bit+inhibit+&2 &&end macro unless_&1 zero &&2,&&1+inhibit+&2 &&end &end " " def_1op " macro def_1op macro &1 zero 0,&&1+inhibit+&2 &&end &end " " def_left " macro def_left macro &1 zero &&1,inhibit+&2 &&end &end " " def_leftn " macro def_leftn macro &1 zero &&1n,inhibit+&2 &&end &end " " def_1op_left " macro def_1op_left macro &1 zero &&2,&&1+inhibit+&2 &&end &end " " def_1op_left_flag " macro def_1op_left_flag macro &1 ife &&3,() zero &&2,&&1+inhibit+&2 ifend_exit zero &&2,&&1+&&3+inhibit+&2 &&end &end " " def_int_dat_var " macro def_int_dat_var macro &1 int_dat_var &&1,&2 &&end &end " " def_type_cond " macro def_type_cond macro &1 zero &&2,&&(1&&i+&&)inhibit+&2 &&end &end " " def_2op_left " macro def_2op_left macro &1 zero &&3,&&2+&&1+inhibit+&2 &&end &end " " def_array1 " macro def_array1 macro &1 zero &&U,inhibit+&2 array (&&1),&&U &&end &end " " def_array2 " macro def_array2 macro &1 zero &&U,&&1+inhibit+&2 array (&&2),&&U &&end &end " " def_2op " macro def_2op macro &1 zero 0,&&1+&&2+inhibit+&2 &&end &end " " def_1op_optleft " macro def_1op_optleft macro &1 ine &&2,() zero &&2,&&1+inhibit+&2 ifend_exit zero 0,&&1+inhibit+&2 &&end &end " " def_1op_flag " macro def_1op_flag macro &1 ife &&1,() zero 0,inhibit+&2 ifend_exit zero 1,&&1+inhibit+&2 &&end &end " " def_general_cond " macro def_general_cond macro &1 if_mac1 &&1,&&2,&&3,&&4,&2 &&end &end " " def_1op_name " macro def_1op_name macro &1 zero 0,&&1n+inhibit+&2 &&end &end " " def_2op_name " macro def_2op_name macro &1 zero &&1n,&&2+inhibit+&2 &&end &end " TABLE OF OPCODE ASSIGNMENTS " " NOTE: If you change any of these opcode assignments, be sure to " change BOTH ext_code_generator and fort_optimizing_cg!!! " " " 1 copy " 2 swap " 3 pop " 4 push_temp " 5 push_variable " 6 used for extended opcode dispatch " 7 emit_eis " 8 push_constant " 9 convert_constant " 10 push_count_indexed " 11 push_builtin " 12 proc " 13 func " 14 call " 15 return " 16 jump " 17 scan " 18 exit " 19 s_call " 20 set_inds_valid " 21 if_dt " 22 unless_dt " 23 if_optype " 24 unless_optype " 25 (if unless)_array " 26 (if unless)_aligned " 27 if_eaq " 28 unless_eaq " 29 dt_jump " 30 ind_jump " 31 if " 32 unless " 33 jump_indexed " 34 emit, emit_data, emit_inst " 35 label " 36 rel_con " 37 set_rel_constant " 38 add_to_address " 39 free_temp " 40 reserve_regs " 41 load_pr " 42 use_a " 43 use_q " 44 make_addressable " 45 use_eaq " 46 load " 47 load_top " 48 in_reg " 49 refresh_regs " 50 push_sf_arg_count " 51 increment " 52 decrement " 53 multiply " 54 push_count " 55 push_bif_index " 56 (if unless)_saving_stack_extent " 57 start_cat " 58 shorten_stack " 59 set_next_operand " 60 (if unless)_ansi77 " 61 s_func_label " 62 push_s_func_label " 63 push_s_func_var " 64 push_array_size " 65 print " 66 error " 67 used by rest_of_error " 68 push_length " 69 (if unless)_variable_arglist " 70 used by call " 71 used by make_addressable " 72 if_ind " 73 unless_ind " 74 (if unless)_char_star_function " 75 (if unless)_check_multiply " 76 make_io_desc " 77 (if unless)_one_word_dt " 78 assign_entry " 79 (if unless)_storage_created " 80 push_char_temp " 81 (if unless)_parameter " 82 (if unless)_global " 83 (if unless)_induction_var " 84 (if unless)_fb17 " 85 (if unless)_negative " 86 (if unless)_global_ind_var " 87 (if unless)_local " 88 (if unless)_VLA " 89 (if unless)_main " 90 (if unless)_cleanup " 91 (if unless)_constant_addrs " 92 (if unless)_hfp " 93 get_quick_label " 94 UNUSED " 95 (if unless)_needs_descriptors " 96 UNUSED " 97 UNUSED " 98 UNUSED " 99 (if unless)_namelist_used " 100 UNUSED " 101 if_next_statement " 102 unless_next_statement " 103 UNUSED " 104 push_operand " 105 compare " 106 UNUSED " 107 UNUSED " 108 round " 109 flush_ref " 110 save_state " 111 store " 112 load_pr_value " 113 load_for_test " 114 set_in_storage " 115 bump " 116 drop " 117 UNUSED " 118 (if unless)_zero " 119 UNUSED " 120 UNUSED " 121 push_ref_count " 122 UNUSED " 123 float_power_of_fpbase " 124 dt_jump1 " 125 pad_char_const_to_word " 126 pad_char_const_to_dw " 127 power_of_two " LANGUAGE MACROS " " def_1op copy,1 " copy opname def_1op swap,2 " swap opname def_1op pop,3 " pop opname def_int_dat_var push_temp,4 " push_temp {int|dt_name|var} def_1op_name push_variable,5 " push_variable dt_name def_left emit_eis,7 " emit_eis [equal_lengths] def_int_dat_var push_constant,8 " push_constant {int|dt_name|var} def_1op_name convert_constant,9 " convert_constant dt_name def_array2 push_count_indexed,10 " push_count_indexed opname,(count,...) def_left push_builtin,11 " push_builtin builtin_name macro proc " proc {int|var} [,error_lbl] vfd 18/&2,10/&1,1/1,7/12 &end macro func " func {int|var} [,error_lbl] vfd 18/&2,10/&1,1/1,7/13 &end macro call " call lbl,[error_lbl] ife &2,() zero &1,inhibit+14 ifend_exit zero &1,inhibit+70 zero &2 &end def_1op_flag return,15 " return [eaq_name|opname] def_left jump,16 " jump lbl macro scan " scan err_lbl,(exit_lbl...) &u: ife &1,continue zero *,inhibit+17 ifend ine &1,continue scan_label &1,inhibit+17,&U,&p ifend &(2 scan_label &i,inhibit+16,&U,&p &) &U: &end def_left exit,18 " exit integer def_left s_call,19 " s_call lbl def_1op set_inds_valid,20 " set_inds_valid eaq_name def_type_cond if_dt,21 " if_dt (dt_name...),lbl def_type_cond unless_dt,22 " unless_dt (dt_name...),lbl def_type_cond if_optype,23 " if_optype (dt_name...),lbl def_type_cond unless_optype,24 " unless_optype (dt_name...),lbl def_simple_cond array,25 " (if unless)_array lbl def_1op_cond aligned,26 " (if unless)_aligned opname,lbl def_2op_left if_eaq,27 " if_eaq eaq_name,opname,lbl def_2op_left unless_eaq,28 " unless_eaq eaq_name,opname,lbl def_array1 dt_jump,29 " dt_jump (lbl,...) def_array1 ind_jump,30 " ind_jump (lbl,...) def_general_cond if,31 " if opname,relop,opname,lbl def_general_cond unless,32 " unless opname,relop,opname,lbl def_array2 jump_indexed,33 " jump_indexed opname,(lbl,...) def_left emit,34 " emit integer def_left emit_data,34 " emit_data integer macro emit_inst " emit_inst integer zero &1,inst_word+inhibit+34 &end def_1op label,35 " label opname def_1op rel_con,36 " rel_con opname def_1op set_rel_constant,37 " set_rel_constant opname def_1op_flag add_to_address,38 " add_to_address [opname] def_1op free_temp,39 " free_temp opname macro reserve_regs " reserve_regs (xpr_name,...) &(&=&x,1&[zero &;+&]&i&),inhibit+40 &end def_2op_name load_pr,41 " load_pr pr_name,opname def_left use_a,42 " use_a [protect_indicators] def_left use_q,43 " use_q [protect_indicators] macro make_addressable " make_addressable opname[,opname] ife &2,() zero 0,&1+inhibit+44 ifend_exit zero &2,&1+inhibit+71 &end def_left use_eaq,45 " use_eaq [protect_indicators] def_2op load,46 " load eaq_name,opname def_1op_optleft load_top,47 " load_top eaq_name[,lbl] def_2op in_reg,48 " in_reg eaq_name,opname def_left refresh_regs,49 " refresh_regs [protect_indicators] def_1op push_sf_arg_count,50 " push_sf_arg_count opname def_1op_left increment,51 " increment opname,int def_1op_left decrement,52 " decrement opname,int def_1op_left multiply,53 " multiply opname,int def_left push_count,54 " push_count integer def_1op push_bif_index,55 " push_bif_index opname def_simple_cond saving_stack_extent,56 " (if unless)_saving_stack_extent lbl def_left start_cat,57 " start_cat lbl def_left shorten_stack,58 " shorten_stack [protect_indicators] def_left set_next_operand,59 " set_next_operand opno def_simple_cond ansi77,60 " (if unless)_ansi77 lbl def_1op s_func_label,61 " s_func_label opname def_1op push_s_func_label,62 " push_s_func_label opname def_1op_left push_s_func_var,63 " push_s_func_var opname,lbl def_1op push_array_size,64 " push_array_size opname macro print " print errno,opname,... &u: vfd 18/&1,10/&U,1/1,7/65 rest_of_error &FQ2 equ &U,*-&p-1 &end macro error " error errno,opname,... ine &1,() &u: vfd 18/&1,10/&U,1/1,7/66 rest_of_error &FQ2 equ &U,*-&p-1 ifend_exit zero 0,inhibit+66 &end def_1op push_length,68 " push_length opname def_1op_cond variable_arglist,69 " (if unless)_variable_arglist opname,lbl def_1op_left if_ind,72 " if_ind eaq_name,lbl def_1op_left unless_ind,73 " unless_ind eaq_name,lbl def_simple_cond char_star_function,74 " (if unless)_char_star_function def_simple_cond check_multiply,75 " (if unless)_check_multiply def_left make_io_desc,76 " make_io_desc bits def_1op_cond one_word_dt,77 " (if unless)_one_word_dt,lbl def_1op assign_entry,78 " assign_entry opname def_simple_cond storage_created,79 " (if unless)_storage_created lbl def_int_dat_var push_char_temp,80 " push_char_temp {int|dt_name|var} def_1op_cond parameter,81 " (if unless)_parameter opname,lbl def_1op_cond global,82 " (if unless)_global opname,lbl def_1op_cond induction_var,83 " (if unless)_induction_var opname,lbl def_1op_cond fb17,84 " (if unless)_fb17 opname,lbl def_1op_cond negative,85 " (if unless)_negative opname,lbl def_1op_cond global_ind_var,86 " (if unless)_global_ind_var opname,lbl def_1op_cond local,87 " (if unless)_local opname,lbl def_1op_cond VLA,88 " (if unless)_VLA opname,lbl def_simple_cond main,89 " (if unless)_main lbl def_simple_cond cleanup,90 " (if unless)_cleanup lbl def_simple_cond constant_addrs,91 " (if unless)_constant_addrs lbl def_simple_cond hfp,92 " (if unless)_hfp lbl def_1op get_quick_label,93 " get_quick_label opname def_1op_cond needs_descriptors,95 " (if unless)_needs_descriptors opname,lbl def_simple_cond namelist_used,99 " (if unless)_namelist_used lbl def_1op_left if_next_statement,101 " if_next_statement opname,lbl def_1op_left unless_next_statement,102 " unless_next_statement opname,lbl def_left push_operand,104 " push_operand lbl def_2op compare,105 " compare eaq_name,opname def_1op round,108 " round eaq_name def_1op flush_ref,109 " flush_ref opname def_1op_optleft save_state,110 " save_state opname[,discard] macro store " store eaq_name,opname[,??] zero &=&3,no_update&[1&;0&],&1+&2+inhibit+111 &end def_2op_name load_pr_value,112 " load_pr_value eaq_name,opname def_2op load_for_test,113 " load_for_test eaq_name,opname def_1op set_in_storage,114 " set_in_storage opname macro bump " bump opname[,integer] zero &=&2,&[1&;&2&],&1+inhibit+115 &end macro drop " drop opname[,integer] zero &=&2,&[1&;&2&],&1+inhibit+116 &end def_1op_cond zero,118 " (if unless)_zero opname,lbl def_1op push_ref_count,121 " push_ref_count opname def_1op_left_flag float_power_of_fpbase,123 def_array2 dt_jump1,124 " dt_jump1 opname,(lbl,...) def_1op pad_char_const_to_word,125 " pad_char_const_to_word opname def_1op pad_char_const_to_dw,126 " pad_char_const_to_dw opname def_1op_left power_of_two,127 " power_of_two opname,lbl " " " Macro numbers cannot exceed 127. " TABLE OF SIMPLE OPCODES " " NOTE: If you add to or change any of these opcode assignments, be " sure to change BOTH ext_code_generator and fort_optimizing_cg!!! " " " 1 push_label " 2 push_rel_constant " 3 s_return " 4 free_regs " 5 reset_regs " 6 reset_eaq " 7 use_ind " 8 start_subscript " 9 next_subscript " 10 finish_subscript " 11 subscript_error " 12 s_func_finish " 13 end_unit " 14 stat " 15 check_parameters " 16 check_arg_list " 17 store_arg_addrs " 18 gen_itp_list " 19 make_descriptors " 20 set_runtime_block_loc " 21 optimized_subscript " 22 sub_index " 23 discard_state " 24 push_output " 25 bump_args " 26 drop_args " 27 push_operand_count " 28 skip_data " 29 set_rounded " 30 load_xreg " 31 load_preg " 32 drop_all_counts " 33 ind_to_a " 34 assign_index " 35 compare_index " 36 test_index " 37 increment_index " 38 decrement_index " 39 make_substring " 40 refresh_regs_if_next_is_jump " 41 note_eligible_ind_var_use " 42 free_descriptors " 43 force_ql " 44 int_to_char1 " 45 char1_to_int " 46 continue_cat " 47 finish_cat " 48 set_needs_descriptors " 49 desc_ptr_in_pr3 " 50 arg_ptr_in_pr1 " 52 emit_cleanup_args " 53 emit_storage_args " 54 emit_profile_entry " 55 force_even " 56 emit_entry_defs " 57 rhs_fld " 58 lhs_fld " SIMPLE LANGUAGE MACROS " def_simple push_label,1 def_simple push_rel_constant,2 def_simple s_return,3 def_simple free_regs,4 def_simple reset_regs,5 " def_simple reset_eaq,6 def_simple use_ind,7 def_simple start_subscript,8 " def_simple next_subscript,9 " def_simple finish_subscript,10 " def_simple subscript_error,11 " def_simple s_func_finish,12 " def_simple end_unit,13 def_simple stat,14 def_simple check_parameters,15 def_simple check_arg_list,16 def_simple store_arg_addrs,17 def_simple gen_itp_list,18 def_simple make_descriptors,19 def_simple set_runtime_block_loc,20 def_simple optimized_subscript,21 " def_simple sub_index,22 " def_simple discard_state,23 " def_simple push_output,24 " def_simple bump_args,25 " def_simple drop_args,26 " def_simple push_operand_count,27 " def_simple skip_data,28 " def_simple set_rounded,29 " def_simple load_xreg,30 " def_simple load_preg,31 " def_simple drop_all_counts,32 " def_simple ind_to_a,33 " def_simple assign_index,34 " def_simple compare_index,35 " def_simple test_index,36 " def_simple increment_index,37 " def_simple decrement_index,38 " def_simple make_substring,39 " def_simple refresh_regs_if_next_is_jump,40 " def_simple note_eligible_ind_var_use,41 " def_simple free_descriptors,42 def_simple force_ql,43 " def_simple int_to_char1,44 def_simple char1_to_int,45 def_simple continue_cat,46 def_simple finish_cat,47 def_simple set_needs_descriptors,48 def_simple desc_ptr_in_pr3,49 def_simple arg_ptr_in_pr1,50 def_simple emit_cleanup_args,52 def_simple emit_storage_args,53 def_simple emit_profile_entry,54 def_simple force_even,55 def_simple emit_entry_defs,56 def_simple rhs_fld,57 def_simple lhs_fld,58 " " END fort_macros.incl.alm " " " ----------------------------------------------------------- " " " " Historical Background " " This edition of the Multics software materials and documentation is provided and donated " to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. " as a contribution to computer science knowledge. " This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, " Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull " and Bull HN Information Systems Inc. to the development of this operating system. " Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), " renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership " of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for " managing computer hardware properly and for executing programs. Many subsequent operating systems " incorporated Multics principles. " Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., " as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . " " ----------------------------------------------------------- " " Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without " fee is hereby granted,provided that the below copyright notice and historical background appear in all copies " and that both the copyright notice and historical background and this permission notice appear in supporting " documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining " to distribution of the programs without specific prior written permission. " Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. " Copyright 2006 by Bull HN Information Systems Inc. " Copyright 2006 by Bull SAS " All Rights Reserved " "