1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- S Y S T E M . I M G _ C H A R -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2013, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32package body System.Img_Char is 33 34 --------------------- 35 -- Image_Character -- 36 --------------------- 37 38 procedure Image_Character 39 (V : Character; 40 S : in out String; 41 P : out Natural) 42 is 43 pragma Assert (S'First = 1); 44 45 subtype Cname is String (1 .. 3); 46 47 subtype C0_Range is Character 48 range Character'Val (16#00#) .. Character'Val (16#1F#); 49 50 C0 : constant array (C0_Range) of Cname := 51 (Character'Val (16#00#) => "NUL", 52 Character'Val (16#01#) => "SOH", 53 Character'Val (16#02#) => "STX", 54 Character'Val (16#03#) => "ETX", 55 Character'Val (16#04#) => "EOT", 56 Character'Val (16#05#) => "ENQ", 57 Character'Val (16#06#) => "ACK", 58 Character'Val (16#07#) => "BEL", 59 Character'Val (16#08#) => "BS ", 60 Character'Val (16#09#) => "HT ", 61 Character'Val (16#0A#) => "LF ", 62 Character'Val (16#0B#) => "VT ", 63 Character'Val (16#0C#) => "FF ", 64 Character'Val (16#0D#) => "CR ", 65 Character'Val (16#0E#) => "SO ", 66 Character'Val (16#0F#) => "SI ", 67 Character'Val (16#10#) => "DLE", 68 Character'Val (16#11#) => "DC1", 69 Character'Val (16#12#) => "DC2", 70 Character'Val (16#13#) => "DC3", 71 Character'Val (16#14#) => "DC4", 72 Character'Val (16#15#) => "NAK", 73 Character'Val (16#16#) => "SYN", 74 Character'Val (16#17#) => "ETB", 75 Character'Val (16#18#) => "CAN", 76 Character'Val (16#19#) => "EM ", 77 Character'Val (16#1A#) => "SUB", 78 Character'Val (16#1B#) => "ESC", 79 Character'Val (16#1C#) => "FS ", 80 Character'Val (16#1D#) => "GS ", 81 Character'Val (16#1E#) => "RS ", 82 Character'Val (16#1F#) => "US "); 83 84 subtype C1_Range is Character 85 range Character'Val (16#7F#) .. Character'Val (16#9F#); 86 87 C1 : constant array (C1_Range) of Cname := 88 (Character'Val (16#7F#) => "DEL", 89 Character'Val (16#80#) => "res", 90 Character'Val (16#81#) => "res", 91 Character'Val (16#82#) => "BPH", 92 Character'Val (16#83#) => "NBH", 93 Character'Val (16#84#) => "res", 94 Character'Val (16#85#) => "NEL", 95 Character'Val (16#86#) => "SSA", 96 Character'Val (16#87#) => "ESA", 97 Character'Val (16#88#) => "HTS", 98 Character'Val (16#89#) => "HTJ", 99 Character'Val (16#8A#) => "VTS", 100 Character'Val (16#8B#) => "PLD", 101 Character'Val (16#8C#) => "PLU", 102 Character'Val (16#8D#) => "RI ", 103 Character'Val (16#8E#) => "SS2", 104 Character'Val (16#8F#) => "SS3", 105 Character'Val (16#90#) => "DCS", 106 Character'Val (16#91#) => "PU1", 107 Character'Val (16#92#) => "PU2", 108 Character'Val (16#93#) => "STS", 109 Character'Val (16#94#) => "CCH", 110 Character'Val (16#95#) => "MW ", 111 Character'Val (16#96#) => "SPA", 112 Character'Val (16#97#) => "EPA", 113 Character'Val (16#98#) => "SOS", 114 Character'Val (16#99#) => "res", 115 Character'Val (16#9A#) => "SCI", 116 Character'Val (16#9B#) => "CSI", 117 Character'Val (16#9C#) => "ST ", 118 Character'Val (16#9D#) => "OSC", 119 Character'Val (16#9E#) => "PM ", 120 Character'Val (16#9F#) => "APC"); 121 122 begin 123 -- Control characters are represented by their names (RM 3.5(32)) 124 125 if V in C0_Range then 126 S (1 .. 3) := C0 (V); 127 P := (if S (3) = ' ' then 2 else 3); 128 129 elsif V in C1_Range then 130 S (1 .. 3) := C1 (V); 131 132 if S (1) /= 'r' then 133 P := (if S (3) = ' ' then 2 else 3); 134 135 -- Special case, res means RESERVED_nnn where nnn is the three digit 136 -- decimal value corresponding to the code position (more efficient 137 -- to compute than to store). 138 139 else 140 declare 141 VP : constant Natural := Character'Pos (V); 142 begin 143 S (1 .. 9) := "RESERVED_"; 144 S (10) := Character'Val (48 + VP / 100); 145 S (11) := Character'Val (48 + (VP / 10) mod 10); 146 S (12) := Character'Val (48 + VP mod 10); 147 P := 12; 148 end; 149 end if; 150 151 -- Normal characters yield the character enclosed in quotes (RM 3.5(32)) 152 153 else 154 S (1) := '''; 155 S (2) := V; 156 S (3) := '''; 157 P := 3; 158 end if; 159 end Image_Character; 160 161 ------------------------ 162 -- Image_Character_05 -- 163 ------------------------ 164 165 procedure Image_Character_05 166 (V : Character; 167 S : in out String; 168 P : out Natural) 169 is 170 pragma Assert (S'First = 1); 171 begin 172 if V = Character'Val (16#00AD#) then 173 P := 11; 174 S (1 .. P) := "SOFT_HYPHEN"; 175 else 176 Image_Character (V, S, P); 177 end if; 178 end Image_Character_05; 179 180end System.Img_Char; 181