itcl.c

这是一个Linux下的集成开发环境

/*

Copyright (c) 2000, Red Hat, Inc.

This file is part of Source-Navigator.

Source-Navigator is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as published
by the Free Software Foundation; either version 2, or (at your option)
any later version.

Source-Navigator is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License along
with Source-Navigator; see the file COPYING.  If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
MA 02111-1307, USA.



*/

#include "itcl.h"
#ifdef __cplusplus
extern "C" {
#include "General.h"
#include "rSystem.h"
}
#else
#include "General.h"
#include "rSystem.h"
#endif
#include <stdio.h>
#include "Tree.h"

#define yyInline
#ifndef NULL
#define NULL 0L
#endif
#ifndef rfalse
#define rfalse 0
#endif
#ifndef rtrue
#define rtrue 1
#endif

#ifdef yyInline
#define yyALLOC(tree, free, start, alloc, type, make, ptr, kind, init) \
  ptr = (free -= yyAlignedSize (sizeof (type))) >= start ? \
   (tree) free : alloc (sizeof (type)); \
  init (ptr, kind);
#else
#define yyALLOC(tree, free, start, alloc, type, make, ptr, kind, init) \
  ptr = make (kind);
#endif

/* line 5 "itcl.puma" */

#include "Reuse.h"
#include "Position.h"
#include "StringM.h"
#include "Idents.h"
#include "Parser.h"
#include "Eval.h"
#include "sn.h"

#define null		(char *) NULL
#define scope_type(cur_class) cur_class ? PAF_MBR_FUNC_DEF : PAF_FUNC_DEF
#define default_attr	PAF_PUBLIC

extern	FILE *	cross_ref_fp	;
extern	int	report_local_vars;

static	tIdent
		iat_scope	,
		iclass		,
		icommon		,
		iconfigbody	,
		iconstructor	,
		idestructor	,
		idelete		,
		ihash_auto	,
		iinherit	,
		iisa		,
		iitcl		,
		iitcl_class	,
		iitcl_info	,
		iitk		,
		iiwidgets	,
		ilocal		,
		imethod		,
		iobject		,
		iobjects	,
		iprevious	,
		iprivate	,
		iprotected	,
		ipublic		,
		ithis		,
		ivirtual	;

static	char	buffer [1024]	;
static	char	args_buffer [1500];
static	int	length		;
static	rbool	need_pass_2	;
static	rbool	in_string	;
static	tPosition gpos		;
static	tTree	genv, predef	;
static	char *	p		;
static	char *	current_ident	;
static	char *	current_class	;
static	char *	cur_proc_ptr	= NULL;
static	char *	cur_class_ptr	= NULL;
static	char *	cur_arg_types_ptr = NULL;

static tIdent MakeID
#if defined __STDC__ | defined __cplusplus
(char * s)
#else
(s)
 char * s;
#endif
{
   return MakeIdent (s, strlen (s));
}


#ifndef yyWrite
#define yyWrite(s) (void) fputs (s, yyf)
#endif
#ifndef yyWriteNl
#define yyWriteNl (void) fputc ('\n', yyf)
#endif

#include "yyitcl.h"

static void yyExit ARGS ((void)) { rExit (1); }

void (* itcl_Exit) ARGS ((void)) = yyExit;

#ifdef UNIX
static FILE * yyf = stdout;
#else
static FILE * yyf;
#endif

static void yyAbort
#ifdef __cplusplus
 (char * yyFunction)
#else
 (yyFunction) char * yyFunction;
#endif
{
 (void) fprintf (stderr, "Error: module itcl, routine %s failed\n",
  yyFunction);
 itcl_Exit ();
}

