File: blocke.c

package info (click to toggle)
yforth 0.1beta-12
  • links: PTS
  • area: main
  • in suites: potato
  • size: 352 kB
  • ctags: 787
  • sloc: ansic: 4,415; makefile: 59
file content (62 lines) | stat: -rw-r--r-- 1,620 bytes parent folder | download | duplicates (9)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
/* yForth? - Written by Luca Padovani (C) 1996/97
 * ------------------------------------------------------------------------
 * This software is FreeWare as long as it comes with this header in each
 * source file, anyway you can use it or any part of it whatever
 * you want. It comes without any warranty, so use it at your own risk.
 * ------------------------------------------------------------------------
 * Module name: blocke.c
 * Abstract:	Block extension word set
 */

#include <stdio.h>
#include "yforth.h"
#include "core.h"
#include "coree.h"
#include "block.h"
#include "blocke.h"

/**************************************************************************/
/* VARIABLES ************** ***********************************************/
/**************************************************************************/

UCell _s_c_r;

/**************************************************************************/
/* WORDS ****************** ***********************************************/
/**************************************************************************/

void _empty_buffers() {
	register int i;
	for (i = 0; i < NUM_BLOCKS; i++) block_data[i].block_no = 0;
}

void _list() {
	register Char *buffer;
	register int i;
	_block();
	buffer = (Char *) *sp++;
	for (i = 0; i < BLOCK_SIZE; i += 64) {
		*--sp = i / 64;
		*--sp = 2;
		_dot_r();
		*--sp = ':';
		_emit();
		_b_l();
		_emit();
		*--sp = (Cell) buffer + i;
		*--sp = 64;
		_type();
		_c_r();
	}
}

void _thru() {
	register UCell u2 = (UCell) *sp++;
	register UCell u1 = (UCell) *sp++;
	for (; u1 <= u2; u1++) {
		*--sp = u1;
		_load();
	}
}