WebSVN – tendra.SVN – Blame – /trunk/src/producers/common/output/struct.c

Rev	Author	Line No.	Line
2	7u83	1	`/*`
7	7u83	2	`* Copyright (c) 2002-2006 The TenDRA Project <http://www.tendra.org/>.`
		3	`* All rights reserved.`
		4	`*`
		5	`* Redistribution and use in source and binary forms, with or without`
		6	`* modification, are permitted provided that the following conditions are met:`
		7	`*`
		8	`* 1. Redistributions of source code must retain the above copyright notice,`
		9	`* this list of conditions and the following disclaimer.`
		10	`* 2. Redistributions in binary form must reproduce the above copyright notice,`
		11	`* this list of conditions and the following disclaimer in the documentation`
		12	`* and/or other materials provided with the distribution.`
		13	`* 3. Neither the name of The TenDRA Project nor the names of its contributors`
		14	`* may be used to endorse or promote products derived from this software`
		15	`* without specific, prior written permission.`
		16	`*`
		17	* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
		18	`* IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,`
		19	`* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR`
		20	`* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR`
		21	`* CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,`
		22	`* EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,`
		23	`* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;`
		24	`* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,`
		25	`* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR`
		26	`* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF`
		27	`* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.`
		28	`*`
		29	`* $Id$`
		30	`*/`
		31	`/*`
2	7u83	32	`Crown Copyright (c) 1997, 1998`
7	7u83	33
2	7u83	34	`This TenDRA(r) Computer Program is subject to Copyright`
		35	`owned by the United Kingdom Secretary of State for Defence`
		36	`acting through the Defence Evaluation and Research Agency`
		37	`(DERA). It is made available to Recipients with a`
		38	`royalty-free licence for its use, reproduction, transfer`
		39	`to other parties and amendment for any purpose not excluding`
		40	`product development provided that any such use et cetera`
		41	`shall be deemed to be acceptance of the following conditions:-`
7	7u83	42
2	7u83	43	`(1) Its Recipients shall ensure that this Notice is`
		44	`reproduced upon any copies or amended versions of it;`
7	7u83	45
2	7u83	46	`(2) Any amended version of it shall be clearly marked to`
		47	`show both the nature of and the organisation responsible`
		48	`for the relevant amendment or amendments;`
7	7u83	49
2	7u83	50	`(3) Its onward transfer from a recipient to another`
		51	`party shall be deemed to be that party's acceptance of`
		52	`these conditions;`
7	7u83	53
2	7u83	54	`(4) DERA gives no warranty or assurance as to its`
		55	`quality or suitability for any purpose and DERA accepts`
		56	`no liability whatsoever in relation to any use to which`
		57	`it may be put.`
		58	`*/`
		59
		60
		61	`#include "config.h"`
		62	`#include "version.h"`
		63	`#include "c_types.h"`
		64	`#include "ctype_ops.h"`
		65	`#include "exp_ops.h"`
		66	`#include "graph_ops.h"`
		67	`#include "hashid_ops.h"`
		68	`#include "id_ops.h"`
		69	`#include "itype_ops.h"`
		70	`#include "member_ops.h"`
		71	`#include "nspace_ops.h"`
		72	`#include "off_ops.h"`
		73	`#include "type_ops.h"`
		74	`#include "virt_ops.h"`
		75	`#include "error.h"`
		76	`#include "tdf.h"`
		77	`#include "allocate.h"`
		78	`#include "basetype.h"`
		79	`#include "buffer.h"`
		80	`#include "capsule.h"`
		81	`#include "check.h"`
		82	`#include "chktype.h"`
		83	`#include "class.h"`
		84	`#include "compile.h"`
		85	`#include "constant.h"`
		86	`#include "construct.h"`
		87	`#include "derive.h"`
		88	`#include "destroy.h"`
		89	`#include "encode.h"`
		90	`#include "exp.h"`
		91	`#include "function.h"`
		92	`#include "hash.h"`
		93	`#include "init.h"`
		94	`#include "initialise.h"`
		95	`#include "interface.h"`
		96	`#include "mangle.h"`
		97	`#include "member.h"`
		98	`#include "namespace.h"`
		99	`#include "print.h"`
		100	`#include "shape.h"`
		101	`#include "struct.h"`
		102	`#include "syntax.h"`
		103	`#include "tok.h"`
		104	`#include "token.h"`
		105	`#include "virtual.h"`
		106	`#if TDF_OUTPUT`
		107
		108
		109	`/*`
		110	`CLASS AND GRAPH TOKEN NUMBERS`
		111
		112	`Each node of a base class graph has three associated token numbers.`
		113	`The use of these numbers varies depending on whether the node is`
		114	`the top node of a graph, a virtual base class, or a non-virtual base`
		115	`class. These macros give mnemonic values for these uses. Names are`
		116	`also given to the various class type token numbers.`
		117	`*/`
		118
7	7u83	119	`#define ctype_shape(A) ctype_tok1((A))`
		120	`#define ctype_null_exp(A) ctype_tok2((A))`
		121	`#define graph_al_tag(A) graph_tok1((A))`
		122	`#define graph_core_off(A) graph_tok2((A))`
		123	`#define graph_base_off(A) graph_tok1((A))`
		124	`#define graph_real_off(A) graph_tok2((A))`
2	7u83	125
		126
		127	`/*`
		128	`DUMMY CLASS TYPE`
		129
		130	`These types are dummies used in the class layout routines.`
		131	`*/`
		132
7	7u83	133	`TYPE dummy_class = NULL_type;`
		134	`TYPE dummy_vtab = NULL_type;`
		135	`TYPE dummy_count = NULL_type;`
		136	`TYPE ptr_dummy_class = NULL_type;`
		137	`TYPE ptr_dummy_vtab = NULL_type;`
		138	`TYPE dummy_func = NULL_type;`
		139	`ulong size_dummy_vtab = 0;`
		140	`OFFSET off_size_t = NULL_off;`
		141	`IDENTIFIER dummy_type_name = NULL_id;`
2	7u83	142
		143
		144	`/*`
		145	`ENCODE AN EXPRESSION TOKEN APPLICATION`
		146
		147	`This routine adds an application of the simple expression token n to`
		148	`the bitstream bs.`
		149	`*/`
		150
7	7u83	151	`static BITSTREAM *`
		152	`enc_exp_token(BITSTREAM *bs, ulong n)`
2	7u83	153	`{`
7	7u83	154	`ulong m = link_no(bs, n, VAR_token);`
		155	`ENC_exp_apply_token(bs);`
		156	`ENC_make_tok(bs, m);`
		157	`ENC_LEN_SMALL(bs, 0);`
		158	`return (bs);`
2	7u83	159	`}`
		160
		161
		162	`/*`
		163	`ENCODE A SHAPE TOKEN APPLICATION`
		164
		165	`This routine adds an application of the simple shape token n to the`
		166	`bitstream bs.`
		167	`*/`
		168
7	7u83	169	`static BITSTREAM *`
		170	`enc_shape_token(BITSTREAM *bs, ulong n)`
2	7u83	171	`{`
7	7u83	172	`ulong m = link_no(bs, n, VAR_token);`
		173	`ENC_shape_apply_token(bs);`
		174	`ENC_make_tok(bs, m);`
		175	`ENC_LEN_SMALL(bs, 0);`
		176	`return (bs);`
2	7u83	177	`}`
		178
		179
		180	`/*`
		181	`VIRTUAL FUNCTION TABLE ROUTINES`
		182
		183	`The virtual function table and run-time type information routines are`
		184	`only included in the C++ producer.`
		185	`*/`
		186
		187	`#if LANGUAGE_CPP`
		188
		189
		190	`/*`
		191	`ENCODE A BUFFER AS A STRING LITERAL`
		192
		193	`This routine adds the contents of the buffer bf to the bitstream bs`
		194	`as a string literal.`
		195	`*/`
		196
7	7u83	197	`static BITSTREAM *`
		198	`enc_buffer(BITSTREAM bs, BUFFER bf)`
2	7u83	199	`{`
7	7u83	200	`string s = bf->start;`
		201	`unsigned long n = (unsigned long)(bf->posn - s);`
2	7u83	202
7	7u83	203	`/* Declare the string literal */`
		204	`ulong m = capsule_no(NULL_string, VAR_tag);`
		205	`BITSTREAM *ts = enc_tagdec_start(NULL_id, m, NULL_type, 1);`
		206	`ENC_nof(ts);`
		207	`ENC_make_nat(ts);`
		208	`ENC_INT(ts, n);`
		209	`ts = enc_shape(ts, type_char);`
		210	`enc_tagdec_end(ts);`
2	7u83	211
7	7u83	212	`/* Define the string literal */`
		213	`ts = enc_tagdef_start(NULL_id, m, NULL_type, 1);`
		214	`ENC_make_nof_int(ts);`
		215	`ts = enc_variety(ts, type_char);`
		216	`ENC_make_string(ts);`
		217	`ts = enc_tdfstring(ts, n, s);`
		218	`enc_tagdef_end(ts);`
2	7u83	219
7	7u83	220	`/* Encode the result */`
		221	`m = link_no(bs, m, VAR_tag);`
		222	`ENC_obtain_tag(bs);`
		223	`ENC_make_tag(bs, m);`
		224	`return (bs);`
2	7u83	225	`}`
		226
		227
		228	`/*`
		229	`ENCODE RUN-TIME BASE CLASS INFORMATION`
		230
		231	`This routine defines the run-time base class information for the base`
		232	`classes br or the sub-types pt and adds the address of the first base`
		233	`to bs.`
		234	`*/`
		235
7	7u83	236	`static BITSTREAM *`
		237	`enc_rtti_bases(BITSTREAM *bs, LIST(GRAPH)br, LIST(TYPE)pt, NAT sz)`
2	7u83	238	`{`
7	7u83	239	`TYPE t;`
		240	`ulong n, m;`
		241	`BITSTREAM ts, us;`
		242	`int a = INFO_public;`
2	7u83	243
7	7u83	244	`if (!IS_NULL_list(br)) {`
		245	`/* Get base class information */`
		246	`VIRTUAL vt;`
		247	`CLASS_TYPE ct;`
		248	`GRAPH gr = DEREF_graph(HEAD_list(br));`
		249	`DECL_SPEC acc = DEREF_dspec(graph_access(gr));`
		250	`br = TAIL_list(br);`
2	7u83	251
7	7u83	252	`/* Find base class information */`
		253	`ct = DEREF_ctype(graph_head(gr));`
		254	`t = make_class_type(ct);`
		255	`vt = DEREF_virt(ctype_virt(ct));`
		256	`if (!IS_NULL_virt(vt)) {`
		257	`/* Make sure base class is declared */`
		258	`int used = DEREF_int(virt_table_rtti_used(vt));`
		259	`if (!used) {`
		260	`IDENTIFIER cid = DEREF_id(ctype_name(ct));`
		261	`COPY_int(virt_table_rtti_used(vt), 1);`
		262	`compile_virtual(ct, !has_linkage(cid));`
		263	`}`
		264	`}`
		265	`if (acc & dspec_virtual) {`
		266	`sz = small_nat[1];`
		267	`}`
		268	`acc &= dspec_access;`
		269	`if (acc == dspec_protected) {`
		270	`a = INFO_protected;`
		271	`} else if (acc == dspec_private) {`
		272	`a = INFO_private;`
		273	`}`
		274	`m = DEREF_ulong(graph_base_off(gr));`
2	7u83	275
7	7u83	276	`} else if (!IS_NULL_list(pt)) {`
		277	`/* Get sub-type information */`
		278	`t = DEREF_type(HEAD_list(pt));`
		279	`pt = TAIL_list(pt);`
		280	`if (!IS_NULL_type(t)) {`
		281	`CV_SPEC cv = DEREF_cv(type_qual(t));`
		282	`if (IS_type_func(t)) {`
		283	`/* Allow for function qualifiers */`
		284	`cv = DEREF_cv(type_func_mqual(t));`
		285	`}`
		286	`if (cv) {`
		287	`if (cv & cv_const) {`
		288	`a \|= INFO_const;`
		289	`}`
		290	`if (cv & cv_volatile) {`
		291	`a \|= INFO_volatile;`
		292	`}`
		293	`t = qualify_type(t, cv_none, 0);`
		294	`}`
		295	`}`
		296	`m = LINK_NONE;`
		297
		298	`} else {`
		299	`/* Output end of list */`
		300	`ENC_make_null_ptr(bs);`
		301	`ENC_alignment(bs);`
		302	`bs = enc_special(bs, TOK_baseid_type);`
		303	`return (bs);`
2	7u83	304	`}`
		305
7	7u83	306	`/* Declare base structure */`
		307	`n = capsule_no(NULL_string, VAR_tag);`
		308	`ts = enc_tagdec_start(NULL_id, n, NULL_type, 1);`
		309	`ts = enc_special(ts, TOK_baseid_type);`
		310	`enc_tagdec_end(ts);`
2	7u83	311
7	7u83	312	`/* Define base structure */`
		313	`ts = enc_tagdef_start(NULL_id, n, NULL_type, 1);`
		314	`ts = enc_special(ts, TOK_baseid_make);`
		315	`us = start_bitstream(NIL(FILE), ts->link);`
		316	`us = enc_rtti_type(us, t, lex_typeid);`
		317	`if (m == LINK_NONE) {`
		318	`ENC_offset_zero(us);`
		319	`us = enc_alignment(us, type_sint);`
		320	`} else {`
		321	`us = enc_exp_token(us, m);`
		322	`}`
		323	`us = enc_rtti_bases(us, br, pt, NULL_nat);`
		324	`us = enc_make_snat(us, a);`
		325	`us = enc_snat(us, sz, 0, 0);`
		326	`ts = enc_bitstream(ts, us);`
		327	`enc_tagdef_end(ts);`
2	7u83	328
7	7u83	329	`/* Encode the result */`
		330	`n = link_no(bs, n, VAR_tag);`
		331	`ENC_obtain_tag(bs);`
		332	`ENC_make_tag(bs, n);`
		333	`return (bs);`
2	7u83	334	`}`
		335
		336
		337	`/*`
		338	`ENCODE A RUN-TIME TYPE INFORMATION STRUCTURE`
		339
		340	`This routine defines the tag n to be the run-time type information`
		341	`structure for the type t. If def is false then only the declaration`
		342	`is output.`
		343	`*/`
		344
7	7u83	345	`static void`
		346	`enc_rtti_struct(TYPE t, ulong n, int def)`
2	7u83	347	`{`
7	7u83	348	`unsigned acc = find_usage(n, VAR_tag);`
		349	`if (!(acc & USAGE_DECL)) {`
		350	`BITSTREAM *bs = enc_tagdec_start(NULL_id, n, NULL_type, 1);`
		351	`bs = enc_special(bs, TOK_typeid_type);`
		352	`enc_tagdec_end(bs);`
		353	`}`
		354	`if (def && !(acc & USAGE_DEFN)) {`
		355	`int c = RTTI_void;`
		356	`NAT sz = NULL_nat;`
		357	`BITSTREAM bs, ts;`
		358	`LIST(TYPE)p = NULL_list(TYPE);`
		359	`LIST(GRAPH)br = NULL_list(GRAPH);`
		360	`BUFFER *bf = clear_buffer(&print_buff, NIL(FILE));`
		361	`print_uniq_anon++;`
		362	`IGNORE print_type(t, bf, 0);`
		363	`print_uniq_anon--;`
		364	`bfputc(bf, 0);`
		365	`switch (TAG_type(t)) {`
		366	`case type_integer_tag: {`
		367	`/* Integral types */`
		368	`c = RTTI_integer;`
		369	`break;`
