xref: /csrg-svn/usr.bin/pascal/src/lab.c (revision 10655)
1 /* Copyright (c) 1979 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)lab.c 1.17 02/01/83";
4 
5 #include "whoami.h"
6 #include "0.h"
7 #include "tree.h"
8 #include "opcode.h"
9 #include "objfmt.h"
10 #ifdef PC
11 #   include	"pc.h"
12 #   include	"pcops.h"
13 #endif PC
14 
15 /*
16  * Label enters the definitions
17  * of the label declaration part
18  * into the namelist.
19  */
20 label(r, l)
21 	int *r, l;
22 {
23     static bool	label_order = FALSE;
24     static bool	label_seen = FALSE;
25 #ifdef PC
26 	char	extname[ BUFSIZ ];
27 #endif PC
28 #ifndef PI0
29 	register *ll;
30 	register struct nl *p, *lp;
31 
32 	lp = NIL;
33 #else
34 	send(REVLAB, r);
35 #endif
36 	if ( ! progseen ) {
37 	    level1();
38 	}
39 	line = l;
40 #ifndef PI1
41 	if (parts[ cbn ] & (CPRT|TPRT|VPRT|RPRT)){
42 	    if ( opt( 's' ) ) {
43 		standard();
44 		error("Label declarations should precede const, type, var and routine declarations");
45 	    } else {
46 		if ( !label_order ) {
47 		    label_order = TRUE;
48 		    warning();
49 		    error("Label declarations should precede const, type, var and routine declarations");
50 		}
51 	    }
52 	}
53 	if (parts[ cbn ] & LPRT) {
54 	    if ( opt( 's' ) ) {
55 		standard();
56 		error("All labels should be declared in one label part");
57 	    } else {
58 		if ( !label_seen ) {
59 		    label_seen = TRUE;
60 		    warning();
61 		    error("All labels should be declared in one label part");
62 		}
63 	    }
64 	}
65 	parts[ cbn ] |= LPRT;
66 #endif
67 #ifndef PI0
68 	for (ll = r; ll != NIL; ll = ll[2]) {
69 		l = getlab();
70 		p = enter(defnl(ll[1], LABEL, 0, l));
71 		/*
72 		 * Get the label for the eventual target
73 		 */
74 		p->value[1] = getlab();
75 		p->chain = lp;
76 		p->nl_flags |= (NFORWD|NMOD);
77 		p->value[NL_GOLEV] = NOTYET;
78 		p->value[NL_ENTLOC] = l;
79 		lp = p;
80 #		ifdef OBJ
81 		    /*
82 		     * This operator is between
83 		     * the bodies of two procedures
84 		     * and provides a target for
85 		     * gotos for this label via TRA.
86 		     */
87 		    putlab(l);
88 		    put(2, O_GOTO | cbn<<8, (long)p->value[1]);
89 #		endif OBJ
90 #		ifdef PC
91 		    /*
92 		     *	labels have to be .globl otherwise /lib/c2 may
93 		     *	throw them away if they aren't used in the function
94 		     *	which defines them.
95 		     */
96 		    extlabname( extname , p -> symbol , cbn );
97 		    putprintf("	.globl	%s", 0, extname);
98 		    if ( cbn == 1 ) {
99 			stabglabel( extname , line );
100 		    }
101 #		endif PC
102 	}
103 	gotos[cbn] = lp;
104 #	ifdef PTREE
105 	    {
106 		pPointer	Labels = LabelDCopy( r );
107 
108 		pDEF( PorFHeader[ nesting ] ).PorFLabels = Labels;
109 	    }
110 #	endif PTREE
111 #endif
112 }
113 
114 #ifndef PI0
115 /*
116  * Gotoop is called when
117  * we get a statement "goto label"
118  * and generates the needed tra.
119  */
120 gotoop(s)
121 	char *s;
122 {
123 	register struct nl *p;
124 #ifdef PC
125 	char	extname[ BUFSIZ ];
126 #endif PC
127 
128 	gocnt++;
129 	p = lookup(s);
130 	if (p == NIL)
131 		return (NIL);
132 #	ifdef OBJ
133 	    put(2, O_TRA4, (long)p->value[NL_ENTLOC]);
134 #	endif OBJ
135 #	ifdef PC
136 	    if ( cbn == bn ) {
137 		    /*
138 		     *	local goto.
139 		     */
140 		extlabname( extname , p -> symbol , bn );
141 		    /*
142 		     * this is a funny jump because it's to a label that
143 		     * has been declared global.
144 		     * Although this branch is within this module
145 		     * the assembler will complain that the destination
146 		     * is a global symbol.
147 		     * The complaint arises because the assembler
148 		     * doesn't change relative jumps into absolute jumps.
149 		     * and this  may cause a branch displacement overflow
150 		     * when the module is subsequently linked with
151 		     * the rest of the program.
152 		     */
153 #		ifdef vax
154 		    putprintf("	jmp	%s", 0, extname);
155 #		endif vax
156 #		ifdef mc68000
157 		    putprintf("	jra	%s", 0, extname);
158 #		endif mc68000
159 	    } else {
160 		    /*
161 		     *	Non-local goto.
162 		     *
163 		     *  Close all active files between top of stack and
164 		     *  frame at the destination level.	Then call longjmp
165 		     *	to unwind the stack to the destination level.
166 		     *
167 		     *	For nested routines the end of the frame
168 		     *	is calculated as:
169 		     *	    __disply[bn].fp + sizeof(local frame)
170 		     *	(adjusted by (sizeof int) to get just past the end).
171 		     *	The size of the local frame is dumped out by
172 		     *	the second pass as an assembler constant.
173 		     *	The main routine may not be compiled in this
174 		     *	module, so its size may not be available.
175 		     * 	However all of its variables will be globally
176 		     *	declared, so only the known runtime temporaries
177 		     *	will be in its stack frame.
178 		     */
179 		parts[ bn ] |= NONLOCALGOTO;
180 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
181 			, "_PCLOSE" );
182 		if ( bn > 1 ) {
183 		    p = lookup( enclosing[ bn - 1 ] );
184 		    sprintf( extname, "%s%d+%d",
185 			FRAME_SIZE_LABEL, p -> value[NL_ENTLOC], sizeof(int));
186 		    p = lookup(s);
187 		    putLV( extname , bn , 0 , NNLOCAL , P2PTR | P2CHAR );
188 		} else {
189 		    putLV( 0 , bn , -( DPOFF1 + sizeof( int ) ) , LOCALVAR ,
190 			P2PTR | P2CHAR );
191 		}
192 		putop( P2CALL , P2INT );
193 		putdot( filename , line );
194 		putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
195 			, "_longjmp" );
196 		putLV( 0 , bn , GOTOENVOFFSET , NLOCAL , P2PTR|P2STRTY );
197 		extlabname( extname , p -> symbol , bn );
198 		putLV( extname , 0 , 0 , NGLOBAL , P2PTR|P2STRTY );
199 		putop( P2LISTOP , P2INT );
200 		putop( P2CALL , P2INT );
201 		putdot( filename , line );
202 	    }
203 #	endif PC
204 	if (bn == cbn)
205 		if (p->nl_flags & NFORWD) {
206 			if (p->value[NL_GOLEV] == NOTYET) {
207 				p->value[NL_GOLEV] = level;
208 				p->value[NL_GOLINE] = line;
209 			}
210 		} else
211 			if (p->value[NL_GOLEV] == DEAD) {
212 				recovered();
213 				error("Goto %s is into a structured statement", p->symbol);
214 			}
215 }
216 
217 /*
218  * Labeled is called when a label
219  * definition is encountered, and
220  * marks that it has been found and
221  * patches the associated GOTO generated
222  * by gotoop.
223  */
224 labeled(s)
225 	char *s;
226 {
227 	register struct nl *p;
228 #ifdef PC
229 	char	extname[ BUFSIZ ];
230 #endif PC
231 
232 	p = lookup(s);
233 	if (p == NIL)
234 		return (NIL);
235 	if (bn != cbn) {
236 		error("Label %s not defined in correct block", s);
237 		return;
238 	}
239 	if ((p->nl_flags & NFORWD) == 0) {
240 		error("Label %s redefined", s);
241 		return;
242 	}
243 	p->nl_flags &= ~NFORWD;
244 #	ifdef OBJ
245 	    patch4(p->value[NL_ENTLOC]);
246 #	endif OBJ
247 #	ifdef PC
248 	    extlabname( extname , p -> symbol , bn );
249 	    putprintf( "%s:" , 0 , extname );
250 #	endif PC
251 	if (p->value[NL_GOLEV] != NOTYET)
252 		if (p->value[NL_GOLEV] < level) {
253 			recovered();
254 			error("Goto %s from line %d is into a structured statement", s, p->value[NL_GOLINE]);
255 		}
256 	p->value[NL_GOLEV] = level;
257 }
258 #endif
259 
260 #ifdef PC
261     /*
262      *	construct the long name of a label based on it's static nesting.
263      *	into a caller-supplied buffer (that should be about BUFSIZ big).
264      */
265 extlabname( buffer , name , level )
266     char	buffer[];
267     char	*name;
268     int		level;
269 {
270     char	*starthere;
271     int		i;
272 
273     starthere = &buffer[0];
274     for ( i = 1 ; i < level ; i++ ) {
275 	sprintf( starthere , EXTFORMAT , enclosing[ i ] );
276 	starthere += strlen( enclosing[ i ] ) + 1;
277     }
278     sprintf( starthere , EXTFORMAT , "" );
279     starthere += 1;
280     sprintf( starthere , LABELFORMAT , name );
281     starthere += strlen( name ) + 1;
282     if ( starthere >= &buffer[ BUFSIZ ] ) {
283 	panic( "extlabname" );
284     }
285 }
286 #endif PC
287