Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * FORMIO.MOD - Formatted input/output * 5 * * 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 (*%F _fdata *) 12 (*# call(seg_name => null) *) 13 (*# data(seg_name => null) *) 14 (*%E *) 15 16 (*# check(stack=>off, 17 index=>off, 18 range=>off, 19 overflow=>off, 20 nil_ptr=>off) *) 21 (*# module(implementation=>off) *) 22 23 IMPLEMENTATION MODULE FormIO; 24 25 (*# call(o_a_copy=>off) *) 26 27 IMPORT SYSTEM,Str,IO; 28 29 CONST 30 MaxStrSize = 511; 31 TYPE 32 MaxStr = ARRAY [0..MaxStrSize] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 33 34 35 (* 36 37 FormatString = { Alpha | FieldSpecifier | SwitchChar } 38 39 Alpha = any ascii char except '%' and '\' 40 41 FieldSpecifier = '%' '%' 42 | '% ['-'] [WidthSpecifier] TypeSpecifier 43 44 WidthSpecifier = DecimalNumber [ '.' DecimalNumber ] 45 46 TypeSpecifier = 'u' (* Unsigned *) 47 | 'i' (* Signed *) 48 | 'r' (* Real *) 49 | 'c' (* Character *) 50 | 's' (* String *) 51 | 'h' (* Hex (unsigned) *) 52 | 'b' (* Boolean *) 53 | 'p' (* Pointer / Address *) 54 55 SwitchChar = '\' SwitchOptions 56 57 SwitchOptions = '\' (* \ *) 58 | '%' (* % *) 59 | 'b' (* BS = CHR(8) *) 60 | 'f' (* FF = CHR(12) *) 61 | 'n' (* NL = CHR(13),CHR(10) *) 62 | 't' (* Tab = CHR(9) *) 63 | 'e' (* Esc = CHR(27) *) 64 | CharCode 65 66 CharCode = DecimalNumber 67 68 DecimalNumber = Digit [ Digit [ Digit ] ] 69 70 *) 71 72 TYPE ParamRec = RECORD 73 size : CARDINAL; 74 adr : ADDRESS; ***** ^ undeclared identifier 75 END; ***** ^ not supported yet 76 77 78 PROCEDURE Format ( VAR Res : ARRAY OF CHAR; ***** ^ not supported yet 79 Pat : ARRAY OF CHAR; ***** ^ not supported yet 80 Params : ARRAY OF ParamRec ); ***** ^ not supported yet 81 VAR 82 buff : MaxStr; ***** ^ not supported yet 83 hb : ARRAY [0..4] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 84 rjust : BOOLEAN; 85 fwidth : CARDINAL; 86 fnum : CARDINAL; 87 fsize : CARDINAL; 88 places : CARDINAL; 89 lc : LONGCARD; ***** ^ undeclared identifier 90 lr : LONGREAL; 91 li : LONGINT; 92 i,j,h,l,p : CARDINAL; 93 storechar : BOOLEAN; 94 c : CHAR; 95 Ok : BOOLEAN; 96 base : CARDINAL; 97 f : POINTER TO 98 RECORD CASE : SHORTCARD OF ***** ^ not supported yet ***** ^ 'POINTER' expected 99 0 : si : SHORTINT | 100 1 : i : INTEGER | 101 2 : li : LONGINT | 102 3 : sc : SHORTCARD | 103 4 : c : CARDINAL | 104 5 : lc : LONGCARD | 105 6 : r : REAL | 106 7 : lr : LONGREAL | 107 8 : ch : CHAR | 108 9 : a : ADDRESS | 109 10 : b : BOOLEAN | 110 11 : str : MaxStr; 111 END; 112 END; 113 114 PROCEDURE GetNum():CARDINAL; (* leaves i and c changed *) 115 VAR 116 n,nc : CARDINAL; 117 BEGIN 118 n := 0; 119 FOR nc := 0 TO 2 DO 120 IF (i >= l) OR (c < '0') OR (c > '9') THEN 121 RETURN n; 122 END; (*IF*) 123 n := n * 10 + ORD(c) - ORD('0'); 124 c := Pat[i]; 125 INC(i); 126 END; (*FOR*) 127 RETURN n; 128 END GetNum; 129 130 BEGIN 131 fnum := 0; 132 h := HIGH(Res); 133 l := Str.Length(Pat); 134 Res[0] := 0C; 135 i := 0; j := 0; 136 LOOP 137 IF i=l THEN EXIT END; 138 storechar := TRUE; 139 c := Pat[i]; INC(i); 140 IF c = '\' THEN 141 c := Pat[i]; INC(i); 142 CASE CAP(c) OF 143 'B':c:=CHR(8); 144 | 'F':c:=CHR(12); 145 | 'E':c:=CHR(27); 146 | 'N':Res[j] := CHR(13); INC(j); c := CHR(10); 147 | 'T':c:=CHR(9); 148 | '0'..'9':DEC(i); c:= CHR(GetNum()); 149 END; 150 ELSIF (c='%')AND(i<>l) THEN 151 c := Pat[i]; INC(i); 152 (* pattern found *) 153 rjust:=TRUE; places:=5; 154 storechar := FALSE; 155 IF c='-' THEN rjust := FALSE; c := Pat[i]; INC(i); 156 END; 157 fwidth := GetNum(); 158 IF c='.' THEN 159 c := Pat[i]; INC(i); 160 places := GetNum(); 161 END; 162 IF fnum<=HIGH(Params) THEN 163 WITH Params[fnum] DO 164 fsize := size; 165 f := adr; 166 END; 167 INC(fnum); 168 c := CAP(c); 169 Ok := TRUE; 170 buff[0] := 0C; 171 CASE c OF 172 'I': IF fsize=1 THEN li := LONGINT(f^.si) 173 ELSIF fsize=2 THEN li := LONGINT(f^.i) 174 ELSIF fsize=4 THEN li := LONGINT(f^.li); 175 ELSE Ok := FALSE; 176 END; 177 IF Ok THEN 178 Str.IntToStr(li,buff,10,Ok); 179 END; 180 | 'U', 181 'H': IF fsize=1 THEN lc := LONGCARD(f^.sc) 182 ELSIF fsize=2 THEN lc := LONGCARD(f^.c) 183 ELSIF fsize=4 THEN lc := LONGCARD(f^.lc); 184 ELSE Ok := FALSE ; 185 END; 186 IF Ok THEN 187 base := 10; IF c='H' THEN base := 16 END; 188 Str.CardToStr(lc,buff,base,Ok); 189 END; 190 | 'P': IF fsize <> 4 THEN Ok := FALSE END; 191 IF Ok THEN 192 Str.CardToStr(LONGCARD(SYSTEM.Seg(f^.a^)),buff,16,Ok); 193 Str.Append(buff,':'); 194 Str.CardToStr(LONGCARD(SYSTEM.Ofs(f^.a^)),hb,16,Ok); 195 Str.Append(buff,hb); 196 END; 197 | 'R': IF fsize=4 THEN lr := LONGREAL(f^.r) 198 ELSIF fsize=8 THEN lr := LONGREAL(f^.lr); 199 ELSE Ok := FALSE; 200 END; 201 IF Ok THEN 202 Str.RealToStr(lr,places,FALSE,buff,Ok); 203 END; 204 | 'S': Str.Copy(buff,f^.str); 205 IF fsize < SIZE(buff) THEN buff[fsize] := CHR(0) END; 206 | 'C': buff[0] := f^.ch; buff[1] := CHR(0); 207 | 'B': IF fsize=1 THEN 208 IF f^.b THEN buff := 'TRUE' ELSE buff := 'FALSE' END; 209 END; 210 ELSE storechar := TRUE; 211 END; 212 Res[j] := CHR(0); 213 IF NOT Ok THEN buff := '????' END; 214 p := Str.Length(buff); 215 IF rjust THEN 216 WHILE (ph) THEN EXIT END; 236 END; 237 IF (j<=h) THEN Res[j] := CHR(0) END; 238 END Format; 239 240 241 PROCEDURE WrF1 ( Pat : ARRAY OF CHAR; 242 P1 : ARRAY OF BYTE ); 243 VAR 244 params : ARRAY [0..0] OF ParamRec; 245 res : MaxStr; 246 BEGIN 247 params[0].size := SIZE(P1); 248 params[0].adr := ADR(P1); 249 Format(res,Pat,params); 250 IO.WrStr(res); 251 END WrF1; 252 253 PROCEDURE WrF2 ( Pat : ARRAY OF CHAR; 254 P1,P2 : ARRAY OF BYTE ); 255 VAR 256 params : ARRAY [0..1] OF ParamRec; 257 res : MaxStr; 258 BEGIN 259 params[0].size := SIZE(P1); 260 params[0].adr := ADR(P1); 261 params[1].size := SIZE(P2); 262 params[1].adr := ADR(P2); 263 Format(res,Pat,params); 264 IO.WrStr(res); 265 END WrF2; 266 267 PROCEDURE WrF3 ( Pat : ARRAY OF CHAR; 268 P1,P2,P3 : ARRAY OF BYTE ); 269 VAR 270 params : ARRAY [0..2] OF ParamRec; 271 res : MaxStr; 272 BEGIN 273 params[0].size := SIZE(P1); 274 params[0].adr := ADR(P1); 275 params[1].size := SIZE(P2); 276 params[1].adr := ADR(P2); 277 params[2].size := SIZE(P3); 278 params[2].adr := ADR(P3); 279 Format(res,Pat,params); 280 IO.WrStr(res); 281 END WrF3; 282 283 PROCEDURE WrF4 ( Pat : ARRAY OF CHAR; 284 P1,P2,P3,P4 : ARRAY OF BYTE ); 285 VAR 286 params : ARRAY [0..3] OF ParamRec; 287 res : MaxStr; 288 BEGIN 289 params[0].size := SIZE(P1); 290 params[0].adr := ADR(P1); 291 params[1].size := SIZE(P2); 292 params[1].adr := ADR(P2); 293 params[2].size := SIZE(P3); 294 params[2].adr := ADR(P3); 295 params[3].size := SIZE(P4); 296 params[3].adr := ADR(P4); 297 Format(res,Pat,params); 298 IO.WrStr(res); 299 END WrF4; 300 301 PROCEDURE WrF5 ( Pat : ARRAY OF CHAR; 302 P1,P2,P3,P4,P5 : ARRAY OF BYTE ); 303 VAR 304 params : ARRAY [0..4] OF ParamRec; 305 res : MaxStr; 306 BEGIN 307 params[0].size := SIZE(P1); 308 params[0].adr := ADR(P1); 309 params[1].size := SIZE(P2); 310 params[1].adr := ADR(P2); 311 params[2].size := SIZE(P3); 312 params[2].adr := ADR(P3); 313 params[3].size := SIZE(P4); 314 params[3].adr := ADR(P4); 315 params[4].size := SIZE(P5); 316 params[4].adr := ADR(P5); 317 Format(res,Pat,params); 318 IO.WrStr(res); 319 END WrF5; 320 321 PROCEDURE WrF ( Pat : ARRAY OF CHAR ); 322 VAR 323 c : CARDINAL; 324 BEGIN 325 c := 0; 326 WrF1(Pat,c); 327 END WrF; 328 329 330 END FormIO. 13 errors