2	7u83	370	`}`
7	7u83	371	`case type_floating_tag: {`
		372	`/* Floating-point types */`
		373	`c = RTTI_float;`
		374	`break;`
2	7u83	375	`}`
7	7u83	376	`case type_ptr_tag: {`
		377	`/* Pointer types */`
		378	`TYPE s = DEREF_type(type_ptr_sub(t));`
		379	`CONS_type(s, p, p);`
		380	`c = RTTI_ptr;`
		381	`break;`
2	7u83	382	`}`
7	7u83	383	`case type_ref_tag: {`
		384	`/* Reference types */`
		385	`TYPE s = DEREF_type(type_ref_sub(t));`
		386	`CONS_type(s, p, p);`
		387	`c = RTTI_ref;`
		388	`break;`
2	7u83	389	`}`
7	7u83	390	`case type_ptr_mem_tag: {`
		391	`/* Pointer to member types */`
		392	`TYPE s = DEREF_type(type_ptr_mem_sub(t));`
		393	`CLASS_TYPE cs = DEREF_ctype(type_ptr_mem_of(t));`
		394	`CONS_type(s, p, p);`
		395	`s = make_class_type(cs);`
		396	`CONS_type(s, p, p);`
		397	`c = RTTI_ptr_mem;`
		398	`break;`
		399	`}`
		400	`case type_func_tag: {`
		401	`/* Function types */`
		402	`TYPE s = DEREF_type(type_func_ret(t));`
		403	`CV_SPEC mq = DEREF_cv(type_func_mqual(t));`
		404	`int ell = DEREF_int(type_func_ellipsis(t));`
		405	`LIST(TYPE)q = DEREF_list(type_func_ptypes(t));`
		406	`CONS_type(s, p, p);`
		407	`while (!IS_NULL_list(q)) {`
		408	`s = DEREF_type(HEAD_list(q));`
		409	`CONS_type(s, p, p);`
		410	`q = TAIL_list(q);`
		411	`}`
		412	`if (ell & FUNC_ELLIPSIS) {`
		413	`CONS_type(type_any, p, p);`
		414	`}`
		415	`p = REVERSE_list(p);`
		416	`if (mq & cv_c) {`
		417	`c = RTTI_c_func;`
		418	`} else {`
		419	`c = RTTI_func;`
		420	`}`
		421	`break;`
		422	`}`
		423	`case type_array_tag: {`
		424	`/* Array types */`
		425	`TYPE s = DEREF_type(type_array_sub(t));`
		426	`CONS_type(s, p, p);`
		427	`sz = DEREF_nat(type_array_size(t));`
		428	`c = RTTI_array;`
		429	`break;`
		430	`}`
		431	`case type_bitfield_tag: {`
		432	`/* Bitfield types */`
		433	`INT_TYPE it = DEREF_itype(type_bitfield_defn(t));`
		434	`TYPE s = DEREF_type(itype_bitfield_sub(it));`
		435	`CONS_type(s, p, p);`
		436	`sz = DEREF_nat(itype_bitfield_size(it));`
		437	`c = RTTI_bitfield;`
		438	`break;`
		439	`}`
		440	`case type_compound_tag: {`
		441	`/* Class types */`
		442	`CLASS_TYPE ct = DEREF_ctype(type_compound_defn(t));`
		443	`CLASS_INFO ci = DEREF_cinfo(ctype_info(ct));`
		444	`GRAPH gr = DEREF_graph(ctype_base(ct));`
		445	`br = DEREF_list(graph_tails(gr));`
		446	`if (ci & cinfo_union) {`
		447	`c = RTTI_union;`
		448	`} else {`
		449	`c = RTTI_class;`
		450	`}`
		451	`break;`
		452	`}`
		453	`case type_enumerate_tag: {`
		454	`/* Enumeration types */`
		455	`c = RTTI_enum;`
		456	`break;`
		457	`}`
		458	`}`
		459	`bs = enc_tagdef_start(NULL_id, n, NULL_type, 1);`
		460	`bs = enc_special(bs, TOK_typeid_make);`
		461	`ts = start_bitstream(NIL(FILE), bs->link);`
		462	`ts = enc_make_snat(ts, c);`
		463	`ts = enc_buffer(ts, bf);`
		464	`ts = enc_rtti_bases(ts, br, p, sz);`
		465	`DESTROY_list(p, SIZE_type);`
		466	`bs = enc_bitstream(bs, ts);`
		467	`enc_tagdef_end(bs);`
2	7u83	468	`}`
7	7u83	469	`return;`
2	7u83	470	`}`
		471
		472
		473	`/*`
		474	`LIST OF RUN-TIME TYPE INFORMATION STRUCTURES`
		475
		476	`These lists gives the tag numbers for the various type information`
		477	`structures output. Polymorphic classes, which form the most common`
		478	`such types, are dealt with separately as part of the virtual function`
		479	`table.`
		480	`*/`
		481
7	7u83	482	`static LIST(TYPE)rtti_types = NULL_list(TYPE);`
		483	`static LIST(ulong)rtti_tags = NULL_list(ulong);`
2	7u83	484
		485
		486	`/*`
		487	`ENCODE THE RUN-TIME TYPE INFORMATION FOR A TYPE`
		488
		489	`This routine adds a reference to the run-time type information`
		490	`structure for the type t to the bitstream bs, defining this if`
		491	`necessary.`
		492	`*/`
		493
7	7u83	494	`BITSTREAM *`
		495	`enc_rtti_type(BITSTREAM *bs, TYPE t, int op)`
2	7u83	496	`{`
7	7u83	497	`ulong n = LINK_NONE;`
		498	`if (IS_NULL_type(t)) {`
		499	`/* Map null type to null pointer */`
		500	`ENC_make_null_ptr(bs);`
		501	`ENC_alignment(bs);`
		502	`bs = enc_special(bs, TOK_typeid_type);`
		503	`return (bs);`
2	7u83	504	`}`
7	7u83	505	`if (op == lex_typeid && !output_rtti) {`
		506	`/* Use dummy type if RTTI suppressed */`
		507	`t = type_error;`
		508	`}`
		509	`switch (TAG_type(t)) {`
		510	`case type_top_tag:`
		511	`case type_bottom_tag:`
		512	`case type_integer_tag:`
		513	`case type_floating_tag:`
		514	`case type_pre_tag:`
		515	`case type_error_tag: {`
		516	`/* Built-in types */`
		517	`BITSTREAM *ts;`
		518	`bs = enc_special(bs, TOK_typeid_basic);`
		519	`ts = start_bitstream(NIL(FILE), bs->link);`
		520	`ts = enc_arith(ts, t, 1);`
		521	`bs = enc_bitstream(bs, ts);`
		522	`return (bs);`
		523	`}`
		524	`case type_compound_tag: {`
		525	`/* Class types */`
		526	`CLASS_TYPE ct = DEREF_ctype(type_compound_defn(t));`
		527	`CLASS_INFO ci = DEREF_cinfo(ctype_info(ct));`
		528	`if (ci & cinfo_polymorphic) {`
		529	`/* Polymorphic class types */`
		530	`int used;`
		531	`VIRTUAL vt = DEREF_virt(ctype_virt(ct));`
		532	`n = DEREF_ulong(virt_table_rtti(vt));`
		533	`if (n == LINK_NONE) {`
		534	`IGNORE compile_class(ct);`
		535	`n = DEREF_ulong(virt_table_rtti(vt));`
		536	`}`
		537	`used = DEREF_int(virt_table_rtti_used(vt));`
		538	`if (!used) {`
		539	`IDENTIFIER cid = DEREF_id(ctype_name(ct));`
		540	`COPY_int(virt_table_rtti_used(vt), 1);`
		541	`compile_virtual(ct, !has_linkage(cid));`
		542	`}`
		543	`if (op == lex_vtable) {`
		544	`/* Deal with virtual function tables */`
		545	`/* NOT YET IMPLEMENTED */`
		546	`n = DEREF_ulong(virt_table_tbl(vt));`
		547	`n = link_no(bs, n, VAR_tag);`
		548	`ENC_obtain_tag(bs);`
		549	`ENC_make_tag(bs, n);`
		550	`return (bs);`
		551	`}`
		552	`} else {`
		553	`IGNORE compile_class(ct);`
2	7u83	554	`}`
7	7u83	555	`break;`
		556	`}`
		557	`}`
		558	`if (n == LINK_NONE) {`
		559	`/* Check for previous definition */`
		560	`LIST(TYPE)p = rtti_types;`
		561	`LIST(ulong)q = rtti_tags;`
		562	`while (!IS_NULL_list(p)) {`
		563	`TYPE s = DEREF_type(HEAD_list(p));`
		564	`if (eq_type(s, t)) {`
		565	`n = DEREF_ulong(HEAD_list(q));`
		566	`break;`
		567	`}`
		568	`q = TAIL_list(q);`
		569	`p = TAIL_list(p);`
2	7u83	570	`}`
7	7u83	571	`if (n == LINK_NONE) {`
		572	`/* Define a new structure */`
		573	`string s = NULL;`
		574	`if (output_all) {`
		575	`s = mangle_tname("__ti__", t);`
		576	`}`
		577	`n = capsule_no(s, VAR_tag);`
		578	`CONS_type(t, rtti_types, rtti_types);`
		579	`CONS_ulong(n, rtti_tags, rtti_tags);`
		580	`enc_rtti_struct(t, n, 1);`
2	7u83	581	`}`
		582	`}`
7	7u83	583	`n = link_no(bs, n, VAR_tag);`
		584	`ENC_obtain_tag(bs);`
		585	`ENC_make_tag(bs, n);`
		586	`return (bs);`
2	7u83	587	`}`
		588
		589
		590	`/*`
		591	`ENCODE THE RUN-TIME TYPE INFORMATION FOR AN EXPRESSION`
		592
		593	`This routine adds the run-time type information expression e to`
		594	`the bitstream bs.`
		595	`*/`
		596
7	7u83	597	`BITSTREAM *`
		598	`enc_rtti_exp(BITSTREAM *bs, EXP e)`
2	7u83	599	`{`
7	7u83	600	`EXP a = DEREF_exp(exp_rtti_arg(e));`
		601	`EXP b = DEREF_exp(exp_rtti_except(e));`
		602	`int op = DEREF_int(exp_rtti_op(e));`
		603	`TYPE t = DEREF_type(exp_type(a));`
		604	`if (IS_type_ptr_etc(t)) {`
		605	`TYPE s = DEREF_type(type_ptr_etc_sub(t));`
		606	`if (IS_type_compound(s)) {`
		607	`CLASS_TYPE ct = DEREF_ctype(type_compound_defn(s));`
		608	`VIRTUAL vt = DEREF_virt(ctype_virt(ct));`
		609	`if (!IS_NULL_virt(vt)) {`
		610	`/* Pointer to polymorphic class */`
		611	`EXP a1;`
		612	`int used;`
		613	`OFFSET off;`
		614	`ulong n, m;`
		615	`BITSTREAM *ts;`
		616	`IGNORE compile_class(ct);`
		617	`off = DEREF_off(virt_table_off(vt));`
		618	`n = DEREF_ulong(virt_table_tok(vt));`
2	7u83	619
7	7u83	620	`/* Introduce variable for pointer */`
		621	`a1 = DEREF_exp(exp_dummy_value(a));`
		622	`m = unit_no(bs, NULL_id, VAR_tag, 1);`
		623	`ENC_variable(bs);`
		624	`bs = enc_access(bs, crt_func_access);`
		625	`ENC_make_tag(bs, m);`
		626	`bs = enc_exp(bs, a);`
		627	`COPY_ulong(exp_dummy_no(a), m);`
		628	`COPY_exp(exp_dummy_value(a), NULL_exp);`
2	7u83	629
7	7u83	630	`/* Check for null pointers */`
		631	`if (!IS_NULL_exp(b)) {`
		632	`ulong lab = unit_no(bs, NULL_id,`
		633	`VAR_label, 1);`
		634	`ENC_SEQ_SMALL(bs, 1);`
		635	`ENC_conditional(bs);`
		636	`ENC_make_label(bs, lab);`
		637	`ENC_SEQ_SMALL(bs, 1);`
		638	`ENC_pointer_test(bs);`
		639	`ENC_OFF(bs);`
		640	`ENC_equal(bs);`
		641	`ENC_make_label(bs, lab);`
		642	`bs = enc_exp(bs, a);`
		643	`bs = enc_null_exp(bs, t);`
		644	`bs = enc_exp(bs, b);`
		645	`ENC_make_top(bs);`
		646	`}`
2	7u83	647
7	7u83	648	`/* Find the run-time type information */`
		649	`ts = start_bitstream(NIL(FILE), bs->link);`
		650	`if (op == lex_typeid) {`
		651	`bs = enc_special(bs, TOK_typeid_ref);`
		652	`} else {`
		653	`bs = enc_special(bs, TOK_vtab_func);`
		654	`}`
		655	`ENC_add_to_ptr(ts);`
		656	`ts = enc_add_ptr(ts, a, LINK_NONE, off, 0);`
		657	`ts = enc_exp_token(ts, n);`
		658	`if (op != lex_typeid) {`
		659	`ENC_make_signed_nat(ts);`
		660	`ENC_OFF(ts);`
		661	`ENC_INT_SMALL(ts, 0);`
		662	`}`
		663	`bs = enc_bitstream(bs, ts);`
		664	`used = DEREF_int(virt_table_rtti_used(vt));`
		665	`if (!used) {`
		666	`IDENTIFIER cid = DEREF_id(ctype_name(ct));`
		667	`COPY_int(virt_table_rtti_used(vt), 1);`
		668	`compile_virtual(ct, !has_linkage(cid));`
		669	`}`
		670	`COPY_exp(exp_dummy_value(a), a1);`
		671	`return (bs);`
		672	`}`
2	7u83	673	`}`
		674	`}`
7	7u83	675	`bs = enc_rtti_type(bs, t, op);`
		676	`return (bs);`
2	7u83	677	`}`
		678
		679
		680	`/*`
		681	`ENCODE A DYNAMIC CAST EXPRESSION`
		682
		683	`This routine adds the dynamic cast expression e to the bitstream bs.`
		684	`*/`
		685
7	7u83	686	`BITSTREAM *`
		687	`enc_dyn_cast(BITSTREAM *bs, EXP e)`
