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 } 185