xref: /csrg-svn/usr.bin/pascal/src/lab.c (revision 9120)
1756Speter /* Copyright (c) 1979 Regents of the University of California */
2756Speter 
3*9120Smckusick static char sccsid[] = "@(#)lab.c 1.14 11/10/82";
4756Speter 
5756Speter #include "whoami.h"
6756Speter #include "0.h"
7756Speter #include "tree.h"
8756Speter #include "opcode.h"
9756Speter #include "objfmt.h"
10756Speter #ifdef PC
11756Speter #   include	"pc.h"
12756Speter #   include	"pcops.h"
13756Speter #endif PC
14756Speter 
15756Speter /*
16756Speter  * Label enters the definitions
17756Speter  * of the label declaration part
18756Speter  * into the namelist.
19756Speter  */
20756Speter label(r, l)
21756Speter 	int *r, l;
22756Speter {
237951Speter     static bool	label_order = FALSE;
247951Speter     static bool	label_seen = FALSE;
253366Speter #ifdef PC
263366Speter 	char	extname[ BUFSIZ ];
273366Speter #endif PC
28756Speter #ifndef PI0
29756Speter 	register *ll;
30756Speter 	register struct nl *p, *lp;
31756Speter 
32756Speter 	lp = NIL;
33756Speter #else
34756Speter 	send(REVLAB, r);
35756Speter #endif
36756Speter 	if ( ! progseen ) {
37756Speter 	    level1();
38756Speter 	}
39756Speter 	line = l;
40756Speter #ifndef PI1
41835Speter 	if (parts[ cbn ] & (CPRT|TPRT|VPRT|RPRT)){
42835Speter 	    if ( opt( 's' ) ) {
43756Speter 		standard();
447951Speter 		error("Label declarations should precede const, type, var and routine declarations");
45835Speter 	    } else {
467951Speter 		if ( !label_order ) {
477951Speter 		    label_order = TRUE;
487951Speter 		    warning();
497951Speter 		    error("Label declarations should precede const, type, var and routine declarations");
507951Speter 		}
51835Speter 	    }
52756Speter 	}
53835Speter 	if (parts[ cbn ] & LPRT) {
54835Speter 	    if ( opt( 's' ) ) {
55756Speter 		standard();
567951Speter 		error("All labels should be declared in one label part");
57835Speter 	    } else {
587951Speter 		if ( !label_seen ) {
597951Speter 		    label_seen = TRUE;
607951Speter 		    warning();
617951Speter 		    error("All labels should be declared in one label part");
627951Speter 		}
63835Speter 	    }
64756Speter 	}
65835Speter 	parts[ cbn ] |= LPRT;
66756Speter #endif
67756Speter #ifndef PI0
68756Speter 	for (ll = r; ll != NIL; ll = ll[2]) {
69756Speter 		l = getlab();
70756Speter 		p = enter(defnl(ll[1], LABEL, 0, l));
71756Speter 		/*
72756Speter 		 * Get the label for the eventual target
73756Speter 		 */
74756Speter 		p->value[1] = getlab();
75756Speter 		p->chain = lp;
76756Speter 		p->nl_flags |= (NFORWD|NMOD);
77756Speter 		p->value[NL_GOLEV] = NOTYET;
787919Smckusick 		p->value[NL_ENTLOC] = l;
79756Speter 		lp = p;
80756Speter #		ifdef OBJ
81756Speter 		    /*
82756Speter 		     * This operator is between
83756Speter 		     * the bodies of two procedures
84756Speter 		     * and provides a target for
85756Speter 		     * gotos for this label via TRA.
86756Speter 		     */
87756Speter 		    putlab(l);
883074Smckusic 		    /* put(2, O_GOTO | cbn<<8+INDX, (long)p->value[1]); */
893074Smckusic 		    put(2, O_GOTO | cbn<<8, (long)p->value[1]);
90756Speter #		endif OBJ
91756Speter #		ifdef PC
92756Speter 		    /*
93756Speter 		     *	labels have to be .globl otherwise /lib/c2 may
94756Speter 		     *	throw them away if they aren't used in the function
95756Speter 		     *	which defines them.
96756Speter 		     */
974880Speter 		    extlabname( extname , p -> symbol , cbn );
983366Speter 		    putprintf( "	.globl	%s" , 0 , extname );
993366Speter 		    if ( cbn == 1 ) {
1003366Speter 			stabglabel( extname , line );
101756Speter 		    }
102756Speter #		endif PC
103756Speter 	}
104756Speter 	gotos[cbn] = lp;
105756Speter #	ifdef PTREE
106756Speter 	    {
107756Speter 		pPointer	Labels = LabelDCopy( r );
108756Speter 
109756Speter 		pDEF( PorFHeader[ nesting ] ).PorFLabels = Labels;
110756Speter 	    }
111756Speter #	endif PTREE
112756Speter #endif
113756Speter }
114756Speter 
115756Speter #ifndef PI0
116756Speter /*
117756Speter  * Gotoop is called when
118756Speter  * we get a statement "goto label"
119756Speter  * and generates the needed tra.
120756Speter  */
121756Speter gotoop(s)
122756Speter 	char *s;
123756Speter {
124756Speter 	register struct nl *p;
1253366Speter #ifdef PC
1263366Speter 	char	extname[ BUFSIZ ];
1273366Speter #endif PC
128756Speter 
129756Speter 	gocnt++;
130756Speter 	p = lookup(s);
131756Speter 	if (p == NIL)
132756Speter 		return (NIL);
133756Speter #	ifdef OBJ
1347919Smckusick 	    put(2, O_TRA4, (long)p->value[NL_ENTLOC]);
135756Speter #	endif OBJ
136756Speter #	ifdef PC
137756Speter 	    if ( cbn != bn ) {
138756Speter 		    /*
139*9120Smckusick 		     *  Close all active files between top of stack and
140*9120Smckusick 		     *  frame at the destination level.	Then call longjmp
141*9120Smckusick 		     *	to unwind the stack to the destination level.
142756Speter 		     */
143756Speter 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
144*9120Smckusick 			, "_PCLOSE" );
145*9120Smckusick 		putRV( DISPLAYNAME , 0 ,
146*9120Smckusick 			bn * sizeof( struct dispsave ) + sizeof ( char * ) ,
1473827Speter 			NGLOBAL , P2PTR | P2INT );
148*9120Smckusick 		if ( bn > 1 ) {
149*9120Smckusick 		    p = lookup( enclosing[ bn - 1 ] );
150*9120Smckusick 		    sprintf( extname, "LF%d+%d", p -> value[ NL_ENTLOC ]
151*9120Smckusick 			, sizeof( int ) );
152*9120Smckusick 		    putleaf( P2ICON , 0 , 0 , P2INT , extname );
153*9120Smckusick 		    p = lookup(s);
154*9120Smckusick 		} else {
155*9120Smckusick 		    putleaf( P2ICON , DPOFF1 + sizeof( int ) , 0 , P2INT , 0 );
156*9120Smckusick 		}
157*9120Smckusick 		putop( P2MINUS , P2PTR | P2CHAR );
158756Speter 		putop( P2CALL , P2INT );
159756Speter 		putdot( filename , line );
160*9120Smckusick 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
161*9120Smckusick 			, "_longjmp" );
162*9120Smckusick 		putLV( 0 , bn , GOTOENVOFFSET , NLOCAL , P2PTR|P2STRTY );
163*9120Smckusick 		extlabname( extname , p -> symbol , bn );
164*9120Smckusick 		putLV( extname , 0 , 0 , NGLOBAL , P2PTR|P2STRTY );
165*9120Smckusick 		putop( P2LISTOP , P2INT );
166*9120Smckusick 		putop( P2CALL , P2INT );
167*9120Smckusick 		putdot( filename , line );
168*9120Smckusick 	    } else {
169*9120Smckusick 		extlabname( extname , p -> symbol , bn );
170*9120Smckusick 		    /*
171*9120Smckusick 		     *	this is a jmp because it's a jump to a global
172*9120Smckusick 		     *	and the assembler doesn't change jbr's into jmp's
173*9120Smckusick 		     *	if the destination is a global symbol.
174*9120Smckusick 		     */
175*9120Smckusick 		putprintf( "	jmp	%s" , 0 , extname );
176756Speter 	    }
177756Speter #	endif PC
178756Speter 	if (bn == cbn)
179756Speter 		if (p->nl_flags & NFORWD) {
180756Speter 			if (p->value[NL_GOLEV] == NOTYET) {
181756Speter 				p->value[NL_GOLEV] = level;
182756Speter 				p->value[NL_GOLINE] = line;
183756Speter 			}
184756Speter 		} else
185756Speter 			if (p->value[NL_GOLEV] == DEAD) {
186756Speter 				recovered();
187756Speter 				error("Goto %s is into a structured statement", p->symbol);
188756Speter 			}
189756Speter }
190756Speter 
191756Speter /*
192756Speter  * Labeled is called when a label
193756Speter  * definition is encountered, and
194756Speter  * marks that it has been found and
195756Speter  * patches the associated GOTO generated
196756Speter  * by gotoop.
197756Speter  */
198756Speter labeled(s)
199756Speter 	char *s;
200756Speter {
201756Speter 	register struct nl *p;
2023366Speter #ifdef PC
2033366Speter 	char	extname[ BUFSIZ ];
2043366Speter #endif PC
205756Speter 
206756Speter 	p = lookup(s);
207756Speter 	if (p == NIL)
208756Speter 		return (NIL);
209756Speter 	if (bn != cbn) {
210756Speter 		error("Label %s not defined in correct block", s);
211756Speter 		return;
212756Speter 	}
213756Speter 	if ((p->nl_flags & NFORWD) == 0) {
214756Speter 		error("Label %s redefined", s);
215756Speter 		return;
216756Speter 	}
217756Speter 	p->nl_flags &= ~NFORWD;
218756Speter #	ifdef OBJ
2197919Smckusick 	    patch4(p->value[NL_ENTLOC]);
220756Speter #	endif OBJ
221756Speter #	ifdef PC
2224880Speter 	    extlabname( extname , p -> symbol , bn );
2233366Speter 	    putprintf( "%s:" , 0 , extname );
224756Speter #	endif PC
225756Speter 	if (p->value[NL_GOLEV] != NOTYET)
226756Speter 		if (p->value[NL_GOLEV] < level) {
227756Speter 			recovered();
228756Speter 			error("Goto %s from line %d is into a structured statement", s, p->value[NL_GOLINE]);
229756Speter 		}
230756Speter 	p->value[NL_GOLEV] = level;
231756Speter }
232756Speter #endif
2334880Speter 
2344880Speter #ifdef PC
2354880Speter     /*
2364880Speter      *	construct the long name of a label based on it's static nesting.
2374880Speter      *	into a caller-supplied buffer (that should be about BUFSIZ big).
2384880Speter      */
2394880Speter extlabname( buffer , name , level )
2404880Speter     char	buffer[];
2414880Speter     char	*name;
2424880Speter     int		level;
2434880Speter {
2444880Speter     char	*starthere;
2454880Speter     int		i;
2464880Speter 
2474880Speter     starthere = &buffer[0];
2484880Speter     for ( i = 1 ; i < level ; i++ ) {
2494880Speter 	sprintf( starthere , EXTFORMAT , enclosing[ i ] );
2504880Speter 	starthere += strlen( enclosing[ i ] ) + 1;
2514880Speter     }
2524880Speter     sprintf( starthere , EXTFORMAT , "" );
2534880Speter     starthere += 1;
2544880Speter     sprintf( starthere , LABELFORMAT , name );
2554880Speter     starthere += strlen( name ) + 1;
2564880Speter     if ( starthere >= &buffer[ BUFSIZ ] ) {
2574880Speter 	panic( "extlabname" );
2584880Speter     }
2594880Speter }
2604880Speter #endif PC
261