2	7u83	688	`{`
7	7u83	689	`ulong m;`
		690	`int used;`
		691	`OFFSET off;`
		692	`VIRTUAL vt;`
		693	`CLASS_TYPE ct;`
		694	`BITSTREAM ts, us;`
		695	`ulong r = LINK_NONE;`
		696	`TYPE t = DEREF_type(exp_type(e));`
		697	`EXP a = DEREF_exp(exp_dyn_cast_arg(e));`
		698	`TYPE s = DEREF_type(exp_type(a));`
		699	`EXP a1 = DEREF_exp(exp_dummy_value(a));`
		700	`EXP b = DEREF_exp(exp_dyn_cast_except(e));`
2	7u83	701
7	7u83	702	`/* Introduce identity for argument */`
		703	`ulong n = unit_no(bs, NULL_id, VAR_tag, 1);`
		704	`ENC_identify(bs);`
		705	`bs = enc_access(bs, dspec_none);`
		706	`ENC_make_tag(bs, n);`
		707	`bs = enc_exp(bs, a1);`
		708	`COPY_exp(exp_dummy_value(a), NULL_exp);`
		709	`COPY_ulong(exp_dummy_no(a), n);`
2	7u83	710
7	7u83	711	`/* Convert to result type */`
		712	`bs = enc_special(bs, TOK_from_ptr_void);`
		713	`ts = start_bitstream(NIL(FILE), bs->link);`
		714	`t = DEREF_type(type_ptr_etc_sub(t));`
		715	`ts = enc_alignment(ts, t);`
2	7u83	716
7	7u83	717	`/* Introduce variable in exception case */`
		718	`if (!IS_NULL_exp(b)) {`
		719	`r = unit_no(ts, NULL_id, VAR_tag, 1);`
		720	`ENC_variable(ts);`
		721	`ts = enc_access(ts, crt_func_access);`
		722	`ENC_make_tag(ts, r);`
		723	`}`
2	7u83	724
7	7u83	725	`/* Encode main token */`
		726	`ts = enc_special(ts, TOK_dynam_cast);`
		727	`us = start_bitstream(NIL(FILE), ts->link);`
2	7u83	728
7	7u83	729	`/* Encode address of virtual function table */`
		730	`s = DEREF_type(type_ptr_etc_sub(s));`
		731	`ct = DEREF_ctype(type_compound_defn(s));`
		732	`IGNORE compile_class(ct);`
		733	`vt = DEREF_virt(ctype_virt(ct));`
		734	`off = DEREF_off(virt_table_off(vt));`
		735	`m = DEREF_ulong(virt_table_tok(vt));`
		736	`ENC_add_to_ptr(us);`
		737	`us = enc_add_ptr(us, a, LINK_NONE, off, 0);`
		738	`us = enc_exp_token(us, m);`
		739	`used = DEREF_int(virt_table_rtti_used(vt));`
		740	`if (!used) {`
		741	`IDENTIFIER cid = DEREF_id(ctype_name(ct));`
		742	`COPY_int(virt_table_rtti_used(vt), 1);`
		743	`compile_virtual(ct, !has_linkage(cid));`
		744	`}`
2	7u83	745
7	7u83	746	`/* Output run-time type information */`
		747	`us = enc_rtti_type(us, t, lex_typeid);`
		748	`ts = enc_bitstream(ts, us);`
2	7u83	749
7	7u83	750	`/* Check for exceptions */`
		751	`if (!IS_NULL_exp(b)) {`
		752	`ulong lab = unit_no(ts, NULL_id, VAR_label, 1);`
		753	`ENC_SEQ_SMALL(ts, 1);`
		754	`ENC_conditional(ts);`
		755	`ENC_make_label(ts, lab);`
		756	`ENC_SEQ_SMALL(ts, 1);`
		757	`ts = enc_special(ts, TOK_pv_test);`
		758	`us = start_bitstream(NIL(FILE), ts->link);`
		759	`ENC_contents(us);`
		760	`us = enc_special(us, TOK_ptr_void);`
		761	`ENC_obtain_tag(us);`
		762	`ENC_make_tag(us, r);`
		763	`ENC_make_label(us, lab);`
		764	`ENC_equal(us);`
		765	`ts = enc_bitstream(ts, us);`
		766	`ts = enc_exp(ts, b);`
		767	`ENC_make_top(ts);`
		768	`ENC_contents(ts);`
		769	`ts = enc_special(ts, TOK_ptr_void);`
		770	`ENC_obtain_tag(ts);`
		771	`ENC_make_tag(ts, r);`
		772	`}`
2	7u83	773
7	7u83	774	`/* End conversion expression */`
		775	`bs = enc_bitstream(bs, ts);`
		776	`COPY_exp(exp_dummy_value(a), a1);`
		777	`return (bs);`
2	7u83	778	`}`
		779
		780
		781	`/*`
		782	`LIST OF PREVIOUSLY DEFINED THUNKS`
		783
		784	`A list of all previously defined thunks is maintained to avoid`
		785	`unnecessary duplication.`
		786	`*/`
		787
7	7u83	788	`static VIRTUAL all_thunks = NULL_virt;`
2	7u83	789
		790
		791	`/*`
		792	`CREATE A THUNK FUNCTION`
		793
		794	`This routine creates a dummy function of type f which calls fid with`
		795	`its given arguments and returns its result with the base class conversion`
		796	`given by ret applied. The tag number of the dummy function is returned.`
		797	`This is used for overriding virtual functions in which the return`
		798	`type differs.`
		799	`*/`
		800
7	7u83	801	`static ulong`
		802	`make_thunk(TYPE f, IDENTIFIER fid, GRAPH ret)`
2	7u83	803	`{`
7	7u83	804	`ulong n;`
		805	`DECL_SPEC acc = DEREF_dspec(graph_access(ret));`
		806	`IGNORE capsule_id(fid, VAR_tag);`
		807	`if (acc & dspec_ignore) {`
		808	`/* Use fid for trivial conversions */`
		809	`n = DEREF_ulong(id_no(fid));`
2	7u83	810
7	7u83	811	`} else {`
		812	`EXP e;`
		813	`int ell;`
		814	`TYPE f2;`
		815	`OFFSET off;`
		816	`unsigned np;`
		817	`TYPE r1, r2;`
		818	`ulong rn, pn;`
		819	`LIST(TYPE)p;`
		820	`BITSTREAM bs, ts;`
2	7u83	821
7	7u83	822	`/* Check previously defined thunks */`
		823	`VIRTUAL vt = all_thunks;`
		824	`while (!IS_NULL_virt(vt)) {`
		825	`IDENTIFIER vn = DEREF_id(virt_func(vt));`
		826	`if (EQ_id(vn, fid)) {`
		827	`GRAPH gv = DEREF_graph(virt_base(vt));`
		828	`if (EQ_graph(gv, ret)) {`
		829	`n = DEREF_ulong(virt_no(vt));`
		830	`return (n);`
		831	`}`
		832	`}`
		833	`vt = DEREF_virt(virt_next(vt));`
2	7u83	834	`}`
		835
7	7u83	836	`/* Find type information */`
		837	`while (IS_type_templ(f)) {`
		838	`f = DEREF_type(type_templ_defn(f));`
		839	`}`
		840	`r1 = DEREF_type(type_func_ret(f));`
		841	`p = DEREF_list(type_func_mtypes(f));`
		842	`np = LENGTH_list(p);`
		843	`ell = DEREF_int(type_func_ellipsis(f));`
		844	`f2 = DEREF_type(id_function_etc_type(fid));`
		845	`while (IS_type_templ(f2)) {`
		846	`f2 = DEREF_type(type_templ_defn(f2));`
		847	`}`
		848	`r2 = DEREF_type(type_func_ret(f2));`
2	7u83	849
7	7u83	850	`/* Declare the thunk function */`
		851	`n = capsule_no(NULL_string, VAR_tag);`
		852	`enc_tagdec(NULL_id, n, f, 0);`
		853	`bs = enc_tagdef_start(NULL_id, n, f, 0);`
		854	`ts = start_bitstream(NIL(FILE), bs->link);`
		855	`ENC_make_proc(bs);`
		856	`bs = enc_shape(bs, r1);`
		857	`ENC_LIST(bs, np);`
		858	`ENC_LIST(ts, np);`
		859	`while (!IS_NULL_list(p)) {`
		860	`/* Scan through parameter types */`
		861	`TYPE pt = DEREF_type(HEAD_list(p));`
		862	`ulong m = unit_no(bs, NULL_id, VAR_tag, 1);`
		863	`ENC_contents(ts);`
		864	`if (pass_complex_type(pt)) {`
		865	`ENC_pointer(bs);`
		866	`bs = enc_alignment(bs, pt);`
		867	`ENC_pointer(ts);`
		868	`ts = enc_alignment(ts, pt);`
		869	`} else {`
		870	`bs = enc_shape(bs, pt);`
		871	`ts = enc_shape(ts, pt);`
		872	`}`
		873	`bs = enc_access(bs, dspec_none);`
		874	`ENC_make_tag(bs, m);`
		875	`ENC_obtain_tag(ts);`
		876	`ENC_make_tag(ts, m);`
		877	`p = TAIL_list(p);`
		878	`}`
		879	`if (ell & FUNC_ELLIPSIS) {`
		880	`/* Check for ellipsis */`
		881	`ulong m = unit_no(bs, NULL_id, VAR_tag, 1);`
		882	`ENC_ON(bs);`
		883	`ENC_make_tag(bs, m);`
		884	`bs = enc_access(bs, dspec_none);`
		885	`/* NOT YET IMPLEMENTED: use same_callees? */`
		886	`} else {`
		887	`ENC_OFF(bs);`
		888	`}`
		889	`ENC_OFF(ts);`
2	7u83	890
7	7u83	891	`/* Output the function body */`
		892	`rn = unit_no(bs, NULL_id, VAR_tag, 1);`
		893	`MAKE_exp_dummy(r2, NULL_exp, rn, NULL_off, 1, e);`
		894	`ENC_variable(bs);`
		895	`bs = enc_access(bs, dspec_none);`
		896	`ENC_make_tag(bs, rn);`
		897	`ENC_apply_proc(bs);`
		898	`bs = enc_shape(bs, r2);`
		899	`pn = unit_no(bs, fid, VAR_tag, 0);`
		900	`ENC_obtain_tag(bs);`
		901	`ENC_make_tag(bs, pn);`
		902	`bs = join_bitstreams(bs, ts);`
		903	`if (IS_type_ptr(r2)) {`
		904	`/* Test for null pointers */`
		905	`ulong lab = unit_no(bs, NULL_id, VAR_label, 1);`
		906	`ENC_conditional(bs);`
		907	`ENC_make_label(bs, lab);`
		908	`ENC_SEQ_SMALL(bs, 1);`
		909	`bs = enc_compare(bs, e, NULL_exp, ntest_eq, lab, LINK_NONE);`
		910	`ENC_return(bs);`
		911	`bs = enc_null_exp(bs, r1);`
		912	`}`
		913	`ENC_return(bs);`
		914	`off = DEREF_off(graph_off(ret));`
		915	`bs = enc_add_ptr(bs, e, LINK_NONE, off, 1);`
		916	`enc_tagdef_end(bs);`
		917	`free_exp(e, 1);`
		918
		919	`/* Add to list of all thunks */`
		920	`MAKE_virt_simple(fid, n, ret, vt);`
		921	`COPY_virt(virt_next(vt), all_thunks);`
		922	`all_thunks = vt;`
2	7u83	923	`}`
7	7u83	924	`return (n);`
2	7u83	925	`}`
		926
		927
		928	`/*`
		929	`ENCODE THE SHAPE OF A VIRTUAL FUNCTION TABLE`
		930
		931	`This routine adds the shape of a virtual function table containing`
		932	`n functions to the bitstream bs.`
		933	`*/`
		934
7	7u83	935	`BITSTREAM *`
		936	`enc_vtable_shape(BITSTREAM *bs, ulong n)`
2	7u83	937	`{`
7	7u83	938	`BITSTREAM *ts;`
		939	`bs = enc_special(bs, TOK_vtab_type);`
		940	`ts = start_bitstream(NIL(FILE), bs->link);`
		941	`ENC_make_nat(ts);`
		942	`ENC_INT(ts, n + VIRTUAL_EXTRA);`
		943	`bs = enc_bitstream(bs, ts);`
		944	`return (bs);`
2	7u83	945	`}`
		946
		947
		948	`/*`
		949	`ENCODE THE DEFINITION OF A VIRTUAL FUNCTION TABLE`
		950
		951	`This routine encodes the definition of the virtual function table vt.`
		952	`n gives the tag number for the table, gr is the table offset and the`
		953	`flag inherited is true for secondary tables. rtti gives the tag`
		954	`number for the run-time type information.`
		955	`*/`
		956
7	7u83	957	`static void`
		958	`enc_vtable_defn(VIRTUAL vt, ulong n, CLASS_TYPE ct, GRAPH gr, int inherited,`
		959	`ulong rtti)`
2	7u83	960	`{`
7	7u83	961	`ulong r;`
		962	`BITSTREAM bs, ts, *us;`
		963	`ulong m = DEREF_ulong(virt_no(vt));`
		964	`ulong p = DEREF_ulong(virt_table_tok(vt));`
		965	`OFFSET off = DEREF_off(virt_table_off(vt));`
		966	`LIST(VIRTUAL)pt = DEREF_list(virt_table_entries(vt));`
2	7u83	967
7	7u83	968	`/* Output start of table */`
		969	`bs = enc_tagdef_start(NULL_id, n, NULL_type, 1);`
		970	`bs = enc_special(bs, TOK_vtab_make);`
		971	`ts = start_bitstream(NIL(FILE), bs->link);`
		972	`ENC_obtain_tag(ts);`
		973	`r = link_no(ts, rtti, VAR_tag);`
		974	`ENC_make_tag(ts, r);`
		975	`if (inherited) {`
		976	`/* Add base class offset */`
		977	`OFFSET off2 = DEREF_off(graph_off(gr));`
		978	`if (!is_zero_offset(off2)) {`
		979	`ENC_offset_add(ts);`
		980	`ts = enc_offset(ts, off2);`
		981	`}`
2	7u83	982	`}`
7	7u83	983	`if (!is_zero_offset(off)) {`
		984	`/* Add inherited table offset */`
		985	`ENC_offset_add(ts);`
		986	`ts = enc_offset(ts, off);`
2	7u83	987	`}`
7	7u83	988	`ts = enc_exp_token(ts, p);`
		989	`ENC_make_nat(ts);`
		990	`ENC_INT(ts, m + VIRTUAL_EXTRA);`
