1
2
3
4
5
6
7
8
9
10
11
12
13
14 pascal: pas: proc;
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31 dcl com_err_ entry options (variable);
32 dcl com_err_$suppress_name entry options (variable);
33 dcl cu_$arg_count entry (fixed bin);
34 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (17), fixed bin (35));
35 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
36 dcl expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35));
37 dcl release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35));
38 dcl get_group_id_ entry returns (char (32));
39 dcl get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35));
40 dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35));
41 dcl release_temp_segment_ entry (char (*), ptr, fixed bin (35));
42 dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35));
43 dcl ioa_ entry options (variable);
44 dcl ioa_$ioa_switch entry options (variable);
45 dcl iox_$open entry (ptr, fixed bin, bit (1), fixed bin (35));
46 dcl iox_$position entry (ptr, fixed bin, fixed bin (21), fixed bin (35),);
47 dcl iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
48 dcl iox_$attach_name entry (char (*), ptr, char (*), ptr, fixed bin (35));
49 dcl iox_$look_iocb entry (char (*), ptr, fixed bin (35));
50 dcl iox_$destroy_iocb entry (ptr, fixed bin (35));
51 dcl hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35));
52 dcl hcs_$status_mins entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35));
53 dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
54 dcl object_info_$display entry (ptr, fixed bin (24), ptr, fixed bin (35));
55 dcl get_wdir_ entry returns (char (168));
56 dcl iox_$find_iocb entry (char (*), ptr, fixed bin (35));
57 dcl iox_$close entry (ptr, fixed bin (35));
58 dcl iox_$detach_iocb entry (ptr, fixed bin (35));
59 dcl iox_$error_output ext ptr;
60 dcl clock_ entry returns (fixed bin (71));
61 dcl virtual_cpu_time_ entry returns (fixed bin (71));
62 dcl error_table_$badopt fixed bin (35) ext;
63 dcl error_table_$end_of_info fixed bin (35) ext;
64 dcl error_table_$long_record fixed bin (35) ext;
65 dcl error_table_$segknown fixed bin (35) ext;
66 dcl error_table_$short_record fixed bin (35) ext;
67 dcl system_info_$installation_id entry (char (*));
68 dcl adjust_bit_count_ entry (char (168), char (32), bit (1), fixed bin (35), fixed bin (35));
69 dcl date_time_ entry (fixed bin (71), char (*));
70 dcl tssi_$clean_up_segment entry (ptr);
71 dcl user_info_$process_type entry (fixed bin (17));
72 dcl tssi_$get_file entry (char (*), char (*), ptr, ptr, ptr, fixed bin (35));
73 dcl tssi_$finish_file entry (ptr, fixed bin, fixed bin (24), bit (36), ptr, fixed bin (35));
74 dcl tssi_$clean_up_file entry (ptr, ptr);
75 dcl msf_manager_$get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35));
76 dcl convert_status_code_ entry (fixed bin (35), char (8), char (100));
77
78
79
80 dcl RACINE_defs$mpcogin ptr ext;
81 dcl RACINE_defs$firstcond ptr ext;
82 dcl RACINE_defs$ch8flag fixed bin (35) ext;
83 dcl RACINE_defs$no_compilation_warnings fixed bin (35) ext;
84 dcl pascal_error_table_$bad_syn_chain fixed bin (35) ext;
85 dcl pascal_gen_rel_$def entry (bit (5), fixed bin);
86 dcl pascal_gen_rel_$link entry (bit (5), fixed bin);
87 dcl pascal_gen_rel_$ps_def entry (bit (5), fixed bin);
88 dcl pascal_sources_management_$clean entry;
89 dcl racine entry (char (*), fixed bin (35));
90 dcl (pascal_create_area, pascal_reset_area) entry options (variable);
91
92
93
94 dcl pascal_severity_ fixed bin (35) ext static;
95
96
97
98 dcl absolute_compiler_path char (168) int static;
99 dcl absolute_source_path char (168) varying int static;
100 dcl pascal_is_busy fixed bin int static init (0);
101 dcl pascal_error_label label int static;
102 dcl in_ptr int static ptr;
103 dcl err_ptr int static ptr;
104 dcl first_invocation bit (1) init ("1"b) int static;
105 dcl 1 oi like object_info int static;
106 dcl installation_id char (32) int static;
107 dcl process_type fixed bin (17) int static;
108
109
110
111 dcl compiler_input char (7) int static options (constant) init ("mpcogin");
112 dcl compiler_output char (8) int static options (constant) init ("mpcogout");
113 dcl compiler_error char (8) int static options (constant) init ("mpcogerr");
114
115
116
117 dcl my_firstcond ptr;
118 dcl condname char (32) varying;
119 dcl box_ptr ptr;
120 dcl ldn fixed bin;
121 dcl error_switch bit (1);
122 dcl n_read fixed bin (21);
123 dcl PARM char (100);
124 dcl arg_count fixed bin;
125 dcl bad_arg_switch fixed bin;
126 dcl i fixed bin;
127 dcl COND fixed bin (35);
128 dcl ps_var_string char (168) varying;
129 dcl ps_entry_name char (32);
130 dcl ps_aclinfo_ptr ptr;
131 dcl absolute_list_path char (168) varying;
132 dcl code fixed bin (35);
133 dcl arg_len fixed bin (17);
134 dcl arg_ptr ptr;
135 dcl parm_string char (100) varying;
136 dcl list_ptr ptr;
137 dcl list_entry_name char (32);
138 dcl dir_name char (168);
139 dcl entryname char (32);
140 dcl entry_type fixed bin (2);
141 dcl temp_list_dir char (168);
142 dcl temp_list_entry char (32);
143 dcl temp_list_path char (168) varying;
144 dcl atd_ptr ptr;
145 dcl page_length fixed bin (35);
146 dcl link_length fixed bin (35);
147 dcl source_ptr ptr;
148 dcl word_count fixed bin (35);
149 dcl def_ptr ptr;
150 dcl bit_count fixed bin (35);
151 dcl bc fixed bin (24);
152 dcl label_variable label;
153 dcl my_base ptr;
154 dcl var_string char (168) varying;
155 dcl list_aclinfo_ptr ptr;
156 dcl object_aclinfo_ptr ptr;
157 dcl command_line char (256);
158 dcl list_ok fixed bin;
159 dcl error_message char (256) varying;
160 dcl status_message char (100);
161 dcl short_info char (8);
162 dcl list_fcb_ptr ptr;
163 dcl 1 list_status_branch like status_branch;
164 dcl last_component_ptr ptr;
165 dcl last_component_nbr fixed bin;
166 dcl trap_pair_offset bit (18);
167
168 dcl 1 command_switches,
169 2 listing_switches,
170 3 bfm_sw bit (1) unal,
171 3 list_sw bit (1) unal,
172 3 map_sw bit (1) unal,
173 2 table_switches,
174 3 bftb_sw bit (1) unal,
175 3 tb_sw bit (1) unal,
176 2 language_switches,
177 3 full_sw bit (1) unal,
178 3 iso_sw bit (1) unal,
179 3 sol_sw bit (1) unal,
180 2 profile_switches,
181 3 pf_sw bit (1) unal,
182 3 lpf_sw bit (1) unal,
183 2 aen_sw bit (1) unal,
184 2 db_sw bit (1) unal,
185 2 french_sw bit (1) unal,
186 2 em_sw bit (1) unal,
187 2 int_sw bit (1) unal,
188 2 iow_sw bit (1) unal,
189 2 ps_sw bit (1) unal,
190 2 rlc_sw bit (1) unal;
191
192
193
194 dcl 1 attach_description based,
195 2 length fixed bin (17),
196 2 string char (0 refer (attach_description.length));
197
198 dcl 1 label based,
199 2 target ptr,
200 2 stack ptr;
201
202 dcl arg char (arg_len) based (arg_ptr);
203
204 dcl 1 a based (arg_ptr),
205 2 first char (2) unal,
206 2 l7 char (7) unal;
207
208 dcl 1 def_header based (def_ptr),
209 2 def_list_relp bit (18) unal,
210 2 unused bit (18) unal,
211 2 hash_table_relp bit (18) unal,
212 2 flags unal,
213 3 new_format bit (1) unal,
214 3 ignore bit (1) unal,
215 3 unused bit (16) unal,
216 2 all_zero_word bit (36),
217 2 seg_name,
218 3 num_chars fixed bin (9) unsigned unal,
219 3 string char (0 refer (def_header.seg_name.num_chars)) unal,
220 2 def_seg aligned like definition;
221
222 dcl 1 symb based (def_ptr),
223 2 symb_name,
224 3 num_chars fixed bin (9) unsigned unal,
225 3 string char (12),
226 2 def_symb aligned like definition;
227
228 dcl 1 val based,
229 2 high bit (18) unal,
230 2 low bit (18) unal;
231
232 dcl 1 condbox based (box_ptr),
233 2 name char (32),
234 2 nextcond ptr,
235 2 (active, activated, setinargs) fixed bin (35);
236
237
238
239 dcl null builtin;
240 dcl addrel builtin;
241 dcl rel builtin;
242 dcl ptr builtin;
243 dcl addr builtin;
244 dcl length builtin;
245 dcl substr builtin;
246 dcl rtrim builtin;
247
248
249
250 dcl (cleanup, pascal_error) condition;
251 %page;
252
253
254 pascal_severity_ = 0;
255
256 if pascal_is_busy = 1 then do;
257 call com_err_ (0, "pascal", "The Pascal compiler has been previously invoked and suspended.
258 It cannot be invoked recursively. Use ""release"" first.");
259 pascal_severity_ = 4;
260 return;
261 end;
262
263 if first_invocation = "1"b then do;
264 call system_info_$installation_id (installation_id);
265 pascal_context_$user_id = get_group_id_ ();
266 call user_info_$process_type (process_type);
267 here:
268 label_variable = here;
269 my_base = ptr (addr (label_variable) -> label.target, 0);
270 call hcs_$fs_get_path_name (my_base, dir_name, i, entryname, code);
271 if code ^= 0 then do;
272 first_error:
273 call com_err_ (code, "pascal", "");
274 pascal_severity_ = 5;
275 return;
276 end;
277 absolute_compiler_path = rtrim (dir_name) || ">" || rtrim (entryname);
278 call pascal_create_area (absolute_compiler_path, "-bf", "-size", "500");
279 call hcs_$status_mins (my_base, entry_type, bc, code);
280 if code ^= 0 then go to first_error;
281 oi.version_number = object_info_version_2;
282 call object_info_$display (my_base, bc, addr (oi), code);
283 if code ^= 0 then go to first_error;
284 pascal_context_$compiler_created = oi.compile_time;
285 pascal_context_$realformataddr = addr (pascal_context_$realformatstring);
286 pascal_context_$integerformataddr = addr (pascal_context_$integerformatstring);
287 pascal_context_$asciiformataddr = addr (pascal_context_$asciiformatstring);
288 pascal_context_$octalformataddr = addr (pascal_context_$octalformatstring);
289 pascal_context_$nilformataddr = addr (pascal_context_$nilformatstring);
290 first_invocation = "0"b;
291 end;
292
293 call set_for_cleanup;
294 on cleanup call cleanup_compiler;
295
296 RACINE_defs$firstcond = null;
297 RACINE_defs$ch8flag = 0;
298 RACINE_defs$no_compilation_warnings = 0;
299
300 pascal_context_$time = clock_ ();
301 pascal_context_$cpu = virtual_cpu_time_ ();
302
303
304
305 pascal_context_$options.ps = "0"b;
306 pascal_context_$options.bind = "1"b;
307 error_switch = "1"b;
308 pascal_context_$option_list, parm_string = "";
309 pascal_context_$options.profile,
310 pascal_context_$options.list,
311 pascal_context_$options.table,
312 pascal_context_$options.brief_table,
313 pascal_context_$options.ref_table,
314 pascal_context_$options.map,
315 pascal_context_$options.brief_map,
316 pascal_context_$options.generated_code,
317 pascal_context_$options.add_exportable_names,
318 pascal_context_$options.long_profile = "0"b;
319 bad_arg_switch = 0;
320
321 command_switches = "0"b;
322 tb_sw, int_sw,
323 em_sw, db_sw, full_sw, iow_sw, rlc_sw = "1"b;
324
325 call cu_$arg_count (arg_count);
326
327 if arg_count = 0 then do;
328 call com_err_$suppress_name (0, "pascal", "Usage: pascal path {-control_args}");
329 pascal_severity_ = 5;
330 go to comp_aborted_;
331 end;
332
333 if arg_count > 1 then do;
334 do i = 2 to arg_count;
335 call cu_$arg_ptr (i, arg_ptr, arg_len, code);
336 if code ^= 0 then go to standard_error_;
337 if (arg = "-add_exportable_names") | (arg = "-aen") then do;
338 aen_sw = "1"b;
339 pascal_context_$option_list = pascal_context_$option_list || "add_exportable_names ";
340 end;
341 else if (arg = "-brief_map") | (arg = "-bfm") then do;
342 listing_switches = "0"b;
343 bfm_sw = "1"b;
344 pascal_context_$option_list = pascal_context_$option_list || "brief_map ";
345 end;
346 else if (arg = "-brief_table") | (arg = "-bftb") then do;
347 table_switches = "0"b;
348 bftb_sw = "1"b;
349 pascal_context_$option_list = pascal_context_$option_list || "table ";
350 end;
351 else if (arg = "-ecc")
352 | (arg = "-extended_character_code") then do;
353 RACINE_defs$ch8flag = 1;
354 pascal_context_$option_list = pascal_context_$option_list ||
355 "extended_character_code";
356 end;
357 else if (arg = "-necc")
358 | (arg = "-no_extended_character_code") then do;
359 RACINE_defs$ch8flag = 0;
360 pascal_context_$option_list = pascal_context_$option_list ||
361 "no_extended_character_code";
362 end;
363 else if (arg = "-ncw")
364 | (arg = "-no_compilation_warnings") then do;
365 RACINE_defs$no_compilation_warnings = 1;
366 pascal_context_$option_list = pascal_context_$option_list ||
367 "no_compilation_warnings";
368 end;
369 else if (arg = "-cw")
370 | (arg = "-compilation_warnings") then do;
371 RACINE_defs$no_compilation_warnings = 0;
372 pascal_context_$option_list = pascal_context_$option_list ||
373 "compilation_warnings";
374 end;
375 else if (arg = "-debug") | (arg = "-db") then do;
376 db_sw = "1"b;
377 pascal_context_$option_list = pascal_context_$option_list || "debug ";
378 end;
379 else if (arg = "-english") then do;
380 french_sw = "0"b;
381 pascal_context_$option_list = pascal_context_$option_list || "english ";
382 end;
383 else if (arg = "-error_messages") | (arg = "-em") then do;
384 em_sw = "1"b;
385 pascal_context_$option_list = pascal_context_$option_list || "error_messages ";
386 end;
387 else if (arg = "-french") then do;
388 french_sw = "1"b;
389 pascal_context_$option_list = pascal_context_$option_list || "french ";
390 end;
391 else if (arg = "-full_extensions") | (arg = "-full") then do;
392 language_switches = "0"b;
393 full_sw = "1"b;
394 pascal_context_$option_list = pascal_context_$option_list || "full_extensions ";
395 end;
396 else if (arg = "-interactive") | (arg = "-int") then do;
397 int_sw = "1"b;
398 pascal_context_$option_list = pascal_context_$option_list || "interactive ";
399 end;
400 else if (arg = "-io_warnings") | (arg = "-iow") then do;
401 iow_sw = "1"b;
402 pascal_context_$option_list = pascal_context_$option_list || "io_warnings ";
403 end;
404 else if (arg = "-list") then do;
405 listing_switches = "0"b;
406 list_sw = "1"b;
407 pascal_context_$option_list = pascal_context_$option_list || "list ";
408 end;
409 else if (arg = "-long_profile") | (arg = "-lpf") then do;
410 profile_switches = "0"b;
411 lpf_sw = "1"b;
412 pascal_context_$option_list = pascal_context_$option_list || "long_profile ";
413 end;
414 else if (arg = "-map") then do;
415 listing_switches = "0"b;
416 map_sw = "1"b;
417 pascal_context_$option_list = pascal_context_$option_list || "map ";
418 end;
419 else if (arg = "-no_debug") | (arg = "-ndb") then do;
420 db_sw = "0"b;
421 pascal_context_$option_list = pascal_context_$option_list || "no_debug ";
422 end;
423 else if (arg = "-no_error_messages") | (arg = "-nem") then do;
424 em_sw = "0"b;
425 pascal_context_$option_list = pascal_context_$option_list || "no_error_messages ";
426 end;
427 else if arg = ("-no_interactive") | (arg = "-nint") then do;
428 int_sw = "0"b;
429 pascal_context_$option_list = pascal_context_$option_list || "no_interactive ";
430 end;
431 else if (arg = "-no_io_warnings") | (arg = "-niow") then do;
432 iow_sw = "0"b;
433 pascal_context_$option_list = pascal_context_$option_list || "no_io_warnings ";
434 end;
435 else if (arg = "-no_list") then do;
436 listing_switches = "0"b;
437 pascal_context_$option_list = pascal_context_$option_list || "no_list ";
438 end;
439 else if (arg = "-no_long_profile") | (arg = "-nlpf") then do;
440 lpf_sw = "0"b;
441 pascal_context_$option_list = pascal_context_$option_list || "no_long_profile ";
442 end;
443 else if (arg = "-no_private_storage") | (arg = "-nps") then do;
444 ps_sw = "0"b;
445 pascal_context_$option_list = pascal_context_$option_list || "no_private_storage ";
446 end;
447 else if (arg = "-no_profile") | (arg = "-npf") then do;
448 pf_sw = "0"b;
449 pascal_context_$option_list = pascal_context_$option_list || "no_profile ";
450 end;
451 else if (arg = "-no_relocatable") | (arg = "-nrlc") |
452 (arg = "-nonrelocatable") | (arg = "-non_relocatable") then do;
453 rlc_sw = "0"b;
454 pascal_context_$option_list = pascal_context_$option_list || "no_relocatable ";
455 end;
456 else if (arg = "-no_table") | (arg = "-ntb") then do;
457 tb_sw = "0"b;
458 pascal_context_$option_list = pascal_context_$option_list || "no_table ";
459 end;
460 else if (arg = "-page_length") | (arg = "-pl") then do;
461 if arg_count = i then do;
462 call com_err_ (0, "pascal",
463 "No value specified for -page_length");
464 bad_arg_switch = 1;
465 end;
466 else do;
467 i = i + 1;
468 call cu_$arg_ptr (i, arg_ptr, arg_len, code);
469 if code ^= 0 then go to standard_error;
470 page_length = cv_dec_check_ (arg, code);
471 if code ^= 0 then do;
472 call com_err_ (0, "pascal",
473 "Invalid integer -page_length value ^a", arg);
474 bad_arg_switch = 1;
475 end;
476 else do;
477 if (page_length < 10) | (page_length > 99) then do;
478 call com_err_ (0, "pascal",
479 "Value of -page_length must be between 10 and 99");
480 bad_arg_switch = 1;
481 end;
482 else do;
483 parm_string = parm_string || "LP" || arg || " ";
484 pascal_context_$option_list =
485 pascal_context_$option_list || "lp " || arg || " ";
486 end;
487 end;
488 end;
489 end;
490 else if (arg = "-private_storage") | (arg = "-ps") then do;
491 ps_sw = "1"b;
492 pascal_context_$option_list = pascal_context_$option_list || "private_storage ";
493 end;
494 else if (arg = "-profile") | (arg = "-pf") then do;
495 profile_switches = "0"b;
496 pf_sw = "1"b;
497 pascal_context_$option_list = pascal_context_$option_list || "profile ";
498 end;
499 else if (arg = "-relocatable") | (arg = "-rlc") then do;
500 rlc_sw = "1"b;
501 pascal_context_$option_list = pascal_context_$option_list || "relocatable ";
502 end;
503 else if (arg = "sol_extensions") | (arg = "-sol") then do;
504 language_switches = "0"b;
505 sol_sw = "1"b;
506 pascal_context_$option_list = pascal_context_$option_list || "sol_extensions ";
507 end;
508 else if (arg = "-standard") then do;
509 language_switches = "0"b;
510 iso_sw = "1"b;
511 pascal_context_$option_list = pascal_context_$option_list || "standard ";
512 end;
513 else if (arg = "-table") | (arg = "-tb") then do;
514 table_switches = "0"b;
515 tb_sw = "1"b;
516 pascal_context_$option_list = pascal_context_$option_list || "table ";
517 end;
518 else if (arg = "-reference_table") | (arg = "-rftb") then do;
519 table_switches = "0"b;
520 tb_sw = "1"b;
521 pascal_context_$options.ref_table = "1"b;
522 pascal_context_$option_list = pascal_context_$option_list || "reference_table ";
523 end;
524 else
525 if (arg = "-conditional_execution") | (arg = "-cond") then do;
526 if (i + 2) > arg_count then do;
527 cond_syntax_error:
528 call com_err_ (0, "pascal", "Bad syntax in ""-cond"" value.");
529 bad_arg_switch = 1;
530 go to cond_err;
531 end;
532 call cu_$arg_ptr (i + 1, arg_ptr, arg_len, code);
533 if code ^= 0 then go to standard_error;
534 condname = translate (arg, "abcdefghijklmnopqrstuvwxyz", "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
535 allocate condbox;
536 condbox.nextcond = RACINE_defs$firstcond;
537 RACINE_defs$firstcond, my_firstcond = box_ptr;
538 condbox.name = condname;
539 condbox.setinargs = 1;
540 condbox.activated = 0;
541 call cu_$arg_ptr (i + 2, arg_ptr, arg_len, code);
542 if code ^= 0 then go to standard_error;
543 if arg = "true" | arg = "on" then condbox.active = 1;
544 else if arg = "false" | arg = "off" then condbox.active = 0;
545 else go to cond_syntax_error;
546 pascal_context_$option_list = pascal_context_$option_list ||
547 "conditional_execution " || condname || " " || arg || " ";
548 cond_err:
549 i = i + 2;
550 end;
551 else
552 if (arg = "-fast_mode") | (arg = "-fast") then do;
553 parm_string = parm_string || "FAST ";
554 pascal_context_$option_list = pascal_context_$option_list || "fast_mode ";
555 end;
556 else
557 if (arg_len = 9) & ((a.l7 = "TRACE=0") |
558 (a.l7 = "TRACE=1") | (a.l7 = "TRACE=2") | (a.l7 = "TRACE=3"))
559 & ((a.first = "-S") | (a.first = "-G") | (a.first = "-D")) then do;
560 parm_string = parm_string || arg || " ";
561 pascal_context_$option_list = pascal_context_$option_list || arg || " ";
562 end;
563 else do;
564 bad_arg_switch = 1;
565 call com_err_ (error_table_$badopt, "pascal", "^a", arg);
566 end;
567 end;
568 end;
569
570
571 if list_sw then do;
572 parm_string = parm_string || "LIST PRCODE ";
573 pascal_context_$options.generated_code = "1"b; pascal_context_$options.list = "1"b;
574 end;
575 else if map_sw then do;
576 parm_string = parm_string || "LIST ";
577 pascal_context_$options.list = "1"b; pascal_context_$options.map = "1"b;
578 end;
579 else if bfm_sw then do;
580 parm_string = parm_string || "BRIEFMAP ";
581 pascal_context_$options.list = "1"b; pascal_context_$options.brief_map = "1"b;
582 end;
583 if tb_sw then do;
584 parm_string = parm_string || "TABLE ";
585 pascal_context_$options.table = "1"b;
586 if pascal_context_$options.ref_table then
587 parm_string = parm_string || "REFS ";
588 else pascal_context_$options.ref_table = "0"b;
589 end;
590 else if bftb_sw then do;
591 parm_string = parm_string || "BRIEFTB ";
592 pascal_context_$options.brief_table = "1"b;
593 end;
594 if pf_sw then do;
595 parm_string = parm_string || "PROFILE ";
596 pascal_context_$options.profile = "1"b;
597 end;
598 else if lpf_sw then do;
599 parm_string = parm_string || "LONGPROF ";
600 pascal_context_$options.long_profile = "1"b;
601 end;
602 if full_sw then do;
603 parm_string = parm_string || "NOSTAND ";
604 end;
605 else if iso_sw then do;
606 end;
607 else if sol_sw then do;
608 parm_string = parm_string || "STDSOL ";
609 end;
610 if int_sw then do;
611 parm_string = parm_string || "INTER ";
612 pascal_context_$options.interactive = "1"b;
613 end;
614 if ps_sw then do;
615 pascal_context_$options.ps = "1"b;
616 end;
617 if french_sw then do;
618 parm_string = parm_string || "FRENC ";
619 end;
620 if ^iow_sw then do;
621 parm_string = parm_string || "NOIOW ";
622 end;
623 if ^db_sw then do;
624 parm_string = parm_string || "NOCHECKS ";
625 end;
626 if ^rlc_sw then do;
627 pascal_context_$options.bind = "0"b;
628 end;
629 if aen_sw then do;
630 pascal_context_$options.add_exportable_names = "1"b;
631 end;
632 if ^em_sw then do;
633 error_switch = "0"b;
634 end;
635
636
637
638 call cu_$arg_ptr (1, arg_ptr, arg_len, code);
639 if code ^= 0 then go to standard_error_;
640
641 call expand_pathname_$add_suffix (arg, "pascal",
642 pascal_context_$source_dir_name, pascal_context_$source_entry_name, code);
643 if code ^= 0 then do;
644 call com_err_ (code, "pascal", "^a", arg);
645 pascal_severity_ = 5;
646 go to comp_aborted_;
647 end;
648
649 var_string = rtrim (pascal_context_$source_entry_name);
650 absolute_source_path = rtrim (pascal_context_$source_dir_name) || ">" || var_string;
651
652 call hcs_$initiate (pascal_context_$source_dir_name, pascal_context_$source_entry_name, "",
653 0, 0, source_ptr, code);
654 if (code ^= 0) & (code ^= error_table_$segknown) then do;
655 call com_err_ (code, "pascal", "^a", absolute_source_path);
656 pascal_severity_ = 5;
657 go to comp_aborted_;
658 end;
659
660 if bad_arg_switch = 1 then do;
661 pascal_severity_ = 5;
662 go to comp_aborted_;
663 end;
664
665
666
667 list_ok, pascal_context_$object_ok, pascal_context_$ps_ok, link_length, COND = 0;
668 list_aclinfo_ptr, object_aclinfo_ptr, ps_aclinfo_ptr = null;
669
670 var_string = substr (var_string, 1, length (var_string) - length (".pascal"));
671 pascal_context_$object_entry_name = var_string;
672 if pascal_context_$options.ps = "1"b then do;
673 ps_var_string = var_string || ".defs";
674 ps_entry_name = ps_var_string;
675 end;
676
677 pascal_context_$working_dir_name = get_wdir_ ();
678
679 if pascal_context_$options.list = "1"b then do;
680 list_entry_name = rtrim (pascal_context_$object_entry_name) || ".list";
681 absolute_list_path = rtrim (pascal_context_$working_dir_name) || ">" || rtrim (list_entry_name);
682
683 call tssi_$get_file (pascal_context_$working_dir_name, list_entry_name, list_ptr,
684 list_aclinfo_ptr, list_fcb_ptr, code);
685 if code ^= 0 then do;
686 call com_err_ (code, "pascal", "Error while get ^a", absolute_list_path);
687 pascal_severity_ = 5;
688 go to comp_aborted;
689 end;
690 call hcs_$fs_get_path_name (list_ptr, temp_list_dir, ldn, temp_list_entry, code);
691 if code ^= 0 then go to standard_error;
692 temp_list_path = rtrim (temp_list_dir) || ">" || rtrim (temp_list_entry);
693 end;
694
695
696
697 if pascal_context_$options.ps = "1"b then do;
698 call get_temp_segments_ ("pascal_compiler", pascal_context_$ps_segs, code);
699 if code ^= 0 then go to temp_err;
700 end;
701
702 if pascal_context_$options.generated_code then do;
703 call get_temp_segment_ ("pascal_compiler", pascal_context_$usednamesaddr, code);
704 if code ^= 0 then go to temp_err;
705 end;
706
707 call get_temp_segments_ ("pascal_compiler", pascal_context_$segs, code);
708 if code ^= 0 then do;
709 temp_err:
710 call com_err_ (code, "pascal", "Error while get compiler temp work segs");
711 pascal_severity_ = 5;
712 go to comp_aborted_;
713 end;
714
715 pascal_context_$stats_ptr = pascal_context_$statlink_ptr;
716 pascal_context_$links_ptr = addrel (pascal_context_$statlink_ptr, 2 ** 17);
717 pascal_context_$map_ptr = addrel (pascal_context_$symb_ptr, 2 ** 17);
718 pascal_context_$prof_ptr = addrel (pascal_context_$map_ptr, 2 ** 16);
719
720
721
722 in_ptr, pascal_context_$out_ptr, err_ptr = null;
723
724 call iox_$find_iocb (compiler_input, in_ptr, code);
725 if code ^= 0 then go to standard_error_;
726
727 call verify_io (in_ptr);
728
729 call iox_$attach_name (compiler_input, in_ptr, "vfile_ " || absolute_source_path, null, code);
730 if code ^= 0 then do;
731 call com_err_ (code, "pascal",
732 "Error attaching ""^a"" switch ""vfile_ ^a"" for compiler input.",
733 compiler_input, absolute_source_path);
734 pascal_severity_ = 5;
735 go to comp_aborted_;
736 end;
737 call iox_$find_iocb (compiler_output, pascal_context_$out_ptr, code);
738 if code ^= 0 then go to standard_error_;
739
740 call verify_io (pascal_context_$out_ptr);
741
742 if pascal_context_$options.list = "1"b then do;
743 call iox_$attach_name (compiler_output, pascal_context_$out_ptr,
744 "vfile_ " || temp_list_path, null, code);
745 if code ^= 0 then do;
746 call com_err_ (code, "pascal",
747 "Error attaching ""^a"" switch ""vfile_ ^a"" for compiler output.",
748 compiler_output, temp_list_path);
749 pascal_severity_ = 5;
750 go to comp_aborted_;
751 end;
752 end;
753 else do;
754 call iox_$attach_name (compiler_output, pascal_context_$out_ptr, "discard_", null, code);
755 if code ^= 0 then do;
756 call com_err_ (code, "pascal",
757 "Error attaching ""^a"" switch ""discard_"" for compiler output.",
758 compiler_output);
759 pascal_severity_ = 5;
760 go to comp_aborted;
761 end;
762 end;
763
764 call iox_$find_iocb (compiler_error, err_ptr, code);
765 if code ^= 0 then go to standard_error_;
766
767 call verify_io (err_ptr);
768
769 if error_switch = "1"b then do;
770 call iox_$attach_name (compiler_error, err_ptr, "syn_ user_output", null, code);
771 if code ^= 0 then do;
772 call com_err_ (code, "pascal",
773 "Error attaching ""^a"" switch ""syn_ user_output"" for compiler error messages.",
774 compiler_error);
775 pascal_severity_ = 5;
776 go to comp_aborted_;
777 end;
778 end;
779 else do;
780 call iox_$attach_name (compiler_error, err_ptr, "discard_", null, code);
781 if code ^= 0 then do;
782 call com_err_ (code, "pascal",
783 "Error attaching ""^a"" switch ""discard_"" for compiler error messages.",
784 compiler_error);
785 pascal_severity_ = 5;
786 go to comp_aborted_;
787 end;
788 end;
789
790
791
792
793
794 pascal_context_$text_word_count = 0;
795
796
797
798 def_ptr = pascal_context_$def_ptr;
799 def_header.flags.new_format = "1"b;
800 def_header.flags.ignore = "1"b;
801
802 seg_name.num_chars = length (var_string);
803 seg_name.string = var_string;
804 word_count = 3 + ((seg_name.num_chars + 4) / 4);
805 def_list_relp = addr (word_count) -> val.low;
806 pascal_context_$segname_def_ptr = ptr (pascal_context_$def_ptr, word_count);
807 def_seg.forward, def_seg.segname = rel (addrel (pascal_context_$segname_def_ptr, 7));
808 def_seg.backward = "000000000000000010"b;
809 def_seg.value = "000000000000000010"b;
810 def_seg.flags.new = "1"b;
811 def_seg.class = "011"b;
812 def_seg.symbol = "000000000000000011"b;
813
814 def_ptr = ptr (def_ptr, word_count + 3);
815 symb_name.num_chars = 12;
816 symb_name.string = "symbol_table";
817 pascal_context_$last_def_ptr = ptr (pascal_context_$def_ptr, word_count + 7);
818
819 def_symb.backward, def_symb.segname = rel (pascal_context_$segname_def_ptr);
820 def_symb.forward = "000000000000000010"b;
821 def_symb.flags.new = "1"b;
822 def_symb.class = "010"b;
823 def_symb.symbol = rel (def_ptr);
824 pascal_context_$def_word_count = word_count + 10;
825
826
827
828 def_ptr = addrel (def_ptr, 7);
829 trap_pair_offset = rel (def_ptr);
830 def_ptr -> type_pair.type = "000000000000000001"b;
831 def_ptr -> type_pair.seg_ptr = "000000000000000010"b;
832 def_ptr -> type_pair.trap_ptr,
833 def_ptr -> type_pair.ext_ptr = "0"b;
834
835 def_ptr = addrel (def_ptr, 2);
836 def_ptr -> type_ptr = trap_pair_offset;
837 def_ptr -> exp = "0"b;
838
839 pascal_context_$def_word_count = pascal_context_$def_word_count + 3;
840
841 pascal_context_$links_ptr -> exp_ptr = rel (def_ptr);
842 pascal_context_$links_ptr -> ft2 = "100110"b;
843
844
845
846
847 pascal_context_$stat_half_word_count = 16;
848
849
850
851 call pascal_gen_rel_$def (def_rel, 1);
852 call pascal_gen_rel_$def (abs, (word_count * 2) - 1);
853 call pascal_gen_rel_$def (def_rel, 3);
854 call pascal_gen_rel_$def (abs, 1);
855 call pascal_gen_rel_$def (def_rel, 2);
856 call pascal_gen_rel_$def (abs, 8);
857 call pascal_gen_rel_$def (def_rel, 2);
858 call pascal_gen_rel_$def (symb_rel, 1);
859 call pascal_gen_rel_$def (abs, 1);
860 call pascal_gen_rel_$def (def_rel, 2);
861
862 call pascal_gen_rel_$def (abs, 2);
863 call pascal_gen_rel_$def (def_rel, 3);
864 call pascal_gen_rel_$def (abs, 1);
865
866 call pascal_gen_rel_$link (abs, 2);
867 call pascal_gen_rel_$link (text_rel, 1);
868 call pascal_gen_rel_$link (abs, 13);
869
870
871
872 if pascal_context_$options.ps = "1"b then do;
873
874
875
876 def_ptr = pascal_context_$ps_def_ptr;
877 def_header.flags.new_format = "1"b;
878 def_header.flags.ignore = "1"b;
879
880 seg_name.num_chars = length (ps_var_string);
881 seg_name.string = ps_var_string;
882 word_count = 3 + ((seg_name.num_chars + 4) / 4);
883 def_list_relp = addr (word_count) -> val.low;
884 pascal_context_$ps_segname_def_ptr = ptr (pascal_context_$ps_def_ptr, word_count);
885 def_seg.forward, def_seg.segname = rel (addrel (pascal_context_$ps_segname_def_ptr, 7));
886 def_seg.backward = "000000000000000010"b;
887 def_seg.value = "000000000000000010"b;
888 def_seg.flags.new = "1"b;
889 def_seg.class = "011"b;
890 def_seg.symbol = "000000000000000011"b;
891
892 def_ptr = ptr (def_ptr, word_count + 3);
893 symb_name.num_chars = 12;
894 symb_name.string = "symbol_table";
895 pascal_context_$ps_last_def_ptr = ptr (pascal_context_$ps_def_ptr, word_count + 7);
896
897 def_symb.backward, def_symb.segname = rel (pascal_context_$ps_segname_def_ptr);
898 def_symb.forward = "000000000000000010"b;
899 def_symb.flags.new = "1"b;
900 def_symb.class = "010"b;
901 def_symb.symbol = rel (def_ptr);
902 pascal_context_$ps_def_word_count = word_count + 10;
903
904
905
906 pascal_context_$ps_stat_half_word_count = 16;
907 pascal_context_$ps_link_ptr -> header.stats.begin_links,
908 pascal_context_$ps_link_ptr -> header.stats.block_length = "000000000000001000"b; ;
909
910
911
912 if pascal_context_$options.bind = "1"b then do;
913 call pascal_gen_rel_$ps_def (def_rel, 1);
914 call pascal_gen_rel_$ps_def (abs, (word_count * 2) - 1);
915 call pascal_gen_rel_$ps_def (def_rel, 3);
916 call pascal_gen_rel_$ps_def (abs, 1);
917 call pascal_gen_rel_$ps_def (def_rel, 2);
918 call pascal_gen_rel_$ps_def (abs, 8);
919 call pascal_gen_rel_$ps_def (def_rel, 2);
920 call pascal_gen_rel_$ps_def (symb_rel, 1);
921 call pascal_gen_rel_$ps_def (abs, 1);
922 call pascal_gen_rel_$ps_def (def_rel, 2);
923 end;
924
925 end;
926
927
928
929 PARM = parm_string;
930 call date_time_ (pascal_context_$time, pascal_context_$time_string);
931
932 pascal_context_$abort_comp_label = comp_aborted;
933 pascal_context_$int_error_label = force_return_internal;
934 pascal_error_label = force_return_pascal;
935 on pascal_error go to pascal_error_label;
936
937
938 call ioa_ (pascal_compiler_id$version);
939
940 call racine (PARM, COND);
941
942
943
944
945 if COND ^= 0 then do;
946 call ioa_$ioa_switch (iox_$error_output,
947 "pascal: ^d error^[s^] detected in ^a", COND, COND > 1,
948 pascal_context_$source_entry_name);
949 end;
950
951 end_of_comp:
952
953 if COND ^= 0 then pascal_severity_ = 3;
954
955
956
957 if pascal_context_$options.list = "1"b then do;
958 call hcs_$status_long (pascal_context_$working_dir_name, list_entry_name, 0,
959 addr (list_status_branch), null, code);
960 if code ^= 0 then do;
961 call com_err_ (code, "pascal", "Error getting status of ^a", absolute_list_path);
962 pascal_severity_ = 5;
963 go to comp_aborted;
964 end;
965 if (list_status_branch.type = 2) & (list_status_branch.bit_count ^= 0) then do;
966 last_component_nbr = list_status_branch.bit_count - 1;
967 end;
968 else do;
969 last_component_nbr = 0;
970 end;
971 call adjust_bit_count_ (pascal_context_$working_dir_name, list_entry_name, "1"b, bit_count, code);
972 if code ^= 0 then do;
973 call com_err_ (code, "pascal", "Error adjusting bit count of listing segment ^a",
974 absolute_list_path);
975 pascal_severity_ = 5;
976 go to comp_aborted;
977 end;
978 bc = bit_count - (last_component_nbr * 36 * (2 ** 18 - 1024));
979 call tssi_$finish_file (list_fcb_ptr, last_component_nbr, bc, "101"b, list_aclinfo_ptr, code);
980
981
982
983
984
985
986
987
988 list_ok = 1;
989 end;
990 if COND ^= 0 then go to comp_aborted;
991
992
993
994
995 call iox_$detach_iocb (in_ptr, code);
996 call iox_$detach_iocb (pascal_context_$out_ptr, code);
997 call iox_$detach_iocb (err_ptr, code);
998 call release_temp_segments_ ("pascal_compiler", pascal_context_$segs, code);
999 if pascal_context_$options.generated_code then
1000 call release_temp_segment_ ("pascal_compiler", pascal_context_$usednamesaddr, code);
1001 if pascal_context_$options.ps = "1"b then
1002 call release_temp_segments_ ("pascal_compiler", pascal_context_$ps_segs, code);
1003 call pascal_sources_management_$clean;
1004 call pascal_reset_area (absolute_compiler_path);
1005 pascal_is_busy = 0;
1006 return;
1007 %page;
1008 force_return_pascal:
1009
1010
1011 pascal_context_$err_info.string = pascal_operators_statics_$error_info.string;
1012 pascal_context_$err_info.status_code = pascal_operators_statics_$error_info.status_code;
1013
1014 force_return_internal:
1015
1016 pascal_severity_ = 4;
1017
1018 error_message = pascal_context_$err_info.string;
1019 call convert_status_code_ (pascal_context_$err_info.status_code, short_info, status_message);
1020
1021 if pascal_context_$options.list = "1"b then do;
1022 call hcs_$status_long (pascal_context_$working_dir_name, list_entry_name, 0,
1023 addr (list_status_branch), null, code);
1024 if code ^= 0 then do;
1025 go to no_err_list;
1026 end;
1027 if (list_status_branch.type = 2) & (list_status_branch.bit_count ^= 0) then do;
1028 last_component_nbr = list_status_branch.bit_count - 1;
1029 end;
1030 else do;
1031 last_component_nbr = 0;
1032 end;
1033 call msf_manager_$get_ptr (list_fcb_ptr, last_component_nbr, "0"b, last_component_ptr, bc, code);
1034 if code ^= 0 then do;
1035 go to no_err_list;
1036 end;
1037 call tssi_$finish_file (list_ptr, last_component_nbr, bc, "101"b, list_aclinfo_ptr, code);
1038 if code ^= 0 then do;
1039 go to no_err_list;
1040 end;
1041 call adjust_bit_count_ (pascal_context_$working_dir_name, list_entry_name, "1"b, bit_count, code);
1042 if code ^= 0 then do;
1043 go to no_err_list;
1044 end;
1045 list_ok = 1;
1046 end;
1047
1048 no_err_list:
1049
1050 call ioa_$ioa_switch (iox_$error_output, rtrim (error_message) || "
1051 " || rtrim (status_message));
1052 fsb_ptr = RACINE_defs$mpcogin;
1053 call ioa_$ioa_switch (iox_$error_output, "pascal:
1054 Compilation stopped while processing source line ^d:
1055 ", record_counter);
1056 call iox_$open (system_ptr, 1, "0"b, code);
1057 if code = 0 then do;
1058 call iox_$position (system_ptr, 0, record_counter - 1, code);
1059 if (code = 0) | (code = error_table_$end_of_info) then do;
1060 call iox_$get_line (system_ptr, addr (command_line), 256, n_read, code);
1061 if (code = 0) | (code = error_table_$short_record) | (code = error_table_$long_record) then do;
1062 call ioa_$ioa_switch (iox_$error_output,
1063 rtrim (substr (command_line, 1, n_read)));
1064 end;
1065 else call ioa_$ioa_switch (iox_$error_output, "(cannot get source line)
1066 ");
1067 end;
1068 else call ioa_$ioa_switch (iox_$error_output, "(cannot get source line)
1069 ");
1070 end;
1071 else call ioa_$ioa_switch (iox_$error_output, "(cannot get source line)
1072 ");
1073 call ioa_$ioa_switch (iox_$error_output, "pascal: An error occurred during compilation of source segment ^a.
1074 Please correct all the errors detected and recompile. " || "If the error persists,
1075 contact Pascal maintenance personnel.", pascal_context_$source_entry_name);
1076
1077 COND = 1;
1078 go to end_of_comp;
1079
1080 standard_error:
1081
1082 pascal_severity_ = 5;
1083 call com_err_ (code, "pascal");
1084
1085 comp_aborted:
1086
1087 call ioa_$ioa_switch (iox_$error_output,
1088 "pascal: ^[No object created. ^]^[No list created. ^]^[No private_storage segment created.^]",
1089 pascal_context_$object_ok = 0, (pascal_context_$options.list = "1"b) & (list_ok = 0),
1090 (pascal_context_$options.ps = "1"b) & (pascal_context_$ps_ok = 0));
1091
1092 comp_aborted_:
1093
1094 call cleanup_compiler;
1095
1096 return;
1097
1098 standard_error_:
1099
1100 pascal_severity_ = 5;
1101 call com_err_ (code, "pascal");
1102 go to comp_aborted_;
1103 %page;
1104 listhead: entry;
1105
1106
1107
1108 call ioa_$ioa_switch (pascal_context_$out_ptr, "
1109 COMPILATION LISTING OF SEGMENT:
1110 ^a", absolute_source_path);
1111 call ioa_$ioa_switch (pascal_context_$out_ptr, "
1112 Compiled by: ^a
1113 Compiled at: ^a", pascal_compiler_id$gen_id, installation_id);
1114 call ioa_$ioa_switch (pascal_context_$out_ptr, " Compiled on: ^a
1115 options: ^a
1116
1117 ", pascal_context_$time_string, pascal_context_$option_list);
1118
1119 return;
1120 %page;
1121 verify_io: proc (iocb_ptr);
1122
1123 dcl iocb_ptr ptr;
1124
1125 atd_ptr = iocb_ptr -> attach_descrip_ptr;
1126
1127 if atd_ptr ^= null then do;
1128 if iocb_ptr -> open_descrip_ptr ^= null then do;
1129 control_syn:
1130 if substr (atd_ptr -> attach_description.string, 1, 5) ^= "syn_ " then go to close_now;
1131 if atd_ptr -> attach_description.string ^= "syn_ user_input"
1132 & atd_ptr -> attach_description.string ^= "syn_ user_output"
1133 & atd_ptr -> attach_description.string ^= "syn_ error_output"
1134 & atd_ptr -> attach_description.string ^= "syn_ user_i/o" then do;
1135 call iox_$find_iocb (substr (atd_ptr -> attach_description.string,
1136 6, atd_ptr -> attach_description.length - 5), iocb_ptr, code);
1137 if code ^= 0 then go to standard_error;
1138 atd_ptr = iocb_ptr -> attach_descrip_ptr;
1139 if atd_ptr = null then do;
1140 code = pascal_error_table_$bad_syn_chain;
1141 go to standard_error;
1142 end;
1143 go to control_syn;
1144 end;
1145 go to no_to_close;
1146 close_now:
1147 call com_err_ (0, "pascal", "Warning: Pascal closes current file ^a",
1148 iocb_ptr -> iocb.name);
1149 call iox_$close (iocb_ptr, code);
1150 if code ^= 0 then go to standard_error;
1151 no_to_close:
1152 end;
1153 call com_err_ (0, "pascal", "Warning: Pascal detaches I/O switch ^a",
1154 iocb_ptr -> iocb.name);
1155 call iox_$detach_iocb (iocb_ptr, code);
1156 if code ^= 0 then go to standard_error;
1157 end;
1158
1159 return;
1160
1161 end;
1162 %page;
1163 set_for_cleanup: proc;
1164
1165 pascal_context_$out_ptr, err_ptr, pascal_context_$segs, my_firstcond, pascal_context_$usednamesaddr,
1166 list_aclinfo_ptr, object_aclinfo_ptr, ps_aclinfo_ptr, pascal_context_$ps_segs = null;
1167 pascal_is_busy = 1;
1168
1169 end set_for_cleanup;
1170
1171
1172 cleanup_compiler: proc;
1173
1174 dcl iocb_ptr ptr;
1175
1176 if pascal_context_$out_ptr ^= null then do;
1177 call iox_$close (pascal_context_$out_ptr, code);
1178 call iox_$detach_iocb (pascal_context_$out_ptr, code);
1179 end;
1180 call iox_$look_iocb ("mpcogin", iocb_ptr, code);
1181 if iocb_ptr ^= null then do;
1182 call iox_$close (iocb_ptr, code);
1183 call iox_$detach_iocb (iocb_ptr, code);
1184 call iox_$destroy_iocb (iocb_ptr, code);
1185 end;
1186 if err_ptr ^= null then do;
1187 call iox_$detach_iocb (err_ptr, code);
1188 end;
1189
1190 call release_temp_segments_ ("pascal_compiler", pascal_context_$segs, code);
1191 if code ^= 0 then do;
1192 call com_err_ (code, "pascal", "Error releasing compiler temp work segments.");
1193 end;
1194
1195 if pascal_context_$options.ps = "1"b then do;
1196 call release_temp_segments_ ("pascal_compiler", pascal_context_$ps_segs, code);
1197 if code ^= 0 then do;
1198 call com_err_ (code, "pascal", "Error releasing compiler temp work segments.");
1199 end;
1200 end;
1201
1202 if pascal_context_$options.generated_code then do;
1203 call release_temp_segment_ ("pascal_compiler", pascal_context_$usednamesaddr, code);
1204 if code ^= 0 then
1205 call com_err_ (code, "pascal", "Error releasing compiler temp work segment.");
1206 end;
1207
1208 if list_aclinfo_ptr ^= null then call tssi_$clean_up_file (list_fcb_ptr, list_aclinfo_ptr);
1209 if object_aclinfo_ptr ^= null then call tssi_$clean_up_segment (object_aclinfo_ptr);
1210 if ps_aclinfo_ptr ^= null then call tssi_$clean_up_segment (ps_aclinfo_ptr);
1211
1212 call pascal_sources_management_$clean;
1213
1214 call pascal_reset_area (absolute_compiler_path);
1215
1216 do while (my_firstcond ^= null);
1217 box_ptr = my_firstcond;
1218 my_firstcond = nextcond;
1219 free condbox;
1220 end;
1221
1222 pascal_is_busy = 0;
1223
1224
1225 end cleanup_compiler;
1226 %page;
1227 %include pascal_ops_statics;
1228 %page;
1229 %include pascal_fsb;
1230 %page;
1231 %include pascal_context_;
1232 %page;
1233 %include query_info;
1234 %page;
1235 %include status_structures;
1236 %page;
1237 %include send_mail_info;
1238 %page;
1239 %include pl1_symbol_block;
1240 %page;
1241 %include object_map;
1242 %page;
1243 %include definition;
1244 %page;
1245 %include source_map;
1246 %page;
1247 %include std_symbol_header;
1248 %page;
1249 %include iocb;
1250 %page;
1251 %include object_info;
1252 %page;
1253 %include linkdcl;
1254
1255
1256 end pascal;