1 | /************** PlugUtil C Program Source Code File (.C) ***************/ |
2 | /* */ |
3 | /* PROGRAM NAME: PLUGUTIL */ |
4 | /* ------------- */ |
5 | /* Version 3.0 */ |
6 | /* */ |
7 | /* COPYRIGHT: */ |
8 | /* ---------- */ |
9 | /* (C) Copyright to the author Olivier BERTRAND 1993-2017 */ |
10 | /* */ |
11 | /* WHAT THIS PROGRAM DOES: */ |
12 | /* ----------------------- */ |
13 | /* This program are initialization and utility Plug routines. */ |
14 | /* */ |
15 | /* WHAT YOU NEED TO COMPILE THIS PROGRAM: */ |
16 | /* -------------------------------------- */ |
17 | /* */ |
18 | /* REQUIRED FILES: */ |
19 | /* --------------- */ |
20 | /* See Readme.C for a list and description of required SYSTEM files. */ |
21 | /* */ |
22 | /* PLUG.C - Source code */ |
23 | /* GLOBAL.H - Global declaration file */ |
24 | /* OPTION.H - Option declaration file */ |
25 | /* */ |
26 | /* REQUIRED LIBRARIES: */ |
27 | /* ------------------- */ |
28 | /* */ |
29 | /* OS2.LIB - OS2 libray */ |
30 | /* LLIBCE.LIB - Protect mode/standard combined large model C */ |
31 | /* library */ |
32 | /* */ |
33 | /* REQUIRED PROGRAMS: */ |
34 | /* ------------------ */ |
35 | /* */ |
36 | /* IBM C Compiler */ |
37 | /* IBM Linker */ |
38 | /* */ |
39 | /***********************************************************************/ |
40 | |
41 | /***********************************************************************/ |
42 | /* */ |
43 | /* Include relevant MariaDB header file. */ |
44 | /* */ |
45 | /***********************************************************************/ |
46 | #include "my_global.h" |
47 | #if defined(__WIN__) |
48 | //#include <windows.h> |
49 | #else |
50 | #if defined(UNIX) || defined(UNIV_LINUX) |
51 | #include <errno.h> |
52 | #include <unistd.h> |
53 | //#define __stdcall |
54 | #else |
55 | #include <dir.h> |
56 | #endif |
57 | #include <stdarg.h> |
58 | #endif |
59 | |
60 | #if defined(WIN) |
61 | #include <alloc.h> |
62 | #endif |
63 | #include <errno.h> /* definitions of ERANGE ENOMEM */ |
64 | #if !defined(UNIX) && !defined(UNIV_LINUX) |
65 | #include <direct.h> /* Directory management library */ |
66 | #endif |
67 | |
68 | /***********************************************************************/ |
69 | /* */ |
70 | /* Include application header files */ |
71 | /* */ |
72 | /* global.h is header containing all global declarations. */ |
73 | /* */ |
74 | /***********************************************************************/ |
75 | #define STORAGE /* Initialize global variables */ |
76 | |
77 | #include "osutil.h" |
78 | #include "global.h" |
79 | #include "plgdbsem.h" |
80 | #if defined(NEWMSG) |
81 | #include "rcmsg.h" |
82 | #endif // NEWMSG |
83 | |
84 | #if defined(__WIN__) |
85 | extern HINSTANCE s_hModule; /* Saved module handle */ |
86 | #endif // __WIN__ |
87 | |
88 | #if defined(XMSG) |
89 | extern char *msg_path; |
90 | char *msglang(void); |
91 | #endif // XMSG |
92 | |
93 | /***********************************************************************/ |
94 | /* Local Definitions and static variables */ |
95 | /***********************************************************************/ |
96 | typedef struct { |
97 | ushort Segsize; |
98 | ushort Size; |
99 | } AREASIZE; |
100 | |
101 | ACTIVITY defActivity = { /* Describes activity and language */ |
102 | NULL, /* Points to user work area(s) */ |
103 | "Unknown" }; /* Application name */ |
104 | |
105 | #if defined(XMSG) || defined(NEWMSG) |
106 | static char stmsg[200]; |
107 | #endif // XMSG || NEWMSG |
108 | |
109 | #if defined(UNIX) || defined(UNIV_LINUX) |
110 | #include "rcmsg.h" |
111 | #endif // UNIX |
112 | |
113 | /**************************************************************************/ |
114 | /* Tracing output function. */ |
115 | /**************************************************************************/ |
116 | void htrc(char const *fmt, ...) |
117 | { |
118 | va_list ap; |
119 | va_start (ap, fmt); |
120 | |
121 | |
122 | //if (trace == 1) |
123 | // vfprintf(debug, fmt, ap); |
124 | //else |
125 | vfprintf(stderr, fmt, ap); |
126 | |
127 | va_end (ap); |
128 | } // end of htrc |
129 | |
130 | /***********************************************************************/ |
131 | /* Plug initialization routine. */ |
132 | /* Language points on initial language name and eventual path. */ |
133 | /* Return value is the pointer to the Global structure. */ |
134 | /***********************************************************************/ |
135 | PGLOBAL PlugInit(LPCSTR Language, uint worksize) |
136 | { |
137 | PGLOBAL g; |
138 | |
139 | if (trace(2)) |
140 | htrc("PlugInit: Language='%s'\n" , |
141 | ((!Language) ? "Null" : (char*)Language)); |
142 | |
143 | try { |
144 | g = new GLOBAL; |
145 | } catch (...) { |
146 | fprintf(stderr, MSG(GLOBAL_ERROR), (int)sizeof(GLOBAL)); |
147 | return NULL; |
148 | } // end try/catch |
149 | |
150 | g->Sarea = NULL; |
151 | g->Createas = 0; |
152 | g->Alchecked = 0; |
153 | g->Mrr = 0; |
154 | g->Activityp = NULL; |
155 | g->Xchk = NULL; |
156 | g->N = 0; |
157 | g->More = 0; |
158 | strcpy(g->Message, "" ); |
159 | |
160 | /*******************************************************************/ |
161 | /* Allocate the main work segment. */ |
162 | /*******************************************************************/ |
163 | if (worksize && AllocSarea(g, worksize)) { |
164 | char errmsg[MAX_STR]; |
165 | snprintf(errmsg, sizeof(errmsg) - 1, MSG(WORK_AREA), g->Message); |
166 | strcpy(g->Message, errmsg); |
167 | } // endif Sarea |
168 | |
169 | g->jump_level = -1; /* New setting to allow recursive call of Plug */ |
170 | return(g); |
171 | } /* end of PlugInit */ |
172 | |
173 | /***********************************************************************/ |
174 | /* PlugExit: Terminate Plug operations. */ |
175 | /***********************************************************************/ |
176 | int PlugExit(PGLOBAL g) |
177 | { |
178 | if (g) { |
179 | PDBUSER dup = PlgGetUser(g); |
180 | |
181 | if (dup) |
182 | free(dup); |
183 | |
184 | FreeSarea(g); |
185 | delete g; |
186 | } // endif g |
187 | |
188 | return 0; |
189 | } // end of PlugExit |
190 | |
191 | /***********************************************************************/ |
192 | /* Remove the file type from a file name. */ |
193 | /* Note: this routine is not really implemented for Unix. */ |
194 | /***********************************************************************/ |
195 | LPSTR PlugRemoveType(LPSTR pBuff, LPCSTR FileName) |
196 | { |
197 | #if defined(__WIN__) |
198 | char drive[_MAX_DRIVE]; |
199 | #else |
200 | char *drive = NULL; |
201 | #endif |
202 | char direc[_MAX_DIR]; |
203 | char fname[_MAX_FNAME]; |
204 | char ftype[_MAX_EXT]; |
205 | |
206 | _splitpath(FileName, drive, direc, fname, ftype); |
207 | |
208 | if (trace(2)) { |
209 | htrc("after _splitpath: FileName=%s\n" , FileName); |
210 | htrc("drive=%s dir=%s fname=%s ext=%s\n" , |
211 | SVP(drive), direc, fname, ftype); |
212 | } // endif trace |
213 | |
214 | _makepath(pBuff, drive, direc, fname, "" ); |
215 | |
216 | if (trace(2)) |
217 | htrc("buff='%s'\n" , pBuff); |
218 | |
219 | return pBuff; |
220 | } // end of PlugRemoveType |
221 | |
222 | |
223 | BOOL PlugIsAbsolutePath(LPCSTR path) |
224 | { |
225 | #if defined(__WIN__) |
226 | return ((path[0] >= 'a' && path[0] <= 'z') || |
227 | (path[0] >= 'A' && path[0] <= 'Z')) && path[1] == ':'; |
228 | #else |
229 | return path[0] == '/'; |
230 | #endif |
231 | } |
232 | |
233 | /***********************************************************************/ |
234 | /* Set the full path of a file relatively to a given path. */ |
235 | /* Note: this routine is not really implemented for Unix. */ |
236 | /***********************************************************************/ |
237 | LPCSTR PlugSetPath(LPSTR pBuff, LPCSTR prefix, LPCSTR FileName, LPCSTR defpath) |
238 | { |
239 | char newname[_MAX_PATH]; |
240 | char direc[_MAX_DIR], defdir[_MAX_DIR], tmpdir[_MAX_DIR]; |
241 | char fname[_MAX_FNAME]; |
242 | char ftype[_MAX_EXT]; |
243 | #if defined(__WIN__) |
244 | char drive[_MAX_DRIVE], defdrv[_MAX_DRIVE]; |
245 | #else |
246 | char *drive = NULL, *defdrv = NULL; |
247 | #endif |
248 | |
249 | if (trace(2)) |
250 | htrc("prefix=%s fn=%s path=%s\n" , prefix, FileName, defpath); |
251 | |
252 | if (!strncmp(FileName, "//" , 2) || !strncmp(FileName, "\\\\" , 2)) { |
253 | strcpy(pBuff, FileName); // Remote file |
254 | return pBuff; |
255 | } // endif |
256 | |
257 | if (PlugIsAbsolutePath(FileName)) |
258 | { |
259 | strcpy(pBuff, FileName); // FileName includes absolute path |
260 | return pBuff; |
261 | } // endif |
262 | |
263 | #if !defined(__WIN__) |
264 | if (*FileName == '~') { |
265 | if (_fullpath(pBuff, FileName, _MAX_PATH)) { |
266 | if (trace(2)) |
267 | htrc("pbuff='%s'\n" , pBuff); |
268 | |
269 | return pBuff; |
270 | } else |
271 | return FileName; // Error, return unchanged name |
272 | |
273 | } // endif FileName |
274 | #endif // !__WIN__ |
275 | |
276 | if (prefix && strcmp(prefix, "." ) && !PlugIsAbsolutePath(defpath)) |
277 | { |
278 | char tmp[_MAX_PATH]; |
279 | int len= snprintf(tmp, sizeof(tmp) - 1, "%s%s%s" , |
280 | prefix, defpath, FileName); |
281 | memcpy(pBuff, tmp, (size_t) len); |
282 | pBuff[len]= '\0'; |
283 | return pBuff; |
284 | } |
285 | |
286 | _splitpath(FileName, drive, direc, fname, ftype); |
287 | |
288 | if (defpath) { |
289 | char c = defpath[strlen(defpath) - 1]; |
290 | |
291 | strcpy(tmpdir, defpath); |
292 | |
293 | if (c != '/' && c != '\\') |
294 | strcat(tmpdir, "/" ); |
295 | |
296 | } else |
297 | strcpy(tmpdir, "./" ); |
298 | |
299 | _splitpath(tmpdir, defdrv, defdir, NULL, NULL); |
300 | |
301 | if (trace(2)) { |
302 | htrc("after _splitpath: FileName=%s\n" , FileName); |
303 | #if defined(__WIN__) |
304 | htrc("drive=%s dir=%s fname=%s ext=%s\n" , drive, direc, fname, ftype); |
305 | htrc("defdrv=%s defdir=%s\n" , defdrv, defdir); |
306 | #else |
307 | htrc("dir=%s fname=%s ext=%s\n" , direc, fname, ftype); |
308 | #endif |
309 | } // endif trace |
310 | |
311 | if (drive && !*drive) |
312 | strcpy(drive, defdrv); |
313 | |
314 | switch (*direc) { |
315 | case '\0': |
316 | strcpy(direc, defdir); |
317 | break; |
318 | case '\\': |
319 | case '/': |
320 | break; |
321 | default: |
322 | // This supposes that defdir ends with a SLASH |
323 | strcpy(direc, strcat(defdir, direc)); |
324 | } // endswitch |
325 | |
326 | _makepath(newname, drive, direc, fname, ftype); |
327 | |
328 | if (trace(2)) |
329 | htrc("newname='%s'\n" , newname); |
330 | |
331 | if (_fullpath(pBuff, newname, _MAX_PATH)) { |
332 | if (trace(2)) |
333 | htrc("pbuff='%s'\n" , pBuff); |
334 | |
335 | return pBuff; |
336 | } else |
337 | return FileName; // Error, return unchanged name |
338 | |
339 | } // end of PlugSetPath |
340 | |
341 | #if defined(XMSG) |
342 | /***********************************************************************/ |
343 | /* PlugGetMessage: get a message from the message file. */ |
344 | /***********************************************************************/ |
345 | char *PlugReadMessage(PGLOBAL g, int mid, char *m) |
346 | { |
347 | char msgfile[_MAX_PATH], msgid[32], buff[256]; |
348 | char *msg; |
349 | FILE *mfile = NULL; |
350 | |
351 | //GetPrivateProfileString("Message", msglang, "Message\\english.msg", |
352 | // msgfile, _MAX_PATH, plgini); |
353 | //strcat(strcat(strcpy(msgfile, msg_path), msglang()), ".msg"); |
354 | strcat(strcpy(buff, msglang()), ".msg" ); |
355 | PlugSetPath(msgfile, NULL, buff, msg_path); |
356 | |
357 | if (!(mfile = fopen(msgfile, "rt" ))) { |
358 | sprintf(stmsg, "Fail to open message file %s" , msgfile); |
359 | goto err; |
360 | } // endif mfile |
361 | |
362 | for (;;) |
363 | if (!fgets(buff, 256, mfile)) { |
364 | sprintf(stmsg, "Cannot get message %d %s" , mid, SVP(m)); |
365 | goto fin; |
366 | } else |
367 | if (atoi(buff) == mid) |
368 | break; |
369 | |
370 | if (sscanf(buff, " %*d %s \"%[^\"]" , msgid, stmsg) < 2) { |
371 | // Old message file |
372 | if (!sscanf(buff, " %*d \"%[^\"]" , stmsg)) { |
373 | sprintf(stmsg, "Bad message file for %d %s" , mid, SVP(m)); |
374 | goto fin; |
375 | } else |
376 | m = NULL; |
377 | |
378 | } // endif sscanf |
379 | |
380 | if (m && strcmp(m, msgid)) { |
381 | // Message file is out of date |
382 | strcpy(stmsg, m); |
383 | goto fin; |
384 | } // endif m |
385 | |
386 | fin: |
387 | fclose(mfile); |
388 | |
389 | err: |
390 | if (g) { |
391 | // Called by STEP |
392 | msg = PlugDup(g, stmsg); |
393 | } else // Called by MSG or PlgGetErrorMsg |
394 | msg = stmsg; |
395 | |
396 | return msg; |
397 | } // end of PlugReadMessage |
398 | |
399 | #elif defined(NEWMSG) |
400 | /***********************************************************************/ |
401 | /* PlugGetMessage: get a message from the resource string table. */ |
402 | /***********************************************************************/ |
403 | char *PlugGetMessage(PGLOBAL g, int mid) |
404 | { |
405 | char *msg; |
406 | |
407 | #if 0 // was !defined(UNIX) && !defined(UNIV_LINUX) |
408 | int n = LoadString(s_hModule, (uint)mid, (LPTSTR)stmsg, 200); |
409 | |
410 | if (n == 0) { |
411 | DWORD rc = GetLastError(); |
412 | msg = (char*)PlugSubAlloc(g, NULL, 512); // Extend buf allocation |
413 | n = sprintf(msg, "Message %d, rc=%d: " , mid, rc); |
414 | FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | |
415 | FORMAT_MESSAGE_IGNORE_INSERTS, NULL, rc, 0, |
416 | (LPTSTR)(msg + n), 512 - n, NULL); |
417 | return msg; |
418 | } // endif n |
419 | |
420 | #else // ALL |
421 | if (!GetRcString(mid, stmsg, 200)) |
422 | sprintf(stmsg, "Message %d not found" , mid); |
423 | #endif // ALL |
424 | |
425 | if (g) { |
426 | // Called by STEP |
427 | msg = PlugDup(g, stmsg); |
428 | } else // Called by MSG or PlgGetErrorMsg |
429 | msg = stmsg; |
430 | |
431 | return msg; |
432 | } // end of PlugGetMessage |
433 | #endif // NEWMSG |
434 | |
435 | #if defined(__WIN__) |
436 | /***********************************************************************/ |
437 | /* Return the line length of the console screen buffer. */ |
438 | /***********************************************************************/ |
439 | short GetLineLength(PGLOBAL g) |
440 | { |
441 | CONSOLE_SCREEN_BUFFER_INFO coninfo; |
442 | HANDLE hcons = GetStdHandle(STD_OUTPUT_HANDLE); |
443 | BOOL b = GetConsoleScreenBufferInfo(hcons, &coninfo); |
444 | |
445 | return (b) ? coninfo.dwSize.X : 0; |
446 | } // end of GetLineLength |
447 | #endif // __WIN__ |
448 | |
449 | /***********************************************************************/ |
450 | /* Program for memory allocation of work and language areas. */ |
451 | /***********************************************************************/ |
452 | bool AllocSarea(PGLOBAL g, uint size) |
453 | { |
454 | /*********************************************************************/ |
455 | /* This is the allocation routine for the WIN32/UNIX/AIX version. */ |
456 | /*********************************************************************/ |
457 | #if defined(__WIN__) |
458 | if (size >= 1048576) // 1M |
459 | g->Sarea = VirtualAlloc(NULL, size, MEM_COMMIT | MEM_RESERVE, PAGE_READWRITE); |
460 | else |
461 | #endif |
462 | g->Sarea = malloc(size); |
463 | |
464 | if (!g->Sarea) { |
465 | sprintf(g->Message, MSG(MALLOC_ERROR), "malloc" ); |
466 | g->Sarea_Size = 0; |
467 | } else |
468 | g->Sarea_Size = size; |
469 | |
470 | #if defined(DEVELOPMENT) |
471 | if (true) { |
472 | #else |
473 | if (trace(8)) { |
474 | #endif |
475 | if (g->Sarea) |
476 | htrc("Work area of %u allocated at %p\n" , size, g->Sarea); |
477 | else |
478 | htrc("SareaAlloc: %s\n" , g->Message); |
479 | |
480 | } // endif trace |
481 | |
482 | return (!g->Sarea); |
483 | } // end of AllocSarea |
484 | |
485 | /***********************************************************************/ |
486 | /* Program for memory freeing the work area. */ |
487 | /***********************************************************************/ |
488 | void FreeSarea(PGLOBAL g) |
489 | { |
490 | if (g->Sarea) { |
491 | #if defined(__WIN__) |
492 | if (g->Sarea_Size >= 1048576) // 1M |
493 | VirtualFree(g->Sarea, 0, MEM_RELEASE); |
494 | else |
495 | #endif |
496 | free(g->Sarea); |
497 | |
498 | #if defined(DEVELOPMENT) |
499 | if (true) |
500 | #else |
501 | if (trace(8)) |
502 | #endif |
503 | htrc("Freeing Sarea at %p size = %d\n" , g->Sarea, g->Sarea_Size); |
504 | |
505 | g->Sarea = NULL; |
506 | g->Sarea_Size = 0; |
507 | } // endif Sarea |
508 | |
509 | return; |
510 | } // end of FreeSarea |
511 | |
512 | /***********************************************************************/ |
513 | /* Program for SubSet initialization of memory pools. */ |
514 | /* Here there should be some verification done such as validity of */ |
515 | /* the address and size not larger than memory size. */ |
516 | /***********************************************************************/ |
517 | BOOL PlugSubSet(PGLOBAL g __attribute__((unused)), void *memp, uint size) |
518 | { |
519 | PPOOLHEADER pph = (PPOOLHEADER)memp; |
520 | |
521 | pph->To_Free = (OFFSET)sizeof(POOLHEADER); |
522 | pph->FreeBlk = size - pph->To_Free; |
523 | |
524 | return FALSE; |
525 | } /* end of PlugSubSet */ |
526 | |
527 | /***********************************************************************/ |
528 | /* Program for sub-allocating one item in a storage area. */ |
529 | /* Note: SubAlloc routines of OS/2 are no more used to increase the */ |
530 | /* code portability and avoid problems when a grammar compiled under */ |
531 | /* one version of OS/2 is used under another version. */ |
532 | /* The simple way things are done here is also based on the fact */ |
533 | /* that no freeing of suballocated blocks is permitted in Plug. */ |
534 | /***********************************************************************/ |
535 | void *PlugSubAlloc(PGLOBAL g, void *memp, size_t size) |
536 | { |
537 | PPOOLHEADER pph; /* Points on area header. */ |
538 | |
539 | if (!memp) |
540 | /*******************************************************************/ |
541 | /* Allocation is to be done in the Sarea. */ |
542 | /*******************************************************************/ |
543 | memp = g->Sarea; |
544 | |
545 | size = ((size + 7) / 8) * 8; /* Round up size to multiple of 8 */ |
546 | pph = (PPOOLHEADER)memp; |
547 | |
548 | if (trace(16)) |
549 | htrc("SubAlloc in %p size=%d used=%d free=%d\n" , |
550 | memp, size, pph->To_Free, pph->FreeBlk); |
551 | |
552 | if ((uint)size > pph->FreeBlk) { /* Not enough memory left in pool */ |
553 | PCSZ pname = "Work" ; |
554 | |
555 | sprintf(g->Message, |
556 | "Not enough memory in %s area for request of %u (used=%d free=%d)" , |
557 | pname, (uint)size, pph->To_Free, pph->FreeBlk); |
558 | |
559 | if (trace(1)) |
560 | htrc("PlugSubAlloc: %s\n" , g->Message); |
561 | |
562 | throw 1234; |
563 | } /* endif size OS32 code */ |
564 | |
565 | /*********************************************************************/ |
566 | /* Do the suballocation the simplest way. */ |
567 | /*********************************************************************/ |
568 | memp = MakePtr(memp, pph->To_Free); /* Points to suballocated block */ |
569 | pph->To_Free += (OFFSET)size; /* New offset of pool free block */ |
570 | pph->FreeBlk -= (uint)size; /* New size of pool free block */ |
571 | |
572 | if (trace(16)) |
573 | htrc("Done memp=%p used=%d free=%d\n" , |
574 | memp, pph->To_Free, pph->FreeBlk); |
575 | |
576 | return (memp); |
577 | } /* end of PlugSubAlloc */ |
578 | |
579 | /***********************************************************************/ |
580 | /* Program for sub-allocating and copying a string in a storage area. */ |
581 | /***********************************************************************/ |
582 | char *PlugDup(PGLOBAL g, const char *str) |
583 | { |
584 | if (str) { |
585 | char *sm = (char*)PlugSubAlloc(g, NULL, strlen(str) + 1); |
586 | |
587 | strcpy(sm, str); |
588 | return sm; |
589 | } else |
590 | return NULL; |
591 | |
592 | } // end of PlugDup |
593 | |
594 | #if 0 |
595 | /***********************************************************************/ |
596 | /* This routine suballocate a copy of the passed string. */ |
597 | /***********************************************************************/ |
598 | char *PlugDup(PGLOBAL g, const char *str) |
599 | { |
600 | char *buf; |
601 | size_t len; |
602 | |
603 | if (str && (len = strlen(str))) { |
604 | buf = (char*)PlugSubAlloc(g, NULL, len + 1); |
605 | strcpy(buf, str); |
606 | } else |
607 | buf = NULL; |
608 | |
609 | return(buf); |
610 | } /* end of PlugDup */ |
611 | #endif // 0 |
612 | |
613 | /***********************************************************************/ |
614 | /* This routine makes a pointer from an offset to a memory pointer. */ |
615 | /***********************************************************************/ |
616 | void *MakePtr(void *memp, OFFSET offset) |
617 | { |
618 | return ((offset == 0) ? NULL : &((char *)memp)[offset]); |
619 | } /* end of MakePtr */ |
620 | |
621 | /***********************************************************************/ |
622 | /* This routine makes an offset from a pointer new format. */ |
623 | /***********************************************************************/ |
624 | #if 0 |
625 | OFFSET MakeOff(void *memp, void *ptr) |
626 | { |
627 | return ((!ptr) ? 0 : (OFFSET)((char *)ptr - (char *)memp)); |
628 | } /* end of MakeOff */ |
629 | #endif |
630 | /*--------------------- End of PLUGUTIL program -----------------------*/ |
631 | |