2	7u83	991
7	7u83	992	`/* Output virtual functions */`
		993	`ENC_make_nof(ts);`
		994	`ENC_LIST(ts, m);`
		995	`while (!IS_NULL_list(pt)) {`
		996	`GRAPH gs;`
		997	`DECL_SPEC ds;`
		998	`IDENTIFIER fid;`
		999	`GRAPH ret = NULL_graph;`
		1000	`IDENTIFIER pid = NULL_id;`
		1001	`VIRTUAL at = DEREF_virt(HEAD_list(pt));`
		1002	`while (IS_virt_link(at)) {`
		1003	`/* Allow for symbolic links */`
		1004	`at = DEREF_virt(DEREF_ptr(virt_link_to(at)));`
		1005	`}`
		1006	`if (inherited) {`
		1007	`/* Allow for inherited function tables */`
		1008	`VIRTUAL as;`
		1009	`pid = DEREF_id(virt_func(at));`
		1010	`as = find_overrider(ct, pid, gr, &ret);`
		1011	`if (!IS_NULL_virt(as)) {`
		1012	`at = as;`
		1013	`}`
		1014	`}`
		1015	`fid = DEREF_id(virt_func(at));`
		1016	`ds = DEREF_dspec(id_storage(fid));`
		1017	`gs = DEREF_graph(virt_base(at));`
		1018
		1019	`/* Output pointer to member function */`
		1020	`ts = enc_special(ts, TOK_pmf_make);`
		1021	`us = start_bitstream(NIL(FILE), ts->link);`
		1022	`if (ds & dspec_pure) {`
		1023	`/* Pure virtual function */`
		1024	`us = enc_special(us, TOK_vtab_pure);`
		1025	`} else {`
		1026	`if (IS_NULL_graph(ret)) {`
		1027	`IGNORE capsule_id(fid, VAR_tag);`
		1028	`r = unit_no(us, fid, VAR_tag, 0);`
		1029	`} else {`
		1030	`TYPE f = DEREF_type(id_function_etc_type(pid));`
		1031	`r = make_thunk(f, fid, ret);`
		1032	`r = link_no(us, r, VAR_tag);`
		1033	`}`
		1034	`ENC_obtain_tag(us);`
		1035	`ENC_make_tag(us, r);`
		1036	`}`
		1037	`us = enc_base(us, gs, 0);`
		1038	`us = enc_base(us, gr, 0);`
		1039	`ts = enc_bitstream(ts, us);`
		1040	`pt = TAIL_list(pt);`
2	7u83	1041	`}`
7	7u83	1042	`bs = enc_bitstream(bs, ts);`
		1043	`enc_tagdef_end(bs);`
		1044	`return;`
2	7u83	1045	`}`
		1046
		1047
		1048	`/*`
		1049	`DEFINE VIRTUAL FUNCTION TABLES`
		1050
		1051	`This routine defines or declares the virtual function tables for`
		1052	`the class ct depending on the value of def. The tables are given`
		1053	`external names only if ext is true.`
		1054	`*/`
		1055
7	7u83	1056	`void`
		1057	`define_vtable(CLASS_TYPE ct, int def, int ext)`
2	7u83	1058	`{`
7	7u83	1059	`ulong r;`
		1060	`int used;`
		1061	`int have_main_table = 0;`
		1062	`VIRTUAL vt = DEREF_virt(ctype_virt(ct));`
		1063	`if (IS_NULL_virt(vt)) {`
		1064	`return;`
2	7u83	1065	`}`
7	7u83	1066	`if (output_all) {`
		1067	`ext = 1;`
2	7u83	1068	`}`
7	7u83	1069	`if (def == 2) {`
		1070	`/* Force definition in this case */`
		1071	`IGNORE compile_class(ct);`
		1072	`} else {`
		1073	`ulong n = DEREF_ulong(ctype_shape(ct));`
		1074	`if (n == LINK_NONE) {`
		1075	`return;`
		1076	`}`
2	7u83	1077	`}`
7	7u83	1078
		1079	`/* Output run-time type information */`
		1080	`r = DEREF_ulong(virt_table_rtti(vt));`
		1081	`used = DEREF_int(virt_table_rtti_used(vt));`
		1082	`if (used \|\| def) {`
		1083	`TYPE t = dummy_class;`
		1084	`if (ext) {`
		1085	`/* Make up external name */`
		1086	`string s = mangle_typeid("__ti__", ct);`
		1087	`r = capsule_name(r, &s, VAR_tag);`
		1088	`}`
		1089	`record_usage(r, VAR_tag, USAGE_USE);`
		1090	`COPY_int(virt_table_rtti_used(vt), 1);`
		1091	`COPY_ctype(type_compound_defn(t), ct);`
		1092	`enc_rtti_struct(t, r, def);`
2	7u83	1093	`}`
7	7u83	1094
		1095	`/* Output virtual function tables */`
		1096	`while (!IS_NULL_virt(vt)) {`
		1097	`ulong n;`
		1098	`VIRTUAL vs;`
		1099	`unsigned acc;`
		1100	`CLASS_TYPE cs;`
		1101	`int inherited = 1;`
		1102	`GRAPH gr = DEREF_graph(virt_base(vt));`
		1103	`DECL_SPEC gacc = DEREF_dspec(graph_access(gr));`
		1104	`if ((gacc & dspec_ignore) && !have_main_table) {`
		1105	`/* Main virtual function table */`
		1106	`gr = DEREF_graph(graph_top(gr));`
		1107	`have_main_table = 1;`
		1108	`inherited = 0;`
		1109	`}`
		1110	`cs = DEREF_ctype(graph_head(gr));`
		1111	`vs = DEREF_virt(ctype_virt(cs));`
		1112	`n = DEREF_ulong(virt_table_tbl(vt));`
		1113	`record_usage(n, VAR_tag, USAGE_USE);`
		1114	`acc = find_usage(n, VAR_tag);`
		1115	`if (ext) {`
		1116	`/* Make up external name */`
		1117	`string s = mangle_vtable("__vt__", gr);`
		1118	`n = capsule_name(n, &s, VAR_tag);`
		1119	`}`
		1120	`if (!(acc & USAGE_DECL)) {`
		1121	`/* Output table declaration */`
		1122	`ulong m = DEREF_ulong(virt_no(vs));`
		1123	`BITSTREAM *ts = enc_tagdec_start(NULL_id, n, NULL_type,`
		1124	`1);`
		1125	`ts = enc_vtable_shape(ts, m);`
		1126	`enc_tagdec_end(ts);`
		1127	`}`
		1128	`if (def && !(acc & USAGE_DEFN)) {`
		1129	`/* Output table definition */`
		1130	`enc_vtable_defn(vs, n, ct, gr, inherited, r);`
		1131	`}`
		1132	`vt = DEREF_virt(virt_next(vt));`
2	7u83	1133	`}`
7	7u83	1134	`return;`
2	7u83	1135	`}`
		1136
		1137
		1138	`/*`
		1139	`ALLOCATE TAG NUMBERS FOR VIRTUAL FUNCTION TABLES`
		1140
		1141	`This routine allocates tag and token numbers for the virtual function`
		1142	`tables of the polymorphic class ct and its base classes.`
		1143	`*/`
		1144
7	7u83	1145	`static ulong`
		1146	`declare_vtable(CLASS_TYPE ct)`
2	7u83	1147	`{`
7	7u83	1148	`ulong n = LINK_NONE;`
		1149	`ulong r = LINK_NONE;`
		1150	`VIRTUAL vt = DEREF_virt(ctype_virt(ct));`
		1151	`while (!IS_NULL_virt(vt)) {`
		1152	`ulong t;`
		1153	`OFFSET off;`
		1154	`ulong m = DEREF_ulong(virt_table_tok(vt));`
		1155	`if (m != LINK_NONE) {`
		1156	`/* Already declared */`
		1157	`return (m);`
		1158	`}`
		1159	`off = DEREF_off(virt_table_off(vt));`
		1160	`if (IS_NULL_off(off)) {`
		1161	`/* New virtual function table required */`
		1162	`m = capsule_no(NULL_string, VAR_token);`
		1163	`} else if (IS_off_base(off)) {`
		1164	`/* Use existing virtual function table */`
		1165	`GRAPH gs = DEREF_graph(off_base_graph(off));`
		1166	`CLASS_TYPE cs = DEREF_ctype(graph_head(gs));`
		1167	`m = declare_vtable(cs);`
		1168	`} else {`
		1169	`/* Use existing virtual function table */`
		1170	`GRAPH gs = DEREF_graph(off_deriv_graph(off));`
		1171	`CLASS_TYPE cs = DEREF_ctype(graph_head(gs));`
		1172	`m = declare_vtable(cs);`
		1173	`}`
		1174	`if (n == LINK_NONE) {`
		1175	`n = m;`
		1176	`}`
2	7u83	1177
7	7u83	1178	`/* Allocate (but not define) virtual table tags */`
		1179	`t = capsule_no(NULL_string, VAR_tag);`
		1180	`clear_usage(t, VAR_tag);`
		1181	`if (r == LINK_NONE) {`
		1182	`r = capsule_no(NULL_string, VAR_tag);`
		1183	`clear_usage(r, VAR_tag);`
		1184	`}`
		1185	`COPY_ulong(virt_table_tbl(vt), t);`
		1186	`COPY_ulong(virt_table_rtti(vt), r);`
		1187	`COPY_ulong(virt_table_tok(vt), m);`
		1188	`vt = DEREF_virt(virt_next(vt));`
2	7u83	1189	`}`
7	7u83	1190	`return (n);`
2	7u83	1191	`}`
		1192
		1193
		1194	`/*`
		1195	`END OF RUN-TIME TYPE INFORMATION ROUTINES`
		1196
		1197	`The remaining routines are common to both the C and C++ producers.`
		1198	`*/`
		1199
		1200	`#endif /* LANGUAGE_CPP */`
		1201
		1202
		1203	`/*`
		1204	`FIND THE TABLE OFFSET OF A VIRTUAL FUNCTION`
		1205
		1206	`This routine finds the position of the virtual function id in the`
		1207	`virtual function table vt.`
		1208	`*/`
		1209
7	7u83	1210	`ulong`
		1211	`virtual_no(IDENTIFIER id, VIRTUAL vt)`
2	7u83	1212	`{`
7	7u83	1213	`LIST(VIRTUAL)pv = DEREF_list(virt_table_entries(vt));`
		1214	`while (!IS_NULL_list(pv)) {`
		1215	`VIRTUAL vs = DEREF_virt(HEAD_list(pv));`
		1216	`IDENTIFIER vid = DEREF_id(virt_func(vs));`
		1217	`if (EQ_id(vid, id)) {`
		1218	`ulong m = DEREF_ulong(virt_no(vs));`
		1219	`return (m + VIRTUAL_EXTRA);`
		1220	`}`
		1221	`pv = TAIL_list(pv);`
2	7u83	1222	`}`
7	7u83	1223	`return (VIRTUAL_EXTRA);`
2	7u83	1224	`}`
		1225
		1226
		1227	`/*`
		1228	`IS A TYPE A ZERO SIZED BITFIELD?`
		1229
		1230	`This routine checks whether the type t represents a zero sized`
		1231	`bitfield. These force an alignment in a class rather than being`
		1232	`a proper class member.`
		1233	`*/`
		1234
7	7u83	1235	`static int`
		1236	`is_zero_bitfield(TYPE t)`
2	7u83	1237	`{`
7	7u83	1238	`if (!IS_NULL_type(t) && IS_type_bitfield(t)) {`
		1239	`INT_TYPE bf = DEREF_itype(type_bitfield_defn(t));`
		1240	`DECL_SPEC ds = DEREF_dspec(itype_bitfield_info(bf));`
		1241	`if (ds & dspec_pure) {`
		1242	`return (1);`
		1243	`}`
		1244	`}`
		1245	`return (0);`
2	7u83	1246	`}`
		1247
		1248
		1249	`/*`
		1250	`ENCODE A SHAPE OFFSET EXPRESSION`
		1251
		1252	`This routine adds the offset of the type t to the bitstream bs,`
		1253	`unless t is dummy_class, when the offset of the type excluding the`
		1254	`virtual bases is added.`
		1255	`*/`
		1256
7	7u83	1257	`static BITSTREAM *`
		1258	`enc_offset_add(BITSTREAM *bs, TYPE t)`
2	7u83	1259	`{`
7	7u83	1260	`if (EQ_type(t, dummy_class)) {`
		1261	`/* Class offset */`
		1262	`CLASS_TYPE ct = DEREF_ctype(type_compound_defn(t));`
		1263	`GRAPH gr = DEREF_graph(ctype_base(ct));`
		1264	`ulong m = DEREF_ulong(graph_core_off(gr));`
		1265	`if (m != LINK_NONE) {`
		1266	`bs = enc_exp_token(bs, m);`
		1267	`return (bs);`
		1268	`}`
2	7u83	1269	`}`
7	7u83	1270	`ENC_shape_offset(bs);`
		1271	`bs = enc_shape(bs, t);`
		1272	`return (bs);`
2	7u83	1273	`}`
		1274
		1275
		1276	`/*`
		1277	`ENCODE AN OFFSET PAD EXPRESSION`
		1278
		1279	`This routine adds the offset of a structure member of type s`
		1280	`which follows a member of type t with offset given by the token n`
		1281	`to the bitstream bs. Note that bitfield types are awkward.`
		1282	`*/`
		1283
7	7u83	1284	`static BITSTREAM *`
		1285	`enc_offset_pad(BITSTREAM *bs, ulong n, TYPE t, TYPE s)`
2	7u83	1286	`{`
7	7u83	1287	`BITSTREAM *ts;`
		1288	`unsigned tag = null_tag;`
		1289	`int z = is_zero_bitfield(t);`
		1290	`if (!IS_NULL_type(s)) {`
		1291	`if (is_zero_bitfield(s)) {`
		1292	`/* Force an alignment */`
		1293	`s = find_bitfield_type(s);`
		1294	`}`
		1295	`ENC_offset_pad(bs);`
		1296	`bs = enc_alignment(bs, s);`
		1297	`tag = TAG_type(s);`
2	7u83	1298	`}`
7	7u83	1299	`if (tag == type_bitfield_tag) {`
		1300	`/* Use token for bitfields */`
		1301	`bs = enc_special(bs, TOK_pad);`
		1302	`ts = start_bitstream(NIL(FILE), bs->link);`
		1303	`} else {`
		1304	`ts = bs;`
		1305	`}`
2	7u83	1306
7	7u83	1307	`/* Add offset (except for zero sized bitfields) */`
		1308	`if (!z) {`
		1309	`ENC_offset_add(ts);`
		1310	`}`
		1311	`ts = enc_exp_token(ts, n);`
		1312	`if (!z) {`
		1313	`ts = enc_offset_add(ts, t);`
		1314	`}`
2	7u83	1315
7	7u83	1316	`/* Encode extra bitfield arguments */`
		1317	`if (tag == type_bitfield_tag) {`
		1318	`TYPE r = find_bitfield_type(s);`
		1319	`ts = enc_shape(ts, r);`
		1320	`ts = enc_shape(ts, s);`
		1321	`bs = enc_bitstream(bs, ts);`
		1322	`} else {`
		1323	`bs = ts;`
		1324	`}`
		1325	`return (bs);`
2	7u83	1326	`}`
		1327
		1328
		1329	`/*`
		1330	`DEFINE AN ALIGNMENT TAG`
		1331
		1332	`This routine defines the alignment tag m to be the token n. The value`
		1333	`LINK_NONE for n is used to indicate an incomplete structure.`
		1334	`*/`
		1335
7	7u83	1336	`static void`
		1337	`enc_al_tagdef(ulong m, ulong n)`