void Interpret_itcl ARGS ((tTree yyP1));
static void get_objects ARGS ((tTree s));
static void get_param_objects ARGS ((tTree s));
static void add_variables ARGS ((tIdent yyP3, tTree yyP2, int attr));
static void include ARGS ((tTree yyP4));
static void add_global_vars ARGS ((tTree w));
static void add_variable_vars ARGS ((tTree w, int acc, int attr));
static void add_vars ARGS ((tTree yyP5, int acc));
static void add_foreach_vars ARGS ((tTree yyP6));
static void add_var ARGS ((tTree w, int acc, int attr));
static void add_var_2 ARGS ((tIdent i, tPosition pos, tTree w, tTree e, int acc, int attr));
static tTree IdentifyLocal ARGS ((tIdent i, tTree o));
static tTree IdentifyGlobal ARGS ((tIdent yyP7));
static tTree Identify ARGS ((tIdent yyP9, tTree yyP8));
static tTree IdentifyMember ARGS ((tIdent yyP11, tTree yyP10));
static tTree IdentifySuper ARGS ((tIdent yyP13, tTree yyP12));
static tTree IdentifyVariable ARGS ((tIdent yyP15, tTree yyP14));
static tTree IdentifyProcLocal ARGS ((tIdent i, tTree o));
static tTree IdentifyProcGlobal ARGS ((tIdent yyP16));
static tTree IdentifyProc ARGS ((tIdent yyP18, tTree yyP17));
static tTree IdentifyProcMember ARGS ((tIdent yyP20, tTree yyP19));
static tTree IdentifyProcSuper ARGS ((tIdent yyP22, tTree yyP21));
static tTree get_namespace ARGS ((tTree yyP23));
static void pass2 ARGS ((tTree t));
static void pass3 ARGS ((tTree yyP24));
tIdent make_one_word ARGS ((tTree yyP25));
static void make_one_word_2 ARGS ((tTree yyP26));
tTree Mword ARGS ((tTree yyP28, tTree yyP27));
tTree Mqualification ARGS ((tTree yyP29));
tTree Mstmt ARGS ((tTree yyP31, tTree yyP30));
static tTree Mstmt_1 ARGS ((tTree yyP33, tTree yyP32, int attr));
static tTree Mstmt_2 ARGS ((tTree yyP36, tIdent yyP35, tTree yyP34, int attr));
tTree Mblock_content ARGS ((tPosition yyP39, tPosition yyP38, tTree yyP37));
static tTree make_qualification ARGS ((tTree yyP40));
static tTree param_names ARGS ((tTree yyP41));
static tTree param_names_2 ARGS ((tTree yyP43, tTree yyP42));
static tTree param_names_3 ARGS ((tTree yyP45, tTree yyP44));
static tTree param_names_4 ARGS ((tTree yyP47, tTree yyP46));
static void get_end_pos ARGS ((tTree yyP48, tPosition * yyP49));
static void get_begin_pos ARGS ((tTree yyP50, tPosition * yyP51));
static void get_end_pos_2 ARGS ((tTree yyP52, tPosition * yyP53));
static rbool get_script ARGS ((tTree yyP54, tTree * yyP56, tPosition * yyP55));
static void itcl_info ARGS ((tTree yyP57));
static tTree get_env ARGS ((tTree yyP58));
static tTree get_env_2 ARGS ((tTree yyP59));
static tIdent get_ident ARGS ((tTree yyP60));
static void add_qualifications ARGS ((tIdent yyP62, tTree yyP61, int attr));
static void inherit_var ARGS ((tTree w));
static void inherit_var_2 ARGS ((tIdent yyP66, tPosition yyP65, tTree yyP64, tTree yyP63));
static void add_variable_quals ARGS ((tTree yyP67, int acc, int attr));
static void add_quals ARGS ((tTree yyP68, int acc));
static void add_foreach_quals ARGS ((tTree yyP69));
static void add_qual ARGS ((tTree w, int acc));
static void add_qual_2 ARGS ((tTree w, int acc));
static tTree use_qual ARGS ((tTree yyP70));
static tTree use_proc_qual ARGS ((tTree yyP71));
static tTree use_proc ARGS ((tTree yyP72));
static tTree use_word ARGS ((tTree yyP73));
static void use ARGS ((tTree yyP74, tPosition p, int acc));
static void use_2 ARGS ((tTree env, tPosition pos, int acc));
static void use_undef ARGS ((tIdent ident, tPosition pos));
static void use_proc_undef ARGS ((tIdent ident, tPosition pos));
static void dcl ARGS ((tTree yyP75, int attr));
static void dcl_2 ARGS ((tTree env, tPosition pos, int attr));
static tString current_namespace ARGS ((tTree yyP76));
static tString get_class ARGS ((tTree yyP77));
static tString get_class_name ARGS ((tTree yyP78));
static void to_names ARGS ((tTree yyP80, tString yyP79));
static void get_names ARGS ((tTree yyP81));
static void get_separator ARGS ((tTree yyP82));
static void relocate ARGS ((tTree yyP83, tTree new_env));
static tTree declare_object ARGS ((tTree yyP85, tTree yyP84));
static void use_proc_object ARGS ((tTree yyP87, tTree yyP86));
static void get_pos ARGS ((tTree yyP88, tPosition * yyP89));
static long add_attr ARGS ((tTree yyP90));

