home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / program / m2posx02 / sys.ipp < prev    next >
Encoding:
Modula Implementation  |  1993-10-23  |  4.0 KB  |  157 lines
  1. IMPLEMENTATION MODULE sys;
  2. (*__NO_CHECKS__*)
  3. (*****************************************************************************)
  4. (* Basiert auf der MiNTLIB von Eric R. Smith                                 *)
  5. (* --------------------------------------------------------------------------*)
  6. (* STATUS: OK                                                                *)
  7. (* --------------------------------------------------------------------------*)
  8. (* 14-Feb-93, Holger Kleinschmidt                                            *)
  9. (*****************************************************************************)
  10.  
  11. VAL_INTRINSIC
  12. CAST_IMPORT
  13. OSCALL_IMPORT
  14.  
  15. FROM SYSTEM IMPORT
  16. (* PROC *) ADR;
  17.  
  18. FROM types IMPORT
  19. (* TYPE *) WORDSET, SIGNEDLONG, UNSIGNEDLONG, UNSIGNEDWORD, SIGNEDWORD,
  20.            PathName, timeT;
  21.  
  22. FROM err IMPORT
  23. (* CONST*) EINVAL,
  24. (* VAR  *) errno;
  25.  
  26. #if MINT
  27. FROM DosSystem IMPORT MiNTVersion;
  28. #endif
  29.  
  30. FROM DosFile IMPORT
  31. (* PROC *) UnixToDos;
  32.  
  33. #include "oscalls.m2h"
  34.  
  35. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  36.  
  37. CONST
  38.   EOKL = LIC(0);
  39.  
  40. #if MINT
  41. VAR
  42.   MiNT : CARDINAL;
  43. #endif
  44. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  45.  
  46. PROCEDURE pathconf ((* EIN/ -- *) REF file  : ARRAY OF CHAR;
  47.                     (* EIN/ -- *)     which : PConfVal      ): SIGNEDLONG;
  48. (*T*)
  49. VAR dot   : BOOLEAN;
  50.     done  : BOOLEAN;
  51.     path0 : PathName;
  52. #if MINT
  53.     limit : SIGNEDLONG;
  54. #endif
  55.  
  56. BEGIN
  57.  UnixToDos(file, path0, dot, done);
  58.  IF NOT done THEN
  59.    RETURN(-1);
  60.  END;
  61. #if MINT
  62.  IF MiNT > 0 THEN
  63.    CASE which OF
  64.      pcMaxCanon : RETURN(-1); (* ?? *)
  65.     |pcMaxInput : RETURN(-1); (* ?? *)
  66.     |pcChownRestricted: RETURN(0); (* ja *)
  67.     |pcVdisable : RETURN(0);
  68.    ELSE
  69.      Dpathconf(ADR(path0), VAL(UNSIGNEDWORD, which)+1, limit);
  70.      IF which = pcNoTrunc THEN
  71.        IF limit > LIC(0) THEN
  72.          RETURN(-1); (* <=> Dateinamen werden gekuerzt *)
  73.        ELSE
  74.          RETURN(0);
  75.        END;
  76.      ELSIF limit < EOKL THEN
  77.        errno := INT(limit);
  78.        RETURN(-1);
  79.      ELSE
  80.        RETURN(limit);
  81.      END;
  82.    END;
  83.  END;
  84. #endif
  85.  CASE which OF
  86.    pcLinkMax  : RETURN(1);
  87.   |pcPathMax  : RETURN(128);
  88.   |pcNameMax  : RETURN(12);
  89.   |pcNoTrunc  : RETURN(-1); (* -1 <=> es wird gekuerzt *)
  90.   |pcVdisable : RETURN(0);
  91.   |pcMaxInput : RETURN(-1); (* ? *)
  92.   |pcMaxCanon : RETURN(-1); (* ? *)
  93.  ELSE (* pcPipeBuf, pcChownRestricted... *)
  94.    errno := EINVAL;
  95.    RETURN(-1);
  96.  END;
  97. END pathconf;
  98.  
  99. (*---------------------------------------------------------------------------*)
  100.  
  101. PROCEDURE sysconf ((* EIN/ -- *) which : SConfVal ): SIGNEDLONG;
  102. (*T*)
  103. #if MINT
  104. VAR limit : SIGNEDLONG;
  105. #endif
  106. BEGIN
  107. #if MINT
  108.  IF MiNT > 0 THEN
  109.    CASE which OF
  110.      scArgMax     : RETURN(UNLIMITED); (* wegen "ARGV" *)
  111.     |scClkTck     : RETURN(CLKTCK);
  112.     |scJobControl : RETURN(1);  (* ja *)
  113.     |scSavedIds   : RETURN(-1); (* nein ?? *)
  114.    ELSE
  115.      Sysconf(VAL(SIGNEDWORD,which)+1, limit);
  116.      IF limit < LIC(0) THEN
  117.        errno := INT(limit);
  118.        RETURN(-1);
  119.      ELSE
  120.        RETURN(limit);
  121.      END;
  122.    END;
  123.  END;
  124. #endif
  125.  CASE which OF
  126.    scArgMax     : RETURN(UNLIMITED); (* wegen "ARGV" *)
  127.   |scOpenMax    : RETURN(81);        (* max. Kennung = 80 *)
  128.   |scNGroupsMax : RETURN(0);
  129.   |scChildMax   : RETURN(UNLIMITED);
  130.   |scClkTck     : RETURN(CLKTCK);
  131.   |scJobControl : RETURN(-1); (* kein ``Job Control'' *)
  132.   |scSavedIds   : RETURN(-1); (* aber kein Fehler ! *)
  133.  ELSE  (* scVersion, ... *)
  134.    errno := EINVAL;
  135.    RETURN(-1);
  136.  END;
  137. END sysconf;
  138.  
  139. (*---------------------------------------------------------------------------*)
  140.  
  141. PROCEDURE time ((* -- /AUS *) VAR time : timeT );
  142. (*T*)
  143. VAR date : UNSIGNEDWORD;
  144. BEGIN
  145.  Tgettime(date);
  146.  time.time := CAST(WORDSET,date);
  147.  Tgetdate(date);
  148.  time.date := CAST(WORDSET,date);
  149. END time;
  150.  
  151. #if MINT
  152. (*===========================================================================*)
  153. BEGIN
  154.  MiNT := MiNTVersion();
  155. #endif
  156. END sys.
  157.