1 /* scanit.f -- translated by f2c (version 19980913).
2 You must link the resulting object file with the libraries:
3 -lf2c -lm (in that order)
4 */
5
6 #include "f2c.h"
7
8 /* $Procedure SCANIT ( Scan a character string ) */
scanit_0_(int n__,char * string,integer * start,integer * room,integer * nmarks,char * marks,integer * mrklen,integer * pnters,integer * ntokns,integer * ident,integer * beg,integer * end,ftnlen string_len,ftnlen marks_len)9 /* Subroutine */ int scanit_0_(int n__, char *string, integer *start, integer
10 *room, integer *nmarks, char *marks, integer *mrklen, integer *pnters,
11 integer *ntokns, integer *ident, integer *beg, integer *end, ftnlen
12 string_len, ftnlen marks_len)
13 {
14 /* System generated locals */
15 integer i__1, i__2, i__3;
16
17 /* Builtin functions */
18 integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen);
19
20 /* Local variables */
21 integer last, jump, test, slot, stop, last1, this1, i__, j, l, n, fchar,
22 lchar;
23 extern /* Subroutine */ int chkin_(char *, ftnlen);
24 logical equal;
25 extern integer ncpos_(char *, char *, integer *, ftnlen, ftnlen);
26 logical known;
27 extern integer rtrim_(char *, ftnlen);
28 extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
29 integer eblock, backup, finish, lbound, offset;
30 extern /* Subroutine */ int rmdupc_(integer *, char *, ftnlen);
31 integer ubound, intval;
32 extern /* Subroutine */ int sigerr_(char *, ftnlen);
33 char letter[1];
34 extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
35 ftnlen);
36 extern logical return_(void);
37
38 /* $ Abstract */
39
40 /* This routine serves as an umbrella routine for routines */
41 /* that are used to scan a string for recognized and unrecognized */
42 /* substrings. */
43
44 /* $ Disclaimer */
45
46 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
47 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
48 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
49 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
50 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
51 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
52 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
53 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
54 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
55 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
56
57 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
58 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
59 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
60 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
61 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
62 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
63
64 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
65 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
66 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
67 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
68
69 /* $ Required_Reading */
70
71 /* None. */
72
73 /* $ Keywords */
74
75 /* SEARCH */
76 /* PARSE */
77
78 /* $ Declarations */
79 /* $ Brief_I/O */
80
81 /* Variable I/O Description */
82 /* -------- --- -------------------------------------------------- */
83 /* STRING I a string to be scanned. */
84 /* ROOM I space available for located substrings. */
85 /* NMARKS I/O number of recognizable substrings. */
86 /* MARKS I/O recognizable substrings. */
87 /* MRKLEN I/O an auxiliary array describing MARKS. */
88 /* PNTERS I/O an auxiliary array describing MARKS. */
89 /* START I/O position from which to commence/resume scanning. */
90 /* NTOKNS O number of scanned substrings. */
91 /* BEG O beginnings of scanned substrings. */
92 /* END O endings of scanned substrings. */
93 /* IDENT O position of scanned substring within array MARKS. */
94
95 /* $ Detailed_Input */
96
97 /* STRING is any character string that is to be scanned */
98 /* to locate recognized and unrecognized substrings. */
99
100 /* ROOM is the amount of space available for storing the */
101 /* results of scanning the string. */
102
103 /* NMARKS is the number of marks that will be */
104 /* recognized substrings of STRING. */
105
106 /* MARKS is an array of marks that will be recognized */
107 /* by the scanning routine. The array must be */
108 /* processed by a call to SCANPR before it can */
109 /* be used by SCAN. Further details are given */
110 /* in documentation for the individual entry points. */
111
112 /* MRKLEN is an auxiliary array populated by SCANPR */
113 /* for use by SCAN. It should be declared with */
114 /* length equal to the length of MARKS. */
115
116 /* PNTERS is an auxiliary array populated by SCANPR for */
117 /* use by SCAN. It should be declared in the */
118 /* calling program as */
119
120 /* INTEGER PNTERS ( RCHARS ) */
121
122 /* RCHARS is given by the expression */
123
124 /* MAX - MIN + 5 */
125
126 /* where */
127
128 /* MAX is the maximum value of ICHAR(MARKS(I)(1:1)) */
129 /* over the range I = 1, NMARKS */
130
131 /* MIN is the minimum value of ICHAR(MARKS(I)(1:1)) */
132 /* over the range I = 1, NMARKS */
133
134 /* Further details are provided in the entry point */
135 /* SCANPR. */
136
137 /* START is the position in the STRING from which scanning */
138 /* should commence. */
139
140 /* $ Detailed_Output */
141
142 /* NMARKS is the number of marks in the array MARKS after it */
143 /* has been prepared for SCANPR. */
144
145 /* MARKS is an array of recognizable substrings that has */
146 /* been prepared for SCAN by SCANPR. Note that MARKS */
147 /* will be sorted in increasing order. */
148
149 /* MRKLEN is an auxiliary array, populated by SCANPR for */
150 /* use by SCAN. */
151
152 /* PNTERS is an auxiliary array, populated by a call to */
153 /* SCANPR and is intended for use by SCAN. */
154
155 /* START is the position from which scanning should continue */
156 /* in order to fully scan STRING (if sufficient memory was */
157 /* not provided in BEG, END, and IDENT on the current */
158 /* call to SCAN). */
159
160 /* NTOKNS is the number of substrings identified in the current */
161 /* scan of STRING. */
162
163 /* BEG Beginnings of scanned substrings. */
164 /* This should be declared so that it is at least */
165 /* as large as ROOM. */
166
167 /* END Endings of scanned substrings. */
168 /* This should be declared so that it is at least */
169 /* as large as ROOM. */
170
171 /* IDENT Positions of scanned substring within array MARKS. */
172 /* If the substring STRING(BEG(I):END(I)) is not in the */
173 /* list of MARKS then IDENT(I) will have the value 0. */
174 /* This should be declared so that it is at least */
175 /* as large as ROOM. */
176
177 /* $ Parameters */
178
179 /* None. */
180
181 /* $ Exceptions */
182
183 /* 1) If this routine is called directly the error */
184 /* 'SPICE(BOGUSENTRY)' will be signalled. */
185
186 /* $ Files */
187
188 /* None. */
189
190 /* $ Particulars */
191
192 /* This routine serves as an umbrella routine for the two entry */
193 /* points SCANPR and SCAN. It can be used to locate keywords */
194 /* or delimited substrings within a string. */
195
196 /* The process of breaking a string into those substrings that */
197 /* have recognizable meaning, is called "scanning." The substrings */
198 /* identified by the scanning process are called "tokens." */
199
200 /* Scanning has many applications including: */
201
202 /* -- the parsing of algebraic expressions */
203
204 /* -- parsing calendar dates */
205
206 /* -- processing text with embedded directions for displaying */
207 /* the text. */
208
209 /* -- interpretation of command languages */
210
211 /* -- compilation of programming languages */
212
213 /* This routine simplifies the process of scanning a string for */
214 /* its tokens. */
215
216 /* $ Examples */
217
218 /* Example 1. */
219 /* ---------- */
220
221 /* Suppose you need to identify all of the words within a string */
222 /* and wish to ignore punctuation marks such as ',', ':', ';', ' ', */
223 /* '---'. */
224
225 /* The first step is to load the array of marks as shown here: */
226
227 /* The minimum ASCII code for the first character of a marker is */
228 /* 32 ( for ' '). */
229
230 /* INTEGER FCHAR */
231 /* PARAMETER ( FCHAR = 32 ) */
232
233 /* The maximum ASCII code for the first character of a marker is */
234 /* 59 (for ';' ) */
235
236 /* INTEGER LCHAR */
237 /* PARAMETER ( LCHAR = 59 ) */
238
239 /* INTEGER RCHAR */
240 /* PARAMETER ( RCHAR = LCHAR - FCHAR + 5 ) */
241
242 /* LOGICAL FIRST */
243 /* CHARACTER*(3) MARKS */
244 /* INTEGER NMARKS ( 5 ) */
245 /* INTEGER MRKLEN ( 5 ) */
246 /* INTEGER PNTERS ( RCHAR ) */
247
248 /* INTEGER ROOM */
249 /* PARAMETER ( ROOM = 50 ) */
250
251 /* INTEGER BEG ( ROOM ) */
252 /* INTEGER END ( ROOM ) */
253 /* INTEGER IDENT ( ROOM ) */
254
255 /* SAVE FIRST */
256 /* SAVE MARKS */
257 /* SAVE MRKLEN */
258 /* SAVE PNTERS */
259
260 /* IF ( FIRST ) THEN */
261
262 /* FIRST = .FALSE. */
263
264 /* MARKS(1) = ' ' */
265 /* MARKS(2) = '---' */
266 /* MARKS(3) = ':' */
267 /* MARKS(4) = ',' */
268 /* MARKS(5) = ';' */
269
270 /* NMARKS = 5 */
271
272 /* CALL SCANPR ( NMARKS, MARKS, MRKLEN, PNTERS ) */
273
274 /* END IF */
275
276 /* Notice that the call to SCANPR is nested inside an */
277 /* IF ( FIRST ) THEN ... END IF block. In this and many applications */
278 /* the marks that will be used in the scan are fixed. Since the */
279 /* marks are not changing, you need to process MARKS and set up */
280 /* the auxiliary arrays MRKLEN and PNTERS only once (assuming that */
281 /* you SAVE the appropriate variables as has been done above). */
282 /* In this way if the code is executed many times, there is only */
283 /* a small overhead required for preparing the data so that it */
284 /* can be used efficiently in scanning. */
285
286 /* To identify the substrings that represent words we scan the */
287 /* string using the prepared MARKS, MRKLEN and PNTERS. */
288
289 /* CALL SCAN ( STRING, MARKS, MRKLEN, PNTERS, ROOM, */
290 /* . START, NTOKNS, IDENT, BEG, END ) */
291
292 /* To isolate only the words of the string, we examine the */
293 /* array IDENT and keep only those Begin and Ends for which */
294 /* the corresponding identity is non-positive. */
295
296 /* KEPT = 0 */
297
298 /* DO I = 1, NTOKNS */
299
300 /* IF ( IDENT(I) .LE. 0 ) THEN */
301
302 /* KEPT = KEPT + 1 */
303 /* BEG(KEPT) = BEG(I) */
304 /* END(KEPT) = END(I) */
305
306 /* END IF */
307
308 /* END DO */
309
310
311 /* Example 2. */
312 /* ---------- */
313
314 /* To parse an algebraic expression such as */
315
316 /* ( X + Y ) * ( 2*Z + SIN(W) ) ** 2 */
317
318 /* You would select '**', '*', '+', '-', '(', ')' and ' ' */
319 /* to be the markers. Note that all of these begin with one */
320 /* of the characters in the string ' !"#$%&''()*+,-./' */
321 /* so that we can declare PNTERS to have length 20. */
322
323 /* Prepare the MARKS, MRKLEN, and PNTERS. */
324
325 /* LOGICAL FIRST */
326 /* CHARACTER*(4) MARKS */
327 /* INTEGER NMARKS ( 8 ) */
328 /* INTEGER MRKLEN ( 8 ) */
329 /* INTEGER PNTERS ( 20 ) */
330
331 /* SAVE FIRST */
332 /* SAVE MARKS */
333 /* SAVE MRKLEN */
334 /* SAVE PNTERS */
335
336 /* IF ( FIRST ) THEN */
337
338 /* MARKS(1) = '(' */
339 /* MARKS(2) = ')' */
340 /* MARKS(3) = '+' */
341 /* MARKS(4) = '-' */
342 /* MARKS(5) = '*' */
343 /* MARKS(6) = '/' */
344 /* MARKS(7) = '**' */
345 /* MARKS(8) = ' ' */
346
347 /* NMARKS = 8 */
348
349 /* CALL SCANPR ( NMARKS, MARKS, MRKLEN, PNTERS ) */
350
351 /* Locate the blank character in MARKS once it has */
352 /* been prepared. */
353
354 /* BLANK = BSRCHC ( ' ', NMARKS, MARKS ) */
355
356 /* END IF */
357
358
359 /* Once all of the initializations are out of the way, */
360 /* we can scan an input string. */
361
362 /* CALL SCAN ( STRING, MARKS, MRKLEN, PNTERS, ROOM, */
363 /* . START, NTOKNS, IDENT, BEG, END ) */
364
365
366 /* Next eliminate any white space that was returned in the */
367 /* list of tokens. */
368
369 /* KEPT = 0 */
370
371 /* DO I = 1, NTOKNS */
372
373 /* IF ( IDENT(I) .NE. BLANK ) THEN */
374 /* KEPT = KEPT + 1 */
375 /* BEG (KEPT) = BEG (I) */
376 /* END (KEPT) = END (I) */
377 /* IDENT(KEPT) = IDENT (I) */
378 /* END IF */
379
380 /* END DO */
381
382 /* Now all of the substrings remaining point to grouping symbols, */
383 /* operators, functions, or variables. Given that the individual */
384 /* "words" of the expression are now in hand, the meaning of the */
385 /* expression is much easier to determine. */
386
387 /* The rest of the routine is left as a non-trivial exercise */
388 /* for the reader. */
389
390 /* $ Restrictions */
391
392 /* The array of MARKS, MRKLEN, and PNTERS must be properly formatted */
393 /* prior to calling SCAN. This is accomplished by calling SCANPR. */
394
395 /* $ Literature_References */
396
397 /* None. */
398
399 /* $ Author_and_Institution */
400
401 /* W.L. Taber (JPL) */
402
403 /* $ Version */
404
405 /* - Spicelib Version 1.0.0, 26-JUL-1996 (WLT) */
406
407 /* -& */
408 /* $ Index_Entries */
409
410 /* Scan a string for recognized and unrecognized tokens */
411 /* Parse a string */
412
413 /* -& */
414
415 /* SPICELIB functions */
416
417
418 /* Local variables */
419
420 /* Parameter adjustments */
421 if (ident) {
422 }
423 if (beg) {
424 }
425 if (end) {
426 }
427
428 /* Function Body */
429 switch(n__) {
430 case 1: goto L_scanpr;
431 case 2: goto L_scan;
432 }
433
434 if (! return_()) {
435 chkin_("SCANIT", (ftnlen)6);
436 setmsg_("Your program has referenced the umbrella subroutine SCANIT."
437 " This may indicate a programming error.", (ftnlen)99);
438 sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17);
439 chkout_("SCANIT", (ftnlen)6);
440 }
441 return 0;
442 /* $Procedure SCANPR ( Scanning preparation ) */
443
444 L_scanpr:
445 /* $ Abstract */
446
447 /* Prepare recognized markers and auxiliary arrays for the */
448 /* routine SCAN. */
449
450 /* $ Disclaimer */
451
452 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
453 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
454 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
455 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
456 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
457 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
458 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
459 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
460 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
461 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
462
463 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
464 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
465 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
466 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
467 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
468 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
469
470 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
471 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
472 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
473 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
474
475 /* $ Required_Reading */
476
477 /* None. */
478
479 /* $ Keywords */
480
481 /* PARSING */
482 /* UTILITY */
483
484 /* $ Declarations */
485
486 /* INTEGER NMARKS */
487 /* CHARACTER*(*) MARKS ( * ) */
488 /* INTEGER MRKLEN ( * ) */
489 /* INTEGER PNTERS ( * ) */
490
491 /* $ Brief_I/O */
492
493 /* Variable I/O Description */
494 /* -------- --- -------------------------------------------------- */
495 /* NMARKS I/O Number of recognizable substrings. */
496 /* MARKS I/O Recognizable substrings. */
497 /* MRKLEN O auxiliary array describing MARKS. */
498 /* PNTERS O auxiliary array describing MARKS. */
499
500 /* $ Detailed_Input */
501
502 /* NMARKS is the number of recognized marks that will be */
503 /* recognized substrings of STRING. */
504
505 /* MARKS is an array of marks that will be recognized */
506 /* by the scanning routine. Leading and trailing */
507 /* blanks are not significant. (Except for the */
508 /* blank character ' ', itself. After all, some */
509 /* part of it must be significant.) Case of the */
510 /* entries in MARKS is significant. The MARKS */
511 /* 'XX' and 'xx' are regarded as different MARKS. */
512
513 /* $ Detailed_Output */
514
515 /* NMARKS is the number of marks in the array MARKS after it */
516 /* has been prepared for SCAN. */
517
518 /* MARKS is an array of recognizable substrings. */
519 /* It has been prepared for use by SCAN */
520 /* so as to be compatible with the other arrays. */
521 /* It will be sorted in ascending order, left */
522 /* justified and contain no duplicate entries. */
523
524 /* MRKLEN is an auxiliary array populated by SCANPR */
525 /* for use by SCAN that describes MARKS. */
526
527 /* PNTERS is an auxiliary array populated by SCANPR for */
528 /* use by SCAN. It should be declared in the */
529 /* calling program as */
530
531 /* INTEGER PNTERS ( RCHARS ) */
532
533 /* RCHARS is given by the expression */
534
535 /* MAX - MIN + 5 */
536
537 /* where */
538
539 /* MAX is the maximum value of ICHAR(MARKS(I)(1:1)) */
540 /* over the range I = 1, NMARKS */
541
542 /* MIN is the minimum value of ICHAR(MARKS(I)(1:1)) */
543 /* over the range I = 1, NMARKS */
544
545 /* Here are some typical values that may help you avoid */
546 /* going through the computations above. (This assumes */
547 /* that ICHAR returns the ASCII code for a character.) */
548
549 /* Scanning Situation RCHAR */
550 /* ------------------ ------------------- */
551 /* If NMARKS = 1 */
552 /* or all MARKS 5 */
553 /* begin with the same */
554 /* character. */
555
556 /* All MARKS begin with */
557 /* one of the characters 20 */
558 /* in the string */
559 /* ' !"#$%&''()*+,-./' */
560
561 /* All MARKS begin with */
562 /* one of the characters 11 */
563 /* in the string */
564 /* ':;<=>?@' */
565
566 /* All MARKS begin with */
567 /* one of the characters 37 */
568 /* in the string */
569 /* ' !"#$%&''()*+,-./:;<=>?@' */
570
571 /* All MARKS begin with */
572 /* an upper case english letter 30 */
573
574 /* All MARKS begin with a */
575 /* decimal digit 14 */
576
577 /* All Marks begin with a */
578 /* lower case english letter 30 */
579
580 /* All Marks begin with */
581 /* a digit or upper case 47 */
582 /* character. */
583
584 /* All Marks begin with a */
585 /* printing character or 100 */
586 /* a blank. */
587
588 /* Anything might be a mark 132 */
589
590 /* Finally, so you won't have to look it up elsewhere */
591 /* here are the ASCII codes for the printing */
592 /* characters and blanks. */
593
594 /* (Common Punctuations) Character ASCII Code */
595 /* ----------- ---------- */
596 /* ' ' (space) 32 */
597 /* '!' 33 */
598 /* '"' 34 */
599 /* '#' 35 */
600 /* '$' 36 */
601 /* '%' 37 */
602 /* '&' 38 */
603 /* '''' 39 */
604 /* '(' 40 */
605 /* ')' 41 */
606 /* '*' 42 */
607 /* '+' 43 */
608 /* ',' 44 */
609 /* '-' 45 */
610 /* '.' 46 */
611 /* '/' 47 */
612
613
614 /* (Decimal Digits) Character ASCII Code */
615 /* ----------- ---------- */
616 /* '0' 48 */
617 /* '1' 49 */
618 /* '2' 50 */
619 /* '3' 51 */
620 /* '4' 52 */
621 /* '5' 53 */
622 /* '6' 54 */
623 /* '7' 55 */
624 /* '8' 56 */
625 /* '9' 57 */
626
627 /* (More punctuation) Character ASCII Code */
628 /* ----------- ---------- */
629 /* ':' 58 */
630 /* ';' 59 */
631 /* '<' 60 */
632 /* '=' 61 */
633 /* '>' 62 */
634 /* '?' 63 */
635 /* '@' 64 */
636
637 /* (Uppercase characters) Character ASCII Code */
638 /* ----------- ---------- */
639 /* 'A' 65 */
640 /* 'B' 66 */
641 /* 'C' 67 */
642 /* 'D' 68 */
643 /* 'E' 69 */
644 /* 'F' 70 */
645 /* 'G' 71 */
646 /* 'H' 72 */
647 /* 'I' 73 */
648 /* 'J' 74 */
649 /* 'K' 75 */
650 /* 'L' 76 */
651 /* 'M' 77 */
652 /* 'N' 78 */
653 /* 'O' 79 */
654 /* 'P' 80 */
655 /* 'Q' 81 */
656 /* 'R' 82 */
657 /* 'S' 83 */
658 /* 'T' 84 */
659 /* 'U' 85 */
660 /* 'V' 86 */
661 /* 'W' 87 */
662 /* 'X' 88 */
663 /* 'Y' 89 */
664 /* 'Z' 90 */
665
666 /* (More punctuation) Character ASCII Code */
667 /* ----------- ---------- */
668 /* '[' 91 */
669 /* '\' 92 */
670 /* ']' 93 */
671 /* '^' 94 */
672 /* '_' 95 */
673 /* '`' 96 */
674
675 /* (Lowercase characters) Character ASCII Code */
676 /* ----------- ---------- */
677 /* 'a' 97 */
678 /* 'b' 98 */
679 /* 'c' 99 */
680 /* 'd' 100 */
681 /* 'e' 101 */
682 /* 'f' 102 */
683 /* 'g' 103 */
684 /* 'h' 104 */
685 /* 'i' 105 */
686 /* 'j' 106 */
687 /* 'k' 107 */
688 /* 'l' 108 */
689 /* 'm' 109 */
690 /* 'n' 110 */
691 /* 'o' 111 */
692 /* 'p' 112 */
693 /* 'q' 113 */
694 /* 'r' 114 */
695 /* 's' 115 */
696 /* 't' 116 */
697 /* 'u' 117 */
698 /* 'v' 118 */
699 /* 'w' 119 */
700 /* 'x' 120 */
701 /* 'y' 121 */
702 /* 'z' 122 */
703
704 /* (More punctuation) Character ASCII Code */
705 /* ----------- ---------- */
706 /* '{' 123 */
707 /* '|' 124 */
708 /* '}' 125 */
709 /* '~' 126 */
710 /* $ Parameters */
711
712 /* None. */
713
714 /* $ Exceptions */
715
716 /* Error Free. */
717
718 /* 1) A space is regarded as a special mark. If MARKS(I) = ' ', */
719 /* then MARKS(I) will match any consecutive sequence of blanks. */
720
721 /* 2) If NMARKS is less than or equal to zero, SCAN will always */
722 /* find a single token, namely the entire string to be scanned. */
723
724 /* $ Files */
725
726 /* None. */
727
728 /* $ Particulars */
729
730 /* This routine prepares the arrays MARKS, MRKLEN and PNTERS */
731 /* so that they are suitable for input to the routine SCAN. */
732
733 /* It is expected that users will need to scan many strings */
734 /* and that from the programming point of view it is */
735 /* easiest to simply supply a list of MARKS to a "formatting" */
736 /* routine such as this so that the strings can then */
737 /* be efficiently scanned by the routine SCAN. This formatting */
738 /* is the function of this routine. */
739
740 /* $ Examples */
741
742 /* Suppose you need to identify all of the words within a string */
743 /* and wish to ignore punctuation marks such as ' ', ',', ':', ';' */
744 /* '---'. Then the first step is to load the array of marks as */
745 /* shown here: */
746
747 /* The minimum ASCII code for the first character of a marker is */
748 /* 32 (for ' '). */
749
750 /* INTEGER FCHAR */
751 /* PARAMETER ( FCHAR = 32 ) */
752
753 /* The maximum ASCII code for the first character of a marker is */
754 /* 59 (for ';'). */
755
756 /* INTEGER LCHAR */
757 /* PARAMETER ( LCHAR = 59 ) */
758
759
760 /* The proper size to declare PNTERS is given by the parameter */
761 /* RCHAR defined in terms of LCHAR and FCHAR. */
762
763 /* INTEGER RCHAR */
764 /* PARAMETER ( RCHAR = LCHAR - FCHAR + 5 ) */
765
766 /* LOGICAL FIRST */
767 /* CHARACTER*(4) MARKS */
768 /* INTEGER NMARKS ( 5 ) */
769 /* INTEGER MRKLEN ( 5 ) */
770 /* INTEGER PNTERS ( RCHAR ) */
771
772 /* SAVE FIRST */
773 /* SAVE MARKS */
774 /* SAVE MRKLEN */
775 /* SAVE PNTERS */
776
777 /* IF ( FIRST ) THEN */
778
779 /* FIRST = .FALSE. */
780
781 /* MARKS(1) = ' ' */
782 /* MARKS(2) = '---' */
783 /* MARKS(3) = ':' */
784 /* MARKS(4) = ',' */
785 /* MARKS(5) = ';' */
786
787 /* NMARKS = 5 */
788
789 /* CALL SCANPR ( NMARKS, MARKS, MRKLEN, PNTERS ) */
790
791 /* END IF */
792
793 /* Notice that the call to SCANPR is nested inside an */
794 /* IF ( FIRST ) THEN ... END IF block. In this and many applications */
795 /* the marks that will used in the scan are fixed. Since the marks */
796 /* are not changing, you need to process MARKS and set up */
797 /* the auxiliary arrays MRKLEN and PNTERS only once (assuming that */
798 /* you SAVE the appropriate variables as has been done above). */
799 /* In this way if the code is executed many times, there is only */
800 /* a small overhead required for preparing the data so that it */
801 /* can be used efficiently in scanning. */
802
803
804 /* $ Restrictions */
805
806 /* MRKLEN and PNTERS must be declared to be at least as large */
807 /* as indicated above. If not, this routine will write */
808 /* past the ends of these arrays. Much unpleasantness may */
809 /* ensue in the attempt to debug such problems. */
810
811 /* $ Literature_References */
812
813 /* None. */
814
815 /* $ Author_and_Institution */
816
817 /* W.L. Taber (JPL) */
818
819 /* $ Version */
820
821 /* - Spicelib Version 1.0.0, 26-JUL-1996 (WLT) */
822
823 /* -& */
824 /* $ Index_Entries */
825
826 /* Prepare for scanning strings */
827 /* Prepare for parsing strings */
828
829 /* -& */
830
831 /* We handle the case where NMARKS is non-positive separately. */
832
833 if (*nmarks <= 0) {
834 pnters[0] = 0;
835 pnters[1] = 0;
836 pnters[2] = 0;
837 pnters[3] = 0;
838 pnters[4] = 0;
839 return 0;
840 }
841
842 /* First left justify MARKS and remove duplicates. */
843
844 i__1 = *nmarks;
845 for (i__ = 1; i__ <= i__1; ++i__) {
846 ljust_(marks + (i__ - 1) * marks_len, marks + (i__ - 1) * marks_len,
847 marks_len, marks_len);
848 }
849 n = *nmarks;
850
851 /* Sort and remove duplicates from the array MARKS. */
852
853 rmdupc_(&n, marks, marks_len);
854
855 /* All of the MARKS have the same declared length. */
856 /* However, since all of your marks may not have */
857 /* the same intended length (for example '*' and */
858 /* '**') it is desirable to be able to specify */
859 /* how much of MARKS(I) should actually be used */
860 /* when examining STRING for a substring match. */
861 /* This is done with the array MRKLEN. */
862 /* MARKS(I)(1:MRKLEN(I)) will be used when */
863 /* scanning STRING. */
864
865 /* Here is the expected structure of PNTERS. */
866
867 /* PNTERS(1) = MIN ( ICHAR(MARKS(I)(1:1) ), I=1,NMARKS ) */
868 /* PNTERS(2) = MAX ( ICHAR(MARKS(I)(1:1) ), I=1,NMARKS ) */
869
870 /* For ease of further discussion let */
871 /* MYCHAR(I) represent the characters from PNTERS(1) */
872 /* to PNTERS(2), and assume that legitimate values of */
873 /* I are from 1 to M. */
874
875 /* PNTERS(3) = 0 */
876 /* PNTERS(4) = index of the last entry of MARKS */
877 /* that begins with the character */
878 /* MYCHAR(1). */
879
880 /* PNTERS(5) = index of the last entry of MARKS */
881 /* that begins with the character */
882 /* MYCHAR(2), if there is no such element */
883 /* of MARKS let PNTERS(5) = PNTERS(4) */
884 /* . */
885 /* . */
886 /* . */
887
888 /* PNTERS(3+K) = index of the last entry of MARKS */
889 /* that begins with the character */
890 /* MYCHAR(K), if there is no such element */
891 /* of MARKS, let PNTERS(3+K) = */
892 /* PNTERS(3+K-1) */
893 /* . */
894 /* . */
895 /* . */
896
897 /* PNTERS(3+M) = index of the last entry of MARKS */
898 /* that begins with the character */
899 /* MYCHAR(M). */
900
901 /* PNTERS(4+M) = PNTERS(3+M) */
902
903
904
905 /* Next determine the minimum and maximum ASCII values */
906 /* of the first characters of the MARKS. */
907
908 fchar = *(unsigned char *)&marks[0];
909 lchar = *(unsigned char *)&marks[(n - 1) * marks_len];
910 pnters[0] = fchar;
911 pnters[1] = lchar;
912
913 /* For the purposes of getting started, we will say the last */
914 /* character that started a MARK was one before FCHAR. We */
915 /* will record the end of its block in slot 3 of PNTERS. */
916
917 last1 = fchar - 1;
918 slot = 3;
919 i__1 = n;
920 for (i__ = 1; i__ <= i__1; ++i__) {
921 mrklen[i__ - 1] = rtrim_(marks + (i__ - 1) * marks_len, marks_len);
922 this1 = *(unsigned char *)&marks[(i__ - 1) * marks_len];
923 if (this1 != last1) {
924
925 /* We need to record the address of the end of the last */
926 /* block of MARKS that began with the same character. */
927 /* This is of course one before the current value of I. */
928
929 /* While we are at it, we might as well determine how */
930 /* many possible first letters were "jumped" over in */
931 /* going from the last first character to the current */
932 /* first character. */
933
934 eblock = i__ - 1;
935 jump = this1 - last1;
936
937 /* The end of the block for all of the MARKS having */
938 /* first character between the last one and this one */
939 /* is the same. */
940
941 i__2 = slot + jump - 1;
942 for (j = slot; j <= i__2; ++j) {
943 pnters[j - 1] = eblock;
944 }
945 slot += jump;
946 last1 = this1;
947 }
948 }
949 pnters[slot - 1] = n;
950 pnters[slot] = n;
951 *nmarks = n;
952 return 0;
953 /* $Procedure SCAN ( Scan a string for tokens ) */
954
955 L_scan:
956 /* $ Abstract */
957
958 /* This routine scans a string returning the beginning and */
959 /* ends of recognized and unrecognized substrings. The full */
960 /* collection of these substrings partitions the string. */
961
962 /* $ Disclaimer */
963
964 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
965 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
966 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
967 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
968 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
969 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
970 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
971 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
972 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
973 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
974
975 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
976 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
977 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
978 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
979 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
980 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
981
982 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
983 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
984 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
985 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
986
987 /* $ Required_Reading */
988
989 /* None. */
990
991 /* $ Keywords */
992
993 /* PARSING */
994
995 /* $ Declarations */
996
997 /* CHARACTER*(*) STRING */
998 /* CHARACTER*(*) MARKS ( * ) */
999 /* INTEGER MRKLEN ( * ) */
1000 /* INTEGER PNTERS ( * ) */
1001 /* INTEGER ROOM */
1002 /* INTEGER START */
1003 /* INTEGER NTOKNS */
1004 /* INTEGER BEG ( * ) */
1005 /* INTEGER END ( * ) */
1006 /* INTEGER IDENT ( * ) */
1007
1008 /* $ Brief_I/O */
1009
1010 /* Variable I/O Description */
1011 /* -------- --- -------------------------------------------------- */
1012 /* STRING I string to be scanned. */
1013 /* MARKS I recognizable substrings. */
1014 /* MRKLEN I an auxiliary array describing MARKS. */
1015 /* PNTERS I an auxiliary array describing MARKS. */
1016 /* ROOM I space available for storing substring descriptions. */
1017 /* START I/O position from which to begin/resume scanning. */
1018 /* NTOKNS O number of scanned substrings. */
1019 /* BEG O beginnings of scanned substrings. */
1020 /* END O endings of scanned substrings. */
1021 /* IDENT O position of scanned substring within array MARKS. */
1022
1023 /* $ Detailed_Input */
1024
1025 /* STRING is any character string that is to be scanned */
1026 /* to locate recognized and unrecognized substrings. */
1027
1028 /* MARKS is an array of marks that will be recognized */
1029 /* by the scanning routine. This array must be prepared */
1030 /* by calling the routine SCANPR. */
1031
1032 /* Note that the blank string is interpreted */
1033 /* in a special way by SCAN. If the blank character, */
1034 /* ' ', is one of the MARKS, it will match any unbroken */
1035 /* sequence of blanks in string. Thus if ' ' is the only */
1036 /* marks supplied and STRING is */
1037
1038 /* 'A lot of space ' */
1039 /* ...................... */
1040
1041 /* Then scan will locate the following substrings */
1042
1043 /* 'A' STRING(1:1) (unrecognized) */
1044 /* ' ' STRING(2:4) (recognized --- all blanks) */
1045 /* 'lot' STRING(5:7) (unrecognized) */
1046 /* ' ' STRING(8:8) (recognized --- a blank) */
1047 /* 'of' STRING(9:10) (unrecognized) */
1048 /* ' ' STRING(11:16) (recognized --- all blanks) */
1049 /* 'space' STRING(17:21) (unrecognized) */
1050 /* ' ' STRING(22:22) (recognized --- a blank) */
1051
1052 /* MRKLEN is an auxiliary array populated by SCANPR */
1053 /* for use by SCAN. It should be declared with */
1054 /* length equal to the length of MARKS. It must */
1055 /* be prepared for use by the routine SCANPR. */
1056
1057 /* PNTERS is a specially structured array of integers that */
1058 /* describes the array MARKS. It is must be filled */
1059 /* in by the routine SCANPR. It should be declared */
1060 /* by the calling program as shown here: */
1061
1062 /* INTEGER PNTERS ( RCHARS ) */
1063
1064 /* RCHARS is given by the expression */
1065
1066 /* MAX - MIN + 5 */
1067
1068 /* where */
1069
1070 /* MAX is the maximum value of ICHAR(MARKS(I)(1:1)) */
1071 /* over the range I = 1, NMARKS */
1072
1073 /* MIN is the minimum value of ICHAR(MARKS(I)(1:1)) */
1074 /* over the range I = 1, NMARKS */
1075
1076 /* See SCANPR for a more detailed description of the */
1077 /* declaration of PNTERS. */
1078
1079 /* ROOM is the amount of space available for storing the */
1080 /* results of scanning the string. */
1081
1082 /* START is the position from which scanning should commence. */
1083 /* Values of START less than 1 are treated as 1. */
1084
1085 /* $ Detailed_Output */
1086
1087 /* START is the position from which scanning should continue */
1088 /* in order to fully scan STRING (if sufficient memory was */
1089 /* not provided in BEG, END, and IDENT on the current */
1090 /* call to SCAN). */
1091
1092 /* NTOKNS is the number of substrings identified in the current */
1093 /* scan of STRING. */
1094
1095 /* BEG Beginnings of scanned substrings. This should be */
1096 /* declared so that it is at least as large as ROOM. */
1097
1098 /* END Endings of scanned substrings. This should be declared */
1099 /* so that it is at least as large as ROOM. */
1100
1101 /* IDENT Positions of scanned substring within array MARKS. */
1102 /* If the substring STRING(BEG(I):END(I)) is in the array */
1103 /* MARKS, then MARKS(IDENT(I)) will equal */
1104 /* STRING(BEG(I):END(I)). */
1105
1106 /* If the substring STRING(BEG(I):END(I)) is not in the */
1107 /* list of MARKS then IDENT(I) will have the value 0. */
1108
1109 /* IDENT should be declared so that it can contain at least */
1110 /* ROOM integers. */
1111
1112 /* $ Parameters */
1113
1114 /* None. */
1115
1116 /* $ Exceptions */
1117
1118 /* Error Free. */
1119
1120 /* 1) A space is regarded as a special mark. If MARKS(I) = ' ', */
1121 /* then MARKS(I) will match any consecutive sequence of blanks. */
1122
1123 /* 2) If START is less than 1 on input, it will be treated as */
1124 /* if it were 1. */
1125
1126 /* 3) If START is greater than the length of the string, no */
1127 /* tokens will be found and the value of START will return */
1128 /* unchanged. */
1129
1130 /* $ Files */
1131
1132 /* None. */
1133
1134 /* $ Particulars */
1135
1136 /* This routine allows you to scan a string and partition it into */
1137 /* recognized and unrecognized substrings. */
1138
1139 /* For some applications the recognized substrings serve only as */
1140 /* delimiters between the portions of the string */
1141 /* that are of interest to your application. For other */
1142 /* applications the recognized substrings are equally important as */
1143 /* they may indicate operations that are to be performed on the */
1144 /* unrecognized portions of the string. However, the techniques */
1145 /* required to scan the string are the same in both instances. The */
1146 /* examples below illustrate some common situations. */
1147
1148 /* $ Examples */
1149
1150 /* Example 1. */
1151 /* ---------- */
1152
1153 /* Suppose you wished to write a routine that would return the words */
1154 /* of a string. The following routine shows how SCANPR and SCAN can */
1155 /* be used to accomplish this task. */
1156
1157 /* SUBROUTINE GETWDS ( STRING, WDROOM, NWORDS, WORDS ) */
1158
1159 /* CHARACTER*(*) STRING */
1160 /* INTEGER WDROOM */
1161 /* INTEGER NWORDS */
1162 /* CHARACTER*(*) WORDS ( * ) */
1163
1164
1165 /* CHARACTER*(1) MARKS ( 1 ) */
1166 /* INTEGER MRKLEN ( 1 ) */
1167 /* INTEGER PNTERS ( 5 ) */
1168
1169 /* INTEGER ROOM */
1170 /* PARAMETER ( ROOM = 50 ) */
1171
1172 /* INTEGER BEG ( ROOM ) */
1173 /* INTEGER END ( ROOM ) */
1174 /* INTEGER I */
1175 /* INTEGER IDENT ( ROOM ) */
1176 /* INTEGER NMARKS */
1177 /* INTEGER NTOKNS */
1178 /* INTEGER START */
1179
1180 /* LOGICAL FIRST */
1181 /* SAVE FIRST */
1182 /* DATA FIRST / .TRUE. / */
1183
1184
1185 /* On the first time through the routine, set up the MARKS */
1186 /* MRKLEN, and PNTERS arrays. */
1187
1188 /* IF( FIRST ) THEN */
1189
1190 /* FIRST = .FALSE. */
1191 /* MARKS(1) = ' ' */
1192 /* NMARKS = 1 */
1193
1194 /* CALL SCANPR ( NMARKS, MARKS, MRKLEN, PNTERS ) */
1195
1196 /* END IF */
1197
1198 /* Now simply scan the input string for words until we have */
1199 /* them all or until we run out of room. */
1200
1201 /* START = 1 */
1202 /* NWORDS = 0 */
1203
1204 /* CALL SCAN ( STRING, */
1205 /* MARKS, MRKLEN, PNTERS, ROOM, START, */
1206 /* NTOKNS, IDENT, BEG, END ) */
1207
1208 /* If we found something in our scan, copy the substrings into the */
1209 /* words array. */
1210
1211 /* DO WHILE ( ( NWORDS .LT. WDROOM ) */
1212 /* . .AND. ( NTOKNS .GT. 0 ) ) */
1213
1214
1215 /* Step through the scanned substrings, looking for those */
1216 /* that are not blank ... */
1217
1218 /* I = 1 */
1219
1220 /* DO WHILE ( ( NWORDS .LT. WDROOM ) */
1221 /* . .AND. ( I .LE. NTOKNS ) ) */
1222
1223 /* Copy the non-blank substrings (those unidentified by */
1224 /* SCAN) into WORDS. */
1225
1226 /* IF ( IDENT(I) .EQ. 0 ) THEN */
1227 /* NWORDS = NWORDS + 1 */
1228 /* WORDS(NWORDS) = STRING(BEG(I):END(I)) */
1229 /* END IF */
1230
1231 /* I = I + 1 */
1232
1233 /* END DO */
1234
1235
1236 /* Scan the STRING again for any substrings that might */
1237 /* remain. Note that START is already pointing at the */
1238 /* point in the string from which to resume scanning. */
1239
1240 /* CALL SCAN ( STRING, */
1241 /* MARKS, MRKLEN, PNTERS, ROOM, START, */
1242 /* NTOKNS, IDENT, BEG, END ) */
1243 /* END DO */
1244
1245 /* That's all, we've got all the substrings there were (or */
1246 /* that we had room for). */
1247
1248 /* RETURN */
1249
1250
1251 /* Example 2. */
1252 /* ---------- */
1253
1254 /* To parse an algebraic expression such as */
1255
1256 /* ( X + Y ) * ( 2*Z + SIN(W) ) ** 2 */
1257
1258 /* You would select '**', '*', '+', '-', '(', ')' and ' ' */
1259 /* to be the markers. Note that all of these begin with one */
1260 /* of the characters in the string ' !"#$%&''()*+,-./' */
1261 /* so that we can declare PNTERS to have length 20. */
1262
1263 /* Prepare the MARKS, MRKLEN, and PNTERS. */
1264
1265 /* CHARACTER*(4) MARKS */
1266 /* INTEGER NMARKS ( 8 ) */
1267 /* INTEGER MRKLEN ( 8 ) */
1268 /* INTEGER PNTERS ( 20 ) */
1269
1270 /* INTEGER ROOM */
1271 /* PARAMETER ( ROOM = 20 ) */
1272
1273 /* INTEGER NTOKNS */
1274 /* INTEGER BEG ( ROOM ) */
1275 /* INTEGER END ( ROOM ) */
1276 /* INTEGER IDENT ( ROOM ) */
1277
1278 /* LOGICAL FIRST */
1279 /* SAVE FIRST */
1280 /* SAVE MARKS */
1281 /* SAVE MRKLEN */
1282 /* SAVE PNTERS */
1283
1284 /* DATA FIRST / .TRUE. / */
1285
1286 /* IF ( FIRST ) THEN */
1287
1288 /* MARKS(1) = '(' */
1289 /* MARKS(2) = ')' */
1290 /* MARKS(3) = '+' */
1291 /* MARKS(4) = '-' */
1292 /* MARKS(5) = '*' */
1293 /* MARKS(6) = '/' */
1294 /* MARKS(7) = '**' */
1295 /* MARKS(8) = ' ' */
1296
1297 /* NMARKS = 8 */
1298
1299 /* CALL SCANPR ( NMARKS, MARKS, MRKLEN, PNTERS ) */
1300
1301 /* BLANK = BSRCHC ( ' ', NMARKS, MARKS ) */
1302
1303 /* END IF */
1304
1305
1306 /* Once all of the initializations are out of the way, */
1307 /* we can scan an input string. */
1308
1309 /* CALL SCAN ( STRING, MARKS, MRKLEN, PNTERS, ROOM, */
1310 /* . START, NTOKNS, IDENT, BEG, END ) */
1311
1312
1313 /* Next eliminate any white space that was returned in the */
1314 /* list of tokens. */
1315
1316 /* KEPT = 0 */
1317
1318 /* DO I = 1, NTOKNS */
1319
1320 /* IF ( IDENT(I) .NE. BLANK ) THEN */
1321
1322 /* KEPT = KEPT + 1 */
1323 /* BEG (KEPT) = BEG(I) */
1324 /* END (KEPT) = END(I) */
1325 /* IDENT(KEPT) = IDENT(I) */
1326
1327 /* END IF */
1328
1329 /* END DO */
1330
1331 /* Now all of the substrings remaining point to grouping symbols, */
1332 /* operators, functions, or variables. Given that the individual */
1333 /* "words" of the expression are now in hand, the meaning of the */
1334 /* expression is much easier to determine. */
1335
1336 /* The rest of the routine is left as a non-trivial exercise */
1337 /* for the reader. */
1338
1339 /* $ Restrictions */
1340
1341 /* The arrays MARKS, MRKLEN, and PNTERS must be prepared by the */
1342 /* routine SCANPR prior to supplying them for use by SCAN. */
1343
1344 /* $ Literature_References */
1345
1346 /* None. */
1347
1348 /* $ Author_and_Institution */
1349
1350 /* W.L. Taber (JPL) */
1351
1352 /* $ Version */
1353
1354 /* - SPICELIB Version 1.0.0, 26-JUL-1996 (WLT) */
1355
1356 /* -& */
1357 /* $ Index_Entries */
1358
1359 /* Scan a string for recognized and unrecognized tokens */
1360 /* Parse a string */
1361
1362 /* -& */
1363
1364 /* All of the MARKS have the same declared length. */
1365 /* However, since all of your marks may not have */
1366 /* the same intended length (for example '*' and */
1367 /* '**') it is desirable to be able to specify */
1368 /* how much of MARKS(I) should actually be used */
1369 /* when examining STRING for a substring match. */
1370 /* This is done with the array MRKLEN. */
1371 /* MARKS(I)(1:MRKLEN(I)) will be used when */
1372 /* scanning STRING. */
1373
1374 /* Here is the expected structure of PNTERS. */
1375
1376 /* PNTERS(1) = MIN ( ICHAR(MARKS(I)(1:1) ) */
1377 /* PNTERS(2) = MAX ( ICHAR(MARKS(I)(1:1) ) */
1378
1379 /* where I ranges from 1 to the number of MARKS stored */
1380 /* in MARKS. For ease of further discussion let */
1381 /* MYCHAR(I) represent the characters from PNTERS(1) */
1382 /* to PNTERS(2), and assume that legitimate values of */
1383 /* I are from 1 to N. */
1384
1385 /* PNTERS(3) = 0 */
1386 /* PNTERS(4) = index of the last entry of MARKS */
1387 /* that begins with the character */
1388 /* MYCHAR(1). */
1389
1390 /* PNTERS(5) = index of the last entry of MARKS */
1391 /* that begins with the character */
1392 /* MYCHAR(2), if there is no such element */
1393 /* of MARKS let PNTERS(5) = PNTERS(4) */
1394 /* . */
1395 /* . */
1396 /* . */
1397
1398 /* PNTERS(3+K) = index of the last entry of MARKS */
1399 /* that begins with the character */
1400 /* MYCHAR(K), if there is no such element */
1401 /* of MARKS, let PNTERS(3+K) = */
1402 /* PNTERS(3+K-1) */
1403 /* . */
1404 /* . */
1405 /* . */
1406
1407 /* PNTERS(3+N) = index of the last entry of MARKS */
1408 /* that begins with the character */
1409 /* MYCHAR(N). */
1410
1411 /* PNTERS(4+N) = PNTERS(3+N) */
1412
1413
1414 /* Get the information concerning the range of the */
1415 /* marks from the PNTERS array. */
1416
1417 offset = pnters[0] - 4;
1418 lbound = pnters[0] - 1;
1419 ubound = pnters[1] + 1;
1420 last = i_len(string, string_len);
1421 *ntokns = 0;
1422 backup = *start - 1;
1423 known = TRUE_;
1424 *start = max(1,*start);
1425 while(*start <= last) {
1426
1427 /* Get the numeric code for this letter, and look up */
1428 /* the range of markers that begin with this letter. */
1429
1430 *(unsigned char *)letter = *(unsigned char *)&string[*start - 1];
1431 /* Computing MAX */
1432 /* Computing MIN */
1433 i__3 = *(unsigned char *)letter;
1434 i__1 = lbound, i__2 = min(i__3,ubound);
1435 intval = max(i__1,i__2);
1436 test = pnters[intval - offset - 1];
1437 finish = pnters[intval - offset - 2];
1438 equal = FALSE_;
1439
1440 /* If TEST is greater than FINISH, then there is a range of */
1441 /* markers that start with this letter. */
1442
1443 while(test > finish) {
1444
1445 /* Look up the length of the next marker to test for */
1446 /* and compute where it would end in STRING if there */
1447 /* is a match. */
1448
1449 l = mrklen[test - 1];
1450 stop = backup + l;
1451
1452 /* Make sure that we are not going to violate any substring */
1453 /* references when we compare the current candidate mark with */
1454 /* the substring having the same length and starting at START. */
1455
1456 if (stop > last) {
1457 --test;
1458 } else {
1459
1460 /* OK. The substring reference STRING(START:STOP) is */
1461 /* legal. See if it is equal to the current test mark. */
1462
1463 equal = s_cmp(marks + (test - 1) * marks_len, string + (*
1464 start - 1), l, stop - (*start - 1)) == 0;
1465
1466 /* If it isn't equal, just set up to test the next mark. */
1467
1468 if (! equal) {
1469 --test;
1470 } else {
1471
1472 /* If we were in the middle of an unrecognized string */
1473 /* then, we need to check whether or not we have room */
1474 /* to identify another token. If we don't we must return */
1475 /* now. */
1476
1477 if (! known && *ntokns == *room) {
1478 return 0;
1479 }
1480
1481 /* A space is a special kind of mark. All white space */
1482 /* is regarded as being the same. If the current mark */
1483 /* is a space, we need to collect all of the consecutive */
1484 /* blanks beginning with the one at the START position. */
1485
1486 if (s_cmp(marks + (test - 1) * marks_len, " ", marks_len,
1487 (ftnlen)1) == 0) {
1488 stop = ncpos_(string, " ", start, string_len, (ftnlen)
1489 1) - 1;
1490 if (stop < 0) {
1491 stop = last;
1492 }
1493 }
1494
1495 /* Ok. We have a new known token. */
1496
1497 /* 1) Record its begin, end, and identity. */
1498
1499 /* 2) Set TEST to FINISH so that the loop will end. */
1500
1501 /* 3) Set START to the current STOP so that later when */
1502 /* we add 1, START will point to the beginning */
1503 /* of the remainder of the string that needs to be */
1504 /* scanned. */
1505
1506 known = TRUE_;
1507 ++(*ntokns);
1508 beg[*ntokns - 1] = *start;
1509 end[*ntokns - 1] = stop;
1510 ident[*ntokns - 1] = test;
1511 test = finish;
1512 *start = stop;
1513
1514 /* If we have just used up all available room, */
1515 /* position START so that we will be ready */
1516 /* to continue scanning on a subsequent call */
1517 /* and return. */
1518
1519 if (*ntokns == *room) {
1520 ++(*start);
1521 return 0;
1522 }
1523 }
1524 }
1525 }
1526
1527 /* If none of the markers matched a substring starting at */
1528 /* the current position, we are beginning or continuing */
1529 /* an unrecognized substring. */
1530
1531 if (! equal) {
1532
1533 /* If we are already in the middle of an unrecognized */
1534 /* substring, just extend our current unrecognized string. */
1535
1536 if (! known) {
1537 end[*ntokns - 1] = *start;
1538
1539 /* Otherwise, start up a new unrecognized substring. */
1540
1541 } else {
1542 ++(*ntokns);
1543 beg[*ntokns - 1] = *start;
1544 end[*ntokns - 1] = *start;
1545 ident[*ntokns - 1] = 0;
1546 known = FALSE_;
1547 }
1548 }
1549 backup = *start;
1550 ++(*start);
1551 }
1552 return 0;
1553 } /* scanit_ */
1554
scanit_(char * string,integer * start,integer * room,integer * nmarks,char * marks,integer * mrklen,integer * pnters,integer * ntokns,integer * ident,integer * beg,integer * end,ftnlen string_len,ftnlen marks_len)1555 /* Subroutine */ int scanit_(char *string, integer *start, integer *room,
1556 integer *nmarks, char *marks, integer *mrklen, integer *pnters,
1557 integer *ntokns, integer *ident, integer *beg, integer *end, ftnlen
1558 string_len, ftnlen marks_len)
1559 {
1560 return scanit_0_(0, string, start, room, nmarks, marks, mrklen, pnters,
1561 ntokns, ident, beg, end, string_len, marks_len);
1562 }
1563
scanpr_(integer * nmarks,char * marks,integer * mrklen,integer * pnters,ftnlen marks_len)1564 /* Subroutine */ int scanpr_(integer *nmarks, char *marks, integer *mrklen,
1565 integer *pnters, ftnlen marks_len)
1566 {
1567 return scanit_0_(1, (char *)0, (integer *)0, (integer *)0, nmarks, marks,
1568 mrklen, pnters, (integer *)0, (integer *)0, (integer *)0, (
1569 integer *)0, (ftnint)0, marks_len);
1570 }
1571
scan_(char * string,char * marks,integer * mrklen,integer * pnters,integer * room,integer * start,integer * ntokns,integer * ident,integer * beg,integer * end,ftnlen string_len,ftnlen marks_len)1572 /* Subroutine */ int scan_(char *string, char *marks, integer *mrklen,
1573 integer *pnters, integer *room, integer *start, integer *ntokns,
1574 integer *ident, integer *beg, integer *end, ftnlen string_len, ftnlen
1575 marks_len)
1576 {
1577 return scanit_0_(2, string, start, room, (integer *)0, marks, mrklen,
1578 pnters, ntokns, ident, beg, end, string_len, marks_len);
1579 }
1580
1581