Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/branches/num64/runtime/c-libs/win32-filesys/win32-filesys.c
ViewVC logotype

Diff of /sml/branches/num64/runtime/c-libs/win32-filesys/win32-filesys.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 5322, Thu Jun 6 15:24:02 2019 UTC revision 5323, Thu Jun 6 16:01:41 2019 UTC
# Line 12  Line 12 
12  #include "ml-objects.h"  #include "ml-objects.h"
13  #include "ml-c.h"  #include "ml-c.h"
14    
15    /* #define DEBUG_WIN32 */
16    
17  #define TMP_PREFIX "TMP-SMLNJ"  #define TMP_PREFIX "TMP-SMLNJ"
18    
19  #define IS_DOTDIR(c) ((c)[0] == '.' && (!(c)[1] || ((c)[1] == '.' && !(c)[2])))  #define IS_DOTDIR(c) ((c)[0] == '.' && (!(c)[1] || ((c)[1] == '.' && !(c)[2])))
# Line 103  Line 105 
105   */   */
106  ml_val_t _ml_win32_FS_create_directory (ml_state_t *msp, ml_val_t arg)  ml_val_t _ml_win32_FS_create_directory (ml_state_t *msp, ml_val_t arg)
107  {  {
108    #ifdef DEBUG_WIN32
109        BOOL sts = CreateDirectory(STR_MLtoC(arg), NULL);
110        if (sts) {
111            return ML_true;
112        } else {
113            SayDebug("create_directory(%s) failed; error = %d\n", STR_MLtoC(arg), GetLastError());
114            return ML_false;
115        }
116    #else
117      return CreateDirectory(STR_MLtoC(arg),NULL) ? ML_true : ML_false;      return CreateDirectory(STR_MLtoC(arg),NULL) ? ML_true : ML_false;
118    #endif
119  }  }
120    
121  /* _ml_win32_FS_remove_directory : string -> bool  /* _ml_win32_FS_remove_directory : string -> bool
# Line 121  Line 133 
133      ml_val_t res, ml_w;      ml_val_t res, ml_w;
134    
135      if (w != INVALID_FILE_ATTRIBUTES) {      if (w != INVALID_FILE_ATTRIBUTES) {
 #ifdef DEBUG_WIN32  
         SayDebug("get_file_attributes: returning SOME %#x as attrs for <%s>\n",  
             w, STR_MLtoC(arg));  
 #endif  
136          ml_w = INT32_CtoML(msp, w);          ml_w = INT32_CtoML(msp, w);
137          OPTION_SOME(msp,res,ml_w);          OPTION_SOME(msp,res,ml_w);
138      }      }
# Line 150  Line 158 
158          OPTION_SOME(msp,res,ml_w);          OPTION_SOME(msp,res,ml_w);
159      }      }
160      else {      else {
161    #ifdef DEBUG_WIN32
162            SayDebug("get_file_attributes_by_handle(%#x): error = %d\n", HANDLE_MLtoC(arg), GetLastError());
163    #endif
164          res = OPTION_NONE;          res = OPTION_NONE;
165      }      }
166      return res;      return res;
# Line 165  Line 176 
176    
177      r = GetFullPathName(STR_MLtoC(arg), MAX_PATH, buf, &dummy);      r = GetFullPathName(STR_MLtoC(arg), MAX_PATH, buf, &dummy);
178      if ((r == 0) || (r > MAX_PATH)) {      if ((r == 0) || (r > MAX_PATH)) {
179    #ifdef DEBUG_WIN32
180            SayDebug("get_full_path(%s): error = %d\n", STR_MLtoC(arg), GetLastError());
181    #endif
182          return RAISE_SYSERR(msp, -1);          return RAISE_SYSERR(msp, -1);
183      }      }
184      res = ML_CString(msp, buf);      res = ML_CString(msp, buf);
# Line 181  Line 195 
195          return ML_AllocInt64(msp, sz.QuadPart);          return ML_AllocInt64(msp, sz.QuadPart);
196      }      }
197      else {      else {
198    #ifdef DEBUG_WIN32
199            SayDebug("get_file_size(%#x): error = %d\n", HANDLE_MLtoC(arg), GetLastError());
200    #endif
201          return RAISE_SYSERR(msp, -1);          return RAISE_SYSERR(msp, -1);
202      }      }
203  }  }
# Line 209  Line 226 
226          return res;          return res;
227      }      }
228      else {      else {
229    #ifdef DEBUG_WIN32
230            SayDebug("get_file_size_by_name(%s): error = %d\n", STR_MLtoC(arg), GetLastError());
231    #endif
232          return OPTION_NONE;          return OPTION_NONE;
233      }      }
234    
235  }  }
236    
237  /* _ml_win32_FS_get_file_time : string -> Int64.int option  /* _ml_win32_FS_get_file_time : string -> Word64.word option
238   */   */
239  ml_val_t _ml_win32_FS_get_file_time (ml_state_t *msp, ml_val_t arg)  ml_val_t _ml_win32_FS_get_file_time (ml_state_t *msp, ml_val_t arg)
240  {  {
# Line 228  Line 248 
248      if (h != INVALID_HANDLE_VALUE) {      if (h != INVALID_HANDLE_VALUE) {
249          FILETIME ft;          FILETIME ft;
250          if (GetFileTime(h, NULL, NULL, &ft)) {  /* request time of "last write" */          if (GetFileTime(h, NULL, NULL, &ft)) {  /* request time of "last write" */
251            /* convert to nanoseconds; FILETIME is in units of 100ns */            /* convert to 100-nanosecond units (FILETIME units) */
252              Int64_t ns = 100 * (((Int64_t)ft.dwHighDateTime << 32) + (Int64_t)ft.dwLowDateTime);              Unsigned64_t ns = ((Unsigned64_t)ft.dwHighDateTime << 32) + (Unsigned64_t)ft.dwLowDateTime;
253  SayDebug("get_file_time(\"%s\") = [%#010x:%08x] (%lld)\n",            /* return nanoseconds */
254  STR_MLtoC(arg), ft.dwHighDateTime,ft.dwLowDateTime,ns);              ml_ns = ML_AllocWord64(msp, 100 * ns);
             ml_ns = ML_AllocInt64(msp, ns);  
255              OPTION_SOME(msp, res, ml_ns);              OPTION_SOME(msp, res, ml_ns);
256          }          }
257      } else {      } else {
258    #ifdef DEBUG_WIN32
259            SayDebug("get_file_time(%s) failed; error = %d\n", STR_MLtoC(arg), GetLastError());
260    #endif
261          res = OPTION_NONE;          res = OPTION_NONE;
262      }      }
263      return res;      return res;
# Line 260  Line 282 
282          ns /= 100;  /* FILETIME is in units of 100ns */          ns /= 100;  /* FILETIME is in units of 100ns */
283          ft.dwHighDateTime = (DWORD)(ns >> 32);          ft.dwHighDateTime = (DWORD)(ns >> 32);
284          ft.dwLowDateTime = (DWORD)ns;          ft.dwLowDateTime = (DWORD)ns;
 SayDebug("set_file_time(\"%s\", [%#010x:%08x] (%lld))\n",  
 STR_MLtoC(arg), ft.dwHighDateTime,ft.dwLowDateTime,ns);  
285    
286          if (SetFileTime(h, NULL, NULL, &ft)) {          if (SetFileTime(h, NULL, NULL, &ft)) {
287              res = ML_true;              res = ML_true;
# Line 277  Line 297 
297   */   */
298  ml_val_t _ml_win32_FS_delete_file (ml_state_t *msp, ml_val_t arg)  ml_val_t _ml_win32_FS_delete_file (ml_state_t *msp, ml_val_t arg)
299  {  {
300    #ifdef DEBUG_WIN32
301        BOOL sts = DeleteFile(STR_MLtoC(arg));
302        if (sts) {
303            return ML_true;
304        } else {
305            SayDebug("DeleteFile(%s); error = %d\n", STR_MLtoC(arg), GetLastError());
306            return ML_false;
307        }
308    #else
309      return DeleteFile (STR_MLtoC(arg)) ? ML_true : ML_false;      return DeleteFile (STR_MLtoC(arg)) ? ML_true : ML_false;
310    #endif
311  }  }
312    
313  /* _ml_win32_FS_move_file : (string * string) -> bool  /* _ml_win32_FS_move_file : (string * string) -> bool

Legend:
Removed from v.5322  
changed lines
  Added in v.5323

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0