void Interpret_itcl
#if defined __STDC__ | defined __cplusplus
(register tTree yyP1)
#else
(yyP1)
 register tTree yyP1;
#endif
{
  if (yyP1->Kind == kprogram) {
  if (yyP1->program.stmts->stmts.env->Kind == kenv) {
/* line 187 "itcl.puma" */
  {
/* line 188 "itcl.puma" */
   yyP1->program.stmts->stmts.env->env.objects = genv;
/* line 189 "itcl.puma" */
   genv = yyP1->program.stmts->stmts.env;
/* line 190 "itcl.puma" */
   cur_class_ptr = null;
/* line 190 "itcl.puma" */
   cur_proc_ptr = null;
/* line 191 "itcl.puma" */
   get_objects (yyP1->program.stmts);
/* line 192 "itcl.puma" */
  if (need_pass_2) {
      cur_class_ptr = null; cur_proc_ptr = null;
      pass2 (yyP1->program.stmts);
   }

/* line 197 "itcl.puma" */
   cur_class_ptr = null;
/* line 197 "itcl.puma" */
   cur_proc_ptr = null;
/* line 198 "itcl.puma" */
   pass3 (yyP1->program.stmts);
  }
   return;

  }
  }
;
}

static void get_objects
#if defined __STDC__ | defined __cplusplus
(register tTree s)
#else
(s)
 register tTree s;