2	7u83	1338	`{`
7	7u83	1339	`unsigned acc = find_usage(m, VAR_alignment);`
		1340	`if (!(acc & USAGE_DEFN)) {`
		1341	`BITSTREAM *bs = aldef_unit;`
		1342	`ulong r = link_no(bs, m, VAR_alignment);`
		1343	`ENC_make_al_tagdef(bs);`
		1344	`ENC_INT(bs, r);`
		1345	`if (n == LINK_NONE) {`
		1346	`bs = enc_special(bs, TOK_empty_align);`
		1347	`} else {`
		1348	`ENC_alignment(bs);`
		1349	`bs = enc_shape_token(bs, n);`
		1350	`}`
		1351	`record_usage(m, VAR_alignment, USAGE_DEFN);`
		1352	`count_item(bs);`
		1353	`aldef_unit = bs;`
2	7u83	1354	`}`
7	7u83	1355	`return;`
2	7u83	1356	`}`
		1357
		1358
		1359	`/*`
		1360	`ENCODE A TDF COMPOUND SHAPE`
		1361
		1362	`This routine defines all the shape and offset tokens associated with`
		1363	`the compound type ct. It returns the external (capsule) number of`
		1364	`a token giving the overall shape of the result.`
		1365	`*/`
		1366
7	7u83	1367	`ulong`
		1368	`compile_class(CLASS_TYPE ct)`
2	7u83	1369	`{`
7	7u83	1370	`ulong n = DEREF_ulong(ctype_shape(ct));`
		1371	`if (n == LINK_NONE) {`
		1372	`ulong m;`
		1373	`HASHID nm;`
		1374	`NAMESPACE ns;`
		1375	`BITSTREAM *bs;`
		1376	`BITSTREAM *ts;`
		1377	`LIST(GRAPH)br;`
		1378	`TYPE pt = NULL_type;`
		1379	`int ext = output_all;`
		1380	`ulong pm = LINK_NONE;`
		1381	`ulong vo = LINK_NONE;`
		1382	`unsigned no_mems = 0;`
		1383	`unsigned no_bases = 0;`
		1384	`DECL_SPEC macc = dspec_none;`
		1385	`GRAPH gr = DEREF_graph(ctype_base(ct));`
		1386	`CLASS_INFO ci = DEREF_cinfo(ctype_info(ct));`
		1387	`CLASS_TYPE cd = DEREF_ctype(type_compound_defn(dummy_class));`
2	7u83	1388	`#if LANGUAGE_CPP`
7	7u83	1389	`VIRTUAL vt = DEREF_virt(ctype_virt(ct));`
2	7u83	1390	`#endif`
		1391
7	7u83	1392	`/* Check for tokenised types */`
		1393	`if (ci & cinfo_token) {`
		1394	`IDENTIFIER id = DEREF_id(ctype_name(ct));`
		1395	`id = find_token(id);`
		1396	`IGNORE enc_tokdef(id, 0);`
		1397	`n = DEREF_ulong(id_no(id));`
		1398	`COPY_ulong(ctype_shape(ct), n);`
		1399	`return (n);`
		1400	`}`
2	7u83	1401
7	7u83	1402	`/* Assign token number */`
		1403	`n = capsule_no(NULL_string, VAR_token);`
		1404	`COPY_ulong(ctype_shape(ct), n);`
2	7u83	1405
7	7u83	1406	`/* Allow for recursive types */`
		1407	`if (ci & cinfo_recursive) {`
		1408	`m = DEREF_ulong(graph_al_tag(gr));`
		1409	`if (m == LINK_NONE) {`
		1410	`m = capsule_no(NULL_string, VAR_alignment);`
		1411	`if (ext) {`
		1412	`string s = mangle_typeid("~cpp.al.",`
		1413	`ct);`
		1414	`m = capsule_name(m, &s, VAR_alignment);`
		1415	`}`
		1416	`COPY_ulong(graph_al_tag(gr), m);`
		1417	`}`
2	7u83	1418	`}`
		1419
7	7u83	1420	`/* Assign virtual function tokens */`
2	7u83	1421	`#if LANGUAGE_CPP`
7	7u83	1422	`if (!IS_NULL_virt(vt)) {`
		1423	`OFFSET off = DEREF_off(virt_table_off(vt));`
		1424	`if (!IS_NULL_off(off)) {`
		1425	`vt = NULL_virt;`
		1426	`}`
		1427	`IGNORE declare_vtable(ct);`
		1428	`}`
2	7u83	1429	`#endif`
		1430
7	7u83	1431	`/* Scan through direct base classes */`
		1432	`br = DEREF_list(graph_tails(gr));`
		1433	`while (!IS_NULL_list(br)) {`
		1434	`int virt = 0;`
		1435	`GRAPH gs = DEREF_graph(HEAD_list(br));`
		1436	`DECL_SPEC acc = DEREF_dspec(graph_access(gs));`
		1437	`CLASS_TYPE cs = DEREF_ctype(graph_head(gs));`
2	7u83	1438
7	7u83	1439	`/* Define offset token */`
		1440	`IGNORE compile_class(cs);`
		1441	`m = capsule_no(NULL_string, VAR_token);`
		1442	`if (ext) {`
		1443	`string s = mangle_vtable("~cpp.base.", gs);`
		1444	`m = capsule_name(m, &s, VAR_token);`
		1445	`}`
		1446	`COPY_ulong(graph_base_off(gs), m);`
		1447	`bs = enc_tokdef_start(m, "E", NIL(ulong), 1);`
		1448	`if (pm == LINK_NONE) {`
		1449	`/* First base class */`
		1450	`ENC_offset_zero(bs);`
		1451	`if (acc & dspec_virtual) {`
		1452	`ENC_alignment(bs);`
		1453	`ENC_pointer(bs);`
		1454	`ENC_alignment(bs);`
		1455	`ENC_top(bs);`
		1456	`virt = 1;`
		1457	`} else {`
		1458	`bs = enc_al_ctype(bs, cs);`
		1459	`}`
		1460	`} else {`
		1461	`/* Subsequent base classes */`
		1462	`ENC_offset_pad(bs);`
		1463	`if (acc & dspec_virtual) {`
		1464	`ENC_alignment(bs);`
		1465	`ENC_pointer(bs);`
		1466	`ENC_alignment(bs);`
		1467	`ENC_top(bs);`
		1468	`virt = 1;`
		1469	`} else {`
		1470	`bs = enc_al_ctype(bs, cs);`
		1471	`}`
		1472	`ENC_offset_add(bs);`
		1473	`bs = enc_exp_token(bs, pm);`
		1474	`bs = enc_offset_add(bs, pt);`
		1475	`}`
		1476	`enc_tokdef_end(m, bs);`
		1477
		1478	`/* Find member type */`
		1479	`pt = dummy_class;`
		1480	`COPY_ctype(type_compound_defn(pt), cs);`
		1481	`if (virt) {`
		1482	`pt = ptr_dummy_class;`
		1483	`} else {`
		1484	`no_bases++;`
		1485	`}`
		1486	`pm = m;`
		1487	`br = TAIL_list(br);`
2	7u83	1488	`}`
7	7u83	1489
		1490	`/* Scan through data members */`
		1491	`ts = start_bitstream(NIL(FILE), tokdef_unit->link);`
		1492	`ns = DEREF_nspace(ctype_member(ct));`
		1493	`if (output_order) {`
		1494	`macc = dspec_public;`
2	7u83	1495	`}`
7	7u83	1496	`do {`
		1497	`DECL_SPEC nacc = dspec_none;`
		1498	`MEMBER mem = DEREF_member(nspace_ctype_first(ns));`
		1499	`mem = next_data_member(mem, 1);`
		1500	`while (!IS_NULL_member(mem)) {`
		1501	`unsigned real_mem = 1;`
		1502	`IDENTIFIER mid = DEREF_id(member_id(mem));`
		1503	`TYPE t = DEREF_type(id_member_type(mid));`
		1504	`if (ci & cinfo_union) {`
		1505	`/* Union types */`
		1506	`m = LINK_ZERO;`
		1507	`if (!IS_NULL_type(pt)) {`
		1508	`ENC_offset_max(ts);`
		1509	`ENC_shape_offset(ts);`
		1510	`ts = enc_shape(ts, pt);`
		1511	`}`
		1512	`no_mems = 1;`
		1513	`} else {`
		1514	`/* Structure types */`
		1515	`if (macc) {`
		1516	`/* Check member access */`
		1517	`DECL_SPEC acc = DEREF_dspec(id_storage(mid));`
		1518	`acc &= dspec_access;`
		1519	`if (acc != macc) {`
		1520	`mem = DEREF_member(member_next(mem));`
		1521	`mem = next_data_member(mem, 1);`
		1522	`if (acc > macc) {`
		1523	`/* Find next access to check */`
		1524	`if (acc == dspec_protected) {`
		1525	`nacc = dspec_protected;`
		1526	`} else if (nacc == dspec_none) {`
		1527	`nacc = dspec_private;`
		1528	`}`
		1529	`}`
		1530	`continue;`
		1531	`}`
		1532	`}`
		1533	`m = DEREF_ulong(id_no(mid));`
		1534	`if (m == LINK_NONE) {`
		1535	`m = capsule_no(NULL_string, VAR_token);`
		1536	`if (ext) {`
		1537	`string s = mangle_name(mid, VAR_token, 0);`
		1538	`m = capsule_name(m, &s, VAR_token);`
		1539	`}`
		1540	`bs = enc_tokdef_start(m, "E", NIL(ulong), 1);`
		1541	`if (pm == LINK_NONE) {`
		1542	`/* First member */`
		1543	`if (IS_type_bitfield(t)) {`
		1544	`/* Bitfield members */`
		1545	`TYPE r = find_bitfield_type(t);`
		1546	`if (!is_zero_bitfield(t)) {`
		1547	`ENC_offset_pad(bs);`
		1548	`bs = enc_alignment(bs, t);`
		1549	`}`
		1550	`ENC_offset_zero(bs);`
		1551	`bs = enc_alignment(bs, r);`
		1552	`nm = DEREF_hashid(id_name(mid));`
		1553	`if (IS_hashid_anon(nm))real_mem = 0;`
		1554	`} else {`
		1555	`/* Non-bitfield members */`
		1556	`ENC_offset_zero(bs);`
		1557	`bs = enc_alignment(bs, t);`
		1558	`}`
		1559	`} else {`
		1560	`/* Subsequent members */`
		1561	`bs = enc_offset_pad(bs, pm, pt, t);`
		1562	`if (IS_type_bitfield(t)) {`
		1563	`nm = DEREF_hashid(id_name(mid));`
		1564	`if (IS_hashid_anon(nm))real_mem = 0;`
		1565	`}`
		1566	`}`
		1567	`enc_tokdef_end(m, bs);`
		1568	`}`
		1569	`no_mems += real_mem;`
		1570	`pm = m;`
2	7u83	1571	`}`
7	7u83	1572	`COPY_ulong(id_no(mid), m);`
		1573	`pt = t;`
		1574	`mem = DEREF_member(member_next(mem));`
		1575	`mem = next_data_member(mem, 1);`
2	7u83	1576	`}`
7	7u83	1577	`macc = nacc;`
		1578	`} while (macc);`
		1579
		1580	`/* Allow for virtual function table */`
		1581	`#if LANGUAGE_CPP`
		1582	`if (!IS_NULL_virt(vt)) {`
		1583	`TYPE t = ptr_dummy_vtab;`
		1584	`m = DEREF_ulong(virt_table_tok(vt));`
		1585	`if (ext) {`
		1586	`string s = mangle_typeid("~cpp.vptr.", ct);`
		1587	`m = capsule_name(m, &s, VAR_token);`
2	7u83	1588	`}`
7	7u83	1589	`size_dummy_vtab = DEREF_ulong(virt_no(vt));`
		1590	`bs = enc_tokdef_start(m, "E", NIL(ulong), 1);`
		1591	`if (pm == LINK_NONE) {`
		1592	`ENC_offset_zero(bs);`
		1593	`bs = enc_alignment(bs, t);`
2	7u83	1594	`} else {`
7	7u83	1595	`bs = enc_offset_pad(bs, pm, pt, t);`
2	7u83	1596	`}`
7	7u83	1597	`enc_tokdef_end(m, bs);`
		1598	`pt = t;`
		1599	`pm = m;`
		1600	`no_bases++;`
2	7u83	1601	`}`
		1602	`#endif`
		1603
7	7u83	1604	`/* Scan through virtual bases */`
		1605	`br = DEREF_list(ctype_vbase(ct));`
		1606	`while (!IS_NULL_list(br)) {`
		1607	`GRAPH gs = DEREF_graph(HEAD_list(br));`
		1608	`CLASS_TYPE cs = DEREF_ctype(graph_head(gs));`
2	7u83	1609
7	7u83	1610	`/* Define offset token */`
		1611	`IGNORE compile_class(cs);`
		1612	`m = capsule_no(NULL_string, VAR_token);`
		1613	`if (ext) {`
		1614	`string s = mangle_vtable("~cpp.virt.", gs);`
		1615	`m = capsule_name(m, &s, VAR_token);`
		1616	`}`
		1617	`bs = enc_tokdef_start(m, "E", NIL(ulong), 1);`
		1618	`ENC_offset_pad(bs);`
		1619	`bs = enc_al_ctype(bs, cs);`
		1620	`ENC_offset_add(bs);`
		1621	`bs = enc_exp_token(bs, pm);`
		1622	`bs = enc_offset_add(bs, pt);`
		1623	`enc_tokdef_end(m, bs);`
		1624	`do {`
		1625	`/* All copies have the same real offset */`
		1626	`COPY_ulong(graph_real_off(gs), m);`
		1627	`gs = DEREF_graph(graph_equal(gs));`
		1628	`} while (!IS_NULL_graph(gs));`
		1629	`if (vo == LINK_NONE) {`
		1630	`vo = m;`
		1631	`}`
		1632	`pt = dummy_class;`
		1633	`COPY_ctype(type_compound_defn(pt), cs);`
		1634	`pm = m;`
		1635	`no_bases++;`
		1636	`br = TAIL_list(br);`
		1637	`}`
2	7u83	1638
7	7u83	1639	`/* Define the overall shape token */`
		1640	`no_mems += no_bases;`
		1641	`if (no_mems) {`
		1642	`/* Non-empty structure offset definition */`
		1643	`m = capsule_no(NULL_string, VAR_token);`
		1644	`if (ext) {`
		1645	`string s = mangle_typeid("~cpp.off.", ct);`
		1646	`m = capsule_name(m, &s, VAR_token);`
		1647	`}`
		1648	`bs = enc_tokdef_start(m, "E", NIL(ulong), 1);`
		1649	`bs = enc_special(bs, TOK_comp_off);`
		1650	`if (ci & cinfo_union) {`
		1651	`/* Complete union definition */`
		1652	`ENC_shape_offset(ts);`
		1653	`ts = enc_shape(ts, pt);`
		1654	`} else {`
		1655	`/* Complete structure definition */`
		1656	`ts = enc_offset_pad(ts, pm, pt, NULL_type);`
		1657	`}`
		1658	`bs = enc_bitstream(bs, ts);`
		1659	`enc_tokdef_end(m, bs);`
2	7u83	1660
7	7u83	1661	`/* Record offset of non-virtual components */`
		1662	`if (vo == LINK_NONE) {`
		1663	`vo = m;`
		1664	`}`
		1665	`COPY_ulong(graph_core_off(gr), vo);`
