git.gag.com Git - debian/yforth/blob - toolse.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: toolse.c
   8  * Abstract:    Programming Tools extension word set
   9  */
  10
  11 #include <stdio.h>
  12 #include <stdlib.h>
  13 #include "yforth.h"
  14 #include "toolse.h"
  15 #include "core.h"
  16 #include "coree.h"
  17 #include "block.h"
  18
  19 /**************************************************************************/
  20 /* WORDS ******************************************************************/
  21 /**************************************************************************/
  22
  23 void _bye() {
  24 #if BLOCK_DEF
  25         close_block_file();
  26 #endif
  27     exit(0);
  28 }
  29
  30 void _ahead() {
  31         compile_cell((Cell) _branch);
  32         *--sp = (Cell) _dp;
  33         compile_cell(0);
  34 }
  35
  36 void _bracket_if() {
  37         register Cell flag = *sp++;
  38         register Cell nest = 1;
  39         register Cell ok = FFLAG(1);
  40         if (!flag) {
  41                 do {
  42                         _b_l();
  43                         _word();
  44                         sp++;
  45                         if (!*_dp) {
  46                                 _refill();
  47                                 ok = *sp++;
  48                         } else {
  49                                 if (!strmatch("[IF]", _dp, 4)) nest++;
  50                                 else if (!strmatch("[THEN]", _dp, 6) ||
  51                                                  (!strmatch("[ELSE]", _dp, 6) && nest == 1)) nest--;
  52                         }
  53                 } while (nest && ok);
  54         }
  55 }
  56
  57 void _bracket_else() {
  58         register Cell nest = 1;
  59         register Cell ok = FFLAG(1);
  60         do {
  61                 _b_l();
  62                 _word();
  63                 sp++;
  64                 if (!*_dp) {
  65                         _refill();
  66                         ok = *sp++;
  67                 } else {
  68                         if (!strmatch("[IF]", _dp, 4)) nest++;
  69                         else if (!strmatch("[THEN]", _dp, 6)) nest--;
  70                 }
  71         } while (nest && ok);
  72 }
  73
  74 void _bracket_then() {
  75 }
  76