Skip to content

R
riscv-gcc-1
Commit 53a54647 by Arnaud Charlet
Options

Removed, no longer used. 

From-SVN: r101073
parent 84fdd8a3
Showing with 0 additions and 916 deletions
gcc/ada/Makefile.generic deleted 100644 → 0
# Generic Makefile to support compilation for multiple languages.
# See also Makefile.prolog
#
# Copyright (C) 2001-2004 Free Software Foundation, Inc.
# This file is part of GCC.
# GCC 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.
# GCC 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 GCC; see the file COPYING. If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
# This Makefile provides a very generic framework of the following
# functionalities:
#
# Multi-language support (currently any combination of Ada/C/C++ supported)
# Automatic handling of source dependencies
# Handling of various C/C++ compilers
# Handling of Ada sources using the GNAT toolchain
# Complete build process (compile/bind/link)
# Individual compilation (on a file, or on a language)
# Handling of an object directory
# Here are the rules that can be used from the command line:
#
# build: complete compile/bind/link process
# compile: compile all files that are not up-to-date
# link: bind/link
# ada: compile all Ada files that are not up-to-date
# c: ditto for C files
# c++: ditto for C++ files
# <ada file>: compile the specified file if needed.
# <object file>: compile the corresponding C/C++ source file if needed.
# clean: remove all temporary files
# This Makefile expects the following variables to be set by the caller
# (typically another Makefile):
#
# ADA_SPEC extension of Ada spec files (optional, default to .ads)
# ADA_BODY extension of Ada body files (optional, default to .adb)
# C_EXT extension of C files (optional, default to .c)
# CXX_EXT extension of C++ files (optional, default to .cc)
# OBJ_EXT extension of object files (optional, default to .o)
# SRC_DIRS blank separated list of source directories
# C_SRCS explicit list of C sources (optional)
# C_SRCS_DEFINED if set, indicates that C_SRCS is already set
# CXX_SRCS explicit list of C++ sources (optional)
# CXX_SRCS_DEFINED is set, indicates that CXX_SRCS is already set
# OBJ_DIR a single directory where object files should be put
# EXEC_DIR a single directory where executables should be put (optional)
# LANGUAGES a blank separated list of languages supported, e.g "ada c"
# the current list of recognized languages is: ada, c, c++
# CC name of the C compiler (optional, default to gcc)
# CXX name of the C++ compiler (optional, default to gcc)
# AR_CMD command to create an archive (optional, default to "ar rc")
# AR_EXT file extension of an archive (optional, default to ".a")
# RANLIB command to generate an index (optional, default to "ranlib")
# GNATMAKE name of the GNAT builder (optional, default to "gnatmake")
# ADAFLAGS additional Ada compilation switches, e.g "-gnatf" (optional)
# CFLAGS default C compilation switches, e.g "-O2 -g" (optional)
# CXXFLAGS default C++ compilation switches (optional)
# LIBS libraries to link with (optional)
# LDFLAGS linker switches (optional)
# ADA_SOURCES list of main Ada sources (optional)
# EXEC name of the final executable (optional)
# MAIN language of the main program (optional)
# MAIN_OBJECT main object file (optional)
# PROJECT_FILE name of the project file, without the .gpr extension
# DEPS_PROJECTS list of project dependencies (optional)
# SILENT (optional) when defined, make -s will not output anything
# when all commands are successful.
# Set the source search path for C and C++ if needed
ifndef MAIN
MAIN=ada
endif
ifndef ADA_SPEC
ADA_SPEC=.ads
endif
ifndef ADA_BODY
ADA_BODY=.adb
endif
ifndef CC
CC=gcc
endif
ifndef CXX
CXX=gcc
endif
ifndef CXX_EXT
CXX_EXT=.cc
endif
vpath %$(C_EXT) $(SRC_DIRS)
vpath %$(CXX_EXT) $(SRC_DIRS)
ifndef OBJ_EXT
OBJ_EXT=.o
endif
ifndef AR_EXT
AR_EXT=.a
endif
ifndef AR_CMD
AR_CMD=ar rc
endif
ifndef RANLIB
RANLIB=ranlib
endif
ifndef GNATMAKE
GNATMAKE:=gnatmake
endif
ifndef ARCHIVE
ARCHIVE=$(OBJ_DIR)/lib$(PROJECT_BASE)-full$(AR_EXT)
endif
ifeq ($(EXEC_DIR),)
EXEC_DIR=$(OBJ_DIR)
endif
# Define display to echo only when SILENT is not defined
ifdef SILENT
define display
@gprcmd ignore
endef
else
define display
@echo
endef
endif
# Make sure gnatmake is called silently when SILENT is set
ifdef SILENT
GNATMAKE:=$(GNATMAKE) -q
endif
# If C/C++ compiler is gcc, make sure gcc is called with the switch indicating
# the language, in case the extension is not standard.
ifeq ($(strip $(filter-out %gcc,$(CC))),)
C_Compiler=$(CC) -x c
else
C_Compiler=$(CC)
endif
ifeq ($(strip $(filter-out %gcc %g++,$(CXX))),)
CXX_Compiler=$(CXX) -x c++
else
CXX_Compiler=$(CXX)
endif
# Set the object search path
vpath %$(OBJ_EXT) $(OBJ_DIR)
vpath %$(AR_EXT) $(OBJ_DIR)
# A target can't have a character ':' otherwise it will confuse make. We
# replace ':' by a pipe character. Note that there is less chance than a pipe
# character be part of a pathname on UNIX and this character can't be used in
# a pathname on Windows.
clean_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=clean_%))
compile_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=compile_%))
object_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=object_%))
ada_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=ada_%))
c_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=c_%))
c++_deps = $(subst :,__GPRCOLON__,$(DEPS_PROJECTS:%=c++_%))
# Default target is to build (compile/bind/link)
all: build
clean: $(clean_deps) internal-clean
build: $(compile_deps) internal-compile internal-build
compile: $(compile_deps) internal-compile $(ADA_SOURCES)
ada: $(ada_deps) internal-ada
archive-objects: $(object_deps) internal-archive-objects
c: $(c_deps) internal-c
c++: $(c++deps) internal-c++
$(clean_deps): force
@$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:clean_%=%))) -f Makefile.$(notdir $@) internal-clean
$(compile_deps): force
@$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:compile_%=%))) -f Makefile.$(notdir $@) internal-compile
$(object_deps): force
@$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:object_%=%))) -f Makefile.$(notdir $@) internal-archive-objects ARCHIVE=$(ARCHIVE)
$(ada_deps): force
@$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:ada_%=%))) -f Makefile.$(notdir $@) internal-ada
$(c_deps): force
@$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:c_%=%))) -f Makefile.$(notdir $@) internal-c
$(c++_deps): force
@$(MAKE) -C $(dir $(subst __GPRCOLON__,:,$(@:c++_%=%))) -f Makefile.$(notdir $@) internal-c++
ifneq ($(EXEC),)
EXEC_RULE=-o $(EXEC)
endif
PROJECT_BASE = $(notdir $(PROJECT_FILE))
# Set C/C++ linker command & target
ifeq ($(filter c++,$(LANGUAGES)),c++)
LINKER = $(CXX)
ifeq ($(filter ada,$(LANGUAGES)),ada)
# C++ and Ada mixed
LARGS = --LINK=$(LINKER)
ifeq ($(strip $(filter-out %gcc %g++,$(CXX))),)
# Case of GNAT and a GNU C++ compiler
$(LINKER):
else
# Case of GNAT and a non GNU C++ compiler
LINKER = $(OBJ_DIR)/c++linker
$(LINKER): Makefile.$(PROJECT_BASE)
@echo \#!/bin/sh > $(LINKER)
@echo $(CXX) $$\* $(shell gcc -print-libgcc-file-name) >> $(LINKER)
@chmod +x $(LINKER)
endif
endif
else
ifeq ($(strip $(LANGUAGES)),c)
# Case of C only
LINKER = $(CC)
endif
endif
C_INCLUDES := $(foreach name,$(SRC_DIRS),-I$(name))
ALL_CFLAGS = $(CFLAGS) $(DEP_CFLAGS)
ALL_CXXFLAGS = $(CXXFLAGS) $(DEP_CFLAGS)
LDFLAGS := $(LIBS) $(LDFLAGS)
# Compute list of objects based on languages
ifeq ($(strip $(filter c,$(LANGUAGES))),c)
# Compute list of C sources automatically unless already specified
ifndef C_SRCS_DEFINED
ifndef C_SRCS
C_SRCS := \
$(foreach name,$(SRC_DIRS),$(notdir $(wildcard $(name)/*$(C_EXT))))
endif
endif
C_OBJECTS := $(C_SRCS:$(C_EXT)=$(OBJ_EXT))
OBJECTS += $(C_OBJECTS)
endif
ifeq ($(strip $(filter c++,$(LANGUAGES))),c++)
# Compute list of C++ sources automatically unless already specified
ifndef CXX_SRCS_DEFINED
ifndef CXX_SRCS
CXX_SRCS := \
$(foreach name,$(SRC_DIRS),$(notdir $(wildcard $(name)/*$(CXX_EXT))))
endif
endif
CXX_OBJECTS := $(CXX_SRCS:$(CXX_EXT)=$(OBJ_EXT))
OBJECTS += $(CXX_OBJECTS)
endif
OBJ_FILES := $(foreach name,$(OBJECTS),$(OBJ_DIR)/$(name))
# To handle C/C++ dependencies, we associate a small file for each
# source that will list the dependencies as a make rule, so that we can then
# include these rules in this makefile, and recompute them on a file by file
# basis
DEP_FILES := $(OBJ_FILES:$(OBJ_EXT)=.d)
# Ada compilations are taken care of automatically, so do not mess with Ada
# objects, only with main sources.
ifeq ($(strip $(OBJECTS)),)
internal-compile:
internal-archive-objects:
else
internal-compile: lib$(PROJECT_BASE)$(AR_EXT)
lib$(PROJECT_BASE)$(AR_EXT): $(OBJECTS)
@$(display) creating archive file for $(PROJECT_BASE)
cd $(OBJ_DIR); $(AR_CMD) $@ $(strip $(OBJECTS))
-$(RANLIB) $(OBJ_DIR)/$@
internal-archive-objects: $(OBJECTS)
# @echo $(AR_CMD) $(ARCHIVE) $(strip $(OBJECTS))
# cd $(OBJ_DIR); $(AR_CMD) $(ARCHIVE) $(strip $(OBJECTS))
# -$(RANLIB) $(OBJ_DIR)/$@
endif
# Linking rules
# There are three cases:
#
# - C/C++ sources
#
# - Ada/C/C++, main program is in Ada
#
# - Ada/C/C++, main program is in C/C++
ifeq ($(strip $(filter-out c c++,$(LANGUAGES))),)
# link with C/C++
ifeq ($(MAIN_OBJECT),)
link:
@echo link: no main object specified, exiting...
exit 1
else
ifeq ($(EXEC),)
link:
@echo link: no executable specified, exiting...
exit 1
else
link: $(EXEC_DIR)/$(EXEC) archive-objects
$(EXEC_DIR)/$(EXEC): $(OBJECTS)
@$(display) $(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS) $(FLDFLAGS)
@$(LINKER) -o $(EXEC_DIR)/$(EXEC) $(OBJ_DIR)/$(MAIN_OBJECT) $(LDFLAGS) $(FLDFLAGS)
endif
endif
internal-build: internal-compile link
else
ifeq ($(strip $(filter-out c c++ ada,$(LANGUAGES))),)
# link with Ada/C/C++
ifeq ($(MAIN),ada)
# Ada main
link: $(LINKER) archive-objects force
@$(display) $(GNATMAKE) -b -l -P$(PROJECT_FILE) $(ADA_SOURCES)
@$(GNATMAKE) -b -l -P$(PROJECT_FILE) $(ADA_SOURCES) \
-largs $(LARGS) $(LDFLAGS)
internal-build: $(LINKER) archive-objects force
@$(display) $(GNATMAKE) -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
@$(GNATMAKE) -P$(PROJECT_FILE) $(EXEC_RULE) $(ADA_SOURCES) $(ADAFLAGS) \
-largs $(LARGS) $(LDFLAGS)
else
# C/C++ main
link: $(LINKER) archive-objects force
@$(display) $(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES)
@$(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) \
-largs $(OBJ_DIR)/$(MAIN_OBJECT) $(LARGS) $(LDFLAGS) $(FLDFLAGS)
internal-build: $(LINKER) archive-objects force
@$(display) $(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) $(ADAFLAGS)
@$(GNATMAKE) $(EXEC_RULE) \
-B -P$(PROJECT_FILE) $(ADA_SOURCES) $(ADAFLAGS) \
-largs $(OBJ_DIR)/$(MAIN_OBJECT) $(LARGS) $(LDFLAGS) $(FLDFLAGS)
endif
else
# unknown set of languages, fail
link:
@echo do not know how to link with the following languages: $(LANGUAGES)
exit 1
endif
endif
# Automatic handling of dependencies
ifeq ($(strip $(filter-out %gcc %g++,$(CC) $(CXX))),)
# Compiler is GCC, take avantage of the preprocessor option -MD and
# the CPATH environment variable
empty:=
space:=$(empty) $(empty)
path_sep:=$(shell gprcmd path_sep)
SRC_DIRS_PATH:= $(subst $(space),$(path_sep),$(SRC_DIRS))
export CPATH:=$(SRC_DIRS_PATH)$(path_sep)$(CPATH)
DEP_CFLAGS = -Wp,-MD,$(OBJ_DIR)/$(*F).d
define post-compile
@gprcmd deps $(OBJ_EXT) $(OBJ_DIR)/$(*F).d gcc
endef
# Default rule to create dummy dependency files the first time
$(OBJ_DIR)/%.d:
@echo $(*F)$(OBJ_EXT): > $@
else
# Compiler unknown, use a more general approach based on the output of $(CC) -M
ALL_CFLAGS := $(ALL_CFLAGS) $(C_INCLUDES)
ALL_CXXFLAGS := $(ALL_CXXFLAGS) $(C_INCLUDES)
DEP_FLAGS = -M
DEP_CFLAGS =
define post-compile
endef
$(OBJ_DIR)/%.d: %$(C_EXT)
@$(CC) $(DEP_FLAGS) $(ALL_CFLAGS) $< > $@
@gprcmd deps $(OBJ_EXT) $@
$(OBJ_DIR)/%.d: %$(CXX_EXT)
@$(CXX) $(DEP_FLAGS) $(ALL_CXXFLAGS) $< > $@
@gprcmd deps $(OBJ_EXT) $@
endif
ifneq ($(DEP_FILES),)
-include $(DEP_FILES)
endif
# Compilation rules
# File rules
# Compile C files individually
%$(OBJ_EXT) : %$(C_EXT)
@$(display) $(C_Compiler) -c $(CFLAGS) $< -o $(OBJ_DIR)/$@
ifndef FAKE_COMPILE
@$(C_Compiler) -c $(ALL_CFLAGS) $< -o $(OBJ_DIR)/$@
@$(post-compile)
endif
# Compile C++ files individually
%$(OBJ_EXT) : %$(CXX_EXT)
@$(display) $(CXX_Compiler) -c $(CXXFLAGS) $< -o $(OBJ_DIR)/$@
ifndef FAKE_COMPILE
@$(CXX_Compiler) -c $(ALL_CXXFLAGS) $< -o $(OBJ_DIR)/$@
@$(post-compile)
endif
# Compile Ada body files individually
%$(ADA_BODY) : force
$(GNATMAKE) -c -P$(PROJECT_FILE) $@ $(ADAFLAGS)
# Compile Ada spec files individually
%$(ADA_SPEC) : force
$(GNATMAKE) -c -P$(PROJECT_FILE) $@ $(ADAFLAGS)
# Languages rules
# Compile all Ada files in the project
internal-ada :
$(GNATMAKE) -c -P$(PROJECT_FILE) $(ADAFLAGS)
# Compile all C files in the project
internal-c : $(C_OBJECTS)
# Compile all C++ files in the project
internal-c++ : $(CXX_OBJECTS)
.PHONY: force internal-clean internal-archive internal-build internal-compile internal-ada internal-c internal-c++ build compile clean ada c c++
internal-clean:
@$(display) $(RM) $(OBJ_DIR)/*$(OBJ_EXT)
@$(RM) $(OBJ_DIR)/*$(OBJ_EXT)
@$(display) $(RM) $(OBJ_DIR)/*.ali
@$(RM) $(OBJ_DIR)/*.ali
@$(display) $(RM) $(OBJ_DIR)/b~*
@$(RM) $(OBJ_DIR)/b~*
@$(display) $(RM) $(OBJ_DIR)/b_*
@$(RM) $(OBJ_DIR)/b_*
@$(display) $(RM) $(OBJ_DIR)/*$(AR_EXT)
@$(RM) $(OBJ_DIR)/*$(AR_EXT)
@$(display) $(RM) $(OBJ_DIR)/*.d
@$(RM) $(OBJ_DIR)/*.d
ifneq ($(EXEC),)
@$(display) $(RM) $(EXEC_DIR)/$(EXEC)
@$(RM) $(EXEC_DIR)/$(EXEC)
endif
force:
gcc/ada/Makefile.prolog deleted 100644 → 0
# Makefile included at the beginning of the makefiles generated by gpr2make
# to support compilation for multiple languages.
# See also Makefile.generic
#
# Copyright (C) 2001-2004 Free Software Foundation, Inc.
# This file is part of GCC.
# GCC 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.
# GCC 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 GCC; see the file COPYING. If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
# all reserved variables are saved in <VAR>.saved
BASE_DIR.saved := $(BASE_DIR)
C_EXT.saved:=$(C_EXT)
CXX_EXT.saved:=$(CXX_EXT)
OBJ_EXT.saved:=$(OBJ_EXT)
SRC_DIRS.saved:=$(SRC_DIRS)
C_SRCS.saved:=$(C_SRCS)
CXX_SRCS.saved:=$(CXX_SRCS)
OBJ_DIR.saved:=$(OBJ_DIR)
LANGUAGES.saved:=$(LANGUAGES)
CC.saved:=$(CC)
CXX.saved:=$(CXX)
AR_CMD.saved:=$(AR_CMD)
AR_EXT.saved:=$(AR_EXT)
GNATMAKE.saved:=$(GNATMAKE)
ADAFLAGS.saved:=$(ADAFLAGS)
CFLAGS.saved:=$(CFLAGS)
CXXFLAGS.saved:=$(CXXFLAGS)
FLDFLAGS.saved:=$(FLDFLAGS)
LIBS.saved:=$(LIBS)
LDFLAGS.saved:=$(LDFLAGS)
ADA_SOURCES.saved:=$(ADA_SOURCES)
EXEC.saved:=$(EXEC)
EXEC_DIR.saved:=$(EXEC_DIR)
MAIN.saved:=$(MAIN)
PROJECT_FILE.saved:=$(PROJECT_FILE)
DEPS_PROJECTS.saved:=$(DEPS_PROJECTS)
# Default settings
LANGUAGES:=ada
C_EXT:=.c
CXX_EXT:=.cc
AR_EXT=.a
OBJ_EXT=.o
CC=gcc
FLDFLAGS:=
# Default target is to build (compile/bind/link)
# Target build is defined in Makefile.generic
default: build
gcc/ada/i-cpp-vms.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- I N T E R F A C E S . C P P --
-- --
-- B o d y --
-- --
-- Copyright (C) 2000-2004, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT 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 distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This is the OpenVMS/Alpha DEC C++ (cxx) version of this package
with Ada.Tags; use Ada.Tags;
with System; use System;
with System.Storage_Elements; use System.Storage_Elements;
with Unchecked_Conversion;
package body Interfaces.CPP is
subtype Cstring is String (Positive);
type Cstring_Ptr is access all Cstring;
type Tag_Table is array (Natural range <>) of Vtable_Ptr;
pragma Suppress_Initialization (Tag_Table);
type Type_Specific_Data is record
Idepth : Natural;
Expanded_Name : Cstring_Ptr;
External_Tag : Cstring_Ptr;
HT_Link : Tag;
Ancestor_Tags : Tag_Table (Natural);
end record;
type Vtable_Entry is record
Pfn : System.Address;
end record;
type Type_Specific_Data_Ptr is access all Type_Specific_Data;
type Vtable_Entry_Array is array (Positive range <>) of Vtable_Entry;
type VTable is record
Prims_Ptr : Vtable_Entry_Array (Positive);
TSD : Type_Specific_Data_Ptr;
-- Location of TSD is unknown so it got moved here to be out of the
-- way of Prims_Ptr. Find it later. ???
end record;
--------------------------------------------------------
-- Unchecked Conversions for Tag, Vtable_Ptr, and TSD --
--------------------------------------------------------
function To_Type_Specific_Data_Ptr is
new Unchecked_Conversion (Address, Type_Specific_Data_Ptr);
function To_Address is
new Unchecked_Conversion (Type_Specific_Data_Ptr, Address);
---------------------------------------------
-- Unchecked Conversions for String Fields --
---------------------------------------------
function To_Cstring_Ptr is
new Unchecked_Conversion (Address, Cstring_Ptr);
function To_Address is
new Unchecked_Conversion (Cstring_Ptr, Address);
-----------------------
-- Local Subprograms --
-----------------------
function Length (Str : Cstring_Ptr) return Natural;
-- Length of string represented by the given pointer (treating the
-- string as a C-style string, which is Nul terminated).
--------------------
-- Displaced_This --
--------------------
function Displaced_This
(Current_This : System.Address;
Vptr : Vtable_Ptr;
Position : Positive) return System.Address
is
pragma Warnings (Off, Vptr);
pragma Warnings (Off, Position);
begin
return Current_This;
-- + Storage_Offset (Vptr.Prims_Ptr (Position).Delta1);
-- why is above line commented out ???
end Displaced_This;
-----------------------
-- CPP_CW_Membership --
-----------------------
function CPP_CW_Membership
(Obj_Tag : Vtable_Ptr;
Typ_Tag : Vtable_Ptr) return Boolean
is
Pos : constant Integer := Obj_Tag.TSD.Idepth - Typ_Tag.TSD.Idepth;
begin
return Pos >= 0 and then Obj_Tag.TSD.Ancestor_Tags (Pos) = Typ_Tag;
end CPP_CW_Membership;
---------------------------
-- CPP_Get_Expanded_Name --
---------------------------
function CPP_Get_Expanded_Name (T : Vtable_Ptr) return Address is
begin
return To_Address (T.TSD.Expanded_Name);
end CPP_Get_Expanded_Name;
--------------------------
-- CPP_Get_External_Tag --
--------------------------
function CPP_Get_External_Tag (T : Vtable_Ptr) return Address is
begin
return To_Address (T.TSD.External_Tag);
end CPP_Get_External_Tag;
-------------------------------
-- CPP_Get_Inheritance_Depth --
-------------------------------
function CPP_Get_Inheritance_Depth (T : Vtable_Ptr) return Natural is
begin
return T.TSD.Idepth;
end CPP_Get_Inheritance_Depth;
-----------------------
-- CPP_Get_RC_Offset --
-----------------------
function CPP_Get_RC_Offset (T : Vtable_Ptr) return SSE.Storage_Offset is
pragma Warnings (Off, T);
begin
return 0;
end CPP_Get_RC_Offset;
-----------------------------
-- CPP_Get_Prim_Op_Address --
-----------------------------
function CPP_Get_Prim_Op_Address
(T : Vtable_Ptr;
Position : Positive) return Address
is
begin
return T.Prims_Ptr (Position).Pfn;
end CPP_Get_Prim_Op_Address;
-------------------------------
-- CPP_Get_Remotely_Callable --
-------------------------------
function CPP_Get_Remotely_Callable (T : Vtable_Ptr) return Boolean is
pragma Warnings (Off, T);
begin
return True;
end CPP_Get_Remotely_Callable;
-----------------
-- CPP_Get_TSD --
-----------------
function CPP_Get_TSD (T : Vtable_Ptr) return Address is
begin
return To_Address (T.TSD);
end CPP_Get_TSD;
--------------------
-- CPP_Inherit_DT --
--------------------
procedure CPP_Inherit_DT
(Old_T : Vtable_Ptr;
New_T : Vtable_Ptr;
Entry_Count : Natural)
is
begin
if Old_T /= null then
New_T.Prims_Ptr (1 .. Entry_Count) :=
Old_T.Prims_Ptr (1 .. Entry_Count);
end if;
end CPP_Inherit_DT;
---------------------
-- CPP_Inherit_TSD --
---------------------
procedure CPP_Inherit_TSD
(Old_TSD : Address;
New_Tag : Vtable_Ptr)
is
TSD : constant Type_Specific_Data_Ptr :=
To_Type_Specific_Data_Ptr (Old_TSD);
New_TSD : Type_Specific_Data renames New_Tag.TSD.all;
begin
if TSD /= null then
New_TSD.Idepth := TSD.Idepth + 1;
New_TSD.Ancestor_Tags (1 .. New_TSD.Idepth)
:= TSD.Ancestor_Tags (0 .. TSD.Idepth);
else
New_TSD.Idepth := 0;
end if;
New_TSD.Ancestor_Tags (0) := New_Tag;
end CPP_Inherit_TSD;
---------------------------
-- CPP_Set_Expanded_Name --
---------------------------
procedure CPP_Set_Expanded_Name (T : Vtable_Ptr; Value : Address) is
begin
T.TSD.Expanded_Name := To_Cstring_Ptr (Value);
end CPP_Set_Expanded_Name;
--------------------------
-- CPP_Set_External_Tag --
--------------------------
procedure CPP_Set_External_Tag (T : Vtable_Ptr; Value : Address) is
begin
T.TSD.External_Tag := To_Cstring_Ptr (Value);
end CPP_Set_External_Tag;
-------------------------------
-- CPP_Set_Inheritance_Depth --
-------------------------------
procedure CPP_Set_Inheritance_Depth
(T : Vtable_Ptr;
Value : Natural)
is
begin
T.TSD.Idepth := Value;
end CPP_Set_Inheritance_Depth;
-----------------------------
-- CPP_Set_Prim_Op_Address --
-----------------------------
procedure CPP_Set_Prim_Op_Address
(T : Vtable_Ptr;
Position : Positive;
Value : Address)
is
begin
T.Prims_Ptr (Position).Pfn := Value;
end CPP_Set_Prim_Op_Address;
-----------------------
-- CPP_Set_RC_Offset --
-----------------------
procedure CPP_Set_RC_Offset (T : Vtable_Ptr; Value : SSE.Storage_Offset) is
pragma Warnings (Off, T);
pragma Warnings (Off, Value);
begin
null;
end CPP_Set_RC_Offset;
-------------------------------
-- CPP_Set_Remotely_Callable --
-------------------------------
procedure CPP_Set_Remotely_Callable (T : Vtable_Ptr; Value : Boolean) is
pragma Warnings (Off, T);
pragma Warnings (Off, Value);
begin
null;
end CPP_Set_Remotely_Callable;
-----------------
-- CPP_Set_TSD --
-----------------
procedure CPP_Set_TSD (T : Vtable_Ptr; Value : Address) is
begin
T.TSD := To_Type_Specific_Data_Ptr (Value);
end CPP_Set_TSD;
-------------------
-- Expanded_Name --
-------------------
function Expanded_Name (T : Vtable_Ptr) return String is
Result : constant Cstring_Ptr := T.TSD.Expanded_Name;
begin
return Result (1 .. Length (Result));
end Expanded_Name;
------------------
-- External_Tag --
------------------
function External_Tag (T : Vtable_Ptr) return String is
Result : constant Cstring_Ptr := T.TSD.External_Tag;
begin
return Result (1 .. Length (Result));
end External_Tag;
------------
-- Length --
------------
function Length (Str : Cstring_Ptr) return Natural is
Len : Integer := 1;
begin
while Str (Len) /= ASCII.Nul loop
Len := Len + 1;
end loop;
return Len - 1;
end Length;
end Interfaces.CPP;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment