Topspeed_JPI/TS-V3/SRC/FORMIO.LST

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 (p<fwidth) DO
  217               Res[j] := ' '; INC(j); INC(p);
  218             END;
  219             Res[j] := CHR(0);
  220             Str.Append(Res,buff);
  221             j := Str.Length(Res);
  222           ELSE
  223             Res[j] := CHR(0);
  224             Str.Append(Res,buff);
  225             j := Str.Length(Res);
  226             WHILE (p<fwidth) DO
  227               Res[j] := ' '; INC(j); INC(p);
  228             END;
  229           END;
  230        END;
  231      END;
  232      IF storechar THEN
  233         Res[j] := c; INC(j);
  234      END;
  235      IF (j>h) 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