tcl.puma

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

TRAFO	Trafo

PUBLIC	Interpret_tcl

GLOBAL {
# include "Reuse.h"
# include "Position.h"
# include "StringM.h"
# include "Idents.h"
# include "Parser.h"
# include "paf.h"

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

extern	FILE *	cross_ref_fp	;
extern	int	report_local_vars;

static	char	buffer [1024]	;
static	char	args_buffer [1024];
static	int	length		;
static	rbool	need_pass_2	;
static	rbool	in_string	;
static	tTree	genv		;
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;
}

BEGIN {
   yyf		= stdout;
   need_pass_2	= rfalse;
   in_string	= rfalse;
   genv		= NoTree;
}

/**************************************************************/

PROCEDURE Interpret_tcl (Tree)

program (stmts := stmts: stmts (env := env)) :-
   genv := env;
   cur_class_ptr := null; cur_proc_ptr := null;
   get_objects (stmts);					/* pass 1 */
{  if (need_pass_2) {
      cur_class_ptr = null; cur_proc_ptr = null;
      pass2 (stmts);
   }
};
   (cross_ref_fp);
   cur_class_ptr := null; cur_proc_ptr := null;
   pass3 (stmts);
   .

/**************************************************************/

PROCEDURE get_objects (s: Tree)

proc (next := next, env := e, qualification := qualification:
      local_ident (pos := pos, ident := ident),
      param_names := param_names, block := block) :-
   e->env.objects := object (s, ident, e->env.objects);
   dcl (e->env.objects);
   get_objects (next);
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := GetCStr (ident);
   get_param_objects (param_names);
   get_objects (block);
   cur_proc_ptr := prev_proc;
   .
proc (next := next, qualification := qualification:
      global_ident (pos := pos, ident := ident),
      param_names := param_names, block := block) :-
   genv->env.objects := object (s, ident, genv->env.objects);
   dcl (genv->env.objects);
   get_objects (next);
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := GetCStr (ident);
   get_param_objects (param_names);
   get_objects (block);
   cur_proc_ptr := prev_proc;
   .
proc (next := next, qualification := q: local_text (...),
      param_names := param_names, block := block) ;
proc (next := next, qualification := q: global_text (...),
      param_names := param_names, block := block) :-
   get_objects (next);
   prev_proc: tString; prev_proc := cur_proc_ptr;
   cur_proc_ptr := GetCStr (get_ident (q));
   get_param_objects (param_names);
   get_objects (block);
   cur_proc_ptr := prev_proc;
   .
proc (next := next, env := e, qualification := qualification,
      param_names := param_names, block := block) :-
   need_pass_2 := rtrue;
   get_objects (next);					/* pass 2 */
   .
namespace (next := next, env := e, qualification := qualification:
      local_ident (pos := pos, ident := ident), block := blk) :-
   obj: objects; obj := IdentifyLocal (ident, e->env.objects);
{  if (obj != NoTree && obj->object.object->Kind == knamespace) {
      relocate (blk, obj->object.object->namespace.block->texts.env);
      use (obj, pos, PAF_REF_READ);
   } else {
      e->env.objects = mobject (s, ident, e->env.objects);
      dcl (e->env.objects);
   }
};
   get_objects (next);
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (ident);
   get_objects (blk);
   cur_class_ptr := prev_class;
   .
namespace (next := next, qualification := qualification:
      global_ident (pos := pos, ident := ident), block := blk) :-
   obj: objects; obj := IdentifyGlobal (ident);
{  if (obj != NoTree && obj->object.object->Kind == knamespace) {
      relocate (blk, obj->object.object->namespace.block->texts.env);
      use (obj, pos, PAF_REF_READ);
   } else {
      genv->env.objects = mobject (s, ident, genv->env.objects);
      dcl (genv->env.objects);
   }
};
   get_objects (next);
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (ident);
   get_objects (blk);
   cur_class_ptr := prev_class;
   .
namespace (next := next, qualification := q: local_text (...), block := block) ;
namespace (next := next, qualification := q: global_text (...), block := block) :-
   get_objects (next);
   prev_class: tString; prev_class := cur_class_ptr;
   cur_class_ptr := GetCStr (get_ident (q));
   get_objects (block);
   cur_class_ptr := prev_class;
   .
namespace (next := next, qualification := qualification, block := block) :-
   need_pass_2 := rtrue;
   get_objects (next);					/* pass 2 */
   .
