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