Topspeed_JPI/TS-V3/SRC/FIOX.LST

Listing:

    1  (*# call(o_a_size=>off) *)
    2  (*# call(o_a_copy=>off) *)
    3  (*# call(near_call=>on) *)
    4  IMPLEMENTATION MODULE FIOx;
    5  (*
    6          Copyright (C) 1988,1989,1990 Jensen & Partners International
    7  *)
    8  
    9  
   10    IMPORT FIO;
   11    (*%T _OS2 *) IMPORT Dos; (*%E*)
   12    (*%F _OS2 *) IMPORT Lib, SYSTEM, Str (*%T _mthread *),Process (*%E *); (*%E*)
   13  
   14    VAR
   15      _multi_mode : MultiMode;
*****                    ^ undeclared identifier
   16      LocalError : CARDINAL;
   17  
   18  (*************************)
   19  (****** DOS Section ******)
   20  (*************************)
   21  (*%F _OS2 *)
   22  
   23    VAR
   24      DosVerMaj,
   25      DosVerMin : SHORTCARD;
   26  
   27  
   28    PROCEDURE FileLocks(f: File; VAR unlock,lock: LockRec): CARDINAL;
   29      VAR
   30        regs : SYSTEM.Registers;
   31        tmp  : POINTER TO LockRec;
   32        mode : SHORTCARD;
   33      BEGIN
   34        mode := 1;
   35        tmp := SYSTEM.ADR(unlock);
   36        LOOP
   37          IF tmp#NIL THEN
   38            WITH regs DO
   39              AH := 5CH;
   40              AL := mode;
   41              BX := f;
   42              CX := CARDINAL(tmp^.pos DIV 65536);
   43              DX := CARDINAL(tmp^.pos MOD 65536);
   44              SI := CARDINAL(tmp^.len DIV 65536);
   45              DI := CARDINAL(tmp^.len MOD 65536);
   46            END;
   47            (*%T _mthread *) Process.Lock(); (*%E *)
   48            Lib.Dos(regs);
   49            (*%T _mthread *) Process.Unlock(); (*%E *)
   50            IF SYSTEM.CarryFlag IN regs.Flags THEN
   51              RETURN regs.AX;
   52            END;
   53          END;
   54          IF mode=0 THEN
   55            EXIT;
   56          END;
   57          tmp := SYSTEM.ADR(lock);
   58          DEC(mode);
   59        END;
   60        RETURN NO_ERROR;
   61      END FileLocks;
   62  
   63  
   64    PROCEDURE Multi(): MultiMode;
   65      BEGIN
   66        RETURN _multi_mode;
   67      END Multi;
   68  
   69  
   70    PROCEDURE MultiFile(f: File): BOOLEAN;
   71      VAR
   72        regs : SYSTEM.Registers;
   73      BEGIN
   74        IF _multi_mode=_multi_file THEN
   75          WITH regs DO
   76            AH := 44H;
   77            AL := 0AH;
   78            BX := f;
   79            Lib.Dos(regs);
   80            RETURN NOT (SYSTEM.CarryFlag IN Flags) AND (15 IN BITSET(DX));
   81          END;
   82        ELSE
   83          RETURN _multi_mode=_multi_yes;
   84        END;
   85      END MultiFile;
   86  
   87  
   88  
   89  
   90  (*# save *)
   91  (*%T _fcall *) (*# call(near_call=>off) *) (*%E *)
   92    PROCEDURE DelayDefault();
   93      BEGIN
   94        (*%T _mthread *) Process.Delay(DelayDefaultValue DIV 50); (*%E *)
   95        (*%F _mthread *) Lib.Delay(DelayDefaultValue); (*%E *)
   96      END DelayDefault;
   97  (*# restore *)
   98  
   99  
  100    PROCEDURE Init;
  101      VAR
  102        regs : SYSTEM.Registers;
  103        str : ARRAY[0..5] OF CHAR;
  104      BEGIN
  105        _multi_mode := _multi_file;
  106        WITH regs DO
  107          AH := 30H;
  108          Lib.Dos(regs);
  109          DosVerMaj := AL;
  110          DosVerMin := AH;
  111          Lib.EnvironmentFind('multi',str);
  112          Str.Caps(str);
  113          IF Str.Compare(str,'YES')=0 THEN
  114            _multi_mode := _multi_yes;
  115          ELSIF Str.Compare(str,'NO')=0 THEN
  116            _multi_mode := _multi_no;
  117          ELSIF DosVerMaj >= 3 THEN
  118            AH := 10H;
  119            AL := 0;
  120            Lib.Intr(regs,2FH);
  121            IF AL=0FFH THEN
  122              _multi_mode := _multi_yes;
  123            END;
  124          END;
  125        END;
  126      END Init;
  127  
  128  
  129  (*%E *)
  130  (**************************)
  131  (****** OS/2 Section ******)
  132  (**************************)
  133  (*%T _OS2 *)
  134  
  135  
  136  
  137    PROCEDURE Multi(): MultiMode;
*****                       ^ undeclared identifier
  138      BEGIN
  139        RETURN _multi_yes;
*****               ^ undeclared identifier
  140      END Multi;
*****          ^ not supported yet
  141  
  142  
  143    PROCEDURE MultiFile(f: File): BOOLEAN;
*****                           ^ undeclared identifier
  144      BEGIN
  145        RETURN TRUE;
  146      END MultiFile;
*****          ^ not supported yet
  147  
  148  
  149  
  150  
  151  (*%F _fptr *)
  152  (*# save *)
  153  (*# call(inline=>on) *)
  154  (*# call(reg_param=>(cx)) *)
  155  (*# call(reg_return=>(cx,dx)) *)
  156  (*# call(reg_saved=>(ax,bx,cx,si,di,ds,es,st1,st2)) *)
  157  (*# data(near_ptr=>off) *)
  158    TYPE
  159      A6 = ARRAY[0..5] OF SHORTCARD;
  160      LR_PTR = POINTER TO Dos.LOCKRANGE;
  161    PROCEDURE LR_ptr(a: NearADDRESS): LR_PTR=A6(033H,0D2H, (*  xor  dx,dx *)
  162                                                0E3H,002H, (*  jcxz $0    *)
  163                                                08CH,0DAH);(*  mov  dx,ds *)
  164                                                           (* $0:         *)
  165  (*# restore *)
  166  (*%E *)
  167  
  168  
  169    PROCEDURE FileLocks(f: File; VAR unlock,lock: LockRec): CARDINAL;
*****                           ^ undeclared identifier
*****                                                  ^ undeclared identifier
  170      BEGIN
  171  (*%T _fptr *)
  172        RETURN Dos.FileLocks(f,Dos.LOCKRANGE(unlock),Dos.LOCKRANGE(lock));
*****               ^ not supported yet
*****                   ^ not supported yet
*****                             ^ not supported yet
*****                               ^ not supported yet
*****                                   ^ not supported yet
*****                                             ^ not supported yet
*****                                                     ^ not supported yet
*****                                                         ^ not supported yet
*****                                                                   ^ not supported yet
  173  (*%E *)
  174  (*%F _fptr *)
  175        RETURN Dos.FileLocks(f,LR_ptr(ADR(unlock))^,LR_ptr(ADR(lock))^);
  176  (*%E *)
  177      END FileLocks;
*****          ^ not supported yet
  178  
  179  
  180  (*# save *)
  181  (*%T _fcall *) (*# call(near_call=>off) *) (*%E *)
  182    PROCEDURE DelayDefault();
  183      BEGIN
  184        Dos.Sleep(DelayDefaultValue);
*****        ^ not supported yet
*****            ^ not supported yet
*****                  ^ undeclared identifier
  185      END DelayDefault;
*****          ^ not supported yet
  186  (*# restore *)
  187  
  188  
  189    PROCEDURE Init();
  190      BEGIN
  191      END Init;
*****          ^ not supported yet
  192  
  193  
  194  (*%E *)
  195  (****************************)
  196  (****** Common Section ******)
  197  (****************************)
  198  
  199    PROCEDURE Open(Name: ARRAY OF CHAR; Share,ReadOnly,Create: BOOLEAN): File;
*****                                  ^ not supported yet
*****                                                                         ^ undeclared identifier
  200      TYPE
  201        Mn = ARRAY BOOLEAN OF BITSET;
*****                   ^ not supported yet
*****                              ^ undeclared identifier
  202        Mj = ARRAY BOOLEAN OF Mn;
*****                   ^ not supported yet
*****                              ^ not supported yet
  203        ST = ARRAY[0..64] OF CHAR;
*****                      ^ not supported yet
*****                             ^ not supported yet
  204      CONST
  205        m_Std = {};
*****                 ^ not supported yet
  206        m_ReadWrite = {1};
*****                       ^ not supported yet
  207        m_ReadOnly = {};
*****                      ^ not supported yet
  208        m_DenyAll = {4};
*****                     ^ not supported yet
  209        m_DenyWrite = {5};
*****                       ^ not supported yet
  210        m_DenyNone = {6};
*****                      ^ not supported yet
  211        M = Mj(Mn((m_Std+m_ReadWrite+m_DenyAll),
  212                  (m_Std+m_ReadWrite+m_DenyNone)),
*****                                                ^ not supported yet
  213               Mn((m_Std+m_ReadOnly +m_DenyAll),
  214                  (m_Std+m_ReadOnly +m_DenyWrite)));
*****                                                 ^ not supported yet
  215        m_Test = (m_Std+m_ReadOnly+m_DenyNone);
  216      VAR
  217        multi : BOOLEAN;
  218        h : File;
*****            ^ undeclared identifier
  219        savesharemode : BITSET;
*****                        ^ undeclared identifier
  220      BEGIN
  221        IF Create AND (ReadOnly OR Share) THEN
  222          RETURN MAX(CARDINAL);
*****                 ^ undeclared identifier
*****                             ^ not supported yet
  223        END;
  224        (*%T _mthread *) (*%F _OS2*) Process.Lock(); (*%E*) (*%E *)
  225        IF Create THEN
  226          h := FIO.Create(ST(Name));
*****          ^ not supported yet
*****               ^ not supported yet
*****                   ^ not supported yet
*****                             ^ not supported yet
  227        ELSE
  228          savesharemode := FIO.ShareMode;
*****          ^ not supported yet
*****                           ^ not supported yet
*****                               ^ not supported yet
  229          IF Share AND (_multi_mode=_multi_file) THEN
*****                        ^ not supported yet
*****                                    ^ undeclared identifier
  230            FIO.ShareMode := m_Test;
*****            ^ not supported yet
*****                ^ not supported yet
  231            h := FIO.OpenRead(ST(Name));
*****            ^ not supported yet
*****                 ^ not supported yet
*****                     ^ not supported yet
*****                                 ^ not supported yet
  232            multi := MultiFile(h);
*****                     ^ not supported yet
*****                               ^ not supported yet
  233            FIO.Close(h);
*****            ^ not supported yet
*****                ^ not supported yet
*****                      ^ not supported yet
  234          ELSE
  235            multi := _multi_mode=_multi_yes;
*****                     ^ not supported yet
*****                                 ^ undeclared identifier
  236          END;
  237          FIO.ShareMode := M[ReadOnly,Share AND multi];
*****          ^ not supported yet
*****              ^ not supported yet
*****                                                     ^ not supported yet
  238          h := FIO.OpenRead(ST(Name));
*****          ^ not supported yet
*****               ^ not supported yet
*****                   ^ not supported yet
*****                               ^ not supported yet
  239          FIO.ShareMode := savesharemode;
*****          ^ not supported yet
*****              ^ not supported yet
*****                           ^ not supported yet
  240        END;
  241        (*%T _mthread *) (*%F _OS2*) Process.Unlock(); (*%E *) (*%E*)
  242        RETURN h;
*****               ^ not supported yet
  243      END Open;
*****          ^ not supported yet
  244  
  245  
  246    PROCEDURE Truncate(f: File; l: LONGCARD);
*****                          ^ undeclared identifier
*****                                   ^ undeclared identifier
  247      VAR
  248        s : LONGCARD;
*****            ^ undeclared identifier
  249      BEGIN
  250        s := Size(f);
*****        ^ not supported yet
*****             ^ undeclared identifier
*****                  ^ not supported yet
  251        IF FIO.IOresult()=0 THEN
*****           ^ not supported yet
*****               ^ not supported yet
*****                        ^ not supported yet
  252          IF s<l THEN
*****             ^ not supported yet
*****               ^ not supported yet
  253            Seek(f,l-1);
*****            ^ undeclared identifier
*****                 ^ not supported yet
*****                   ^ not supported yet
*****                      ^ not supported yet
  254            IF FIO.IOresult()=0 THEN
*****               ^ not supported yet
*****                   ^ not supported yet
*****                            ^ not supported yet
  255              Write(f,0,1);
*****              ^ undeclared identifier
*****                    ^ not supported yet
*****                         ^ not supported yet
  256              IF FIO.IOresult()<>0 THEN
*****                 ^ not supported yet
*****                     ^ not supported yet
*****                              ^ not supported yet
  257                LocalError := FIO.IOresult();
*****                              ^ not supported yet
*****                                  ^ not supported yet
*****                                           ^ not supported yet
  258                IF (Size(f)#s) THEN
*****                    ^ undeclared identifier
*****                         ^ not supported yet
*****                            ^ not supported yet
  259                  Truncate(f,s);
*****                  ^ not supported yet
*****                           ^ not supported yet
*****                             ^ not supported yet
  260                END;
  261              END;
  262            END;
  263          ELSIF s>l THEN
*****                ^ not supported yet
*****                  ^ not supported yet
  264            Seek(f,l);
*****            ^ undeclared identifier
*****                 ^ not supported yet
*****                   ^ not supported yet
  265            FIO.Truncate(f);
*****            ^ not supported yet
*****                ^ not supported yet
*****                         ^ not supported yet
  266          END;
  267        END;
  268      END Truncate;
*****          ^ not supported yet
  269  
  270  
  271  
  272    CONST
  273      Locking = _mthread AND NOT _OS2;
*****                ^ undeclared identifier
*****                                 ^ undeclared identifier
  274  
  275  
  276  (*# save *)
  277  (*# call(result_optional=>on) *)
  278    PROCEDURE Common(f: File; x: LockRec; l: BOOLEAN): BOOLEAN;
*****                        ^ undeclared identifier
*****                                 ^ undeclared identifier
  279      VAR
  280        cnt,
  281        res : CARDINAL;
  282      BEGIN
  283        cnt := RetryCount();
*****               ^ undeclared identifier
*****                          ^ not supported yet
  284        LOOP
  285          IF l THEN
  286            res := FileLocks(f,NULL^,x);
*****                   ^ not supported yet
*****                             ^ not supported yet
*****                               ^ undeclared identifier
*****                                     ^ not supported yet
  287          ELSE
  288            res := FileLocks(f,x,NULL^);
*****                   ^ not supported yet
*****                             ^ not supported yet
*****                               ^ not supported yet
*****                                 ^ undeclared identifier
  289          END;
  290          IF (res=NO_ERROR) OR (cnt=0) OR NOT l THEN
*****                  ^ undeclared identifier
  291            EXIT;
  292          END;
  293          DEC(cnt);
*****          ^ undeclared identifier
*****                 ^ not supported yet
  294          Delay();
*****          ^ undeclared identifier
*****                ^ not supported yet
  295        END;
  296        RETURN res=NO_ERROR;
*****                   ^ undeclared identifier
  297      END Common;
*****          ^ not supported yet
  298  (*# restore *)
  299  
  300  
  301    PROCEDURE Lock(f: File; x: LockRec): BOOLEAN;
*****                      ^ undeclared identifier
*****                               ^ undeclared identifier
  302      BEGIN
  303        RETURN Common(f,x,TRUE);
*****               ^ not supported yet
*****                      ^ not supported yet
*****                        ^ not supported yet
*****                              ^ not supported yet
  304      END Lock;
*****          ^ not supported yet
  305  
  306  
  307    PROCEDURE UnLock(f: File; x: LockRec);
*****                        ^ undeclared identifier
*****                                 ^ undeclared identifier
  308      BEGIN
  309        Common(f,x,FALSE);
*****        ^ not supported yet
*****               ^ not supported yet
*****                 ^ not supported yet
*****                        ^ not supported yet
  310      END UnLock;
*****          ^ not supported yet
  311  
  312  
  313  (*# save *)
  314  (*# call(o_a_size=>on) *)
  315  (*# call(o_a_copy=>off) *)
  316  (*# call(result_optional=>on) *)
  317    PROCEDURE RangeCommon(f: File; x: ARRAY OF LockRec; lock: BOOLEAN): BOOLEAN;
*****                             ^ undeclared identifier
*****                                               ^ undeclared identifier
  318      VAR
  319        i,
  320        j   : CARDINAL;
  321        res : BOOLEAN;
  322      BEGIN
  323        res := TRUE;
  324        i := 0;
  325        LOOP
  326          IF NOT res OR (i>HIGH(x)) OR (x[i].pos=MAX(LONGCARD)) THEN
*****                           ^ undeclared identifier
*****                                ^ not supported yet
*****                                        ^ not supported yet
*****                                           ^ not supported yet
*****                                             ^ not supported yet
*****                                                 ^ undeclared identifier
*****                                                     ^ undeclared identifier
  327            EXIT;
  328          END;
  329          res := Common(f,x[i],lock);
*****                 ^ not supported yet
*****                        ^ not supported yet
*****                          ^ not supported yet
*****                             ^ not supported yet
*****                                   ^ not supported yet
  330          INC(i);
*****          ^ undeclared identifier
*****               ^ not supported yet
  331        END;
  332        IF NOT res AND (i>1) THEN
  333          DEC(i);
*****          ^ undeclared identifier
*****               ^ not supported yet
  334          LOOP
  335            DEC(i);
*****            ^ undeclared identifier
*****                 ^ not supported yet
  336            Common(f,x[i],NOT lock);
*****            ^ not supported yet
*****                   ^ not supported yet
*****                     ^ not supported yet
*****                        ^ not supported yet
*****                                  ^ not supported yet
  337            IF i = 0 THEN
  338              EXIT;
  339            END;
  340          END;
  341        END;
  342        RETURN res;
  343      END RangeCommon;
*****          ^ not supported yet
  344  (*# restore *)
  345  
  346  
  347  (*# save *)
  348  (*# call(o_a_size=>on) *)
  349  (*# call(o_a_copy=>off) *)
  350    PROCEDURE LockRange(f: File; x: ARRAY OF LockRec): BOOLEAN;
*****                           ^ undeclared identifier
*****                                             ^ undeclared identifier
  351      BEGIN
  352        RETURN RangeCommon(f,x,TRUE);
*****               ^ not supported yet
*****                           ^ not supported yet
*****                             ^ not supported yet
*****                                   ^ not supported yet
  353      END LockRange;
*****          ^ not supported yet
  354  (*# restore *)
  355  
  356  
  357  (*# save *)
  358  (*# call(o_a_size=>on) *)
  359  (*# call(o_a_copy=>off) *)
  360    PROCEDURE UnLockRange(f: File; x: ARRAY OF LockRec);
*****                             ^ undeclared identifier
*****                                               ^ undeclared identifier
  361      BEGIN
  362        RangeCommon(f,x,FALSE);
*****        ^ not supported yet
*****                    ^ not supported yet
*****                      ^ not supported yet
*****                             ^ not supported yet
  363      END UnLockRange;
*****          ^ not supported yet
  364  (*# restore *)
  365  
  366    PROCEDURE Error(): CARDINAL;
  367      VAR res : CARDINAL;
  368      BEGIN
  369        IF LocalError<>0 THEN
  370          LocalError := 0;
  371        ELSE
  372          res := FIO.IOresult();
*****                 ^ not supported yet
*****                     ^ not supported yet
*****                              ^ not supported yet
  373        END;
  374        RETURN res;
  375      END Error;
*****          ^ not supported yet
  376  
  377  
  378  (*# save *)
  379  (*%T _fcall *) (*# call(near_call=>off) *) (*%E *)
  380    PROCEDURE RetryCountDefault() : CARDINAL;
  381      BEGIN
  382        RETURN RetryCountDefaultValue;
*****               ^ undeclared identifier
  383      END RetryCountDefault;
*****          ^ not supported yet
  384  (*# restore *)
  385  
  386    PROCEDURE Read(f: File; VAR b: ARRAY OF BYTE; c: CARDINAL);
*****                      ^ undeclared identifier
*****                                            ^ undeclared identifier
  387    VAR p : ADDRESS;
*****            ^ undeclared identifier
  388    BEGIN
  389      p := ADR(b);
*****      ^ not supported yet
*****           ^ undeclared identifier
*****               ^ not supported yet
  390      IF FIO.RdBin(f,p^,c)<>c THEN
*****         ^ not supported yet
*****             ^ not supported yet
*****                   ^ not supported yet
*****                     ^ not supported yet
*****                         ^ not supported yet
  391        LocalError := PAST_EOF;
*****                      ^ undeclared identifier
  392      END;
  393    END Read;
*****        ^ not supported yet
  394  
  395    PROCEDURE Write(f: File; b: ARRAY OF BYTE; c: CARDINAL);
*****                       ^ undeclared identifier
*****                                         ^ undeclared identifier
  396    VAR p : ADDRESS;
*****            ^ undeclared identifier
  397    BEGIN
  398      p := ADR(b);
*****      ^ not supported yet
*****           ^ undeclared identifier
*****               ^ not supported yet
  399      FIO.WrBin(f,p^,c);
*****      ^ not supported yet
*****          ^ not supported yet
*****                ^ not supported yet
*****                  ^ not supported yet
*****                      ^ not supported yet
  400      IF FIO.IOresult()=FIO.DiskFull THEN
*****         ^ not supported yet
*****             ^ not supported yet
*****                      ^ not supported yet
*****                        ^ not supported yet
*****                            ^ not supported yet
  401        LocalError := PAST_EOF;
*****                      ^ undeclared identifier
  402      END;
  403    END Write;
*****        ^ not supported yet
  404  
  405  
  406    BEGIN
  407      _multi_mode := _multi_yes;
*****      ^ not supported yet
*****                     ^ undeclared identifier
  408      LocalError := 0;
  409      RetryCount := RetryCountDefault;
*****      ^ undeclared identifier
*****                    ^ not supported yet
  410      Delay := DelayDefault;
*****      ^ undeclared identifier
*****               ^ not supported yet
  411      Init();
*****      ^ not supported yet
*****           ^ not supported yet
  412    END FIOx.
*****        ^ not supported yet

  240 errors