xref: /csrg-svn/usr.bin/pascal/src/lab.c (revision 3366)
1756Speter /* Copyright (c) 1979 Regents of the University of California */
2756Speter 
3*3366Speter static char sccsid[] = "@(#)lab.c 1.8 03/25/81";
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 {
23*3366Speter #ifdef PC
24*3366Speter 	char	extname[ BUFSIZ ];
25*3366Speter #endif PC
26756Speter #ifndef PI0
27756Speter 	register *ll;
28756Speter 	register struct nl *p, *lp;
29756Speter 
30756Speter 	lp = NIL;
31756Speter #else
32756Speter 	send(REVLAB, r);
33756Speter #endif
34756Speter 	if ( ! progseen ) {
35756Speter 	    level1();
36756Speter 	}
37756Speter 	line = l;
38756Speter #ifndef PI1
39835Speter 	if (parts[ cbn ] & (CPRT|TPRT|VPRT|RPRT)){
40835Speter 	    if ( opt( 's' ) ) {
41756Speter 		standard();
42835Speter 	    } else {
43835Speter 		warning();
44835Speter 	    }
45835Speter 	    error("Label declarations should precede const, type, var and routine declarations");
46756Speter 	}
47835Speter 	if (parts[ cbn ] & LPRT) {
48835Speter 	    if ( opt( 's' ) ) {
49756Speter 		standard();
50835Speter 	    } else {
51835Speter 		warning();
52835Speter 	    }
53835Speter 	    error("All labels should be declared in one label part");
54756Speter 	}
55835Speter 	parts[ cbn ] |= LPRT;
56756Speter #endif
57756Speter #ifndef PI0
58756Speter 	for (ll = r; ll != NIL; ll = ll[2]) {
59756Speter 		l = getlab();
60756Speter 		p = enter(defnl(ll[1], LABEL, 0, l));
61756Speter 		/*
62756Speter 		 * Get the label for the eventual target
63756Speter 		 */
64756Speter 		p->value[1] = getlab();
65756Speter 		p->chain = lp;
66756Speter 		p->nl_flags |= (NFORWD|NMOD);
67756Speter 		p->value[NL_GOLEV] = NOTYET;
68756Speter 		p->entloc = l;
69756Speter 		lp = p;
70756Speter #		ifdef OBJ
71756Speter 		    /*
72756Speter 		     * This operator is between
73756Speter 		     * the bodies of two procedures
74756Speter 		     * and provides a target for
75756Speter 		     * gotos for this label via TRA.
76756Speter 		     */
77756Speter 		    putlab(l);
783074Smckusic 		    /* put(2, O_GOTO | cbn<<8+INDX, (long)p->value[1]); */
793074Smckusic 		    put(2, O_GOTO | cbn<<8, (long)p->value[1]);
80756Speter #		endif OBJ
81756Speter #		ifdef PC
82756Speter 		    /*
83756Speter 		     *	labels have to be .globl otherwise /lib/c2 may
84756Speter 		     *	throw them away if they aren't used in the function
85756Speter 		     *	which defines them.
86756Speter 		     */
87*3366Speter 		    sextname( extname , p -> symbol , cbn );
88*3366Speter 		    putprintf( "	.globl	%s" , 0 , extname );
89*3366Speter 		    if ( cbn == 1 ) {
90*3366Speter 			stabglabel( extname , line );
91756Speter 		    }
92756Speter #		endif PC
93756Speter 	}
94756Speter 	gotos[cbn] = lp;
95756Speter #	ifdef PTREE
96756Speter 	    {
97756Speter 		pPointer	Labels = LabelDCopy( r );
98756Speter 
99756Speter 		pDEF( PorFHeader[ nesting ] ).PorFLabels = Labels;
100756Speter 	    }
101756Speter #	endif PTREE
102756Speter #endif
103756Speter }
104756Speter 
105756Speter #ifndef PI0
106756Speter /*
107756Speter  * Gotoop is called when
108756Speter  * we get a statement "goto label"
109756Speter  * and generates the needed tra.
110756Speter  */
111756Speter gotoop(s)
112756Speter 	char *s;
113756Speter {
114756Speter 	register struct nl *p;
115*3366Speter #ifdef PC
116*3366Speter 	char	extname[ BUFSIZ ];
117*3366Speter #endif PC
118756Speter 
119756Speter 	gocnt++;
120756Speter 	p = lookup(s);
121756Speter 	if (p == NIL)
122756Speter 		return (NIL);
123756Speter #	ifdef OBJ
1243074Smckusic 	    put(2, O_TRA4, (long)p->entloc);
125756Speter #	endif OBJ
126756Speter #	ifdef PC
127756Speter 	    if ( cbn != bn ) {
128756Speter 		    /*
129756Speter 		     *	call goto to unwind the stack to the destination level
130756Speter 		     */
131756Speter 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
132756Speter 			, "_GOTO" );
133756Speter 		putLV( DISPLAYNAME , 0 , bn * sizeof( struct dispsave )
134756Speter 			, P2PTR | P2INT );
135756Speter 		putop( P2CALL , P2INT );
136756Speter 		putdot( filename , line );
137756Speter 	    }
138*3366Speter 	    sextname( extname , p -> symbol , bn );
139*3366Speter 	    putprintf( "	jbr	%s" , 0 , extname );
140756Speter #	endif PC
141756Speter 	if (bn == cbn)
142756Speter 		if (p->nl_flags & NFORWD) {
143756Speter 			if (p->value[NL_GOLEV] == NOTYET) {
144756Speter 				p->value[NL_GOLEV] = level;
145756Speter 				p->value[NL_GOLINE] = line;
146756Speter 			}
147756Speter 		} else
148756Speter 			if (p->value[NL_GOLEV] == DEAD) {
149756Speter 				recovered();
150756Speter 				error("Goto %s is into a structured statement", p->symbol);
151756Speter 			}
152756Speter }
153756Speter 
154756Speter /*
155756Speter  * Labeled is called when a label
156756Speter  * definition is encountered, and
157756Speter  * marks that it has been found and
158756Speter  * patches the associated GOTO generated
159756Speter  * by gotoop.
160756Speter  */
161756Speter labeled(s)
162756Speter 	char *s;
163756Speter {
164756Speter 	register struct nl *p;
165*3366Speter #ifdef PC
166*3366Speter 	char	extname[ BUFSIZ ];
167*3366Speter #endif PC
168756Speter 
169756Speter 	p = lookup(s);
170756Speter 	if (p == NIL)
171756Speter 		return (NIL);
172756Speter 	if (bn != cbn) {
173756Speter 		error("Label %s not defined in correct block", s);
174756Speter 		return;
175756Speter 	}
176756Speter 	if ((p->nl_flags & NFORWD) == 0) {
177756Speter 		error("Label %s redefined", s);
178756Speter 		return;
179756Speter 	}
180756Speter 	p->nl_flags &= ~NFORWD;
181756Speter #	ifdef OBJ
182756Speter 	    patch4(p->entloc);
183756Speter #	endif OBJ
184756Speter #	ifdef PC
185*3366Speter 	    sextname( extname , p -> symbol , bn );
186*3366Speter 	    putprintf( "%s:" , 0 , extname );
187756Speter #	endif PC
188756Speter 	if (p->value[NL_GOLEV] != NOTYET)
189756Speter 		if (p->value[NL_GOLEV] < level) {
190756Speter 			recovered();
191756Speter 			error("Goto %s from line %d is into a structured statement", s, p->value[NL_GOLINE]);
192756Speter 		}
193756Speter 	p->value[NL_GOLEV] = level;
194756Speter }
195756Speter #endif
196