Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * PRINTFBA.MOD - COMMS Toolkit formatted i/o support * 5 * * 6 * COPYRIGHT (C) 1988..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 IMPLEMENTATION MODULE PrintFBase; 12 IMPORT Lib,IO; 13 14 CONST 15 MaxArgs = 5; 16 UpperDigits = '0123456789ABCDEF'; ***** ^ not supported yet 17 LowerDigits = '0123456789abcdef'; ***** ^ not supported yet 18 19 TYPE 20 StringPtr = POINTER TO ARRAY[0..0FFFH] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 21 JustifyTypes = (Left,Right,Centre); 22 CardType = (short,card,long); 23 CardPointer = POINTER TO RECORD 24 CASE :CardType OF ***** ^ not supported yet ***** ^ 'POINTER' expected 25 short : shortp : SHORTCARD; | 26 card : cardp : CARDINAL; | 27 long : longp : LONGCARD; | 28 END; 29 END; 30 31 VAR 32 PatAddr,DestAddr : StringPtr; 33 NumberBase : LONGCARD; 34 ArgNo,ArgCount,Patp, 35 Destp,PatMax,DestMax: CARDINAL; 36 ArgList : ARRAY[0..MaxArgs-1] OF ADDRESS; 37 Size : ARRAY[0..MaxArgs-1] OF CARDINAL; 38 Digits : ARRAY[0..15] OF CHAR; 39 Convert : ARRAY[0..51] OF PROC; 40 41 (*....................................*) 42 43 PROCEDURE Length(VAR s:ARRAY OF CHAR; Max:CARDINAL):CARDINAL; 44 BEGIN 45 RETURN Lib.ScanR(ADR(s),Max,0C); 46 END Length; 47 48 (*....................................*) 49 50 PROCEDURE Justify(Justification:JustifyTypes;VAR dest:ARRAY OF CHAR;Lnth:CARDINAL;PadChar:CHAR):CARDINAL; 51 VAR 52 Len : CARDINAL; 53 BEGIN 54 Len := Lib.ScanR(ADR(dest),HIGH(dest)+1,0C); 55 LOOP 56 IF Len>=Lnth THEN 57 EXIT; 58 END; 59 IF (Justification=Right) OR (Justification=Centre) THEN 60 INC(Len); 61 Lib.Move(ADR(dest),ADR(dest[1]),Len); 62 dest[0]:=PadChar; 63 END; 64 IF Len>=Lnth THEN 65 EXIT; 66 END; 67 IF (Justification=Left) OR (Justification=Centre) THEN 68 dest[Len]:=PadChar; 69 INC(Len); 70 dest[Len]:=0C; 71 END 72 END; 73 RETURN Len; 74 END Justify; 75 76 (*............................................*) 77 78 PROCEDURE Error(ErrNo:CARDINAL); 79 VAR 80 argnumstr : ARRAY[0..9] OF CHAR; 81 BEGIN 82 IO.WrLn; 83 IO.WrStr('PrintF Error --> '); 84 CASE ErrNo OF 85 1 : IO.WrStr('Unexpected end of spec. input.'); | 86 2 : IO.WrStr('Argument does not match specification.');| 87 3 : IO.WrStr('Wrong number of args.'); | 88 4 : IO.WrStr('Not a recognised field specifier'); | 89 5 : IO.WrStr('Not enough room in dest string.'); | 90 6 : IO.WrStr('Char codes must be three digits.'); | 91 7 : IO.WrStr('Width argument must be cardinal.'); | 92 8 : IO.WrStr('NewConversion, Type Char must be in {a..z, A..Z}');| 93 END; (* cases *) 94 IO.WrLn; 95 HALT; 96 END Error; 97 98 (*....................................*) 99 100 PROCEDURE CToS(c:LONGCARD; VAR i:CARDINAL); 101 BEGIN 102 IF c>=NumberBase THEN 103 CToS(c DIV NumberBase,i); 104 END; 105 DestString[i] := Digits[CARDINAL(c MOD NumberBase)]; 106 INC(i); 107 END CToS; 108 109 (*....................................*) 110 111 PROCEDURE ReadLong(VAR l:LONGCARD); 112 VAR 113 p : CardPointer; 114 BEGIN 115 p := Data; 116 IF DataSize=1 THEN 117 l := LONGCARD(p^.shortp) 118 ELSIF DataSize=2 THEN 119 l := LONGCARD(p^.cardp) 120 ELSIF DataSize=4 THEN 121 l := p^.longp 122 ELSE 123 Error(2); 124 END; 125 END ReadLong; 126 127 (*....................................*) 128 129 PROCEDURE CardToString; 130 (* Handle conversion to string of SHORTCARD,CARDINAL and LONGCARD for*) 131 (* all number bases from 2-16. Note that only bases 8,10 & 16 are *) 132 (* supported by the field spec protocol. *) 133 VAR 134 i : CARDINAL; 135 c : LONGCARD; 136 BEGIN 137 IF TypeChar='o' THEN 138 NumberBase := 8; 139 ELSIF TypeChar='u' THEN 140 NumberBase := 10; 141 ELSE 142 NumberBase := 16; 143 END; 144 ReadLong(c); 145 i:=0; 146 IF AlwaysSigned THEN 147 DestString[0]:=Positive; 148 INC(i); 149 END; 150 CToS(c,i); 151 DestString[i]:=0C; 152 END CardToString; 153 154 (*....................................*) 155 156 PROCEDURE LowerCaseHex; 157 BEGIN 158 Digits:=LowerDigits; 159 CardToString; 160 Digits:=UpperDigits 161 END LowerCaseHex; 162 163 (*....................................*) 164 165 PROCEDURE IntToString; 166 (* Handle conversion to string of SHORTINT,INTEGER and LONGINT *) 167 VAR 168 i : CARDINAL; 169 p : CardPointer; 170 x : LONGINT; 171 BEGIN 172 NumberBase := 10; 173 p := Data; 174 IF DataSize=1 THEN 175 x := LONGINT(SHORTINT(p^.shortp)) 176 ELSIF DataSize=2 THEN 177 x := LONGINT(INTEGER(p^.cardp)) 178 ELSIF DataSize=4 THEN 179 x := LONGINT(p^.longp) 180 ELSE 181 Error(2); 182 END; 183 i:=0; 184 IF x<0 THEN 185 DestString[0]:='-'; INC(i); x:=-x 186 ELSIF AlwaysSigned THEN 187 DestString[0]:=Positive; INC(i) 188 END; 189 CToS(LONGCARD(x),i); 190 DestString[i]:=0C; 191 END IntToString; 192 193 (*....................................*) 194 195 PROCEDURE CopyString; 196 VAR 197 Lnth : CARDINAL; 198 stringp : StringPtr; 199 BEGIN 200 stringp := Data; 201 Lnth := Length(stringp^,DataSize); 202 Lib.Move(Data,ADR(DestString),Lnth); 203 DestString[Lnth] := 0C; 204 END CopyString; 205 206 (*....................................*) 207 208 PROCEDURE StoreChar(Ch:CHAR); 209 BEGIN 210 IF Destp<>DestMax THEN 211 DestAddr^[Destp] := Ch; 212 INC(Destp); 213 END; 214 END StoreChar; 215 216 (*....................................*) 217 218 PROCEDURE CopyChar; 219 VAR 220 charp : POINTER TO CHAR; 221 BEGIN 222 IF DataSize=1 THEN 223 charp := Data; 224 DestString[0] := charp^; 225 DestString[1] := 0C 226 ELSE 227 Error(2) 228 END; 229 END CopyChar; 230 231 (*....................................*) 232 233 PROCEDURE Parse; 234 VAR 235 Ch : CHAR; 236 237 (*. . . . . . . . . . . . . . . . . . .*) 238 239 PROCEDURE GetChar(VAR Ch:CHAR):BOOLEAN; 240 BEGIN 241 IF Patp=PatMax THEN 242 Ch := 0C; 243 ELSE 244 Ch := PatAddr^[Patp]; 245 INC(Patp); 246 END; 247 RETURN Ch<>0C; 248 END GetChar; 249 250 (*. . . . . . . . . . . . . . . . . . .*) 251 252 PROCEDURE NextChar; 253 BEGIN 254 IF NOT GetChar(Ch) THEN 255 Error(1); 256 END; 257 END NextChar; 258 259 (*. . . . . . . . . . . . . . . . . . .*) 260 261 PROCEDURE ReadNumber(VAR c:CARDINAL); 262 VAR 263 temp : LONGCARD; 264 BEGIN 265 IF Ch='*' THEN 266 NextChar; 267 IF ArgNo=ArgCount THEN 268 Error(3); 269 END; 270 Data:=ArgList[ArgNo]; 271 DataSize:=Size[ArgNo]; 272 INC(ArgNo); 273 ReadLong(temp); 274 IF temp>255 THEN 275 Error(7); 276 ELSE 277 c:=CARDINAL(temp); 278 END; 279 ELSE 280 c := 0; 281 WHILE (Ch>='0') AND (Ch<='9') DO 282 c := c*10 + ORD(Ch)-48; 283 NextChar; 284 END; 285 END; 286 END ReadNumber; 287 288 (*. . . . . . . . . . . . . . . . . . .*) 289 290 PROCEDURE FieldSpecification; 291 VAR 292 Lnth,i : CARDINAL; 293 Just : JustifyTypes; 294 TestCh : CHAR; 295 BEGIN 296 IF ArgNo=ArgCount THEN 297 Error(3); 298 END; 299 RightJustify:=TRUE; 300 FieldWidth:=0; 301 Places:=5; 302 PadChar:=' '; 303 AlwaysSigned:=FALSE; 304 NextChar; 305 IF Ch='%' THEN 306 StoreChar(Ch); 307 RETURN; 308 END; 309 LOOP 310 IF Ch='-' THEN 311 RightJustify:=FALSE; 312 NextChar; 313 ELSIF (Ch='+') OR (Ch=' ') THEN 314 AlwaysSigned:=TRUE; Positive:=Ch; NextChar 315 ELSIF Ch='0' THEN 316 PadChar:='0'; 317 NextChar; 318 ELSIF (Ch>='1') AND (Ch<='9') THEN 319 ReadNumber(FieldWidth); 320 IF Ch='.' THEN 321 NextChar; 322 ReadNumber(Places); 323 END; 324 ELSE 325 EXIT; 326 END; 327 END; 328 TestCh := CAP(Ch); 329 IF (TestCh>='A') AND (TestCh<='Z') THEN 330 TypeChar := Ch; 331 IF ArgNo=ArgCount THEN 332 Error(3); 333 END; 334 Data := ArgList[ArgNo]; 335 DataSize := Size[ArgNo]; 336 IF (TypeChar>='a') AND (TypeChar<='z') THEN 337 i := ORD(TypeChar)-ORD('a') 338 ELSE 339 i := 26 + (ORD(TypeChar)-ORD('A')) 340 END; 341 IF Convert[i]=NULLPROC THEN 342 Error(4); 343 ELSE 344 Convert[i](); 345 END; 346 ELSE 347 Error(4); 348 END; 349 IF RightJustify THEN 350 Just:=Right; 351 ELSE 352 Just:=Left; 353 END; 354 Lnth := Justify(Just,DestString,FieldWidth,PadChar); 355 IF Destp+Lnth>DestMax THEN 356 Lnth:=DestMax-Destp; 357 END; 358 Lib.Move(ADR(DestString),ADR(DestAddr^[Destp]),Lnth); 359 INC(Destp,Lnth); 360 INC(ArgNo); 361 END FieldSpecification; 362 363 (*. . . . . . . . . . . . . . . . . . .*) 364 365 PROCEDURE SwitchChar; 366 VAR 367 code,i : CARDINAL; 368 c : CHAR; 369 BEGIN 370 NextChar; 371 CASE CAP(Ch) OF 372 'B' : c:=CHR(8); | 373 'F' : c:=CHR(12); | 374 'N' : StoreChar(CHR(13)); 375 c:=CHR(10); | 376 'R' : c:=CHR(13); | 377 'T' : c:=CHR(9); | 378 '0'..'9' : code:=ORD(Ch)-48; 379 FOR i:=0 TO 1 DO 380 NextChar; 381 IF (Ch<'0') OR (Ch>'9') THEN 382 Error(6); 383 END; 384 code:=code*10+ORD(Ch)-48; 385 END; 386 c := CHR(code); | 387 ELSE 388 c := Ch 389 END; (* cases *) 390 StoreChar(c); 391 END SwitchChar; 392 393 (*. . . . . . . . . . . . . . . . . . .*) 394 395 BEGIN (* Parse *) 396 ArgNo:=0; 397 WHILE GetChar(Ch) DO 398 IF Ch='%' THEN 399 FieldSpecification 400 ELSIF Ch='\' THEN 401 SwitchChar 402 ELSE 403 StoreChar(Ch); 404 END; 405 END; 406 StoreChar(0C); 407 END Parse; 408 409 (*...............................................*) 410 411 PROCEDURE DoPrintF(VAR pat:ARRAY OF CHAR;VAR arg1,arg2,arg3,arg4,arg5:ARRAY OF BYTE;VAR dest:ARRAY OF CHAR;NumArgs:CARDINAL); 412 BEGIN 413 ArgCount := NumArgs; 414 PatAddr:=ADR(pat); 415 Patp:=0; 416 PatMax:=HIGH(pat)+1; 417 DestAddr:=ADR(dest); 418 Destp:=0; 419 DestMax:=HIGH(dest)+1; 420 ArgList[0]:=ADR(arg1); 421 Size[0]:=HIGH(arg1)+1; 422 ArgList[1]:=ADR(arg2); 423 Size[1]:=HIGH(arg2)+1; 424 ArgList[2]:=ADR(arg3); 425 Size[2]:=HIGH(arg3)+1; 426 ArgList[3]:=ADR(arg4); 427 Size[3]:=HIGH(arg4)+1; 428 ArgList[4]:=ADR(arg5); 429 Size[4]:=HIGH(arg5)+1; 430 Digits := UpperDigits; 431 Parse; 432 END DoPrintF; 433 434 (*...............................................*) 435 436 PROCEDURE NewConversion(TypeChar:CHAR; ConvertRoutine:PROC); 437 VAR 438 i : CARDINAL; 439 BEGIN 440 IF (CAP(TypeChar)>='A') AND (CAP(TypeChar)<='Z') THEN 441 IF (TypeChar>='a') AND (TypeChar<='z') THEN 442 i := ORD(TypeChar)-ORD('a') 443 ELSE 444 i := 26 + (ORD(TypeChar)-ORD('A')) 445 END; 446 Convert[i] := ConvertRoutine 447 ELSE 448 Error(8); 449 END; 450 END NewConversion; 451 452 (*..................................................*) 453 454 PROCEDURE InitPrintF; 455 VAR 456 i : CARDINAL; 457 BEGIN 458 FOR i:=0 TO 51 DO 459 Convert[i]:=PROC(NIL) 460 END; 461 NewConversion('i',IntToString); 462 NewConversion('u',CardToString); 463 NewConversion('H',CardToString); 464 NewConversion('h',LowerCaseHex); 465 NewConversion('X',CardToString); 466 NewConversion('x',LowerCaseHex); 467 NewConversion('o',CardToString); 468 NewConversion('c',CopyChar); 469 NewConversion('s',CopyString); 470 END InitPrintF; 471 472 (*..................................................*) 473 474 BEGIN 475 InitPrintF; 476 END PrintFBase. 477 6 errors