61 lines
1.7 KiB
Ada
61 lines
1.7 KiB
Ada
--
|
||
-- UNCHECK.ADA
|
||
--
|
||
-- Unchecked programming procedures for Artek Ada
|
||
--
|
||
-- Copyright (C) 1986 Artek Corporation
|
||
--
|
||
-- These utility procedures are implemented in accordance
|
||
-- with the Ada standard.
|
||
--
|
||
|
||
generic
|
||
type OBJECT is limited private;
|
||
type NAME is access OBJECT;
|
||
procedure UNCHECKED_DEALLOCATION (X : in out NAME);
|
||
|
||
with ACODES; use ACODES;
|
||
procedure UNCHECKED_DEALLOCATION (X : in out NAME) is
|
||
|
||
begin
|
||
pragma ACODE (NOP, 00, 00, 00);
|
||
pragma ACODE (LOAD2); -- Load pointer to X
|
||
pragma ACODE (CVABS);
|
||
pragma ACODE (LOAD2); -- Load contents of X
|
||
pragma ACODE (HDISP, 00, 00, 00); -- Dispose the element pointed to by X
|
||
pragma ACODE (LOAD2); -- Load pointer to X
|
||
pragma ACODE (CVABS, 00, 00);
|
||
pragma ACODE (STORE2); -- Store NULL in it
|
||
null; -- To make this legal Ada syntax
|
||
end UNCHECKED_DEALLOCATION;
|
||
|
||
generic
|
||
type SOURCE is limited private;
|
||
type TARGET is limited private;
|
||
function UNCHECKED_CONVERSION (S : SOURCE) return TARGET;
|
||
|
||
with ACODES; use ACODES;
|
||
function UNCHECKED_CONVERSION (S : SOURCE) return TARGET is
|
||
|
||
type TARGET_ACCESS is access TARGET;
|
||
TARGET_POINTER : TARGET_ACCESS;
|
||
|
||
function SOURCE_ADDRESS return TARGET_ACCESS is
|
||
A : TARGET_ACCESS;
|
||
begin
|
||
pragma ACODE (NOP, 00, 00, 00, 01, 00, 00); -- A'ADDRESS, S'ADDRESS
|
||
pragma ACODE (ADR); -- Convert S to 16-bit offset
|
||
pragma ACODE (STORE2); -- and store in A
|
||
return A;
|
||
end SOURCE_ADDRESS;
|
||
|
||
begin
|
||
if SOURCE'SIZE /= TARGET'SIZE then
|
||
raise CONSTRAINT_ERROR;
|
||
else
|
||
TARGET_POINTER := SOURCE_ADDRESS;
|
||
return TARGET_POINTER . all; -- Return the target (read from the source!)
|
||
end if;
|
||
end UNCHECKED_CONVERSION;
|
||
|
||
|