Topspeed_JPI/TS-V3/MODBASE/MEMOFUNC.LST

Listing:

    1  IMPLEMENTATION MODULE MemoFunctions;
    2  
    3  (*
    4   *  ModBase
    5   *  Release 3.0
    6   *  (c) Copyright 1986 - 1991 John McMonagle & Donald G. Fletcher
    7   *  (c) Copyright 1986 - 1991 PMI
    8   *  P.O. Box 8402
    9   *  Green Bay Wi 53308
   10   *  All Rights Reserved
   11   *)
   12  
   13  FROM SYSTEM IMPORT ADR,ADDRESS;
   14  
   15  (*Repertoire modules*)
   16  FROM HandleIO IMPORT BlockRead, BlockWrite,OpenFile,
   17       EndReached, SetFilePtr, GetFilePtr,FileOffSet;
   18  FROM StringIO IMPORT ErrorMessage, NoError, PartialRead, PrintMessage;
   19  FROM StrConv IMPORT StrToLongInteger, LongIntegerToStr;
   20  FROM StrEdit IMPORT Append;
   21  FROM M2Strings IMPORT Length,Pos;
   22  FROM LowLevel IMPORT Fill;
   23  FROM ErrorManager IMPORT WARN;
   24  FROM Numbers IMPORT Min;
   25  (*ModBase modules*)
   26  FROM ModBase3 IMPORT DBFile, GetField,MemoSize, Replace,OpenMemo,MemoHandle;
   27    FROM VStorage IMPORT
   28      DosAlloc, DosDealloc;
   29  
   30    PROCEDURE DEALLOCATE(VAR loc:ADDRESS;size:CARDINAL);
   31    BEGIN
   32      DosDealloc(loc,size);
*****      ^ not supported yet
*****                 ^ not supported yet
*****                         ^ not supported yet
   33    END DEALLOCATE;
*****        ^ not supported yet
   34  
   35    PROCEDURE ALLOCATE(VAR loc:ADDRESS;size:CARDINAL);
   36    BEGIN
   37      DosAlloc(loc,size);
*****      ^ not supported yet
*****               ^ not supported yet
*****                       ^ not supported yet
   38    END ALLOCATE;
*****        ^ not supported yet
   39  
   40  CONST
   41    EndOfMemo = 32C;
   42    MemoBlockSize = 512;
   43    MaxMemoSize   =4000;
   44  
   45  
   46    PROCEDURE PadFile( FileHandle: CARDINAL; TheChar: CHAR;
   47        HowMany: CARDINAL );
   48      VAR
   49        TmpBufPtr: POINTER TO CARDINAL;
*****                              ^ not supported yet
   50      BEGIN
   51        ALLOCATE( TmpBufPtr, HowMany );
*****        ^ not supported yet
*****                  ^ not supported yet
*****                                     ^ not supported yet
   52        Fill( TmpBufPtr, HowMany, TheChar );
*****        ^ not supported yet
*****              ^ not supported yet
*****                                          ^ not supported yet
   53        IF BlockWrite( FileHandle, TmpBufPtr, HowMany ) # NoError THEN
*****           ^ not supported yet
*****                                   ^ not supported yet
*****                                                      ^ not supported yet
*****                                                          ^ not supported yet
   54          HALT;
*****          ^ undeclared identifier
   55        END;
   56        DEALLOCATE( TmpBufPtr, HowMany );
*****        ^ not supported yet
*****                    ^ not supported yet
*****                                       ^ not supported yet
   57      END PadFile;
*****          ^ not supported yet
   58  
   59  PROCEDURE GetMemoField(VAR alias: DBFile; fieldnum: CARDINAL; VAR
   60      memo: ARRAY OF CHAR);
*****                     ^ not supported yet
   61  
   62    VAR
   63      FileError: ErrorMessage;
   64      memostr: ARRAY [0..9] OF CHAR;
*****                         ^ not supported yet
*****                               ^ not supported yet
   65      block: ARRAY[0..MemoSize-1] OF CHAR;
*****                      ^ not supported yet
*****                               ^ not supported yet
*****                                     ^ not supported yet
   66      memopos, memonum: LONGINT;
   67      handle,i: CARDINAL;
   68      fieldok: BOOLEAN;
   69    BEGIN
   70      IF NOT OpenMemo(alias)
*****             ^ not supported yet
*****                      ^ not supported yet
   71      THEN
   72        WARN('Unable to open memo file')
*****        ^ not supported yet
*****             ^ not supported yet
   73      END;
   74      handle:=MemoHandle(alias);
