mappers.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
-------------------------> GNU Sather - sourcefile <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute and/or modify it under the terms of the GNU Library General --
-- Public License (LGPL) as published by the Free Software Foundation; --
-- either version 2 of the license, or (at your option) any later version. --
-- This library 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 Doc/LGPL for more details. --
-- The license text is also available from: Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --
--------------> Please email comments to <bug-sather@gnu.org> <--------------
immutable class MAP_PARTS < $ENUMS{MAP_PARTS}
immutable class MAP_PARTS < $ENUMS{MAP_PARTS} is
-- This class defines the different map file part code values.
-- Version 1.0 Dec 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 23 Nov 98 kh Original revised from MAP_MODES
include ENUM{MAP_PARTS} ;
private const val_count : CARD := 3 ;
-- The next constant routines provide the enumeration values.
End_Mark : SAME is return enum(1) end ;
Infinite : SAME is return enum(2) end ;
Byte_Size : SAME is return enum(3) end ;
end ; -- MAP_PARTS
immutable class MAP_MODES < $ENUMS{MAP_MODES}
immutable class MAP_MODES < $ENUMS{MAP_MODES} is
-- This class defines the different modes of map file processing
-- required when reading a binary map file.
-- Version 1.0 Nov 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 3 Nov 98 kh Original after a Perl script
include ENUM{MAP_MODES} ;
private const val_count : CARD := 3 ;
private const offset : CARD := 6 ;
-- The next constant routines provide the enumeration values. Note the
-- offset which arises because of the defined values in the representation
-- of the mapping file format.
Alternate_Key_Val : SAME is return enum(6) end ;
All_Keys_All_Vals : SAME is return enum(7) end ;
Partial_Key_Val_Map : SAME is return enum(8) end ;
end ; -- MAP_MODES
immutable class INFO_KINDS < $ENUMS{INFO_KINDS}
immutable class INFO_KINDS < $ENUMS{INFO_KINDS} is
-- This class defines the different modes of storage and header
-- information in the character mapping file 'defined' in the CODE_MAPPER
-- class.
-- Version 1.0 Nov 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 3 Nov 98 kh Original after a Perl script
include ENUM{INFO_KINDS} ;
private const val_count : CARD := 5 ;
private const offset : CARD := 20 ;
-- The next constant routines provide the enumeration values. Note the
-- offset which arises because of the defined values in the representation
-- of the mapping file format.
Header_Name : SAME is return enum(20) end ;
Charset_Alias : SAME is return enum(21) end ;
Mapfile_Revision : SAME is return enum(22) end ;
Mapfile_Author : SAME is return enum(23) end ;
Mapfile_Info : SAME is return enum(24) end ;
end ; -- INFO_KINDS
class MAP_FILE
class MAP_FILE is
-- This class implements the mapping from a code kind to the local
-- mapping file identity for that code kind.
-- NOTE The corresponding resource file should have exactly the same number
-- of entries as the code CODE_KINDS resource file and they must be
-- in the same order, so that the mapping between kind and file path
-- is correct!
-- Version 1.0 Dec 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 22 Dec 98 kh Original
private shared File_Names : ARRAY{STR} ;
private shared File_Paths : ARRAY{FILE_PATH} ;
private Map_ref : STR is
-- This routine creates and returns the map directory name.
loc_lib : LIBCHARS := LIBCHARS::default ;
loc_res : CODE_STR := CODE_STR::create(loc_lib) +
CHAR_CODE::create(UNICODE::LATIN_SMALL_LETTER_M.card,loc_lib) +
CHAR_CODE::create(UNICODE::LATIN_SMALL_LETTER_A.card,loc_lib) +
CHAR_CODE::create(UNICODE::LATIN_SMALL_LETTER_P.card,loc_lib) +
CHAR_CODE::create(UNICODE::LATIN_SMALL_LETTER_S.card,loc_lib) ;
return loc_res.tgt_str
end ;
private init : BOOL is
-- This private 'predicate' 'loads' the name array and then constructs
-- the path array if this is possible, returning true if successful,
-- otherwise false.
if void(File_Paths) then
loc_lib : LIBCHARS := LIBCHARS::default ;
loc_cult : CULTURE := loc_lib.culture ;
resource : RESOURCES := loc_cult.resources ;
dummy : SAME := new ; -- only for the next stmt!
File_Names := resource.read(SYS::rune_name(dummy),
CODE_KINDS::cardinality) ;
SYS::destroy(dummy) ;
File_Paths := ARRAY{FILE_PATH}::create(CODE_KINDS::cardinality) ;
sather_home : STR := OPSYS::get_env(loc_cult.Home_ref) ;
base_dir : FILE_PATH := FILE_PATH::create(sather_home) ;
base_dir := base_dir.append(Map_ref) ;
loop
name : STR := File_Names.elt! ;
loc_path : FILE_PATH ;
if name.size = 0 then
loc_path := void
else
loc_path := base_dir.append(name) ;
if void(loc_path) then
return false
end
end ;
File_Paths.set!(loc_path)
end
end ;
return true
end ;
path(
kind : CODE_KINDS
) : FILE_PATH
pre ~(kind.card = 0)
post void(result)
or (result.str = File_Paths[kind.card - 1].str)
is
-- This routine returns the file path for the mapping file of the given
-- code kind or, if initialisation fails then void.
if init then
return File_Paths[kind.card - 1]
else
return void
end
end ;
end ; -- MAP_FILE
class MAP_HEADER < $BINARY, $IS_EQ
class MAP_HEADER < $BINARY, $IS_EQ is
-- This class defines the header contents of a code mapping file
-- as contained in the standard file format.
-- The header format comprises :-
--
-- (1) A magic number - 0xb827
--
-- (2) One or more Data Entries.
-- Each data entry comprises a null octet followed by an Info Kinds code
-- (also one octet) followed by a single octet giving the length (in octets)
-- of the UCS2 encoded header entry which follows immediately after the
-- length octet.
-- Version 1.0 Oct 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 30 Oct 98 kh Original after a Perl script
include COMPARABLE ;
include BINARY ;
private const Map_Magic : CARD := 0xB827 ;
readonly attr code_name : HEX_STR ;
readonly attr aliasses : FLIST{HEX_STR} ;
readonly attr revision : HEX_STR ;
readonly attr author : HEX_STR ;
readonly attr misc_info : HEX_STR ;
private get_info(
cursor : BIN_CURSOR
) : HEX_STR
pre ~void(cursor)
and ((cursor.item.card + 1) <= cursor.remaining)
post (result.size = (initial(cursor.item.card) /
HEXTET::Octets_in_Hextet))
is
-- This is a special reading routine converting hextets from the
-- indicated binary string into a two-string, which is returned.
count : CARD := cursor.get_item.card / 2 ; -- count of chars!
if count = 0 then -- possible - if unexpected!
return void
end ;
res : HEX_STR := HEX_STR::create ;
loop
count.times! ;
res := res + HEXTET::build(cursor).char
end ;
return res
end ;
private check_magic(
cursor : BIN_CURSOR
) : BOOL
pre ~void(cursor)
and ~cursor.is_done
and (cursor.remaining >= 2) -- Contains at least magic no!
post true
is
-- This routine returns true if and only if the correct magic number
-- is in the string starting at the current octet.
start_index : CARD := cursor.index ;
loc_magic : CARD := HEXTET::build(cursor).card ;
if loc_magic /= Map_Magic then -- check if it's the right kind
cursor.set_index(start_index) ;
return false
else
return true
end
end ;
private is_header_end(
cursor : BIN_CURSOR,
out code : INFO_KINDS
) : BOOL
pre ~void(cursor)
and ~cursor.is_done
post result
or ~(code.card = 0)
is
-- This private routine returns true if and only if the next 'item' in
-- the indicated input string represents the end of the file header. This
-- consists of a null octet followed by a non-null one and a final null octet.
-- If false is returned then code contains the header component enumeration
-- value for data retrieval.
if cursor.item = OCTET::null then -- could be header or end
cursor.advance ;
loc_code : CARD := cursor.get_item.card ;
if cursor.item = OCTET::null then -- the end has been found!
cursor.retract ;
cursor.retract ;
return true
else
code := INFO_KINDS::create(loc_code) ;
return false
end
else -- definitely unexpected!
return true
end
end ;
build(
cursor : BIN_CURSOR
) : SAME
pre ~void(cursor)
and ~cursor.is_done
and (cursor.remaining >= 2) -- Contains at least magic no!
post true
is
-- This routine creates a new header from the given binary string,
-- removing the header end mark before returning.
if ~check_magic(cursor) then
return void
end ;
res : SAME := new ;
info_kind : INFO_KINDS ;
loop -- for header entries!
if cursor.is_done
or is_header_end(cursor,out info_kind) then
break!
end ;
case info_kind
when INFO_KINDS::Header_Name then
res.code_name := res.get_info(cursor)
when INFO_KINDS::Charset_Alias then
res.aliasses := res.aliasses.push(get_info(cursor))
when INFO_KINDS::Mapfile_Revision then
res.revision := res.get_info(cursor)
when INFO_KINDS::Mapfile_Author then
res.author := res.get_info(cursor)
when INFO_KINDS::Mapfile_Info then
res.misc_info := res.get_info(cursor)
else -- should never happen!!
SYS_ERROR::create.error(res,SYS_EXCEPT::Bad_Map,
res.get_info(cursor).str)
end
end ;
return res
end ;
create(
name : HEX_STR
) : SAME
pre ~void(name)
post ~void(result)
and ~void(result.aliasses)
and (result.aliasses.size = 0)
is
-- This routine creates a new map header with the given name. The
-- aliasses component is created but left empty as are all other components.
me : SAME := new ;
me.code_name := name ;
me.aliasses := FLIST{HEX_STR}::create ;
return me
end ;
is_eq(
other : SAME
) : BOOL is
-- This predicate returns true if and only if self and other are the
-- same object.
return SYS::is_eq(self,other)
end ;
binstr : BINSTR
pre ~void(self)
post true -- build(result.cursor) = self
is
-- This routine creates a binary string form of self which may be used
-- for filing, etc as necessary.
res : BINSTR := HEXTET::create(Map_Magic).binstr + OCTET::null ;
if ~void(code_name) then
res := res + INFO_KINDS::Header_Name.binstr + code_name.binstr.sized
end ;
if ~void(aliasses) then
loop
res := res + OCTET::null + INFO_KINDS::Charset_Alias.binstr +
aliasses.elt!.binstr.sized
end
end ;
if ~void(revision) then
res := res + OCTET::null + INFO_KINDS::Mapfile_Revision.binstr +
revision.binstr.sized
end ;
if ~void(author) then
res := res + OCTET::null + INFO_KINDS::Mapfile_Author.binstr +
author.binstr.sized
end ;
if ~void(misc_info) then
res := res + OCTET::null + INFO_KINDS::Mapfile_Info.binstr +
misc_info.binstr.sized
end ;
return res
end ;
add_alias(
name : STR
) : SAME
pre ~void(self)
and ~void(name)
post (result.aliasses.size = initial(aliasses.size) + 1)
is
-- This routine adds the given name to the alias list for the mapfile,
-- returning self.
if void(aliasses) then
aliasses := FLIST{HEX_STR}::create
end ;
aliasses := aliasses.push(HEX_STR::create(name)) ;
return self
end ;
remove_alias(
name : STR
) : SAME
pre ~void(self)
and ~void(name)
post true
is
-- This routine removes the given name from the alias list, if present,
-- otherwise silently does nothing.
if void(aliasses) then -- quietly do nothing!
return self
end ;
new_aliasses : FLIST{HEX_STR} := FLIST{HEX_STR}::create ;
loc_name : HEX_STR := HEX_STR::create(name) ;
loop
alias : HEX_STR := aliasses.elt! ;
if loc_name /= alias then
new_aliasses := new_aliasses.push(alias)
end
end ;
aliasses := new_aliasses ;
return self
end ;
revision(
number : STR
)
pre ~void(self)
post true
is
-- This routine sets the revision number of the mapfile header as a rune
-- string, not a numeric value.
revision := HEX_STR::create(number)
end ;
author(
name_addr : STR
)
pre ~void(name_addr)
post true
is
-- This routine sets the mapfile author's name (an optionally address)
-- in the mapfile header as a rune string.
author := HEX_STR::create(name_addr)
end ;
info(
data : STR
)
pre ~void(self)
and ~void(data)
post true
is
-- This routine is provided to include miscellaneous information about
-- the code or mapping as found to be necessary..
misc_info := HEX_STR::create(data)
end ;
end ; -- MAP_HEADER