Diff | Source/Git

Download diff

	4b825dc642cb6eb9a060e54bf8d69288fbee4904		cfad47cfa334b206c65f22086bcc5d63e6f70944
		1	#ifdef RCSID
		2	static char RCSid[] =
		3	"$Header: d:/cvsroot/tads/tads3/TCT3STM.CPP,v 1.1 1999/07/11 00:46:57 MJRoberts Exp $";
		4	#endif
		5
		6	/*
		7	* Copyright (c) 1999, 2002 Michael J. Roberts. All Rights Reserved.
		8	*
		9	* Please see the accompanying license file, LICENSE.TXT, for information
		10	* on using and copying this software.
		11	*/
		12	/*
		13	Name
		14	tct3stm.cpp - TADS 3 Compiler - T3 VM Code Generator - statement classes
		15	Function
		16	Generate code for the T3 VM. This file contains statement classes,
		17	in order to segregate the code generation classes required for the
		18	full compiler from those required for subsets that require only
		19	expression parsing (such as debuggers).
		20	Notes
		21
		22	Modified
		23	05/08/99 MJRoberts - Creation
		24	*/
		25
		26	#include <stdio.h>
		27
		28	#include "t3std.h"
		29	#include "os.h"
		30	#include "tcprs.h"
		31	#include "tct3.h"
		32	#include "tcgen.h"
		33	#include "vmtype.h"
		34	#include "vmwrtimg.h"
		35	#include "vmfile.h"
		36	#include "tcmain.h"
		37	#include "tcerr.h"
		38
		39
		40	/* ------------------------------------------------------------------------ */
		41	/*
		42	* Code Body
		43	*/
		44
		45	/* callback context */
		46	struct write_local_to_debug_frame_ctx
		47	{
		48	/* number of symbols written so far */
		49	int count;
		50	};
		51
		52	/*
		53	* Callback for symbol table enumeration - write a local variable entry
		54	* to the code stream for a debug frame record.
		55	*/
		56	void CTPNCodeBody::write_local_to_debug_frame(void ctx0, CTcSymbol sym)
		57	{
		58	write_local_to_debug_frame_ctx *ctx;
		59
		60	/* cast our context */
		61	ctx = (write_local_to_debug_frame_ctx *)ctx0;
		62
		63	/* write it out */
		64	if (sym->write_to_debug_frame())
		65	{
		66	/* we wrote the symbol - count it */
		67	++(ctx->count);
		68	}
		69	}
		70
		71	/*
		72	* Build the debug information table for a code body
		73	*/
		74	void CTPNCodeBody::build_debug_table(ulong start_ofs)
		75	{
		76	size_t i;
		77	ulong post_ptr_ofs;
		78	ulong index_ofs;
		79	CTcPrsSymtab *frame;
		80
		81	/* fix up the debug record offset in the prolog to point here */
		82	G_cs->write2_at(start_ofs + 8, G_cs->get_ofs() - start_ofs);
		83
		84	/*
		85	* Add this offset to our list of line records. If we're creating
		86	* an object file, upon re-loading the object file, we'll need to go
		87	* through all of the line record tables and fix up the file
		88	* references to the new numbering system after loading, so we need
		89	* this memory of where the line record are.
		90	*/
		91	G_cg->add_debug_line_table(G_cs->get_ofs());
		92
		93	/* write the number of line records */
		94	G_cs->write2(G_cs->get_line_rec_count());
		95
		96	/* write the line records themselves */
		97	for (i = 0 ; i < G_cs->get_line_rec_count() ; ++i)
		98	{
		99	tcgen_line_t *rec;
		100
		101	/* get this record */
		102	rec = G_cs->get_line_rec(i);
		103
		104	/* write the offset of the statement's first opcode */
		105	G_cs->write2(rec->ofs);
		106
		107	/* write the source file ID and line number */
		108	G_cs->write2(rec->source_id);
		109	G_cs->write4(rec->source_line);
		110
		111	/* write the frame ID */
		112	G_cs->write2(rec->frame == 0 ? 0 : rec->frame->get_list_index());
		113	}
		114
		115	/*
		116	* write a placeholder pointer to the next byte after the end of the
		117	* frame table
		118	*/
		119	post_ptr_ofs = G_cs->get_ofs();
		120	G_cs->write2(0);
		121
		122	/* write the frame count */
		123	G_cs->write2(G_cs->get_frame_count());
		124
		125	/*
		126	* Write a placeholder frame index table. We will come back and fix
		127	* up this table as we actually write out the frames, but we don't
		128	* actually know how big the individual frame records will be yet,
		129	* so we can only write placeholders for them for now. First, note
		130	* where the frame index table begins.
		131	*/
		132	index_ofs = G_cs->get_ofs();
		133
		134	/* write the placeholder index entries */
		135	for (i = 0 ; i < G_cs->get_frame_count() ; ++i)
		136	G_cs->write2(0);
		137
		138	/* write the individual frames */
		139	for (frame = G_cs->get_first_frame() ; frame != 0 ;
		140	frame = frame->get_list_next())
		141	{
		142	ulong count_ofs;
		143	write_local_to_debug_frame_ctx cbctx;
		144
		145	/*
		146	* go back and fill in the correct offset (from the entry
		147	* itself) in the index table entry for this frame
		148	*/
		149	G_cs->write2_at(index_ofs, G_cs->get_ofs() - index_ofs);
		150
		151	/* move on to the next index entry */
		152	index_ofs += 2;
		153
		154	/* write the ID of the enclosing frame */
		155	G_cs->write2(frame->get_parent() == 0
		156	? 0 : frame->get_parent()->get_list_index());
		157
		158	/*
		159	* write a placeholder for the count of the number of entries in
		160	* the frame, and remember where the placeholder is so we can
		161	* come back and fix it up later
		162	*/
		163	count_ofs = G_cs->get_ofs();
		164	G_cs->write2(0);
		165
		166	/* initialize the enumeration callback context */
		167	cbctx.count = 0;
		168
		169	/* write this frame table's entries */
		170	frame->enum_entries(&write_local_to_debug_frame, &cbctx);
		171
		172	/* go back and fix up the symbol count */
		173	G_cs->write2_at(count_ofs, cbctx.count);
		174	}
		175
		176	/*
		177	* go back and fill in the post-pointer offset - this is a pointer
		178	* to the next byte after the end of the frame table; write the
		179	* offset from the post-pointer field to the current location
		180	*/
		181	G_cs->write2_at(post_ptr_ofs, G_cs->get_ofs() - post_ptr_ofs);
		182
		183	/*
		184	* write the required UINT4 zero value after the frame table - this
		185	* is a placeholder for future expansion (if we add more information
		186	* to the debug table later, this value will be non-zero to indicate
		187	* the presence of the additional information)
		188	*/
		189	G_cs->write4(0);
		190	}
		191
		192	/* ------------------------------------------------------------------------ */
		193	/*
		194	* 'if' statement
		195	*/
		196
		197	/*
		198	* generate code
		199	*/
		200	void CTPNStmIf::gen_code(int, int)
		201	{
		202	/* add a line record */
		203	add_debug_line_rec();
		204
		205	/*
		206	* if the condition has a constant value, don't bother generating
		207	* code for both branches
		208	*/
		209	if (cond_expr_->is_const())
		210	{
		211	int val;
		212
		213	/* determine whether it's true or false */
		214	val = cond_expr_->get_const_val()->get_val_bool();
		215
		216	/*
		217	* Warn about it if it's always false (in which case the 'then'
		218	* code is unreachable); or it's always true and we have an
		219	* 'else' part (since the 'else' part is unreachable). Don't
		220	* warn if it's true and there's no 'else' part, since this
		221	* merely means that there's some redundant source code, but
		222	* will have no effect on the generated code.
		223	*/
		224	if (!val)
		225	{
		226	/* it's false - the 'then' part cannot be executed */
		227	log_warning(TCERR_IF_ALWAYS_FALSE);
		228
		229	/* generate the 'else' part if there is one */
		230	if (else_part_ != 0)
		231	gen_code_substm(else_part_);
		232	}
		233	else
		234	{
		235	/* it's true - the 'else' part cannot be executed */
		236	if (else_part_ != 0)
		237	log_warning(TCERR_IF_ALWAYS_TRUE);
		238
		239	/* generate the 'then' part */
		240	if (then_part_ != 0)
		241	gen_code_substm(then_part_);
		242	}
		243
		244	/* we're done */
		245	return;
		246	}
		247
		248	/*
		249	* If both the 'then' and 'else' parts are null statements, we're
		250	* evaluating the condition purely for side effects. Simply
		251	* evaluate the condition in this case, since there's no need to so
		252	* much as test the condition once evaluated.
		253	*/
		254	if (then_part_ == 0 && else_part_ == 0)
		255	{
		256	/* generate the condition, discarding the result */
		257	cond_expr_->gen_code(TRUE, TRUE);
		258
		259	/* we're done */
		260	return;
		261	}
		262
		263	/*
		264	* The condition is non-constant, and we have at least one subclause,
		265	* so we must evaluate the condition expression. To minimize the
		266	* amount of jumping, check whether we have a true part, else part, or
		267	* both, and generate the branching accordingly.
		268	*/
		269	if (then_part_ != 0)
		270	{
		271	CTcCodeLabel *lbl_else;
		272	CTcCodeLabel *lbl_end;
		273
		274	/*
		275	* We have a true part, so we will want to evaluate the expression
		276	* and jump past the true part if the expression is false. Create
		277	* a label for the false branch.
		278	*/
		279	lbl_else = G_cs->new_label_fwd();
		280
		281	/* generate the condition expression */
		282	cond_expr_->gen_code_cond(0, lbl_else);
		283
		284	/* generate the 'then' part */
		285	gen_code_substm(then_part_);
		286
		287	/* if there's an 'else' part, generate it */
		288	if (else_part_ != 0)
		289	{
		290	/* at the end of the 'then' part, jump past the 'else' part */
		291	lbl_end = gen_jump_ahead(OPC_JMP);
		292
		293	/* this is the start of the 'else' part */
		294	def_label_pos(lbl_else);
		295
		296	/* generate the 'else' part */
		297	gen_code_substm(else_part_);
		298
		299	/* set the label for the jump over the 'else' part */
		300	def_label_pos(lbl_end);
		301	}
		302	else
		303	{
		304	/*
		305	* there's no 'else' part - set the label for the jump past the
		306	* 'then' part
		307	*/
		308	def_label_pos(lbl_else);
		309	}
		310	}
		311	else
		312	{
		313	CTcCodeLabel *lbl_end;
		314
		315	/*
		316	* There's no 'then' part, so there must be an 'else' part (we
		317	* wouldn't have gotten this far if both 'then' and 'else' are
		318	* empty). To minimize branching, evaluate the condition and jump
		319	* past the 'else' part if the condition is true, falling through
		320	* to the 'else' part otherwise. Create a label for the end of the
		321	* statement, which is also the empty 'then' part.
		322	*/
		323	lbl_end = G_cs->new_label_fwd();
		324
		325	/* evaluate the condition and jump to the end if it's true */
		326	cond_expr_->gen_code_cond(lbl_end, 0);
		327
		328	/* generate the 'else' part */
		329	gen_code_substm(else_part_);
		330
		331	/* set the label for the jump over the 'else' part */
		332	def_label_pos(lbl_end);
		333	}
		334	}
		335
		336	/* ------------------------------------------------------------------------ */
		337	/*
		338	* 'for' statement
		339	*/
		340
		341	/*
		342	* generate code
		343	*/
		344	void CTPNStmFor::gen_code(int, int)
		345	{
		346	CTcCodeLabel *top_lbl;
		347	CTcCodeLabel *end_lbl;
		348	CTcCodeLabel *cont_lbl;
		349	CTPNStmEnclosing *old_enclosing;
		350	CTcPrsSymtab *old_frame;
		351
		352	/* set my local frame if necessary */
		353	old_frame = G_cs->set_local_frame(symtab_);
		354
		355	/*
		356	* add a line record - note that we add the line record after
		357	* setting up the local frame, so that the 'for' statement itself
		358	* appears within its own inner scope
		359	*/
		360	add_debug_line_rec();
		361
		362	/* push the enclosing statement */
		363	old_enclosing = G_cs->set_enclosing(this);
		364
		365	/* if there's an initializer expression, generate it */
		366	if (init_expr_ != 0)
		367	init_expr_->gen_code(TRUE, TRUE);
		368
		369	/* set the label for the top of the loop */
		370	top_lbl = new_label_here();
		371
		372	/* allocate a forward label for 'continue' jumps */
		373	cont_lbl = G_cs->new_label_fwd();
		374
		375	/* allocate a forward label for the end of the loop */
		376	end_lbl = G_cs->new_label_fwd();
		377
		378	/*
		379	* If there's a condition, generate its code, jumping to the end of the
		380	* loop if the condition is false.
		381	*/
		382	if (cond_expr_ != 0)
		383	cond_expr_->gen_code_cond(0, end_lbl);
		384
		385	/*
		386	* set our labels, so that 'break' and 'continue' statements in our
		387	* body will know where to go
		388	*/
		389	break_lbl_ = end_lbl;
		390	cont_lbl_ = cont_lbl;
		391
		392	/* if we have a body, generate it */
		393	if (body_stm_ != 0)
		394	gen_code_substm(body_stm_);
		395
		396	/*
		397	* add another line record - we're now generating code again for the
		398	* original 'for' line, even though it's after the body
		399	*/
		400	//$$$ add_debug_line_rec();
		401
		402	/* this is where we come for 'continue' statements */
		403	def_label_pos(cont_lbl);
		404
		405	/* generate the reinitializer expression, if we have one */
		406	if (reinit_expr_ != 0)
		407	reinit_expr_->gen_code(TRUE, TRUE);
		408
		409	/* jump back to the top of the loop */
		410	G_cg->write_op(OPC_JMP);
		411	G_cs->write_ofs2(top_lbl, 0);
		412
		413	/*
		414	* we're at the end of the loop - this is where we jump for 'break'
		415	* and when the condition becomes false
		416	*/
		417	def_label_pos(end_lbl);
		418
		419	/* restore the enclosing statement */
		420	G_cs->set_enclosing(old_enclosing);
		421
		422	/* restore the enclosing local scope */
		423	G_cs->set_local_frame(old_frame);
		424	}
		425
		426	/* ------------------------------------------------------------------------ */
		427	/*
		428	* 'foreach' statement
		429	*/
		430
		431	/*
		432	* generate code
		433	*/
		434	void CTPNStmForeach::gen_code(int, int)
		435	{
		436	CTcCodeLabel *top_lbl;
		437	CTcCodeLabel *end_lbl;
		438	CTPNStmEnclosing *old_enclosing;
		439	CTcPrsSymtab *old_frame;
		440	CTcSymMetaclass *iter_meta;
		441	CTcSymProp *get_next_prop = 0;
		442	CTcSymProp *is_next_avail_prop = 0;
		443
		444	/* set my local frame if necessary */
		445	old_frame = G_cs->set_local_frame(symtab_);
		446
		447	/*
		448	* add a line record - note that we add the line record after
		449	* setting up the local frame, so that the 'for' statement itself
		450	* appears within its own inner scope
		451	*/
		452	add_debug_line_rec();
		453
		454	/* push the enclosing statement */
		455	old_enclosing = G_cs->set_enclosing(this);
		456
		457	/* if there's a collection expression, generate it */
		458	if (coll_expr_ != 0)
		459	{
		460	CTcSymMetaclass *coll_meta;
		461	CTcSymProp *create_iter_prop = 0;
		462
		463	/*
		464	* Look up the createIterator property of the Collection
		465	* metaclass. This property is defined by the Collection
		466	* specification as the property in the first slot in the method
		467	* table for Collection. If Collection isn't defined, or this
		468	* slot isn't defined, it's an error.
		469	*/
		470	coll_meta = G_cg->find_meta_sym("collection", 10);
		471	if (coll_meta != 0)
		472	{
		473	CTcSymMetaProp *mprop;
		474
		475	/* get the first entry in the metaclass property list */
		476	mprop = coll_meta->get_nth_prop(0);
		477
		478	/* if we got the entry, get its property */
		479	create_iter_prop = mprop->prop_;
		480	}
		481
		482	/* if we didn't find the property, it's an error */
		483	if (create_iter_prop == 0)
		484	{
		485	/* tell them about the problem */
		486	G_tok->log_error(TCERR_FOREACH_NO_CREATEITER);
		487	}
		488	else
		489	{
		490	CTcPrsNode *prop_expr;
		491
		492	/* construct an expression for the property */
		493	prop_expr = new CTPNSymResolved(create_iter_prop);
		494
		495	/*
		496	* generate a call to the createIterator() property on the
		497	* collection expression
		498	*/
		499	coll_expr_->gen_code_member(FALSE, prop_expr, FALSE, 0, FALSE);
		500
		501	/* assign the result to the internal iterator stack local */
		502	CTcSymLocal::s_gen_code_setlcl_stk(iter_local_id_, FALSE);
		503	}
		504	}
		505
		506	/* set the label for the top of the loop */
		507	top_lbl = new_label_here();
		508
		509	/* get the Iterator metaclass */
		510	iter_meta = G_cg->find_meta_sym("iterator", 8);
		511	if (iter_meta != 0)
		512	{
		513	CTcSymMetaProp *mprop;
		514
		515	/* get the getNext() property - it's in the first slot */
		516	if ((mprop = iter_meta->get_nth_prop(0)) != 0)
		517	get_next_prop = mprop->prop_;
		518
		519	/* get the isNextAvailable() property - it's in the second slot */
		520	if ((mprop = iter_meta->get_nth_prop(1)) != 0)
		521	is_next_avail_prop = mprop->prop_;
		522	}
		523
		524	/* generate the isNextAvailable test */
		525	if (is_next_avail_prop != 0)
		526	{
		527	CTcPrsNode *prop_expr;
		528
		529	/* get the internal iterator local */
		530	CTcSymLocal::s_gen_code_getlcl(iter_local_id_, FALSE);
		531
		532	/* create an expression for the property */
		533	prop_expr = new CTPNSymResolved(is_next_avail_prop);
		534
		535	/* generate a call to the property */
		536	CTcPrsNode::s_gen_member_rhs(FALSE, prop_expr, FALSE, 0, FALSE);
		537
		538	/* jump out of the loop if the expression is false */
		539	end_lbl = gen_jump_ahead(OPC_JF);
		540
		541	/* the JF pops an element off the stack */
		542	G_cg->note_pop();
		543	}
		544	else
		545	{
		546	/* this property is required to be defined - this is an error */
		547	G_tok->log_error(TCERR_FOREACH_NO_ISNEXTAVAIL);
		548
		549	/*
		550	* generate an arbitrary 'end' label - we're not going to end up
		551	* generating valid code anyway, but since we're not going to abort
		552	* code generation, it'll avoid problems elsewhere if we have a
		553	* valid label assigned
		554	*/
		555	end_lbl = new_label_here();
		556	}
		557
		558	/* generate the code to get the next element of the iteration */
		559	if (get_next_prop != 0)
		560	{
		561	CTcPrsNode *prop_expr;
		562
		563	/* get the internal iterator local */
		564	CTcSymLocal::s_gen_code_getlcl(iter_local_id_, FALSE);
		565
		566	/* create an expression for the property */
		567	prop_expr = new CTPNSymResolved(get_next_prop);
		568
		569	/* generate a call to the property */
		570	CTcPrsNode::s_gen_member_rhs(FALSE, prop_expr, FALSE, 0, FALSE);
		571
		572	/* assign the result to the iterator lvalue */
		573	if (iter_expr_ != 0)
		574	iter_expr_->gen_code_asi(TRUE, TC_ASI_SIMPLE, 0, FALSE);
		575	}
		576	else
		577	{
		578	/* this property is required to be defined - this is an error */
		579	G_tok->log_error(TCERR_FOREACH_NO_GETNEXT);
		580	}
		581
		582	/*
		583	* set our labels, so that 'break' and 'continue' statements in our
		584	* body will know where to go
		585	*/
		586	break_lbl_ = end_lbl;
		587	cont_lbl_ = top_lbl;
		588
		589	/* if we have a body, generate it */
		590	if (body_stm_ != 0)
		591	gen_code_substm(body_stm_);
		592
		593	/*
		594	* add another line record - we're now generating code again for the
		595	* original 'foreach' line, even though it's after the body
		596	*/
		597	//$$$ add_debug_line_rec();
		598
		599	/* jump back to the top of the loop */
		600	G_cg->write_op(OPC_JMP);
		601	G_cs->write_ofs2(top_lbl, 0);
		602
		603	/*
		604	* we're at the end of the loop - this is where we jump for 'break'
		605	* and when the condition becomes false
		606	*/
		607	if (end_lbl != 0)
		608	def_label_pos(end_lbl);
		609
		610	/* restore the enclosing statement */
		611	G_cs->set_enclosing(old_enclosing);
		612
		613	/* restore the enclosing local scope */
		614	G_cs->set_local_frame(old_frame);
		615	}
		616
		617	/* ------------------------------------------------------------------------ */
		618	/*
		619	* 'while' statement
		620	*/
		621
		622	/*
		623	* generate code
		624	*/
		625	void CTPNStmWhile::gen_code(int, int)
		626	{
		627	CTcCodeLabel *top_lbl;
		628	CTcCodeLabel *end_lbl;
		629	CTPNStmEnclosing *old_enclosing;
		630
		631	/* add a line record */
		632	add_debug_line_rec();
		633
		634	/* push the enclosing statement */
		635	old_enclosing = G_cs->set_enclosing(this);
		636
		637	/* set the label for the top of the loop */
		638	top_lbl = new_label_here();
		639
		640	/* generate a label for the end of the loop */
		641	end_lbl = G_cs->new_label_fwd();
		642
		643	/* generate the condition, jumping to the end of the loop if false */
		644	cond_expr_->gen_code_cond(0, end_lbl);
		645
		646	/*
		647	* set the 'break' and 'continue' label in our node, so that 'break'
		648	* and 'continue' statements in subnodes can find the labels during
		649	* code generation
		650	*/
		651	break_lbl_ = end_lbl;
		652	cont_lbl_ = top_lbl;
		653
		654	/* if we have a body, generate it */
		655	if (body_stm_ != 0)
		656	gen_code_substm(body_stm_);
		657
		658	/*
		659	* add another line record - the jump back to the top of the loop is
		660	* part of the 'while' itself
		661	*/
		662	//$$$ add_debug_line_rec();
		663
		664	/* jump back to the top of the loop */
		665	G_cg->write_op(OPC_JMP);
		666	G_cs->write_ofs2(top_lbl, 0);
		667
		668	/*
		669	* we're at the end of the loop - this is where we jump for 'break'
		670	* and when the condition becomes false
		671	*/
		672	def_label_pos(end_lbl);
		673
		674	/* restore the enclosing statement */
		675	G_cs->set_enclosing(old_enclosing);
		676	}
		677
		678
		679	/* ------------------------------------------------------------------------ */
		680	/*
		681	* 'do-while' statement
		682	*/
		683
		684	/*
		685	* generate code
		686	*/
		687	void CTPNStmDoWhile::gen_code(int, int)
		688	{
		689	CTcCodeLabel *top_lbl;
		690	CTcCodeLabel *end_lbl;
		691	CTcCodeLabel *cont_lbl;
		692	CTPNStmEnclosing *old_enclosing;
		693
		694	/* add a line record */
		695	add_debug_line_rec();
		696
		697	/* push the enclosing statement */
		698	old_enclosing = G_cs->set_enclosing(this);
		699
		700	/* set the label for the top of the loop */
		701	top_lbl = new_label_here();
		702
		703	/* create a label for after the loop, for any enclosed 'break's */
		704	end_lbl = G_cs->new_label_fwd();
		705
		706	/*
		707	* create a label for just before the expression, for any enclosed
		708	* 'continue' statements
		709	*/
		710	cont_lbl = G_cs->new_label_fwd();
		711
		712	/* set our 'break' and 'continue' labels in our node */
		713	break_lbl_ = end_lbl;
		714	cont_lbl_ = cont_lbl;
		715
		716	/* if we have a body, generate it */
		717	if (body_stm_ != 0)
		718	gen_code_substm(body_stm_);
		719
		720	/* set the debug source position to the 'while' clause's location */
		721	add_debug_line_rec(while_desc_, while_linenum_);
		722
		723	/* put the 'continue' label here, just before the condition */
		724	def_label_pos(cont_lbl);
		725
		726	/*
		727	* Generate the condition. If the condition is true, jump back to the
		728	* top label; otherwise fall through out of the loop structure.
		729	*/
		730	cond_expr_->gen_code_cond(top_lbl, 0);
		731
		732	/* we're past the end of the loop - this is where we jump for 'break' */
		733	def_label_pos(end_lbl);
		734
		735	/* restore the enclosing statement */
		736	G_cs->set_enclosing(old_enclosing);
		737	}
		738
		739
		740	/* ------------------------------------------------------------------------ */
		741	/*
		742	* 'break' statement
		743	*/
		744
		745	/*
		746	* generate code
		747	*/
		748	void CTPNStmBreak::gen_code(int, int)
		749	{
		750	/* add a line record */
		751	add_debug_line_rec();
		752
		753	/*
		754	* ask the enclosing statement to do the work - if there's no
		755	* enclosing statement, or none of the enclosing statements can
		756	* perform the break, it's an error
		757	*/
		758	if (G_cs->get_enclosing() == 0
		759	\|\| !G_cs->get_enclosing()->gen_code_break(lbl_, lbl_len_))
		760	{
		761	/*
		762	* log the error - if there's a label, the problem is that we
		763	* couldn't find the label, otherwise it's that we can't perform
		764	* a 'break' here at all
		765	*/
		766	if (lbl_ == 0)
		767	G_tok->log_error(TCERR_INVALID_BREAK);
		768	else
		769	G_tok->log_error(TCERR_INVALID_BREAK_LBL, (int)lbl_len_, lbl_);
		770	}
		771	}
		772
		773	/* ------------------------------------------------------------------------ */
		774	/*
		775	* 'continue' statement
		776	*/
		777
		778	/*
		779	* generate code
		780	*/
		781	void CTPNStmContinue::gen_code(int, int)
		782	{
		783	/* add a line record */
		784	add_debug_line_rec();
		785
		786	/*
		787	* ask the enclosing statement to do the work - if there's no
		788	* enclosing statement, or none of the enclosing statements can
		789	* perform the break, it's an error
		790	*/
		791	if (G_cs->get_enclosing() == 0
		792	\|\| !G_cs->get_enclosing()->gen_code_continue(lbl_, lbl_len_))
		793	{
		794	/*
		795	* log the error - if there's a label, the problem is that we
		796	* couldn't find the label, otherwise it's that we can't perform
		797	* a 'break' here at all
		798	*/
		799	if (lbl_ == 0)
		800	G_tok->log_error(TCERR_INVALID_CONTINUE);
		801	else
		802	G_tok->log_error(TCERR_INVALID_CONT_LBL, (int)lbl_len_, lbl_);
		803	}
		804	}
		805
		806	/* ------------------------------------------------------------------------ */
		807	/*
		808	* 'switch' statement
		809	*/
		810
		811	/*
		812	* generate code
		813	*/
		814	void CTPNStmSwitch::gen_code(int, int)
		815	{
		816	CTPNStmSwitch *enclosing_switch;
		817	int i;
		818	char buf[VMB_DATAHOLDER + VMB_UINT2];
		819	CTcCodeLabel *end_lbl;
		820	CTPNStmEnclosing *old_enclosing;
		821
		822	/* add a line record */
		823	add_debug_line_rec();
		824
		825	/* push the enclosing statement */
		826	old_enclosing = G_cs->set_enclosing(this);
		827
		828	/*
		829	* Generate the controlling expression. We want to keep the value,
		830	* hence 'discard' is false, and we need assignment (not 'for
		831	* condition') conversion rules, because we're going to use the
		832	* value in direct comparisons
		833	*/
		834	expr_->gen_code(FALSE, FALSE);
		835
		836	/* make myself the current innermost switch */
		837	enclosing_switch = G_cs->set_switch(this);
		838
		839	/*
		840	* if we can flow out of the switch, allocate a label for the end of
		841	* the switch body
		842	*/
		843	if ((get_control_flow(FALSE) & TCPRS_FLOW_NEXT) != 0)
		844	end_lbl = G_cs->new_label_fwd();
		845	else
		846	end_lbl = 0;
		847
		848	/* the end label is the 'break' location for subnodes */
		849	break_lbl_ = end_lbl;
		850
		851	/*
		852	* Write my SWITCH opcode, and the placeholder case table. We'll
		853	* fill in the case table with its real values as we encounter the
		854	* cases in the course of generating the code. For now, all we know
		855	* is the number of cases we need to put into the table.
		856	*/
		857	G_cg->write_op(OPC_SWITCH);
		858
		859	/* the SWITCH opcode pops the controlling expression value */
		860	G_cg->note_pop();
		861
		862	/* write the number of cases */
		863	G_cs->write2(case_cnt_);
		864
		865	/*
		866	* remember where the first case slot is - the 'case' parse nodes
		867	* will use this to figure out where to write their slot data
		868	*/
		869	case_slot_ofs_ = G_cs->get_ofs();
		870
		871	/*
		872	* Write the placeholder case slots - each case slot gets a
		873	* DATA_HOLDER for the case value, plus an INT2 for the branch
		874	* offset. For now, completely zero each case slot.
		875	*/
		876	memset(buf, 0, VMB_DATAHOLDER + VMB_UINT2);
		877	for (i = 0 ; i < case_cnt_ ; ++i)
		878	G_cs->write(buf, VMB_DATAHOLDER + VMB_UINT2);
		879
		880	/* write a placeholder for the default jump */
		881	if (has_default_)
		882	{
		883	/*
		884	* remember where the 'default' slot is, so that the 'default'
		885	* parse node can figure out where to write its branch offset
		886	*/
		887	default_slot_ofs_ = G_cs->get_ofs();
		888
		889	/*
		890	* Write the placeholder for the 'default' slot - this just gets
		891	* an INT2 for the 'default' jump offset. As with the case
		892	* labels, just zero it for now; we'll fill it in later when we
		893	* encounter the 'default' case.
		894	*/
		895	G_cs->write2(0);
		896	}
		897	else
		898	{
		899	/*
		900	* there's no default slot, so the 'default' slot is simply a
		901	* jump to the end of the switch body - generate a jump ahead to
		902	* our end label
		903	*/
		904	G_cs->write_ofs2(end_lbl, 0);
		905	}
		906
		907	/*
		908	* generate the switch body - this will fill in the case table as we
		909	* encounter the 'case' nodes in the parse tree
		910	*/
		911	if (body_ != 0)
		912	gen_code_substm(body_);
		913
		914	/*
		915	* We're past the body - if we have an end label, set it here. (We
		916	* won't have created an end label if control can't flow out of the
		917	* switch; this allows us to avoid generating unreachable instructions
		918	* after the switch, which would only increase the code size for no
		919	* reason.)
		920	*/
		921	if (end_lbl != 0)
		922	def_label_pos(end_lbl);
		923
		924	/* restore the enclosing switch */
		925	G_cs->set_switch(enclosing_switch);
		926
		927	/* restore the enclosing statement */
		928	G_cs->set_enclosing(old_enclosing);
		929	}
		930
		931	/* ------------------------------------------------------------------------ */
		932	/*
		933	* 'case' label statement
		934	*/
		935
		936	/*
		937	* generate code
		938	*/
		939	void CTPNStmCase::gen_code(int, int)
		940	{
		941	ulong slot_ofs;
		942	ulong jump_ofs;
		943
		944	/*
		945	* we must have an active 'switch' statement, and our expression
		946	* value must be a constant -- if either of these is not true, we
		947	* have an internal error of some kind, because we should never get
		948	* this far if these conditions weren't true
		949	*/
		950	if (G_cs->get_switch() == 0 \|\| !expr_->is_const())
		951	G_tok->throw_internal_error(TCERR_GEN_BAD_CASE);
		952
		953	/* allocate our case slot from the enclosing 'switch' statement */
		954	slot_ofs = G_cs->get_switch()->alloc_case_slot();
		955
		956	/* write the case table entry as a DATAHOLDER value */
		957	G_cg->write_const_as_dh(G_cs, slot_ofs, expr_->get_const_val());
		958
		959	/*
		960	* Add the jump offset. This is the offset from this INT2 entry in
		961	* our case slot to the current output offset. The INT2 is offset
		962	* from the start of our slot by the DATAHOLDER value.
		963	*/
		964	jump_ofs = G_cs->get_ofs() - (slot_ofs + VMB_DATAHOLDER);
		965	G_cs->write2_at(slot_ofs + VMB_DATAHOLDER, (int)jump_ofs);
		966
		967	/*
		968	* because we can jump here (via the case table), we cannot allow
		969	* peephole optimizations from past instructions - clear the
		970	* peephole
		971	*/
		972	G_cg->clear_peephole();
		973
		974	/* generate our substatement, if we have one */
		975	if (stm_ != 0)
		976	gen_code_substm(stm_);
		977	}
		978
		979	/* ------------------------------------------------------------------------ */
		980	/*
		981	* 'default' label statement
		982	*/
		983
		984	/*
		985	* generate code
		986	*/
		987	void CTPNStmDefault::gen_code(int, int)
		988	{
		989	ulong slot_ofs;
		990	char buf[VMB_UINT2];
		991	ulong jump_ofs;
		992
		993	/*
		994	* we must have an active 'switch' statement -- if we don't, we have
		995	* an internal error of some kind, because we should never have
		996	* gotten this far
		997	*/
		998	if (G_cs->get_switch() == 0)
		999	G_tok->throw_internal_error(TCERR_GEN_BAD_CASE);
		1000
		1001	/* ask the switch where our slot goes */
		1002	slot_ofs = G_cs->get_switch()->get_default_slot();
		1003
		1004	/*
		1005	* Set the jump offset. This is the offset from our slot entry in
		1006	* the case table to the current output offset.
		1007	*/
		1008	jump_ofs = G_cs->get_ofs() - slot_ofs;
		1009	oswp2(buf, (int)jump_ofs);
		1010
		1011	/* write our slot entry to the case table */
		1012	G_cs->write_at(slot_ofs, buf, VMB_UINT2);
		1013
		1014	/*
		1015	* because we can jump here (via the case table), we cannot allow
		1016	* peephole optimizations from past instructions - clear the
		1017	* peephole
		1018	*/
		1019	G_cg->clear_peephole();
		1020
		1021	/* generate our substatement, if we have one */
		1022	if (stm_ != 0)
		1023	gen_code_substm(stm_);
		1024	}
		1025
		1026	/* ------------------------------------------------------------------------ */
		1027	/*
		1028	* code label statement
		1029	*/
		1030
		1031	/*
		1032	* ininitialize
		1033	*/
		1034	CTPNStmLabel::CTPNStmLabel(CTcSymLabel lbl, CTPNStmEnclosing enclosing)
		1035	: CTPNStmLabelBase(lbl, enclosing)
		1036	{
		1037	/*
		1038	* we don't have a 'goto' label yet - we'll allocate it on demand
		1039	* during code generation (labels are local in scope to a code body
		1040	* so we can't allocate this until code generation begins for our
		1041	* containing code body)
		1042	*/
		1043	goto_label_ = 0;
		1044
		1045	/*
		1046	* we don't yet have a 'break' label - we'll allocate this when
		1047	* someone first refers to it
		1048	*/
		1049	break_label_ = 0;
		1050	}
		1051
		1052	/*
		1053	* get our code label
		1054	*/
		1055	CTcCodeLabel *CTPNStmLabel::get_goto_label()
		1056	{
		1057	/* if we don't have a label already, allocate it */
		1058	if (goto_label_ == 0)
		1059	goto_label_ = G_cs->new_label_fwd();
		1060
		1061	/* return the label */
		1062	return goto_label_;
		1063	}
		1064
		1065	/*
		1066	* generate code
		1067	*/
		1068	void CTPNStmLabel::gen_code(int, int)
		1069	{
		1070	CTPNStmEnclosing *old_enclosing;
		1071
		1072	/* push the enclosing statement */
		1073	old_enclosing = G_cs->set_enclosing(this);
		1074
		1075	/*
		1076	* Define our label position - this is where we come if someone does
		1077	* a 'goto' to this label. (Note that we might not have a 'goto'
		1078	* label defined yet - if we weren't forward-referenced by a 'goto'
		1079	* statement, we won't have a label defined. Call get_goto_label()
		1080	* to ensure we create a label if it doesn't already exist.)
		1081	*/
		1082	def_label_pos(get_goto_label());
		1083
		1084	/*
		1085	* add the source location of the label - this probably will have no
		1086	* effect, since we don't generate any code for the label itself,
		1087	* but it's harmless so do it anyway to guard against weird cases
		1088	*/
		1089	add_debug_line_rec();
		1090
		1091	/*
		1092	* generate code for the labeled statement, discarding any
		1093	* calculated value
		1094	*/
		1095	if (stm_ != 0)
		1096	gen_code_substm(stm_);
		1097
		1098	/*
		1099	* If we have a 'break' label, it means that code within our labeled
		1100	* statement (i.e., nested within the label) did a 'break' to leave
		1101	* the labeled statement. The target of the break is the next
		1102	* statement after the labeled statement, which comes next, so
		1103	* define the label here.
		1104	*/
		1105	if (break_label_ != 0)
		1106	def_label_pos(break_label_);
		1107
		1108	/* restore the enclosing statement */
		1109	G_cs->set_enclosing(old_enclosing);
		1110	}
		1111
		1112
		1113	/*
		1114	* generate code for a 'break'
		1115	*/
		1116	int CTPNStmLabel::gen_code_break(const textchar_t *lbl, size_t lbl_len)
		1117	{
		1118	/*
		1119	* If the 'break' doesn't specify a label, inherit the default
		1120	* handling, since we're not a default 'break' target. If there's a
		1121	* label, and the label isn't our label, also inherit the default,
		1122	* since the target lies somewhere else.
		1123	*/
		1124	if (lbl == 0 \|\| G_cs->get_goto_symtab() == 0
		1125	\|\| G_cs->get_goto_symtab()->find(lbl, lbl_len) != lbl_)
		1126	return CTPNStmLabelBase::gen_code_break(lbl, lbl_len);
		1127
		1128	/*
		1129	* if we don't yet have a 'break' label defined, define one now
		1130	* (it's a forward declaration, because we won't know where it goes
		1131	* until we finish generating the entire body of the statement
		1132	* contained in the label)
		1133	*/
		1134	if (break_label_ == 0)
		1135	break_label_ = G_cs->new_label_fwd();
		1136
		1137	/* jump to the label */
		1138	G_cg->write_op(OPC_JMP);
		1139	G_cs->write_ofs2(break_label_, 0);
		1140
		1141	/* handled */
		1142	return TRUE;
		1143	}
		1144
		1145
		1146	/*
		1147	* generate code for a 'continue'
		1148	*/
		1149	int CTPNStmLabel::gen_code_continue(const textchar_t *lbl, size_t lbl_len)
		1150	{
		1151	/*
		1152	* If there's no label, inherit the default handling, since we're
		1153	* not a default 'continue' target. If there's a label, and the
		1154	* label isn't our label, also inherit the default, since the target
		1155	* lies somewhere else.
		1156	*/
		1157	if (lbl == 0 \|\| G_cs->get_goto_symtab() == 0
		1158	\|\| G_cs->get_goto_symtab()->find(lbl, lbl_len) != lbl_)
		1159	return CTPNStmLabelBase::gen_code_continue(lbl, lbl_len);
		1160
		1161	/*
		1162	* It's a 'continue' with my label - ask my enclosed statement to do
		1163	* the work; return failure if I have no enclosed statement. Note
		1164	* that we use a special call - generate a labeled continue - to
		1165	* let the statement know that it must perform the 'continue'
		1166	* itself and cannot defer to enclosing statements.
		1167	*/
		1168	if (stm_ != 0)
		1169	return stm_->gen_code_labeled_continue();
		1170	else
		1171	return FALSE;
		1172	}
		1173
		1174
		1175	/* ------------------------------------------------------------------------ */
		1176	/*
		1177	* 'try'
		1178	*/
		1179
		1180	/*
		1181	* generate code
		1182	*/
		1183	void CTPNStmTry::gen_code(int, int)
		1184	{
		1185	ulong start_ofs;
		1186	ulong end_ofs;
		1187	CTPNStmCatch *cur_catch;
		1188	CTcCodeLabel *end_lbl;
		1189	CTPNStmEnclosing *old_enclosing;
		1190	int finally_never_returns;
		1191
		1192	/* we have no end label yet */
		1193	end_lbl = 0;
		1194
		1195	/*
		1196	* add the source location of the 'try' - it probably won't be
		1197	* needed, because we don't generate any code before the protected
		1198	* body, but it's harmless and makes sure we have a good source
		1199	* location in weird cases
		1200	*/
		1201	add_debug_line_rec();
		1202
		1203	/* push the enclosing statement */
		1204	old_enclosing = G_cs->set_enclosing(this);
		1205
		1206	/*
		1207	* If we have a 'finally' clause, we must allocate a
		1208	* forward-reference code label for it. We need to be able to reach
		1209	* the 'finally' clause throughout generation of the protected code
		1210	* and the 'catch' blocks.
		1211	*/
		1212	if (finally_stm_ != 0)
		1213	finally_lbl_ = G_cs->new_label_fwd();
		1214	else
		1215	finally_lbl_ = 0;
		1216
		1217	/* note where the protected code begins */
		1218	start_ofs = G_cs->get_ofs();
		1219
		1220	/* generate the protected code */
		1221	if (body_stm_ != 0)
		1222	gen_code_substm(body_stm_);
		1223
		1224	/*
		1225	* Check to see if we have a 'finally' block that never returns. If we
		1226	* have a 'finally' block, and it doesn't flow to its next statement,
		1227	* then our LJSR's to the 'finally' block will never return.
		1228	*/
		1229	finally_never_returns =
		1230	(finally_stm_ != 0
		1231	&& (finally_stm_->get_control_flow(FALSE) & TCPRS_FLOW_NEXT) == 0);
		1232
		1233	/*
		1234	* if there's a "finally" clause, we must generate a local subroutine
		1235	* call to the "finally" block
		1236	*/
		1237	gen_jsr_finally();
		1238
		1239	/*
		1240	* We must now jump past the "catch" and "finally" code blocks. If the
		1241	* "finally" block itself doesn't flow to the next statement, then
		1242	* there's no need to do this, since we'll never be reached here. If
		1243	* there's no "finally" block, then we won't have LJSR'd anywhere, so
		1244	* this code is definitely reachable.
		1245	*/
		1246	if (!finally_never_returns)
		1247	end_lbl = gen_jump_ahead(OPC_JMP);
		1248
		1249	/*
		1250	* Note where the protected code ends - it ends at one byte below
		1251	* the current write offset, because the current write offset is the
		1252	* next byte we'll write. The code range we store in the exception
		1253	* table is inclusive of the endpoints.
		1254	*/
		1255	end_ofs = G_cs->get_ofs() - 1;
		1256
		1257	/* generate the 'catch' blocks */
		1258	for (cur_catch = first_catch_stm_ ; cur_catch != 0 ;
		1259	cur_catch = cur_catch->get_next_catch())
		1260	{
		1261	/* generate the 'catch' block */
		1262	cur_catch->gen_code_catch(start_ofs, end_ofs);
		1263
		1264	/* call the 'finally' block after the 'catch' finishes */
		1265	gen_jsr_finally();
		1266
		1267	/*
		1268	* If there's a finally block, or there's another 'catch' after me,
		1269	* generate a jump past the remaining catch/finally blocks.
		1270	*
		1271	* If we do have a finally that doesn't flow to the next statement
		1272	* (i.e., we throw or return out of the finally), then there's no
		1273	* need to generate a jump, since we'll never come back here from
		1274	* the finally block.
		1275	*/
		1276	if (!finally_never_returns
		1277	&& (finally_stm_ != 0 \|\| cur_catch->get_next_catch() != 0))
		1278	{
		1279	/*
		1280	* if we have no end label yet, generate one now - we might
		1281	* not have one because we might not have been able to reach
		1282	* any previous jump to the end of the catch (because we threw
		1283	* or returned out of the end of all blocks to this point, for
		1284	* example)
		1285	*/
		1286	if (end_lbl == 0)
		1287	{
		1288	/* we have no label - generate a new one now */
		1289	end_lbl = gen_jump_ahead(OPC_JMP);
		1290	}
		1291	else
		1292	{
		1293	/* we already have an end label - generate a jump to it */
		1294	G_cg->write_op(OPC_JMP);
		1295	G_cs->write_ofs2(end_lbl, 0);
		1296	}
		1297	}
		1298	}
		1299
		1300	/*
		1301	* Restore the enclosing statement. We enclose the protected code
		1302	* and all of the 'catch' blocks, because all of these must leave
		1303	* through the 'finally' handler. We do not, however, enclose the
		1304	* 'finally' handler itself - once it's entered, we do not invoke it
		1305	* again as it leaves.
		1306	*/
		1307	G_cs->set_enclosing(old_enclosing);
		1308
		1309	/* generate the 'finally' block, if we have one */
		1310	if (finally_stm_ != 0)
		1311	{
		1312	/*
		1313	* Generate the 'finally' code. The 'finally' block is executed
		1314	* for the 'try' block plus all of the 'catch' blocks, so the
		1315	* ending offset is the current position (less one byte, since
		1316	* the range is inclusive), which encompasses all of the 'catch'
		1317	* blocks
		1318	*/
		1319	finally_stm_->gen_code_finally(start_ofs, G_cs->get_ofs() - 1, this);
		1320	}
		1321
		1322	/*
		1323	* we're now past all of the "catch" and "finally" blocks, so we can
		1324	* define the jump label for jumping past those blocks (we make this
		1325	* jump from the end of the protected code) - note that we might not
		1326	* have actually generated the label, since we might never have
		1327	* reached any code which jumped to it
		1328	*/
		1329	if (end_lbl != 0)
		1330	def_label_pos(end_lbl);
		1331	}
		1332
		1333	/*
		1334	* Generate code for a 'break' within our protected code or a 'catch'.
		1335	* We'll first generate a call to our 'finally' block, if we have one,
		1336	* then let the enclosing statement handle the break.
		1337	*/
		1338	int CTPNStmTry::gen_code_break(const textchar_t *lbl, size_t lbl_len)
		1339	{
		1340	/* if we have a 'finally' block, invoke it as a local subroutine call */
		1341	gen_jsr_finally();
		1342
		1343	/*
		1344	* If there's an enclosing statement, let it generate the break; if
		1345	* there's not, return failure, because we're not a meaningful
		1346	* target for break.
		1347	*/
		1348	if (enclosing_)
		1349	return enclosing_->gen_code_break(lbl, lbl_len);
		1350	else
		1351	return FALSE;
		1352	}
		1353
		1354	/*
		1355	* Generate code for a 'break' within our protected code or a 'catch'.
		1356	* We'll first generate a call to our 'finally' block, if we have one,
		1357	* then let the enclosing statement handle the break.
		1358	*/
		1359	int CTPNStmTry::gen_code_continue(const textchar_t *lbl, size_t lbl_len)
		1360	{
		1361	/* if we have a 'finally' block, invoke it as a local subroutine call */
		1362	gen_jsr_finally();
		1363
		1364	/*
		1365	* if there's an enclosing statement, let it generate the continue;
		1366	* if there's not, return failure, because we're not a meaningful
		1367	* target for continue
		1368	*/
		1369	if (enclosing_)
		1370	return enclosing_->gen_code_continue(lbl, lbl_len);
		1371	else
		1372	return FALSE;
		1373	}
		1374
		1375	/*
		1376	* Generate a local subroutine call to our 'finally' block, if we have
		1377	* one. This should be used when executing a break, continue, goto, or
		1378	* return out of the protected code or a 'catch' block, or when merely
		1379	* falling off the end of the protected code or 'catch' block.
		1380	*/
		1381	void CTPNStmTry::gen_jsr_finally()
		1382	{
		1383	/* if we have a 'finally', call it */
		1384	if (finally_lbl_ != 0)
		1385	{
		1386	/* generate the local subroutine call */
		1387	G_cg->write_op(OPC_LJSR);
		1388	G_cs->write_ofs2(finally_lbl_, 0);
		1389
		1390	/*
		1391	* the LJSR pushes a value, which is then immediately popped (we
		1392	* must note the push and pop because it affects our maximum
		1393	* stack depth requirement)
		1394	*/
		1395	G_cg->note_push();
		1396	G_cg->note_pop();
		1397
		1398	/*
		1399	* whatever follows the LJSR is logically at the end of the
		1400	* 'finally' block
		1401	*/
		1402	add_debug_line_rec(finally_stm_->get_end_desc(),
		1403	finally_stm_->get_end_linenum());
		1404	}
		1405	}
		1406
		1407
		1408	/* ------------------------------------------------------------------------ */
		1409	/*
		1410	* 'catch'
		1411	*/
		1412
		1413	/*
		1414	* generate code
		1415	*/
		1416	void CTPNStmCatch::gen_code(int, int)
		1417	{
		1418	/* this can't be called directly - use gen_code_catch() instead */
		1419	G_tok->throw_internal_error(TCERR_CATCH_FINALLY_GEN_CODE);
		1420	}
		1421
		1422	/*
		1423	* generate code for the 'catch'
		1424	*/
		1425	void CTPNStmCatch::gen_code_catch(ulong start_prot_ofs, ulong end_prot_ofs)
		1426	{
		1427	CTcSymbol *sym;
		1428	ulong exc_obj_id;
		1429	CTcPrsSymtab *old_frame;
		1430
		1431	/* add the source location of the 'catch' clause */
		1432	add_debug_line_rec();
		1433
		1434	/* set the local scope */
		1435	old_frame = G_cs->set_local_frame(symtab_);
		1436
		1437	/* look up the object defining the class of exceptions to catch */
		1438	sym = G_cs->get_symtab()->find_or_def_undef(exc_class_,
		1439	exc_class_len_, FALSE);
		1440
		1441	/* assume we won't find a valid object ID */
		1442	exc_obj_id = VM_INVALID_OBJ;
		1443
		1444	/* if it's an object, get its ID */
		1445	if (sym->get_type() == TC_SYM_OBJ)
		1446	{
		1447	/* get its object ID */
		1448	exc_obj_id = ((CTcSymObj *)sym)->get_obj_id();
		1449	}
		1450	else if (sym->get_type() != TC_SYM_UNKNOWN)
		1451	{
		1452	/*
		1453	* it's defined, but it's not an object - log an error (note
		1454	* that we don't log an error if the symbol is undefined,
		1455	* because find_or_def_undef() will already have logged an error
		1456	* for us)
		1457	*/
		1458	log_error(TCERR_CATCH_EXC_NOT_OBJ, (int)exc_class_len_, exc_class_);
		1459	}
		1460
		1461	/* add our exception table entry */
		1462	G_cg->get_exc_table()->add_catch(start_prot_ofs, end_prot_ofs,
		1463	exc_obj_id, G_cs->get_ofs());
		1464
		1465	/* don't allow any peephole optimizations to affect this offset */
		1466	G_cg->clear_peephole();
		1467
		1468	/*
		1469	* the VM automatically pushes a value onto the stack to perform the
		1470	* 'catch'
		1471	*/
		1472	G_cg->note_push();
		1473
		1474	/*
		1475	* generate a SETLCL for our formal parameter, so that the exception
		1476	* object is stored in our local variable
		1477	*/
		1478	exc_var_->gen_code_setlcl();
		1479
		1480	/* generate code for our statement, if we have one */
		1481	if (body_ != 0)
		1482	gen_code_substm(body_);
		1483
		1484	/* restore the enclosing local scope */
		1485	G_cs->set_local_frame(old_frame);
		1486	}
		1487
		1488	/* ------------------------------------------------------------------------ */
		1489	/*
		1490	* 'finally'
		1491	*/
		1492
		1493	/*
		1494	* generate code
		1495	*/
		1496	void CTPNStmFinally::gen_code(int, int)
		1497	{
		1498	/* this can't be called directly - use gen_code_finally() instead */
		1499	G_tok->throw_internal_error(TCERR_CATCH_FINALLY_GEN_CODE);
		1500	}
		1501
		1502
		1503	/*
		1504	* generate code for the 'finally'
		1505	*/
		1506	void CTPNStmFinally::gen_code_finally(ulong start_prot_ofs,
		1507	ulong end_prot_ofs,
		1508	CTPNStmTry *try_stm)
		1509	{
		1510	CTPNStmEnclosing *old_enclosing;
		1511
		1512	/*
		1513	* set the source location for our prolog code to the 'finally'
		1514	* clause's start
		1515	*/
		1516	add_debug_line_rec();
		1517
		1518	/* push the enclosing statement */
		1519	old_enclosing = G_cs->set_enclosing(this);
		1520
		1521	/*
		1522	* add our exception table entry - use the invalid object ID as a
		1523	* special flag to indicate that we catch all exceptions
		1524	*/
		1525	G_cg->get_exc_table()->add_catch(start_prot_ofs, end_prot_ofs,
		1526	VM_INVALID_OBJ, G_cs->get_ofs());
		1527
		1528	/* don't allow any peephole optimizations to affect this offset */
		1529	G_cg->clear_peephole();
		1530
		1531	/* the VM pushes the exception onto the stack before calling us */
		1532	G_cg->note_push();
		1533
		1534	/*
		1535	* When we get called due to an exception, we want to run the
		1536	* 'finally' code block and then re-throw the exception. First, store
		1537	* the exception parameter in our special local stack slot that we
		1538	* allocated specifically for the purpose of being a temporary holder
		1539	* for this value.
		1540	*/
		1541	CTcSymLocal::s_gen_code_setlcl_stk(exc_local_id_, FALSE);
		1542
		1543	/* call the 'finally' block */
		1544	try_stm->gen_jsr_finally();
		1545
		1546	/*
		1547	* After the 'finally' block returns, we must re-throw the
		1548	* exception. Retrieve the contents of our local where we stashed
		1549	* the exception object and re-throw the exception.
		1550	*/
		1551	CTcSymLocal::s_gen_code_getlcl(exc_local_id_, FALSE);
		1552
		1553	/* re-throw the exception - this pops the exception object */
		1554	G_cg->write_op(OPC_THROW);
		1555	G_cg->note_pop();
		1556
		1557	/*
		1558	* set the source location to the 'finally' clause once again, since
		1559	* we changed the source location in the course of generating the
		1560	* catch-all handler
		1561	*/
		1562	add_debug_line_rec();
		1563
		1564	/* this is where the 'finally' code block begins - define our label */
		1565	def_label_pos(try_stm->get_finally_lbl());
		1566
		1567	/*
		1568	* The 'finally' block is the target of LJSR instructions, since we
		1569	* must run the 'finally' block's code from numerous code paths.
		1570	* The first thing we must do is pop the return address and stash it
		1571	* in a local variable. (We note an extra push, since the LJSR will
		1572	* have pushed the value before transferring control here.)
		1573	*/
		1574	G_cg->note_push();
		1575	CTcSymLocal::s_gen_code_setlcl_stk(jsr_local_id_, FALSE);
		1576
		1577	/* generate the code block, if there is one */
		1578	if (body_ != 0)
		1579	gen_code_substm(body_);
		1580
		1581	/* return from the 'finally' subroutine */
		1582	G_cg->write_op(OPC_LRET);
		1583	G_cs->write2(jsr_local_id_);
		1584
		1585	/* restore the enclosing statement */
		1586	G_cs->set_enclosing(old_enclosing);
		1587	}
		1588
		1589	/*
		1590	* It is not legal to enter a 'finally' block via a 'goto' statement,
		1591	* because there is no valid way to exit the 'finally' block in this
		1592	* case.
		1593	*/
		1594	int CTPNStmFinally::check_enter_by_goto(CTPNStmGoto *goto_stm,
		1595	CTPNStmLabel *)
		1596	{
		1597	/* this is illegal - log an error */
		1598	goto_stm->log_error(TCERR_GOTO_INTO_FINALLY);
		1599
		1600	/* indicate that it's not allowed */
		1601	return FALSE;
		1602	}
		1603
		1604
		1605	/* ------------------------------------------------------------------------ */
		1606	/*
		1607	* 'throw' statement
		1608	*/
		1609
		1610	/*
		1611	* generate code
		1612	*/
		1613	void CTPNStmThrow::gen_code(int, int)
		1614	{
		1615	/* add a line record */
		1616	add_debug_line_rec();
		1617
		1618	/*
		1619	* generate our expression - we use the result (discard = false),
		1620	* and we are effectively assigning the result, so we can't use the
		1621	* 'for condition' rules
		1622	*/
		1623	expr_->gen_code(FALSE, FALSE);
		1624
		1625	/* generate the 'throw' */
		1626	G_cg->write_op(OPC_THROW);
		1627
		1628	/* 'throw' pops the expression from the stack */
		1629	G_cg->note_pop();
		1630	}
		1631
		1632	/* ------------------------------------------------------------------------ */
		1633	/*
		1634	* 'goto' statement
		1635	*/
		1636
		1637	/*
		1638	* generate code
		1639	*/
		1640	void CTPNStmGoto::gen_code(int, int)
		1641	{
		1642	CTcSymbol *sym;
		1643	CTPNStmLabel *label_stm;
		1644
		1645	/* add a line record */
		1646	add_debug_line_rec();
		1647
		1648	/*
		1649	* look up our label symbol in the 'goto' table for the function,
		1650	* and get the label statement node from the label
		1651	*/
		1652	if (G_cs->get_goto_symtab() == 0
		1653	\|\| (sym = G_cs->get_goto_symtab()->find(lbl_, lbl_len_)) == 0
		1654	\|\| sym->get_type() != TC_SYM_LABEL
		1655	\|\| (label_stm = ((CTcSymLabel *)sym)->get_stm()) == 0)
		1656	{
		1657	/* log an error */
		1658	log_error(TCERR_INVALID_GOTO_LBL, (int)lbl_len_, lbl_);
		1659
		1660	/* give up */
		1661	return;
		1662	}
		1663
		1664	/*
		1665	* Tell any enclosing statements to unwind their 'try' blocks for a
		1666	* transfer to the given label. We only need to go as far as the
		1667	* most deeply nested enclosing statement we have in common with the
		1668	* label, because we'll be transferring control entirely within the
		1669	* confines of that enclosing statement.
		1670	*/
		1671	if (G_cs->get_enclosing() != 0)
		1672	{
		1673	/* generate the unwinding code */
		1674	G_cs->get_enclosing()->gen_code_unwind_for_goto(this, label_stm);
		1675	}
		1676	else
		1677	{
		1678	CTPNStmEnclosing *enc;
		1679
		1680	/*
		1681	* The 'goto' isn't enclosed in any statements. This means that
		1682	* we are entering every block that contains the target label.
		1683	* Some blocks don't allow entering via 'goto', so we must check
		1684	* at this point to see if any of the enclosing blocks are
		1685	* problematic.
		1686	*/
		1687	for (enc = label_stm ; enc != 0 ; enc = enc->get_enclosing())
		1688	{
		1689	/*
		1690	* make sure we're allowed to enter this statement - if not,
		1691	* stop scanning, so that we display only one such error
		1692	*/
		1693	if (!enc->check_enter_by_goto(this, label_stm))
		1694	break;
		1695	}
		1696	}
		1697
		1698	/* generate a jump to the label */
		1699	G_cg->write_op(OPC_JMP);
		1700	G_cs->write_ofs2(label_stm->get_goto_label(), 0);
		1701	}
		1702
		1703
		1704	/* ------------------------------------------------------------------------ */
		1705	/*
		1706	* Generic enclosing statement node
		1707	*/
		1708
		1709	/*
		1710	* Generate code for a break, given the target code label object and the
		1711	* target label symbol, if any. This can be used for any of the looping
		1712	* statement types.
		1713	*/
		1714	int CTPNStmEnclosing::gen_code_break_loop(CTcCodeLabel *code_label,
		1715	const textchar_t *lbl,
		1716	size_t lbl_len)
		1717	{
		1718	/*
		1719	* If the statement is labeled, let the enclosing statement handle
		1720	* it -- since it's labeled, we can't assume the statement refers to
		1721	* us without searching for the enclosing label.
		1722	*/
		1723	if (lbl != 0)
		1724	{
		1725	/* if there's an enclosing statement, let it handle it */
		1726	if (enclosing_ != 0)
		1727	return enclosing_->gen_code_break(lbl, lbl_len);
		1728
		1729	/*
		1730	* there's no enclosing statement, and we can't handle this
		1731	* because it has an explicit label attached - indicate that no
		1732	* break has been generated and give up
		1733	*/
		1734	return FALSE;
		1735	}
		1736
		1737	/*
		1738	* It's unlabeled, so we can take it by default as the nearest
		1739	* enclosing statement for which 'break' makes sense -- generate the
		1740	* jump to the given code label.
		1741	*/
		1742	G_cg->write_op(OPC_JMP);
		1743	G_cs->write_ofs2(code_label, 0);
		1744
		1745	/* we have generated the break */
		1746	return TRUE;
		1747	}
		1748
		1749	/*
		1750	* Generate code for a continue, given the target code label object and
		1751	* the target label symbol, if any. This can be used for any of the
		1752	* looping statement types.
		1753	*/
		1754	int CTPNStmEnclosing::gen_code_continue_loop(CTcCodeLabel *code_label,
		1755	const textchar_t *lbl,
		1756	size_t lbl_len)
		1757	{
		1758	/*
		1759	* If the statement is labeled, let the enclosing statement handle
		1760	* it -- since it's labeled, we can't assume the statement refers to
		1761	* us without searching for the enclosing label.
		1762	*/
		1763	if (lbl != 0)
		1764	{
		1765	/* if there's an enclosing statement, let it handle it */
		1766	if (enclosing_ != 0)
		1767	return enclosing_->gen_code_continue(lbl, lbl_len);
		1768
		1769	/*
		1770	* there's no enclosing statement, and we can't handle this
		1771	* because it has an explicit label attached - indicate that no
		1772	* continue has been generated and give up
		1773	*/
		1774	return FALSE;
		1775	}
		1776
		1777	/*
		1778	* it's unlabeled, so we can take it by default as the nearest
		1779	* enclosing statement for which 'continue' makes sense -- generate
		1780	* the jump to the given code label
		1781	*/
		1782	G_cg->write_op(OPC_JMP);
		1783	G_cs->write_ofs2(code_label, 0);
		1784
		1785	/* we have generated the continue */
		1786	return TRUE;
		1787	}
		1788
		1789	/*
		1790	* Generate the code necessary to unwind the stack for executing a
		1791	* 'goto' to the given labeled statement>
		1792	*/
		1793	void CTPNStmEnclosing::gen_code_unwind_for_goto(CTPNStmGoto *goto_stm,
		1794	CTPNStmLabel *target)
		1795	{
		1796	CTPNStmEnclosing *enc;
		1797
		1798	/*
		1799	* Detmerine if the target statement is enclosed within this
		1800	* statement. If it is, we do not need to unwind from this
		1801	* statement or any of its enclosing statements, because control
		1802	* will remain within this statement.
		1803	*
		1804	* To make this determination, start at the target label and search
		1805	* up its list of enclosing statements. If we reach 'this', we know
		1806	* that we enclose the target. If we reach the outermost enclosing
		1807	* statement, we know that we do not enclose the taret.
		1808	*/
		1809	for (enc = target ; enc != 0 ; enc = enc->get_enclosing())
		1810	{
		1811	/*
		1812	* if we found ourself in the list of enclosing statements
		1813	* around the target label, the label is contained within us,
		1814	* hence we do not need to generate any code to leave, because
		1815	* we're not leaving - simply return immediately without looking
		1816	* any further
		1817	*/
		1818	if (enc == this)
		1819	{
		1820	/*
		1821	* 'this' is the common ancestor of both the 'goto' and the
		1822	* target label, so we're not transferring control in or out
		1823	* of 'this' or any enclosing statement. However, we are
		1824	* transfering control IN through all of the statements that
		1825	* enclose the label up to but not including 'this'.
		1826	*
		1827	* Some types of statements do not allow control transfers
		1828	* in to enclosed labels - in particular, we can't use
		1829	* 'goto' to transfer control into a 'finally' clause.
		1830	* Check all statements that enclose the label up to but not
		1831	* including 'this', and make sure they will allow a
		1832	* transfer in.
		1833	*
		1834	* Note that we make this check now, only after we've found
		1835	* the common ancestor, because we can't tell if we're
		1836	* actually entering any blocks until we find the common
		1837	* ancestor.
		1838	*/
		1839	for (enc = target ; enc != 0 && enc != this ;
		1840	enc = enc->get_enclosing())
		1841	{
		1842	/* make sure we're allowed to enter this statement */
		1843	if (!enc->check_enter_by_goto(goto_stm, target))
		1844	break;
		1845	}
		1846
		1847	/*
		1848	* we're not transferring out of this statement or any
		1849	* enclosing statement, since the source 'goto' and the
		1850	* target label are both contained within 'this' - we're
		1851	* done unwinding for the transfer
		1852	*/
		1853	return;
		1854	}
		1855	}
		1856
		1857	/* generate code to transfer out of this statement */
		1858	gen_code_for_transfer_out();
		1859
		1860	/* check for an enclosing statement */
		1861	if (enclosing_ != 0)
		1862	{
		1863	/*
		1864	* We are enclosed by another statement or statements. This
		1865	* means that we haven't found a common ancestor yet, so we
		1866	* might be leaving the enclosing block as well - continue on to
		1867	* our enclosing statement.
		1868	*/
		1869	enclosing_->gen_code_unwind_for_goto(goto_stm, target);
		1870	}
		1871	else
		1872	{
		1873	/*
		1874	* This is the outermost significant enclosing statement, which
		1875	* means that we are transferring control into a completely
		1876	* unrelated block. As a result, we will enter every statement
		1877	* that encloses the target label.
		1878	*
		1879	* We must check each block we're entering to see if it allows
		1880	* entry by 'goto' statements. Since we now know there is no
		1881	* common ancestor, and thus that we're entering every block
		1882	* enclosing the target label, we must check every block
		1883	* enclosing the target label to see if they allow transfers in
		1884	* via 'goto' statements.
		1885	*/
		1886	for (enc = target ; enc != 0 ; enc = enc->get_enclosing())
		1887	{
		1888	/* make sure we're allowed to enter this statement */
		1889	if (!enc->check_enter_by_goto(goto_stm, target))
		1890	break;
		1891	}
		1892	}
		1893	}
		1894
		1895	/* ------------------------------------------------------------------------ */
		1896	/*
		1897	* Object Definition Statement
		1898	*/
		1899
		1900	/*
		1901	* given the offset of the start of an object in the compiled object
		1902	* stream, get the offset of the first property
		1903	*/
		1904	ulong CTPNStmObject::get_stream_first_prop_ofs(CTcDataStream *stream,
		1905	ulong obj_ofs)
		1906	{
		1907	/*
		1908	* the property table follows the superclass table, which follows
		1909	* the tads-object header; the superclass table contains 4 bytes per
		1910	* superclass (we can obtain the superclass count from the stream
		1911	* data)
		1912	*/
		1913	return obj_ofs + TCT3_TADSOBJ_SC_OFS
		1914	+ (get_stream_sc_cnt(stream, obj_ofs) * 4);
		1915	}
		1916
		1917	/*
		1918	* given the offset of the start of an object in the compiled object
		1919	* stream, get the offset of the property at the given index
		1920	*/
		1921	ulong CTPNStmObject::get_stream_prop_ofs(CTcDataStream *stream,
		1922	ulong obj_ofs, uint idx)
		1923	{
		1924	/*
		1925	* calculate the offset to the selected property from the start of
		1926	* the property table
		1927	*/
		1928	return get_stream_first_prop_ofs(stream, obj_ofs)
		1929	+ (TCT3_TADSOBJ_PROP_SIZE * idx);
		1930	}
		1931
		1932	/*
		1933	* given the offset of the start of an object in the compiled object
		1934	* stream, get the number of properties in the stream data
		1935	*/
		1936	uint CTPNStmObject::get_stream_prop_cnt(CTcDataStream *stream,
		1937	ulong obj_ofs)
		1938	{
		1939	/* the property count is at offset 2 in the tads-object header */
		1940	return stream->readu2_at(obj_ofs + TCT3_TADSOBJ_HEADER_OFS + 2);
		1941	}
		1942
		1943	/*
		1944	* given the offset of the start of an object in the compiled object
		1945	* stream, set the number of properties in the stream data, adjusting
		1946	* the data size in the metaclass header to match
		1947	*/
		1948	size_t CTPNStmObject::set_stream_prop_cnt(CTcDataStream *stream,
		1949	ulong obj_ofs, uint prop_cnt)
		1950	{
		1951	size_t data_size;
		1952
		1953	/* the property count is at offset 2 in the tads-object header */
		1954	stream->write2_at(obj_ofs + TCT3_TADSOBJ_HEADER_OFS + 2, prop_cnt);
		1955
		1956	/*
		1957	* calculate the new data size to store in the metaclass header --
		1958	* this is the size of the tads-object header, plus the size of the
		1959	* superclass table (4 bytes per superclass), plus the size of the
		1960	* property table
		1961	*/
		1962	data_size = TCT3_TADSOBJ_HEADER_SIZE
		1963	+ (get_stream_sc_cnt(stream, obj_ofs) * 4)
		1964	+ (prop_cnt * TCT3_TADSOBJ_PROP_SIZE);
		1965
		1966	/* write the data size to the metaclass header (it's at offset 4) */
		1967	stream->write2_at(obj_ofs + TCT3_META_HEADER_OFS + 4, data_size);
		1968
		1969	/* return the new data size */
		1970	return data_size;
		1971	}
		1972
		1973	/*
		1974	* Get the object flags from an object in a compiled stream
		1975	*/
		1976	uint CTPNStmObject::get_stream_obj_flags(CTcDataStream *stream,
		1977	ulong obj_ofs)
		1978	{
		1979	/* the flags are at offset 4 in the tads-object header */
		1980	return stream->read2_at(obj_ofs + TCT3_TADSOBJ_HEADER_OFS + 4);
		1981	}
		1982
		1983	/*
		1984	* Set the object flags in an object in a compiled stream
		1985	*/
		1986	void CTPNStmObject::set_stream_obj_flags(CTcDataStream *stream,
		1987	ulong obj_ofs, uint flags)
		1988	{
		1989	/*
		1990	* write the new flags - they're at offset 4 in the tads-object
		1991	* header
		1992	*/
		1993	stream->write2_at(obj_ofs + TCT3_TADSOBJ_HEADER_OFS + 4, flags);
		1994	}
		1995
		1996	/*
		1997	* given the offset of the start of an object in the compiled object
		1998	* stream, get the number of superclasses in the stream data
		1999	*/
		2000	uint CTPNStmObject::get_stream_sc_cnt(CTcDataStream *stream,
		2001	ulong obj_ofs)
		2002	{
		2003	/* the superclass count is at offset 0 in the tads-object header */
		2004	return stream->readu2_at(obj_ofs + TCT3_TADSOBJ_HEADER_OFS + 0);
		2005	}
		2006
		2007	/*
		2008	* given the stream offset of the start of an object in the compiled
		2009	* object stream, change a superclass object ID
		2010	*/
		2011	void CTPNStmObject::set_stream_sc(CTcDataStream *stream, ulong obj_ofs,
		2012	uint sc_idx, vm_obj_id_t new_sc)
		2013	{
		2014	/*
		2015	* set the superclass - it's at offset 6 in the object data, plus
		2016	* four bytes (UINT4) per index slot
		2017	*/
		2018	stream->write2_at(obj_ofs + TCT3_TADSOBJ_HEADER_OFS + 6 + (sc_idx * 4),
		2019	new_sc);
		2020	}
		2021
		2022	/*
		2023	* given the offset of the start of an object in the compiled object
		2024	* stream, get the property ID of the property at a given index in the
		2025	* property table
		2026	*/
		2027	vm_prop_id_t CTPNStmObject::get_stream_prop_id(CTcDataStream *stream,
		2028	ulong obj_ofs, uint prop_idx)
		2029	{
		2030	ulong prop_ofs;
		2031
		2032	/* get the property's data offset */
		2033	prop_ofs = get_stream_prop_ofs(stream, obj_ofs, prop_idx);
		2034
		2035	/* read the property ID - it's at offset 0 in the property data */
		2036	return (vm_prop_id_t)stream->readu2_at(prop_ofs);
		2037	}
		2038
		2039	/*
		2040	* given the offset of the start of an object in the compiled object
		2041	* stream, get the datatype of the property at the given index in the
		2042	* property table
		2043	*/
		2044	vm_datatype_t CTPNStmObject::
		2045	get_stream_prop_type(CTcDataStream *stream, ulong obj_ofs, uint prop_idx)
		2046	{
		2047	ulong dh_ofs;
		2048
		2049	/* get the property's data holder offset */
		2050	dh_ofs = get_stream_prop_val_ofs(stream, obj_ofs, prop_idx);
		2051
		2052	/* the type is the first byte of the serialized data holder */
		2053	return (vm_datatype_t)stream->get_byte_at(dh_ofs);
		2054	}
		2055
		2056	/*
		2057	* given the offset of the start of an object in the compiled object
		2058	* stream, get the stream offset of the serialized DATAHOLDER structure
		2059	* for the property at the given index in the property table
		2060	*/
		2061	ulong CTPNStmObject::get_stream_prop_val_ofs(CTcDataStream *stream,
		2062	ulong obj_ofs, uint prop_idx)
		2063	{
		2064	ulong prop_ofs;
		2065
		2066	/* get the property's data offset */
		2067	prop_ofs = get_stream_prop_ofs(stream, obj_ofs, prop_idx);
		2068
		2069	/* the data holder immediately follows the (UINT2) property ID */
		2070	return prop_ofs + 2;
		2071	}
		2072
		2073
		2074	/*
		2075	* given the offset of the start of an object in the compiled object
		2076	* stream, get the property ID of the property at a given index in the
		2077	* property table
		2078	*/
		2079	void CTPNStmObject::set_stream_prop_id(CTcDataStream *stream,
		2080	ulong obj_ofs, uint prop_idx,
		2081	vm_prop_id_t new_id)
		2082	{
		2083	ulong prop_ofs;
		2084
		2085	/* get the property's data offset */
		2086	prop_ofs = get_stream_prop_ofs(stream, obj_ofs, prop_idx);
		2087
		2088	/* set the data */
		2089	stream->write2_at(prop_ofs, (uint)new_id);
		2090	}
		2091
		2092	/* ------------------------------------------------------------------------ */
		2093	/*
		2094	* Object Property list entry - value node
		2095	*/
		2096	void CTPNObjProp::gen_code(int, int)
		2097	{
		2098	vm_val_t val;
		2099	char buf[VMB_DATAHOLDER];
		2100	CTcDataStream *str;
		2101
		2102	/* get the correct data stream */
		2103	str = obj_stm_->get_obj_sym()->get_stream();
		2104
		2105	/* set the current source location for error reporting */
		2106	G_tok->set_line_info(file_, linenum_);
		2107
		2108	/* generate code for our expression or our code body, as appropriate */
		2109	if (expr_ != 0)
		2110	{
		2111	/*
		2112	* if my value is constant, write out a dataholder for the
		2113	* constant value to the stream; otherwise, write out our code
		2114	* and store a pointer to the code
		2115	*/
		2116	if (expr_->is_const())
		2117	{
		2118	/* write the constant value to the object stream */
		2119	G_cg->write_const_as_dh(str, str->get_ofs(),
		2120	expr_->get_const_val());
		2121	}
		2122	else if (expr_->is_dstring())
		2123	{
		2124	CTPNDstr *dstr;
		2125
		2126	/* it's a double-quoted string node */
		2127	dstr = (CTPNDstr *)expr_;
		2128
		2129	/*
		2130	* Add the string to the constant pool. Note that the fixup
		2131	* will be one byte from the current object stream offset,
		2132	* since we need to write the type byte first.
		2133	*/
		2134	G_cg->add_const_str(dstr->get_str(), dstr->get_str_len(),
		2135	str, str->get_ofs() + 1);
		2136
		2137	/*
		2138	* Set up the dstring value. Use a zero placeholder for
		2139	* now; add_const_str() already added a fixup for us that
		2140	* will supply the correct value at link time.
		2141	*/
		2142	val.set_dstring(0);
		2143	vmb_put_dh(buf, &val);
		2144	str->write(buf, VMB_DATAHOLDER);
		2145	}
		2146	else
		2147	{
		2148	/* we should never get here */
		2149	G_tok->throw_internal_error(TCERR_INVAL_PROP_CODE_GEN);
		2150	}
		2151	}
		2152	else if (code_body_ != 0)
		2153	{
		2154	char buf[VMB_DATAHOLDER];
		2155	vm_val_t val;
		2156
		2157	/* if this is a constructor, mark the code body accordingly */
		2158	if (prop_sym_->get_prop() == G_prs->get_constructor_prop())
		2159	code_body_->set_constructor(TRUE);
		2160
		2161	/* if it's static, do some extra work */
		2162	if (is_static_)
		2163	{
		2164	/* mark the code body as static */
		2165	code_body_->set_static();
		2166
		2167	/*
		2168	* add the obj.prop to the static ID stream, so the VM knows
		2169	* to invoke this initializer at start-up
		2170	*/
		2171	G_static_init_id_stream
		2172	->write_obj_id(obj_stm_->get_obj_sym()->get_obj_id());
		2173	G_static_init_id_stream
		2174	->write_prop_id(prop_sym_->get_prop());
		2175	}
		2176
		2177	/* tell our code body to generate the code */
		2178	code_body_->gen_code(FALSE, FALSE);
		2179
		2180	/*
		2181	* Set up our code offset value. Write a code offset of zero
		2182	* for now, since we won't know the correct offset until link
		2183	* time.
		2184	*/
		2185	val.set_codeofs(0);
		2186
		2187	/*
		2188	* Add a fixup to the code body's fixup list for our dataholder,
		2189	* so that we fix up the property value when we link. Note that
		2190	* the fixup is one byte into our object stream from the current
		2191	* offset, because the first byte is the type.
		2192	*/
		2193	CTcAbsFixup::add_abs_fixup(code_body_->get_fixup_list_head(),
		2194	str, str->get_ofs() + 1);
		2195
		2196	/* write out our value in DATAHOLDER format */
		2197	vmb_put_dh(buf, &val);
		2198	str->write(buf, VMB_DATAHOLDER);
		2199	}
		2200	}
		2201
		2202	/*
		2203	* Check locals
		2204	*/
		2205	void CTPNObjProp::check_locals()
		2206	{
		2207	/* check locals in our code body */
		2208	if (code_body_ != 0)
		2209	code_body_->check_locals();
		2210	}
		2211
		2212	/* ------------------------------------------------------------------------ */
		2213	/*
		2214	* Implicit constructor
		2215	*/
		2216	void CTPNStmImplicitCtor::gen_code(int /discard/, int /for_condition/)
		2217	{
		2218	CTPNSuperclass *sc;
		2219
		2220	/*
		2221	* Generate a call to inherit each superclass constructor. Pass the
		2222	* same argument list we received by expanding the varargs list
		2223	* parameter in local 0.
		2224	*/
		2225	for (sc = obj_stm_->get_first_sc() ; sc != 0 ; sc = sc->nxt_)
		2226	{
		2227	CTcSymObj *sc_sym;
		2228
		2229	/*
		2230	* if this one is valid, generate code to call its constructor -
		2231	* it's valid if it has an object symbol
		2232	*/
		2233	sc_sym = (CTcSymObj *)sc->get_sym();
		2234	if (sc_sym != 0 && sc_sym->get_type() == TC_SYM_OBJ)
		2235	{
		2236	/* push the argument counter so far (no other arguments) */
		2237	G_cg->write_op(OPC_PUSH_0);
		2238	G_cg->note_push();
		2239
		2240	/* get the varargs list local */
		2241	CTcSymLocal::s_gen_code_getlcl(0, FALSE);
		2242
		2243	/* convert it to varargs */
		2244	G_cg->write_op(OPC_MAKELSTPAR);
		2245
		2246	/* note the extra push and pop for the argument count */
		2247	G_cg->note_push();
		2248	G_cg->note_pop();
		2249
		2250	/* it's a varargs call */
		2251	G_cg->write_op(OPC_VARARGC);
		2252
		2253	/* generate an EXPINHERIT to this superclass */
		2254	G_cg->write_op(OPC_EXPINHERIT);
		2255	G_cs->write(0); /* varargs -> argc ignored */
		2256	G_cs->write_prop_id(G_prs->get_constructor_prop());
		2257	G_cs->write_obj_id(sc_sym->get_obj_id());
		2258
		2259	/*
		2260	* this removes arguments (the varargs list variable and
		2261	* argument count)
		2262	*/
		2263	G_cg->note_pop(2);
		2264	}
		2265	}
		2266	}
		2267
		2268
		2269	/* ------------------------------------------------------------------------ */
		2270	/*
		2271	* Anonymous function
		2272	*/
		2273
		2274	/*
		2275	* generate code
		2276	*/
		2277	void CTPNAnonFunc::gen_code(int discard, int)
		2278	{
		2279	CTcCodeBodyCtx *cur_ctx;
		2280	int argc;
		2281
		2282	/* if we're discarding the value, don't bother generating the code */
		2283	if (discard)
		2284	return;
		2285
		2286	/*
		2287	* Push each context object - these are the additional arguments to
		2288	* the anonymous function pointer object's constructor beyond the
		2289	* function pointer itself. Note that we must push the arguments in
		2290	* reverse order of our list, since arguments are always pushed from
		2291	* last to first.
		2292	*/
		2293	for (argc = 0, cur_ctx = code_body_->get_ctx_tail() ; cur_ctx != 0 ;
		2294	cur_ctx = cur_ctx->prv_, ++argc)
		2295	{
		2296	int our_varnum;
		2297
		2298	/*
		2299	* find our context matching this context - the caller's
		2300	* contexts are all one level lower than the callee's contexts,
		2301	* because the caller is at the next recursion level out
		2302	*/
		2303	if (!G_cs->get_code_body()
		2304	->get_ctx_var_for_level(cur_ctx->level_ - 1, &our_varnum))
		2305	{
		2306	/* this should never happen */
		2307	assert(FALSE);
		2308	}
		2309
		2310	/*
		2311	* push this context object - to do this, simply retrieve the
		2312	* value of the local variable in our frame that contains this
		2313	* context level
		2314	*/
		2315	CTcSymLocal::s_gen_code_getlcl(our_varnum, FALSE);
		2316	}
		2317
		2318	/*
		2319	* The first argument (and thus last pushed) to the constructor is
		2320	* the constant function pointer that refers to the code of the
		2321	* anonymous function.
		2322	*/
		2323	G_cg->write_op(OPC_PUSHFNPTR);
		2324	code_body_->add_abs_fixup(G_cs);
		2325	G_cs->write4(0);
		2326	++argc;
		2327
		2328	/* note the push of the function pointer argument */
		2329	G_cg->note_push();
		2330
		2331	/* create the new function object */
		2332	if (argc <= 255)
		2333	{
		2334	G_cg->write_op(OPC_NEW1);
		2335	G_cs->write((char)argc);
		2336	G_cs->write((char)G_cg->get_predef_meta_idx(TCT3_METAID_ANONFN));
		2337	}
		2338	else
		2339	{
		2340	G_cg->write_op(OPC_NEW2);
		2341	G_cs->write2(argc);
		2342	G_cs->write2(G_cg->get_predef_meta_idx(TCT3_METAID_ANONFN));
		2343	}
		2344
		2345	/* push the object value */
		2346	G_cg->write_op(OPC_GETR0);
		2347
		2348	/* the 'new' popped the arguments, then we pushed the result */
		2349	G_cg->note_pop(argc - 1);
		2350	}
		2351

FrobTADS

cfad47cfa3/t3compiler/tads3/tct3stm.cpp