1 | // $Source$ |
---|
2 | // $Revision: 753 $ |
---|
3 | // $Date: 2003-05-25 16:52:55 +0000 (Sun, 25 May 2003) $ |
---|
4 | // $Author: luba $ |
---|
5 | |
---|
6 | #include <rf_core.hh> |
---|
7 | |
---|
8 | namespace refal |
---|
9 | { |
---|
10 | |
---|
11 | using namespace rfrt; |
---|
12 | using namespace rftype; |
---|
13 | |
---|
14 | namespace Convert |
---|
15 | { |
---|
16 | |
---|
17 | RF_FUNC (To_m_Int, (RF_ARG e_Exp), (RF_RES s_Int)) |
---|
18 | uintptr_t len = 0; |
---|
19 | int flag = 0; |
---|
20 | |
---|
21 | Term* t = e_Exp.get_first(); |
---|
22 | if (t->get_type() == type_char) { |
---|
23 | for (; ;) |
---|
24 | if (((Char*)t)->to_wchar_t() != ' ') { |
---|
25 | break; |
---|
26 | } |
---|
27 | else t++; |
---|
28 | } |
---|
29 | if (t->get_type() == type_char) { |
---|
30 | if (((Char*)t)->to_wchar_t() == '-') { |
---|
31 | flag = -1; t++; |
---|
32 | } |
---|
33 | else |
---|
34 | if (((Char*)t)->to_wchar_t() == '+') { |
---|
35 | flag = 1; t++; |
---|
36 | } |
---|
37 | }; |
---|
38 | if ((t->get_type() == type_word) ) |
---|
39 | if (((Word*)t)->is_number() == -1) |
---|
40 | flag = -1; |
---|
41 | else |
---|
42 | if(((Word*)t)->is_number() == 1) |
---|
43 | flag = 1; |
---|
44 | else |
---|
45 | if(((Word*)t)->is_number() == 2) |
---|
46 | flag = 0; |
---|
47 | else |
---|
48 | retfail; |
---|
49 | |
---|
50 | if (t->get_type() == type_short_int ||t->get_type() == type_word ) { |
---|
51 | t++; |
---|
52 | } |
---|
53 | |
---|
54 | for (; t < e_Exp.get_last(); t++) { |
---|
55 | if (t->get_type() == type_char) { |
---|
56 | |
---|
57 | if (((Char*)t)->is_not_space()) { |
---|
58 | |
---|
59 | if (((Char*)t)->is_digit()) { |
---|
60 | |
---|
61 | if (len > UINTPTR_MAX - 1) |
---|
62 | RF_LIB_ERROR("Argument too large for conversion"); |
---|
63 | else { |
---|
64 | len += 1; |
---|
65 | } |
---|
66 | } |
---|
67 | else { |
---|
68 | if (((Char*)t)->is_not_space()) |
---|
69 | retfail; |
---|
70 | else |
---|
71 | continue; |
---|
72 | } |
---|
73 | } |
---|
74 | |
---|
75 | else { |
---|
76 | Term* temp = t; |
---|
77 | while (temp->get_type()==type_char){ |
---|
78 | if (((Char*)temp)->is_not_space() == false){ |
---|
79 | temp++; t = temp; |
---|
80 | } |
---|
81 | else { |
---|
82 | retfail; |
---|
83 | } |
---|
84 | } |
---|
85 | } |
---|
86 | } |
---|
87 | else |
---|
88 | if (t->get_type() == type_short_int) { |
---|
89 | if (((ShortInt*)t)->to_int() < 0) |
---|
90 | retfail; |
---|
91 | else { |
---|
92 | size_t num_len = ((ShortInt*)t)->get_char_len(); |
---|
93 | if (len > UINTPTR_MAX - num_len) |
---|
94 | RF_LIB_ERROR("Argument too large for conversion"); |
---|
95 | else |
---|
96 | len += num_len; |
---|
97 | } |
---|
98 | } |
---|
99 | else |
---|
100 | if (t->get_type() == type_word){ |
---|
101 | // retfail, if '-' or '+' is the 1st symbol in the 2nd, 3rd,... word |
---|
102 | // |
---|
103 | if (((Word*)t)->is_number() == 1 ||((Word*)t)->is_number() == -1 ) |
---|
104 | retfail; |
---|
105 | |
---|
106 | size_t word_len = ((Word*)t)->get_len(); |
---|
107 | |
---|
108 | if (len > UINTPTR_MAX - word_len) |
---|
109 | RF_LIB_ERROR("Argument too large for conversion"); |
---|
110 | else |
---|
111 | len += word_len; |
---|
112 | } |
---|
113 | else |
---|
114 | retfail; |
---|
115 | }; |
---|
116 | if (len >= ShortInt::max_len) |
---|
117 | RF_LIB_ERROR("Argument too large for conversion"); |
---|
118 | |
---|
119 | s_Int = ShortInt::create_expr(e_Exp, flag); |
---|
120 | |
---|
121 | RF_END |
---|
122 | } |
---|
123 | } |
---|
124 | |
---|