1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 /* This procedure is called with a constant and a code.  It is used
 12    to generate various types of referencees using the constant.
 13 
 14    Initial Version: 30 September 1968 by BLW
 15           Modified: 19 March 1971 by BLW for Version II
 16           Modified: 24 August 1972 by BLW
 17           Modified: 4 June 1975 by RAB for separate_static
 18           Modified 791026 by PG for TCT tables in pl1_operators_
 19 */
 20 
 21 c_a:      proc(pc,code) returns(ptr);
 22 
 23 dcl       (c,pc) fixed bin(15),                   /* constant value */
 24           code fixed bin,               /* what type of reference */
 25           table_subscript fixed bin,
 26           word_delta fixed bin;
 27 
 28 dcl       (ref_pt,p) ptr,
 29           xr fixed bin(3),
 30           n fixed bin(15),
 31           mask_array fixed static init(0),        /* loc of mask array */
 32           blank_array fixed static init(288),     /* loc of blank array */
 33           array_mask fixed static init(144),      /* loc of mask2 array */
 34           xr_man$load_any_const entry(fixed bin,fixed bin(3)),
 35           get_reference ext entry returns(ptr);
 36 dcl       base_man$load_linkage entry returns(bit(3) aligned);
 37 dcl       base_man$load_static entry returns(bit(3) aligned);
 38 dcl       stack_temp$assign_temp entry(ptr);
 39 
 40 dcl       (addr,bit,divide,fixed,substr,mod) builtin;
 41 
 42 dcl       1 word              aligned based(p),
 43           2 offset            unaligned bit(18),
 44           2 rhs               unaligned bit(18);
 45 
 46 /* internal static */
 47 
 48 dcl       tct_byte_offset (0:3) fixed bin int static init (-627, -499, -371, -243);       /* from assembly of pl1_operators_ */
 49 
 50 /* include files */
 51 
 52 %include reference;
 53 %include temporary;
 54 %include bases;
 55 %include relocation_bits;
 56 ^L
 57 /* program */
 58 
 59           ref_pt = get_reference();
 60           p = addr(ref_pt -> reference.address);
 61           c,n = pc;
 62           goto sw(code);
 63 
 64           /* reference is c itself */
 65 
 66 sw(1):    if n >= 0 then p -> word.offset = bit(fixed(n,18),18);
 67           else p -> word.offset = bit(fixed(262144 + n,18),18);
 68 
 69 done:     ref_pt -> reference.no_address = "0"b;
 70           ref_pt -> reference.perm_address = "1"b;
 71           return(ref_pt);
 72 
 73           /* reference is c,dl */
 74 
 75 sw(2):    ref_pt -> address.tag = "000111"b; /* dl */
 76           goto sw(1);
 77 
 78           /* reference is c,du */
 79 
 80 sw(3):    ref_pt -> address.tag = "000011"b; /* du */
 81           goto sw(1);
 82 
 83           /* reference is sp|c */
 84 
 85 sw(4):    ref_pt -> address.base = sp;
 86 
 87           if mod(n,2) = 0 then ref_pt -> reference.even = "1"b;
 88 
 89 l2:       if n >= 16384
 90           then do;
 91                n = mod(n,16384);
 92                call xr_man$load_any_const(c-n,xr);
 93                substr(ref_pt -> address.tag,3,4) = "1"b || bit(xr,3);
 94                end;
 95 
 96           ref_pt -> address.ext_base = "1"b;
 97           ref_pt -> address.offset = bit(fixed(n,15),15);;
 98           goto done;
 99 
100           /* reference is ap|mask_array+2*c, where referenceed location
101              contains a string with c 1's followed by 72-c 0's */
102 
103 sw(5):    ref_pt -> address.offset = bit(fixed(mask_array+2*n,15),15);
104 l1:       ref_pt -> address.base = ap;
105           ref_pt -> address.ext_base = "1"b;
106           ref_pt -> reference.even = "1"b;
107           goto done;
108 
109           /* reference is ap|blank_array+2*c, where referenceed location
110              contains a string with c 0 char's followed by 8-c blanks */
111 
112 sw(6):    ref_pt -> address.offset = bit(fixed(blank_array+2*divide(n,9,17,0),15),15);
113           goto l1;
114 
115           /* reference is ap|array_mask+2*c, where referenceed location
116              contains a string with c 0's followed by 72-c 1's */
117 
118 sw(7):    ref_pt -> address.offset = bit(fixed(array_mask+2*n,15),15);
119           goto l1;
120 
121           /* reference is 0,c */
122 
123 sw(8):    ref_pt -> address.tag = "001"b || bit(fixed(n,3),3);
124           goto done;
125 
126           /* reference is lp|c,* (linkage section) */
127 
128 sw(9):    ref_pt -> address.tag = "010000"b;      /* * */
129           ref_pt -> address.base = base_man$load_linkage();
130           ref_pt -> reference.relocation = rc_lp15;
131           goto l2;
132 
133           /* reference is c,ic */
134 
135 sw(10):   ref_pt -> reference.ic_ref = "1"b;
136           ref_pt -> address.tag = "000100"b;      /* ic */
137           if mod(n,2) = 0 then ref_pt -> reference.even = "1"b;
138           goto sw(1);
139 
140           /* reference is bp|c */
141 
142 sw(11):   ref_pt -> address.base = bp;
143           goto l2;
144 
145           /* reference is to block of c words in stack */
146 
147 sw(12):   ref_pt -> reference.c_length = n;
148           ref_pt -> reference.temp_ref = "1"b;
149           call stack_temp$assign_temp(ref_pt);
150           c,n = ref_pt -> reference.qualifier -> temporary.location;
151           goto sw(4);
152 
153           /* reference is to location c in static section */
154 
155 sw(13):   ref_pt -> address.base = base_man$load_static();
156           ref_pt -> reference.relocation = rc_is15;
157           goto l2;
158 
159           /* reference is sp|c,* */
160 
161 sw(14):   ref_pt -> address.tag = ref_pt -> address.tag | "010000"b;  /* * */
162           go to sw(4);
163 
164           /* reference is lp|c,* (static section) */
165 
166 sw(15):   ref_pt -> address.tag = ref_pt -> address.tag | "010000"b;  /* * */
167           ref_pt -> reference.relocation = rc_is15;
168           ref_pt -> address.base = base_man$load_static();
169           go to l2;
170 
171           /* reference is ap|-n, where -n is the offset of the TCT table for c */
172 
173 sw (16):
174           word_delta = divide (c, 4, 9, 0);
175           table_subscript = c - word_delta * 4;
176           n = tct_byte_offset (table_subscript) - word_delta + 32768;
177           ref_pt -> reference.address.base = ap;
178           ref_pt -> reference.address.offset = bit (n, 15);
179           ref_pt -> reference.address.ext_base = "1"b;
180           /* dont care about even bit */
181           go to done;
182 
183      end /* c_a */;