COMPILATION LISTING OF SEGMENT graphic_manipulator_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/18/82 1638.6 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 graphic_manipulator_: gm_: procedure; return; 19 20 /* graphic_manipulator_.pl1 - Entry points for maipulating a Multics standard 21* graphic structure */ 22 23 /* Originally coded 7/73 by Lee J. Scheffler */ 24 /* Modified many times since by C. D. Tavares. */ 25 /* Modified 08/79 by CDT as part of the general lsm_ overhaul */ 26 /* Modified 03/25/80 by CDT to fix an unset pointer bug in ecolor. */ 27 /* Modified 10/14/80 by CDT to inhibit storing of trailing zeroes 28* for positional elements and some others, and to use gc_$prune_tree. */ 29 /* Last modified 04/14/81 by CDT to make replace_element accept -1 index */ 30 31 /* System entry points */ 32 33 dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, pointer, fixed bin (35)), 34 get_temp_segment_ ext entry (char (*), pointer, fixed bin (35)); 35 36 /* System-wide error codes */ 37 38 dcl (graphic_error_table_$no_wgs_yet, /* no working graphic seg yet */ 39 graphic_error_table_$null_replacement, /* tried to replace_node a node with the null node */ 40 graphic_error_table_$list_oob, /* attempt to idx outside list */ 41 graphic_error_table_$bad_align, /* bad alignment for char string */ 42 graphic_error_table_$inv_node_type, /* invalid effector type for this operation */ 43 error_table_$smallarg) /* caller-provided array is too small */ 44 fixed bin (35) external; 45 46 dcl err_code fixed bin (35) parameter; /* error code */ 47 48 49 dcl (addr, dim, hbound, mod, null, substr) builtin; 50 51 52 /* Static variables */ 53 54 dcl wgs_p pointer static initial (null); /* points to current WGS */ 55 56 57 dcl (node_no, list_n, new_n, node_n, value_n, old_n, template_n) fixed bin (18); /* node #s */ 58 59 dcl (etype, type) fixed bin, /* Graphic effector codes */ 60 ltype fixed bin; /* lsm_ block types */ 61 62 dcl (curl, arrayl, idx) fixed bin; /* lengths of various things */ 63 64 dcl effector_p pointer; 65 66 dcl array (*) fixed bin (18); /* array of node numbers for list creation and examination */ 67 68 dcl (name, /* name of a symbol */ 69 dname) /* pathname of a directory */ 70 char (*); 71 72 1 1 /* --------------- BEGIN include file graphic_etypes.incl.pl1 --------------- */ 1 2 1 3 /* Types of position, mode, and other effectors for the 1 4* Multics General Graphic System */ 1 5 1 6 1 7 /* Null code */ 1 8 1 9 dcl (Null initial (-1), 1 10 1 11 /* Position codes */ 1 12 1 13 Setposition initial (0), 1 14 Setpoint initial (1), 1 15 Vector initial (2), 1 16 Shift initial (3), 1 17 Point initial (4), 1 18 1 19 /* Mode codes, with values where appropriate */ 1 20 1 21 Scaling initial (8), 1 22 Rotation initial (9), 1 23 Clipping initial (10), 1 24 1 25 Intensity initial (16), 1 26 Full_intensity initial (7), 1 27 Half_intensity initial (3), 1 28 Invisible initial (0), 1 29 1 30 Linetype initial (17), 1 31 Solid initial (0), 1 32 Dashed initial (1), 1 33 Dotted initial (2), 1 34 Dash_dotted initial (3), 1 35 Long_dashed initial (4), 1 36 1 37 Sensitivity initial (18), 1 38 Sensitive initial (1), 1 39 Insensitive initial (0), 1 40 1 41 Blink initial (19), 1 42 Steady initial (0), 1 43 Blinking initial (1), 1 44 1 45 Color initial (20), 1 46 1 47 Symbol initial (24), 1 48 1 49 /* Text code, with legal alignments */ 1 50 1 51 Text initial (25), 1 52 Upper_left initial (1), 1 53 Upper_center initial (2), 1 54 Upper_right initial (3), 1 55 Left initial (4), 1 56 Center initial (5), 1 57 Right initial (6), 1 58 Lower_left initial (7), 1 59 Lower_center initial (8), 1 60 Lower_right initial (9), 1 61 1 62 /* Datablock code */ 1 63 1 64 Datablock initial (26), 1 65 1 66 /* Structural effector codes */ 1 67 1 68 List initial (32), 1 69 Array initial (33), 1 70 1 71 /* Merge codes for gm_$get_struc and gm_$put_struc */ 1 72 1 73 On_dup_error initial (0), /* allow no name duplications */ 1 74 On_dup_source initial (1), /* on name dup, force move (use source copy) */ 1 75 On_dup_target_then_nulls initial (2), /* on name dup, use target copy, for nondup symbols create null ones */ 1 76 On_dup_target_then_source initial (3), /* on name dup, use target copy, for nondup symbols, use source copy */ 1 77 1 78 /* Device codes for graphic input devices */ 1 79 1 80 Terminal_program initial (0), 1 81 Keyboard initial (1), 1 82 Mouse initial (2), 1 83 Joystick initial (3), 1 84 Tablet_and_pen initial (4), 1 85 Light_pen initial (5), 1 86 Trackball initial (6), 1 87 Any_device initial (63)) /* 63 is equivalent to -1 in SPI */ 1 88 1 89 fixed bin internal static options (constant); 1 90 1 91 /* ---------------- END include file graphic_etypes.incl.pl1 ---------------- */ 73 74 2 1 /* Begin include file . . . graphic_templates.incl.pl1 */ 2 2 2 3 dcl Symboltable init (34) fixed bin internal static options (constant); 2 4 2 5 dcl effector_length (0:31) fixed bin static options (constant) initial 2 6 (4, 4, 4, 4, 4, (3) 0, 2 7 4, 4, 7, (5) 0, 2 8 2, 2, 2, 2, 4, (3) 0, /* numbers of words taken up by each flavor effector */ 2 9 (8) 0); 2 10 2 11 2 12 /* Structure of graphic effectors */ 2 13 2 14 dcl 1 effector based aligned, 2 15 2 effector_code fixed bin (6), 2 16 2 data (65535) fixed bin (35); 2 17 2 18 dcl 1 floating_effector based aligned, 2 19 2 effector_code fixed bin (6), 2 20 2 data (65535) float bin (27); 2 21 2 22 dcl 1 position_effector based aligned, 2 23 2 effector_code fixed bin (6), 2 24 2 xpos float bin, 2 25 2 ypos float bin, 2 26 2 zpos float bin; 2 27 2 28 dcl 1 scale_effector based aligned, 2 29 2 effector_code fixed bin (6), 2 30 2 xscale float bin, 2 31 2 yscale float bin, 2 32 2 zscale float bin; 2 33 2 34 dcl 1 rotate_effector based aligned, 2 35 2 effector_code fixed bin (6), 2 36 2 xangle float bin, 2 37 2 yangle float bin, 2 38 2 zangle float bin; 2 39 2 40 dcl 1 clipping_effector based aligned, 2 41 2 effector_code fixed bin (6), 2 42 2 delta_left float bin, 2 43 2 delta_right float bin, 2 44 2 delta_bottom float bin, 2 45 2 delta_top float bin, 2 46 2 delta_back float bin, 2 47 2 delta_front float bin; 2 48 2 49 dcl 1 modal_effector based aligned, 2 50 2 effector_code fixed bin (6), 2 51 2 mode fixed bin; 2 52 2 53 dcl 1 color_effector based aligned, 2 54 2 effector_code fixed bin (6), 2 55 2 red_intensity fixed bin, 2 56 2 green_intensity fixed bin, 2 57 2 blue_intensity fixed bin; 2 58 2 59 dcl 1 text_effector based aligned, 2 60 2 alignment fixed bin (8) unaligned, 2 61 2 text char (262140) unaligned; 2 62 2 63 /* End include file ... graphic_templates.incl.pl1 */ 75 76 3 1 /* Begin include file . . . lsm_formats.incl.pl1 */ 3 2 3 3 /* CONSTANTS */ 3 4 3 5 dcl (LSM_version_7 initial (7), /* current version, root is always symtab */ 3 6 LSM_version_6 initial (6)) /* root wasn't automatically symtab */ 3 7 fixed bin static options (constant); 3 8 3 9 dcl 1 lsm_constants aligned static options (constant), 3 10 2 n_types fixed bin initial (9), 3 11 2 types, 3 12 3 indirect_type initial (1), 3 13 3 fixed_type initial (2), 3 14 3 float_type initial (3), 3 15 3 bit_type initial (4), 3 16 3 char_type initial (5), 3 17 3 symtab_type initial (6), 3 18 3 symbol_type initial (7), 3 19 3 list_type initial (8), 3 20 3 array_type initial (9), 3 21 2 data_length_factors (9) initial (1, 1, 1, 36, 4, 1, 1, 1, 1), 3 22 2 max_allocation fixed bin initial (4095), 3 23 2 initial_component_slots fixed bin initial (8); 3 24 3 25 dcl lsm_segptr pointer; 3 26 3 27 dcl 1 lsm aligned based (lsm_segptr), /* declaration of head of lsm_ segment */ 3 28 2 version fixed bin, /* number of lsm_ version that created this seg */ 3 29 2 free fixed bin (18), /* word number of first free word in seg */ 3 30 2 root_symtab fixed bin (18), /* node number of the root symbol table */ 3 31 2 lock bit (36) aligned, 3 32 2 component_slots fixed bin, 3 33 2 components fixed bin, 3 34 2 pad (26) fixed bin (18), 3 35 2 component_ptrs (lsm_constants.initial_component_slots refer (lsm.component_slots)) pointer unaligned; 3 36 3 37 3 38 /* Formats of different node types used by lsm_ */ 3 39 3 40 dcl node_ptr pointer; 3 41 3 42 dcl 1 header aligned based (node_ptr), /* Used in all formats below */ 3 43 2 type fixed bin (6) unsigned unaligned, /* type of node */ 3 44 2 allocated_len fixed bin (12) unsigned unaligned, /* allocated length of data space */ 3 45 2 data_len fixed bin (18) unsigned unaligned; /* current length of data in block */ 3 46 /* (in appropriate units) */ 3 47 3 48 dcl 1 any_node aligned based (node_ptr), /* general node description */ 3 49 2 header like header aligned, 3 50 2 data_space (0 refer (any_node.allocated_len)) bit (36) aligned; 3 51 3 52 dcl 1 indirect_node aligned based (node_ptr), /* internal to lsm_ */ 3 53 2 header like header, 3 54 2 new_node fixed bin (18); /* numberof reallocated node */ 3 55 3 56 dcl 1 fixed_node aligned based (node_ptr), /* array of fixed bin (35) */ 3 57 2 header like header, 3 58 2 element (0 refer (fixed_node.data_len)) fixed bin (35); /* array of values */ 3 59 3 60 dcl 1 float_node aligned based (node_ptr), /* array of float binary (27) */ 3 61 2 header like header, 3 62 2 element (0 refer (float_node.data_len)) float bin (27); 3 63 3 64 dcl 1 bit_node aligned based (node_ptr), /* string of bits */ 3 65 2 header like header, 3 66 2 string bit (0 refer (bit_node.data_len)); /* bit string of max length */ 3 67 3 68 dcl 1 char_node aligned based (node_ptr), /* string of characters */ 3 69 2 header like header, 3 70 2 string char (0 refer (char_node.data_len)) unaligned; /* character string of max length */ 3 71 3 72 dcl 1 symtab_node aligned based (node_ptr), /* symbol table node */ 3 73 2 header like header, 3 74 2 bucket_root (0 : 1 refer (symtab_node.data_len)) fixed bin (18); 3 75 /* actually, it is (0 : data_len - 1), but there's no way to do */ 3 76 /* this with a refer option, and it's invalid not to use refer */ 3 77 3 78 dcl 1 symbol_node aligned based (node_ptr), /* symbol node */ 3 79 2 header like header, 3 80 2 name_node fixed bin (18), /* number of character string node containing symbol name */ 3 81 2 value_node fixed bin (18), /* number of node that is the "value" of this symbol */ 3 82 2 next_node fixed bin (18); /* number of next symbol node in this bucket chain */ 3 83 /* =0 if this is last node o chain */ 3 84 3 85 dcl 1 list_node aligned based (node_ptr), /* non-terminal list node */ 3 86 2 header like header, 3 87 2 node (0 refer (list_node.data_len)) fixed bin (18); /* numbers of nodes comprising this list */ 3 88 3 89 dcl 1 array_node aligned based (node_ptr), /* non-terminal list with terminal properties */ 3 90 2 header like header, 3 91 2 node (0 refer (array_node.data_len)) fixed bin (18); /* numbers of nodes comprising this array */ 3 92 3 93 3 94 /* End include file . . . lsm_formats.incl.pl1 */ 77 78 4 1 /* --------------- BEGIN include file lsm_entry_dcls.incl.pl1 --------------- */ 4 2 4 3 dcl lsm_$get_blk entry (ptr, fixed bin (18), fixed bin, fixed bin, ptr, fixed bin (35)), 4 4 lsm_$make_blk entry (ptr, fixed bin (18), fixed bin, fixed bin, ptr, fixed bin (35)), 4 5 lsm_$mk_char entry (ptr, char (*), fixed bin (18)), 4 6 lsm_$replace_blk entry (ptr, fixed bin (18), fixed bin (18), fixed bin (35)), 4 7 lsm_$replicate entry (ptr, fixed bin (18), fixed bin (18), fixed bin (35)), 4 8 lsm_$set_blk entry (ptr, fixed bin (18), fixed bin, fixed bin, ptr, fixed bin (35)); 4 9 4 10 dcl lsm_fs_$compact entry (ptr, fixed bin (18), fixed bin (35)), 4 11 lsm_fs_$free entry (ptr, fixed bin (35)), 4 12 lsm_fs_$init entry (ptr, fixed bin (35)), 4 13 lsm_fs_$init_seg entry (ptr, char (*), char (*), fixed bin, fixed bin (35)), 4 14 lsm_fs_$merge_symbol entry (ptr, ptr, fixed bin (18), bit (1), fixed bin, fixed bin (35)), 4 15 lsm_fs_$move_struc entry (ptr, ptr, fixed bin (18), fixed bin (18), fixed bin (35)), 4 16 lsm_fs_$pull entry (ptr, char (*), char (*), fixed bin (35)), 4 17 lsm_fs_$push entry (ptr, char (*), char (*), fixed bin (35)); 4 18 4 19 dcl lsm_sym_$find_table entry (pointer, fixed bin (18), fixed bin (35)), 4 20 lsm_sym_$sym_list entry (ptr, (*) fixed bin (18), fixed bin, fixed bin (35)), 4 21 lsm_sym_$symk entry (ptr, fixed bin, char (*), fixed bin (18), fixed bin (18), fixed bin (35)), 4 22 lsm_sym_$symn entry (ptr, fixed bin, fixed bin (18), fixed bin (18), fixed bin (18), fixed bin (35)); 4 23 4 24 dcl (Find_symbol initial (0), /* op codes for lsm_sym_$symk and lsm_sym_$symn */ 4 25 Find_or_create_symbol initial (1), 4 26 Create_symbol initial (2), 4 27 Delete_symbol initial (3)) fixed bin static options (constant); 4 28 4 29 dcl (Find_seg initial (0), /* Opcodes for lsm_fs_$init_seg */ 4 30 Create_seg initial (1), 4 31 Clear_seg initial (2)) fixed bin static options (constant); 4 32 4 33 /* ---------------- END include file lsm_entry_dcls.incl.pl1 ---------------- */ 79 80 5 1 /* *************** BEGIN INCLUDE FILE gc_entry_dcls.incl.pl1 *************** */ 5 2 5 3 dcl (graphic_compiler_$tree_ptr, 5 4 gc_$tree_ptr) entry returns (pointer); 5 5 5 6 dcl (graphic_compiler_$return_string, 5 7 gc_$return_string, 5 8 graphic_compiler_$rs, 5 9 gc_$rs) entry (fixed bin (18), pointer, fixed bin, fixed bin (35)); 5 10 5 11 dcl (graphic_compiler_$display_append, 5 12 gc_$display_append, 5 13 graphic_compiler_$da, 5 14 gc_$da) entry (fixed bin (18), fixed bin (35)); 5 15 5 16 dcl (graphic_compiler_$display_append_switch, 5 17 gc_$display_append_switch, 5 18 graphic_compiler_$da_switch, 5 19 gc_$da_switch) entry (fixed bin (18), fixed bin (35), pointer); 5 20 5 21 dcl (graphic_compiler_$display, 5 22 gc_$display, 5 23 graphic_compiler_$d, 5 24 gc_$d) entry (fixed bin (18), fixed bin (35)); 5 25 5 26 dcl (graphic_compiler_$display_switch, 5 27 gc_$display_switch, 5 28 graphic_compiler_$d_switch, 5 29 gc_$d_switch) entry (fixed bin (18), fixed bin (35), pointer); 5 30 5 31 dcl (graphic_compiler_$load, 5 32 gc_$load, 5 33 graphic_compiler_$l, 5 34 gc_$l) entry (fixed bin (18), fixed bin (35)); 5 35 5 36 dcl (graphic_compiler_$load_switch, 5 37 gc_$load_switch, 5 38 graphic_compiler_$l_switch, 5 39 gc_$l_switch) entry (fixed bin (18), fixed bin (35), pointer); 5 40 5 41 dcl (graphic_compiler_$display_name_append, 5 42 gc_$display_name_append, 5 43 graphic_compiler_$dna, 5 44 gc_$dna) entry (char (*), fixed bin (35)); 5 45 5 46 dcl (graphic_compiler_$display_name_append_switch, 5 47 gc_$display_name_append_switch, 5 48 graphic_compiler_$dna_switch, 5 49 gc_$dna_switch) entry (char (*), fixed bin (35), pointer); 5 50 5 51 dcl (graphic_compiler_$display_name, 5 52 gc_$display_name, 5 53 graphic_compiler_$dn, 5 54 gc_$dn) entry (char (*), fixed bin (35)); 5 55 5 56 dcl (graphic_compiler_$display_name_switch, 5 57 gc_$display_name_switch, 5 58 graphic_compiler_$dn_switch, 5 59 gc_$dn_switch) entry (char (*), fixed bin (35), pointer); 5 60 5 61 dcl (graphic_compiler_$load_name, 5 62 gc_$load_name, 5 63 graphic_compiler_$ln, 5 64 gc_$ln) entry (char (*), fixed bin (35)); 5 65 5 66 dcl (graphic_compiler_$load_name_switch, 5 67 gc_$load_name_switch, 5 68 graphic_compiler_$ln_switch, 5 69 gc_$ln_switch) entry (char (*), fixed bin (35), pointer); 5 70 5 71 dcl (graphic_compiler_$prune_tree, 5 72 gc_$prune_tree) entry (fixed bin (35)); 5 73 5 74 /* **************** END INCLUDE FILE gc_entry_dcls.incl.pl1 **************** */ 81 82 83 init: entry (err_code); 84 85 /* Create a working graphic segment */ 86 /* THIS ENTRY MUST BE CALLED BEFORE ALL OTHER CALLS TO THIS PROGRAM */ 87 88 err_code = 0; 89 90 if wgs_p = null then call get_wgs; 91 call init_graphic_segment (wgs_p); 92 call graphic_compiler_$prune_tree (err_code); /* reset the tree to min size */ 93 return; 94 95 get_wgs: proc; 96 97 call get_temp_segment_ ("graphic_manipulator_ WGS", wgs_p, err_code); 98 if err_code ^= 0 then goto error_return; 99 return; 100 end get_wgs; 101 102 init_graphic_segment: proc (segp); 103 104 /* This internal procedure creates the graphic symbol table and chains it onto the root. */ 105 106 dcl segp pointer; 107 108 call lsm_fs_$init (segp, err_code); 109 if err_code ^= 0 then goto error_return; 110 111 call lsm_$make_blk (segp, segp -> lsm.root_symtab, symtab_type, 197 /* nice prime # */, null, err_code); 112 if err_code ^= 0 then goto error_return; 113 114 return; 115 116 end init_graphic_segment; 117 118 segp: entry (wgs_ptr, err_code); 119 120 /* Entry to get a pointer to current working graphic segment */ 121 122 dcl wgs_ptr pointer; 123 124 wgs_ptr = wgs_p; /* Return pointer to base of working graphic seg */ 125 if wgs_p = null () then goto no_wgs_yet; 126 err_code = 0; 127 return; 128 129 /* ------------------------------ */ 130 131 check_wgs_init: proc; 132 133 err_code = 0; 134 if wgs_p = null () then goto no_wgs_yet; 135 return; 136 137 check_wgs_init_null_node: entry; 138 139 err_code = 0; 140 if wgs_p = null () then goto no_wgs_yet_null_node; 141 return; 142 143 end check_wgs_init; 144 145 /* ------------------------------ */ 146 147 148 /* STRUCTURE CREATION ENTRY POINTS */ 149 150 151 /* --------------------------------------------------------------------------------------------------- */ 152 /* Create a position effector */ 153 154 create_position: cpos: entry (etype, x, y, z, err_code) returns (fixed bin (18)); 155 dcl (x, y, z) float bin (27) parameter; /* coordinates of position effector */ 156 157 dcl efficient_len fixed bin; 158 159 if z = 0e0 then 160 if y = 0e0 then 161 if x = 0e0 then efficient_len = 0; 162 else efficient_len = 1; 163 else efficient_len = 2; 164 else efficient_len = 3; 165 166 call create_fl_effector (Setposition, Point, etype, efficient_len + 1); 167 /* Get friend to do work */ 168 if efficient_len > 0 then effector_p -> position_effector.xpos = x; 169 if efficient_len > 1 then effector_p -> position_effector.ypos = y; 170 if efficient_len > 2 then effector_p -> position_effector.zpos = z; 171 return (node_no); 172 173 174 /* --------------------------------------------------------------------------------------------------- */ 175 /* Create a mode effector */ 176 177 create_mode: cmode: entry (etype, mode, err_code) returns (fixed bin (18)); 178 dcl mode fixed bin parameter; /* mode value of mode effector */ 179 180 call create_fl_effector (Intensity, Color, etype, effector_length (etype)); 181 effector_p -> modal_effector.mode = mode; 182 return (node_no); 183 184 185 /* --------------------------------------------------------------------------------------------------- */ 186 /* Create scale effector */ 187 188 create_scale: cscale: entry (xscale, yscale, zscale, err_code) returns (fixed bin (18)); 189 dcl (xscale, yscale, zscale) float bin (27) parameter, /* scale factors */ 190 (xa, ya, za) float bin (27); 191 192 call create_fl_effector (Scaling, Scaling, Scaling, effector_length (Scaling)); 193 effector_p -> scale_effector.xscale = xscale; 194 effector_p -> scale_effector.yscale = yscale; 195 effector_p -> scale_effector.zscale = zscale; 196 return (node_no); 197 198 199 /* --------------------------------------------------------------------------------------------------- */ 200 /* Create rotation effector */ 201 202 create_rotation: crot: entry (xangle, yangle, zangle, err_code) returns (fixed bin (18)); 203 dcl (xangle, yangle, zangle) float bin (27); /* rotations around respective axes */ 204 205 if zangle = 0e0 then 206 if yangle = 0e0 then 207 if xangle = 0e0 then efficient_len = 0; 208 else efficient_len = 1; 209 else efficient_len = 2; 210 else efficient_len = 3; 211 212 call create_fl_effector (Rotation, Rotation, Rotation, efficient_len + 1); 213 214 xa = mod (xangle, 360e0); /* Turn into positive angle < 360e0 */ 215 if xa < 0e0 then xa = xa + 360e0; 216 ya = mod (yangle, 360e0); 217 if ya < 0e0 then ya = ya + 360e0; 218 za = mod (zangle, 360e0); 219 if za < 0e0 then za = za + 360e0; 220 221 if efficient_len > 0 then effector_p -> rotate_effector.xangle = xa; 222 if efficient_len > 1 then effector_p -> rotate_effector.yangle = ya; 223 if efficient_len > 2 then effector_p -> rotate_effector.zangle = za; 224 225 return (node_no); 226 227 228 /* ---------------------------------------------------------------------------------------------------- */ 229 /* Create a clipping effector */ 230 231 create_clip: cclip: entry (xlow, xhigh, ylow, yhigh, zlow, zhigh, err_code) returns (fixed bin (18)); 232 233 dcl (xlow, xhigh, ylow, yhigh, zlow, zhigh) float bin (27); /* relative coords of clipping solid */ 234 235 dcl graphic_error_table_$clipping_unimplemented ext fixed bin (35) static; 236 237 /* return "unimplimented" error code until clipping fully operational. */ 238 239 err_code = graphic_error_table_$clipping_unimplemented; 240 return (0); 241 242 unreflabel: 243 244 /* The following code cannot be reached, and is here simply for historical interest. 245* This is how clipping "worked" before we disabled it because it was not implemented. */ 246 247 call create_fl_effector (Clipping, Clipping, Clipping, effector_length (Clipping)); 248 effector_p -> clipping_effector.delta_left = xlow; 249 effector_p -> clipping_effector.delta_right = xhigh; 250 effector_p -> clipping_effector.delta_bottom = ylow; 251 effector_p -> clipping_effector.delta_top = yhigh; 252 effector_p -> clipping_effector.delta_back = zlow; 253 effector_p -> clipping_effector.delta_front = zhigh; 254 return (node_no); 255 256 /* --------------------------------------------------------------------------------------------------- */ 257 /* Create a color effector */ 258 259 create_color: ccolor: entry (int_red, int_green, int_blue, err_code) returns (fixed bin (18)); 260 dcl (int_red, int_green, int_blue) fixed bin parameter; /* intensities of primary additive colors */ 261 262 call create_fl_effector (Color, Color, Color, effector_length (Color)); 263 effector_p -> color_effector.red_intensity = int_red; 264 effector_p -> color_effector.green_intensity = int_green; 265 effector_p -> color_effector.blue_intensity = int_blue; 266 return (node_no); 267 268 269 /* --------------------------------------------------------------------------------------------------- */ 270 /* Utility procedure to create an effector of floating element type */ 271 /* float_type lsm_ blocks are used to hold fixed bins as well */ 272 273 create_fl_effector: procedure (emin, emax, etype, elen); 274 275 dcl (emin, etype, emax, elen) fixed bin; /* minimum and maximum acceptable 276* effector codes */ 277 278 call check_wgs_init_null_node; 279 280 if etype >= emin then if etype <= emax 281 then do; /* If type is proper for call */ 282 call lsm_$make_blk (wgs_p, node_no, float_type, elen, node_ptr, err_code); 283 /* Make block of necessary length */ 284 if err_code ^= 0 then go to error_return_null_node; 285 effector_p = addr (node_ptr -> any_node.data_space); 286 287 effector_p -> effector.effector_code = etype; /* Fill in effector type */ 288 return; 289 end; 290 291 go to bad_type_null_node; 292 293 end create_fl_effector; 294 295 296 /* --------------------------------------------------------------------------------------------------- */ 297 298 /* Create a text (character string) block */ 299 300 create_text: ctext: entry (alignment, nchars, text, err_code) returns (fixed bin (18)); 301 dcl alignment fixed bin, 302 text char (*) unaligned; 303 304 call check_wgs_init_null_node; 305 call lsm_$make_blk (wgs_p, node_no, char_type, nchars+1, node_ptr, err_code); 306 /* Extra char is for alignment */ 307 if err_code ^= 0 then return (0); 308 309 effector_p = addr (node_ptr -> any_node.data_space); 310 if alignment >= 1 then if alignment <= 9 311 then effector_p -> text_effector.alignment = alignment; 312 else go to bad_align; /* If bad alignment */ 313 314 substr (effector_p -> text_effector.text, 1, nchars) = text; /* Copy text */ 315 return (node_no); 316 317 /* --------------------------------------------------------------------------------------------------- */ 318 319 /* Create a data block (to hold user data values or terminal commands) */ 320 321 create_data: cdata: entry (nbits, data, err_code) returns (fixed bin (18)); 322 dcl data bit (*) unaligned; /* data block */ 323 324 call check_wgs_init_null_node; 325 call lsm_$make_blk (wgs_p, node_no, bit_type, nbits, node_ptr, err_code); 326 if err_code ^= 0 then return (0); 327 328 effector_p = addr (node_ptr -> any_node.data_space); 329 node_ptr -> bit_node.string = data; 330 331 return (node_no); 332 333 334 /* --------------------------------------------------------------------------------------------------- */ 335 /* Create a list (non-terminal) or array (terminal list) */ 336 337 create_list: clist: entry (array, arrayl, err_code) returns (fixed bin (18)); 338 339 dcl i fixed bin, 340 lb fixed bin, 341 lbound builtin; 342 343 ltype = list_type; 344 go to list_common; 345 346 create_array: carray: entry (array, arrayl, err_code) returns (fixed bin (18)); 347 348 ltype = array_type; 349 350 list_common: 351 call check_wgs_init_null_node; 352 if arrayl < 0 then go to array_too_small_null_node; 353 354 call lsm_$make_blk (wgs_p, node_no, ltype, arrayl, node_ptr, err_code); /* Create list/array block */ 355 if err_code ^= 0 then return (0); 356 357 lb = lbound (array, 1); 358 359 do i = 1 to arrayl; /* fill in array elements */ 360 node_ptr -> list_node.node (i) = array (lb); 361 lb = lb + 1; 362 end; 363 364 return (node_no); 365 366 367 /* --------------------------------------------------------------------------------------------------- */ 368 369 370 /* Assign a name to the substructure specified by value_n */ 371 372 assign_name: entry (name, value_n, err_code) returns (fixed bin (18)); 373 dcl sym_n fixed bin (18); /* node # of a symbol node */ 374 375 call check_wgs_init_null_node; 376 call lsm_sym_$symk (wgs_p, Create_symbol, name, sym_n, value_n, err_code); 377 /* get lsm_ to make the new symbol block 378* and stick it in the symbol table */ 379 return (sym_n); 380 381 382 383 /* STRUCTURE MANIPULATION ENTRY POINTS */ 384 385 /* --------------------------------------------------------------------------------------------------- */ 386 387 /* Entry to locate a named structure */ 388 389 find_structure: fstruc: entry (name, value_n, err_code) returns (fixed bin (18)); 390 391 call check_wgs_init_null_node; 392 sym_n, value_n = 0; 393 394 call lsm_sym_$symk (wgs_p, Find_symbol, name, sym_n, value_n, err_code); 395 /* look, don't touch */ 396 return (sym_n); 397 398 399 /* --------------------------------------------------------------------------------------------------- */ 400 /* Add an element in a list after the idx'th element */ 401 /* if idx = 0 insert before first element */ 402 /* if idx = -1 insert after last element */ 403 404 add_element: entry (list_n, idx, new_n, err_code); 405 406 call check_wgs_init; 407 408 call find_list_to_alter (wgs_p, node_ptr, list_n, curl, idx, -1, err_code); 409 if err_code ^= 0 then return; 410 411 call lsm_$set_blk (wgs_p, list_n, ltype, curl + 1, node_ptr, err_code); 412 /* Get lsm_ to increase block length */ 413 if err_code ^= 0 then return; 414 415 if idx = -1 then node_ptr -> list_node.node (curl + 1) = new_n; /* If last node ... */ 416 else do; 417 do i = curl to idx + 1 by -1; /* Move everything down one */ 418 node_ptr -> list_node.node (i+1) = node_ptr -> list_node.node (i); 419 end; 420 421 node_ptr -> list_node.node (idx+1) = new_n; 422 end; 423 return; 424 425 426 /* --------------------------------------------------------------------------------------------------- */ 427 428 find_list_to_alter: proc (wgs_p, node_ptr, list_n, curl, idx, lowest_allowed, err_code); 429 430 dcl (wgs_p pointer, 431 node_ptr pointer, 432 list_n fixed bin (18), 433 curl fixed bin, 434 idx fixed bin, 435 lowest_allowed fixed bin, 436 err_code fixed bin (35)) parameter; 437 438 call lsm_$get_blk (wgs_p, list_n, ltype, curl, node_ptr, err_code); 439 if err_code ^= 0 then return; 440 441 if (ltype ^= list_type) & (ltype ^= array_type) then do; 442 err_code = graphic_error_table_$inv_node_type; 443 return; 444 end; 445 446 if ((idx < lowest_allowed) & (idx ^= -1)) | (idx > curl) then do; 447 err_code = graphic_error_table_$list_oob; 448 return; 449 end; 450 451 return; 452 end find_list_to_alter; 453 454 /* --------------------------------------------------------------------------------------------------- */ 455 /* Alter the node number of the idx'th element in a list */ 456 457 replace_element: entry (list_n, idx, new_n, err_code) returns (fixed bin (18)); 458 459 dcl temp_idx fixed bin (18) automatic; 460 461 call check_wgs_init_null_node; 462 463 call find_list_to_alter (wgs_p, node_ptr, list_n, curl, idx, 1, err_code); 464 if err_code ^= 0 then return (0); 465 466 if idx = -1 then temp_idx = curl; 467 else temp_idx = idx; 468 469 node_no = node_ptr -> list_node.node (temp_idx); /* Save for return */ 470 node_ptr -> list_node.node (temp_idx) = new_n; 471 return (node_no); 472 473 /* --------------------------------------------------------------------------------------------------- */ 474 /* Replace an entire substructure whose top node is "old_n" with new_n */ 475 476 replace_node: entry (old_n, new_n, err_code); 477 478 call check_wgs_init; 479 480 call replace_node (old_n, new_n, err_code); /* use internal procedure common to me and remove_symbol */ 481 482 replace_node: proc (old_node, new_node, err_code); 483 484 dcl (old_node, new_node) fixed bin (18) parameter, 485 err_code fixed bin (35) parameter; 486 487 if new_node = 0 then do; 488 err_code = graphic_error_table_$null_replacement; /* can't make nodes other than the zero node null */ 489 return; 490 end; 491 492 call lsm_$get_blk (wgs_p, old_node, 0, 0, null, err_code); 493 /* check to make sure old_node is good node */ 494 if err_code ^= 0 then return; 495 496 call lsm_$replace_blk (wgs_p, old_node, new_node, err_code); 497 /* Destructively replace old block with copy */ 498 return; 499 500 end replace_node; 501 502 return; 503 504 /* --------------------------------------------------------------------------------------------------- */ 505 506 507 /* Delete a symbol from the symbol table. */ 508 509 remove_symbol: entry (name, err_code); 510 511 call check_wgs_init; 512 513 call lsm_sym_$symk (wgs_p, Delete_symbol, name, 0, 0, err_code); 514 /* delete the symbol from symbol table */ 515 return; 516 517 /* --------------------------------------------------------------------------------------------------- */ 518 519 /* Replicate a substructure */ 520 521 replicate: entry (template_n, err_code) returns (fixed bin (18)); 522 523 call check_wgs_init_null_node; 524 call lsm_$replicate (wgs_p, template_n, new_n, err_code); 525 if err_code ^= 0 then return (0); 526 return (new_n); 527 528 529 530 /* STRUCTURE EXAMINATION ENTRY POINTS */ 531 532 533 534 /* --------------------------------------------------------------------------------------------------- */ 535 /* Examine type of node */ 536 537 examine_type: etype: entry (node_n, t_nt, type, err_code); 538 dcl t_nt bit (1) aligned; /* ON if node being examined is non-terminal */ 539 540 call check_wgs_init; 541 542 if node_n = 0 then do; 543 t_nt = "0"b; 544 type = -1; /* null node */ 545 err_code = 0; 546 return; 547 end; 548 549 call lsm_$get_blk (wgs_p, node_n, lsm_type, curl, node_ptr, err_code); 550 if err_code ^= 0 then do; 551 type = -2; 552 return; 553 end; 554 555 if lsm_type <= char_type 556 then t_nt = "0"b; /* This is a terminal node */ 557 558 else if lsm_type = list_type | lsm_type = array_type | lsm_type = symbol_type then t_nt = "1"b; 559 else do; 560 type = -2; 561 go to bad_type; 562 end; 563 564 if lsm_type = char_type then type = Text; 565 else if lsm_type = bit_type then type = Datablock; 566 else if lsm_type = list_type then type = List; 567 else if lsm_type = array_type then type = Array; 568 else if lsm_type = symbol_type then type = Symbol; 569 else type = addr (node_ptr -> any_node.data_space) -> effector.effector_code; 570 571 return; 572 573 /* ----------------------------------------------------------------------------------------------------- */ 574 575 /* Examine a position node */ 576 577 examine_position: epos: entry (node_n, etype, x, y, z, err_code); 578 579 call check_wgs_init; 580 call lsm_$get_blk (wgs_p, node_n, lsm_type, lsm_curl, node_ptr, err_code); 581 582 x, y, z = 0e0; 583 584 if lsm_type ^= float_type then do; 585 bad_etype: etype = -2; 586 go to bad_type; 587 end; 588 589 effector_p = addr (node_ptr -> any_node.data_space); 590 etype = effector_p -> position_effector.effector_code; 591 592 if lsm_curl > 1 then x = effector_p -> position_effector.xpos; 593 if lsm_curl > 2 then y = effector_p -> position_effector.ypos; 594 if lsm_curl > 3 then z = effector_p -> position_effector.zpos; 595 596 return; 597 598 /* ---------------------------------------------------------------------------------------------------- */ 599 600 /* Examine a modal element */ 601 602 examine_mode: emode: entry (node_n, etype, mode, err_code); 603 604 call check_wgs_init; 605 call lsm_$get_blk (wgs_p, node_n, lsm_type, lsm_curl, node_ptr, err_code); 606 607 if lsm_type ^= float_type 608 then go to bad_etype; /* Mode masquerade as float for some reason(?) */ 609 610 effector_p = addr (node_ptr -> any_node.data_space); 611 etype = effector_p -> modal_effector.effector_code; 612 mode = effector_p -> modal_effector.mode; 613 614 return; 615 616 /* ---------------------------------------------------------------------------------------------------- */ 617 618 /* Examine a color element */ 619 620 examine_color: ecolor: entry (node_n, int_red, int_green, int_blue, err_code); 621 622 call check_wgs_init; 623 call lsm_$get_blk (wgs_p, node_n, lsm_type, lsm_curl, node_ptr, err_code); 624 625 effector_p = addr (node_ptr -> any_node.data_space); 626 if effector_p -> effector.effector_code ^= Color 627 then go to bad_etype; /* Node being examined is not a color node */ 628 629 int_red = effector_p -> color_effector.red_intensity; 630 int_green = effector_p -> color_effector.green_intensity; 631 int_blue = effector_p -> color_effector.blue_intensity; 632 633 return; 634 635 /* ---------------------------------------------------------------------------------------------------- */ 636 637 /* Examine a mapping element */ 638 639 examine_mapping: emap: entry (node_n, etype, farray, flen, err_code); 640 641 dcl (farray (*) float bin (27), /* array into which go mapping values */ 642 flen fixed bin) parameter; /* number of useful values in farray */ 643 644 call check_wgs_init; 645 call lsm_$get_blk (wgs_p, node_n, lsm_type, lsm_curl, node_ptr, err_code); 646 647 farray (*) = 0e0; 648 649 if lsm_type ^= float_type 650 then go to bad_etype; /* All modes use floating values */ 651 652 effector_p = addr (node_ptr -> any_node.data_space); 653 etype = effector_p -> effector.effector_code; 654 if etype < Scaling | etype > Clipping then goto bad_etype; 655 656 if dim (farray, 1) < lsm_curl - 1 657 then go to array_too_small; /* If user-supplied array is too small, complain */ 658 659 flen = lsm_curl - 1; 660 661 lb = lbound (farray, 1); 662 663 do i = 1 to flen; /* Fill in array */ 664 farray (lb) = effector_p -> floating_effector.data (i); 665 lb = lb + 1; 666 end; 667 668 return; 669 670 671 /* --------------------------------------------------------------------------------------------------- */ 672 /* Examine contents of list node */ 673 674 examine_list: elist: entry (node_n, array, arrayl, err_code); 675 676 dcl lsm_type fixed bin, /* lsm_ type code */ 677 lsm_curl fixed bin; /* current length of lsm_ block */ 678 679 call check_wgs_init; 680 call lsm_$get_blk (wgs_p, node_n, lsm_type, lsm_curl, node_ptr, err_code); 681 if err_code ^= 0 then return; 682 683 if lsm_type ^= list_type 684 then if lsm_type ^= array_type 685 then do; /* Only allow these types to be examined */ 686 arrayl = 0; 687 go to bad_type; 688 end; 689 690 arrayl = lsm_curl; 691 call fill_array; 692 693 return; 694 695 696 /* --------------------------------------------------------------------------------------------------- */ 697 698 /* Internal procedure to fill array with contents of node */ 699 700 fill_array: procedure; 701 702 dcl array_max fixed bin, 703 dim builtin; 704 705 array_max = dim (array, 1); 706 if array_max < lsm_curl then go to array_too_small; 707 708 lb = lbound (array, 1); 709 710 do i = 1 to lsm_curl; 711 array (lb) = node_ptr -> list_node.node (i); 712 lb = lb + 1; 713 end; 714 715 return; 716 717 end; 718 719 720 /* --------------------------------------------------------------------------------------------------- */ 721 /* Examine symbol table */ 722 723 examine_symtab: esymtab: entry (array, arrayl, err_code); 724 dcl p ptr, 725 array_dim fixed bin, 726 based_array (array_dim) fixed bin (18) based; 727 728 call check_wgs_init; 729 730 lb = lbound (array, 1); 731 p = addr (array (lb)); 732 array_dim = hbound (array, 1) - lb + 1; /* =_ dim (array, 1) but optimizer crumps on that */ 733 734 call lsm_sym_$sym_list (wgs_p, p -> based_array, arrayl, err_code); 735 return; 736 737 738 /* --------------------------------------------------------------------------------------------------- */ 739 /* Examine symbol */ 740 examine_symbol: esymbol: entry (node_n, value_n, nchars, char_str, err_code); 741 742 call check_wgs_init; 743 call lsm_$get_blk (wgs_p, node_n, lsm_type, lsm_curl, node_ptr, err_code); 744 if lsm_type ^= symbol_type then do; 745 err_code = graphic_error_table_$inv_node_type; 746 return; 747 end; 748 749 value_n = node_ptr -> symbol_node.value_node; 750 call lsm_$get_blk (wgs_p, (node_ptr -> symbol_node.name_node), lsm_type, nchars, node_ptr, err_code); 751 char_str = node_ptr -> char_node.string; 752 753 return; 754 755 756 /* ------------------------------------------------------------------------------------------------------ */ 757 758 759 /* Examine text block */ 760 761 examine_text: etext: entry (node_n, alignment, nchars, char_str, err_code); 762 dcl char_str char (*), 763 nchars fixed bin; 764 765 call check_wgs_init; 766 call get_special_block (char_type); 767 alignment = effector_p -> text_effector.alignment; 768 nchars = lsm_curl - 1; /* First char is alignment */ 769 char_str = substr (effector_p -> text_effector.text, 1, nchars); 770 return; 771 772 773 774 775 /* STRUCTURE SAVING, PERMANENT GRAPHIC SEGMENT MANIPULATION */ 776 /* --------------------------------------------------------------------------------------------------- */ 777 778 /* Examine data block */ 779 780 examine_data: edata: entry (node_n, nbits, bit_str, err_code); 781 dcl bit_str bit (*), 782 nbits fixed bin; 783 784 call check_wgs_init; 785 call get_special_block (bit_type); 786 bit_str = node_ptr -> bit_node.string; 787 nbits = lsm_curl; 788 return; 789 790 791 /* --------------------------------------------------------------------------------------------------- */ 792 793 /* Internal procedure to get a text or data block */ 794 795 get_special_block: procedure (spec_type); 796 dcl spec_type fixed bin; 797 err_code = 0; 798 799 call lsm_$get_blk (wgs_p, node_n, lsm_type, lsm_curl, node_ptr, err_code); 800 if err_code ^= 0 then go to error_return; 801 effector_p = addr (node_ptr -> any_node.data_space); 802 if lsm_type ^= spec_type then go to bad_type; 803 return; 804 end; 805 806 807 /* --------------------------------------------------------------------------------------------------- */ 808 809 /* Get the graphic structure named by "name" from the p.g.s. named "dname" 810* and "ename", and merge it into the current WGS. */ 811 812 get_struc: entry (dname, x_ename, name, merge_code, err_code); 813 814 815 dcl merge_code fixed bin parameter, /* Determines disposition of named substructures */ 816 x_ename char (*) parameter, /* ename, possibly without suffix ".pgs" */ 817 ename char (32); /* with ".pgs" suffix added */ 818 819 /* Values of nerge_code */ 820 /* 0 - Copy named substructures from PGS, error on naming conflict */ 821 /* 1 - Copy named substructures from PGS, overwrite on naming conflict */ 822 /* 2 - Insert identically named substrcuctures from WGS, create symbol 823* with 0 value for those that dont exist in WGS */ 824 /* 3 - same as 2, but copy symbols from PGS if they dont already exist in WGS */ 825 826 call add_pgs_suffix; 827 call move_struc ("0"b); /* If pgs does not exist, return with error */ 828 return; 829 830 /* ------------------------------ */ 831 832 add_pgs_suffix: proc; 833 834 dcl suffixed_name_$make ext entry (char (*), char (*), char (32), fixed bin (35)); 835 836 call suffixed_name_$make (x_ename, "pgs", ename, err_code); 837 if err_code ^= 0 then goto error_return; 838 return; 839 840 end add_pgs_suffix; 841 842 /* ------------------------------ */ 843 844 845 /* --------------------------------------------------------------------------------------------------- */ 846 /* Put graphic structure "name" from wgs to pgs */ 847 848 put_struc: entry (dname, x_ename, name, merge_code, err_code); 849 850 /* Values of merge_code are same as for get_struc, but interchange WGS and PGS */ 851 852 call check_wgs_init; 853 call add_pgs_suffix; 854 call move_struc ("1"b); 855 return; 856 857 858 /* --------------------------------------------------------------------------------------------------- */ 859 860 /* Internal procedure to move a structure between the wgs and pgs */ 861 862 move_struc: procedure (put_sw); 863 864 dcl put_sw bit (1) aligned, /* controls direction of movement */ 865 pgs_p pointer; /* pointer to permanent graphic seg */ 866 867 err_code = 0; 868 call lsm_fs_$init_seg (pgs_p, dname, ename, Find_seg, err_code); 869 /* See if pgs already exists */ 870 if pgs_p = null () then 871 if ^ put_sw then goto error_return; 872 else do; /* Otherwise, must create it */ 873 call lsm_fs_$init_seg (pgs_p, dname, ename, Create_seg, err_code); /* Create new lsm seg */ 874 if err_code ^= 0 then go to error_return; 875 876 call init_graphic_segment (pgs_p); 877 end; 878 879 if put_sw then call move_it (wgs_p, pgs_p); /* Movement from wgs to pgs */ 880 else call move_it (pgs_p, wgs_p); /* Movement is from pgs to wgs */ 881 return; 882 883 884 885 /* Internal procedure to move a structure from one gm_ seg to another */ 886 move_it: procedure (from_p, to_p); 887 888 dcl (from_p, to_p) pointer, /* pointers to gm_ segs */ 889 (from_val_n, from_sym_n) fixed bin (18); /* node # in from seg of node to be moved */ 890 891 err_code = 0; 892 893 call lsm_sym_$symk (from_p, Find_symbol, name, from_sym_n, from_val_n, err_code); 894 /* look, don't touch */ 895 /* See if symbol exists in segment from which it will be moved */ 896 if err_code ^= 0 then go to error_return; 897 898 call lsm_fs_$merge_symbol (from_p, to_p, from_sym_n, "1"b, merge_code, err_code); 899 if err_code ^= 0 then return; 900 901 /* if we are moving to PGS, update the bitcount. */ 902 903 if to_p = pgs_p then do; 904 call hcs_$set_bc_seg (pgs_p, pgs_p -> lsm.free * 36, err_code); 905 if err_code ^= 0 then goto error_return; 906 end; 907 908 return; 909 end move_it; 910 end move_struc; 911 912 913 /* --------------------------------------------------------------------------------------------------- */ 914 /* Save current wgs in pgs specified by dname, ename */ 915 916 save_file: entry (dname, x_ename, err_code); 917 918 dcl pgs_p pointer; 919 920 dcl hcs_$terminate_noname ext entry (pointer, fixed bin (35)), 921 hcs_$set_bc_seg ext entry (pointer, fixed bin (24), fixed bin (35)); 922 923 call check_wgs_init; 924 call add_pgs_suffix; 925 call lsm_fs_$push (wgs_p, dname, ename, err_code); 926 if err_code ^= 0 then return; 927 928 /* now be nice to the user and set the bitcount of the pgs. */ 929 call hcs_$initiate (dname, ename, "", 0, 1, pgs_p, err_code); 930 if pgs_p = null then return; 931 932 call hcs_$set_bc_seg (pgs_p, pgs_p -> lsm.free * 36, err_code); 933 if err_code ^= 0 then return; 934 935 call hcs_$terminate_noname (pgs_p, err_code); 936 return; 937 938 939 /* --------------------------------------------------------------------------------------------------- */ 940 /* Use graphic structure in pgs specified by dname, ename as the wgs */ 941 942 use_file: entry (dname, x_ename, err_code); 943 err_code = 0; 944 call add_pgs_suffix; 945 if wgs_p = null then call get_wgs; 946 call lsm_fs_$init (wgs_p, err_code); /* Reinitialize wgs */ 947 if err_code ^= 0 then return; 948 949 call lsm_fs_$pull (wgs_p, dname, ename, err_code); /* Pull in graphic structure from p.g.s. */ 950 return; 951 952 953 /* --------------------------------------------------------------------------------------------------- */ 954 955 956 error_return_null_node: return (0); /* Error return for entries which return a node number */ 957 958 error_return: return; /* Error return for entries that do not return anything */ 959 960 bad_align: err_code = graphic_error_table_$bad_align; 961 return (0); 962 963 bad_type_null_node: err_code = graphic_error_table_$inv_node_type; 964 return (0); 965 966 bad_type: err_code = graphic_error_table_$inv_node_type; 967 return; 968 969 no_wgs_yet: err_code = graphic_error_table_$no_wgs_yet; 970 return; 971 972 no_wgs_yet_null_node: err_code = graphic_error_table_$no_wgs_yet; 973 return (0); 974 975 array_too_small_null_node: err_code = error_table_$smallarg; 976 return (0); 977 978 array_too_small: err_code = error_table_$smallarg; 979 return; 980 981 982 end graphic_manipulator_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/18/82 1625.4 graphic_manipulator_.pl1 >dumps>old>recomp>graphic_manipulator_.pl1 73 1 03/27/82 0439.2 graphic_etypes.incl.pl1 >ldd>include>graphic_etypes.incl.pl1 75 2 03/27/82 0439.2 graphic_templates.incl.pl1 >ldd>include>graphic_templates.incl.pl1 77 3 12/17/79 1708.9 lsm_formats.incl.pl1 >ldd>include>lsm_formats.incl.pl1 79 4 03/27/82 0439.3 lsm_entry_dcls.incl.pl1 >ldd>include>lsm_entry_dcls.incl.pl1 81 5 08/13/81 2035.4 gc_entry_dcls.incl.pl1 >ldd>include>gc_entry_dcls.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. Array constant fixed bin(17,0) initial dcl 1-9 ref 567 Clipping 000067 constant fixed bin(17,0) initial dcl 1-9 set ref 242* 242* 242* 242 654 Color 000065 constant fixed bin(17,0) initial dcl 1-9 set ref 180* 262* 262* 262* 262 626 Create_seg 000112 constant fixed bin(17,0) initial dcl 4-29 set ref 873* Create_symbol 000110 constant fixed bin(17,0) initial dcl 4-24 set ref 376* Datablock constant fixed bin(17,0) initial dcl 1-9 ref 565 Delete_symbol 000106 constant fixed bin(17,0) initial dcl 4-24 set ref 513* Find_seg 000101 constant fixed bin(17,0) initial dcl 4-29 set ref 868* Find_symbol 000101 constant fixed bin(17,0) initial dcl 4-24 set ref 394* 893* Intensity 000066 constant fixed bin(17,0) initial dcl 1-9 set ref 180* List constant fixed bin(17,0) initial dcl 1-9 ref 566 Point 000104 constant fixed bin(17,0) initial dcl 1-9 set ref 166* Rotation constant fixed bin(17,0) initial dcl 1-9 set ref 212* 212* 212* Scaling 000076 constant fixed bin(17,0) initial dcl 1-9 set ref 192* 192* 192* 192 654 Setposition 000101 constant fixed bin(17,0) initial dcl 1-9 set ref 166* Symbol constant fixed bin(17,0) initial dcl 1-9 ref 568 Text constant fixed bin(17,0) initial dcl 1-9 ref 564 addr builtin function dcl 49 ref 285 309 328 569 589 610 625 652 731 801 alignment parameter fixed bin(17,0) dcl 301 in procedure "gm_" set ref 300 300 310 310 310 761 761 767* alignment based fixed bin(8,0) level 2 in structure "text_effector" packed unaligned dcl 2-59 in procedure "gm_" set ref 310* 767 any_node based structure level 1 dcl 3-48 array parameter fixed bin(18,0) array dcl 66 set ref 337 337 346 346 357 360 674 674 705 708 711* 723 723 730 731 732 array_dim 000124 automatic fixed bin(17,0) dcl 724 set ref 732* 734 array_max 000266 automatic fixed bin(17,0) dcl 702 set ref 705* 706 array_type 11 000000 constant fixed bin(17,0) initial level 3 dcl 3-9 ref 348 441 558 567 683 arrayl parameter fixed bin(17,0) dcl 62 set ref 337 337 346 346 352 354* 359 674 674 686* 690* 723 723 734* based_array based fixed bin(18,0) array dcl 724 set ref 734* bit_node based structure level 1 dcl 3-64 bit_str parameter bit unaligned dcl 781 set ref 780 780 786* bit_type 4 000000 constant fixed bin(17,0) initial level 3 dcl 3-9 set ref 325* 565 785* blue_intensity 3 based fixed bin(17,0) level 2 dcl 2-53 set ref 265* 631 char_node based structure level 1 dcl 3-68 char_str parameter char unaligned dcl 762 set ref 740 740 751* 761 761 769* char_type 5 000000 constant fixed bin(17,0) initial level 3 dcl 3-9 set ref 305* 555 564 766* clipping_effector based structure level 1 dcl 2-40 color_effector based structure level 1 dcl 2-53 curl 000102 automatic fixed bin(17,0) dcl 62 in procedure "gm_" set ref 408* 411 415 417 463* 466 549* curl parameter fixed bin(17,0) dcl 430 in procedure "find_list_to_alter" set ref 428 438* 446 data parameter bit unaligned dcl 322 in procedure "gm_" ref 321 321 329 data 1 based float bin(27) array level 2 in structure "floating_effector" dcl 2-18 in procedure "gm_" ref 664 data_len 0(18) based fixed bin(18,0) level 3 in structure "bit_node" packed unsigned unaligned dcl 3-64 in procedure "gm_" ref 329 786 data_len 0(18) based fixed bin(18,0) level 3 in structure "char_node" packed unsigned unaligned dcl 3-68 in procedure "gm_" ref 751 data_space 1 based bit(36) array level 2 dcl 3-48 set ref 285 309 328 569 589 610 625 652 801 delta_back 5 based float bin(27) level 2 dcl 2-40 set ref 252* delta_bottom 3 based float bin(27) level 2 dcl 2-40 set ref 250* delta_front 6 based float bin(27) level 2 dcl 2-40 set ref 253* delta_left 1 based float bin(27) level 2 dcl 2-40 set ref 248* delta_right 2 based float bin(27) level 2 dcl 2-40 set ref 249* delta_top 4 based float bin(27) level 2 dcl 2-40 set ref 251* dim builtin function dcl 702 in procedure "fill_array" ref 705 dim builtin function dcl 49 in procedure "gm_" ref 656 dname parameter char unaligned dcl 68 set ref 812 848 868* 873* 916 925* 929* 942 949* effector based structure level 1 dcl 2-14 effector_code based fixed bin(6,0) level 2 in structure "modal_effector" dcl 2-49 in procedure "gm_" ref 611 effector_code based fixed bin(6,0) level 2 in structure "effector" dcl 2-14 in procedure "gm_" set ref 287* 569 626 653 effector_code based fixed bin(6,0) level 2 in structure "position_effector" dcl 2-22 in procedure "gm_" ref 590 effector_length 000025 constant fixed bin(17,0) initial array dcl 2-5 set ref 180* 192* 242* 262* effector_p 000104 automatic pointer dcl 64 set ref 168 169 170 181 193 194 195 221 222 223 248 249 250 251 252 253 263 264 265 285* 287 309* 310 314 328* 589* 590 592 593 594 610* 611 612 625* 626 629 630 631 652* 653 664 767 769 801* efficient_len 000110 automatic fixed bin(17,0) dcl 157 set ref 159* 162* 163* 164* 166 168 169 170 205* 208* 209* 210* 212 221 222 223 elen parameter fixed bin(17,0) dcl 275 set ref 273 282* emax parameter fixed bin(17,0) dcl 275 ref 273 280 emin parameter fixed bin(17,0) dcl 275 ref 273 280 ename 000125 automatic char(32) unaligned dcl 815 set ref 836* 868* 873* 925* 929* 949* err_code parameter fixed bin(35,0) dcl 430 in procedure "find_list_to_alter" set ref 428 438* 439 442* 447* err_code parameter fixed bin(35,0) dcl 484 in procedure "replace_node" set ref 482 488* 492* 494 496* err_code parameter fixed bin(35,0) dcl 46 in procedure "gm_" set ref 83 88* 92* 97* 98 108* 109 111* 112 118 126* 133* 139* 154 154 177 177 188 188 202 202 231 231 239* 259 259 282* 284 300 300 305* 307 321 321 325* 326 337 337 346 346 354* 355 372 376* 389 389 394* 404 408* 409 411* 413 457 463* 464 476 480* 509 513* 521 524* 525 537 537 545* 549* 550 577 577 580* 602 602 605* 620 620 623* 639 639 645* 674 674 680* 681 723 723 734* 740 740 743* 745* 750* 761 761 780 780 797* 799* 800 812 836* 837 848 867* 868* 873* 874 891* 893* 896 898* 899 904* 905 916 925* 926 929* 932* 933 935* 942 943* 946* 947 949* 960* 963* 966* 969* 972* 975* 978* error_table_$smallarg 000030 external static fixed bin(35,0) dcl 38 ref 975 978 etype parameter fixed bin(17,0) dcl 59 in procedure "gm_" set ref 154 154 166* 177 177 180* 180 577 577 585* 590* 602 602 611* 639 639 653* 654 654 etype parameter fixed bin(17,0) dcl 275 in procedure "create_fl_effector" ref 273 280 280 287 farray parameter float bin(27) array dcl 641 set ref 639 639 647* 656 661 664* flen parameter fixed bin(17,0) dcl 641 set ref 639 639 659* 663 float_type 3 000000 constant fixed bin(17,0) initial level 3 dcl 3-9 set ref 282* 584 607 649 floating_effector based structure level 1 dcl 2-18 free 1 based fixed bin(18,0) level 2 dcl 3-27 ref 904 932 from_p parameter pointer dcl 888 set ref 886 893* 898* from_sym_n 000323 automatic fixed bin(18,0) dcl 888 set ref 893* 898* from_val_n 000322 automatic fixed bin(18,0) dcl 888 set ref 893* get_temp_segment_ 000014 constant entry external dcl 33 ref 97 graphic_compiler_$prune_tree 000062 constant entry external dcl 5-71 ref 92 graphic_error_table_$bad_align 000024 external static fixed bin(35,0) dcl 38 ref 960 graphic_error_table_$clipping_unimplemented 000064 external static fixed bin(35,0) dcl 235 ref 239 graphic_error_table_$inv_node_type 000026 external static fixed bin(35,0) dcl 38 ref 442 745 963 966 graphic_error_table_$list_oob 000022 external static fixed bin(35,0) dcl 38 ref 447 graphic_error_table_$no_wgs_yet 000016 external static fixed bin(35,0) dcl 38 ref 969 972 graphic_error_table_$null_replacement 000020 external static fixed bin(35,0) dcl 38 ref 488 green_intensity 2 based fixed bin(17,0) level 2 dcl 2-53 set ref 264* 630 hbound builtin function dcl 49 ref 732 hcs_$initiate 000012 constant entry external dcl 33 ref 929 hcs_$set_bc_seg 000070 constant entry external dcl 920 ref 904 932 hcs_$terminate_noname 000066 constant entry external dcl 920 ref 935 header based structure level 2 in structure "bit_node" dcl 3-64 in procedure "gm_" header based structure level 1 dcl 3-42 in procedure "gm_" header based structure level 2 in structure "char_node" dcl 3-68 in procedure "gm_" i 000114 automatic fixed bin(17,0) dcl 339 set ref 359* 360* 417* 418 418* 663* 664* 710* 711* idx parameter fixed bin(17,0) dcl 62 in procedure "gm_" set ref 404 408* 415 417 421 457 463* 466 467 idx parameter fixed bin(17,0) dcl 430 in procedure "find_list_to_alter" ref 428 446 446 446 int_blue parameter fixed bin(17,0) dcl 260 set ref 259 259 265 620 620 631* int_green parameter fixed bin(17,0) dcl 260 set ref 259 259 264 620 620 630* int_red parameter fixed bin(17,0) dcl 260 set ref 259 259 263 620 620 629* lb 000115 automatic fixed bin(17,0) dcl 339 set ref 357* 360 361* 361 661* 664 665* 665 708* 711 712* 712 730* 731 732 lbound builtin function dcl 339 ref 357 661 708 730 list_n parameter fixed bin(18,0) dcl 57 in procedure "gm_" set ref 404 408* 411* 457 463* list_n parameter fixed bin(18,0) dcl 430 in procedure "find_list_to_alter" set ref 428 438* list_node based structure level 1 dcl 3-85 list_type 10 000000 constant fixed bin(17,0) initial level 3 dcl 3-9 ref 343 441 558 566 683 lowest_allowed parameter fixed bin(17,0) dcl 430 ref 428 446 lsm based structure level 1 dcl 3-27 lsm_$get_blk 000032 constant entry external dcl 4-3 ref 438 492 549 580 605 623 645 680 743 750 799 lsm_$make_blk 000034 constant entry external dcl 4-3 ref 111 282 305 325 354 lsm_$replace_blk 000036 constant entry external dcl 4-3 ref 496 lsm_$replicate 000040 constant entry external dcl 4-3 ref 524 lsm_$set_blk 000042 constant entry external dcl 4-3 ref 411 lsm_constants 000000 constant structure level 1 dcl 3-9 lsm_curl 000121 automatic fixed bin(17,0) dcl 676 set ref 580* 592 593 594 605* 623* 645* 656 659 680* 690 706 710 743* 768 787 799* lsm_fs_$init 000044 constant entry external dcl 4-10 ref 108 946 lsm_fs_$init_seg 000046 constant entry external dcl 4-10 ref 868 873 lsm_fs_$merge_symbol 000050 constant entry external dcl 4-10 ref 898 lsm_fs_$pull 000052 constant entry external dcl 4-10 ref 949 lsm_fs_$push 000054 constant entry external dcl 4-10 ref 925 lsm_sym_$sym_list 000056 constant entry external dcl 4-19 ref 734 lsm_sym_$symk 000060 constant entry external dcl 4-19 ref 376 394 513 893 lsm_type 000120 automatic fixed bin(17,0) dcl 676 set ref 549* 555 558 558 558 564 565 566 567 568 580* 584 605* 607 623* 645* 649 680* 683 683 743* 744 750* 799* 802 ltype 000101 automatic fixed bin(17,0) dcl 59 set ref 343* 348* 354* 411* 438* 441 441 merge_code parameter fixed bin(17,0) dcl 815 set ref 812 848 898* mod builtin function dcl 49 ref 214 216 218 modal_effector based structure level 1 dcl 2-49 mode parameter fixed bin(17,0) dcl 178 in procedure "gm_" set ref 177 177 181 602 602 612* mode 1 based fixed bin(17,0) level 2 in structure "modal_effector" dcl 2-49 in procedure "gm_" set ref 181* 612 name parameter char unaligned dcl 68 set ref 372 376* 389 389 394* 509 513* 812 848 893* name_node 1 based fixed bin(18,0) level 2 dcl 3-78 ref 750 nbits parameter fixed bin(17,0) dcl 781 set ref 321 321 325* 780 780 787* nchars parameter fixed bin(17,0) dcl 762 set ref 300 300 305 314 740 740 750* 761 761 768* 769 new_n parameter fixed bin(18,0) dcl 57 set ref 404 415 421 457 470 476 480* 524* 526 new_node parameter fixed bin(18,0) dcl 484 set ref 482 487 496* node 1 based fixed bin(18,0) array level 2 dcl 3-85 set ref 360* 415* 418* 418 421* 469 470* 711 node_n parameter fixed bin(18,0) dcl 57 set ref 537 537 542 549* 577 577 580* 602 602 605* 620 620 623* 639 639 645* 674 674 680* 740 740 743* 761 761 780 780 799* node_no 000100 automatic fixed bin(18,0) dcl 57 set ref 171 182 196 225 254 266 282* 305* 315 325* 331 354* 364 469* 471 node_ptr parameter pointer dcl 430 in procedure "find_list_to_alter" set ref 428 438* node_ptr 000106 automatic pointer dcl 3-40 in procedure "gm_" set ref 282* 285 305* 309 325* 328 329 354* 360 408* 411* 415 418 418 421 463* 469 470 549* 569 580* 589 605* 610 623* 625 645* 652 680* 711 743* 749 750 750* 751 786 799* 801 null builtin function dcl 49 ref 90 111 111 125 134 140 492 492 870 930 945 old_n parameter fixed bin(18,0) dcl 57 set ref 476 480* old_node parameter fixed bin(18,0) dcl 484 set ref 482 492* 496* p 000122 automatic pointer dcl 724 set ref 731* 734 pgs_p 000312 automatic pointer dcl 864 in procedure "move_struc" set ref 868* 870 873* 876* 879* 880* 903 904* 904 pgs_p 000136 automatic pointer dcl 918 in procedure "gm_" set ref 929* 930 932* 932 935* position_effector based structure level 1 dcl 2-22 put_sw parameter bit(1) dcl 864 ref 862 870 879 red_intensity 1 based fixed bin(17,0) level 2 dcl 2-53 set ref 263* 629 root_symtab 2 based fixed bin(18,0) level 2 dcl 3-27 set ref 111* rotate_effector based structure level 1 dcl 2-34 scale_effector based structure level 1 dcl 2-28 segp parameter pointer dcl 106 set ref 102 108* 111* 111 spec_type parameter fixed bin(17,0) dcl 796 ref 795 802 string 1 based bit level 2 in structure "bit_node" dcl 3-64 in procedure "gm_" set ref 329* 786 string 1 based char level 2 in structure "char_node" packed unaligned dcl 3-68 in procedure "gm_" ref 751 substr builtin function dcl 49 set ref 314* 769 suffixed_name_$make 000072 constant entry external dcl 834 ref 836 sym_n 000116 automatic fixed bin(18,0) dcl 373 set ref 376* 379 392* 394* 396 symbol_node based structure level 1 dcl 3-78 symbol_type 7 000000 constant fixed bin(17,0) initial level 3 dcl 3-9 ref 558 568 744 symtab_type 6 000000 constant fixed bin(17,0) initial level 3 dcl 3-9 set ref 111* t_nt parameter bit(1) dcl 538 set ref 537 537 543* 555* 558* temp_idx 000117 automatic fixed bin(18,0) dcl 459 set ref 466* 467* 469 470 template_n parameter fixed bin(18,0) dcl 57 set ref 521 524* text parameter char unaligned dcl 301 in procedure "gm_" ref 300 300 314 text 0(09) based char(262140) level 2 in structure "text_effector" packed unaligned dcl 2-59 in procedure "gm_" set ref 314* 769 text_effector based structure level 1 dcl 2-59 to_p parameter pointer dcl 888 set ref 886 898* 903 type parameter fixed bin(17,0) dcl 59 set ref 537 537 544* 551* 560* 564* 565* 566* 567* 568* 569* types 1 000000 constant structure level 2 dcl 3-9 value_n parameter fixed bin(18,0) dcl 57 set ref 372 376* 389 389 392* 394* 740 740 749* value_node 2 based fixed bin(18,0) level 2 dcl 3-78 ref 749 wgs_p parameter pointer dcl 430 in procedure "find_list_to_alter" set ref 428 438* wgs_p 000010 internal static pointer initial dcl 54 in procedure "gm_" set ref 90 91* 97* 124 125 134 140 282* 305* 325* 354* 376* 394* 408* 411* 463* 492* 496* 513* 524* 549* 580* 605* 623* 645* 680* 734* 743* 750* 799* 879* 880* 925* 945 946* 949* wgs_ptr parameter pointer dcl 122 set ref 118 124* x parameter float bin(27) dcl 155 set ref 154 154 159 168 577 577 582* 592* x_ename parameter char unaligned dcl 815 set ref 812 836* 848 916 942 xa 000111 automatic float bin(27) dcl 189 set ref 214* 215 215* 215 221 xangle parameter float bin(27) dcl 203 in procedure "gm_" ref 202 202 205 214 xangle 1 based float bin(27) level 2 in structure "rotate_effector" dcl 2-34 in procedure "gm_" set ref 221* xhigh parameter float bin(27) dcl 233 ref 231 231 249 xlow parameter float bin(27) dcl 233 ref 231 231 248 xpos 1 based float bin(27) level 2 dcl 2-22 set ref 168* 592 xscale 1 based float bin(27) level 2 in structure "scale_effector" dcl 2-28 in procedure "gm_" set ref 193* xscale parameter float bin(27) dcl 189 in procedure "gm_" ref 188 188 193 y parameter float bin(27) dcl 155 set ref 154 154 159 169 577 577 582* 593* ya 000112 automatic float bin(27) dcl 189 set ref 216* 217 217* 217 222 yangle parameter float bin(27) dcl 203 in procedure "gm_" ref 202 202 205 216 yangle 2 based float bin(27) level 2 in structure "rotate_effector" dcl 2-34 in procedure "gm_" set ref 222* yhigh parameter float bin(27) dcl 233 ref 231 231 251 ylow parameter float bin(27) dcl 233 ref 231 231 250 ypos 2 based float bin(27) level 2 dcl 2-22 set ref 169* 593 yscale 2 based float bin(27) level 2 in structure "scale_effector" dcl 2-28 in procedure "gm_" set ref 194* yscale parameter float bin(27) dcl 189 in procedure "gm_" ref 188 188 194 z parameter float bin(27) dcl 155 set ref 154 154 159 170 577 577 582* 594* za 000113 automatic float bin(27) dcl 189 set ref 218* 219 219* 219 223 zangle 3 based float bin(27) level 2 in structure "rotate_effector" dcl 2-34 in procedure "gm_" set ref 223* zangle parameter float bin(27) dcl 203 in procedure "gm_" ref 202 202 205 218 zhigh parameter float bin(27) dcl 233 ref 231 231 253 zlow parameter float bin(27) dcl 233 ref 231 231 252 zpos 3 based float bin(27) level 2 dcl 2-22 set ref 170* 594 zscale parameter float bin(27) dcl 189 in procedure "gm_" ref 188 188 195 zscale 3 based float bin(27) level 2 in structure "scale_effector" dcl 2-28 in procedure "gm_" set ref 195* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Any_device internal static fixed bin(17,0) initial dcl 1-9 Blink internal static fixed bin(17,0) initial dcl 1-9 Blinking internal static fixed bin(17,0) initial dcl 1-9 Center internal static fixed bin(17,0) initial dcl 1-9 Clear_seg internal static fixed bin(17,0) initial dcl 4-29 Dash_dotted internal static fixed bin(17,0) initial dcl 1-9 Dashed internal static fixed bin(17,0) initial dcl 1-9 Dotted internal static fixed bin(17,0) initial dcl 1-9 Find_or_create_symbol internal static fixed bin(17,0) initial dcl 4-24 Full_intensity internal static fixed bin(17,0) initial dcl 1-9 Half_intensity internal static fixed bin(17,0) initial dcl 1-9 Insensitive internal static fixed bin(17,0) initial dcl 1-9 Invisible internal static fixed bin(17,0) initial dcl 1-9 Joystick internal static fixed bin(17,0) initial dcl 1-9 Keyboard internal static fixed bin(17,0) initial dcl 1-9 LSM_version_6 internal static fixed bin(17,0) initial dcl 3-5 LSM_version_7 internal static fixed bin(17,0) initial dcl 3-5 Left internal static fixed bin(17,0) initial dcl 1-9 Light_pen internal static fixed bin(17,0) initial dcl 1-9 Linetype internal static fixed bin(17,0) initial dcl 1-9 Long_dashed internal static fixed bin(17,0) initial dcl 1-9 Lower_center internal static fixed bin(17,0) initial dcl 1-9 Lower_left internal static fixed bin(17,0) initial dcl 1-9 Lower_right internal static fixed bin(17,0) initial dcl 1-9 Mouse internal static fixed bin(17,0) initial dcl 1-9 Null internal static fixed bin(17,0) initial dcl 1-9 On_dup_error internal static fixed bin(17,0) initial dcl 1-9 On_dup_source internal static fixed bin(17,0) initial dcl 1-9 On_dup_target_then_nulls internal static fixed bin(17,0) initial dcl 1-9 On_dup_target_then_source internal static fixed bin(17,0) initial dcl 1-9 Right internal static fixed bin(17,0) initial dcl 1-9 Sensitive internal static fixed bin(17,0) initial dcl 1-9 Sensitivity internal static fixed bin(17,0) initial dcl 1-9 Setpoint internal static fixed bin(17,0) initial dcl 1-9 Shift internal static fixed bin(17,0) initial dcl 1-9 Solid internal static fixed bin(17,0) initial dcl 1-9 Steady internal static fixed bin(17,0) initial dcl 1-9 Symboltable internal static fixed bin(17,0) initial dcl 2-3 Tablet_and_pen internal static fixed bin(17,0) initial dcl 1-9 Terminal_program internal static fixed bin(17,0) initial dcl 1-9 Trackball internal static fixed bin(17,0) initial dcl 1-9 Upper_center internal static fixed bin(17,0) initial dcl 1-9 Upper_left internal static fixed bin(17,0) initial dcl 1-9 Upper_right internal static fixed bin(17,0) initial dcl 1-9 Vector internal static fixed bin(17,0) initial dcl 1-9 array_node based structure level 1 dcl 3-89 fixed_node based structure level 1 dcl 3-56 float_node based structure level 1 dcl 3-60 gc_$d 000000 constant entry external dcl 5-21 gc_$d_switch 000000 constant entry external dcl 5-26 gc_$da 000000 constant entry external dcl 5-11 gc_$da_switch 000000 constant entry external dcl 5-16 gc_$display 000000 constant entry external dcl 5-21 gc_$display_append 000000 constant entry external dcl 5-11 gc_$display_append_switch 000000 constant entry external dcl 5-16 gc_$display_name 000000 constant entry external dcl 5-51 gc_$display_name_append 000000 constant entry external dcl 5-41 gc_$display_name_append_switch 000000 constant entry external dcl 5-46 gc_$display_name_switch 000000 constant entry external dcl 5-56 gc_$display_switch 000000 constant entry external dcl 5-26 gc_$dn 000000 constant entry external dcl 5-51 gc_$dn_switch 000000 constant entry external dcl 5-56 gc_$dna 000000 constant entry external dcl 5-41 gc_$dna_switch 000000 constant entry external dcl 5-46 gc_$l 000000 constant entry external dcl 5-31 gc_$l_switch 000000 constant entry external dcl 5-36 gc_$ln 000000 constant entry external dcl 5-61 gc_$ln_switch 000000 constant entry external dcl 5-66 gc_$load 000000 constant entry external dcl 5-31 gc_$load_name 000000 constant entry external dcl 5-61 gc_$load_name_switch 000000 constant entry external dcl 5-66 gc_$load_switch 000000 constant entry external dcl 5-36 gc_$prune_tree 000000 constant entry external dcl 5-71 gc_$return_string 000000 constant entry external dcl 5-6 gc_$rs 000000 constant entry external dcl 5-6 gc_$tree_ptr 000000 constant entry external dcl 5-3 graphic_compiler_$d 000000 constant entry external dcl 5-21 graphic_compiler_$d_switch 000000 constant entry external dcl 5-26 graphic_compiler_$da 000000 constant entry external dcl 5-11 graphic_compiler_$da_switch 000000 constant entry external dcl 5-16 graphic_compiler_$display 000000 constant entry external dcl 5-21 graphic_compiler_$display_append 000000 constant entry external dcl 5-11 graphic_compiler_$display_append_switch 000000 constant entry external dcl 5-16 graphic_compiler_$display_name 000000 constant entry external dcl 5-51 graphic_compiler_$display_name_append 000000 constant entry external dcl 5-41 graphic_compiler_$display_name_append_switch 000000 constant entry external dcl 5-46 graphic_compiler_$display_name_switch 000000 constant entry external dcl 5-56 graphic_compiler_$display_switch 000000 constant entry external dcl 5-26 graphic_compiler_$dn 000000 constant entry external dcl 5-51 graphic_compiler_$dn_switch 000000 constant entry external dcl 5-56 graphic_compiler_$dna 000000 constant entry external dcl 5-41 graphic_compiler_$dna_switch 000000 constant entry external dcl 5-46 graphic_compiler_$l 000000 constant entry external dcl 5-31 graphic_compiler_$l_switch 000000 constant entry external dcl 5-36 graphic_compiler_$ln 000000 constant entry external dcl 5-61 graphic_compiler_$ln_switch 000000 constant entry external dcl 5-66 graphic_compiler_$load 000000 constant entry external dcl 5-31 graphic_compiler_$load_name 000000 constant entry external dcl 5-61 graphic_compiler_$load_name_switch 000000 constant entry external dcl 5-66 graphic_compiler_$load_switch 000000 constant entry external dcl 5-36 graphic_compiler_$return_string 000000 constant entry external dcl 5-6 graphic_compiler_$rs 000000 constant entry external dcl 5-6 graphic_compiler_$tree_ptr 000000 constant entry external dcl 5-3 indirect_node based structure level 1 dcl 3-52 lsm_$mk_char 000000 constant entry external dcl 4-3 lsm_fs_$compact 000000 constant entry external dcl 4-10 lsm_fs_$free 000000 constant entry external dcl 4-10 lsm_fs_$move_struc 000000 constant entry external dcl 4-10 lsm_segptr automatic pointer dcl 3-25 lsm_sym_$find_table 000000 constant entry external dcl 4-19 lsm_sym_$symn 000000 constant entry external dcl 4-19 symtab_node based structure level 1 dcl 3-72 NAMES DECLARED BY EXPLICIT CONTEXT. add_element 002204 constant entry external dcl 404 add_pgs_suffix 006030 constant entry internal dcl 832 ref 826 853 924 944 array_too_small 005367 constant label dcl 978 ref 656 706 array_too_small_null_node 005354 constant label dcl 975 ref 352 assign_name 001772 constant entry external dcl 372 bad_align 005267 constant label dcl 960 ref 310 bad_etype 003215 constant label dcl 585 ref 607 626 649 654 bad_type 005315 constant label dcl 966 ref 561 586 687 802 bad_type_null_node 005302 constant label dcl 963 ref 291 carray 001615 constant entry external dcl 346 cclip 001011 constant entry external dcl 231 ccolor 001124 constant entry external dcl 259 cdata 001404 constant entry external dcl 321 check_wgs_init 005504 constant entry internal dcl 131 ref 406 478 511 540 579 604 622 644 679 728 742 765 784 852 923 check_wgs_init_null_node 005514 constant entry internal dcl 137 ref 278 304 324 350 375 391 461 523 clist 001541 constant entry external dcl 337 cmode 000457 constant entry external dcl 177 cpos 000310 constant entry external dcl 154 create_array 001642 constant entry external dcl 346 create_clip 001027 constant entry external dcl 231 create_color 001150 constant entry external dcl 259 create_data 001432 constant entry external dcl 321 create_fl_effector 005524 constant entry internal dcl 273 ref 166 180 192 212 242 262 create_list 001566 constant entry external dcl 337 create_mode 000501 constant entry external dcl 177 create_position 000336 constant entry external dcl 154 create_rotation 000663 constant entry external dcl 202 create_scale 000574 constant entry external dcl 188 create_text 001261 constant entry external dcl 300 crot 000645 constant entry external dcl 202 cscale 000556 constant entry external dcl 188 ctext 001231 constant entry external dcl 300 ecolor 003370 constant entry external dcl 620 edata 004471 constant entry external dcl 780 elist 003713 constant entry external dcl 674 emap 003506 constant entry external dcl 639 emode 003260 constant entry external dcl 602 epos 003114 constant entry external dcl 577 error_return 005260 constant label dcl 958 ref 98 109 112 800 837 870 874 896 905 error_return_null_node 005250 constant label dcl 956 ref 284 esymbol 004200 constant entry external dcl 740 esymtab 004041 constant entry external dcl 723 etext 004362 constant entry external dcl 761 etype 002714 constant entry external dcl 537 examine_color 003413 constant entry external dcl 620 examine_data 004516 constant entry external dcl 780 examine_list 003737 constant entry external dcl 674 examine_mapping 003525 constant entry external dcl 639 examine_mode 003301 constant entry external dcl 602 examine_position 003141 constant entry external dcl 577 examine_symbol 004225 constant entry external dcl 740 examine_symtab 004065 constant entry external dcl 723 examine_text 004411 constant entry external dcl 761 examine_type 002731 constant entry external dcl 537 fill_array 005725 constant entry internal dcl 700 ref 691 find_list_to_alter 005570 constant entry internal dcl 428 ref 408 463 find_structure 002106 constant entry external dcl 389 fstruc 002063 constant entry external dcl 389 get_special_block 005771 constant entry internal dcl 795 ref 766 785 get_struc 004571 constant entry external dcl 812 get_wgs 005401 constant entry internal dcl 95 ref 90 945 gm_ 000145 constant entry external dcl 18 graphic_manipulator_ 000156 constant entry external dcl 18 init 000176 constant entry external dcl 83 init_graphic_segment 005434 constant entry internal dcl 102 ref 91 876 list_common 001666 constant label dcl 350 set ref 344 move_it 006222 constant entry internal dcl 886 ref 879 880 move_struc 006065 constant entry internal dcl 862 ref 827 854 no_wgs_yet 005327 constant label dcl 969 ref 125 134 no_wgs_yet_null_node 005341 constant label dcl 972 ref 140 put_struc 004640 constant entry external dcl 848 remove_symbol 002541 constant entry external dcl 509 replace_element 002366 constant entry external dcl 457 replace_node 002476 constant entry external dcl 476 replace_node 005645 constant entry internal dcl 482 in procedure "gm_" ref 480 replicate 002632 constant entry external dcl 521 save_file 004712 constant entry external dcl 916 segp 000250 constant entry external dcl 118 unreflabel 001055 constant label dcl 242 use_file 005133 constant entry external dcl 942 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 7414 7510 6376 7424 Length 10244 6376 74 517 1015 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME gm_ 483 external procedure is an external procedure. get_wgs internal procedure shares stack frame of external procedure gm_. init_graphic_segment internal procedure shares stack frame of external procedure gm_. check_wgs_init internal procedure shares stack frame of external procedure gm_. create_fl_effector internal procedure shares stack frame of external procedure gm_. find_list_to_alter internal procedure shares stack frame of external procedure gm_. replace_node internal procedure shares stack frame of external procedure gm_. fill_array internal procedure shares stack frame of external procedure gm_. get_special_block internal procedure shares stack frame of external procedure gm_. add_pgs_suffix internal procedure shares stack frame of external procedure gm_. move_struc internal procedure shares stack frame of external procedure gm_. move_it internal procedure shares stack frame of external procedure gm_. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 wgs_p gm_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME gm_ 000100 node_no gm_ 000101 ltype gm_ 000102 curl gm_ 000104 effector_p gm_ 000106 node_ptr gm_ 000110 efficient_len gm_ 000111 xa gm_ 000112 ya gm_ 000113 za gm_ 000114 i gm_ 000115 lb gm_ 000116 sym_n gm_ 000117 temp_idx gm_ 000120 lsm_type gm_ 000121 lsm_curl gm_ 000122 p gm_ 000124 array_dim gm_ 000125 ename gm_ 000136 pgs_p gm_ 000266 array_max fill_array 000312 pgs_p move_struc 000322 from_val_n move_it 000323 from_sym_n move_it THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return mod_fl1 signal ext_entry ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. get_temp_segment_ graphic_compiler_$prune_tree hcs_$initiate hcs_$set_bc_seg hcs_$terminate_noname lsm_$get_blk lsm_$make_blk lsm_$replace_blk lsm_$replicate lsm_$set_blk lsm_fs_$init lsm_fs_$init_seg lsm_fs_$merge_symbol lsm_fs_$pull lsm_fs_$push lsm_sym_$sym_list lsm_sym_$symk suffixed_name_$make THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$smallarg graphic_error_table_$bad_align graphic_error_table_$clipping_unimplemented graphic_error_table_$inv_node_type graphic_error_table_$list_oob graphic_error_table_$no_wgs_yet graphic_error_table_$null_replacement LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000144 18 000165 83 000173 88 000210 90 000211 91 000217 92 000226 93 000235 118 000244 124 000262 125 000266 126 000272 127 000273 154 000302 159 000361 162 000371 163 000374 164 000377 166 000401 168 000420 169 000425 170 000433 171 000441 177 000452 180 000520 181 000535 182 000540 188 000551 192 000607 193 000622 194 000626 195 000630 196 000632 202 000643 205 000676 208 000707 209 000712 210 000715 212 000717 214 000724 215 000731 216 000734 217 000737 218 000742 219 000745 221 000750 222 000755 223 000763 225 000771 231 001002 239 001042 240 001045 242 001055 248 001070 249 001074 250 001076 251 001100 252 001102 253 001104 254 001106 259 001117 262 001171 263 001204 264 001207 265 001211 266 001213 300 001224 304 001306 305 001307 307 001333 309 001345 310 001350 314 001357 315 001366 321 001377 324 001455 325 001456 326 001477 328 001511 329 001514 331 001523 337 001534 343 001610 344 001612 346 001613 348 001664 350 001666 352 001667 354 001671 355 001712 357 001724 359 001727 360 001736 361 001751 362 001752 364 001754 372 001765 375 002012 376 002013 379 002050 389 002061 391 002126 392 002127 394 002132 396 002166 404 002177 406 002220 408 002221 409 002247 411 002260 413 002305 415 002316 417 002327 418 002336 419 002342 421 002345 423 002352 457 002361 461 002403 463 002404 464 002432 466 002444 467 002453 469 002454 470 002456 471 002461 476 002472 478 002512 480 002513 502 002526 509 002535 511 002560 513 002561 515 002617 521 002626 523 002645 524 002646 525 002664 526 002676 537 002707 540 002743 542 002744 543 002747 544 002750 545 002752 546 002753 549 002762 550 003003 551 003005 552 003010 555 003017 558 003025 560 003037 561 003042 564 003043 565 003050 566 003055 567 003062 568 003067 569 003074 571 003077 577 003106 579 003163 580 003164 582 003206 584 003212 585 003215 586 003217 589 003220 590 003223 592 003225 593 003232 594 003237 596 003244 602 003253 604 003317 605 003320 607 003342 610 003345 611 003350 612 003352 614 003354 620 003363 622 003433 623 003434 625 003456 626 003461 629 003464 630 003466 631 003470 633 003472 639 003501 644 003541 645 003542 647 003564 649 003620 652 003623 653 003626 654 003630 656 003634 659 003643 661 003646 663 003650 664 003657 665 003674 666 003675 668 003677 674 003706 679 003760 680 003761 681 004003 683 004014 686 004021 687 004022 690 004023 691 004025 693 004026 723 004035 728 004106 730 004107 731 004112 732 004122 734 004127 735 004164 740 004173 742 004247 743 004250 744 004272 745 004275 746 004300 749 004307 750 004313 751 004336 753 004346 761 004355 765 004435 766 004436 767 004440 768 004443 769 004446 770 004455 780 004464 784 004540 785 004541 786 004543 787 004553 788 004555 812 004564 826 004622 827 004623 828 004627 848 004636 852 004671 853 004672 854 004673 855 004677 916 004706 923 004737 924 004740 925 004741 926 004770 929 005001 930 005046 932 005061 933 005100 935 005111 936 005122 942 005131 943 005160 944 005161 945 005162 946 005170 947 005201 949 005212 950 005241 956 005250 958 005260 960 005267 961 005272 963 005302 964 005305 966 005315 967 005320 969 005327 970 005332 972 005341 973 005344 975 005354 976 005357 978 005367 979 005372 95 005401 97 005402 98 005431 99 005433 102 005434 108 005436 109 005447 111 005451 112 005501 114 005503 131 005504 133 005505 134 005506 135 005513 137 005514 139 005515 140 005516 141 005523 273 005524 278 005526 280 005527 282 005535 284 005556 285 005560 287 005563 288 005566 291 005567 428 005570 438 005572 439 005614 441 005620 442 005625 443 005630 446 005631 447 005640 448 005643 451 005644 482 005645 487 005647 488 005651 489 005654 492 005655 494 005703 496 005707 498 005724 700 005725 705 005726 706 005736 708 005740 710 005742 711 005751 712 005765 713 005766 715 005770 795 005771 797 005773 799 005774 800 006016 801 006020 802 006023 803 006027 832 006030 836 006031 837 006062 838 006064 862 006065 867 006067 868 006070 870 006123 873 006133 874 006166 876 006170 879 006172 880 006210 881 006221 886 006222 891 006224 893 006225 896 006261 898 006263 899 006310 903 006313 904 006320 905 006337 908 006341 ----------------------------------------------------------- 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