2	7u83	1666
7	7u83	1667	`/* Non-empty structure shape definition */`
		1668	`if (ext) {`
		1669	`string s = mangle_typeid("~cpp.sh.", ct);`
		1670	`n = capsule_name(n, &s, VAR_token);`
		1671	`}`
		1672	`bs = enc_tokdef_start(n, "S", NIL(ulong), 1);`
		1673	`ENC_compound(bs);`
		1674	`bs = enc_exp_token(bs, m);`
		1675	`enc_tokdef_end(n, bs);`
		1676	`ci &= ~cinfo_empty;`
2	7u83	1677
7	7u83	1678	`} else {`
		1679	`/* Empty structure definition */`
		1680	`clear_usage(n, VAR_token);`
		1681	`n = special_no(TOK_empty_shape);`
		1682	`COPY_ulong(ctype_shape(ct), n);`
		1683	`vo = special_no(TOK_empty_offset);`
		1684	`COPY_ulong(graph_core_off(gr), vo);`
		1685	`ci \|= cinfo_empty;`
		1686	`}`
		1687	`COPY_cinfo(ctype_info(ct), ci);`
		1688
		1689	`/* Define associated alignment tag */`
		1690	`m = DEREF_ulong(graph_al_tag(gr));`
		1691	`if (m != LINK_NONE) {`
		1692	`enc_al_tagdef(m, n);`
		1693	`}`
		1694	`COPY_ctype(type_compound_defn(dummy_class), cd);`
2	7u83	1695	`}`
7	7u83	1696	`return (n);`
2	7u83	1697	`}`
		1698
		1699
		1700	`/*`
		1701	`ENCODE THE SHAPE OF A CLASS TYPE`
		1702
		1703	`This routine adds the class type ct to the bitstream bs as a TDF SHAPE.`
		1704	`*/`
		1705
7	7u83	1706	`BITSTREAM *`
		1707	`enc_ctype(BITSTREAM *bs, CLASS_TYPE ct)`
2	7u83	1708	`{`
7	7u83	1709	`ulong n = compile_class(ct);`
		1710	`bs = enc_shape_token(bs, n);`
		1711	`return (bs);`
2	7u83	1712	`}`
		1713
		1714
		1715	`/*`
		1716	`LIST OF INCOMPLETE CLASSES`
		1717
		1718	`This list is used to hold all the classes which are used while they`
		1719	`are incomplete. An alignment tag is introduced for each such class`
		1720	`which may be defined later if the class is completed.`
		1721	`*/`
		1722
7	7u83	1723	`static LIST(CLASS_TYPE)incompl_classes = NULL_list(CLASS_TYPE);`
2	7u83	1724
		1725
		1726	`/*`
		1727	`DEFINE INCOMPLETE CLASSES`
		1728
		1729	`This routine defines the alignment tags for the incomplete classes`
		1730	`in this list above. Note that the class is not compiled if it has`
		1731	`not already been so.`
		1732	`*/`
		1733
7	7u83	1734	`void`
		1735	`compile_incompl(void)`
2	7u83	1736	`{`
7	7u83	1737	`LIST(CLASS_TYPE)p = incompl_classes;`
		1738	`while (!IS_NULL_list(p)) {`
		1739	`CLASS_TYPE ct = DEREF_ctype(HEAD_list(p));`
		1740	`ulong n = DEREF_ulong(ctype_shape(ct));`
		1741	`if (n == LINK_NONE) {`
		1742	`/* Uncompiled or incomplete class */`
		1743	`GRAPH gr = DEREF_graph(ctype_base(ct));`
		1744	`ulong m = DEREF_ulong(graph_al_tag(gr));`
		1745	`enc_al_tagdef(m, n);`
		1746	`}`
		1747	`p = TAIL_list(p);`
2	7u83	1748	`}`
7	7u83	1749	`DESTROY_list(incompl_classes, SIZE_ctype);`
		1750	`incompl_classes = NULL_list(CLASS_TYPE);`
		1751	`return;`
2	7u83	1752	`}`
		1753
		1754
		1755	`/*`
		1756	`ENCODE THE ALIGNMENT OF A CLASS TYPE`
		1757
		1758	`This routine adds the alignment of the class type ct to the bitstream`
		1759	`bs. Note that ct is not compiled by this routine.`
		1760	`*/`
		1761
7	7u83	1762	`BITSTREAM *`
		1763	`enc_al_ctype(BITSTREAM *bs, CLASS_TYPE ct)`
2	7u83	1764	`{`
7	7u83	1765	`GRAPH gr = DEREF_graph(ctype_base(ct));`
		1766	`ulong m = DEREF_ulong(graph_al_tag(gr));`
		1767	`if (m == LINK_NONE) {`
		1768	`string s = NULL;`
		1769	`ulong n = DEREF_ulong(ctype_shape(ct));`
		1770	`if (n != LINK_NONE) {`
		1771	`/* Class already compiled */`
		1772	`ENC_alignment(bs);`
		1773	`bs = enc_shape_token(bs, n);`
		1774	`return (bs);`
		1775	`}`
		1776	`if (output_all) {`
		1777	`s = mangle_typeid("~cpp.al.", ct);`
		1778	`}`
		1779	`m = capsule_no(s, VAR_alignment);`
		1780	`COPY_ulong(graph_al_tag(gr), m);`
		1781	`CONS_ctype(ct, incompl_classes, incompl_classes);`
2	7u83	1782	`}`
7	7u83	1783	`m = link_no(bs, m, VAR_alignment);`
		1784	`ENC_obtain_al_tag(bs);`
		1785	`ENC_make_al_tag(bs, m);`
		1786	`return (bs);`
2	7u83	1787	`}`
		1788
		1789
		1790	`/*`
		1791	`COMPILE A BASE CLASS`
		1792
		1793	`This routine compiles the base class graph gr returning a token`
		1794	`number representing the base class offset. If gr is a virtual base`
		1795	`and ptr is true then this is the offset of the pointer to the base,`
		1796	`otherwise it is the actual base.`
		1797	`*/`
		1798
7	7u83	1799	`static ulong`
		1800	`compile_base(GRAPH gr, int ptr)`
2	7u83	1801	`{`
7	7u83	1802	`ulong n, m;`
		1803	`GRAPH g1, g2;`
		1804	`BITSTREAM *bs;`
		1805	`string s = NULL;`
		1806	`OFFSET off = DEREF_off(graph_off(gr));`
		1807	`DECL_SPEC acc = DEREF_dspec(graph_access(gr));`
		1808	`if ((acc & dspec_virtual) && !ptr) {`
		1809	`/* Virtual base class */`
		1810	`n = DEREF_ulong(graph_real_off(gr));`
		1811	`return (n);`
		1812	`}`
		1813	`if (IS_off_base(off)) {`
		1814	`/* Direct base class */`
		1815	`n = DEREF_ulong(graph_base_off(gr));`
		1816	`return (n);`
		1817	`}`
2	7u83	1818
7	7u83	1819	`/* Check for recorded values */`
		1820	`if (ptr) {`
		1821	`n = DEREF_ulong(graph_base_off(gr));`
2	7u83	1822	`} else {`
7	7u83	1823	`n = DEREF_ulong(graph_real_off(gr));`
2	7u83	1824	`}`
7	7u83	1825	`if (n != LINK_NONE) {`
		1826	`return (n);`
		1827	`}`
		1828	`if (output_all) {`
		1829	`CONST char *pre = "~cpp.base.";`
		1830	`if ((acc & dspec_mutable) && !ptr) {`
		1831	`pre = "~cpp.virt.";`
		1832	`}`
		1833	`s = mangle_vtable(pre, gr);`
		1834	`}`
		1835	`n = capsule_no(s, VAR_token);`
		1836
		1837	`/* Decompose base offset */`
		1838	`if (acc & dspec_mutable) {`
		1839	`/* Base of virtual base */`
		1840	`CLASS_TYPE cs;`
		1841	`g1 = DEREF_graph(graph_up(gr));`
		1842	`cs = DEREF_ctype(graph_head(g1));`
		1843	`g2 = DEREF_graph(ctype_base(cs));`
		1844	`g2 = find_subgraph(g2, g1, gr);`
		1845	`if (ptr) {`
		1846	`COPY_ulong(graph_base_off(gr), n);`
		1847	`} else {`
		1848	`COPY_ulong(graph_real_off(gr), n);`
		1849	`}`
2	7u83	1850	`} else {`
7	7u83	1851	`/* Indirect base */`
		1852	`OFFSET off1 = DEREF_off(off_deriv_direct(off));`
		1853	`OFFSET off2 = DEREF_off(off_deriv_indirect(off));`
		1854	`g1 = DEREF_graph(off_base_graph(off1));`
		1855	`if (IS_off_base(off2)) {`
		1856	`g2 = DEREF_graph(off_base_graph(off2));`
		1857	`} else {`
		1858	`g2 = DEREF_graph(off_deriv_graph(off2));`
		1859	`}`
		1860	`COPY_ulong(graph_base_off(gr), n);`
		1861	`COPY_ulong(graph_real_off(gr), n);`
2	7u83	1862	`}`
		1863
7	7u83	1864	`/* Define the token */`
		1865	`bs = enc_tokdef_start(n, "E", NIL(ulong), 1);`
		1866	`ENC_offset_add(bs);`
		1867	`m = compile_base(g1, 0);`
		1868	`bs = enc_exp_token(bs, m);`
		1869	`m = compile_base(g2, ptr);`
		1870	`bs = enc_exp_token(bs, m);`
		1871	`enc_tokdef_end(n, bs);`
		1872	`return (n);`
2	7u83	1873	`}`
		1874
		1875
		1876	`/*`
		1877	`ENCODE A BASE CLASS OFFSET`
		1878
		1879	`This routine adds an offset representing the base class graph gr`
		1880	`to the bitstream bs. For virtual bases this is the offset of the`
		1881	`pointer to the base if ptr is true and the offset of the actual base`
		1882	`otherwise.`
		1883	`*/`
		1884
7	7u83	1885	`BITSTREAM *`
		1886	`enc_base(BITSTREAM *bs, GRAPH gr, int ptr)`
2	7u83	1887	`{`
7	7u83	1888	`GRAPH gt = DEREF_graph(graph_top(gr));`
		1889	`CLASS_TYPE ct = DEREF_ctype(graph_head(gt));`
		1890	`if (EQ_graph(gr, gt)) {`
		1891	`ENC_offset_zero(bs);`
		1892	`bs = enc_al_ctype(bs, ct);`
		1893	`} else {`
		1894	`ulong n;`
		1895	`IGNORE compile_class(ct);`
		1896	`n = compile_base(gr, ptr);`
		1897	`bs = enc_exp_token(bs, n);`
		1898	`}`
		1899	`return (bs);`
2	7u83	1900	`}`
		1901
		1902
		1903	`/*`
		1904	`ENCODE THE START OF A VIRTUAL BASE CLASS POINTER EXPRESSION`
		1905
		1906	`This routine adds the start of a virtual base class pointer expression`
		1907	`to the bitstream bs. off1 gives the direct component of the offset`
		1908	`and off2 gives the indirect component.`
		1909	`*/`
		1910
7	7u83	1911	`BITSTREAM *`
		1912	`enc_add_base(BITSTREAM *bs, OFFSET off1, OFFSET off2)`
2	7u83	1913	`{`
7	7u83	1914	`GRAPH gr = DEREF_graph(off_base_graph(off1));`
		1915	`DECL_SPEC acc = DEREF_dspec(graph_access(gr));`
		1916	`if (!IS_NULL_off(off2)) {`
		1917	`if (IS_off_deriv(off2)) {`
		1918	`OFFSET off3 = DEREF_off(off_deriv_direct(off2));`
		1919	`OFFSET off4 = DEREF_off(off_deriv_indirect(off2));`
		1920	`bs = enc_add_base(bs, off3, off4);`
		1921	`} else {`
		1922	`bs = enc_add_base(bs, off2, NULL_off);`
		1923	`}`
2	7u83	1924	`}`
7	7u83	1925	`if (acc & dspec_virtual) {`
		1926	`/* Indirection for virtual bases */`
		1927	`CLASS_TYPE ct = DEREF_ctype(graph_head(gr));`
		1928	`ENC_contents(bs);`
		1929	`ENC_pointer(bs);`
		1930	`bs = enc_al_ctype(bs, ct);`
		1931	`}`
		1932	`if (!(acc & dspec_ignore)) {`
		1933	`/* Add base class offset */`
		1934	`ENC_add_to_ptr(bs);`
		1935	`}`
		1936	`return (bs);`
2	7u83	1937	`}`
		1938
		1939
		1940	`/*`
		1941	`ENCODE THE END OF A VIRTUAL BASE CLASS POINTER EXPRESSION`
		1942
		1943	`This routine adds the end of a virtual base class pointer expression`
		1944	`to the bitstream bs. off1 gives the direct component of the offset`
		1945	`and off2 gives the indirect component.`
		1946	`*/`
		1947
7	7u83	1948	`BITSTREAM *`
		1949	`enc_end_base(BITSTREAM *bs, OFFSET off1, OFFSET off2)`
2	7u83	1950	`{`
7	7u83	1951	`GRAPH gr = DEREF_graph(off_base_graph(off1));`
		1952	`DECL_SPEC acc = DEREF_dspec(graph_access(gr));`
		1953	`if (!(acc & dspec_ignore)) {`
		1954	`/* Output base class offset */`
		1955	`ulong n = DEREF_ulong(graph_base_off(gr));`
		1956	`if (n == LINK_NONE) {`
		1957	`/* Compile class if necessary */`
		1958	`GRAPH gt = DEREF_graph(graph_top(gr));`
		1959	`CLASS_TYPE ct = DEREF_ctype(graph_head(gt));`
		1960	`IGNORE compile_class(ct);`
		1961	`n = DEREF_ulong(graph_base_off(gr));`
		1962	`}`
		1963	`bs = enc_exp_token(bs, n);`
2	7u83	1964	`}`
7	7u83	1965	`if (!IS_NULL_off(off2)) {`
		1966	`if (IS_off_deriv(off2)) {`
		1967	`OFFSET off3 = DEREF_off(off_deriv_direct(off2));`
		1968	`OFFSET off4 = DEREF_off(off_deriv_indirect(off2));`
		1969	`bs = enc_end_base(bs, off3, off4);`
		1970	`} else {`
		1971	`bs = enc_end_base(bs, off2, NULL_off);`
		1972	`}`
2	7u83	1973	`}`
7	7u83	1974	`return (bs);`
2	7u83	1975	`}`
		1976
		1977
		1978	`/*`
		1979	`ENCODE A MEMBER OFFSET`
		1980
		1981	`This routine adds the offset of the member id to the bitstream bs.`
		1982	`If id is a data member this is the offset of the member from the start`
		1983	`of the structure.`
		1984	`*/`
		1985
7	7u83	1986	`BITSTREAM *`
		1987	`enc_member(BITSTREAM *bs, IDENTIFIER id)`
