3
"$Header: d:/cvsroot/tads/tads3/TCT3STM.CPP,v 1.1 1999/07/11 00:46:57 MJRoberts Exp $";
7
* Copyright (c) 1999, 2002 Michael J. Roberts. All Rights Reserved.
9
* Please see the accompanying license file, LICENSE.TXT, for information
10
* on using and copying this software.
14
tct3stm.cpp - TADS 3 Compiler - T3 VM Code Generator - statement classes
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).
23
05/08/99 MJRoberts - Creation
40
/* ------------------------------------------------------------------------ */
45
/* callback context */
46
struct write_local_to_debug_frame_ctx
48
/* number of symbols written so far */
53
* Callback for symbol table enumeration - write a local variable entry
54
* to the code stream for a debug frame record.
56
void CTPNCodeBody::write_local_to_debug_frame(void *ctx0, CTcSymbol *sym)
58
write_local_to_debug_frame_ctx *ctx;
60
/* cast our context */
61
ctx = (write_local_to_debug_frame_ctx *)ctx0;
64
if (sym->write_to_debug_frame())
66
/* we wrote the symbol - count it */
72
* Build the debug information table for a code body
74
void CTPNCodeBody::build_debug_table(ulong start_ofs)
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);
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.
91
G_cg->add_debug_line_table(G_cs->get_ofs());
93
/* write the number of line records */
94
G_cs->write2(G_cs->get_line_rec_count());
96
/* write the line records themselves */
97
for (i = 0 ; i < G_cs->get_line_rec_count() ; ++i)
101
/* get this record */
102
rec = G_cs->get_line_rec(i);
104
/* write the offset of the statement's first opcode */
105
G_cs->write2(rec->ofs);
107
/* write the source file ID and line number */
108
G_cs->write2(rec->source_id);
109
G_cs->write4(rec->source_line);
111
/* write the frame ID */
112
G_cs->write2(rec->frame == 0 ? 0 : rec->frame->get_list_index());
116
* write a placeholder pointer to the next byte after the end of the
119
post_ptr_ofs = G_cs->get_ofs();
122
/* write the frame count */
123
G_cs->write2(G_cs->get_frame_count());
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.
132
index_ofs = G_cs->get_ofs();
134
/* write the placeholder index entries */
135
for (i = 0 ; i < G_cs->get_frame_count() ; ++i)
138
/* write the individual frames */
139
for (frame = G_cs->get_first_frame() ; frame != 0 ;
140
frame = frame->get_list_next())
143
write_local_to_debug_frame_ctx cbctx;
146
* go back and fill in the correct offset (from the entry
147
* itself) in the index table entry for this frame
149
G_cs->write2_at(index_ofs, G_cs->get_ofs() - index_ofs);
151
/* move on to the next index entry */
154
/* write the ID of the enclosing frame */
155
G_cs->write2(frame->get_parent() == 0
156
? 0 : frame->get_parent()->get_list_index());
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
163
count_ofs = G_cs->get_ofs();
166
/* initialize the enumeration callback context */
169
/* write this frame table's entries */
170
frame->enum_entries(&write_local_to_debug_frame, &cbctx);
172
/* go back and fix up the symbol count */
173
G_cs->write2_at(count_ofs, cbctx.count);
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
181
G_cs->write2_at(post_ptr_ofs, G_cs->get_ofs() - post_ptr_ofs);
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)
192
/* ------------------------------------------------------------------------ */
200
void CTPNStmIf::gen_code(int, int)
202
/* add a line record */
203
add_debug_line_rec();
206
* if the condition has a constant value, don't bother generating
207
* code for both branches
209
if (cond_expr_->is_const())
213
/* determine whether it's true or false */
214
val = cond_expr_->get_const_val()->get_val_bool();
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.
226
/* it's false - the 'then' part cannot be executed */
227
log_warning(TCERR_IF_ALWAYS_FALSE);
229
/* generate the 'else' part if there is one */
231
gen_code_substm(else_part_);
235
/* it's true - the 'else' part cannot be executed */
237
log_warning(TCERR_IF_ALWAYS_TRUE);
239
/* generate the 'then' part */
241
gen_code_substm(then_part_);
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.
254
if (then_part_ == 0 && else_part_ == 0)
256
/* generate the condition, discarding the result */
257
cond_expr_->gen_code(TRUE, TRUE);
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.
271
CTcCodeLabel *lbl_else;
272
CTcCodeLabel *lbl_end;
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.
279
lbl_else = G_cs->new_label_fwd();
281
/* generate the condition expression */
282
cond_expr_->gen_code_cond(0, lbl_else);
284
/* generate the 'then' part */
285
gen_code_substm(then_part_);
287
/* if there's an 'else' part, generate it */
290
/* at the end of the 'then' part, jump past the 'else' part */
291
lbl_end = gen_jump_ahead(OPC_JMP);
293
/* this is the start of the 'else' part */
294
def_label_pos(lbl_else);
296
/* generate the 'else' part */
297
gen_code_substm(else_part_);
299
/* set the label for the jump over the 'else' part */
300
def_label_pos(lbl_end);
305
* there's no 'else' part - set the label for the jump past the
308
def_label_pos(lbl_else);
313
CTcCodeLabel *lbl_end;
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.
323
lbl_end = G_cs->new_label_fwd();
325
/* evaluate the condition and jump to the end if it's true */
326
cond_expr_->gen_code_cond(lbl_end, 0);
328
/* generate the 'else' part */
329
gen_code_substm(else_part_);
331
/* set the label for the jump over the 'else' part */
332
def_label_pos(lbl_end);
336
/* ------------------------------------------------------------------------ */
344
void CTPNStmFor::gen_code(int, int)
346
CTcCodeLabel *top_lbl;
347
CTcCodeLabel *end_lbl;
348
CTcCodeLabel *cont_lbl;
349
CTPNStmEnclosing *old_enclosing;
350
CTcPrsSymtab *old_frame;
352
/* set my local frame if necessary */
353
old_frame = G_cs->set_local_frame(symtab_);
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
360
add_debug_line_rec();
362
/* push the enclosing statement */
363
old_enclosing = G_cs->set_enclosing(this);
365
/* if there's an initializer expression, generate it */
367
init_expr_->gen_code(TRUE, TRUE);
369
/* set the label for the top of the loop */
370
top_lbl = new_label_here();
372
/* allocate a forward label for 'continue' jumps */
373
cont_lbl = G_cs->new_label_fwd();
375
/* allocate a forward label for the end of the loop */
376
end_lbl = G_cs->new_label_fwd();
379
* If there's a condition, generate its code, jumping to the end of the
380
* loop if the condition is false.
383
cond_expr_->gen_code_cond(0, end_lbl);
386
* set our labels, so that 'break' and 'continue' statements in our
387
* body will know where to go
389
break_lbl_ = end_lbl;
390
cont_lbl_ = cont_lbl;
392
/* if we have a body, generate it */
394
gen_code_substm(body_stm_);
397
* add another line record - we're now generating code again for the
398
* original 'for' line, even though it's after the body
400
//$$$ add_debug_line_rec();
402
/* this is where we come for 'continue' statements */
403
def_label_pos(cont_lbl);
405
/* generate the reinitializer expression, if we have one */
406
if (reinit_expr_ != 0)
407
reinit_expr_->gen_code(TRUE, TRUE);
409
/* jump back to the top of the loop */
410
G_cg->write_op(OPC_JMP);
411
G_cs->write_ofs2(top_lbl, 0);
414
* we're at the end of the loop - this is where we jump for 'break'
415
* and when the condition becomes false
417
def_label_pos(end_lbl);
419
/* restore the enclosing statement */
420
G_cs->set_enclosing(old_enclosing);
422
/* restore the enclosing local scope */
423
G_cs->set_local_frame(old_frame);
426
/* ------------------------------------------------------------------------ */
428
* 'foreach' statement
434
void CTPNStmForeach::gen_code(int, int)
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;
444
/* set my local frame if necessary */
445
old_frame = G_cs->set_local_frame(symtab_);
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
452
add_debug_line_rec();
454
/* push the enclosing statement */
455
old_enclosing = G_cs->set_enclosing(this);
457
/* if there's a collection expression, generate it */
460
CTcSymMetaclass *coll_meta;
461
CTcSymProp *create_iter_prop = 0;
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.
470
coll_meta = G_cg->find_meta_sym("collection", 10);
473
CTcSymMetaProp *mprop;
475
/* get the first entry in the metaclass property list */
476
mprop = coll_meta->get_nth_prop(0);
478
/* if we got the entry, get its property */
479
create_iter_prop = mprop->prop_;
482
/* if we didn't find the property, it's an error */
483
if (create_iter_prop == 0)
485
/* tell them about the problem */
486
G_tok->log_error(TCERR_FOREACH_NO_CREATEITER);
490
CTcPrsNode *prop_expr;
492
/* construct an expression for the property */
493
prop_expr = new CTPNSymResolved(create_iter_prop);
496
* generate a call to the createIterator() property on the
497
* collection expression
499
coll_expr_->gen_code_member(FALSE, prop_expr, FALSE, 0, FALSE);
501
/* assign the result to the internal iterator stack local */
502
CTcSymLocal::s_gen_code_setlcl_stk(iter_local_id_, FALSE);
506
/* set the label for the top of the loop */
507
top_lbl = new_label_here();
509
/* get the Iterator metaclass */
510
iter_meta = G_cg->find_meta_sym("iterator", 8);
513
CTcSymMetaProp *mprop;
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_;
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_;
524
/* generate the isNextAvailable test */
525
if (is_next_avail_prop != 0)
527
CTcPrsNode *prop_expr;
529
/* get the internal iterator local */
530
CTcSymLocal::s_gen_code_getlcl(iter_local_id_, FALSE);
532
/* create an expression for the property */
533
prop_expr = new CTPNSymResolved(is_next_avail_prop);
535
/* generate a call to the property */
536
CTcPrsNode::s_gen_member_rhs(FALSE, prop_expr, FALSE, 0, FALSE);
538
/* jump out of the loop if the expression is false */
539
end_lbl = gen_jump_ahead(OPC_JF);
541
/* the JF pops an element off the stack */
546
/* this property is required to be defined - this is an error */
547
G_tok->log_error(TCERR_FOREACH_NO_ISNEXTAVAIL);
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
555
end_lbl = new_label_here();
558
/* generate the code to get the next element of the iteration */
559
if (get_next_prop != 0)
561
CTcPrsNode *prop_expr;
563
/* get the internal iterator local */
564
CTcSymLocal::s_gen_code_getlcl(iter_local_id_, FALSE);
566
/* create an expression for the property */
567
prop_expr = new CTPNSymResolved(get_next_prop);
569
/* generate a call to the property */
570
CTcPrsNode::s_gen_member_rhs(FALSE, prop_expr, FALSE, 0, FALSE);
572
/* assign the result to the iterator lvalue */
574
iter_expr_->gen_code_asi(TRUE, TC_ASI_SIMPLE, 0, FALSE);
578
/* this property is required to be defined - this is an error */
579
G_tok->log_error(TCERR_FOREACH_NO_GETNEXT);
583
* set our labels, so that 'break' and 'continue' statements in our
584
* body will know where to go
586
break_lbl_ = end_lbl;
589
/* if we have a body, generate it */
591
gen_code_substm(body_stm_);
594
* add another line record - we're now generating code again for the
595
* original 'foreach' line, even though it's after the body
597
//$$$ add_debug_line_rec();
599
/* jump back to the top of the loop */
600
G_cg->write_op(OPC_JMP);
601
G_cs->write_ofs2(top_lbl, 0);
604
* we're at the end of the loop - this is where we jump for 'break'
605
* and when the condition becomes false
608
def_label_pos(end_lbl);
610
/* restore the enclosing statement */
611
G_cs->set_enclosing(old_enclosing);
613
/* restore the enclosing local scope */
614
G_cs->set_local_frame(old_frame);
617
/* ------------------------------------------------------------------------ */
625
void CTPNStmWhile::gen_code(int, int)
627
CTcCodeLabel *top_lbl;
628
CTcCodeLabel *end_lbl;
629
CTPNStmEnclosing *old_enclosing;
631
/* add a line record */
632
add_debug_line_rec();
634
/* push the enclosing statement */
635
old_enclosing = G_cs->set_enclosing(this);
637
/* set the label for the top of the loop */
638
top_lbl = new_label_here();
640
/* generate a label for the end of the loop */
641
end_lbl = G_cs->new_label_fwd();
643
/* generate the condition, jumping to the end of the loop if false */
644
cond_expr_->gen_code_cond(0, end_lbl);
647
* set the 'break' and 'continue' label in our node, so that 'break'
648
* and 'continue' statements in subnodes can find the labels during
651
break_lbl_ = end_lbl;
654
/* if we have a body, generate it */
656
gen_code_substm(body_stm_);
659
* add another line record - the jump back to the top of the loop is
660
* part of the 'while' itself
662
//$$$ add_debug_line_rec();
664
/* jump back to the top of the loop */
665
G_cg->write_op(OPC_JMP);
666
G_cs->write_ofs2(top_lbl, 0);
669
* we're at the end of the loop - this is where we jump for 'break'
670
* and when the condition becomes false
672
def_label_pos(end_lbl);
674
/* restore the enclosing statement */
675
G_cs->set_enclosing(old_enclosing);
679
/* ------------------------------------------------------------------------ */
681
* 'do-while' statement
687
void CTPNStmDoWhile::gen_code(int, int)
689
CTcCodeLabel *top_lbl;
690
CTcCodeLabel *end_lbl;
691
CTcCodeLabel *cont_lbl;
692
CTPNStmEnclosing *old_enclosing;
694
/* add a line record */
695
add_debug_line_rec();
697
/* push the enclosing statement */
698
old_enclosing = G_cs->set_enclosing(this);
700
/* set the label for the top of the loop */
701
top_lbl = new_label_here();
703
/* create a label for after the loop, for any enclosed 'break's */
704
end_lbl = G_cs->new_label_fwd();
707
* create a label for just before the expression, for any enclosed
708
* 'continue' statements
710
cont_lbl = G_cs->new_label_fwd();
712
/* set our 'break' and 'continue' labels in our node */
713
break_lbl_ = end_lbl;
714
cont_lbl_ = cont_lbl;
716
/* if we have a body, generate it */
718
gen_code_substm(body_stm_);
720
/* set the debug source position to the 'while' clause's location */
721
add_debug_line_rec(while_desc_, while_linenum_);
723
/* put the 'continue' label here, just before the condition */
724
def_label_pos(cont_lbl);
727
* Generate the condition. If the condition is true, jump back to the
728
* top label; otherwise fall through out of the loop structure.
730
cond_expr_->gen_code_cond(top_lbl, 0);
732
/* we're past the end of the loop - this is where we jump for 'break' */
733
def_label_pos(end_lbl);
735
/* restore the enclosing statement */
736
G_cs->set_enclosing(old_enclosing);
740
/* ------------------------------------------------------------------------ */
748
void CTPNStmBreak::gen_code(int, int)
750
/* add a line record */
751
add_debug_line_rec();
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
758
if (G_cs->get_enclosing() == 0
759
|| !G_cs->get_enclosing()->gen_code_break(lbl_, lbl_len_))
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
767
G_tok->log_error(TCERR_INVALID_BREAK);
769
G_tok->log_error(TCERR_INVALID_BREAK_LBL, (int)lbl_len_, lbl_);
773
/* ------------------------------------------------------------------------ */
775
* 'continue' statement
781
void CTPNStmContinue::gen_code(int, int)
783
/* add a line record */
784
add_debug_line_rec();
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
791
if (G_cs->get_enclosing() == 0
792
|| !G_cs->get_enclosing()->gen_code_continue(lbl_, lbl_len_))
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
800
G_tok->log_error(TCERR_INVALID_CONTINUE);
802
G_tok->log_error(TCERR_INVALID_CONT_LBL, (int)lbl_len_, lbl_);
806
/* ------------------------------------------------------------------------ */
814
void CTPNStmSwitch::gen_code(int, int)
816
CTPNStmSwitch *enclosing_switch;
818
char buf[VMB_DATAHOLDER + VMB_UINT2];
819
CTcCodeLabel *end_lbl;
820
CTPNStmEnclosing *old_enclosing;
822
/* add a line record */
823
add_debug_line_rec();
825
/* push the enclosing statement */
826
old_enclosing = G_cs->set_enclosing(this);
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
834
expr_->gen_code(FALSE, FALSE);
836
/* make myself the current innermost switch */
837
enclosing_switch = G_cs->set_switch(this);
840
* if we can flow out of the switch, allocate a label for the end of
843
if ((get_control_flow(FALSE) & TCPRS_FLOW_NEXT) != 0)
844
end_lbl = G_cs->new_label_fwd();
848
/* the end label is the 'break' location for subnodes */
849
break_lbl_ = end_lbl;
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.
857
G_cg->write_op(OPC_SWITCH);
859
/* the SWITCH opcode pops the controlling expression value */
862
/* write the number of cases */
863
G_cs->write2(case_cnt_);
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
869
case_slot_ofs_ = G_cs->get_ofs();
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.
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);
880
/* write a placeholder for the default jump */
884
* remember where the 'default' slot is, so that the 'default'
885
* parse node can figure out where to write its branch offset
887
default_slot_ofs_ = G_cs->get_ofs();
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.
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
904
G_cs->write_ofs2(end_lbl, 0);
908
* generate the switch body - this will fill in the case table as we
909
* encounter the 'case' nodes in the parse tree
912
gen_code_substm(body_);
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
922
def_label_pos(end_lbl);
924
/* restore the enclosing switch */
925
G_cs->set_switch(enclosing_switch);
927
/* restore the enclosing statement */
928
G_cs->set_enclosing(old_enclosing);
931
/* ------------------------------------------------------------------------ */
933
* 'case' label statement
939
void CTPNStmCase::gen_code(int, int)
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
950
if (G_cs->get_switch() == 0 || !expr_->is_const())
951
G_tok->throw_internal_error(TCERR_GEN_BAD_CASE);
953
/* allocate our case slot from the enclosing 'switch' statement */
954
slot_ofs = G_cs->get_switch()->alloc_case_slot();
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());
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.
964
jump_ofs = G_cs->get_ofs() - (slot_ofs + VMB_DATAHOLDER);
965
G_cs->write2_at(slot_ofs + VMB_DATAHOLDER, (int)jump_ofs);
968
* because we can jump here (via the case table), we cannot allow
969
* peephole optimizations from past instructions - clear the
972
G_cg->clear_peephole();
974
/* generate our substatement, if we have one */
976
gen_code_substm(stm_);
979
/* ------------------------------------------------------------------------ */
981
* 'default' label statement
987
void CTPNStmDefault::gen_code(int, int)
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
998
if (G_cs->get_switch() == 0)
999
G_tok->throw_internal_error(TCERR_GEN_BAD_CASE);
1001
/* ask the switch where our slot goes */
1002
slot_ofs = G_cs->get_switch()->get_default_slot();
1005
* Set the jump offset. This is the offset from our slot entry in
1006
* the case table to the current output offset.
1008
jump_ofs = G_cs->get_ofs() - slot_ofs;
1009
oswp2(buf, (int)jump_ofs);
1011
/* write our slot entry to the case table */
1012
G_cs->write_at(slot_ofs, buf, VMB_UINT2);
1015
* because we can jump here (via the case table), we cannot allow
1016
* peephole optimizations from past instructions - clear the
1019
G_cg->clear_peephole();
1021
/* generate our substatement, if we have one */
1023
gen_code_substm(stm_);
1026
/* ------------------------------------------------------------------------ */
1028
* code label statement
1034
CTPNStmLabel::CTPNStmLabel(CTcSymLabel *lbl, CTPNStmEnclosing *enclosing)
1035
: CTPNStmLabelBase(lbl, enclosing)
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)
1046
* we don't yet have a 'break' label - we'll allocate this when
1047
* someone first refers to it
1053
* get our code label
1055
CTcCodeLabel *CTPNStmLabel::get_goto_label()
1057
/* if we don't have a label already, allocate it */
1058
if (goto_label_ == 0)
1059
goto_label_ = G_cs->new_label_fwd();
1061
/* return the label */
1068
void CTPNStmLabel::gen_code(int, int)
1070
CTPNStmEnclosing *old_enclosing;
1072
/* push the enclosing statement */
1073
old_enclosing = G_cs->set_enclosing(this);
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.)
1082
def_label_pos(get_goto_label());
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
1089
add_debug_line_rec();
1092
* generate code for the labeled statement, discarding any
1096
gen_code_substm(stm_);
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.
1105
if (break_label_ != 0)
1106
def_label_pos(break_label_);
1108
/* restore the enclosing statement */
1109
G_cs->set_enclosing(old_enclosing);
1114
* generate code for a 'break'
1116
int CTPNStmLabel::gen_code_break(const textchar_t *lbl, size_t lbl_len)
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.
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);
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)
1134
if (break_label_ == 0)
1135
break_label_ = G_cs->new_label_fwd();
1137
/* jump to the label */
1138
G_cg->write_op(OPC_JMP);
1139
G_cs->write_ofs2(break_label_, 0);
1147
* generate code for a 'continue'
1149
int CTPNStmLabel::gen_code_continue(const textchar_t *lbl, size_t lbl_len)
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.
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);
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.
1169
return stm_->gen_code_labeled_continue();
1175
/* ------------------------------------------------------------------------ */
1183
void CTPNStmTry::gen_code(int, int)
1187
CTPNStmCatch *cur_catch;
1188
CTcCodeLabel *end_lbl;
1189
CTPNStmEnclosing *old_enclosing;
1190
int finally_never_returns;
1192
/* we have no end label yet */
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
1201
add_debug_line_rec();
1203
/* push the enclosing statement */
1204
old_enclosing = G_cs->set_enclosing(this);
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.
1212
if (finally_stm_ != 0)
1213
finally_lbl_ = G_cs->new_label_fwd();
1217
/* note where the protected code begins */
1218
start_ofs = G_cs->get_ofs();
1220
/* generate the protected code */
1222
gen_code_substm(body_stm_);
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.
1229
finally_never_returns =
1231
&& (finally_stm_->get_control_flow(FALSE) & TCPRS_FLOW_NEXT) == 0);
1234
* if there's a "finally" clause, we must generate a local subroutine
1235
* call to the "finally" block
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.
1246
if (!finally_never_returns)
1247
end_lbl = gen_jump_ahead(OPC_JMP);
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.
1255
end_ofs = G_cs->get_ofs() - 1;
1257
/* generate the 'catch' blocks */
1258
for (cur_catch = first_catch_stm_ ; cur_catch != 0 ;
1259
cur_catch = cur_catch->get_next_catch())
1261
/* generate the 'catch' block */
1262
cur_catch->gen_code_catch(start_ofs, end_ofs);
1264
/* call the 'finally' block after the 'catch' finishes */
1268
* If there's a finally block, or there's another 'catch' after me,
1269
* generate a jump past the remaining catch/finally blocks.
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.
1276
if (!finally_never_returns
1277
&& (finally_stm_ != 0 || cur_catch->get_next_catch() != 0))
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
1288
/* we have no label - generate a new one now */
1289
end_lbl = gen_jump_ahead(OPC_JMP);
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);
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.
1307
G_cs->set_enclosing(old_enclosing);
1309
/* generate the 'finally' block, if we have one */
1310
if (finally_stm_ != 0)
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'
1319
finally_stm_->gen_code_finally(start_ofs, G_cs->get_ofs() - 1, this);
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
1330
def_label_pos(end_lbl);
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.
1338
int CTPNStmTry::gen_code_break(const textchar_t *lbl, size_t lbl_len)
1340
/* if we have a 'finally' block, invoke it as a local subroutine call */
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
1349
return enclosing_->gen_code_break(lbl, lbl_len);
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.
1359
int CTPNStmTry::gen_code_continue(const textchar_t *lbl, size_t lbl_len)
1361
/* if we have a 'finally' block, invoke it as a local subroutine call */
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
1370
return enclosing_->gen_code_continue(lbl, lbl_len);
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.
1381
void CTPNStmTry::gen_jsr_finally()
1383
/* if we have a 'finally', call it */
1384
if (finally_lbl_ != 0)
1386
/* generate the local subroutine call */
1387
G_cg->write_op(OPC_LJSR);
1388
G_cs->write_ofs2(finally_lbl_, 0);
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)
1399
* whatever follows the LJSR is logically at the end of the
1402
add_debug_line_rec(finally_stm_->get_end_desc(),
1403
finally_stm_->get_end_linenum());
1408
/* ------------------------------------------------------------------------ */
1416
void CTPNStmCatch::gen_code(int, int)
1418
/* this can't be called directly - use gen_code_catch() instead */
1419
G_tok->throw_internal_error(TCERR_CATCH_FINALLY_GEN_CODE);
1423
* generate code for the 'catch'
1425
void CTPNStmCatch::gen_code_catch(ulong start_prot_ofs, ulong end_prot_ofs)
1429
CTcPrsSymtab *old_frame;
1431
/* add the source location of the 'catch' clause */
1432
add_debug_line_rec();
1434
/* set the local scope */
1435
old_frame = G_cs->set_local_frame(symtab_);
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);
1441
/* assume we won't find a valid object ID */
1442
exc_obj_id = VM_INVALID_OBJ;
1444
/* if it's an object, get its ID */
1445
if (sym->get_type() == TC_SYM_OBJ)
1447
/* get its object ID */
1448
exc_obj_id = ((CTcSymObj *)sym)->get_obj_id();
1450
else if (sym->get_type() != TC_SYM_UNKNOWN)
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
1458
log_error(TCERR_CATCH_EXC_NOT_OBJ, (int)exc_class_len_, exc_class_);
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());
1465
/* don't allow any peephole optimizations to affect this offset */
1466
G_cg->clear_peephole();
1469
* the VM automatically pushes a value onto the stack to perform the
1475
* generate a SETLCL for our formal parameter, so that the exception
1476
* object is stored in our local variable
1478
exc_var_->gen_code_setlcl();
1480
/* generate code for our statement, if we have one */
1482
gen_code_substm(body_);
1484
/* restore the enclosing local scope */
1485
G_cs->set_local_frame(old_frame);
1488
/* ------------------------------------------------------------------------ */
1496
void CTPNStmFinally::gen_code(int, int)
1498
/* this can't be called directly - use gen_code_finally() instead */
1499
G_tok->throw_internal_error(TCERR_CATCH_FINALLY_GEN_CODE);
1504
* generate code for the 'finally'
1506
void CTPNStmFinally::gen_code_finally(ulong start_prot_ofs,
1508
CTPNStmTry *try_stm)
1510
CTPNStmEnclosing *old_enclosing;
1513
* set the source location for our prolog code to the 'finally'
1516
add_debug_line_rec();
1518
/* push the enclosing statement */
1519
old_enclosing = G_cs->set_enclosing(this);
1522
* add our exception table entry - use the invalid object ID as a
1523
* special flag to indicate that we catch all exceptions
1525
G_cg->get_exc_table()->add_catch(start_prot_ofs, end_prot_ofs,
1526
VM_INVALID_OBJ, G_cs->get_ofs());
1528
/* don't allow any peephole optimizations to affect this offset */
1529
G_cg->clear_peephole();
1531
/* the VM pushes the exception onto the stack before calling us */
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
1541
CTcSymLocal::s_gen_code_setlcl_stk(exc_local_id_, FALSE);
1543
/* call the 'finally' block */
1544
try_stm->gen_jsr_finally();
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.
1551
CTcSymLocal::s_gen_code_getlcl(exc_local_id_, FALSE);
1553
/* re-throw the exception - this pops the exception object */
1554
G_cg->write_op(OPC_THROW);
1558
* set the source location to the 'finally' clause once again, since
1559
* we changed the source location in the course of generating the
1562
add_debug_line_rec();
1564
/* this is where the 'finally' code block begins - define our label */
1565
def_label_pos(try_stm->get_finally_lbl());
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.)
1575
CTcSymLocal::s_gen_code_setlcl_stk(jsr_local_id_, FALSE);
1577
/* generate the code block, if there is one */
1579
gen_code_substm(body_);
1581
/* return from the 'finally' subroutine */
1582
G_cg->write_op(OPC_LRET);
1583
G_cs->write2(jsr_local_id_);
1585
/* restore the enclosing statement */
1586
G_cs->set_enclosing(old_enclosing);
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
1594
int CTPNStmFinally::check_enter_by_goto(CTPNStmGoto *goto_stm,
1597
/* this is illegal - log an error */
1598
goto_stm->log_error(TCERR_GOTO_INTO_FINALLY);
1600
/* indicate that it's not allowed */
1605
/* ------------------------------------------------------------------------ */
1613
void CTPNStmThrow::gen_code(int, int)
1615
/* add a line record */
1616
add_debug_line_rec();
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
1623
expr_->gen_code(FALSE, FALSE);
1625
/* generate the 'throw' */
1626
G_cg->write_op(OPC_THROW);
1628
/* 'throw' pops the expression from the stack */
1632
/* ------------------------------------------------------------------------ */
1640
void CTPNStmGoto::gen_code(int, int)
1643
CTPNStmLabel *label_stm;
1645
/* add a line record */
1646
add_debug_line_rec();
1649
* look up our label symbol in the 'goto' table for the function,
1650
* and get the label statement node from the label
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)
1658
log_error(TCERR_INVALID_GOTO_LBL, (int)lbl_len_, lbl_);
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.
1671
if (G_cs->get_enclosing() != 0)
1673
/* generate the unwinding code */
1674
G_cs->get_enclosing()->gen_code_unwind_for_goto(this, label_stm);
1678
CTPNStmEnclosing *enc;
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
1687
for (enc = label_stm ; enc != 0 ; enc = enc->get_enclosing())
1690
* make sure we're allowed to enter this statement - if not,
1691
* stop scanning, so that we display only one such error
1693
if (!enc->check_enter_by_goto(this, label_stm))
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);
1704
/* ------------------------------------------------------------------------ */
1706
* Generic enclosing statement node
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
1714
int CTPNStmEnclosing::gen_code_break_loop(CTcCodeLabel *code_label,
1715
const textchar_t *lbl,
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.
1725
/* if there's an enclosing statement, let it handle it */
1726
if (enclosing_ != 0)
1727
return enclosing_->gen_code_break(lbl, lbl_len);
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
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.
1742
G_cg->write_op(OPC_JMP);
1743
G_cs->write_ofs2(code_label, 0);
1745
/* we have generated the break */
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.
1754
int CTPNStmEnclosing::gen_code_continue_loop(CTcCodeLabel *code_label,
1755
const textchar_t *lbl,
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.
1765
/* if there's an enclosing statement, let it handle it */
1766
if (enclosing_ != 0)
1767
return enclosing_->gen_code_continue(lbl, lbl_len);
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
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
1782
G_cg->write_op(OPC_JMP);
1783
G_cs->write_ofs2(code_label, 0);
1785
/* we have generated the continue */
1790
* Generate the code necessary to unwind the stack for executing a
1791
* 'goto' to the given labeled statement>
1793
void CTPNStmEnclosing::gen_code_unwind_for_goto(CTPNStmGoto *goto_stm,
1794
CTPNStmLabel *target)
1796
CTPNStmEnclosing *enc;
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.
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.
1809
for (enc = target ; enc != 0 ; enc = enc->get_enclosing())
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
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'.
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
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
1839
for (enc = target ; enc != 0 && enc != this ;
1840
enc = enc->get_enclosing())
1842
/* make sure we're allowed to enter this statement */
1843
if (!enc->check_enter_by_goto(goto_stm, target))
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
1857
/* generate code to transfer out of this statement */
1858
gen_code_for_transfer_out();
1860
/* check for an enclosing statement */
1861
if (enclosing_ != 0)
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.
1869
enclosing_->gen_code_unwind_for_goto(goto_stm, target);
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.
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.
1886
for (enc = target ; enc != 0 ; enc = enc->get_enclosing())
1888
/* make sure we're allowed to enter this statement */
1889
if (!enc->check_enter_by_goto(goto_stm, target))
1895
/* ------------------------------------------------------------------------ */
1897
* Object Definition Statement
1901
* given the offset of the start of an object in the compiled object
1902
* stream, get the offset of the first property
1904
ulong CTPNStmObject::get_stream_first_prop_ofs(CTcDataStream *stream,
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
1913
return obj_ofs + TCT3_TADSOBJ_SC_OFS
1914
+ (get_stream_sc_cnt(stream, obj_ofs) * 4);
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
1921
ulong CTPNStmObject::get_stream_prop_ofs(CTcDataStream *stream,
1922
ulong obj_ofs, uint idx)
1925
* calculate the offset to the selected property from the start of
1926
* the property table
1928
return get_stream_first_prop_ofs(stream, obj_ofs)
1929
+ (TCT3_TADSOBJ_PROP_SIZE * idx);
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
1936
uint CTPNStmObject::get_stream_prop_cnt(CTcDataStream *stream,
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);
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
1948
size_t CTPNStmObject::set_stream_prop_cnt(CTcDataStream *stream,
1949
ulong obj_ofs, uint prop_cnt)
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);
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
1962
data_size = TCT3_TADSOBJ_HEADER_SIZE
1963
+ (get_stream_sc_cnt(stream, obj_ofs) * 4)
1964
+ (prop_cnt * TCT3_TADSOBJ_PROP_SIZE);
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);
1969
/* return the new data size */
1974
* Get the object flags from an object in a compiled stream
1976
uint CTPNStmObject::get_stream_obj_flags(CTcDataStream *stream,
1979
/* the flags are at offset 4 in the tads-object header */
1980
return stream->read2_at(obj_ofs + TCT3_TADSOBJ_HEADER_OFS + 4);
1984
* Set the object flags in an object in a compiled stream
1986
void CTPNStmObject::set_stream_obj_flags(CTcDataStream *stream,
1987
ulong obj_ofs, uint flags)
1990
* write the new flags - they're at offset 4 in the tads-object
1993
stream->write2_at(obj_ofs + TCT3_TADSOBJ_HEADER_OFS + 4, flags);
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
2000
uint CTPNStmObject::get_stream_sc_cnt(CTcDataStream *stream,
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);
2008
* given the stream offset of the start of an object in the compiled
2009
* object stream, change a superclass object ID
2011
void CTPNStmObject::set_stream_sc(CTcDataStream *stream, ulong obj_ofs,
2012
uint sc_idx, vm_obj_id_t new_sc)
2015
* set the superclass - it's at offset 6 in the object data, plus
2016
* four bytes (UINT4) per index slot
2018
stream->write2_at(obj_ofs + TCT3_TADSOBJ_HEADER_OFS + 6 + (sc_idx * 4),
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
2027
vm_prop_id_t CTPNStmObject::get_stream_prop_id(CTcDataStream *stream,
2028
ulong obj_ofs, uint prop_idx)
2032
/* get the property's data offset */
2033
prop_ofs = get_stream_prop_ofs(stream, obj_ofs, prop_idx);
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);
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
2044
vm_datatype_t CTPNStmObject::
2045
get_stream_prop_type(CTcDataStream *stream, ulong obj_ofs, uint prop_idx)
2049
/* get the property's data holder offset */
2050
dh_ofs = get_stream_prop_val_ofs(stream, obj_ofs, prop_idx);
2052
/* the type is the first byte of the serialized data holder */
2053
return (vm_datatype_t)stream->get_byte_at(dh_ofs);
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
2061
ulong CTPNStmObject::get_stream_prop_val_ofs(CTcDataStream *stream,
2062
ulong obj_ofs, uint prop_idx)
2066
/* get the property's data offset */
2067
prop_ofs = get_stream_prop_ofs(stream, obj_ofs, prop_idx);
2069
/* the data holder immediately follows the (UINT2) property ID */
2070
return prop_ofs + 2;
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
2079
void CTPNStmObject::set_stream_prop_id(CTcDataStream *stream,
2080
ulong obj_ofs, uint prop_idx,
2081
vm_prop_id_t new_id)
2085
/* get the property's data offset */
2086
prop_ofs = get_stream_prop_ofs(stream, obj_ofs, prop_idx);
2089
stream->write2_at(prop_ofs, (uint)new_id);
2092
/* ------------------------------------------------------------------------ */
2094
* Object Property list entry - value node
2096
void CTPNObjProp::gen_code(int, int)
2099
char buf[VMB_DATAHOLDER];
2102
/* get the correct data stream */
2103
str = obj_stm_->get_obj_sym()->get_stream();
2105
/* set the current source location for error reporting */
2106
G_tok->set_line_info(file_, linenum_);
2108
/* generate code for our expression or our code body, as appropriate */
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
2116
if (expr_->is_const())
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());
2122
else if (expr_->is_dstring())
2126
/* it's a double-quoted string node */
2127
dstr = (CTPNDstr *)expr_;
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.
2134
G_cg->add_const_str(dstr->get_str(), dstr->get_str_len(),
2135
str, str->get_ofs() + 1);
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.
2143
vmb_put_dh(buf, &val);
2144
str->write(buf, VMB_DATAHOLDER);
2148
/* we should never get here */
2149
G_tok->throw_internal_error(TCERR_INVAL_PROP_CODE_GEN);
2152
else if (code_body_ != 0)
2154
char buf[VMB_DATAHOLDER];
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);
2161
/* if it's static, do some extra work */
2164
/* mark the code body as static */
2165
code_body_->set_static();
2168
* add the obj.prop to the static ID stream, so the VM knows
2169
* to invoke this initializer at start-up
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());
2177
/* tell our code body to generate the code */
2178
code_body_->gen_code(FALSE, FALSE);
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
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.
2193
CTcAbsFixup::add_abs_fixup(code_body_->get_fixup_list_head(),
2194
str, str->get_ofs() + 1);
2196
/* write out our value in DATAHOLDER format */
2197
vmb_put_dh(buf, &val);
2198
str->write(buf, VMB_DATAHOLDER);
2205
void CTPNObjProp::check_locals()
2207
/* check locals in our code body */
2208
if (code_body_ != 0)
2209
code_body_->check_locals();
2212
/* ------------------------------------------------------------------------ */
2214
* Implicit constructor
2216
void CTPNStmImplicitCtor::gen_code(int /*discard*/, int /*for_condition*/)
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.
2225
for (sc = obj_stm_->get_first_sc() ; sc != 0 ; sc = sc->nxt_)
2230
* if this one is valid, generate code to call its constructor -
2231
* it's valid if it has an object symbol
2233
sc_sym = (CTcSymObj *)sc->get_sym();
2234
if (sc_sym != 0 && sc_sym->get_type() == TC_SYM_OBJ)
2236
/* push the argument counter so far (no other arguments) */
2237
G_cg->write_op(OPC_PUSH_0);
2240
/* get the varargs list local */
2241
CTcSymLocal::s_gen_code_getlcl(0, FALSE);
2243
/* convert it to varargs */
2244
G_cg->write_op(OPC_MAKELSTPAR);
2246
/* note the extra push and pop for the argument count */
2250
/* it's a varargs call */
2251
G_cg->write_op(OPC_VARARGC);
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());
2260
* this removes arguments (the varargs list variable and
2269
/* ------------------------------------------------------------------------ */
2271
* Anonymous function
2277
void CTPNAnonFunc::gen_code(int discard, int)
2279
CTcCodeBodyCtx *cur_ctx;
2282
/* if we're discarding the value, don't bother generating the code */
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
2293
for (argc = 0, cur_ctx = code_body_->get_ctx_tail() ; cur_ctx != 0 ;
2294
cur_ctx = cur_ctx->prv_, ++argc)
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
2303
if (!G_cs->get_code_body()
2304
->get_ctx_var_for_level(cur_ctx->level_ - 1, &our_varnum))
2306
/* this should never happen */
2311
* push this context object - to do this, simply retrieve the
2312
* value of the local variable in our frame that contains this
2315
CTcSymLocal::s_gen_code_getlcl(our_varnum, FALSE);
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.
2323
G_cg->write_op(OPC_PUSHFNPTR);
2324
code_body_->add_abs_fixup(G_cs);
2328
/* note the push of the function pointer argument */
2331
/* create the new function object */
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));
2340
G_cg->write_op(OPC_NEW2);
2342
G_cs->write2(G_cg->get_predef_meta_idx(TCT3_METAID_ANONFN));
2345
/* push the object value */
2346
G_cg->write_op(OPC_GETR0);
2348
/* the 'new' popped the arguments, then we pushed the result */
2349
G_cg->note_pop(argc - 1);
added
removed
tads/tads3/tct3stm.cpp