*****              ^ not supported yet
*****                         ^ not supported yet
   75      GetField(alias, fieldnum, memostr);
*****      ^ not supported yet
*****               ^ not supported yet
*****                                ^ not supported yet
   76      (* First check to make sure there is a memo to read *)
   77      IF (StrToLongInteger(memostr,0, memonum))
*****          ^ not supported yet
*****                           ^ not supported yet
*****                                             ^ not supported yet
   78          AND (memonum > VAL(LONGINT,0)) THEN
*****                         ^ undeclared identifier
*****                                      ^ not supported yet
   79        memopos := VAL(LONGINT, MemoBlockSize) * memonum;
*****                   ^ undeclared identifier
*****                                             ^ not supported yet
   80        SetFilePtr(handle, FromStart, memopos);
*****        ^ not supported yet
*****                           ^ undeclared identifier
*****                                             ^ not supported yet
   81        memo[0] := 0C;
*****        ^ not supported yet
*****              ^ not supported yet
   82        block[0] := 0C;
*****        ^ not supported yet
*****               ^ not supported yet
   83        LOOP
   84          FileError := BlockRead(handle, ADR(block[0]), MemoSize);
*****          ^ not supported yet
*****                       ^ not supported yet
*****                                         ^ not supported yet
*****                                             ^ not supported yet
*****                                                    ^ not supported yet
*****                                                        ^ not supported yet
   85          IF (FileError=NoError) OR (FileError=PartialRead)  THEN
*****              ^ not supported yet
*****                        ^ not supported yet
*****                                     ^ not supported yet
*****                                               ^ not supported yet
   86            i:=Pos(EndOfMemo,block);
*****               ^ not supported yet
*****                             ^ not supported yet
   87            IF i<MemoSize THEN
*****                 ^ not supported yet
   88              block[i]:=0C;
*****              ^ not supported yet
*****                     ^ not supported yet
   89              Append(memo,block);
*****              ^ not supported yet
*****                     ^ not supported yet
*****                          ^ not supported yet
   90              EXIT;
   91            ELSE
   92              Append(memo,block);
*****              ^ not supported yet
*****                     ^ not supported yet
*****                          ^ not supported yet
   93            END;
   94          ELSE
   95            EXIT
   96          END;
   97        END;
   98      ELSE (* the memofield was empty *)
   99        memo[0] := 0C;
*****        ^ not supported yet
*****              ^ not supported yet
  100      END;
  101    END GetMemoField;
*****        ^ not supported yet
  102  
  103  
  104  PROCEDURE ReplaceM(VAR alias: DBFile; fieldnum: CARDINAL;VAR  memo:
  105      ARRAY OF CHAR);
*****               ^ not supported yet
  106  
  107    VAR
  108      FileError: ErrorMessage;
  109      ptrstr: ARRAY [0..9] OF CHAR;
*****                        ^ not supported yet
*****                              ^ not supported yet
  110      blocknum, blockpos: LONGINT;
  111      OldMemo   :POINTER TO ARRAY[0..MaxMemoSize]OF CHAR;
*****                                     ^ not supported yet
*****                                                    ^ not supported yet
  112      handle:CARDINAL;
  113   (* seem a bit overkill but use of comparestr will use usualy 8K of stack *)
  114  PROCEDURE StrEqual(VAR str1,str2:ARRAY OF CHAR):BOOLEAN;
*****                                            ^ not supported yet
  115  VAR
  116    limit, count:CARDINAL;
  117  
  118  BEGIN
  119    limit:=Min(HIGH(str1),HIGH(str2));
*****           ^ not supported yet
*****               ^ undeclared identifier
*****                    ^ not supported yet
*****                          ^ undeclared identifier
*****                               ^ not supported yet
  120    count:=0;
  121    WHILE count<limit
  122    DO
  123      IF str1[count]#str2[count]
*****         ^ not supported yet
*****                   ^ not supported yet
*****                     ^ not supported yet
*****                               ^ not supported yet
  124      THEN
  125        RETURN FALSE;
  126      ELSIF str1[count]=0C
*****            ^ not supported yet
*****                      ^ not supported yet
  127      THEN
  128        RETURN TRUE;
  129      END;
  130      INC(count);
*****      ^ undeclared identifier
*****               ^ not supported yet
  131    END (* while *);
  132    IF HIGH(str1)<HIGH(str2)
*****       ^ undeclared identifier
*****            ^ not supported yet
*****                  ^ undeclared identifier
*****                       ^ not supported yet
  133    THEN
  134      RETURN str2[count]=0C;
*****             ^ not supported yet
*****                       ^ not supported yet
  135    ELSIF HIGH(str1)>HIGH(str2)