2	7u83	1988	`{`
7	7u83	1989	`ulong tok;`
		1990	`unsigned tag = TAG_id(id);`
		1991	`if (tag == id_member_tag) {`
		1992	`/* Simple data member */`
		1993	`OFFSET off = DEREF_off(id_member_off(id));`
		1994	`if (IS_off_member(off)) {`
		1995	`tok = DEREF_ulong(id_no(id));`
		1996	`if (tok == LINK_NONE) {`
		1997	`CLASS_TYPE ct = parent_class(id);`
		1998	`IGNORE compile_class(ct);`
		1999	`tok = DEREF_ulong(id_no(id));`
		2000	`}`
		2001	`if (tok == LINK_ZERO) {`
		2002	`/* Union member */`
		2003	`TYPE t = DEREF_type(id_member_type(id));`
		2004	`ENC_offset_zero(bs);`
		2005	`bs = enc_alignment(bs, t);`
		2006	`} else {`
		2007	`/* Structure member */`
		2008	`bs = enc_exp_token(bs, tok);`
		2009	`}`
		2010	`} else {`
		2011	`bs = enc_offset(bs, off);`
		2012	`}`
2	7u83	2013	`} else {`
7	7u83	2014	`/* Static data members and member functions */`
		2015	`IGNORE capsule_id(id, VAR_tag);`
		2016	`tok = unit_no(bs, id, VAR_tag, 0);`
		2017	`ENC_obtain_tag(bs);`
		2018	`ENC_make_tag(bs, tok);`
2	7u83	2019	`}`
7	7u83	2020	`return (bs);`
2	7u83	2021	`}`
		2022
		2023
		2024	`/*`
		2025	`ENCODE A NULL CLASS OBJECT DEFINITION`
		2026
		2027	`This routine adds an expression representing a null value of type`
		2028	`ct to the bitstream bs. The virtual base components are only`
		2029	`included if virt is true. Note that the order of the components`
		2030	`is not necessarily the same as that in compile_class, but the`
		2031	`installers always sort make_compound expressions into the correct`
		2032	`order.`
		2033	`*/`
		2034
7	7u83	2035	`static BITSTREAM *`
		2036	`enc_null_class_aux(BITSTREAM *bs, CLASS_TYPE ct, int virt)`
2	7u83	2037	`{`
7	7u83	2038	`CLASS_INFO ci = DEREF_cinfo(ctype_info(ct));`
		2039	`if (ci & (cinfo_empty \| cinfo_token)) {`
		2040	`/* Tokenised and empty classes */`
		2041	`ENC_make_value(bs);`
		2042	`bs = enc_ctype(bs, ct);`
		2043	`} else {`
		2044	`/* Non-empty classes */`
		2045	`MEMBER mem;`
		2046	`unsigned no_mems = 0;`
		2047	`GRAPH gr = DEREF_graph(ctype_base(ct));`
		2048	`LIST(GRAPH)br = DEREF_list(graph_tails(gr));`
		2049	`LIST(GRAPH)bv = DEREF_list(ctype_vbase(ct));`
		2050	`NAMESPACE ns = DEREF_nspace(ctype_member(ct));`
		2051	`BITSTREAM *ts = start_bitstream(NIL(FILE), bs->link);`
2	7u83	2052
7	7u83	2053	`/* Scan through direct base classes */`
		2054	`while (!IS_NULL_list(br)) {`
		2055	`GRAPH gs = DEREF_graph(HEAD_list(br));`
		2056	`DECL_SPEC acc = DEREF_dspec(graph_access(gs));`
		2057	`CLASS_TYPE cs = DEREF_ctype(graph_head(gs));`
		2058	`ulong m = DEREF_ulong(graph_base_off(gs));`
		2059	`if (acc & dspec_virtual) {`
		2060	`ts = enc_exp_token(ts, m);`
		2061	`ENC_make_null_ptr(ts);`
		2062	`ts = enc_al_ctype(ts, cs);`
		2063	`no_mems++;`
		2064	`} else {`
		2065	`CLASS_INFO cj = DEREF_cinfo(ctype_info(cs));`
		2066	`if (!(cj & cinfo_empty)) {`
		2067	`ts = enc_exp_token(ts, m);`
		2068	`ts = enc_null_class_aux(ts, cs, 0);`
		2069	`no_mems++;`
		2070	`}`
		2071	`}`
		2072	`br = TAIL_list(br);`
2	7u83	2073	`}`
		2074
7	7u83	2075	`/* Scan through data members */`
		2076	`mem = DEREF_member(nspace_ctype_first(ns));`
		2077	`mem = next_data_member(mem, 0);`
		2078	`while (!IS_NULL_member(mem)) {`
		2079	`IDENTIFIER mid = DEREF_id(member_id(mem));`
		2080	`TYPE s = DEREF_type(id_member_type(mid));`
		2081	`ts = enc_member(ts, mid);`
		2082	`ts = enc_null_exp(ts, s);`
		2083	`no_mems++;`
		2084	`if (ci & cinfo_union) {`
		2085	`break;`
		2086	`}`
		2087	`mem = DEREF_member(member_next(mem));`
		2088	`mem = next_data_member(mem, 0);`
		2089	`}`
2	7u83	2090
7	7u83	2091	`/* Scan through virtual function tables */`
2	7u83	2092	`#if LANGUAGE_CPP`
7	7u83	2093	`if (ci & cinfo_polymorphic) {`
		2094	`VIRTUAL vt = DEREF_virt(ctype_virt(ct));`
		2095	`while (!IS_NULL_virt(vt)) {`
		2096	`OFFSET off = DEREF_off(virt_table_off(vt));`
		2097	`if (IS_NULL_off(off)) {`
		2098	`ulong m =`
		2099	`DEREF_ulong(virt_table_tok(vt));`
		2100	`ts = enc_exp_token(ts, m);`
		2101	`size_dummy_vtab =`
		2102	`DEREF_ulong(virt_no(vt));`
		2103	`ts = enc_null_exp(ts, ptr_dummy_vtab);`
		2104	`no_mems++;`
		2105	`}`
		2106	`vt = DEREF_virt(virt_next(vt));`
		2107	`}`
2	7u83	2108	`}`
		2109	`#endif`
		2110
7	7u83	2111	`/* Scan through virtual bases */`
		2112	`if (virt) {`
		2113	`while (!IS_NULL_list(bv)) {`
		2114	`GRAPH gs = DEREF_graph(HEAD_list(bv));`
		2115	`CLASS_TYPE cs = DEREF_ctype(graph_head(gs));`
		2116	`CLASS_INFO cj = DEREF_cinfo(ctype_info(cs));`
		2117	`if (!(cj & cinfo_empty)) {`
		2118	`ulong m =`
		2119	`DEREF_ulong(graph_real_off(gs));`
		2120	`ts = enc_exp_token(ts, m);`
		2121	`ts = enc_null_class_aux(ts, cs, 0);`
		2122	`no_mems++;`
		2123	`}`
		2124	`bv = TAIL_list(bv);`
		2125	`}`
		2126	`} else {`
		2127	`if (IS_NULL_list(bv)) {`
		2128	`virt = 1;`
		2129	`}`
2	7u83	2130	`}`
		2131
7	7u83	2132	`/* Encode complete construct */`
		2133	`if (no_mems) {`
		2134	`ENC_make_compound(bs);`
		2135	`if (virt) {`
		2136	`ENC_shape_offset(bs);`
		2137	`bs = enc_ctype(bs, ct);`
		2138	`} else {`
		2139	`ulong m = DEREF_ulong(graph_core_off(gr));`
		2140	`if (m == LINK_NONE) {`
		2141	`ENC_shape_offset(bs);`
		2142	`bs = enc_ctype(bs, ct);`
		2143	`} else {`
		2144	`bs = enc_exp_token(bs, m);`
		2145	`}`
		2146	`}`
		2147	`ENC_LIST(bs, no_mems + no_mems);`
		2148	`bs = join_bitstreams(bs, ts);`
2	7u83	2149	`} else {`
7	7u83	2150	`ENC_make_value(bs);`
		2151	`bs = enc_ctype(bs, ct);`
		2152	`end_bitstream(ts, 0);`
2	7u83	2153	`}`
		2154	`}`
7	7u83	2155	`return (bs);`
2	7u83	2156	`}`
		2157
		2158
		2159	`/*`
		2160	`ENCODE A NULL CLASS OBJECT`
		2161
		2162	`This routine adds the default null value for the class type ct to the`
		2163	`bitstream bs. This is represented by a token which is defined the`
		2164	`first time the routine is called.`
		2165	`*/`
		2166
7	7u83	2167	`BITSTREAM *`
		2168	`enc_null_class(BITSTREAM *bs, CLASS_TYPE ct)`
2	7u83	2169	`{`
7	7u83	2170	`ulong n = DEREF_ulong(ctype_null_exp(ct));`
		2171	`if (n == LINK_NONE) {`
		2172	`/* Define token for null value */`
		2173	`BITSTREAM *ts;`
		2174	`string s = NULL;`
		2175	`IGNORE compile_class(ct);`
		2176	`if (output_all) {`
		2177	`s = mangle_typeid("~cpp.null.", ct);`
		2178	`}`
		2179	`n = capsule_no(s, VAR_token);`
		2180	`COPY_ulong(ctype_null_exp(ct), n);`
		2181	`ts = enc_tokdef_start(n, "E", NIL(ulong), 1);`
		2182	`ts = enc_null_class_aux(ts, ct, 1);`
		2183	`enc_tokdef_end(n, ts);`
		2184	`}`
		2185	`bs = enc_exp_token(bs, n);`
		2186	`return (bs);`
2	7u83	2187	`}`
		2188
		2189
		2190	`/*`
		2191	`CONSTRUCTOR INITIALISER ROUTINES`
		2192
		2193	`The constructor initialiser routines are only included in the C++`
		2194	`producer.`
		2195	`*/`
		2196
		2197	`#if LANGUAGE_CPP`
		2198
		2199
		2200	`/*`
		2201	`ENCODE A CONSTRUCTOR INITIALISER`
		2202
		2203	`This routine performs a construct initialisation using a at offset`
		2204	`off from the tag m. virt controls how m is accessed. Note that a`
		2205	`may be a dummy expression to indicate that m is initialised from`
		2206	`the corresponding offset from the second argument in a copy`
		2207	`constructor or assignment operator (see init_empty_base).`
		2208	`*/`
		2209
7	7u83	2210	`static BITSTREAM *`
		2211	`enc_ctor_exp(BITSTREAM *bs, EXP a, OFFSET off, ulong m, int virt, unsigned seq)`
2	7u83	2212	`{`
7	7u83	2213	`if (!IS_NULL_exp(a)) {`
		2214	`int context = 0;`
		2215	`EXP d = NULL_exp;`
		2216	`TYPE s = DEREF_type(exp_type(a));`
		2217	`if (IS_exp_paren(a)) {`
		2218	`/* Used to mark destructors - see destr_init */`
		2219	`if (seq > 1) {`
		2220	`context = 5;`
		2221	`d = a;`
		2222	`}`
		2223	`a = DEREF_exp(exp_paren_arg(a));`
		2224	`}`
		2225	`if (IS_NULL_exp(a)) {`
		2226	`/* EMPTY */`
		2227	`} else if (IS_exp_value(a)) {`
		2228	`/* Copy assignment */`
		2229	`int bf = 0;`
		2230	`TYPE t = DEREF_type(exp_type(a));`
		2231	`bs = enc_assign_op(bs, t, &bf);`
		2232	`if (bf) {`
		2233	`/* Bitfield assignment */`
		2234	`OFFSET off1 = off;`
		2235	`OFFSET off2 = decons_bitf_off(&off1);`
		2236	`bs = enc_dummy_exp(bs, t, m, off1, 0, virt);`
		2237	`bs = enc_offset(bs, off2);`
		2238	`} else {`
		2239	`/* Non-bitfield assignment */`
		2240	`bs = enc_dummy_exp(bs, t, m, off, 0, virt);`
		2241	`}`
		2242	`last_conts[DUMMY_copy] = 1;`
		2243	`bs = enc_dummy_exp(bs, t, LINK_NONE, off, DUMMY_copy, 1);`
		2244	`last_conts[DUMMY_copy] = 0;`
		2245	`seq--;`
		2246	`} else {`
		2247	`/* Constructor initialiser */`
		2248	`bs = enc_init_tag(bs, m, off, 0, s, a, d, context);`
		2249	`if (!IS_NULL_exp(d)) {`
		2250	`d = NULL_exp;`
		2251	`seq--;`
		2252	`}`
		2253	`seq--;`
		2254	`}`
		2255	`if (!IS_NULL_exp(d)) {`
		2256	`/* Increase constructor count */`
		2257	`bs = enc_destr_count(bs, s, 1);`
		2258	`seq--;`
		2259	`}`
2	7u83	2260	`}`
7	7u83	2261	`while (seq) {`
		2262	`ENC_make_top(bs);`
		2263	`seq--;`
2	7u83	2264	`}`
7	7u83	2265	`return (bs);`
2	7u83	2266	`}`
		2267
		2268
		2269	`/*`
		2270	`INITIALISE VIRTUAL BASE POINTERS`
		2271
		2272	`This routine adds a list of virtual base pointer initialisations`
		2273	`for an object with tag number m and class ct to the bitstream bs.`
		2274	`*/`
		2275
7	7u83	2276	`static BITSTREAM *`
		2277	`enc_virt_init(BITSTREAM *bs, CLASS_TYPE ct, ulong m)`
2	7u83	2278	`{`
7	7u83	2279	`LIST(GRAPH)bv = DEREF_list(ctype_vbase(ct));`
		2280	`while (!IS_NULL_list(bv)) {`
		2281	`GRAPH gr = DEREF_graph(HEAD_list(bv));`
		2282	`ulong tv = DEREF_ulong(graph_real_off(gr));`
		2283	`while (!IS_NULL_graph(gr)) {`
		2284	`ulong tp = compile_base(gr, 1);`
		2285	`ENC_assign(bs);`
		2286	`ENC_add_to_ptr(bs);`
		2287	`ENC_obtain_tag(bs);`
		2288	`ENC_make_tag(bs, m);`
		2289	`bs = enc_exp_token(bs, tp);`
		2290	`ENC_add_to_ptr(bs);`
		2291	`ENC_obtain_tag(bs);`
		2292	`ENC_make_tag(bs, m);`
		2293	`bs = enc_exp_token(bs, tv);`
		2294	`gr = DEREF_graph(graph_equal(gr));`
		2295	`}`
		2296	`bv = TAIL_list(bv);`
2	7u83	2297	`}`
7	7u83	2298	`return (bs);`
2	7u83	2299	`}`
		2300
		2301
		2302	`/*`
		2303	`INITIALISE VIRTUAL FUNCTION TABLES`
		2304
		2305	`This routine adds a list of virtual function table initialisations`
		2306	`for an object with tag number m and class ct to the bitstream bs.`
		2307	`*/`
		2308
7	7u83	2309	`static BITSTREAM *`
		2310	`enc_vtab_init(BITSTREAM *bs, CLASS_TYPE ct, ulong m, int virt)`
