1 /* BEGIN INCLUDE FILE pl1_macro_compare_procs.incl.pl1 */
 2 compare_numbers:
 3      procedure (operation, operand1, operand2) returns (bit (1));
 4           declare operation              fixed binary;      /* INPUT:  logical operation */
 5           declare (operand1, operand2)   fixed binary;      /* INPUT: operands */
 6 
 7           goto compare (operation);
 8 
 9 compare (14):
10 compare (24):
11           return (arith_value (operand1) = arith_value (operand2));
12 compare (15):
13           return (arith_value (operand1) ^= arith_value (operand2));
14 compare (16):
15           return (arith_value (operand1) < arith_value (operand2));
16 compare (17):
17           return (arith_value (operand1) > arith_value (operand2));
18 compare (18):
19           return (arith_value (operand1) <= arith_value (operand2));
20 compare (19):
21           return (arith_value (operand1) >= arith_value (operand2));
22 compare (20):
23           return (arith_value (operand1) ^> arith_value (operand2));
24 compare (21):
25           return (arith_value (operand1) ^< arith_value (operand2));
26 
27      end compare_numbers;
28 
29 compare_chars:
30      procedure (operation, operand1, operand2) returns (bit (1));
31           declare operation              fixed binary;      /* INPUT:  logical operation */
32           declare (operand1, operand2)   fixed binary;      /* INPUT: operands */
33 
34           goto compare (operation);
35 
36 compare (14):
37 compare (24):
38           return (char_value (operand1) = char_value (operand2));
39 compare (15):
40           return (char_value (operand1) ^= char_value (operand2));
41 compare (16):
42           return (char_value (operand1) < char_value (operand2));
43 compare (17):
44           return (char_value (operand1) > char_value (operand2));
45 compare (18):
46           return (char_value (operand1) <= char_value (operand2));
47 compare (19):
48           return (char_value (operand1) >= char_value (operand2));
49 compare (20):
50           return (char_value (operand1) ^> char_value (operand2));
51 compare (21):
52           return (char_value (operand1) ^< char_value (operand2));
53 
54      end compare_chars;
55 
56 compare_bit_strings:
57      procedure (operation, operand1, operand2) returns (bit (1));
58           declare operation              fixed binary;      /* INPUT:  logical operation */
59           declare (operand1, operand2)   fixed binary;      /* INPUT: operands */
60 
61           goto compare (operation);
62 
63 compare (14):
64 compare (24):
65           return (bit_value (operand1) = bit_value (operand2));
66 compare (15):
67           return (bit_value (operand1) ^= bit_value (operand2));
68 compare (16):
69           return (bit_value (operand1) < bit_value (operand2));
70 compare (17):
71           return (bit_value (operand1) > bit_value (operand2));
72 compare (18):
73           return (bit_value (operand1) <= bit_value (operand2));
74 compare (19):
75           return (bit_value (operand1) >= bit_value (operand2));
76 compare (20):
77           return (bit_value (operand1) ^> bit_value (operand2));
78 compare (21):
79           return (bit_value (operand1) ^< bit_value (operand2));
80 
81      end compare_bit_strings;
82 
83 same_identifier:
84        procedure (id1, id2) returns (bit (1));
85        declare (id1, id2)               fixed binary;
86 
87 /* long winded way of saying that both tokens are represented by the same char_string */
88 
89             return (substr (token (id1).string_ptr -> based_chars, 1, token (id1).string_size) = substr (token (id2).string_ptr -> based_chars, 1, token (id2).string_size));
90 
91      end same_identifier;
92 /* END INCLUDE FILE ... pl1_macro_compare_procs.incl.pl1 */