1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32 evaluate: proc(opcode,r2,r3) returns(ptr);
33
34 dcl opcode bit(9) aligned,
35 (r2,r3) ptr;
36
37 dcl q ptr,
38 ans char(32) aligned,
39 (i,n,prec,prec2,prec3) fixed bin(35);
40
41 dcl (v2,v3) fixed decimal (31);
42 dcl v fixed decimal (50);
43 dcl v_chars char (51) based (addr (v));
44
45 dcl string_max fixed bin int static init(256);
46
47 dcl (substr,length,max) builtin;
48
49 dcl assign_ entry (ptr, fixed bin, fixed bin(35), ptr, fixed bin, fixed bin(35));
50
51 %include op_codes;
52 %include operator;
53 %include token;
54 %include token_types;
55 %include language_utility;
56 %include std_descriptor_types;
57
58 if opcode = cat_string then go to concatenate;
59
60 if opcode >= div
61 then do;
62 make: q = create_operator(opcode,3);
63 q -> operand(2) = r2;
64 q -> operand(3) = r3;
65 return(q);
66 end;
67
68 if r2 -> token.type ^= r3 -> token.type then goto make;
69
70 if r2 -> token.type ^= dec_integer then goto make;
71
72 if r2 -> token.loc ^= r3 -> token.loc
73 then go to make;
74
75 prec2 = length(r2 -> token.string);
76 prec3 = length(r3 -> token.string);
77
78 if prec2 > 31 | prec3 > 31 then goto make;
79
80 call assign_ (addr (v2), real_fix_dec_9bit_ls_dtype*2, 31,
81 addr (r2 -> token.string), char_dtype*2, prec2);
82 call assign_ (addr (v3), real_fix_dec_9bit_ls_dtype*2, 31,
83 addr (r3 -> token.string), char_dtype*2, prec3);
84
85 if opcode = add
86 then v = v2 + v3;
87
88 else if opcode = sub
89 then v = v2 - v3;
90 else v = v2 * v3;
91
92
93
94 i = verify (substr (v_chars, 2), "0");
95 prec = max (length (v_chars)-i, 1);
96
97 if substr (v_chars, 1, 1) ^= "-" then
98 return (create_token$protected (substr (v_chars, length (v_chars)-prec+1, prec), dec_integer, (r2 -> token.loc)));
99 else return (create_token$protected ("-" || substr (v_chars, length (v_chars)-prec+1, prec), dec_integer, (r2 -> token.loc)));
100
101
102 concatenate:
103 if r2 -> token.type ^= r3 -> token.type then goto make;
104
105 if r2 -> token.type = char_string
106 then prec2 = length(r2 -> token.string);
107 else if r2 -> token.type = bit_string
108 then prec2 = length(r2 -> token.string) - 1;
109 else go to make;
110
111 if prec2 + length(r3 -> token.string) > string_max
112 then go to make;
113
114 return(create_token(substr(r2 -> token.string,1,prec2) || r3 -> token.string, (r2 -> token.type)));
115 end;