2	7u83	2311	`{`
7	7u83	2312	`VIRTUAL vt = DEREF_virt(ctype_virt(ct));`
		2313	`while (!IS_NULL_virt(vt)) {`
		2314	`OFFSET off = DEREF_off(virt_table_off(vt));`
		2315	`ulong tv = DEREF_ulong(virt_table_tok(vt));`
		2316	`ulong tt = DEREF_ulong(virt_table_tbl(vt));`
		2317	`record_usage(tt, VAR_tag, USAGE_USE);`
		2318	`ENC_assign(bs);`
		2319	`ENC_add_to_ptr(bs);`
		2320	`if (is_zero_offset(off)) {`
		2321	`ENC_obtain_tag(bs);`
		2322	`ENC_make_tag(bs, m);`
		2323	`} else {`
		2324	`TYPE t = ptr_dummy_class;`
		2325	`bs = enc_dummy_exp(bs, t, m, off, 0, virt);`
		2326	`}`
		2327	`bs = enc_exp_token(bs, tv);`
		2328	`tt = link_no(bs, tt, VAR_tag);`
		2329	`ENC_obtain_tag(bs);`
		2330	`ENC_make_tag(bs, tt);`
		2331	`vt = DEREF_virt(virt_next(vt));`
2	7u83	2332	`}`
7	7u83	2333	`return (bs);`
2	7u83	2334	`}`
		2335
		2336
		2337	`/*`
		2338	`DELETE AN OBJECT`
		2339
		2340	`This routine adds the conditional deletion for an object with tag`
		2341	`number m and class ct to the bitstream bs.`
		2342	`*/`
		2343
7	7u83	2344	`static BITSTREAM *`
		2345	`enc_delete_obj(BITSTREAM *bs, CLASS_TYPE ct, ulong m)`
2	7u83	2346	`{`
7	7u83	2347	`IDENTIFIER cid = DEREF_id(ctype_name(ct));`
		2348	`TYPE t = DEREF_type(id_class_name_etc_defn(cid));`
		2349	`IDENTIFIER fid = find_allocator(t, lex_delete, 0, NULL_id);`
		2350	`if (IS_NULL_id(fid)) {`
		2351	`/* This shouldn't happen */`
		2352	`ENC_make_top(bs);`
		2353	`} else {`
		2354	`ulong d;`
		2355	`BITSTREAM *ts;`
		2356	`TYPE fn = DEREF_type(id_function_etc_type(fid));`
		2357	`LIST(TYPE)ptypes = DEREF_list(type_func_ptypes(fn));`
		2358	`unsigned npids = LENGTH_list(ptypes);`
2	7u83	2359
7	7u83	2360	`/* Mark the function as to be compiled */`
		2361	`IGNORE capsule_id(fid, VAR_tag);`
		2362	`CONS_id(fid, pending_funcs, pending_funcs);`
2	7u83	2363
7	7u83	2364	`/* Encode the function call */`
		2365	`ENC_apply_proc(bs);`
		2366	`ENC_top(bs);`
		2367	`ENC_obtain_tag(bs);`
		2368	`d = unit_no(bs, fid, VAR_tag, 0);`
		2369	`ENC_make_tag(bs, d);`
		2370	`if (npids > 2) {`
		2371	`npids = 2;`
		2372	`}`
		2373	`ENC_LIST_SMALL(bs, npids);`
		2374	`bs = enc_special(bs, TOK_to_ptr_void);`
		2375	`ts = start_bitstream(NIL(FILE), bs->link);`
		2376	`ts = enc_al_ctype(ts, ct);`
		2377	`ENC_obtain_tag(ts);`
		2378	`ENC_make_tag(ts, m);`
		2379	`bs = enc_bitstream(bs, ts);`
		2380	`if (npids == 2) {`
		2381	`/* Allow for second argument */`
		2382	`TYPE s;`
		2383	`TYPE c = type_char;`
		2384	`ptypes = TAIL_list(ptypes);`
		2385	`s = DEREF_type(HEAD_list(ptypes));`
		2386	`if (!IS_type_integer(s)) {`
		2387	`s = type_size_t;`
		2388	`}`
		2389	`ENC_offset_div(bs);`
		2390	`bs = enc_variety(bs, s);`
		2391	`bs = enc_shape_offset(bs, t);`
		2392	`bs = enc_shape_offset(bs, c);`
		2393	`}`
		2394	`ENC_OFF(bs);`
2	7u83	2395	`}`
7	7u83	2396	`return (bs);`
2	7u83	2397	`}`
		2398
		2399
		2400	`/*`
		2401	`ENCODE A LIST OF CONSTRUCTOR INITIALISERS`
		2402
		2403	`This routine adds the list of constructor initialisers given by e`
		2404	`to the bitstream bs.`
		2405	`*/`
		2406
7	7u83	2407	`BITSTREAM *`
		2408	`enc_ctor_init(BITSTREAM *bs, EXP e)`
2	7u83	2409	`{`
7	7u83	2410	`ulong n, m;`
		2411	`CLASS_TYPE ct = last_class;`
		2412	`int kind = DEREF_int(exp_initialiser_kind(e));`
		2413	`LIST(EXP)p = DEREF_list(exp_initialiser_args(e));`
		2414	`LIST(OFFSET)q = DEREF_list(exp_initialiser_offs(e));`
2	7u83	2415
7	7u83	2416	`/* Find number of items */`
		2417	`unsigned np = LENGTH_list(p);`
		2418	`unsigned nv = DEREF_unsigned(exp_initialiser_virt(e));`
		2419	`unsigned nb = DEREF_unsigned(exp_initialiser_base(e));`
		2420	`unsigned no = np - nv;`
2	7u83	2421
7	7u83	2422	`/* Compile the class */`
		2423	`IGNORE compile_class(ct);`
2	7u83	2424
7	7u83	2425	`/* Find the 'this' pointer */`
		2426	`n = last_params[DUMMY_this];`
		2427	`m = unit_no(bs, NULL_id, VAR_tag, 1);`
		2428	`ENC_identify(bs);`
		2429	`bs = enc_access(bs, crt_func_access);`
		2430	`ENC_make_tag(bs, m);`
		2431	`ENC_contents(bs);`
		2432	`ENC_pointer(bs);`
		2433	`bs = enc_al_ctype(bs, ct);`
		2434	`ENC_obtain_tag(bs);`
		2435	`ENC_make_tag(bs, n);`
2	7u83	2436
7	7u83	2437	`if (kind == DEFAULT_DESTR) {`
		2438	`/* Deal with destructors */`
		2439	`int context = 0;`
		2440	`unsigned ns = no + 1;`
		2441	`ulong m2 = last_params[DUMMY_extra];`
		2442	`if (last_params[DUMMY_count] != LINK_NONE) {`
		2443	`context = 5;`
		2444	`ns--;`
		2445	`}`
		2446	`if (nv) {`
		2447	`ns++;`
		2448	`}`
		2449	`if (ns > 1) {`
		2450	`ENC_SEQUENCE(bs, ns - 1);`
		2451	`} else {`
		2452	`if (ns == 0) {`
		2453	`ENC_make_top(bs);`
		2454	`}`
		2455	`}`
2	7u83	2456
7	7u83	2457	`/* Destroy members and direct bases */`
		2458	`while (no) {`
		2459	`EXP a = DEREF_exp(HEAD_list(p));`
		2460	`if (IS_NULL_exp(a)) {`
		2461	`ENC_make_top(bs);`
		2462	`} else {`
		2463	`TYPE s = DEREF_type(exp_type(a));`
		2464	`OFFSET off = DEREF_off(HEAD_list(q));`
		2465	`bs = enc_term_local(bs, m, off, 0, s, a,`
		2466	`context);`
		2467	`}`
		2468	`q = TAIL_list(q);`
		2469	`p = TAIL_list(p);`
		2470	`no--;`
		2471	`}`
2	7u83	2472
7	7u83	2473	`/* Conditionally destroy virtual bases */`
		2474	`if (nv) {`
		2475	`int mask = 0;`
		2476	`if (context == 0) {`
		2477	`mask = EXTRA_DESTR;`
		2478	`}`
		2479	`bs = enc_flag_test(bs, m2, nv, mask, ntest_not_eq);`
		2480	`while (!IS_NULL_list(p)) {`
		2481	`EXP a = DEREF_exp(HEAD_list(p));`
		2482	`if (IS_NULL_exp(a)) {`
		2483	`ENC_make_top(bs);`
		2484	`} else {`
		2485	`TYPE s = DEREF_type(exp_type(a));`
		2486	`OFFSET off = DEREF_off(HEAD_list(q));`
		2487	`bs = enc_term_local(bs, m, off, 0, s,`
		2488	`a, context);`
		2489	`}`
		2490	`q = TAIL_list(q);`
		2491	`p = TAIL_list(p);`
		2492	`}`
		2493	`ENC_make_top(bs);`
2	7u83	2494	`}`
		2495
7	7u83	2496	`/* Conditionally call 'operator delete' */`
		2497	`if (context == 0) {`
		2498	`ns = 1;`
		2499	`bs = enc_flag_test(bs, m2, ns, EXTRA_DELETE,`
		2500	`ntest_not_eq);`
		2501	`bs = enc_delete_obj(bs, ct, m);`
		2502	`ENC_make_top(bs);`
		2503	`}`
2	7u83	2504
7	7u83	2505	`} else {`
		2506	`/* Deal with constructors */`
		2507	`int virt = 1;`
		2508	`unsigned ns, nu;`
		2509	`unsigned ni = 0;`
		2510	`unsigned nt = 0;`
		2511	`unsigned ne = 1;`
2	7u83	2512
7	7u83	2513	`/* Allow for copy constructors */`
		2514	`if (kind == DEFAULT_COPY \|\| kind == DEFAULT_ASSIGN) {`
		2515	`ulong n1 = last_params[DUMMY_second];`
		2516	`ulong m1 = unit_no(bs, NULL_id, VAR_tag, 1);`
		2517	`ENC_identify(bs);`
		2518	`bs = enc_access(bs, crt_func_access);`
		2519	`ENC_make_tag(bs, m1);`
		2520	`ENC_contents(bs);`
		2521	`ENC_pointer(bs);`
		2522	`bs = enc_al_ctype(bs, ct);`
		2523	`ENC_obtain_tag(bs);`
		2524	`ENC_make_tag(bs, n1);`
		2525	`last_params[DUMMY_copy] = m1;`
		2526	`}`
2	7u83	2527
7	7u83	2528	`/* Count number of items */`
		2529	`if (kind != DEFAULT_ASSIGN) {`
		2530	`VIRTUAL vt = DEREF_virt(ctype_virt(ct));`
		2531	`if (kind != DEFAULT_PRELUDE) {`
		2532	`LIST(GRAPH)bv = DEREF_list(ctype_vbase(ct));`
		2533	`while (!IS_NULL_list(bv)) {`
		2534	`/* Virtual base pointers */`
		2535	`GRAPH gr = DEREF_graph(HEAD_list(bv));`
		2536	`while (!IS_NULL_graph(gr)) {`
		2537	`ni++;`
		2538	`gr = DEREF_graph(graph_equal(gr));`
		2539	`}`
		2540	`bv = TAIL_list(bv);`
		2541	`}`
		2542	`}`
		2543	`if (!IS_NULL_virt(vt)) {`
		2544	`/* Virtual function tables */`
		2545	`IDENTIFIER cid = DEREF_id(ctype_name(ct));`
		2546	`compile_virtual(ct, !has_linkage(cid));`
		2547	`while (!IS_NULL_virt(vt)) {`
		2548	`nt++;`
		2549	`vt = DEREF_virt(virt_next(vt));`
		2550	`}`
		2551	`}`
		2552	`virt = 0;`
2	7u83	2553	`}`
7	7u83	2554	`if (last_params[DUMMY_count] != LINK_NONE) {`
		2555	`ne = 2;`
2	7u83	2556	`}`
7	7u83	2557	`ns = ne * no + nt;`
		2558	`nu = ne * nv + ni;`
		2559	`if (nu) {`
		2560	`ns++;`
		2561	`}`
		2562	`if (ns > 1) {`
		2563	`ENC_SEQUENCE(bs, ns - 1);`
		2564	`} else {`
		2565	`if (ns == 0) {`
		2566	`ENC_make_top(bs);`
		2567	`}`
		2568	`}`
2	7u83	2569
7	7u83	2570	`/* Conditionally initialise virtual bases */`
		2571	`if (nu) {`
		2572	`int dv = 0;`
		2573	`ulong m2 = last_params[DUMMY_extra];`
		2574	`bs = enc_flag_test(bs, m2, nu, 0, ntest_not_eq);`
		2575	`if (ni) {`
		2576	`/* Initialise virtual base pointers */`
		2577	`bs = enc_virt_init(bs, ct, m);`
		2578	`}`
		2579	`while (nv) {`
		2580	`/* Virtual base initialisers */`
		2581	`EXP a = DEREF_exp(HEAD_list(p));`
		2582	`OFFSET off = DEREF_off(HEAD_list(q));`
		2583	`bs = enc_ctor_exp(bs, a, off, m, virt, ne);`
		2584	`if (!IS_NULL_exp(a) && IS_exp_paren(a)) {`
		2585	`dv++;`
		2586	`}`
		2587	`q = TAIL_list(q);`
		2588	`p = TAIL_list(p);`
		2589	`nv--;`
		2590	`}`
		2591	`if (ne == 1 \|\| dv == 0) {`
		2592	`ENC_make_top(bs);`
		2593	`} else {`
		2594	`bs = enc_destr_count(bs, NULL_type, dv);`
		2595	`}`
		2596	`}`
2	7u83	2597
7	7u83	2598	`/* Initialise direct bases */`
		2599	`while (nb) {`
		2600	`EXP a = DEREF_exp(HEAD_list(p));`
		2601	`OFFSET off = DEREF_off(HEAD_list(q));`
		2602	`bs = enc_ctor_exp(bs, a, off, m, virt, ne);`
		2603	`q = TAIL_list(q);`
		2604	`p = TAIL_list(p);`
		2605	`nb--;`
		2606	`}`
2	7u83	2607
7	7u83	2608	`/* Initialise virtual function tables */`
		2609	`if (nt) {`
		2610	`bs = enc_vtab_init(bs, ct, m, 1);`
		2611	`}`
2	7u83	2612
7	7u83	2613	`/* Initialise members */`
		2614	`while (!IS_NULL_list(p)) {`
		2615	`EXP a = DEREF_exp(HEAD_list(p));`
		2616	`OFFSET off = DEREF_off(HEAD_list(q));`
		2617	`bs = enc_ctor_exp(bs, a, off, m, virt, ne);`
		2618	`q = TAIL_list(q);`
		2619	`p = TAIL_list(p);`
		2620	`}`
		2621	`last_params[DUMMY_copy] = LINK_NONE;`
2	7u83	2622	`}`
7	7u83	2623	`return (bs);`
2	7u83	2624	`}`
		2625
		2626
		2627	`#endif /* LANGUAGE_CPP */`
		2628	`#endif /* TDF_OUTPUT */`

Subversion Repositories tendra.SVN

(root)/trunk/src/producers/common/output/struct.c – Rev 7