stmt (env := env, next := next: stmts, words := words:
      one_word (ident := ident, next := w2: word_c (...))) :-
   add_variables (ident, w2);
   get_objects (words);
   get_objects (next);
   .
stmt (env := env, next := next: stmts, words := words) :-
   get_objects (words);
   get_objects (next);
   .
block (env := env, next := next: texts, pos := pos, stmts := stmts) :-
   get_objects (stmts);
   get_objects (next);
   .
content (env := env, next := next: texts, pos := pos, qualification := qualification: qualification_c) :-
   get_objects (qualification);
   get_objects (next);
   .
block_content (env := env, next := next: texts, pos := pos, stmts := stmts) :-
   get_objects (stmts);
   get_objects (next);
   .
text (env := env, next := next: texts, pos := pos) :-
   get_objects (next);
   .
one_word (env := env, next := next: words, ident := ident, pos := pos) :-
   get_objects (next);
   .
qual_word (env := env, next := next: words, qualification := qualification: qualification_c) :-
   get_objects (qualification);
   get_objects (next);
   .
qual_words (env := env, next := next: words, qualifications := qualifications) :-
   get_objects (qualifications);
   get_objects (next);
   .
one_qualification (env := env, next := next: qualifications, qualification := qualification: qualification_c) :-
   get_objects (qualification);
   get_objects (next);
   .
local_text (pos := pos, env := env, texts := texts) :-
   get_objects (texts);
   .
global_text (pos := pos, env := env, texts := texts) :-
   get_objects (texts);
   .
qualification (pos := pos, env := env, qualification := qualification: qualification_c, ident := ident) :-
   get_objects (qualification);
   .
complex_qual (pos := pos, env := env, qualification := qualification: qualification_c, texts := texts) :-
   get_objects (qualification);
   get_objects (texts);
   .
subscription (pos := pos, env := env, qualification := qualification: qualification_c, index := index: qualification_c) :-
   get_objects (qualification);
   get_objects (index);
   .

/**************************************************************/

PROCEDURE get_param_objects (s: words)

one_word (next := next, env := e, ident := ident, pos := pos) :-
   e->env.objects := object (s, ident, e->env.objects);
   dcl (e->env.objects);
   get_param_objects (next);
   .
word_c (next := next) :-
   get_param_objects (next);				/* ignore garbage */
   .

/**************************************************************/

PROCEDURE add_variables (tIdent, word_c)

(iset), w2: word_c (next := noword (...)) :-		/* set r	*/
   add_var (w2, PAF_REF_READ);
   .
(iset), w2 :-						/* set w x	*/
   add_var (w2, PAF_REF_WRITE);
   .
(iglobal), w2 :-					/* global d ...	*/
   add_global_vars (w2);
   .
(ivariable), w2: word_c (next := noword (...)) :-	/* variable d	*/
   add_variable_vars (w2, PAF_REF_READ);
   .
(ivariable), w2 :-					/* variable w x ... */
   add_variable_vars (w2, PAF_REF_WRITE);
   .
(iappend), w2 :-					/* append w	*/
   add_var (w2, PAF_REF_WRITE);
   .
(ilappend), w2 :-					/* lappend w	*/
   add_var (w2, PAF_REF_WRITE);
   .
(iarray), w2: one_word (ident := (iset), next :=	/* array set w	*/
   w3: word_c (...)) :-
   add_var (w3, PAF_REF_WRITE);
   .
(iarray), w2: word_c (next := w3: word_c (...)) :-	/* array x r	*/
   add_var (w3, PAF_REF_READ);
   .
(ibinary), w2: one_word (ident := (iscan), next :=   /* binary scan x x w ... */
   w3: word_c (next :=
   w4: word_c (next :=
   w5: word_c (...)))) :-
   add_vars (w5, PAF_REF_WRITE);
   .
(iscan), w2: word_c (next :=				/* scan x x w ... */
   w3: word_c (next :=
   w4: word_c (...))) :-
   add_vars (w4, PAF_REF_WRITE);
   .
(iforeach), w2 :-					/* foreach */
   add_foreach_vars (w2);
   .
(ivwait), w2 :-						/* vwait r	*/
   add_var (w2, PAF_REF_READ);
   .
(iincr), w2 :-						/* incr w	*/
   add_var (w2, PAF_REF_WRITE);
   .
(iparray), w2 :-					/* parray r	*/
   add_var (w2, PAF_REF_READ);
   .
(icatch), w2: word_c (next := w3: word_c (...)) :-	/* catch x w	*/
   add_var (w3, PAF_REF_WRITE);
   .