#endif
{
 yyRecursion:

  switch (s->Kind) {
  case kproc_c:
  case kproc:
  case kmethod:
  case kbody:
  case kconfigbody:
  case kconstructor:
  case kdestructor:
  if (s->proc_c.qualification->Kind == klocal_ident) {
/* line 205 "itcl.puma" */
 {
  register tTree yyV1;
  tString prev_proc;
  {
/* line 208 "itcl.puma" */
   yyALLOC (tTree,Tree_PoolFreePtr,Tree_PoolStartPtr,
    Tree_Alloc,yobject,MakeTree,yyV1,kobject,Tree_InitHead)
    yyV1->object.object = s;
    yyV1->object.ident = s->proc_c.qualification->local_ident.ident;
    yyV1->object.next = s->proc_c.env -> env . objects;
   s->proc_c.env -> env . objects = yyV1;
/* line 209 "itcl.puma" */
   dcl (s->proc_c.env -> env . objects, s->proc_c.attribute);
/* line 210 "itcl.puma" */
   get_objects (s->proc_c.next);
/* line 211 "itcl.puma" */

/* line 211 "itcl.puma" */
   prev_proc = cur_proc_ptr;
/* line 212 "itcl.puma" */
   cur_proc_ptr = GetCStr (s->proc_c.qualification->local_ident.ident);
/* line 213 "itcl.puma" */
   get_param_objects (s->proc_c.param_names);
/* line 214 "itcl.puma" */
   get_objects (s->proc_c.block);
/* line 215 "itcl.puma" */
   cur_proc_ptr = prev_proc;
  }
   return;
 }

  }
  if (s->proc_c.qualification->Kind == kglobal_ident) {
/* line 217 "itcl.puma" */
 {
  register tTree yyV1;
  tString prev_proc;
  {
/* line 220 "itcl.puma" */
   yyALLOC (tTree,Tree_PoolFreePtr,Tree_PoolStartPtr,
    Tree_Alloc,yobject,MakeTree,yyV1,kobject,Tree_InitHead)
    yyV1->object.object = s;
    yyV1->object.ident = s->proc_c.qualification->global_ident.ident;
    yyV1->object.next = genv -> env . objects;
   genv -> env . objects = yyV1;
/* line 221 "itcl.puma" */
   dcl (genv -> env . objects, s->proc_c.attribute);
/* line 222 "itcl.puma" */
   get_objects (s->proc_c.next);
/* line 223 "itcl.puma" */

/* line 223 "itcl.puma" */
   prev_proc = cur_proc_ptr;
/* line 224 "itcl.puma" */
   cur_proc_ptr = GetCStr (s->proc_c.qualification->global_ident.ident);
/* line 225 "itcl.puma" */
   get_param_objects (s->proc_c.param_names);
/* line 226 "itcl.puma" */
   get_objects (s->proc_c.block);
/* line 227 "itcl.puma" */
   cur_proc_ptr = prev_proc;
  }
   return;
 }

  }
  if (s->proc_c.qualification->Kind == klocal_text) {
/* line 229 "itcl.puma" */
 {
  tString prev_proc;
  {
/* line 233 "itcl.puma" */
   get_objects (s->proc_c.next);
/* line 234 "itcl.puma" */

/* line 234 "itcl.puma" */
   prev_proc = cur_proc_ptr;
/* line 235 "itcl.puma" */
   cur_proc_ptr = GetCStr (get_ident (s->proc_c.qualification));
/* line 236 "itcl.puma" */
   get_param_objects (s->proc_c.param_names);
/* line 237 "itcl.puma" */
   get_objects (s->proc_c.block);
/* line 238 "itcl.puma" */
   cur_proc_ptr = prev_proc;
  }
   return;
 }

  }
  if (s->proc_c.qualification->Kind == kglobal_text) {
/* line 229 "itcl.puma" */
 {
  tString prev_proc;
  {
/* line 233 "itcl.puma" */
   get_objects (s->proc_c.next);
/* line 234 "itcl.puma" */

/* line 234 "itcl.puma" */
   prev_proc = cur_proc_ptr;
/* line 235 "itcl.puma" */
   cur_proc_ptr = GetCStr (get_ident (s->proc_c.qualification));
/* line 236 "itcl.puma" */
   get_param_objects (s->proc_c.param_names);
/* line 237 "itcl.puma" */
   get_objects (s->proc_c.block);
/* line 238 "itcl.puma" */
   cur_proc_ptr = prev_proc;
  }
   return;
 }

  }
/* line 240 "itcl.puma" */
  {
/* line 241 "itcl.puma" */
   need_pass_2 = rtrue;
/* line 242 "itcl.puma" */
   s = s->proc_c.next;
   goto yyRecursion;
  }

  case knamespace:
  if (s->namespace.qualification->Kind == klocal_ident) {
/* line 244 "itcl.puma" */
 {
  tTree obj;
  tString prev_class;
  {
/* line 247 "itcl.puma" */

/* line 247 "itcl.puma" */
   obj = IdentifyLocal (s->namespace.qualification->local_ident.ident, s->namespace.env -> env . objects);
/* line 248 "itcl.puma" */
  if (obj != NoTree && obj->object.object->Kind == knamespace) {
      relocate (s->namespace.block, obj->object.object->namespace.block->texts.env);
      use (obj, s->namespace.qualification->local_ident.pos, PAF_REF_READ);
   } else {
      s->namespace.env->env.objects = mobject (s, s->namespace.qualification->local_ident.ident, s->namespace.env->env.objects);
      dcl (s->namespace.env->env.objects, s->namespace.attribute);
   }

/* line 256 "itcl.puma" */
   get_objects (s->namespace.next);
/* line 257 "itcl.puma" */

/* line 257 "itcl.puma" */
   prev_class = cur_class_ptr;
/* line 258 "itcl.puma" */
   cur_class_ptr = GetCStr (s->namespace.qualification->local_ident.ident);
/* line 259 "itcl.puma" */
   get_objects (s->namespace.block);
/* line 260 "itcl.puma" */
   cur_class_ptr = prev_class;
  }
   return;
 }

  }
  if (s->namespace.qualification->Kind == kglobal_ident) {
/* line 262 "itcl.puma" */
 {
  tTree obj;
  tString prev_class;
  {
/* line 265 "itcl.puma" */

/* line 265 "itcl.puma" */
   obj = IdentifyGlobal (s->namespace.qualification->global_ident.ident);
/* line 266 "itcl.puma" */
  if (obj != NoTree && obj->object.object->Kind == knamespace) {
      relocate (s->namespace.block, obj->object.object->namespace.block->texts.env);
      use (obj, s->namespace.qualification->global_ident.pos, PAF_REF_READ);
   } else {
      genv->env.objects = mobject (s, s->namespace.qualification->global_ident.ident, genv->env.objects);
      dcl (genv->env.objects, s->namespace.attribute);
   }

/* line 274 "itcl.puma" */
   get_objects (s->namespace.next);
/* line 275 "itcl.puma" */

/* line 275 "itcl.puma" */
   prev_class = cur_class_ptr;
/* line 276 "itcl.puma" */
   cur_class_ptr = GetCStr (s->namespace.qualification->global_ident.ident);
/* line 277 "itcl.puma" */
   get_objects (s->namespace.block);
/* line 278 "itcl.puma" */
   cur_class_ptr = prev_class;
  }
   return;
 }

  }
  if (s->namespace.qualification->Kind == klocal_text) {
/* line 280 "itcl.puma" */
 {
  tString prev_class;
  {
/* line 282 "itcl.puma" */
   get_objects (s->namespace.next);
/* line 283 "itcl.puma" */

/* line 283 "itcl.puma" */
   prev_class = cur_class_ptr;
/* line 284 "itcl.puma" */
   cur_class_ptr = GetCStr (get_ident (s->namespace.qualification));
/* line 285 "itcl.puma" */
   get_objects (s->namespace.block);
/* line 286 "itcl.puma" */
   cur_class_ptr = prev_class;
  }
   return;
 }

  }
  if (s->namespace.qualification->Kind == kglobal_text) {
/* line 280 "itcl.puma" */
 {
  tString prev_class;
  {
/* line 282 "itcl.puma" */
   get_objects (s->namespace.next);
/* line 283 "itcl.puma" */

/* line 283 "itcl.puma" */
   prev_class = cur_class_ptr;
/* line 284 "itcl.puma" */
   cur_class_ptr = GetCStr (get_ident (s->namespace.qualification));
/* line 285 "itcl.puma" */
   get_objects (s->namespace.block);
/* line 286 "itcl.puma" */
   cur_class_ptr = prev_class;
  }
   return;
 }

  }
/* line 288 "itcl.puma" */
  {
/* line 289 "itcl.puma" */
   need_pass_2 = rtrue;
/* line 290 "itcl.puma" */
   s = s->namespace.next;
   goto yyRecursion;
  }

  case kclass:
  if (s->class.qualification->Kind == klocal_ident) {
/* line 292 "itcl.puma" */
 {
  tTree obj;
  tString prev_class;
  {
/* line 298 "itcl.puma" */

/* line 298 "itcl.puma" */
   obj = IdentifyLocal (s->class.qualification->local_ident.ident, s->class.env -> env . objects);
/* line 299 "itcl.puma" */
  if (obj != NoTree && Tree_IsType (obj->object.object, knamespace_c)) {
      relocate (s->class.block, obj->object.object->class.block->texts.env);
      use (obj, s->class.qualification->local_ident.pos, PAF_REF_READ);
   } else {
      s->class.env->env.objects = mobject (s, s->class.qualification->local_ident.ident, s->class.env->env.objects);
      dcl (s->class.env->env.objects, s->class.attribute);
   }