Subversion Repositories tendra.SVN

Rev

Rev 2 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 2 Rev 7
Line -... Line 1...
- 
 
 1 
/*
- 
 
 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 
 */
1 
/*
 31 
/*
2 
    		 Crown Copyright (c) 1997
 32 
    		 Crown Copyright (c) 1997
3 
 
 33 
 
4 
    This TenDRA(r) Computer Program is subject to Copyright
 34 
    This TenDRA(r) Computer Program is subject to Copyright
5 
    owned by the United Kingdom Secretary of State for Defence
 35 
    owned by the United Kingdom Secretary of State for Defence
Line 66... Line 96...
66 
/************************************************************************
 96 
/************************************************************************
67 
  Make an exp representing the contents of an external tag with
 97 
  Make an exp representing the contents of an external tag with
68 
  name n of shape s and variable if v.
 98 
  name n of shape s and variable if v.
69 
 ************************************************************************/
 99 
 ************************************************************************/
70 
 
 100 
 
71 
exp make_extn
 101 
exp
72 
    PROTO_N ( ( n, s, v ) )
 - 
 
73 
    PROTO_T ( char* n X shape s X int v )
 102 
make_extn(char* n, shape s, int v)
74 
{
 103 
{
75 
  dec * g = alloc_nof ( dec, 1 ) ;
 104 
	dec * g = alloc_nof(dec, 1);
76 
  exp id = getexp (s, 0, 1, 0, 0, 0, 0, ident_tag);
 105 
	exp id = getexp(s, 0, 1, 0, 0, 0, 0, ident_tag);
77 
  exp nme = getexp (s, 0, 1, id, 0, 0, 0, name_tag);
 106 
	exp nme = getexp(s, 0, 1, id, 0, 0, 0, name_tag);
78 
  setglob (id);
 107 
	setglob(id);
79 
  if (v) {
 108 
	if (v) {
80 
     setvar(id);
 109 
		setvar(id);
81 
  }
 110 
	}
82 
  brog(id) = g;
 111 
	brog(id) = g;
83 
  g -> dec_u.dec_val.dec_exp = id;
 112 
	g -> dec_u.dec_val.dec_exp = id;
84 
  g -> dec_u.dec_val.dec_id = n;
 113 
	g -> dec_u.dec_val.dec_id = n;
85 
  g -> dec_u.dec_val.extnamed = 1;
 114 
	g -> dec_u.dec_val.extnamed = 1;
86 
  return (nme);
 115 
	return (nme);
87 
}
 116 
}
88 
 
 117 
 
89 
/************************************************************************
 118 
/************************************************************************
90 
  Make an exp representing a dummy double destination used to force a
 119 
  Make an exp representing a dummy double destination used to force a
91 
  floating point overflow (if any) for expression with zero destination.
 120 
  floating point overflow (if any) for expression with zero destination.
92 
 ************************************************************************/
 121 
 ************************************************************************/
- 
 
 122 
exp
93 
exp get_dummy_double_dest
 123 
get_dummy_double_dest(void)
94 
    PROTO_Z ()
 - 
 
95 
{
 124 
{
96 
   return (make_extn("___m68k_dummy_double", doublesh, 1));
 125 
	return (make_extn("___m68k_dummy_double", doublesh, 1));
97 
}
 126 
}
98 
 
 127 
 
99 
 
 128 
 
100 
/************************************************************************
 129 
/************************************************************************
101 
  Make an exp representing the stack limit
 130 
  Make an exp representing the stack limit
102 
 ************************************************************************/
 131 
 ************************************************************************/
- 
 
 132 
exp
103 
exp get_stack_limit
 133 
get_stack_limit(void)
104 
    PROTO_Z ()
 - 
 
105 
{
 134 
{
106 
   return make_extn ("___m68k_stack_limit", ulongsh, 1);
 135 
	return make_extn("___m68k_stack_limit", ulongsh, 1);
107 
}
 136 
}
108 
 
 137 
 
109 
/************************************************************************
 138 
/************************************************************************
110 
  Make an exp representing the error handler
 139 
  Make an exp representing the error handler
111 
 ************************************************************************/
 140 
 ************************************************************************/
- 
 
 141 
exp
112 
exp get_error_handler
 142 
get_error_handler(void)
113 
    PROTO_Z ()
 - 
 
114 
{
 143 
{
115 
   return make_extn ("___m68k_errhandler", ulongsh, 1);
 144 
	return make_extn("___m68k_errhandler", ulongsh, 1);
116 
}
 145 
}
117 
/************************************************************************
 146 
/************************************************************************
118 
  Make an exp representing env_size
 147 
  Make an exp representing env_size
119 
 ************************************************************************/
 148 
 ************************************************************************/
120 
exp get_env_size
 149 
exp
121 
    PROTO_N ( ( decl ) )
 - 
 
122 
    PROTO_T ( dec *decl )
 150 
get_env_size(dec *decl)
123 
{
 151 
{
124 
   /* allocate space for 10 digits 2 prefix characters and a null */
 152 
	/* allocate space for 10 digits 2 prefix characters and a null */
125 
   char* lab_name = alloc_nof ( char, 13 ) ;
 153 
	char* lab_name = alloc_nof(char, 13);
126 
   sprintf(lab_name, "#%c%lu", LPREFIX, (unsigned long) decl);
 154 
	sprintf(lab_name, "#%c%lu", LPREFIX,(unsigned long)decl);
127 
   return make_extn (lab_name, ulongsh, 1);
 155 
	return make_extn(lab_name, ulongsh, 1);
128 
}
 156 
}
129 
 
 157