git.gag.com Git - debian/yforth/blob - blocke.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: blocke.c
   8  * Abstract:    Block extension word set
   9  */
  10
  11 #include <stdio.h>
  12 #include "yforth.h"
  13 #include "core.h"
  14 #include "coree.h"
  15 #include "block.h"
  16 #include "blocke.h"
  17
  18 /**************************************************************************/
  19 /* VARIABLES ************** ***********************************************/
  20 /**************************************************************************/
  21
  22 UCell _s_c_r;
  23
  24 /**************************************************************************/
  25 /* WORDS ****************** ***********************************************/
  26 /**************************************************************************/
  27
  28 void _empty_buffers() {
  29         register int i;
  30         for (i = 0; i < NUM_BLOCKS; i++) block_data[i].block_no = 0;
  31 }
  32
  33 void _list() {
  34         register Char *buffer;
  35         register int i;
  36         _block();
  37         buffer = (Char *) *sp++;
  38         for (i = 0; i < BLOCK_SIZE; i += 64) {
  39                 *--sp = i / 64;
  40                 *--sp = 2;
  41                 _dot_r();
  42                 *--sp = ':';
  43                 _emit();
  44                 _b_l();
  45                 _emit();
  46                 *--sp = (Cell) buffer + i;
  47                 *--sp = 64;
  48                 _type();
  49                 _c_r();
  50         }
  51 }
  52
  53 void _thru() {
  54         register UCell u2 = (UCell) *sp++;
  55         register UCell u1 = (UCell) *sp++;
  56         for (; u1 <= u2; u1++) {
  57                 *--sp = u1;
  58                 _load();
  59         }
  60 }
  61
  62