usr/src/common/ficl/extras.c

   1 #include "ficl.h"
   2 #include <unistd.h>
   3 #include <stdio.h>
   4 #include <stdlib.h>
   5
   6 /*
   7  * Ficl interface to system (ANSI)
   8  * Gets a newline (or NULL) delimited string from the input
   9  * and feeds it to the ANSI system function...
  10  * Example:
  11  *    system del *.*
  12  *    \ ouch!
  13  */
  14 static void
  15 ficlPrimitiveSystem(ficlVm *vm)
  16 {
  17         ficlCountedString *counted = (ficlCountedString *)vm->pad;
  18
  19         ficlVmGetString(vm, counted, '\n');
  20         if (FICL_COUNTED_STRING_GET_LENGTH(*counted) > 0) {
  21                 int returnValue = \
  22                     system(FICL_COUNTED_STRING_GET_POINTER(*counted));
  23                 if (returnValue) {
  24                         sprintf(vm->pad, "System call returned %d\n",
  25                             returnValue);
  26                         ficlVmTextOut(vm, vm->pad);
  27                         ficlVmThrow(vm, FICL_VM_STATUS_QUIT);
  28                 }
  29         } else {
  30                 ficlVmTextOut(vm, "Warning (system): nothing happened\n");
  31         }
  32 }
  33
  34 /*
  35  * Ficl add-in to load a text file and execute it...
  36  * Cheesy, but illustrative.
  37  * Line oriented... filename is newline (or NULL) delimited.
  38  * Example:
  39  *    load test.f
  40  */
  41 #define BUFFER_SIZE     256
  42 static void
  43 ficlPrimitiveLoad(ficlVm *vm)
  44 {
  45         char buffer[BUFFER_SIZE];
  46         char filename[BUFFER_SIZE];
  47         ficlCountedString *counted = (ficlCountedString *)filename;
  48         int line = 0;
  49         FILE *f;
  50         int result = 0;
  51         ficlCell oldSourceId;
  52         ficlString s;
  53
  54         ficlVmGetString(vm, counted, '\n');
  55
  56         if (FICL_COUNTED_STRING_GET_LENGTH(*counted) <= 0) {
  57                 ficlVmTextOut(vm, "Warning (load): nothing happened\n");
  58                 return;
  59         }
  60
  61         /*
  62          * get the file's size and make sure it exists
  63          */
  64
  65         f = fopen(FICL_COUNTED_STRING_GET_POINTER(*counted), "r");
  66         if (!f) {
  67                 ficlVmTextOut(vm, "Unable to open file ");
  68                 ficlVmTextOut(vm, FICL_COUNTED_STRING_GET_POINTER(*counted));
  69                 ficlVmTextOut(vm, "\n");
  70                 ficlVmThrow(vm, FICL_VM_STATUS_QUIT);
  71         }
  72
  73         oldSourceId = vm->sourceId;
  74         vm->sourceId.p = (void *)f;
  75
  76         /* feed each line to ficlExec */
  77         while (fgets(buffer, BUFFER_SIZE, f)) {
  78                 int length = strlen(buffer) - 1;
  79
  80                 line++;
  81                 if (length <= 0)
  82                         continue;
  83
  84                 if (buffer[length] == '\n')
  85                         buffer[length--] = '\0';
  86
  87                 FICL_STRING_SET_POINTER(s, buffer);
  88                 FICL_STRING_SET_LENGTH(s, length + 1);
  89                 result = ficlVmExecuteString(vm, s);
  90                 /* handle "bye" in loaded files. --lch */
  91                 switch (result) {
  92                 case FICL_VM_STATUS_OUT_OF_TEXT:
  93                 case FICL_VM_STATUS_USER_EXIT:
  94                 break;
  95
  96                 default:
  97                         vm->sourceId = oldSourceId;
  98                         fclose(f);
  99                         ficlVmThrowError(vm, "Error loading file <%s> line %d",
 100                             FICL_COUNTED_STRING_GET_POINTER(*counted), line);
 101                 break;
 102                 }
 103         }
 104         /*
 105          * Pass an empty line with SOURCE-ID == -1 to flush
 106          * any pending REFILLs (as required by FILE wordset)
 107          */
 108         vm->sourceId.i = -1;
 109         FICL_STRING_SET_FROM_CSTRING(s, "");
 110         ficlVmExecuteString(vm, s);
 111
 112         vm->sourceId = oldSourceId;
 113         fclose(f);
 114
 115         /* handle "bye" in loaded files. --lch */
 116         if (result == FICL_VM_STATUS_USER_EXIT)
 117                 ficlVmThrow(vm, FICL_VM_STATUS_USER_EXIT);
 118 }
 119
 120 /*
 121  * Dump a tab delimited file that summarizes the contents of the
 122  * dictionary hash table by hashcode...
 123  */
 124 static void
 125 ficlPrimitiveSpewHash(ficlVm *vm)
 126 {
 127         ficlHash *hash = ficlVmGetDictionary(vm)->forthWordlist;
 128         ficlWord *word;
 129         FILE *f;
 130         unsigned i;
 131         unsigned hashSize = hash->size;
 132
 133         if (!ficlVmGetWordToPad(vm))
 134                 ficlVmThrow(vm, FICL_VM_STATUS_OUT_OF_TEXT);
 135
 136         f = fopen(vm->pad, "w");
 137         if (!f) {
 138                 ficlVmTextOut(vm, "unable to open file\n");
 139                 return;
 140         }
 141
 142         for (i = 0; i < hashSize; i++) {
 143                 int n = 0;
 144
 145                 word = hash->table[i];
 146                 while (word) {
 147                         n++;
 148                         word = word->link;
 149                 }
 150
 151                 fprintf(f, "%d\t%d", i, n);
 152
 153                 word = hash->table[i];
 154                 while (word) {
 155                         fprintf(f, "\t%s", word->name);
 156                         word = word->link;
 157                 }
 158
 159                 fprintf(f, "\n");
 160         }
 161
 162         fclose(f);
 163 }
 164
 165 static void
 166 ficlPrimitiveBreak(ficlVm *vm)
 167 {
 168         vm->state = vm->state;
 169 }
 170
 171 void
 172 ficlSystemCompileExtras(ficlSystem *system)
 173 {
 174         ficlDictionary *dictionary = ficlSystemGetDictionary(system);
 175
 176         ficlDictionarySetPrimitive(dictionary, "break", ficlPrimitiveBreak,
 177             FICL_WORD_DEFAULT);
 178         ficlDictionarySetPrimitive(dictionary, "load", ficlPrimitiveLoad,
 179             FICL_WORD_DEFAULT);
 180         ficlDictionarySetPrimitive(dictionary, "spewhash",
 181             ficlPrimitiveSpewHash, FICL_WORD_DEFAULT);
 182         ficlDictionarySetPrimitive(dictionary, "system", ficlPrimitiveSystem,
 183             FICL_WORD_DEFAULT);
 184 }