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

   1 /* yForth? - A Forth interpreter written in ANSI C
   2  * Copyright (C) 2012 Luca Padovani
   3  *
   4  * This program is free software: you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation, either version 3 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16  * ------------------------------------------------------------------------
  17  * Module name:
  18  * Abstract:
  19  */
  20
  21 #include <string.h>
  22 #include <ctype.h>
  23 #include "yforth.h"
  24 #include "string.h"
  25 #include "core.h"
  26
  27 /**************************************************************************/
  28 /* WORDS ******************************************************************/
  29 /**************************************************************************/
  30
  31 void _dash_trailing() {
  32         register Char *s = (Char *) sp[1];
  33         register int i = sp[0];
  34         while (i-- > 0) if (!isspace(s[i])) break;
  35         sp[0] = i + 1;
  36 }
  37
  38 void _slash_string() {
  39         register Cell n = *sp++;
  40         sp[1] = (Cell) ((Char *) sp[1] + n);
  41         sp[0] -= n;
  42 }
  43
  44 void _blank() {
  45         register UCell u = (UCell) *sp++;
  46         register Char *s = (Char *) *sp++;
  47         if (u) memset(s, ' ', u);
  48 }
  49
  50 void _c_move() {
  51         register UCell u = (UCell) *sp++;
  52         register Char *dest = (Char *) *sp++;
  53         register Char *source = (Char *) *sp++;
  54         while (u--) *dest++ = *source++;
  55 }
  56
  57 void _c_move_up() {
  58         register UCell u = (UCell) *sp++;
  59         register Char *dest = (Char *) *sp++ + u;
  60         register Char *source = (Char *) *sp++ + u;
  61         while (u--) *--dest = *--source;
  62 }
  63
  64 void _compare() {
  65         register UCell u2 = (UCell) *sp++;
  66         register Char *s2 = (Char *) *sp++;
  67         register UCell u1 = (UCell) *sp++;
  68         register Char *s1 = (Char *) *sp;
  69         register UCell m = u2 <= u1 ? u2 : u1;
  70         while (m) {
  71                 if (*s1 != *s2) break;
  72                 s1++;
  73                 s2++;
  74                 m--;
  75         }
  76         if (u1 == u2 && !m) *sp = 0;
  77         else if (!m) *sp = u1 < u2 ? -1 : 1;
  78         else *sp = *s1 < *s2 ? -1 : 1;
  79 }
  80
  81 void _search() {
  82         register UCell u2 = (UCell) *sp++;
  83         register Char *s2 = (Char *) sp[0];
  84         register UCell u1 = (UCell) sp[1];
  85         register Char *s1 = (Char *) sp[2];
  86         if (u2 > u1) *sp = FFLAG(0);
  87         else {
  88                 while (u1 >= u2) {
  89                         *--sp = (Cell) s1;
  90                         *--sp = (Cell) u1;
  91                         *--sp = (Cell) s2;
  92                         *--sp = (Cell) u2;
  93                         _compare();
  94                         if (!(*sp++)) {
  95                                 sp[2] = (Cell) s1;
  96                                 sp[1] = (Cell) u1;
  97                                 sp[0] = FFLAG(1);
  98                                 break;
  99                         } else {
 100                                 s1++;
 101                                 u1--;
 102                         }
 103                 }
 104         }
 105 }
 106
 107 void _s_literal() {
 108         register UCell u = (UCell) *sp++;
 109         register Char *s = (Char *) *sp++;
 110         compile_cell((Cell) _do_literal);
 111         compile_cell((Cell) s);
 112         compile_cell((Cell) _do_literal);
 113         compile_cell((Cell) u);
 114 }
 115