(igets), w2: word_c (next := w3: word_c (...)) :-	/* gets x w	*/
   add_var (w3, PAF_REF_WRITE);
   .
(iinfo), w2: one_word (ident := (iexists), next :=	/* info exists r */
   w3: word_c (...)) :-
   add_var (w3, PAF_REF_READ);
   .
(iinfo), w2: one_word (ident := (iargs), next :=	/* info args r */
   w3: word_c (...)) :-
   add_var (w3, PAF_REF_READ);
   .
(iinfo), w2: one_word (ident := (ibody), next :=	/* info body r */
   w3: word_c (...)) :-
   add_var (w3, PAF_REF_READ);
   .
(iinfo), w2: one_word (ident := (idefault), next :=	/* info default r x w */
   w3: word_c (next :=
   w4: word_c (next :=
   w5: word_c (...)))) :-
   add_var (w3, PAF_REF_READ);
   add_var (w5, PAF_REF_WRITE);
   .
(itkinfo), w2: one_word (ident := (ivariable), next :=	/* tkinfo variable r */
   w3: word_c (...)) :-
   add_var (w3, PAF_REF_READ);
   .
(ifile), w2: one_word (ident := (ilstat), next :=	/* file lstat x w */
   w3: word_c (next :=
   w4: word_c (...))) :-
   add_var (w4, PAF_REF_WRITE);
   .
(ifile), w2: one_word (ident := (istat), next :=	/* file stat x w */
   w3: word_c (next :=
   w4: word_c (...))) :-
   add_var (w4, PAF_REF_WRITE);
   .
(iunset), w2 :-						/* unset w ...	*/
   add_vars (w2, PAF_REF_WRITE);
   .
/*
(irename), w2 :-					/* rename r	/*
   add_var (w2, PAF_REF_READ);
   .
*/
(isource), w2: word_c (next := noword (...)) :-		/* source filename */
   include (w2);
   .

/**************************************************************/

PROCEDURE include (word_c)

one_word (env := env, ident := ident, pos := pos) :-
   put_symbol (PAF_INCLUDE_DEF, NIL, GetCStr (ident), current_file,
      (int) pos.Line, (int) pos.Column - 1,
      (int) pos.Line, (int) (pos.Column + StLength (GetStringRef (ident)) - 1),
      0, NIL, NIL, NIL, NIL, 0, 0, 0, 0);
   .
qual_word (env := env, qualification := qualification) :-
   .
qual_words (env := env, qualifications := qualifications) :-
   .

/**************************************************************/

PROCEDURE add_global_vars (w: words)

/*
one_word (ident := ident, env := e, pos := pos, next := next) :-
   obj: objects; obj := IdentifyGlobal (ident);
   obj != NIL;
   use (obj, pos, PAF_REF_READ);
   e->env.objects := object (obj->object.object, ident, e->env.objects);
   add_global_vars (next);
   .
*/
one_word (ident := ident, env := e, pos := pos, next := next) :-
   genv->env.objects := object (w, ident, genv->env.objects);
   e->env.objects := object (w, ident, e->env.objects);
   e := genv;
   dcl (genv->env.objects);
   add_global_vars (next);
   .
/*
qual_word (env := e, qualification :=
      global_ident (pos := pos, ident := ident), next := next) :-
   obj: objects; obj := IdentifyGlobal (ident);
   obj != NIL;
   use (obj, pos, PAF_REF_READ);
   e->env.objects := object (obj->object.object, ident, e->env.objects);
   add_global_vars (next);
   .
*/
qual_word (qualification :=
      g: global_ident (env := e, pos := pos, ident := ident), next := next) :-
   genv->env.objects := object (g, ident, genv->env.objects);
   e->env.objects := object (g, ident, e->env.objects);
   e := genv;
   dcl (e->env.objects);
   add_global_vars (next);
   .
qual_word (next := next) ;
qual_words (next := next) :-
   add_global_vars (next);			/* crazy: ignore it */
   .

/**************************************************************/

PROCEDURE add_variable_vars (w: [words, qualification_c], acc: int)

LOCAL { tTree obj, e2; }

one_word (ident := ident, env := e: env (object := object), pos := pos, next := next), _ :-
   object->Kind != kproc;
   e->env.objects := object (w, ident, e->env.objects);
   dcl (e->env.objects);
{  if (acc == PAF_REF_WRITE) use (e->env.objects, pos, acc); };