~ubuntu-branches/ubuntu/trusty/mit-scheme/trusty-proposed

« back to all changes in this revision

Viewing changes to src/microcode/comutl.c

  • Committer: Bazaar Package Importer
  • Author(s): Soren Hansen
  • Date: 2007-05-09 10:57:57 UTC
  • mfrom: (1.1.5 upstream)
  • Revision ID: james.westby@ubuntu.com-20070509105757-p8focimovgqxaaed
Tags: 7.7.90+20070205-1ubuntu1
* Merge from debian unstable, remaining changes:
  * Bootstrapping done via supplied binary package. See log entry for
    7.7.90+20060906-3ubuntu1 for details.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
1
/* -*-C-*-
2
2
 
3
 
$Id: comutl.c,v 1.33 2003/02/14 18:28:18 cph Exp $
 
3
$Id: comutl.c,v 1.37 2007/01/12 03:45:55 cph Exp $
4
4
 
5
 
Copyright (c) 1987-1999 Massachusetts Institute of Technology
 
5
Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
 
6
    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
 
7
    2006, 2007 Massachusetts Institute of Technology
6
8
 
7
9
This file is part of MIT/GNU Scheme.
8
10
 
18
20
 
19
21
You should have received a copy of the GNU General Public License
20
22
along with MIT/GNU Scheme; if not, write to the Free Software
21
 
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
 
23
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
22
24
USA.
23
25
 
24
26
*/
143
145
  if (result == ((char *) NULL))
144
146
    PRIMITIVE_RETURN (SHARP_F);
145
147
  else
146
 
    PRIMITIVE_RETURN (char_pointer_to_string ((unsigned char *) result));
 
148
    PRIMITIVE_RETURN (char_pointer_to_string (result));
147
149
}
148
150
 
149
151
DEFINE_PRIMITIVE ("BUILTIN-INDEX->NAME", Prim_builtin_index_to_name, 1, 1,
157
159
  if (result == ((char *) NULL))
158
160
    PRIMITIVE_RETURN (SHARP_F);
159
161
  else
160
 
    PRIMITIVE_RETURN (char_pointer_to_string ((unsigned char *) result));
 
162
    PRIMITIVE_RETURN (char_pointer_to_string (result));
161
163
}
162
164
 
163
165
/* This is only meaningful for the C back end. */
167
169
  "Given the tag of a compiled object, return the object.")
168
170
{
169
171
#ifdef NATIVE_CODE_IS_C
170
 
  extern SCHEME_OBJECT * EXFUN (initialize_C_compiled_block, (int, char *));
171
 
  SCHEME_OBJECT * block, val;
172
 
  
173
 
  block = (initialize_C_compiled_block (1, (STRING_ARG (1))));
174
 
  val = ((block == ((SCHEME_OBJECT *) NULL))
175
 
         ? SHARP_F
176
 
         : (MAKE_POINTER_OBJECT (TC_COMPILED_ENTRY, block)));
 
172
  extern SCHEME_OBJECT EXFUN (initialize_C_compiled_block, (int, char *));
 
173
  SCHEME_OBJECT val;
 
174
 
 
175
  val = (initialize_C_compiled_block (1, (STRING_ARG (1))));
177
176
  PRIMITIVE_RETURN (val);
178
177
#else
179
178
  PRIMITIVE_RETURN (SHARP_F);