OpenCOBOL 1.1pre-rel
|
00001 /* 00002 * Copyright (C) 2001-2009 Keisuke Nishida 00003 * Copyright (C) 2007-2009 Roger While 00004 * 00005 * This program is free software; you can redistribute it and/or modify 00006 * it under the terms of the GNU General Public License as published by 00007 * the Free Software Foundation; either version 2, or (at your option) 00008 * any later version. 00009 * 00010 * This program is distributed in the hope that it will be useful, 00011 * but WITHOUT ANY WARRANTY; without even the implied warranty of 00012 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00013 * GNU General Public License for more details. 00014 * 00015 * You should have received a copy of the GNU General Public License 00016 * along with this software; see the file COPYING. If not, write to 00017 * the Free Software Foundation, 51 Franklin Street, Fifth Floor 00018 * Boston, MA 02110-1301 USA 00019 */ 00020 00021 #ifndef CB_TREE_H 00022 #define CB_TREE_H 00023 00024 #define YYSTYPE cb_tree 00025 00026 #define CB_BEFORE cb_int0 00027 #define CB_AFTER cb_int1 00028 00029 #define COB_MAX_SUBSCRIPTS 16 00030 00031 #define CB_PREFIX_ATTR "a_" /* field attribute (cob_field_attr) */ 00032 #define CB_PREFIX_BASE "b_" /* base address (unsigned char *) */ 00033 #define CB_PREFIX_CONST "c_" /* constant or literal (cob_field) */ 00034 #define CB_PREFIX_DECIMAL "d_" /* decimal number (cob_decimal) */ 00035 #define CB_PREFIX_FIELD "f_" /* field (cob_field) */ 00036 #define CB_PREFIX_FILE "h_" /* file (cob_file) */ 00037 #define CB_PREFIX_KEYS "k_" /* file keys (struct cob_file_key []) */ 00038 #define CB_PREFIX_LABEL "l_" /* label */ 00039 #define CB_PREFIX_SEQUENCE "s_" /* collating sequence */ 00040 00041 #define CB_PROGRAM_TYPE 0 00042 #define CB_FUNCTION_TYPE 1 00043 00044 enum cb_tag { 00045 /* primitives */ 00046 CB_TAG_CONST, /* 0 constant value */ 00047 CB_TAG_INTEGER, /* 1 integer constant */ 00048 CB_TAG_STRING, /* 2 string constant */ 00049 CB_TAG_ALPHABET_NAME, /* 3 alphabet-name */ 00050 CB_TAG_CLASS_NAME, /* 4 class-name */ 00051 CB_TAG_LOCALE_NAME, /* 5 locale-name */ 00052 CB_TAG_SYSTEM_NAME, /* 6 system-name */ 00053 CB_TAG_LITERAL, /* 7 numeric/alphanumeric literal */ 00054 CB_TAG_DECIMAL, /* 8 decimal number */ 00055 CB_TAG_FIELD, /* 9 user-defined variable */ 00056 CB_TAG_FILE, /* 10 file description */ 00057 /* expressions */ 00058 CB_TAG_REFERENCE, /* 11 reference to a field, file, or label */ 00059 CB_TAG_BINARY_OP, /* 12 binary operation */ 00060 CB_TAG_FUNCALL, /* 13 run-time function call */ 00061 CB_TAG_CAST, /* 14 type cast */ 00062 CB_TAG_INTRINSIC, /* 15 intrinsic function */ 00063 /* statements */ 00064 CB_TAG_LABEL, /* 16 label statement */ 00065 CB_TAG_ASSIGN, /* 17 assignment statement */ 00066 CB_TAG_INITIALIZE, /* 18 INITIALIZE statement */ 00067 CB_TAG_SEARCH, /* 19 SEARCH statement */ 00068 CB_TAG_CALL, /* 20 CALL statement */ 00069 CB_TAG_GOTO, /* 21 GO TO statement */ 00070 CB_TAG_IF, /* 22 IF statement */ 00071 CB_TAG_PERFORM, /* 23 PERFORM statement */ 00072 CB_TAG_STATEMENT, /* 24 general statement */ 00073 CB_TAG_CONTINUE, /* 25 CONTINUE statement */ 00074 /* miscellaneous */ 00075 CB_TAG_PERFORM_VARYING, /* 26 PERFORM VARYING parameter */ 00076 CB_TAG_PICTURE, /* 27 PICTURE clause */ 00077 CB_TAG_LIST /* 28 list */ 00078 }; 00079 00080 enum cb_alphabet_name_type { 00081 CB_ALPHABET_NATIVE, 00082 CB_ALPHABET_STANDARD_1, 00083 CB_ALPHABET_STANDARD_2, 00084 CB_ALPHABET_EBCDIC, 00085 CB_ALPHABET_CUSTOM 00086 }; 00087 00088 enum cb_system_name_category { 00089 CB_CALL_CONVENTION_NAME, 00090 CB_CODE_NAME, 00091 CB_COMPUTER_NAME, 00092 CB_DEVICE_NAME, 00093 CB_ENTRY_CONVENTION_NAME, 00094 CB_EXTERNAL_LOCALE_NAME, 00095 CB_FEATURE_NAME, 00096 CB_LIBRARY_NAME, 00097 CB_SWITCH_NAME, 00098 CB_TEXT_NAME 00099 }; 00100 00101 enum cb_device_name { 00102 CB_DEVICE_SYSIN, 00103 CB_DEVICE_SYSOUT, 00104 CB_DEVICE_SYSERR, 00105 CB_DEVICE_CONSOLE 00106 }; 00107 00108 enum cb_feature_name { 00109 CB_FEATURE_FORMFEED, 00110 CB_FEATURE_C01, 00111 CB_FEATURE_C02, 00112 CB_FEATURE_C03, 00113 CB_FEATURE_C04, 00114 CB_FEATURE_C05, 00115 CB_FEATURE_C06, 00116 CB_FEATURE_C07, 00117 CB_FEATURE_C08, 00118 CB_FEATURE_C09, 00119 CB_FEATURE_C10, 00120 CB_FEATURE_C11, 00121 CB_FEATURE_C12 00122 }; 00123 00124 enum cb_switch_name { 00125 CB_SWITCH_1, 00126 CB_SWITCH_2, 00127 CB_SWITCH_3, 00128 CB_SWITCH_4, 00129 CB_SWITCH_5, 00130 CB_SWITCH_6, 00131 CB_SWITCH_7, 00132 CB_SWITCH_8 00133 }; 00134 00135 enum cb_class { 00136 CB_CLASS_UNKNOWN, /* 0 */ 00137 CB_CLASS_ALPHABETIC, /* 1 */ 00138 CB_CLASS_ALPHANUMERIC, /* 2 */ 00139 CB_CLASS_BOOLEAN, /* 3 */ 00140 CB_CLASS_INDEX, /* 4 */ 00141 CB_CLASS_NATIONAL, /* 5 */ 00142 CB_CLASS_NUMERIC, /* 6 */ 00143 CB_CLASS_OBJECT, /* 7 */ 00144 CB_CLASS_POINTER /* 8 */ 00145 }; 00146 00147 enum cb_category { 00148 CB_CATEGORY_UNKNOWN, /* 0 */ 00149 CB_CATEGORY_ALPHABETIC, /* 1 */ 00150 CB_CATEGORY_ALPHANUMERIC, /* 2 */ 00151 CB_CATEGORY_ALPHANUMERIC_EDITED, /* 3 */ 00152 CB_CATEGORY_BOOLEAN, /* 4 */ 00153 CB_CATEGORY_INDEX, /* 5 */ 00154 CB_CATEGORY_NATIONAL, /* 6 */ 00155 CB_CATEGORY_NATIONAL_EDITED, /* 7 */ 00156 CB_CATEGORY_NUMERIC, /* 8 */ 00157 CB_CATEGORY_NUMERIC_EDITED, /* 9 */ 00158 CB_CATEGORY_OBJECT_REFERENCE, /* 10 */ 00159 CB_CATEGORY_DATA_POINTER, /* 11 */ 00160 CB_CATEGORY_PROGRAM_POINTER /* 12 */ 00161 }; 00162 00163 enum cb_storage { 00164 CB_STORAGE_CONSTANT, /* Constants */ 00165 CB_STORAGE_FILE, /* FILE SECTION */ 00166 CB_STORAGE_WORKING, /* WORKING-STORAGE SECTION */ 00167 CB_STORAGE_LOCAL, /* LOCAL-STORAGE SECTION */ 00168 CB_STORAGE_LINKAGE, /* LINKAGE SECTION */ 00169 CB_STORAGE_SCREEN, /* SCREEN SECTION */ 00170 CB_STORAGE_REPORT, /* REPORT SECTION */ 00171 CB_STORAGE_COMMUNICATION /* COMMUNICATION SECTION */ 00172 }; 00173 00174 enum cb_usage { 00175 CB_USAGE_BINARY, /* 0 */ 00176 CB_USAGE_BIT, /* 1 */ 00177 CB_USAGE_COMP_5, /* 2 */ 00178 CB_USAGE_COMP_X, /* 3 */ 00179 CB_USAGE_DISPLAY, /* 4 */ 00180 CB_USAGE_FLOAT, /* 5 */ 00181 CB_USAGE_DOUBLE, /* 6 */ 00182 CB_USAGE_INDEX, /* 7 */ 00183 CB_USAGE_NATIONAL, /* 8 */ 00184 CB_USAGE_OBJECT, /* 9 */ 00185 CB_USAGE_PACKED, /* 10 */ 00186 CB_USAGE_POINTER, /* 11 */ 00187 CB_USAGE_PROGRAM, /* 12 */ 00188 CB_USAGE_LENGTH, /* 13 */ 00189 CB_USAGE_PROGRAM_POINTER, /* 14 */ 00190 CB_USAGE_UNSIGNED_CHAR, /* 15 */ 00191 CB_USAGE_SIGNED_CHAR, /* 16 */ 00192 CB_USAGE_UNSIGNED_SHORT, /* 17 */ 00193 CB_USAGE_SIGNED_SHORT, /* 18 */ 00194 CB_USAGE_UNSIGNED_INT, /* 19 */ 00195 CB_USAGE_SIGNED_INT, /* 20 */ 00196 CB_USAGE_UNSIGNED_LONG, /* 21 */ 00197 CB_USAGE_SIGNED_LONG /* 22 */ 00198 }; 00199 00200 enum cb_operand_type { 00201 CB_SENDING_OPERAND, 00202 CB_RECEIVING_OPERAND 00203 }; 00204 00205 00206 /* 00207 * Tree 00208 */ 00209 00210 struct cb_tree_common { 00211 enum cb_tag tag; 00212 enum cb_category category; 00213 unsigned char *source_file; 00214 int source_line; 00215 }; 00216 00217 typedef struct cb_tree_common *cb_tree; 00218 00219 #define CB_TREE(x) ((struct cb_tree_common *) (x)) 00220 #define CB_TREE_TAG(x) (CB_TREE (x)->tag) 00221 #define CB_TREE_CLASS(x) cb_tree_class (CB_TREE (x)) 00222 #define CB_TREE_CATEGORY(x) cb_tree_category (CB_TREE (x)) 00223 00224 #ifdef __GNUC__ 00225 #define CB_TREE_CAST(tg,ty,x) \ 00226 ({ \ 00227 cb_tree _x = (x); \ 00228 if (!_x || CB_TREE_TAG (_x) != tg) \ 00229 { \ 00230 cobc_tree_cast_error (_x, __FILE__, __LINE__, tg); \ 00231 } \ 00232 ((ty *) (_x)); \ 00233 }) 00234 #else 00235 #define CB_TREE_CAST(tg,ty,x) ((ty *) (x)) 00236 #endif 00237 00238 extern char *cb_name (cb_tree x); 00239 extern enum cb_class cb_tree_class (cb_tree x); 00240 extern enum cb_category cb_tree_category (cb_tree x); 00241 extern int cb_tree_type (cb_tree x); 00242 extern int cb_fits_int (cb_tree x); 00243 extern int cb_fits_long_long (cb_tree x); 00244 extern int cb_get_int (cb_tree x); 00245 extern long long cb_get_long_long (cb_tree x); 00246 00247 /* 00248 * Constants 00249 */ 00250 00251 extern cb_tree cb_any; 00252 extern cb_tree cb_true; 00253 extern cb_tree cb_false; 00254 extern cb_tree cb_null; 00255 extern cb_tree cb_zero; 00256 extern cb_tree cb_one; 00257 extern cb_tree cb_space; 00258 extern cb_tree cb_low; 00259 extern cb_tree cb_high; 00260 extern cb_tree cb_norm_low; 00261 extern cb_tree cb_norm_high; 00262 extern cb_tree cb_quote; 00263 extern cb_tree cb_int0; 00264 extern cb_tree cb_int1; 00265 extern cb_tree cb_int2; 00266 extern cb_tree cb_int3; 00267 extern cb_tree cb_int4; 00268 extern cb_tree cb_int5; 00269 extern cb_tree cb_i[8]; 00270 extern cb_tree cb_error_node; 00271 00272 extern cb_tree cb_intr_whencomp; 00273 extern cb_tree cb_intr_pi; 00274 extern cb_tree cb_intr_e; 00275 00276 extern cb_tree cb_standard_error_handler; 00277 00278 extern size_t gen_screen_ptr; 00279 00280 struct cb_const { 00281 struct cb_tree_common common; 00282 const char *val; 00283 }; 00284 00285 #define CB_CONST(x) (CB_TREE_CAST (CB_TAG_CONST, struct cb_const, x)) 00286 #define CB_CONST_P(x) (CB_TREE_TAG (x) == CB_TAG_CONST) 00287 00288 extern void cb_init_constants (void); 00289 00290 00291 /* 00292 * Integer 00293 */ 00294 00295 struct cb_integer { 00296 struct cb_tree_common common; 00297 int val; 00298 }; 00299 00300 #define CB_INTEGER(x) (CB_TREE_CAST (CB_TAG_INTEGER, struct cb_integer, x)) 00301 #define CB_INTEGER_P(x) (CB_TREE_TAG (x) == CB_TAG_INTEGER) 00302 00303 extern cb_tree cb_int (int n); 00304 00305 00306 /* 00307 * String 00308 */ 00309 00310 struct cb_string { 00311 struct cb_tree_common common; 00312 size_t size; 00313 const unsigned char *data; 00314 }; 00315 00316 #define CB_STRING(x) (CB_TREE_CAST (CB_TAG_STRING, struct cb_string, x)) 00317 #define CB_STRING_P(x) (CB_TREE_TAG (x) == CB_TAG_STRING) 00318 00319 #define cb_build_string0(str) cb_build_string (str, strlen ((char *)str)) 00320 00321 extern cb_tree cb_build_string (const unsigned char *data, size_t size); 00322 00323 00324 /* 00325 * Alphabet-name 00326 */ 00327 00328 struct cb_alphabet_name { 00329 struct cb_tree_common common; 00330 const char *name; 00331 char *cname; 00332 cb_tree custom_list; 00333 enum cb_alphabet_name_type type; 00334 int low_val_char; 00335 int high_val_char; 00336 }; 00337 00338 #define CB_ALPHABET_NAME(x) (CB_TREE_CAST (CB_TAG_ALPHABET_NAME, struct cb_alphabet_name, x)) 00339 #define CB_ALPHABET_NAME_P(x) (CB_TREE_TAG (x) == CB_TAG_ALPHABET_NAME) 00340 00341 extern cb_tree cb_build_alphabet_name (cb_tree name, enum cb_alphabet_name_type type); 00342 00343 00344 /* 00345 * Class-name 00346 */ 00347 00348 struct cb_class_name { 00349 struct cb_tree_common common; 00350 const char *name; 00351 char *cname; 00352 cb_tree list; 00353 }; 00354 00355 #define CB_CLASS_NAME(x) (CB_TREE_CAST (CB_TAG_CLASS_NAME, struct cb_class_name, x)) 00356 #define CB_CLASS_NAME_P(x) (CB_TREE_TAG (x) == CB_TAG_CLASS_NAME) 00357 00358 extern cb_tree cb_build_class_name (cb_tree name, cb_tree list); 00359 00360 00361 /* 00362 * Locale name 00363 */ 00364 00365 struct cb_locale_name { 00366 struct cb_tree_common common; 00367 const char *name; 00368 char *cname; 00369 cb_tree list; 00370 }; 00371 00372 #define CB_LOCALE_NAME(x) (CB_TREE_CAST (CB_TAG_LOCALE_NAME, struct cb_locale_name, x)) 00373 #define CB_LOCALE_NAME_P(x) (CB_TREE_TAG (x) == CB_TAG_LOCALE_NAME) 00374 00375 extern cb_tree cb_build_locale_name (cb_tree name, cb_tree list); 00376 00377 /* 00378 * System-name 00379 */ 00380 00381 struct cb_system_name { 00382 struct cb_tree_common common; 00383 enum cb_system_name_category category; 00384 int token; 00385 }; 00386 00387 #define CB_SYSTEM_NAME(x) (CB_TREE_CAST (CB_TAG_SYSTEM_NAME, struct cb_system_name, x)) 00388 #define CB_SYSTEM_NAME_P(x) (CB_TREE_TAG (x) == CB_TAG_SYSTEM_NAME) 00389 00390 extern cb_tree cb_build_system_name (enum cb_system_name_category category, int token); 00391 00392 00393 /* 00394 * Literal 00395 */ 00396 00397 struct cb_literal { 00398 struct cb_tree_common common; 00399 size_t size; 00400 unsigned char *data; 00401 signed char all; 00402 signed char sign; /* unsigned: 0 negative: -1 positive: 1 */ 00403 signed char scale; 00404 signed char spare; /* spare */ 00405 }; 00406 00407 #define CB_LITERAL(x) (CB_TREE_CAST (CB_TAG_LITERAL, struct cb_literal, x)) 00408 #define CB_LITERAL_P(x) (CB_TREE_TAG (x) == CB_TAG_LITERAL) 00409 #define CB_NUMERIC_LITERAL_P(x) \ 00410 (CB_LITERAL_P (x) && CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC) 00411 00412 extern cb_tree cb_build_numeric_literal (int sign, const unsigned char *data, int scale); 00413 extern cb_tree cb_build_alphanumeric_literal (const unsigned char *data, size_t size); 00414 extern cb_tree cb_concat_literals (cb_tree x1, cb_tree x2); 00415 00416 00417 /* 00418 * Decimal 00419 */ 00420 00421 struct cb_decimal { 00422 struct cb_tree_common common; 00423 int id; 00424 }; 00425 00426 #define CB_DECIMAL(x) (CB_TREE_CAST (CB_TAG_DECIMAL, struct cb_decimal, x)) 00427 #define CB_DECIMAL_P(x) (CB_TREE_TAG (x) == CB_TAG_DECIMAL) 00428 00429 extern cb_tree cb_build_decimal (int id); 00430 00431 00432 /* 00433 * Picture 00434 */ 00435 00436 struct cb_picture { 00437 struct cb_tree_common common; 00438 int size; /* byte size */ 00439 int lenstr; /* length of picture string */ 00440 char *orig; /* original picture string */ 00441 char *str; /* packed picture string */ 00442 enum cb_category category; /* field category */ 00443 unsigned char digits; /* the number of digit places */ 00444 signed char scale; /* 1/10^scale */ 00445 unsigned char have_sign; /* have 'S' */ 00446 unsigned char spare; /* spare */ 00447 }; 00448 00449 #define CB_PICTURE(x) (CB_TREE_CAST (CB_TAG_PICTURE, struct cb_picture, x)) 00450 #define CB_PICTURE_P(x) (CB_TREE_TAG (x) == CB_TAG_PICTURE) 00451 00452 extern cb_tree cb_build_picture (const char *str); 00453 00454 00455 /* 00456 * Field 00457 */ 00458 00459 struct cb_field { 00460 struct cb_tree_common common; 00461 int id; /* field id */ 00462 int storage_id; /* storage id */ 00463 const char *name; /* the original name */ 00464 const char *ename; /* the externalized name */ 00465 int size; /* field size */ 00466 int memory_size; /* memory size */ 00467 int offset; /* byte offset from top (01 field) */ 00468 int level; /* level number */ 00469 int occurs_min; /* OCCURS <max> */ 00470 int occurs_max; /* or OCCURS <min> TO <max> */ 00471 int indexes; /* number of parents who have OCCURS */ 00472 int count; /* reference count */ 00473 cb_tree occurs_depending; /* OCCURS ... DEPENDING ON */ 00474 enum cb_storage storage; 00475 enum cb_usage usage; /* USAGE */ 00476 cb_tree values; /* VALUE */ 00477 cb_tree false_88; /* 88 FALSE clause */ 00478 cb_tree index_list; /* INDEXED BY */ 00479 struct cb_field *parent; /* upper level field (NULL for 01 fields) */ 00480 struct cb_field *children; /* top of lower level fields */ 00481 struct cb_field *sister; /* fields in the same level */ 00482 struct cb_field *redefines; /* REDEFINES */ 00483 struct cb_field *rename_thru; /* RENAMES THRU */ 00484 struct cb_field *index_qual; /* INDEXED BY qualifier */ 00485 struct cb_file *file; /* file name associated in FD section */ 00486 struct cb_key { 00487 int dir; /* ASCENDING or DESCENDING */ 00488 cb_tree key; /* KEY */ 00489 cb_tree ref; /* reference used in SEARCH ALL */ 00490 cb_tree val; /* value to be compared in SEARCH ALL */ 00491 } *keys; 00492 int nkeys; /* the number of keys */ 00493 int param_num; /* CHAINING param number */ 00494 struct cb_picture *pic; /* PICTURE */ 00495 /* screen parameters */ 00496 cb_tree screen_line; 00497 cb_tree screen_column; 00498 cb_tree screen_from; 00499 cb_tree screen_to; 00500 cb_tree screen_foreg; 00501 cb_tree screen_backg; 00502 int screen_flag; /* flags used in SCREEN SECTION */ 00503 /* flags */ 00504 unsigned int flag_external : 1; /* EXTERNAL */ 00505 unsigned int flag_blank_zero : 1; /* BLANK WHEN ZERO */ 00506 unsigned int flag_justified : 1; /* JUSTIFIED RIGHT */ 00507 unsigned int flag_sign_leading : 1; /* SIGN IS LEADING */ 00508 unsigned int flag_sign_separate : 1; /* SIGN IS SEPARATE */ 00509 unsigned int flag_synchronized : 1; /* SYNCHRONIZED */ 00510 unsigned int flag_occurs : 1; /* OCCURS */ 00511 unsigned int flag_invalid : 1; /* is broken */ 00512 unsigned int flag_binary_swap : 1; /* binary byteswap */ 00513 unsigned int flag_local : 1; /* has local scope */ 00514 unsigned int flag_base : 1; /* has memory allocation */ 00515 unsigned int flag_field : 1; /* has been internally cached */ 00516 unsigned int flag_item_external : 1; /* is EXTERNAL */ 00517 unsigned int flag_chained : 1; /* CHAINING item */ 00518 unsigned int flag_real_binary : 1; /* is BINARY-CHAR/SHORT/LONG/DOUBLE */ 00519 unsigned int flag_item_based : 1; /* is BASED */ 00520 unsigned int flag_item_78 : 1; /* is 78 level */ 00521 unsigned int flag_any_length : 1; /* is ANY LENGTH */ 00522 unsigned int flag_anylen_done : 1; /* ANY LENGTH is set up */ 00523 unsigned int flag_indexed_by : 1; /* INDEXED BY item */ 00524 unsigned int flag_is_pointer : 1; /* is POINTER */ 00525 unsigned int flag_is_verified : 1; /* has been verified */ 00526 unsigned int flag_is_global : 1; /* is GLOBAL */ 00527 unsigned int flag_is_c_long : 1; /* is BINARY-C-LONG */ 00528 unsigned int flag_is_pdiv_parm : 1; /* is PROC DIV USING */ 00529 unsigned int flag_local_alloced : 1; /* LOCAL storage is allocated */ 00530 unsigned int flag_no_init : 1; /* no initialize unless used */ 00531 unsigned int flag_spare : 5; 00532 }; 00533 00534 #define CB_FIELD(x) (CB_TREE_CAST (CB_TAG_FIELD, struct cb_field, x)) 00535 #define CB_FIELD_P(x) (CB_TREE_TAG (x) == CB_TAG_FIELD) 00536 00537 extern cb_tree cb_build_field (cb_tree name); 00538 extern cb_tree cb_build_implicit_field (cb_tree name, int len); 00539 extern cb_tree cb_build_constant (cb_tree name, cb_tree value); 00540 00541 extern struct cb_field *cb_field (cb_tree x); 00542 extern struct cb_field *cb_field_add (struct cb_field *f, struct cb_field *p); 00543 extern int cb_field_size (cb_tree x); 00544 extern struct cb_field *cb_field_founder (struct cb_field *f); 00545 extern struct cb_field *cb_field_variable_size (struct cb_field *f); 00546 extern struct cb_field *cb_field_variable_address (struct cb_field *f); 00547 extern int cb_field_subordinate (struct cb_field *p, struct cb_field *f); 00548 00549 #define CB_REF_OR_FIELD_P(x) ((CB_FIELD_P (x) || CB_REFERENCE_P (x))) 00550 00551 /* Index */ 00552 00553 #define CB_INDEX_P(x) ((CB_FIELD_P (x) || CB_REFERENCE_P (x)) \ 00554 && cb_field (x)->usage == CB_USAGE_INDEX) 00555 00556 00557 /* 00558 * Label 00559 */ 00560 00561 struct cb_label { 00562 struct cb_tree_common common; 00563 const unsigned char *name; 00564 struct cb_label *section; 00565 cb_tree exit_label; 00566 cb_tree exit_label_ref; 00567 cb_tree children; 00568 const unsigned char *orig_name; 00569 int id; 00570 int is_section; 00571 int is_entry; 00572 unsigned char need_begin; 00573 unsigned char need_return; 00574 unsigned char is_global; 00575 unsigned char spare; 00576 }; 00577 00578 #define CB_LABEL(x) (CB_TREE_CAST (CB_TAG_LABEL, struct cb_label, x)) 00579 #define CB_LABEL_P(x) (CB_TREE_TAG (x) == CB_TAG_LABEL) 00580 00581 extern cb_tree cb_build_label (cb_tree name, struct cb_label *section); 00582 00583 struct handler_struct { 00584 struct cb_label *handler_label; 00585 struct cb_program *handler_prog; 00586 }; 00587 00588 /* 00589 * File 00590 */ 00591 00592 struct cb_alt_key { 00593 struct cb_alt_key *next; 00594 cb_tree key; 00595 int duplicates; 00596 int offset; 00597 }; 00598 00599 struct cb_file { 00600 struct cb_tree_common common; 00601 const char *name; /* The original name */ 00602 char *cname; /* The name used in C */ 00603 /* SELECT */ 00604 cb_tree assign; /* ASSIGN */ 00605 cb_tree file_status; /* FILE STATUS */ 00606 cb_tree sharing; /* SHARING */ 00607 cb_tree key; /* RELATIVE/RECORD KEY */ 00608 struct cb_alt_key *alt_key_list; /* ALTERNATE RECORD KEY */ 00609 /* FD/SD */ 00610 struct cb_field *record; /* Record descriptor */ 00611 cb_tree record_depending; /* RECORD DEPENDING */ 00612 cb_tree linage; /* LINAGE */ 00613 cb_tree linage_ctr; /* LINAGE COUNTER */ 00614 cb_tree latfoot; /* LINAGE FOOTING */ 00615 cb_tree lattop; /* LINAGE TOP */ 00616 cb_tree latbot; /* LINAGE BOTTOM */ 00617 struct cb_label *handler; /* Error handler */ 00618 struct cb_program *handler_prog; /* Prog where defined */ 00619 int record_min; /* RECORD CONTAINS */ 00620 int record_max; /* RECORD CONTAINS */ 00621 int optional; /* OPTIONAL */ 00622 int organization; /* ORGANIZATION */ 00623 int access_mode; /* ACCESS MODE */ 00624 int lock_mode; /* LOCK MODE */ 00625 int same_clause; /* SAME clause */ 00626 int finalized; /* Is finalized */ 00627 int external; /* Is EXTERNAL */ 00628 int special; /* Special file */ 00629 int external_assign; /* ASSIGN EXTERNAL */ 00630 int fileid_assign; /* ASSIGN DISK */ 00631 int global; /* Is GLOBAL */ 00632 }; 00633 00634 #define CB_FILE(x) (CB_TREE_CAST (CB_TAG_FILE, struct cb_file, x)) 00635 #define CB_FILE_P(x) (CB_TREE_TAG (x) == CB_TAG_FILE) 00636 00637 extern struct cb_file *build_file (cb_tree name); 00638 extern void validate_file (struct cb_file *f, cb_tree name); 00639 extern void finalize_file (struct cb_file *f, struct cb_field *records); 00640 00641 00642 /* 00643 * Reference 00644 */ 00645 00646 #define CB_WORD_HASH_SIZE 133 00647 00648 struct cb_word { 00649 struct cb_word *next; /* next word with the same hash value */ 00650 const char *name; /* word name */ 00651 cb_tree items; /* objects associated with this word */ 00652 int count; /* number of words with the same name */ 00653 int error; /* set to 1 if error displayed */ 00654 }; 00655 00656 struct cb_reference { 00657 struct cb_tree_common common; 00658 struct cb_word *word; 00659 enum cb_operand_type type; 00660 cb_tree value; /* item referred by this reference */ 00661 cb_tree subs; /* the list of subscripts */ 00662 cb_tree offset; /* 1st operand of reference modification */ 00663 cb_tree length; /* 2nd operand of reference modification */ 00664 cb_tree check; 00665 cb_tree chain; /* next qualified name */ 00666 int all; 00667 }; 00668 00669 #define CB_REFERENCE(x) (CB_TREE_CAST (CB_TAG_REFERENCE, struct cb_reference, x)) 00670 #define CB_REFERENCE_P(x) (CB_TREE_TAG (x) == CB_TAG_REFERENCE) 00671 00672 #define CB_NAME(x) (CB_REFERENCE (x)->word->name) 00673 00674 extern cb_tree cb_build_filler (void); 00675 extern cb_tree cb_build_reference (const char *name); 00676 extern cb_tree cb_build_field_reference (struct cb_field *f, cb_tree ref); 00677 extern const char *cb_define (cb_tree name, cb_tree val); 00678 extern void cb_define_system_name (const char *name); 00679 extern cb_tree cb_ref (cb_tree x); 00680 00681 00682 /* 00683 * Binary operation 00684 */ 00685 00686 /* 00687 '+' x + y 00688 '-' x - y 00689 '*' x * y 00690 '/' x / y 00691 '^' x ** y 00692 '=' x = y 00693 '>' x > y 00694 '<' x < y 00695 '[' x <= y 00696 ']' x >= y 00697 '~' x != y 00698 '!' not x 00699 '&' x and y 00700 '|' x or y 00701 '@' ( x ) 00702 */ 00703 00704 struct cb_binary_op { 00705 struct cb_tree_common common; 00706 int op; 00707 cb_tree x; 00708 cb_tree y; 00709 }; 00710 00711 #define CB_BINARY_OP(x) (CB_TREE_CAST (CB_TAG_BINARY_OP, struct cb_binary_op, x)) 00712 #define CB_BINARY_OP_P(x) (CB_TREE_TAG (x) == CB_TAG_BINARY_OP) 00713 00714 #define cb_build_parenthesis(x) cb_build_binary_op (x, '@', NULL) 00715 #define cb_build_negation(x) cb_build_binary_op (x, '!', NULL) 00716 00717 extern cb_tree cb_build_binary_op (cb_tree x, int op, cb_tree y); 00718 extern cb_tree cb_build_binary_list (cb_tree l, int op); 00719 00720 00721 /* 00722 * Function call 00723 */ 00724 00725 struct cb_funcall { 00726 struct cb_tree_common common; 00727 const char *name; 00728 cb_tree argv[7]; 00729 int argc; 00730 int varcnt; 00731 size_t screenptr; 00732 }; 00733 00734 #define CB_FUNCALL(x) (CB_TREE_CAST (CB_TAG_FUNCALL, struct cb_funcall, x)) 00735 #define CB_FUNCALL_P(x) (CB_TREE_TAG (x) == CB_TAG_FUNCALL) 00736 00737 extern cb_tree cb_build_funcall (const char *name, int argc, cb_tree a1, cb_tree a2, 00738 cb_tree a3, cb_tree a4, cb_tree a5, cb_tree a6, 00739 cb_tree a7); 00740 00741 #define cb_build_funcall_0(f) \ 00742 cb_build_funcall(f, 0, NULL, NULL, NULL, NULL, NULL, NULL, NULL) 00743 #define cb_build_funcall_1(f,a1) \ 00744 cb_build_funcall(f, 1, a1, NULL, NULL, NULL, NULL, NULL, NULL) 00745 #define cb_build_funcall_2(f,a1,a2) \ 00746 cb_build_funcall(f, 2, a1, a2, NULL, NULL, NULL, NULL, NULL) 00747 #define cb_build_funcall_3(f,a1,a2,a3) \ 00748 cb_build_funcall(f, 3, a1, a2, a3, NULL, NULL, NULL, NULL) 00749 #define cb_build_funcall_4(f,a1,a2,a3,a4) \ 00750 cb_build_funcall(f, 4, a1, a2, a3, a4, NULL, NULL, NULL) 00751 #define cb_build_funcall_5(f,a1,a2,a3,a4,a5) \ 00752 cb_build_funcall(f, 5, a1, a2, a3, a4, a5, NULL, NULL) 00753 #define cb_build_funcall_6(f,a1,a2,a3,a4,a5,a6) \ 00754 cb_build_funcall(f, 6, a1, a2, a3, a4, a5, a6, NULL) 00755 #define cb_build_funcall_7(f,a1,a2,a3,a4,a5,a6,a7) \ 00756 cb_build_funcall(f, 7, a1, a2, a3, a4, a5, a6, a7) 00757 00758 00759 /* 00760 * Type cast 00761 */ 00762 00763 enum cb_cast_type { 00764 CB_CAST_INTEGER, 00765 CB_CAST_ADDRESS, 00766 CB_CAST_ADDR_OF_ADDR, 00767 CB_CAST_LENGTH, 00768 CB_CAST_PROGRAM_POINTER 00769 }; 00770 00771 struct cb_cast { 00772 struct cb_tree_common common; 00773 enum cb_cast_type type; 00774 cb_tree val; 00775 }; 00776 00777 #define CB_CAST(x) (CB_TREE_CAST (CB_TAG_CAST, struct cb_cast, x)) 00778 #define CB_CAST_P(x) (CB_TREE_TAG (x) == CB_TAG_CAST) 00779 00780 extern cb_tree cb_build_cast (enum cb_cast_type type, cb_tree val); 00781 00782 #define cb_build_cast_integer(x) cb_build_cast (CB_CAST_INTEGER, x) 00783 #define cb_build_cast_address(x) cb_build_cast (CB_CAST_ADDRESS, x) 00784 #define cb_build_cast_addr_of_addr(x) cb_build_cast (CB_CAST_ADDR_OF_ADDR, x) 00785 #define cb_build_cast_length(x) cb_build_cast (CB_CAST_LENGTH, x) 00786 #define cb_build_cast_ppointer(x) cb_build_cast (CB_CAST_PROGRAM_POINTER, x) 00787 00788 00789 /* 00790 * Assign 00791 */ 00792 00793 struct cb_assign { 00794 struct cb_tree_common common; 00795 cb_tree var; 00796 cb_tree val; 00797 }; 00798 00799 #define CB_ASSIGN(x) (CB_TREE_CAST (CB_TAG_ASSIGN, struct cb_assign, x)) 00800 #define CB_ASSIGN_P(x) (CB_TREE_TAG (x) == CB_TAG_ASSIGN) 00801 00802 extern cb_tree cb_build_assign (cb_tree var, cb_tree val); 00803 00804 00805 /* 00806 * Intrinsic FUNCTION 00807 */ 00808 00809 enum cb_intr_enum { 00810 CB_INTR_ABS = 1, 00811 CB_INTR_ACOS, 00812 CB_INTR_ANNUITY, 00813 CB_INTR_ASIN, 00814 CB_INTR_ATAN, 00815 CB_INTR_BOOLEAN_OF_INTEGER, 00816 CB_INTR_BYTE_LENGTH, 00817 CB_INTR_CHAR, 00818 CB_INTR_CHAR_NATIONAL, 00819 CB_INTR_COMBINED_DATETIME, 00820 CB_INTR_CONCATENATE, 00821 CB_INTR_COS, 00822 CB_INTR_CURRENT_DATE, 00823 CB_INTR_DATE_OF_INTEGER, 00824 CB_INTR_DATE_TO_YYYYMMDD, 00825 CB_INTR_DAY_OF_INTEGER, 00826 CB_INTR_DAY_TO_YYYYDDD, 00827 CB_INTR_DISPLAY_OF, 00828 CB_INTR_E, 00829 CB_INTR_EXCEPTION_FILE, 00830 CB_INTR_EXCEPTION_FILE_N, 00831 CB_INTR_EXCEPTION_LOCATION, 00832 CB_INTR_EXCEPTION_LOCATION_N, 00833 CB_INTR_EXCEPTION_STATEMENT, 00834 CB_INTR_EXCEPTION_STATUS, 00835 CB_INTR_EXP, 00836 CB_INTR_EXP10, 00837 CB_INTR_FACTORIAL, 00838 CB_INTR_FRACTION_PART, 00839 CB_INTR_HIGHEST_ALGEBRAIC, 00840 CB_INTR_INTEGER, 00841 CB_INTR_INTEGER_OF_BOOLEAN, 00842 CB_INTR_INTEGER_OF_DATE, 00843 CB_INTR_INTEGER_OF_DAY, 00844 CB_INTR_INTEGER_PART, 00845 CB_INTR_LENGTH, 00846 CB_INTR_LOCALE_COMPARE, 00847 CB_INTR_LOCALE_DATE, 00848 CB_INTR_LOCALE_TIME, 00849 CB_INTR_LOCALE_TIME_FROM_SECS, 00850 CB_INTR_LOG, 00851 CB_INTR_LOG10, 00852 CB_INTR_LOWER_CASE, 00853 CB_INTR_LOWEST_ALGEBRAIC, 00854 CB_INTR_MAX, 00855 CB_INTR_MEAN, 00856 CB_INTR_MEDIAN, 00857 CB_INTR_MIDRANGE, 00858 CB_INTR_MIN, 00859 CB_INTR_MOD, 00860 CB_INTR_NATIONAL_OF, 00861 CB_INTR_NUMVAL, 00862 CB_INTR_NUMVAL_C, 00863 CB_INTR_NUMVAL_F, 00864 CB_INTR_ORD, 00865 CB_INTR_ORD_MAX, 00866 CB_INTR_ORD_MIN, 00867 CB_INTR_PI, 00868 CB_INTR_PRESENT_VALUE, 00869 CB_INTR_RANDOM, 00870 CB_INTR_RANGE, 00871 CB_INTR_REM, 00872 CB_INTR_REVERSE, 00873 CB_INTR_SECONDS_FROM_FORMATTED_TIME, 00874 CB_INTR_SECONDS_PAST_MIDNIGHT, 00875 CB_INTR_SIGN, 00876 CB_INTR_SIN, 00877 CB_INTR_SQRT, 00878 CB_INTR_STANDARD_COMPARE, 00879 CB_INTR_STANDARD_DEVIATION, 00880 CB_INTR_STORED_CHAR_LENGTH, 00881 CB_INTR_SUBSTITUTE, 00882 CB_INTR_SUBSTITUTE_CASE, 00883 CB_INTR_SUM, 00884 CB_INTR_TAN, 00885 CB_INTR_TEST_DATE_YYYYMMDD, 00886 CB_INTR_TEST_DAY_YYYYDDD, 00887 CB_INTR_TEST_NUMVAL, 00888 CB_INTR_TEST_NUMVAL_C, 00889 CB_INTR_TEST_NUMVAL_F, 00890 CB_INTR_TRIM, 00891 CB_INTR_UPPER_CASE, 00892 CB_INTR_VARIANCE, 00893 CB_INTR_WHEN_COMPILED, 00894 CB_INTR_YEAR_TO_YYYY 00895 }; 00896 00897 struct cb_intrinsic_table { 00898 const char *name; /* FUNCTION NAME */ 00899 const int args; /* 0-n, negative = variable */ 00900 const int implemented; /* Have we implemented it? */ 00901 const enum cb_intr_enum intr_enum; /* Enum intrinsic */ 00902 const char *intr_routine; /* Routine name */ 00903 const enum cb_category category; /* Category */ 00904 const unsigned int refmod; /* Can be refmodded */ 00905 }; 00906 00907 struct cb_intrinsic { 00908 struct cb_tree_common common; 00909 cb_tree name; 00910 cb_tree args; 00911 cb_tree intr_field; /* Field to use */ 00912 struct cb_intrinsic_table *intr_tab; 00913 cb_tree offset; 00914 cb_tree length; 00915 }; 00916 00917 #define CB_INTRINSIC(x) (CB_TREE_CAST (CB_TAG_INTRINSIC, struct cb_intrinsic, x)) 00918 #define CB_INTRINSIC_P(x) (CB_TREE_TAG (x) == CB_TAG_INTRINSIC) 00919 00920 extern struct cb_intrinsic_table *lookup_intrinsic (const char *name, 00921 const int checkres); 00922 extern cb_tree cb_build_intrinsic (cb_tree name, 00923 cb_tree args, 00924 cb_tree refmod); 00925 extern cb_tree cb_build_any_intrinsic (cb_tree args); 00926 00927 00928 /* 00929 * INITIALIZE 00930 */ 00931 00932 struct cb_initialize { 00933 struct cb_tree_common common; 00934 cb_tree var; 00935 cb_tree val; 00936 cb_tree rep; 00937 cb_tree def; 00938 int flag_statement; 00939 }; 00940 00941 #define CB_INITIALIZE(x) (CB_TREE_CAST (CB_TAG_INITIALIZE, struct cb_initialize, x)) 00942 #define CB_INITIALIZE_P(x) (CB_TREE_TAG (x) == CB_TAG_INITIALIZE) 00943 00944 extern cb_tree cb_build_initialize (cb_tree var, cb_tree val, cb_tree rep, cb_tree def, int flag); 00945 00946 00947 /* 00948 * SEARCH 00949 */ 00950 00951 struct cb_search { 00952 struct cb_tree_common common; 00953 int flag_all; 00954 cb_tree table; 00955 cb_tree var; 00956 cb_tree end_stmt; 00957 cb_tree whens; 00958 }; 00959 00960 #define CB_SEARCH(x) (CB_TREE_CAST (CB_TAG_SEARCH, struct cb_search, x)) 00961 #define CB_SEARCH_P(x) (CB_TREE_TAG (x) == CB_TAG_SEARCH) 00962 00963 extern cb_tree cb_build_search (int flag_all, cb_tree table, cb_tree var, cb_tree end_stmt, cb_tree whens); 00964 00965 00966 /* 00967 * CALL 00968 */ 00969 00970 #define CB_CALL_BY_REFERENCE 1 00971 #define CB_CALL_BY_CONTENT 2 00972 #define CB_CALL_BY_VALUE 3 00973 00974 struct cb_call { 00975 struct cb_tree_common common; 00976 cb_tree name; 00977 cb_tree args; 00978 cb_tree stmt1; 00979 cb_tree stmt2; 00980 cb_tree returning; 00981 int is_system; 00982 }; 00983 00984 #define CB_CALL(x) (CB_TREE_CAST (CB_TAG_CALL, struct cb_call, x)) 00985 #define CB_CALL_P(x) (CB_TREE_TAG (x) == CB_TAG_CALL) 00986 00987 extern cb_tree cb_build_call (cb_tree name, cb_tree args, cb_tree stmt1, cb_tree stmt2, 00988 cb_tree returning, int is_system_call); 00989 00990 00991 /* 00992 * GO TO statement 00993 */ 00994 00995 struct cb_goto { 00996 struct cb_tree_common common; 00997 cb_tree target; 00998 cb_tree depending; 00999 }; 01000 01001 #define CB_GOTO(x) (CB_TREE_CAST (CB_TAG_GOTO, struct cb_goto, x)) 01002 #define CB_GOTO_P(x) (CB_TREE_TAG (x) == CB_TAG_GOTO) 01003 01004 extern cb_tree cb_build_goto (cb_tree target, cb_tree depending); 01005 01006 01007 /* 01008 * IF 01009 */ 01010 01011 struct cb_if { 01012 struct cb_tree_common common; 01013 cb_tree test; 01014 cb_tree stmt1; 01015 cb_tree stmt2; 01016 }; 01017 01018 #define CB_IF(x) (CB_TREE_CAST (CB_TAG_IF, struct cb_if, x)) 01019 #define CB_IF_P(x) (CB_TREE_TAG (x) == CB_TAG_IF) 01020 01021 extern cb_tree cb_build_if (cb_tree test, cb_tree stmt1, cb_tree stmt2); 01022 01023 01024 /* 01025 * PERFORM 01026 */ 01027 01028 enum cb_perform_type { 01029 CB_PERFORM_EXIT, 01030 CB_PERFORM_ONCE, 01031 CB_PERFORM_TIMES, 01032 CB_PERFORM_UNTIL, 01033 CB_PERFORM_FOREVER 01034 }; 01035 01036 struct cb_perform_varying { 01037 struct cb_tree_common common; 01038 cb_tree name; 01039 cb_tree from; 01040 cb_tree step; 01041 cb_tree until; 01042 }; 01043 01044 struct cb_perform { 01045 struct cb_tree_common common; 01046 enum cb_perform_type type; 01047 cb_tree test; 01048 cb_tree body; 01049 cb_tree data; 01050 cb_tree varying; 01051 cb_tree exit_label; 01052 cb_tree cycle_label; 01053 }; 01054 01055 #define CB_PERFORM_VARYING(x) (CB_TREE_CAST (CB_TAG_PERFORM_VARYING, struct cb_perform_varying, x)) 01056 01057 #define CB_PERFORM(x) (CB_TREE_CAST (CB_TAG_PERFORM, struct cb_perform, x)) 01058 #define CB_PERFORM_P(x) (CB_TREE_TAG (x) == CB_TAG_PERFORM) 01059 01060 extern cb_tree cb_build_perform (int type); 01061 extern cb_tree cb_build_perform_varying (cb_tree name, cb_tree from, cb_tree step, cb_tree until); 01062 01063 /* 01064 * Statement 01065 */ 01066 01067 struct cb_statement { 01068 struct cb_tree_common common; 01069 const char *name; 01070 cb_tree body; 01071 cb_tree file; 01072 cb_tree handler1; 01073 cb_tree handler2; 01074 cb_tree handler3; 01075 cb_tree null_check; 01076 int handler_id; 01077 int need_terminator; 01078 }; 01079 01080 #define CB_STATEMENT(x) (CB_TREE_CAST (CB_TAG_STATEMENT, struct cb_statement, x)) 01081 #define CB_STATEMENT_P(x) (CB_TREE_TAG (x) == CB_TAG_STATEMENT) 01082 01083 extern struct cb_statement *cb_build_statement (const char *name); 01084 01085 01086 /* 01087 * CONTINUE 01088 */ 01089 01090 struct cb_continue { 01091 struct cb_tree_common common; 01092 }; 01093 01094 #define CB_CONTINUE(x) (CB_TREE_CAST (CB_TAG_CONTINUE, struct cb_continue, x)) 01095 #define CB_CONTINUE_P(x) (CB_TREE_TAG (x) == CB_TAG_CONTINUE) 01096 01097 extern cb_tree cb_build_continue (void); 01098 01099 01100 /* 01101 * List 01102 */ 01103 01104 struct cb_list { 01105 struct cb_tree_common common; 01106 cb_tree purpose; 01107 cb_tree value; 01108 cb_tree chain; 01109 int sizes; 01110 }; 01111 01112 #define CB_LIST(x) (CB_TREE_CAST (CB_TAG_LIST, struct cb_list, x)) 01113 #define CB_LIST_P(x) (CB_TREE_TAG (x) == CB_TAG_LIST) 01114 01115 #define CB_PURPOSE(x) (CB_LIST (x)->purpose) 01116 #define CB_VALUE(x) (CB_LIST (x)->value) 01117 #define CB_CHAIN(x) (CB_LIST (x)->chain) 01118 #define CB_SIZES(x) (CB_LIST (x)->sizes) 01119 01120 #define CB_PURPOSE_INT(x) (CB_INTEGER (CB_PURPOSE (x))->val) 01121 01122 #define CB_SIZE_AUTO 0 01123 #define CB_SIZE_1 1 01124 #define CB_SIZE_2 2 01125 #define CB_SIZE_4 3 01126 #define CB_SIZE_8 4 01127 #define CB_SIZE_UNSIGNED 8 01128 01129 #define CB_SIZES_INT(x) ((CB_LIST (x)->sizes) & 0x07) 01130 #define CB_SIZES_INT_UNSIGNED(x) ((CB_LIST (x)->sizes) & CB_SIZE_UNSIGNED) 01131 01132 extern cb_tree cb_build_list (cb_tree purpose, cb_tree value, cb_tree rest); 01133 extern cb_tree cb_list_add (cb_tree l, cb_tree x); 01134 extern cb_tree cb_list_append (cb_tree l1, cb_tree l2); 01135 extern cb_tree cb_list_reverse (cb_tree l); 01136 extern int cb_list_length (cb_tree l); 01137 01138 #define cb_list_init(x) cb_build_list (NULL, x, NULL) 01139 #define cb_cons(x,l) cb_build_list (NULL, x, l) 01140 01141 /* Pair */ 01142 01143 #define CB_PAIR_P(x) (CB_LIST_P (x) && CB_PAIR_X (x)) 01144 #define CB_PAIR_X(x) CB_PURPOSE (x) 01145 #define CB_PAIR_Y(x) CB_VALUE (x) 01146 01147 #define cb_build_pair(x,y) cb_build_list (x, y, NULL) 01148 01149 01150 /* 01151 * Program 01152 */ 01153 01154 struct cb_program { 01155 /* program variables */ 01156 struct cb_program *next_program; /* Nested */ 01157 const char *program_id; 01158 char *source_name; 01159 char *orig_source_name; 01160 FILE *local_storage_file; 01161 char *local_storage_name; 01162 cb_tree entry_list; 01163 cb_tree file_list; 01164 cb_tree exec_list; 01165 cb_tree label_list; 01166 cb_tree reference_list; 01167 cb_tree alphabet_name_list; 01168 cb_tree class_name_list; 01169 cb_tree parameter_list; 01170 cb_tree locale_list; 01171 cb_tree symbolic_list; 01172 cb_tree global_list; 01173 cb_tree cb_return_code; 01174 cb_tree cb_sort_return; 01175 cb_tree cb_call_params; 01176 cb_tree class_spec_list; 01177 cb_tree interface_spec_list; 01178 cb_tree function_spec_list; 01179 cb_tree program_spec_list; 01180 cb_tree property_spec_list; 01181 struct cb_field *working_storage; 01182 struct cb_field *local_storage; 01183 struct cb_field *linkage_storage; 01184 struct cb_field *screen_storage; 01185 cb_tree local_file_list; 01186 cb_tree global_file_list; 01187 struct handler_struct global_handler[5]; 01188 cb_tree collating_sequence; 01189 cb_tree cursor_pos; 01190 cb_tree crt_status; 01191 cb_tree returning; /* RETURNING */ 01192 struct cb_word *word_table[CB_WORD_HASH_SIZE]; 01193 /* internal variables */ 01194 int loop_counter; 01195 int decimal_index; 01196 int decimal_index_max; 01197 unsigned char decimal_point; /* '.' or ',' */ 01198 unsigned char currency_symbol; /* '$' or user-specified */ 01199 unsigned char numeric_separator; /* ',' or '.' */ 01200 unsigned char nested_level; /* Nested program level */ 01201 unsigned char flag_main; /* Gen main function */ 01202 unsigned char flag_common; /* COMMON PROGRAM */ 01203 unsigned char flag_initial; /* INITIAL PROGRAM */ 01204 unsigned char flag_recursive; /* RECURSIVE PROGRAM */ 01205 unsigned char flag_screen; /* have SCREEN SECTION */ 01206 unsigned char flag_validated; /* End program validate */ 01207 unsigned char flag_chained; /* PROCEDURE CHAINING */ 01208 unsigned char flag_global_use; /* USE GLOBAL */ 01209 unsigned char gen_decset; /* Gen decimal_set_int */ 01210 unsigned char gen_udecset; /* Gen decimal_set_uint */ 01211 unsigned char gen_ptrmanip; /* Gen cob_pointer_manip */ 01212 unsigned char gen_file_error; /* Gen error routine */ 01213 unsigned char prog_type; /* Program type */ 01214 unsigned char spare[3]; /* Spare */ 01215 }; 01216 01217 extern struct cb_program *cb_build_program (struct cb_program *last_program, 01218 int nest_level); 01219 01220 /* parser.y */ 01221 extern int non_const_word; 01222 01223 /* reserved.c */ 01224 extern cb_tree lookup_system_name (const char *name); 01225 extern int lookup_reserved_word (const char *name); 01226 extern void cb_list_reserved (void); 01227 extern void cb_list_intrinsics (void); 01228 extern void cb_list_mnemonics (void); 01229 extern void cb_init_reserved (void); 01230 extern void cb_list_map (cb_tree (*func) (cb_tree x), cb_tree l); 01231 01232 /* error.c */ 01233 #ifdef __GNUC__ 01234 extern void cb_warning_x (cb_tree x, const char *fmt, ...) 01235 __attribute__ ((__format__ (__printf__, 2, 3))); 01236 extern void cb_error_x (cb_tree x, const char *fmt, ...) 01237 __attribute__ ((__format__ (__printf__, 2, 3))); 01238 #else 01239 extern void cb_warning_x (cb_tree x, const char *fmt, ...); 01240 extern void cb_error_x (cb_tree x, const char *fmt, ...); 01241 #endif 01242 01243 extern char *check_filler_name (char *name); 01244 extern void redefinition_error (cb_tree x); 01245 extern void redefinition_warning (cb_tree x, cb_tree y); 01246 extern void undefined_error (cb_tree x); 01247 extern void ambiguous_error (cb_tree x); 01248 extern void group_error (cb_tree x, const char *clause); 01249 extern void level_redundant_error (cb_tree x, const char *clause); 01250 extern void level_require_error (cb_tree x, const char *clause); 01251 extern void level_except_error (cb_tree x, const char *clause); 01252 01253 struct cb_literal *build_literal (enum cb_category category, 01254 const unsigned char *data, size_t size); 01255 01256 /* field.c */ 01257 extern size_t cb_needs_01; 01258 extern int cb_get_level (cb_tree x); 01259 extern cb_tree cb_build_field_tree (cb_tree level, cb_tree name, 01260 struct cb_field *last_field, 01261 enum cb_storage storage, struct cb_file *fn); 01262 extern struct cb_field *cb_resolve_redefines (struct cb_field *field, 01263 cb_tree redefines); 01264 extern void cb_validate_field (struct cb_field *p); 01265 extern void cb_validate_88_item (struct cb_field *p); 01266 extern struct cb_field *cb_validate_78_item (struct cb_field *p); 01267 extern void cb_clear_real_field (void); 01268 01269 /* typeck.c */ 01270 extern cb_tree cb_check_numeric_value (cb_tree x); 01271 01272 extern void cb_build_registers (void); 01273 extern char *cb_encode_program_id (const char *name); 01274 extern const char *cb_build_program_id (cb_tree name, cb_tree alt_name); 01275 extern void cb_define_switch_name (cb_tree name, cb_tree sname, 01276 cb_tree flag, cb_tree ref); 01277 extern cb_tree cb_build_section_name (cb_tree name, int sect_or_para); 01278 extern cb_tree cb_build_assignment_name (struct cb_file *curfile, 01279 cb_tree name); 01280 extern cb_tree cb_build_index (cb_tree name, cb_tree values, 01281 int indexed_by, struct cb_field *qual); 01282 extern cb_tree cb_build_identifier (cb_tree x); 01283 extern cb_tree cb_build_length (cb_tree x); 01284 extern cb_tree cb_build_const_length (cb_tree x); 01285 extern cb_tree cb_build_address (cb_tree x); 01286 extern cb_tree cb_build_ppointer (cb_tree x); 01287 01288 extern void cb_validate_program_environment (struct cb_program *prog); 01289 extern void cb_validate_program_data (struct cb_program *prog); 01290 extern void cb_validate_program_body (struct cb_program *prog); 01291 01292 extern cb_tree cb_build_expr (cb_tree list); 01293 extern cb_tree cb_build_cond (cb_tree x); 01294 01295 extern void cb_emit_arithmetic (cb_tree vars, int op, cb_tree val); 01296 extern cb_tree cb_build_add (cb_tree v, cb_tree n, cb_tree round_opt); 01297 extern cb_tree cb_build_sub (cb_tree v, cb_tree n, cb_tree round_opt); 01298 extern void cb_emit_corresponding ( 01299 cb_tree (*func) (cb_tree f1, cb_tree f2, cb_tree f3), 01300 cb_tree x1, cb_tree x2, cb_tree opt); 01301 extern void cb_emit_move_corresponding (cb_tree x1, cb_tree x2); 01302 01303 extern void cb_emit_accept (cb_tree var, cb_tree pos, cb_tree fgc, 01304 cb_tree bgc, cb_tree scroll, int dispattrs); 01305 extern void cb_emit_accept_line_or_col (cb_tree var, const int l_or_c); 01306 extern void cb_emit_accept_date (cb_tree var); 01307 extern void cb_emit_accept_date_yyyymmdd (cb_tree var); 01308 extern void cb_emit_accept_day (cb_tree var); 01309 extern void cb_emit_accept_day_yyyyddd (cb_tree var); 01310 extern void cb_emit_accept_day_of_week (cb_tree var); 01311 extern void cb_emit_accept_time (cb_tree var); 01312 extern void cb_emit_accept_command_line (cb_tree var); 01313 extern void cb_emit_get_environment (cb_tree envvar, cb_tree envval); 01314 extern void cb_emit_accept_environment (cb_tree var); 01315 extern void cb_emit_accept_mnemonic (cb_tree var, cb_tree mnemonic); 01316 extern void cb_emit_accept_name (cb_tree var, cb_tree name); 01317 extern void cb_emit_accept_arg_number (cb_tree var); 01318 extern void cb_emit_accept_arg_value (cb_tree var); 01319 01320 extern void cb_emit_allocate (cb_tree target1, cb_tree target2, 01321 cb_tree size, cb_tree initialize); 01322 extern void cb_emit_free (cb_tree vars); 01323 01324 extern void cb_emit_call (cb_tree prog, cb_tree using, cb_tree returning, 01325 cb_tree on_exception, cb_tree not_on_exception); 01326 01327 extern void cb_emit_cancel (cb_tree prog); 01328 01329 extern void cb_emit_close (cb_tree file, cb_tree opt); 01330 01331 extern void cb_emit_commit (void); 01332 01333 extern void cb_emit_continue (void); 01334 01335 extern void cb_emit_delete (cb_tree file); 01336 01337 extern void cb_emit_display (cb_tree values, cb_tree upon, 01338 cb_tree no_adv, cb_tree pos, 01339 cb_tree fgc, cb_tree bgc, 01340 cb_tree scroll, int dispattrs); 01341 extern cb_tree cb_build_display_upon (cb_tree x); 01342 extern cb_tree cb_build_display_upon_direct (cb_tree x); 01343 extern void cb_emit_env_name (cb_tree value); 01344 extern void cb_emit_env_value (cb_tree value); 01345 extern void cb_emit_arg_number (cb_tree value); 01346 extern void cb_emit_command_line (cb_tree value); 01347 01348 extern void cb_emit_divide (cb_tree dividend, cb_tree divisor, 01349 cb_tree quotient, cb_tree remainder); 01350 01351 extern void cb_emit_evaluate (cb_tree subject_list, cb_tree case_list); 01352 01353 extern void cb_emit_goto (cb_tree target, cb_tree depending); 01354 extern void cb_emit_exit (size_t goback); 01355 01356 extern void cb_emit_if (cb_tree cond, cb_tree stmt1, cb_tree stmt2); 01357 01358 extern void cb_emit_initialize (cb_tree vars, cb_tree fillinit, 01359 cb_tree value, cb_tree replacing, cb_tree def); 01360 01361 extern void cb_emit_inspect (cb_tree var, cb_tree body, 01362 cb_tree replacing, int replconv); 01363 extern void cb_init_tarrying (void); 01364 extern cb_tree cb_build_tarrying_data (cb_tree x); 01365 extern cb_tree cb_build_tarrying_characters (cb_tree l); 01366 extern cb_tree cb_build_tarrying_all (void); 01367 extern cb_tree cb_build_tarrying_leading (void); 01368 extern cb_tree cb_build_tarrying_trailing (void); 01369 extern cb_tree cb_build_tarrying_value (cb_tree x, cb_tree l); 01370 extern cb_tree cb_build_replacing_characters (cb_tree x, cb_tree l); 01371 extern cb_tree cb_build_replacing_all (cb_tree x, cb_tree y, cb_tree l); 01372 extern cb_tree cb_build_replacing_leading (cb_tree x, cb_tree y, cb_tree l); 01373 extern cb_tree cb_build_replacing_first (cb_tree x, cb_tree y, cb_tree l); 01374 extern cb_tree cb_build_replacing_trailing (cb_tree x, cb_tree y, cb_tree l); 01375 extern cb_tree cb_build_converting (cb_tree x, cb_tree y, cb_tree l); 01376 extern cb_tree cb_build_inspect_region_start (void); 01377 extern cb_tree cb_build_inspect_region (cb_tree l, cb_tree pos, cb_tree x); 01378 01379 extern int validate_move (cb_tree src, cb_tree dst, size_t is_value); 01380 extern cb_tree cb_build_move (cb_tree src, cb_tree dst); 01381 extern void cb_emit_move (cb_tree src, cb_tree dsts); 01382 01383 extern void cb_emit_open (cb_tree file, cb_tree mode, cb_tree sharing); 01384 01385 extern void cb_emit_perform (cb_tree perform, cb_tree body); 01386 extern cb_tree cb_build_perform_once (cb_tree body); 01387 extern cb_tree cb_build_perform_times (cb_tree count); 01388 extern cb_tree cb_build_perform_until (cb_tree condition, cb_tree varying); 01389 extern cb_tree cb_build_perform_forever (cb_tree body); 01390 extern cb_tree cb_build_perform_exit (struct cb_label *label); 01391 01392 extern void cb_emit_read (cb_tree ref, cb_tree next, cb_tree into, 01393 cb_tree key, cb_tree lock_opts); 01394 01395 extern void cb_emit_rewrite (cb_tree record, cb_tree from, 01396 cb_tree lockopt); 01397 01398 extern void cb_emit_release (cb_tree ref, cb_tree from); 01399 extern void cb_emit_return (cb_tree ref, cb_tree into); 01400 01401 extern void cb_emit_rollback (void); 01402 01403 extern void cb_emit_search (cb_tree table, cb_tree varying, 01404 cb_tree at_end, cb_tree whens); 01405 extern void cb_emit_search_all (cb_tree table, cb_tree at_end, 01406 cb_tree when, cb_tree stmts); 01407 01408 extern void cb_emit_setenv (cb_tree x, cb_tree y); 01409 extern void cb_emit_set_to (cb_tree l, cb_tree x); 01410 extern void cb_emit_set_up_down (cb_tree l, cb_tree flag, cb_tree x); 01411 extern void cb_emit_set_on_off (cb_tree l, cb_tree flag); 01412 extern void cb_emit_set_true (cb_tree l); 01413 extern void cb_emit_set_false (cb_tree l); 01414 01415 extern void cb_emit_sort_init (cb_tree name, cb_tree keys, cb_tree col); 01416 extern void cb_emit_sort_using (cb_tree file, cb_tree l); 01417 extern void cb_emit_sort_input (cb_tree proc); 01418 extern void cb_emit_sort_giving (cb_tree file, cb_tree l); 01419 extern void cb_emit_sort_output (cb_tree proc); 01420 extern void cb_emit_sort_finish (cb_tree file); 01421 01422 extern void cb_emit_start (cb_tree file, cb_tree op, cb_tree key); 01423 01424 extern void cb_emit_stop_run (cb_tree x); 01425 01426 extern void cb_emit_string (cb_tree items, cb_tree into, cb_tree pointer); 01427 01428 extern void cb_emit_unlock (cb_tree ref); 01429 01430 extern void cb_emit_unstring (cb_tree name, cb_tree delimited, 01431 cb_tree into, cb_tree pointer, cb_tree tallying); 01432 extern cb_tree cb_build_unstring_delimited (cb_tree all, cb_tree value); 01433 extern cb_tree cb_build_unstring_into (cb_tree name, cb_tree delimiter, 01434 cb_tree count); 01435 01436 extern void cb_emit_write (cb_tree record, cb_tree from, cb_tree opt, 01437 cb_tree lockopt); 01438 extern cb_tree cb_build_write_advancing_lines (cb_tree pos, cb_tree lines); 01439 extern cb_tree cb_build_write_advancing_mnemonic (cb_tree pos, 01440 cb_tree mnemonic); 01441 extern cb_tree cb_build_write_advancing_page (cb_tree pos); 01442 01443 extern void cobc_tree_cast_error (cb_tree x, const char *filen, 01444 const int linenum, const int tagnum); 01445 01446 01447 /* codegen.c */ 01448 extern void codegen (struct cb_program *prog, int nested); 01449 01450 /* scanner.l */ 01451 extern void cb_set_in_procedure (void); 01452 extern void cb_reset_in_procedure (void); 01453 extern void cb_add_78 (struct cb_field *f); 01454 extern void cb_reset_78 (void); 01455 extern struct cb_field *check_level_78 (const char *name); 01456 01457 #endif /* CB_TREE_H */