-- Copyright (c),  Digital Equipment Corporation, 1993, 1994.
-- Redistribution and use in source and binary forms are permitted
-- provided that the copyright notice as indicated in box below and
-- this paragraph are duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such distribution
-- and use acknowledge that the software was developed by Digital Equipment
-- Corporation.  The name of Digital Equipment Corporation may not be used to
-- endorse or promote products derived from this software without the specific
-- prior written permission.
--
-- All other rights reserved.
--
-- THIS SOFTWARE IS PROVIDED ''AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
-- WARRANTIES, INCLUDING, WITHOUT LIMITATION, IMPLIED WARRANTIES OF
-- NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
-- Digital assumes no responsibility AT ALL for the use or reliability
-- of this software.
--
-- +------------------------------------------------------------------------+
-- | USE, DUPLICATION OR DISCLOSURE BY THE U.S. GOVERNMENT IS SUBJECT TO    |
-- | RESTRICTIONS AS SET FORTH IN SUBPARAGRAPH (c) (1) (ii) OF              |
-- | DFARS 252.227-7013, OR IN FAR 52.227-14 ALT. II, AS APPLICABLE.        |
-- |                                                                        |
-- +------------------------------------------------------------------------+
--

package body WSTRING is
    use SYSTEM;

    function IS_NULL(
	ADDRESS : WCHAR_POINTER)
	return BOOLEAN is

    begin
	return ADDRESS = NULL_WCHAR_POINTER;
    end IS_NULL;

    package body WNULL_TERMINATED is

        function TO_WIDE_STRING (S : NULL_TERMINATED.STRING) 
            return WNULL_TERMINATED.WIDE_STRING is

            X : WNULL_TERMINATED.WIDE_STRING (S'range);
        begin
	    for I in X'range loop
	        if (S(I) = 0) and (I /= X'last) then
		    raise CONSTRAINT_ERROR;
	        end if;
                X(I) := WIDE_CHAR (S(I));
	    end loop;
            X(X'last) := WIDE_CHAR (0);
            return X;
        end;

        function TO_STRING (S : WNULL_TERMINATED.WIDE_STRING) 
            return NULL_TERMINATED.STRING is
            X : NULL_TERMINATED.STRING (S'range);

        begin
            for I in X'range loop
                X(I) := CHAR (S(I));
            end loop;
	    return X;
        end;

        function TO_STRING (CP : WCHAR_POINTER) 
            return WNULL_TERMINATED.WIDE_STRING is
	    X : WNULL_TERMINATED.WIDE_STRING (1..LENGTH(CP)+1);
	        for X use at SYSTEM.ADDRESS(CP);
        begin
	    return X;
        end;

        function LENGTH(S : WNULL_TERMINATED.WIDE_STRING) 
            return NATURAL is
        begin
	    for I in S'range loop
	        if S(I) = 0 then
		    return I-S'first;  -- not +1 since 0 not counted
	        end if;
	    end loop;
	    raise CONSTRAINT_ERROR;
        end;

        function LENGTH(CP : WCHAR_POINTER) 
            return NATURAL is

	    S : WNULL_TERMINATED.UNCHECKED_WIDE_STRING;
	        for S use at SYSTEM.ADDRESS(CP);

        begin
	    for I in S'range loop
	        if S(I) = 0 then
		    return I-S'first;  -- not +1 since 0 not counted
	        end if;
	    end loop;
	    raise CONSTRAINT_ERROR;
        end;

	function TO_ADDRESS_OR_NULL_POINTER(S : WNULL_TERMINATED.WIDE_STRING) 
	    return SYSTEM.ADDRESS is
	begin
	    if S'LENGTH <= 1 then
		return SYSTEM.NO_ADDR;
	    else
		return S'ADDRESS;
	    end if;
	end;

    end WNULL_TERMINATED;
end WSTRING;