git.gag.com Git - debian/yforth/blob - ycore.c

   1 /* yForth? - Written by Luca Padovani (C) 1996/97
   2  * ------------------------------------------------------------------------
   3  * This software is FreeWare as long as it comes with this header in each
   4  * source file, anyway you can use it or any part of it whatever
   5  * you want. It comes without any warranty, so use it at your own risk.
   6  * ------------------------------------------------------------------------
   7  * Module name:     ycore.c
   8  * Abstract:        Words defined for this particular implementation of
   9                     forth. Do not expect to find these words in other
  10                     implementations.
  11  */
  12
  13 #include <stdio.h>
  14 #include <string.h>
  15 #include <stdlib.h>
  16 #include "ver.h"
  17 #include "yforth.h"
  18 #include "core.h"
  19 #include "file.h"
  20 #include "search.h"
  21
  22 /**************************************************************************/
  23 /* WORDS DEFINITION *******************************************************/
  24 /**************************************************************************/
  25
  26 /* ( --- ) print current version of yForth? */
  27 void _yforth_version() {
  28         print_version();
  29 }
  30
  31 /* ( c-addr u --- ) save a snapshot of the current dictionary and vocabulary
  32  * search order
  33  */
  34 void _save_image() {
  35         FILE *f = fopen(get_file_name(), "wb");
  36         struct image_header hd;
  37         struct voc_marker vm;
  38         if (f) {
  39                 memset(&hd, 0, sizeof(struct image_header));
  40                 strcpy(hd.header, "yForth? Image File\n");
  41                 hd.ver_hi = VER_HI;
  42                 hd.ver_lo = VER_LO;
  43                 hd.base = dp0;
  44                 hd.dspace_size = dspace_size;
  45                 hd.pattern = VERSION_PATTERN;
  46                 if (fwrite(&hd, sizeof(struct image_header), 1, f) < 1) _error = E_NOFILE;
  47                 else {
  48                         save_vocabulary(&vm);
  49                         if (fwrite(&vm, sizeof(struct voc_marker), 1, f) < 1) _error = E_NOFILE;
  50                         else {
  51                                 if (fwrite(dp0, sizeof(Cell), dspace_size, f) < dspace_size)
  52                                         _error = E_NOFILE;
  53                         }
  54                 }
  55                 fclose(f);
  56         } else _error = E_NOFILE;
  57 }
  58
  59 /* ( c-addr u --- n ) execute command pointeb by c-addr via "system", n is
  60  * the result of operation as described in the C library manual
  61  */
  62 void _system() {
  63         register UCell len = *sp++;
  64         register Char *name = (Char *) *sp;
  65         extern Char s_tmp_buffer[];
  66         memcpy(s_tmp_buffer, name, len);
  67         s_tmp_buffer[len] = '\0';
  68         *sp = system(s_tmp_buffer);
  69 }
  70