1 /* lxname.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 /* Table of constant values */
9
10 static integer c__255 = 255;
11 static integer c__0 = 0;
12
13 /* $Procedure LXNAME ( Lex names ) */
lxname_0_(int n__,char * hdchrs,char * tlchrs,char * string,integer * first,integer * last,integer * idspec,integer * nchar,ftnlen hdchrs_len,ftnlen tlchrs_len,ftnlen string_len)14 /* Subroutine */ int lxname_0_(int n__, char *hdchrs, char *tlchrs, char *
15 string, integer *first, integer *last, integer *idspec, integer *
16 nchar, ftnlen hdchrs_len, ftnlen tlchrs_len, ftnlen string_len)
17 {
18 /* System generated locals */
19 integer i__1, i__2;
20
21 /* Builtin functions */
22 integer s_rnge(char *, integer, char *, integer);
23
24 /* Local variables */
25 integer c__, headc[261], i__, l, nhead;
26 extern integer cardi_(integer *);
27 integer tailc[261];
28 extern /* Subroutine */ int chkin_(char *, ftnlen);
29 integer ntail, tcpos;
30 extern integer rtrim_(char *, ftnlen);
31 integer hl, tl;
32 extern /* Subroutine */ int scardi_(integer *, integer *), validi_(
33 integer *, integer *, integer *);
34 extern integer bsrchi_(integer *, integer *, integer *);
35 extern /* Subroutine */ int appndi_(integer *, integer *), sigerr_(char *,
36 ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen),
37 errint_(char *, integer *, ftnlen), ssizei_(integer *, integer *),
38 insrti_(integer *, integer *);
39 extern logical return_(void);
40
41 /* $ Abstract */
42
43 /* Umbrella routine for name scanning entry points. */
44
45 /* $ Disclaimer */
46
47 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
48 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
49 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
50 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
51 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
52 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
53 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
54 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
55 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
56 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
57
58 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
59 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
60 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
61 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
62 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
63 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
64
65 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
66 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
67 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
68 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
69
70 /* $ Required_Reading */
71
72 /* None. */
73
74 /* $ Keywords */
75
76 /* CHARACTER */
77 /* PARSING */
78 /* SCANNING */
79 /* STRING */
80 /* UTILITY */
81
82 /* $ Declarations */
83 /* $ Brief_I/O */
84
85 /* Variable I/O Entry points */
86 /* -------- --- -------------------------------------------------- */
87 /* HDCHRS I LXCSID */
88 /* TLCHRS I LXCSID */
89 /* STRING I LXIDNT */
90 /* FIRST I LXIDNT */
91 /* IDSPEC I-O LXDFID, LXCSID, LXIDNT */
92 /* LAST O LXIDNT */
93 /* NCHAR O LXIDNT */
94 /* MXSPEC P LXDFID, LXCSID */
95 /* LBCELL P LXIDNT, LXDFID, LXCSID */
96
97 /* $ Detailed_Input */
98
99 /* See the entry points for descriptions of their inputs. */
100
101 /* $ Detailed_Output */
102
103 /* See the entry points for descriptions of their outputs. */
104
105 /* $ Parameters */
106
107 /* See the entry points for descriptions of their parameters. */
108
109 /* $ Exceptions */
110
111 /* 1) If this routine is called directly, the error */
112 /* SPICE(BOGUSENTRY) is signaled. */
113
114 /* See the entry points for descriptions of the exceptions */
115 /* specific to those entry points. */
116
117 /* $ Files */
118
119 /* None. */
120
121 /* $ Particulars */
122
123 /* Many computer languages include tokens that represent names. */
124 /* Examples of names include procedure names and variable names. */
125 /* The term `identifier' is generally used to indicate this type */
126 /* of token. Rules for constructing identifiers vary from */
127 /* language to language, but identifiers conforming to the */
128 /* following rules are widely recognized: */
129
130 /* 1) The first character of the identifier is a letter. */
131
132 /* 2) The remaining characters are letters or numbers. */
133
134 /* 3) The length of the identifier is less than some specified */
135 /* limit. */
136
137 /* This suite of routines has its own set of default rules for */
138 /* forming identifiers. These rules are somewhat more liberal */
139 /* than those listed above. Rule (1) above still holds, but */
140 /* trailing characters may include letters, numbers, and the */
141 /* special characters */
142
143 /* $ */
144 /* _ (underscore) */
145
146 /* No mechanism for enforcing rule (3) is provided; this task is */
147 /* left to the caller, since this routine would be unnecessarily */
148 /* complicated by the need to construct diagnostic messages. */
149
150 /* The entry point LXIDNT (Lex identifier) recognizes valid */
151 /* identifier tokens, using either the default character sets */
152 /* for the head and tail of the identifier, or character sets */
153 /* specified in the last call to LXCSID. */
154
155 /* In order to use this suite of routines to scan identifiers that */
156 /* conform to the default rules, a program normally calls the entry */
157 /* point LXDFID (Lex, default identifier specification) once to */
158 /* obtain the default `identifier specification'. This specification */
159 /* is an integer array in which the allowed head and tail character */
160 /* sets are specified. This specification is then saved and supplied */
161 /* to the entry point LXIDNT (Lex identifier) whenever LXIDNT is */
162 /* called to scan an identifier. The entry point LXIDNT recognizes */
163 /* valid identifier tokens, using an input identifier specification */
164 /* to decide which head and tail characters are allowed in an */
165 /* identifier. */
166
167 /* The scanning code using these routines might have the following */
168 /* structure: */
169
170
171 /* INTEGER IDSPEC ( LBCELL : MXSPEC ) */
172 /* . */
173 /* . */
174 /* . */
175 /* C */
176 /* C Initialize the identifier specification, using the */
177 /* C default: */
178 /* C */
179 /* CALL SSIZEI ( MXSPEC, IDSPEC ) */
180 /* CALL LXDFID ( IDSPEC ) */
181 /* . */
182 /* . */
183 /* . */
184 /* C */
185 /* C Scan string: */
186 /* C */
187 /* DO WHILE ( <more tokens> ) */
188 /* . */
189 /* . */
190 /* . */
191 /* IF ( <test for identifier> ) THEN */
192
193 /* CALL LXIDNT ( IDSPEC, STRING, FIRST, LAST, NCHARS ) */
194
195 /* IF ( NCHARS .GT. 0 ) THEN */
196
197 /* [Identifier was found--process result] */
198
199 /* ELSE */
200
201 /* [Token at starting at location FIRST was not */
202 /* an identifier--handle alternatives] */
203
204 /* END IF */
205
206 /* ELSE */
207
208 /* [ perform tests for other tokens ] */
209
210 /* END IF */
211
212 /* END DO */
213
214
215 /* It is possible to override the default rules by calling the */
216 /* entry point LXCSID (Lex, custom identifier characters). This */
217 /* routine allows the caller to specify the precise set of */
218 /* characters allowed as the first character (`head') of the */
219 /* identifier, as well as those allowed in the remainder (`tail') */
220 /* of the identifier. */
221
222 /* If a custom identifier specification is desired, the call to */
223 /* LXDFID in the pseudo code above would be replaced by a call to */
224 /* LXCSID. After setting the strings HDCHRS and TLCHRS to contain, */
225 /* respectively, the allowed head and tail identifier characters, the */
226 /* following call would produce an identifier specification structure */
227 /* IDSPEC representing these set of allowed characters. */
228
229 /* CALL LXCSID ( HDCHRS, TLCHRS, IDSPEC ) */
230
231 /* The array IDSPEC obtained from LXCSID would be used as input to */
232 /* LXIDNT, instead of using the array obtained by calling LXDFID. */
233
234 /* $ Examples */
235
236 /* 1) The following table illustrates the behavior of the scanning */
237 /* entry point LXIDNT when the default identifier syntax is in */
238 /* effect: */
239
240 /* STRING CONTENTS FIRST LAST NCHAR */
241 /* ========================================================== */
242 /* WHERE A LT B 1 5 5 */
243 /* WHERE A LT B 7 7 1 */
244 /* WHERE A.LT.B 7 7 1 */
245 /* WHERE (A0)LT(B8) 8 9 2 */
246 /* WHERE A0$LT_B7 7 14 8 */
247 /* WHERE A LT B 12 12 1 */
248 /* WHERE A .LT. B 9 8 0 */
249
250
251 /* 2) The following table illustrates the behavior of the scanning */
252 /* entry point LXIDNT when a custom identifier syntax is used. */
253 /* The call */
254
255 /* CALL LXCSID ( HDCHRS, TLCHRS, IDSPEC ) */
256
257 /* where */
258
259 /* HDCHRS = 'abcdefghijklmnopqrstuvwxyz' */
260
261 /* and */
262
263 /* TLCHRS = 'abcdefghijklmnopqrstuvwxyz012345.' */
264
265 /* will produce an indentifier specification IDSPEC that, */
266 /* when supplied as an input to LXIDNT, will cause LXIDNT */
267 /* to perform in accordance with the table shown below: */
268
269
270 /* STRING CONTENTS FIRST LAST NCHAR */
271 /* ========================================================== */
272 /* WHERE A LT B 1 0 0 */
273 /* where a lt b 1 5 5 */
274 /* WHERE a LT b 7 7 1 */
275 /* WHERE a.LT.b 7 8 2 */
276 /* WHERE (a0)LT(b8) 14 14 1 */
277 /* WHERE (a0)LT(b5) 14 15 2 */
278 /* WHERE a0.lt.b8 7 13 7 */
279 /* WHERE a0$lt_b7 7 8 2 */
280 /* where a .lt. b 9 12 4 */
281
282
283 /* $ Restrictions */
284
285 /* None. */
286
287 /* $ Literature_References */
288
289 /* None. */
290
291 /* $ Author_and_Institution */
292
293 /* N.J. Bachman (JPL) */
294 /* B.V. Semenov (JPL) */
295
296 /* $ Version */
297
298 /* - Beta Version 1.0.1, 10-FEB-2014 (BVS) */
299
300 /* Added LBCELL to the Brief_I/O section. */
301
302 /* - Beta Version 1.0.0, 25-OCT-1995 (NJB) */
303
304 /* -& */
305 /* $ Index_Entries */
306
307 /* scan name tokens --- umbrella */
308
309 /* -& */
310
311 /* SPICELIB functions */
312
313
314 /* Local parameters */
315
316
317 /* IDSPEC parameters: */
318
319
320 /* Local variables */
321
322
323 /* Standard SPICE error handling. */
324
325 switch(n__) {
326 case 1: goto L_lxidnt;
327 case 2: goto L_lxdfid;
328 case 3: goto L_lxcsid;
329 }
330
331 if (return_()) {
332 return 0;
333 } else {
334 chkin_("LXNAME", (ftnlen)6);
335 }
336 sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17);
337 chkout_("LXNAME", (ftnlen)6);
338 return 0;
339 /* $Procedure LXIDNT ( Lex identifer ) */
340
341 L_lxidnt:
342 /* $ Abstract */
343
344 /* Lex (scan) an identifer, starting from a specified character */
345 /* position. */
346
347 /* $ Disclaimer */
348
349 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
350 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
351 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
352 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
353 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
354 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
355 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
356 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
357 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
358 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
359
360 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
361 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
362 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
363 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
364 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
365 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
366
367 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
368 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
369 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
370 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
371
372 /* $ Required_Reading */
373
374 /* None. */
375
376 /* $ Keywords */
377
378 /* CHARACTER */
379 /* PARSING */
380 /* SCANNING */
381 /* STRING */
382 /* UTILITY */
383
384 /* $ Declarations */
385
386 /* INTEGER LBCELL */
387 /* PARAMETER ( LBCELL = -5 ) */
388
389 /* INTEGER IDSPEC ( LBCELL : * ) */
390 /* CHARACTER*(*) STRING */
391 /* INTEGER FIRST */
392 /* INTEGER LAST */
393 /* INTEGER NCHAR */
394
395 /* $ Brief_I/O */
396
397 /* Variable I/O Description */
398 /* -------- --- -------------------------------------------------- */
399 /* IDSPEC I Identifier character specification. */
400 /* STRING I String to be scanned. */
401 /* FIRST I Character position at which to start scanning. */
402 /* LAST O Character position of end of token. */
403 /* NCHAR O Number of characters in token. */
404 /* LBCELL P The SPICELIB cell lower bound. */
405
406 /* $ Detailed_Input */
407
408 /* IDSPEC is an integer cell containing a specification of */
409 /* the head and tail identifier character sets to be */
410 /* used in scanning the input argument STRING. IDSPEC */
411 /* should be obtained by calling LXDFID or LXCSID. */
412 /* The structure of IDSPEC is not part of the */
413 /* specification of this routine suite and should not */
414 /* be relied upon by calling code. */
415
416 /* STRING is a character string that may contain an */
417 /* `identifier' starting at the character position */
418 /* indicated by the input argument FIRST (see */
419 /* below). Identifier tokens are sequences of */
420 /* characters that represent names. Syntactically, an */
421 /* identifier is a sequence of characters that begins */
422 /* with a character belonging to a set of valid `head' */
423 /* characters and is followed by zero or more */
424 /* characters belonging to a set of valid `tail' */
425 /* characters. */
426
427 /* FIRST is the character position at which the routine */
428 /* is to start scanning an identifier. Note */
429 /* that the character STRING(FIRST:FIRST) must be a */
430 /* valid head character if an identifier is to */
431 /* be found; this routine does *not* attempt to locate */
432 /* the first identifier following the position */
433 /* FIRST. */
434
435 /* $ Detailed_Output */
436
437 /* LAST is the last character position such that the */
438 /* substring STRING(FIRST:LAST) is an identifier, if */
439 /* such a substring exists. Otherwise, the */
440 /* returned value of LAST is FIRST-1. */
441
442 /* NCHAR is the length of the identifier found by this */
443 /* routine, if such a token exists. If an identifier */
444 /* is not found, the returned value of NCHAR is */
445 /* zero. */
446
447 /* $ Parameters */
448
449 /* LBCELL is the SPICELIB cell lower bound. */
450
451 /* $ Exceptions */
452
453 /* Error free. */
454
455 /* 1) If the input argument FIRST is less than 1 or greater than */
456 /* LEN(STRING)-1, the returned value of LAST is FIRST-1, and the */
457 /* returned value of NCHAR is zero. */
458
459 /* $ Files */
460
461 /* None. */
462
463 /* $ Particulars */
464
465 /* The default syntax rules for valid identifiers are specified in */
466 /* the $Particulars section of the umbrella routine LXNAME. These */
467 /* rules may be overridden by calling LXCSID. */
468
469 /* $ Examples */
470
471 /* See the $Examples section of the umbrella routine LXNAME. */
472
473 /* $ Restrictions */
474
475 /* None. */
476
477 /* $ Literature_References */
478
479 /* None. */
480
481 /* $ Author_and_Institution */
482
483 /* N.J. Bachman (JPL) */
484 /* B.V. Semenov (JPL) */
485
486 /* $ Version */
487
488 /* - Beta Version 1.0.1, 10-FEB-2014 (BVS) */
489
490 /* Added LBCELL to the Declarations, Brief_I/O, and Parameters */
491 /* sections. */
492
493 /* - Beta Version 1.0.0, 25-OCT-1995 (NJB) */
494
495 /* -& */
496 /* $ Index_Entries */
497
498 /* scan identifiers */
499
500 /* -& */
501
502 /* No check-in required; this entry point is error-free. */
503
504
505 /* Save the length of the non-blank prefix of the input string. */
506
507 l = rtrim_(string, string_len);
508
509 /* Handle the cases in which we can tell right away that */
510 /* no token can be found. */
511
512 if (*first < 1 || *first > l) {
513 *last = *first - 1;
514 *nchar = 0;
515 return 0;
516 }
517
518 /* In order for there to be a match, the character at position */
519 /* FIRST must be in the head character set. */
520
521 nhead = idspec[6];
522 c__ = *(unsigned char *)&string[*first - 1];
523 i__ = bsrchi_(&c__, &nhead, &idspec[8]);
524 if (i__ == 0) {
525 *last = *first - 1;
526 *nchar = 0;
527 return 0;
528 }
529
530 /* We have an identifier. The remaining question is how long it is. */
531 /* Each subsequent character that is in the tail character set is */
532 /* considered to be part of the identifier. */
533
534 *nchar = 1;
535 *last = *first;
536 ntail = idspec[7];
537 tcpos = nhead + 3;
538 while(*last < l) {
539 i__1 = *last;
540 c__ = *(unsigned char *)&string[i__1];
541 i__ = bsrchi_(&c__, &ntail, &idspec[tcpos + 5]);
542 if (i__ == 0) {
543 return 0;
544 } else {
545 ++(*nchar);
546 ++(*last);
547 }
548 }
549 return 0;
550 /* $Procedure LXDFID ( Lex, default identifier characters ) */
551
552 L_lxdfid:
553 /* $ Abstract */
554
555 /* Return the default specification for the characters that may */
556 /* appear in an identifier. */
557
558 /* $ Disclaimer */
559
560 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
561 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
562 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
563 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
564 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
565 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
566 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
567 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
568 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
569 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
570
571 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
572 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
573 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
574 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
575 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
576 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
577
578 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
579 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
580 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
581 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
582
583 /* $ Required_Reading */
584
585 /* None. */
586
587 /* $ Keywords */
588
589 /* CHARACTER */
590 /* PARSING */
591 /* SCANNING */
592 /* STRING */
593 /* UTILITY */
594
595 /* $ Declarations */
596
597 /* INTEGER MXSPEC */
598 /* PARAMETER ( MXSPEC = 512 ) */
599
600 /* INTEGER LBCELL */
601 /* PARAMETER ( LBCELL = -5 ) */
602
603 /* INTEGER IDSPEC ( LBCELL : * ) */
604
605 /* $ Brief_I/O */
606
607 /* Variable I/O Description */
608 /* -------- --- -------------------------------------------------- */
609 /* IDSPEC I-O Identifier character specification. */
610 /* MXSPEC P Recommended size for declaration of IDSPEC. */
611 /* LBCELL P The SPICELIB cell lower bound. */
612
613 /* $ Detailed_Input */
614
615 /* IDSPEC is an integer cell. The caller must initialize */
616 /* IDSPEC as a cell, and should use MXSPEC as the size */
617 /* of IDSPEC. */
618
619 /* $ Detailed_Output */
620
621 /* IDSPEC is an integer cell containing a specification of */
622 /* the head and tail identifier character sets to be */
623 /* used the entry point LXIDNT in scanning strings. */
624
625 /* $ Parameters */
626
627 /* MXSPEC is the recommended size for the declaration of */
628 /* IDSPEC; the caller should declare IDSPEC as shown: */
629
630 /* INTEGER IDSPEC ( LBCELL : MXSPEC ) */
631
632 /* The caller should also initialize IDSPEC as shown: */
633
634 /* CALL SSIZEI ( MXSPEC, IDSPEC ) */
635
636 /* LBCELL is the SPICELIB cell lower bound. */
637
638 /* $ Exceptions */
639
640 /* 1) If IDSPEC is not properly initialized on input, or if its */
641 /* size is too small, the error will be diagnosed by routines */
642 /* called by this routine. IDSPEC is undefined on output in this */
643 /* case. */
644
645 /* $ Files */
646
647 /* None. */
648
649 /* $ Particulars */
650
651 /* This routine allows a calling program to obtain the default set of */
652 /* allowed patterns for identifiers recognized by LXIDNT. */
653
654 /* Normally, this routine should be called once during the calling */
655 /* program's initialization. */
656
657 /* $ Examples */
658
659 /* See the $Examples section of the umbrella routine LXNAME. */
660
661 /* $ Restrictions */
662
663 /* None. */
664
665 /* $ Literature_References */
666
667 /* None. */
668
669 /* $ Author_and_Institution */
670
671 /* N.J. Bachman (JPL) */
672 /* B.V. Semenov (JPL) */
673
674 /* $ Version */
675
676 /* - Beta Version 1.0.1, 10-FEB-2014 (BVS) */
677
678 /* Added LBCELL to the Declarations, Brief_I/O, and Parameters */
679 /* sections. */
680
681 /* - Beta Version 1.0.0, 25-OCT-1995 (NJB) */
682
683 /* -& */
684 /* $ Index_Entries */
685
686 /* return default allowed identifier characters */
687
688 /* -& */
689
690 /* Standard SPICE error handling. */
691
692 if (return_()) {
693 return 0;
694 } else {
695 chkin_("LXDFID", (ftnlen)6);
696 }
697
698 /* Initialize our head and tail character sets. */
699
700 ssizei_(&c__255, headc);
701 ssizei_(&c__255, tailc);
702
703 /* Fill in the head and tail character arrays with their default */
704 /* values. User integer codes for the characters. */
705
706 for (i__ = 1; i__ <= 26; ++i__) {
707 headc[(i__1 = i__ + 5) < 261 && 0 <= i__1 ? i__1 : s_rnge("headc",
708 i__1, "lxname_", (ftnlen)761)] = 'A' + i__ - 1;
709 headc[(i__1 = i__ + 31) < 261 && 0 <= i__1 ? i__1 : s_rnge("headc",
710 i__1, "lxname_", (ftnlen)762)] = 'a' + i__ - 1;
711 tailc[(i__1 = i__ + 5) < 261 && 0 <= i__1 ? i__1 : s_rnge("tailc",
712 i__1, "lxname_", (ftnlen)763)] = headc[(i__2 = i__ + 5) < 261
713 && 0 <= i__2 ? i__2 : s_rnge("headc", i__2, "lxname_", (
714 ftnlen)763)];
715 tailc[(i__1 = i__ + 31) < 261 && 0 <= i__1 ? i__1 : s_rnge("tailc",
716 i__1, "lxname_", (ftnlen)764)] = headc[(i__2 = i__ + 31) <
717 261 && 0 <= i__2 ? i__2 : s_rnge("headc", i__2, "lxname_", (
718 ftnlen)764)];
719 }
720 for (i__ = 1; i__ <= 10; ++i__) {
721 tailc[(i__1 = i__ + 57) < 261 && 0 <= i__1 ? i__1 : s_rnge("tailc",
722 i__1, "lxname_", (ftnlen)769)] = '0' + i__ - 1;
723 }
724 tailc[68] = '$';
725 tailc[69] = '_';
726 nhead = 52;
727 ntail = 64;
728
729 /* Turn the arrays into integer sets. */
730
731 validi_(&c__255, &nhead, headc);
732 validi_(&c__255, &ntail, tailc);
733
734 /* Create the output specification IDSPEC. This is a cell */
735 /* containing, in order, */
736
737 /* - the number of head characters */
738 /* - the number of tail characters */
739 /* - integer codes for the head characters */
740 /* - integer codes for the tail characters */
741
742 /* IDSPEC is assumed to be initialized. */
743
744
745 scardi_(&c__0, idspec);
746 appndi_(&nhead, idspec);
747 appndi_(&ntail, idspec);
748 i__1 = nhead;
749 for (i__ = 1; i__ <= i__1; ++i__) {
750 appndi_(&headc[(i__2 = i__ + 5) < 261 && 0 <= i__2 ? i__2 : s_rnge(
751 "headc", i__2, "lxname_", (ftnlen)802)], idspec);
752 }
753 i__1 = ntail;
754 for (i__ = 1; i__ <= i__1; ++i__) {
755 appndi_(&tailc[(i__2 = i__ + 5) < 261 && 0 <= i__2 ? i__2 : s_rnge(
756 "tailc", i__2, "lxname_", (ftnlen)806)], idspec);
757 }
758 chkout_("LXDFID", (ftnlen)6);
759 return 0;
760 /* $Procedure LXCSID ( Lex, custom identifier characters ) */
761
762 L_lxcsid:
763 /* $ Abstract */
764
765 /* Set the acceptable characters that may appear in an identifier */
766 /* token. */
767
768 /* $ Disclaimer */
769
770 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
771 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
772 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
773 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
774 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
775 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
776 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
777 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
778 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
779 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
780
781 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
782 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
783 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
784 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
785 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
786 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
787
788 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
789 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
790 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
791 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
792
793 /* $ Required_Reading */
794
795 /* None. */
796
797 /* $ Keywords */
798
799 /* CHARACTER */
800 /* PARSING */
801 /* SCANNING */
802 /* STRING */
803 /* UTILITY */
804
805 /* $ Declarations */
806
807 /* INTEGER MXSPEC */
808 /* PARAMETER ( MXSPEC = 512 ) */
809
810 /* INTEGER LBCELL */
811 /* PARAMETER ( LBCELL = -5 ) */
812
813 /* CHARACTER*(*) HDCHRS */
814 /* CHARACTER*(*) TLCHRS */
815 /* INTEGER IDSPEC ( LBCELL : * ) */
816
817 /* $ Brief_I/O */
818
819 /* Variable I/O Description */
820 /* -------- --- -------------------------------------------------- */
821 /* HDCHRS I Allowed head characters for identifiers. */
822 /* TLCHRS I Allowed tail characters for identifiers. */
823 /* IDSPEC I-O Identifier character specification. */
824 /* MXSPEC P Recommended size for declaration of IDSPEC. */
825 /* LBCELL P The SPICELIB cell lower bound. */
826
827 /* $ Detailed_Input */
828
829 /* HDCHRS is a string containing the set of characters */
830 /* allowed as the first (`head') character of an */
831 /* identifier token. Case is significant; if both */
832 /* upper and lower case instances of a letter are */
833 /* allowed, they must both be listed. White space is */
834 /* ignored. Non-printing characters are not allowed. */
835
836 /* TLCHRS is a string containing the set of characters */
837 /* allowed as tail characters (characters following */
838 /* the head character) of an identifier token. Case */
839 /* is significant; white space is ignored. */
840 /* Non-printing characters are not allowed. */
841
842 /* IDSPEC is an integer cell. The caller must initialize */
843 /* IDSPEC as a cell, and should use MXSPEC as the size */
844 /* of IDSPEC. */
845
846 /* $ Detailed_Output */
847
848 /* IDSPEC is an integer cell containing a specification of */
849 /* the head and tail identifier character sets to be */
850 /* used the entry point LXIDNT in scanning strings. */
851 /* The caller must initialize IDSPEC as a cell, and */
852 /* should use MXSPEC as the size of IDSPEC. */
853
854 /* $ Parameters */
855
856 /* MXSPEC is the recommended size for the declaration of */
857 /* IDSPEC; the caller should declare IDSPEC as shown: */
858
859 /* INTEGER IDSPEC ( LBCELL : MXSPEC ) */
860
861 /* The caller should also initialize IDSPEC as shown: */
862
863 /* CALL SSIZEI ( MXSPEC, IDSPEC ) */
864
865 /* LBCELL is the SPICELIB cell lower bound. */
866
867 /* $ Exceptions */
868
869 /* 1) If non-printing characters are found in either of the input */
870 /* arguments HDCHRS or TLCHRS, the error SPICE(NONPRINTINGCHARS) */
871 /* is signaled. The set of allowed identifier characters is not */
872 /* modified. */
873
874 /* $ Files */
875
876 /* None. */
877
878 /* $ Particulars */
879
880 /* This routine allows a calling program to customize the set of */
881 /* allowed patterns for identifiers recognized by LXIDNT. */
882
883 /* Normally, this routine should be called once during the calling */
884 /* program's initialization, if this routine is called at all. */
885
886 /* $ Examples */
887
888 /* See the $Examples section of the umbrella routine LXNAME. */
889
890 /* $ Restrictions */
891
892 /* None. */
893
894 /* $ Literature_References */
895
896 /* None. */
897
898 /* $ Author_and_Institution */
899
900 /* N.J. Bachman (JPL) */
901 /* B.V. Semenov (JPL) */
902
903 /* $ Version */
904
905 /* - Beta Version 1.0.1, 10-FEB-2014 (BVS) */
906
907 /* Added LBCELL to the Declarations, Brief_I/O, and Parameters */
908 /* sections. */
909
910 /* - Beta Version 1.0.0, 25-OCT-1995 (NJB) */
911
912 /* -& */
913 /* $ Index_Entries */
914
915 /* customize allowed identifier characters for lexing */
916
917 /* -& */
918
919 /* Standard SPICE error handling. */
920
921 if (return_()) {
922 return 0;
923 } else {
924 chkin_("LXCSID", (ftnlen)6);
925 }
926
927 /* Initialize our head and tail character sets, every time. */
928
929 ssizei_(&c__255, headc);
930 ssizei_(&c__255, tailc);
931
932 /* Check the inputs before proceeding. */
933
934 hl = rtrim_(hdchrs, hdchrs_len);
935 tl = rtrim_(tlchrs, tlchrs_len);
936 i__1 = hl;
937 for (i__ = 1; i__ <= i__1; ++i__) {
938 c__ = *(unsigned char *)&hdchrs[i__ - 1];
939 if (c__ < 32 || c__ > 126) {
940 setmsg_("The character having integer code # in position # of th"
941 "e head character string HDCHRS is a non-printing charact"
942 "er.", (ftnlen)114);
943 errint_("#", &c__, (ftnlen)1);
944 errint_("#", &i__, (ftnlen)1);
945 sigerr_("SPICE(NONPRINTINGCHARS)", (ftnlen)23);
946 chkout_("LXCSID", (ftnlen)6);
947 return 0;
948 }
949 }
950 i__1 = tl;
951 for (i__ = 1; i__ <= i__1; ++i__) {
952 c__ = *(unsigned char *)&tlchrs[i__ - 1];
953 if (c__ < 32 || c__ > 126) {
954 setmsg_("The character having integer code # in position # of th"
955 "e tail character string TLCHRS is a non-printing charact"
956 "er.", (ftnlen)114);
957 errint_("#", &c__, (ftnlen)1);
958 errint_("#", &i__, (ftnlen)1);
959 sigerr_("SPICE(NONPRINTINGCHARS)", (ftnlen)23);
960 chkout_("LXCSID", (ftnlen)6);
961 return 0;
962 }
963 }
964
965 /* The characters of HDCHRS become the set of acceptable */
966 /* characters for the head identifier character---all except */
967 /* the blanks. Same deal goes for the tail characters. */
968
969 i__1 = hl;
970 for (i__ = 1; i__ <= i__1; ++i__) {
971 c__ = *(unsigned char *)&hdchrs[i__ - 1];
972 if (c__ != 32) {
973 insrti_(&c__, headc);
974 }
975 }
976 nhead = cardi_(headc);
977 i__1 = tl;
978 for (i__ = 1; i__ <= i__1; ++i__) {
979 c__ = *(unsigned char *)&tlchrs[i__ - 1];
980 if (c__ != 32) {
981 insrti_(&c__, tailc);
982 }
983 }
984 ntail = cardi_(tailc);
985
986 /* Create the output specification IDSPEC. This is a cell */
987 /* containing, in order, */
988
989 /* - the number of head characters */
990 /* - the number of tail characters */
991 /* - integer codes for the head characters */
992 /* - integer codes for the tail characters */
993
994 /* IDSPEC is assumed to be initialized. */
995
996
997 scardi_(&c__0, idspec);
998 appndi_(&nhead, idspec);
999 appndi_(&ntail, idspec);
1000 i__1 = nhead;
1001 for (i__ = 1; i__ <= i__1; ++i__) {
1002 appndi_(&headc[(i__2 = i__ + 5) < 261 && 0 <= i__2 ? i__2 : s_rnge(
1003 "headc", i__2, "lxname_", (ftnlen)1089)], idspec);
1004 }
1005 i__1 = ntail;
1006 for (i__ = 1; i__ <= i__1; ++i__) {
1007 appndi_(&tailc[(i__2 = i__ + 5) < 261 && 0 <= i__2 ? i__2 : s_rnge(
1008 "tailc", i__2, "lxname_", (ftnlen)1093)], idspec);
1009 }
1010 chkout_("LXCSID", (ftnlen)6);
1011 return 0;
1012 } /* lxname_ */
1013
lxname_(char * hdchrs,char * tlchrs,char * string,integer * first,integer * last,integer * idspec,integer * nchar,ftnlen hdchrs_len,ftnlen tlchrs_len,ftnlen string_len)1014 /* Subroutine */ int lxname_(char *hdchrs, char *tlchrs, char *string,
1015 integer *first, integer *last, integer *idspec, integer *nchar,
1016 ftnlen hdchrs_len, ftnlen tlchrs_len, ftnlen string_len)
1017 {
1018 return lxname_0_(0, hdchrs, tlchrs, string, first, last, idspec, nchar,
1019 hdchrs_len, tlchrs_len, string_len);
1020 }
1021
lxidnt_(integer * idspec,char * string,integer * first,integer * last,integer * nchar,ftnlen string_len)1022 /* Subroutine */ int lxidnt_(integer *idspec, char *string, integer *first,
1023 integer *last, integer *nchar, ftnlen string_len)
1024 {
1025 return lxname_0_(1, (char *)0, (char *)0, string, first, last, idspec,
1026 nchar, (ftnint)0, (ftnint)0, string_len);
1027 }
1028
lxdfid_(integer * idspec)1029 /* Subroutine */ int lxdfid_(integer *idspec)
1030 {
1031 return lxname_0_(2, (char *)0, (char *)0, (char *)0, (integer *)0, (
1032 integer *)0, idspec, (integer *)0, (ftnint)0, (ftnint)0, (ftnint)
1033 0);
1034 }
1035
lxcsid_(char * hdchrs,char * tlchrs,integer * idspec,ftnlen hdchrs_len,ftnlen tlchrs_len)1036 /* Subroutine */ int lxcsid_(char *hdchrs, char *tlchrs, integer *idspec,
1037 ftnlen hdchrs_len, ftnlen tlchrs_len)
1038 {
1039 return lxname_0_(3, hdchrs, tlchrs, (char *)0, (integer *)0, (integer *)0,
1040 idspec, (integer *)0, hdchrs_len, tlchrs_len, (ftnint)0);
1041 }
1042
1043