/* Copyright (c) 1979 Regents of the University of California */
static char sccsid
[] = "@(#)nl.c 1.12 %G%";
* NAMELIST SEGMENT DEFINITIONS
struct nls
*nlact
= ntab
;
* all these strings must be places where people can find them
* since lookup only looks at the string pointer, not the chars.
* see, for example, pTreeInit.
-2147483648L , 2147483647L ,
0L , 0L /* fake for reals */
* built in constructed types
* Initnl initializes the first namelist segment and then
* initializes the name list for block 0.
ntab
[0].nls_high
= &nl
[INL
];
for ( cp
= in_types
; *cp
!= 0 ; cp
++ )
hdefnl ( *cp
, TYPE
, nlp
, 0 );
for ( ip
= in_rclasses
; *ip
!= 0 ; ip
++ )
np
= defnl ( 0 , RANGE
, nl
+(*ip
) , 0 );
np
-> range
[0] = *lp
++ ;
np
-> range
[1] = *lp
++ ;
* built in constructed types
hdefnl ( *cp
++ , TYPE
, nl
+T1BOOL
, 0 );
* intset = set of 0 .. 127;
hdefnl( intset
, TYPE
, nlp
+1 , 0 );
defnl ( 0 , SET
, nlp
+1 , 0 );
np
= defnl ( 0 , RANGE
, nl
+TINT
, 0 );
* alfa = array [ 1 .. 10 ] of char;
np
= defnl ( 0 , RANGE
, nl
+TINT
, 0 );
defnl ( 0 , ARRAY
, nl
+T1CHAR
, 1 ) -> chain
= np
;
hdefnl ( *cp
++ , TYPE
, nlp
-1 , 0 );
hdefnl ( *cp
++ , TYPE
, nlp
+1 , 0 );
np
= defnl ( 0 , FILET
, nl
+T1CHAR
, 0 );
np
-> nl_flags
|= NFILES
;
input
= hdefnl ( *cp
++ , VAR
, np
, INPUT_OFF
);
output
= hdefnl ( *cp
++ , VAR
, np
, OUTPUT_OFF
);
input
= hdefnl ( *cp
++ , VAR
, np
, 0 );
output
= hdefnl ( *cp
++ , VAR
, np
, 0 );
input
-> extra_flags
|= NGLOBAL
;
output
-> extra_flags
|= NGLOBAL
;
np
= hdefnl ( *cp
++ , CONST
, nl
+ TBOOL
, 1 );
fp
= hdefnl ( *cp
++ , CONST
, nl
+ TBOOL
, 0 );
(nl
+ TBOOL
)->chain
= fp
;
np
= hdefnl ( *cp
++ , CONST
, nl
+ TBOOL
, 1 );
fp
= hdefnl ( *cp
++ , CONST
, nl
+ TBOOL
, 0 );
(nl
+ TBOOL
)->chain
= fp
;
hdefnl ( *cp
++ , CONST
, nl
+ T4INT
, 0 ) -> range
[0] = MININT
;
hdefnl ( *cp
++ , CONST
, nl
+ T4INT
, 0 ) -> range
[0] = MAXINT
;
hdefnl ( *cp
++ , CONST
, nl
+ T1CHAR
, 0 );
hdefnl ( *cp
++ , CONST
, nl
+ T1CHAR
, 127 );
hdefnl ( *cp
++ , CONST
, nl
+ T1CHAR
, '\007' );
hdefnl ( *cp
++ , CONST
, nl
+ T1CHAR
, '\t' );
* Built-in functions and procedures
for ( cp
= in_funcs
; *cp
!= 0 ; cp
++ )
hdefnl ( *cp
, FUNC
, 0 , * ip
++ );
for ( cp
= in_procs
; *cp
!= 0 ; cp
++ )
hdefnl ( *cp
, PROC
, 0 , * ip
++ );
for ( cp
= in_funcs
; *cp
!= 0 ; cp
++ )
hdefnl ( *cp
, FUNC
, 0 , 0 );
for ( cp
= in_procs
; *cp
!= 0 , cp
++ )
hdefnl ( *cp
, PROC
, 0 , 0 );
hdefnl(sym
, cls
, typ
, val
)
p
= defnl(sym
, cls
, typ
, val
);
* Free up the name list segments
* at the end of a statement/proc/func
* All segments are freed down to the one in which
while (nlact
->nls_low
> nlp
|| nlact
->nls_high
< nlp
) {
char *VARIABLE
= "variable";
"variable", /* VARIABLE */
"variable", /* VARIABLE */
"variable", /* VARIABLE */
* Dump the namelist from the
* current nlp down to 'to'.
* All the namelist is dumped if
printf("\n\"%s\" Block=%d\n", rout
, cbn
);
for (p
= nlp
; p
!= to
;) {
if (p
== nlsp
->nls_low
) {
printf("\tName\tClass Bn+Flags\tType\tVal\tChn\n");
printf("%3d:", nloff(p
));
printf("\t%.7s", p
->symbol
);
printf("\t%s", ctext
[p
->class]);
printf("%d ", p
->nl_flags
& 037);
if (p
->nl_flags
& NFILES
)
printf("\t[%d]", nloff(p
->type
));
switch (nloff(p
->type
)) {
printf("\t%ld", p
->range
[0]);
printf("\t'%s'", p
->ptr
[0]);
printf("\t%d,%d", cbn
, v
);
printf("\t%ld..%ld", p
->range
[0], p
->range
[1]);
printf("\t|%d|", p
->value
[0]);
printf("\t<%o>", p
->value
[0] & 0377);
if (p
->value
[0] & NSTAND
)
printf("\t[%d]", nloff(p
->chain
));
printf("\tALIGN=%d", p
->align_info
);
if (p
->ptr
[NL_FIELDLIST
]) {
nloff(p
->ptr
[NL_FIELDLIST
]));
nloff(p
->ptr
[NL_VARNT
]));
if (p
->ptr
[NL_FIELDLIST
]) {
nloff(p
->ptr
[NL_FIELDLIST
]));
nloff(p
->ptr
[NL_VTOREC
]));
if ( p
-> extra_flags
!= 0 ) {
if ( p
-> extra_flags
& NEXTERN
)
if ( p
-> extra_flags
& NLOCAL
)
if ( p
-> extra_flags
& NPARAM
)
if ( p
-> extra_flags
& NGLOBAL
)
if ( p
-> extra_flags
& NREGVAR
)
pPrintPointer( stdout
, "%s" , p
-> inTree
);
printf("\tNo entries\n");
* Define a new name list entry
* with initial symbol, class, type
* and value[0] as given. A new name
* list segment is allocated to hold
* the next name list slot if necessary.
defnl(sym
, cls
, typ
, val
)
i
= (sizeof *p
)/(sizeof (int));
* Insure that the next namelist
* entry actually exists. This is
* really not needed here, it would
* suffice to do it at entry if we
* need the slot. It is done this
* way because, historically, nlp
* always pointed at the next namelist
if (nlp
>= nlact
->nls_high
) {
cp
= malloc(NLINC
* sizeof *nlp
);
cp
= malloc((NLINC
/ 2) * sizeof *nlp
);
error("Ran out of memory (defnl)");
if (nlact
>= &ntab
[MAXNL
]) {
error("Ran out of name list tables");
nlact
->nls_high
= nlact
->nls_low
+ i
;
* Make a duplicate of the argument
* namelist entry for, e.g., type
* declarations of the form 'type a = b'
register int *p1
, *p2
, i
;
p
= p2
= defnl(0, 0, 0, 0);
i
= (sizeof *p
)/(sizeof (int));
* Compute a namelist offset
* Enter a symbol into the block
* symbol table. Symbols are hashed
* 64 ways based on low 6 bits of the
* character pointer into the string
register struct nl
*rp
, *hp
;
if (rp
->symbol
== input
->symbol
|| rp
->symbol
== output
->symbol
)
error("Pre-defined files input and output must not be redefined");
if (rp
->class != BADUSE
&& rp
->class != FIELD
)
for (p
= hp
; p
!= NIL
&& (p
->nl_block
& 037) == cbn
; p
= p
->nl_next
)
if (p
->symbol
== rp
->symbol
&& p
->class != BADUSE
&& p
->class != FIELD
) {
error("%s is already defined in this block", rp
->symbol
);