xref: /csrg-svn/usr.bin/pascal/src/lab.c (revision 826)
1756Speter /* Copyright (c) 1979 Regents of the University of California */
2756Speter 
3*826Speter static	char sccsid[] = "@(#)lab.c 1.2 08/31/80";
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 {
23756Speter #ifndef PI0
24756Speter 	register *ll;
25756Speter 	register struct nl *p, *lp;
26756Speter 
27756Speter 	lp = NIL;
28756Speter #else
29756Speter 	send(REVLAB, r);
30756Speter #endif
31756Speter 	if ( ! progseen ) {
32756Speter 	    level1();
33756Speter 	}
34756Speter 	line = l;
35756Speter #ifndef PI1
36756Speter #ifdef PC
37756Speter     if (opt('s')) {
38756Speter 	if (parts & (CPRT|TPRT|VPRT)){
39756Speter 		standard();
40756Speter 		error("Label declarations must precede const, type and var declarations");
41756Speter 	}
42756Speter 	if (parts & LPRT) {
43756Speter 		standard();
44756Speter 		error("All labels must be declared in one label part");
45756Speter 	}
46756Speter     }
47756Speter #endif PC
48756Speter #ifdef OBJ
49756Speter 	if (parts & (CPRT|TPRT|VPRT))
50756Speter 		error("Label declarations must precede const, type and var declarations");
51756Speter 	if (parts & LPRT)
52756Speter 		error("All labels must be declared in one label part");
53756Speter #endif OBJ
54756Speter 	parts |= LPRT;
55756Speter #endif
56756Speter #ifndef PI0
57756Speter 	for (ll = r; ll != NIL; ll = ll[2]) {
58756Speter 		l = getlab();
59756Speter 		p = enter(defnl(ll[1], LABEL, 0, l));
60756Speter 		/*
61756Speter 		 * Get the label for the eventual target
62756Speter 		 */
63756Speter 		p->value[1] = getlab();
64756Speter 		p->chain = lp;
65756Speter 		p->nl_flags |= (NFORWD|NMOD);
66756Speter 		p->value[NL_GOLEV] = NOTYET;
67756Speter 		p->entloc = l;
68756Speter 		lp = p;
69756Speter #		ifdef OBJ
70756Speter 		    /*
71756Speter 		     * This operator is between
72756Speter 		     * the bodies of two procedures
73756Speter 		     * and provides a target for
74756Speter 		     * gotos for this label via TRA.
75756Speter 		     */
76756Speter 		    putlab(l);
77756Speter 		    put2(O_GOTO | cbn<<8+INDX, p->value[1]);
78756Speter #		endif OBJ
79756Speter #		ifdef PC
80756Speter 		    /*
81756Speter 		     *	labels have to be .globl otherwise /lib/c2 may
82756Speter 		     *	throw them away if they aren't used in the function
83756Speter 		     *	which defines them.
84756Speter 		     */
85756Speter 		    if (cbn == 1) {
86756Speter 				/*
87756Speter 				 *	stab the label for separate compilation.
88756Speter 				 *	make label number = label name.
89756Speter 				 */
90*826Speter 			    stabglab( p -> symbol , line );
91756Speter 			    p -> value[1] = atol( p -> symbol );
92756Speter 			    putprintf( "	.globl	" , 1 );
93756Speter 			    putprintf( PREFIXFORMAT , 0 , PLABELPREFIX
94756Speter 					, p -> value[1] );
95756Speter 		    } else {
96756Speter 			    putprintf( "	.globl	" , 1 );
97756Speter 			    putprintf( PREFIXFORMAT , 0 , GLABELPREFIX
98756Speter 					, p -> value[1] );
99756Speter 		    }
100756Speter #		endif PC
101756Speter 	}
102756Speter 	gotos[cbn] = lp;
103756Speter #	ifdef PTREE
104756Speter 	    {
105756Speter 		pPointer	Labels = LabelDCopy( r );
106756Speter 
107756Speter 		pDEF( PorFHeader[ nesting ] ).PorFLabels = Labels;
108756Speter 	    }
109756Speter #	endif PTREE
110756Speter #endif
111756Speter }
112756Speter 
113756Speter #ifndef PI0
114756Speter /*
115756Speter  * Gotoop is called when
116756Speter  * we get a statement "goto label"
117756Speter  * and generates the needed tra.
118756Speter  */
119756Speter gotoop(s)
120756Speter 	char *s;
121756Speter {
122756Speter 	register struct nl *p;
123756Speter 
124756Speter 	gocnt++;
125756Speter 	p = lookup(s);
126756Speter 	if (p == NIL)
127756Speter 		return (NIL);
128756Speter #	ifdef OBJ
129756Speter 	    put2(O_TRA4, p->entloc);
130756Speter #	endif OBJ
131756Speter #	ifdef PC
132756Speter 	    if ( cbn != bn ) {
133756Speter 		    /*
134756Speter 		     *	call goto to unwind the stack to the destination level
135756Speter 		     */
136756Speter 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
137756Speter 			, "_GOTO" );
138756Speter 		putLV( DISPLAYNAME , 0 , bn * sizeof( struct dispsave )
139756Speter 			, P2PTR | P2INT );
140756Speter 		putop( P2CALL , P2INT );
141756Speter 		putdot( filename , line );
142756Speter 	    }
143756Speter 	    if ( bn <= 1 ) {
144756Speter 		printjbr( PLABELPREFIX , p -> value[1] );
145756Speter 	    } else {
146756Speter 		printjbr( GLABELPREFIX , p -> value[1] );
147756Speter 	    }
148756Speter #	endif PC
149756Speter 	if (bn == cbn)
150756Speter 		if (p->nl_flags & NFORWD) {
151756Speter 			if (p->value[NL_GOLEV] == NOTYET) {
152756Speter 				p->value[NL_GOLEV] = level;
153756Speter 				p->value[NL_GOLINE] = line;
154756Speter 			}
155756Speter 		} else
156756Speter 			if (p->value[NL_GOLEV] == DEAD) {
157756Speter 				recovered();
158756Speter 				error("Goto %s is into a structured statement", p->symbol);
159756Speter 			}
160756Speter }
161756Speter 
162756Speter /*
163756Speter  * Labeled is called when a label
164756Speter  * definition is encountered, and
165756Speter  * marks that it has been found and
166756Speter  * patches the associated GOTO generated
167756Speter  * by gotoop.
168756Speter  */
169756Speter labeled(s)
170756Speter 	char *s;
171756Speter {
172756Speter 	register struct nl *p;
173756Speter 
174756Speter 	p = lookup(s);
175756Speter 	if (p == NIL)
176756Speter 		return (NIL);
177756Speter 	if (bn != cbn) {
178756Speter 		error("Label %s not defined in correct block", s);
179756Speter 		return;
180756Speter 	}
181756Speter 	if ((p->nl_flags & NFORWD) == 0) {
182756Speter 		error("Label %s redefined", s);
183756Speter 		return;
184756Speter 	}
185756Speter 	p->nl_flags &= ~NFORWD;
186756Speter #	ifdef OBJ
187756Speter 	    patch4(p->entloc);
188756Speter #	endif OBJ
189756Speter #	ifdef PC
190756Speter 	    if ( bn <= 1 ) {
191756Speter 		putprintf( PREFIXFORMAT , 1 , PLABELPREFIX , p -> value[1] );
192756Speter 	    } else {
193756Speter 		putprintf( PREFIXFORMAT , 1 , GLABELPREFIX , p -> value[1] );
194756Speter 	    }
195756Speter 	    putprintf( ":" , 0 );
196756Speter #	endif PC
197756Speter 	if (p->value[NL_GOLEV] != NOTYET)
198756Speter 		if (p->value[NL_GOLEV] < level) {
199756Speter 			recovered();
200756Speter 			error("Goto %s from line %d is into a structured statement", s, p->value[NL_GOLINE]);
201756Speter 		}
202756Speter 	p->value[NL_GOLEV] = level;
203756Speter }
204756Speter #endif
205