*****          ^ undeclared identifier
*****               ^ not supported yet
*****                     ^ undeclared identifier
*****                          ^ not supported yet
  136    THEN
  137      RETURN str1[count]=0C
*****             ^ not supported yet
*****                       ^ not supported yet
  138    ELSE
  139      RETURN TRUE;
  140    END;
  141  END StrEqual;
*****      ^ not supported yet
  142  
  143    BEGIN
  144      IF NOT OpenMemo(alias)
*****             ^ not supported yet
*****                      ^ not supported yet
  145      THEN
  146        WARN('Unable to open memo file')
*****        ^ not supported yet
*****             ^ not supported yet
  147      END;
  148      handle:=MemoHandle(alias);
*****              ^ not supported yet
*****                         ^ not supported yet
  149      IF memo[0]#0C THEN (*  Added to avoid writing a '' Memo !!!! *)
*****         ^ not supported yet
*****               ^ not supported yet
  150        (* check to see if memo changed *)
  151        NEW(OldMemo);
*****        ^ undeclared identifier
*****            ^ not supported yet
  152        GetMemoField(alias,fieldnum,OldMemo^);
*****        ^ not supported yet
*****                     ^ not supported yet
*****                                    ^ not supported yet
  153        IF  NOT StrEqual(OldMemo^,memo)
*****                ^ not supported yet
*****                         ^ not supported yet
*****                                  ^ not supported yet
  154        THEN
  155          SetFilePtr(handle, FromStart, VAL(LONGINT,0));
*****          ^ not supported yet
*****                             ^ undeclared identifier
*****                                        ^ undeclared identifier
*****                                                     ^ not supported yet
  156          FileError := BlockRead(handle, ADR(blocknum), 4);
*****          ^ not supported yet
*****                       ^ not supported yet
*****                                         ^ not supported yet
*****                                                     ^ not supported yet
*****                                                         ^ not supported yet
  157          blockpos := blocknum * VAL(LONGINT,MemoBlockSize);
*****                                 ^ undeclared identifier
*****                                                          ^ not supported yet
  158          SetFilePtr(handle, FromStart, blockpos);
*****          ^ not supported yet
*****                             ^ undeclared identifier
*****                                                ^ not supported yet
  159          FileError := BlockWrite(handle, ADR(memo), Length(memo));
*****          ^ not supported yet
*****                       ^ not supported yet
*****                                          ^ not supported yet
*****                                              ^ not supported yet
*****                                                     ^ not supported yet
*****                                                            ^ not supported yet
  160          IF (Length(memo) MOD MemoBlockSize) # 0 THEN
*****              ^ not supported yet
*****                     ^ not supported yet
  161            PadFile( handle, EndOfMemo, MemoBlockSize -
*****            ^ not supported yet
  162                (Length(memo) MOD MemoBlockSize) );
*****                 ^ not supported yet
*****                        ^ not supported yet
*****                                                 ^ not supported yet
  163          END;
  164          LongIntegerToStr(blocknum,  10,ptrstr);
*****          ^ not supported yet
*****                                         ^ not supported yet
  165          Replace(alias, fieldnum, ptrstr);
*****          ^ not supported yet
*****                  ^ not supported yet
*****                                   ^ not supported yet
  166          blockpos := GetFilePtr(handle);
*****                      ^ not supported yet
*****                                       ^ not supported yet
  167            (* find what will be the next available block
  168               And write it to the first  4 bytes of the file *)
  169          blocknum := blockpos DIV VAL(LONGINT,MemoBlockSize);
*****                                   ^ undeclared identifier
*****                                                            ^ not supported yet
  170          SetFilePtr(handle, FromStart, VAL(LONGINT,0));
*****          ^ not supported yet
*****                             ^ undeclared identifier
*****                                        ^ undeclared identifier
*****                                                     ^ not supported yet
  171          FileError := BlockWrite(handle, ADR(blocknum), 4);
*****          ^ not supported yet
*****                       ^ not supported yet
*****                                          ^ not supported yet
*****                                                      ^ not supported yet
*****                                                          ^ not supported yet
  172        END;
  173        DISPOSE(OldMemo);
*****        ^ undeclared identifier
*****                ^ not supported yet
  174      ELSE
  175        Replace(alias, fieldnum,'          ');
*****        ^ not supported yet
*****                ^ not supported yet
*****                                ^ not supported yet
  176      END;
  177    END ReplaceM;
*****        ^ not supported yet
  178  
  179  BEGIN
  180  END MemoFunctions.
*****      ^ not supported yet

  176 errors