1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19 exp_op: proc(npx,refs,atom);
20
21 dcl npx ptr,
22 refs(3) ptr,
23 atom(3) bit(1) aligned;
24
25 dcl node_pt ptr defined (npx),
26 ref(3) ptr defined (refs);
27
28 dcl (p,q) ptr,
29 (type,square_macro,mpy_macro,n) fixed bin(15),
30 fw bit(36) aligned;
31
32 dcl load entry(ptr,fixed bin);
33 dcl m_a entry(ptr,bit(2) aligned);
34 dcl compile_exp$save entry(ptr) returns(ptr),
35 get_reference entry returns(ptr);
36 dcl state_man$erase_reg entry(bit(19) aligned);
37 dcl expmac entry(fixed bin(15),ptr),
38 expmac$zero entry(fixed bin(15));
39
40 dcl (index,substr) builtin;
41
42 dcl full_word bit(36) aligned based;
43
44 dcl ( square_fx1 init(403),
45 mpy_mac(4) init(25,0,31,32)) fixed bin(15) int static;
46
47 %include cgsystem;
48 %include reference;
49 %include symbol;
50 %include operator;
51
52
53
54
55 call state_man$erase_reg("11"b);
56
57 if atom(2) then call load(ref(2),0); else ref(2) = compile_exp$save((node_pt -> operand(2)));
58
59 p = get_reference();
60 p -> reference = ref(2) -> reference;
61 if p -> reference.no_address then call m_a(p,"0"b);
62 p -> reference.shared, p -> reference.perm_address = "1"b;
63
64 if atom(2) then q = p; else q = ref(2);
65
66 type = p -> reference.data_type;
67 square_macro = square_fx1 - 1 + type;
68 mpy_macro = mpy_mac(type);
69
70 fw = ref(3) -> reference.symbol -> symbol.initial -> full_word;
71
72 call expmac(mpy_macro,q);
73
74 n = index(fw,"1"b) + 1;
75
76 loop: if substr(fw,n,1) then call expmac(mpy_macro,p);
77
78 n = n + 1;
79 if n <= bits_per_word
80 then do;
81 call expmac$zero(square_macro);
82 goto loop;
83 end;
84
85 end;