1169 lines
42 KiB
C
1169 lines
42 KiB
C
/* =====> ZCIO.C */
|
||
/* TIPC Scheme Runtime Support - Window Input/Output Support
|
||
(C) Copyright 1985 by Texas Instruments Incorporated.
|
||
All rights reserved.
|
||
|
||
Author: John C. Jensen
|
||
Installation: Texas Instruments Incorporated, Dallas, Texas
|
||
Division: Central Research Laboratories
|
||
Cost Center: Computer Science Laboratory
|
||
Project: Computer Architecture Branch
|
||
Date Written: 1 February 1985
|
||
Last Modification:
|
||
11 Feb 86 - Fixed READ-CHAR for "read from string".
|
||
- added a call to "force-reset" after an error was encountered
|
||
in routine "takechar".
|
||
- modified routine "takechar" to correctly report an error
|
||
when an invalid status is returned from a write. Added the
|
||
message "Write error: DOS error code X".
|
||
April 86 - Most codes are moved to Assembly language. The modules
|
||
left are: clear_window, gc_on, gc_off
|
||
*/
|
||
#include "scheme.h"
|
||
#include "sport.h"
|
||
extern unsigned GC_ING; /* Garbage collecting indicator */
|
||
|
||
|
||
|
||
/********************** Following Code commented out
|
||
#include "slist.h"
|
||
|
||
int prn_handle = 0; /* current printer handle */
|
||
static int handle = 0; /* current port file's handle */
|
||
static int port_disp = 0; /* current port displacement */
|
||
static int port_page = 0; /* current port page number */
|
||
static int port_reg[2] = {0,0}; /* current port pointer */
|
||
static int window_p = FALSE; /* flag indicating if port is a window */
|
||
static int string_p = FALSE; /* flag indicating string I/O */
|
||
|
||
#define NUM_FIELDS 12
|
||
static int defaults[NUM_FIELDS] = {0, /* cursor line number */
|
||
0, /* cursor column number */
|
||
0, /* upper left corner line number */
|
||
0, /* upper left corner column number */
|
||
25, /* number of lines */
|
||
80, /* number of columns */
|
||
-1, /* no border */
|
||
15, /* text high intensity, enable */
|
||
1, /* wrap enabled */
|
||
0, /* current buffer position */
|
||
0, /* current buffer end */
|
||
TRANSCRIPT+BINARY+WINDOW+OPEN+READ_WRITE}; /* port attributes */
|
||
static int map_attr[NUM_FIELDS] = {10,12,14,16,18,20,22,24,26,28,30,6};
|
||
|
||
/* Extended Character Definitions */
|
||
#define F3 0x003d
|
||
#define F5 0x003f
|
||
#define LEFT_ARROW 0x004b
|
||
#define RIGHT_ARROW 0x004d
|
||
#define ENTER_KEY 0x000d
|
||
#define INSERT 0x0052
|
||
#define DELETE 0x0053
|
||
|
||
char *getmem(); /* Lattice C's memory allocation support */
|
||
|
||
/************************************************************************/
|
||
/* Allocate a Window */
|
||
/************************************************************************/
|
||
make_window(reg)
|
||
int reg[2]; /* register to receive pointer to window object */
|
||
{
|
||
int disp; /* displacement component of a pointer */
|
||
int i; /* index variable */
|
||
int page; /* page number component of a pointer */
|
||
int retstat = 0; /* the return status */
|
||
|
||
ENTER(make_window);
|
||
|
||
page = CORRPAGE(reg[C_PAGE]);
|
||
if (ptype[page] == STRTYPE*2 || (!page))
|
||
{
|
||
/* allocate window object (port data type) */
|
||
mov_reg(tmp_reg, reg); /* save pointer to window label */
|
||
alloc_block(reg, PORTTYPE, WINDSIZE+BUFFSIZE);
|
||
page = CORRPAGE(reg[C_PAGE]);
|
||
disp = reg[C_DISP];
|
||
zero_blk(page,disp);
|
||
|
||
/* initialize fields of window object */
|
||
for (i = 0; i < NUM_FIELDS; i++)
|
||
put_word(page, disp+map_attr[i], defaults[i]);
|
||
|
||
/* store window label pointer into window object */
|
||
put_ptr(page, disp+STR_PTR, tmp_page, tmp_disp);
|
||
}
|
||
else
|
||
{
|
||
set_src_err("MAKE-WINDOW", 1, reg);
|
||
retstat = -1;
|
||
}
|
||
|
||
return(retstat);
|
||
} /* end of function: make_window(reg) */
|
||
************************************************/
|
||
|
||
|
||
|
||
/************************************************************************/
|
||
/* Clear Window */
|
||
/************************************************************************/
|
||
clear_window(reg)
|
||
int reg[2]; /* register containing port pointer */
|
||
{
|
||
int b_attrib; /* border attributes */
|
||
int disp; /* displacement component of a pointer */
|
||
/*%%int i; /* index variable */*/
|
||
/*%%int len; /* label length (in characters) */*/
|
||
int n_cols; /* number of columns in the window */
|
||
int n_lines; /* number of lines in the window */
|
||
int page; /* page number component of a pointer */
|
||
int retstat = 0; /* the return status */
|
||
char *string; /* buffer pointer for label's text */
|
||
int t_attrib; /* text attributes */
|
||
int ul_col; /* upper left corner's column number */
|
||
int ul_line; /* upper left corner's line number */
|
||
|
||
char *string_asciz(); /* fetches characters of a string */
|
||
|
||
ENTER(clear_window);
|
||
|
||
get_port(reg,0);
|
||
page = CORRPAGE(tmp_page);
|
||
disp = tmp_disp;
|
||
if (ptype[page] == PORTTYPE*2 &&
|
||
get_byte(page, disp+P_FLAGS) & WINDOW)
|
||
{
|
||
pt_flds4(tmp_reg, &ul_line, &ul_col, &n_lines, &n_cols);
|
||
t_attrib = get_word(page, disp+T_ATTRIB);
|
||
b_attrib = get_word(page, disp+B_ATTRIB);
|
||
zclear(ul_line, ul_col, n_lines, n_cols, t_attrib);
|
||
if (b_attrib != -1)
|
||
{
|
||
tmp_page = get_byte(page, disp+STR_PTR);
|
||
tmp_disp = get_word(page, disp+STR_PTR+1);
|
||
string = string_asciz(tmp_reg);
|
||
zborder(ul_line, ul_col, n_lines, n_cols, b_attrib, string);
|
||
rlsstr(string);
|
||
}
|
||
/* put the cursor in the "home" position (upper left hand corner) */
|
||
put_word(page, disp+CUR_LINE, 0);
|
||
put_word(page, disp+CUR_COL, 0);
|
||
}
|
||
else
|
||
{
|
||
set_src_err("WINDOW-CLEAR", 1, reg);
|
||
retstat = -1;
|
||
}
|
||
return(retstat);
|
||
} /* end of function: clear_window(reg) */
|
||
|
||
/************
|
||
/************************************************************************/
|
||
/* Get Window Attribute */
|
||
/************************************************************************/
|
||
get_window_attribute(reg, attr)
|
||
int reg[2]; /* register containing port pointer */
|
||
int attr[2]; /* attribute number */
|
||
{
|
||
int attribute; /* index of the attribute desired */
|
||
int disp; /* displacement component of a pointer */
|
||
int page; /* page number component of a pointer */
|
||
int retstat = 0; /* the return status */
|
||
|
||
ENTER(get_window_attribute);
|
||
|
||
get_port(reg, 1);
|
||
page = CORRPAGE(tmp_page);
|
||
disp = tmp_disp;
|
||
if (ptype[page] == PORTTYPE*2 &&
|
||
attr[C_PAGE] == SPECFIX*2 &&
|
||
(attribute = get_fix(CORRPAGE(attr[C_PAGE]),attr[C_DISP])) >= 0 &&
|
||
attribute < NUM_FIELDS)
|
||
{
|
||
reg[C_PAGE] = SPECFIX*2;
|
||
reg[C_DISP] = get_word(page, disp+map_attr[attribute]) & 0x7fff;
|
||
}
|
||
else
|
||
{
|
||
set_src_err("%REIFY-PORT", 2, reg, attr);
|
||
retstat = -1;
|
||
}
|
||
return(retstat);
|
||
} /* end of function: get_window_attribute(reg, attr) */
|
||
|
||
/************************************************************************/
|
||
/* Set Window Attribute */
|
||
/************************************************************************/
|
||
set_window_attribute(reg, attr, value)
|
||
int reg[2]; /* register containing port pointer */
|
||
int attr[2]; /* attribute number */
|
||
int value[2]; /* new value for attribute */
|
||
{
|
||
int attribute; /* index of the attribute desired */
|
||
int disp; /* displacement component of a pointer */
|
||
int page; /* page number component of a pointer */
|
||
int retstat = 0; /* the return status */
|
||
int v; /* the new attribute value */
|
||
int fld; /* offset of lines/columns field */
|
||
int maxnum; /* maximum possible number of lines/columns */
|
||
|
||
ENTER(set_window_attribute);
|
||
|
||
get_port(reg, 1);
|
||
page = CORRPAGE(tmp_page);
|
||
disp = tmp_disp;
|
||
if (ptype[page] == PORTTYPE*2 &&
|
||
attr[C_PAGE] == SPECFIX*2 &&
|
||
(attribute = get_fix(CORRPAGE(attr[C_PAGE]),attr[C_DISP])) >= 0 &&
|
||
attribute < NUM_FIELDS &&
|
||
value[C_PAGE] == SPECFIX*2)
|
||
{
|
||
v = get_fix(CORRPAGE(value[C_PAGE]), value[C_DISP]);
|
||
switch (attribute)
|
||
{
|
||
case 0: /* cursor line */
|
||
case 1: /* cursor column */
|
||
if (v < 0) goto src_err;
|
||
break;
|
||
|
||
case 2: /* upper left corner line */
|
||
fld = N_LINES; maxnum = MAX_LINES;
|
||
goto FIT;
|
||
/*
|
||
v = fit_in_range(v, 0, MAX_LINES-1);
|
||
if (get_word(page, disp+N_LINES) > MAX_LINES - v)
|
||
put_word(page, disp+N_LINES, MAX_LINES - v);
|
||
break;
|
||
*/
|
||
|
||
case 3: /* upper left corner column */
|
||
fld = N_COLS; maxnum = MAX_COLUMNS;
|
||
FIT:
|
||
v = fit_in_range(v, 0, maxnum-1);
|
||
if (get_word(page, disp+fld) > maxnum-v)
|
||
put_word(page, disp+fld, maxnum-v);
|
||
break;
|
||
/*
|
||
v = fit_in_range(v, 0, MAX_COLUMNS-1);
|
||
if (get_word(page, disp+N_COLS) > MAX_COLUMNS - v)
|
||
put_word(page, disp+N_COLS, MAX_COLUMNS - v);
|
||
break;
|
||
*/
|
||
|
||
case 4: /* number of lines */
|
||
v = fit_in_range(v, 1, MAX_LINES-get_word(page,disp+UL_LINE));
|
||
break;
|
||
|
||
case 5: /* number of columns */
|
||
if (!(get_word(page,disp+P_FLAGS) & WINDOW)) break;
|
||
v = fit_in_range(v, 1, MAX_COLUMNS-get_word(page,disp+UL_COL));
|
||
break;
|
||
|
||
default: goto src_err;
|
||
|
||
case 6: /* border color/attributes */
|
||
case 7: /* text color/attributes */
|
||
case 8: /* flags */
|
||
case 9: /* buffer position */
|
||
case 10: /* buffer end */
|
||
case 11: /* port flags */
|
||
}
|
||
put_word(page, disp+map_attr[attribute], v); /* make the change */
|
||
}
|
||
else
|
||
{
|
||
src_err:
|
||
set_src_err("%REIFY-PORT!", 3, reg, attr, value);
|
||
retstat = -1;
|
||
}
|
||
return(retstat);
|
||
} /* end of function: set_window_attribute(reg, attr, value) */
|
||
|
||
/************************************************************************/
|
||
/* Save Window Contents */
|
||
/************************************************************************/
|
||
save_window(reg)
|
||
int reg[2]; /* pointer to window object */
|
||
{
|
||
int page,disp; /* pointer components */
|
||
int n_cols; /* number of columns in the window */
|
||
int n_lines; /* number of lines in the window */
|
||
int retstat = 0; /* the return status */
|
||
int ul_col; /* upper left hand corner's column number */
|
||
int ul_line; /* upper left hand corner's line number */
|
||
|
||
ENTER(save_window);
|
||
|
||
get_port(reg,0);
|
||
page = CORRPAGE(tmp_page);
|
||
disp = tmp_disp;
|
||
if (ptype[page] == PORTTYPE*2 &&
|
||
get_word(page, disp+P_FLAGS) & WINDOW)
|
||
{
|
||
pt_flds4(tmp_reg, &ul_line, &ul_col, &n_lines, &n_cols);
|
||
if (/* bordered? */ get_word(page, disp+B_ATTRIB) != -1)
|
||
{
|
||
adj4bord(&ul_line, &n_lines, &ul_col, &n_cols);
|
||
/*
|
||
if (ul_line) { ul_line--; n_lines++; }
|
||
if (ul_col) { ul_col--; n_cols++; }
|
||
if (ul_line + n_lines < MAX_LINES) n_lines++;
|
||
if (ul_col + n_cols < MAX_COLUMNS) n_cols++;
|
||
*/
|
||
}
|
||
alloc_block(reg, STRTYPE, ((n_lines * n_cols) * 2) + 2);
|
||
save_scr(reg, ul_line, ul_col, n_lines, n_cols);
|
||
}
|
||
else
|
||
{
|
||
set_src_err("WINDOW-SAVE-CONTENTS", 1, reg);
|
||
retstat = -1;
|
||
}
|
||
return(retstat);
|
||
} /* end of function: save_window(reg) */
|
||
|
||
/************************************************************************/
|
||
/* Restore Window Contents */
|
||
/************************************************************************/
|
||
rest_window(reg,data)
|
||
int reg[2]; /* pointer to window object */
|
||
int data[2]; /* data to be restored */
|
||
{
|
||
int page,disp; /* pointer components */
|
||
int n_cols; /* number of columns in the window */
|
||
int n_lines; /* number of lines in the window */
|
||
int retstat = 0; /* the return status */
|
||
int ul_col; /* upper left hand corner's column number */
|
||
int ul_line; /* upper left hand corner's line number */
|
||
|
||
ENTER(rest_window);
|
||
|
||
get_port(reg,0);
|
||
page = CORRPAGE(tmp_page);
|
||
disp = tmp_disp;
|
||
if (ptype[CORRPAGE(data[C_PAGE])] == STRTYPE*2 &&
|
||
ptype[page] == PORTTYPE*2 &&
|
||
get_word(page, disp+P_FLAGS) & WINDOW)
|
||
{
|
||
pt_flds4(tmp_reg, &ul_line, &ul_col, &n_lines, &n_cols);
|
||
if (/* bordered? */ get_word(page, disp+B_ATTRIB) != -1)
|
||
{
|
||
adj4bord(&ul_line, &n_lines, &ul_col, &n_cols);
|
||
/*
|
||
if (ul_line) { ul_line--; n_lines++; }
|
||
if (ul_col) { ul_col--; n_cols++; }
|
||
if (ul_line + n_lines < MAX_LINES) n_lines++;
|
||
if (ul_col + n_cols < MAX_COLUMNS) n_cols++;
|
||
*/
|
||
}
|
||
rest_scr(data, ul_line, ul_col, n_lines, n_cols);
|
||
}
|
||
else
|
||
{
|
||
set_src_err("WINDOW-RESTORE-CONTENTS", 2, reg, data);
|
||
retstat = -1;
|
||
}
|
||
return(retstat);
|
||
} /* end of function: rest_window(reg, data) */
|
||
|
||
/************************************************************************/
|
||
/* Output Character to Window */
|
||
/* */
|
||
/* Description: This routine writes a character to the current cursor */
|
||
/* position, then increments the cursor location. */
|
||
/* If the current cursor position is now within the bounds */
|
||
/* of the window, the character is output in the first */
|
||
/* column of the next line, scrolling the window, if */
|
||
/* necessary. The current text attributes are used to */
|
||
/* write the character. */
|
||
/************************************************************************/
|
||
putc_window(window, ch)
|
||
int window[2]; /* register containing the window pointer */
|
||
int ch; /* the character to be written to the window */
|
||
{
|
||
int cur_col; /* current cursor position column number */
|
||
int cur_line; /* current cursor position line number */
|
||
int n_cols; /* number of columns in the window */
|
||
int n_lines; /* number of lines in the window */
|
||
int page, disp; /* page/displacement components of window pointer */
|
||
int t_attrib; /* window's text character attributes */
|
||
int ul_col; /* upper left hand corner column number */
|
||
int ul_line; /* upper left hand corner line number */
|
||
|
||
page = CORRPAGE(window[C_PAGE]);
|
||
disp = window[C_DISP];
|
||
if (ptype[page] == PORTTYPE*2)
|
||
{
|
||
if (get_byte(page, disp+P_FLAGS) & OPEN)
|
||
{
|
||
pt_flds6(window, &cur_line, &cur_col,
|
||
&ul_line, &ul_col, &n_lines, &n_cols);
|
||
t_attrib = get_word(page, disp+T_ATTRIB);
|
||
switch(ch)
|
||
{
|
||
case '\b': /* process backspace character */
|
||
cur_col--;
|
||
if (cur_col < 0) cur_col = 0;
|
||
|
||
case '\0': /* null character-- do nothing */
|
||
break;
|
||
|
||
case '\007': /* bell character-- sound the alarm */
|
||
zbell();
|
||
break;
|
||
|
||
case '\t': /* process tab character */
|
||
cur_col += (8 - (cur_col % 8));
|
||
break;
|
||
|
||
case '\r': /* process carriage return */
|
||
cur_col = 0;
|
||
break;
|
||
|
||
case '\n': /* process newline */
|
||
cur_col = 0;
|
||
cur_line++;
|
||
if (cur_line >= n_lines)
|
||
{
|
||
zscroll(ul_line, ul_col, n_lines, n_cols, t_attrib);
|
||
cur_line = n_lines-1;
|
||
}
|
||
break;
|
||
|
||
default: if (cur_col >= n_cols)
|
||
{
|
||
if (get_word(page, disp+W_FLAGS) & WRAP)
|
||
{
|
||
cur_line++;
|
||
cur_col=0;
|
||
}
|
||
else
|
||
{
|
||
cur_col++;
|
||
break;
|
||
}
|
||
}
|
||
if (cur_line >= n_lines)
|
||
{
|
||
zscroll(ul_line, ul_col, n_lines, n_cols, t_attrib);
|
||
cur_line = n_lines-1;
|
||
cur_col = 0;
|
||
}
|
||
zputc(cur_line+ul_line, cur_col+ul_col, ch, t_attrib);
|
||
cur_col++;
|
||
} /* end: switch(ch) */
|
||
/* record new cursor position (next character position) */
|
||
put_word(page, disp+CUR_LINE, cur_line);
|
||
put_word(page, disp+CUR_COL, cur_col);
|
||
}
|
||
}
|
||
else
|
||
{
|
||
printf("[VM INTERNAL ERROR] Bad port for window output\n");
|
||
force_debug();
|
||
}
|
||
}
|
||
|
||
/************************************************************************/
|
||
/* Read a "record" from Window */
|
||
/************************************************************************/
|
||
static int *column; /* column coordinate vector */
|
||
static int cur_col; /* current cursor position- column number */
|
||
static int cur_line; /* current cursor position- line number */
|
||
static int i; /* index into character buffer */
|
||
static int insert_mode; /* insert mode flag */
|
||
static int len; /* local copy of ln */
|
||
static int n_cols; /* number of columns in the window */
|
||
static int n_lines; /* number of lines in the window */
|
||
static int page, disp; /* page/displacement components of window pointer */
|
||
static int *row; /* row coordinate vector */
|
||
static int sh_ptr; /* shadow buffer pointer */
|
||
static int t_attrib; /* window's text character attributes */
|
||
static int ul_col; /* upper left hand corner column number */
|
||
static int ul_line; /* upper left hand corner line number */
|
||
static char *string; /* input buffer pointer */
|
||
|
||
static int sh_length = 0; /* number of characters in the shadow buffer */
|
||
static char *sh_buffer; /* shadow buffer */
|
||
|
||
read_window(window, str, ln)
|
||
int window[2]; /* register containing window pointer */
|
||
char *str; /* character buffer in which to return data read */
|
||
int *ln; /* maximum number of characters to read */
|
||
{
|
||
int ch; /* character just read */
|
||
int j; /* index variable */
|
||
int len2; /* length of input buffer times two (2) */
|
||
|
||
ENTER(read_window);
|
||
|
||
string = str;
|
||
sh_ptr = i = 0;
|
||
insert_mode = FALSE;
|
||
len2 = (*ln) + (*ln);
|
||
len = (*ln) - 3;
|
||
|
||
if (!(row = (int *) getmem(len2)) || !(column = (int *) getmem(len2)))
|
||
getmem_error(rtn_name);
|
||
|
||
page = CORRPAGE(window[C_PAGE]);
|
||
disp = window[C_DISP];
|
||
if (ptype[page] == PORTTYPE*2)
|
||
{
|
||
pt_flds6(window, &cur_line, &cur_col,
|
||
&ul_line, &ul_col, &n_lines, &n_cols);
|
||
t_attrib = get_word(page, disp+T_ATTRIB);
|
||
|
||
zcuron();
|
||
do
|
||
{
|
||
if (cur_line >= n_lines)
|
||
{
|
||
zscroll(ul_line, ul_col, n_lines, n_cols, t_attrib);
|
||
cur_line = n_lines-1;
|
||
cur_col = 0;
|
||
}
|
||
zputcur(ul_line + cur_line, ul_col + cur_col);
|
||
ch = getch();
|
||
switch(ch)
|
||
{
|
||
case '\0': /* process extended key sequence */
|
||
ch = getch();
|
||
switch (ch)
|
||
{
|
||
case LEFT_ARROW: goto backspace;
|
||
|
||
case RIGHT_ARROW: insert_mode = FALSE;
|
||
if (sh_ptr < sh_length)
|
||
{
|
||
ch = sh_buffer[sh_ptr];
|
||
goto one_char;
|
||
}
|
||
break;
|
||
|
||
case F3: insert_mode = FALSE;
|
||
while (i < len && sh_ptr < sh_length)
|
||
echo_char(sh_buffer[sh_ptr]);
|
||
break;
|
||
|
||
case F5: if (i)
|
||
{
|
||
rlsstr(sh_buffer);
|
||
if (!(sh_buffer = getmem(i+1)))
|
||
getmem_error(rtn_name);
|
||
str2str(sh_buffer, string, i);
|
||
sh_buffer[i] = '\0';
|
||
sh_length = i;
|
||
for (j = i-1; j >= 0; j--)
|
||
{
|
||
if (row[j] < 0) break;
|
||
zputc(ul_line + (cur_line = row[j]),
|
||
ul_col + (cur_col = column[j]),
|
||
' ', t_attrib);
|
||
}
|
||
sh_ptr = i = 0;
|
||
}
|
||
insert_mode = FALSE;
|
||
break;
|
||
|
||
case INSERT: insert_mode = TRUE;
|
||
break;
|
||
|
||
case DELETE: if (sh_ptr < sh_length) sh_ptr++;
|
||
insert_mode = FALSE;
|
||
break;
|
||
|
||
case ENTER_KEY: goto carriage_return;
|
||
|
||
} /* end: switch (ch) */
|
||
break;
|
||
|
||
case '\b': /* process backspace key */
|
||
backspace:
|
||
if (i <= 0 || row[i-1] < 0) zbell();
|
||
else
|
||
{
|
||
i--;
|
||
if (sh_ptr) sh_ptr--;
|
||
cur_col = column[i];
|
||
cur_line = row[i];
|
||
zputc(ul_line + cur_line, ul_col + cur_col, ' ',
|
||
t_attrib);
|
||
}
|
||
insert_mode = FALSE;
|
||
break;
|
||
|
||
case '\r': /* process return key */
|
||
carriage_return:
|
||
string[i++] = '\r'; /* insert carriage return in buffer */
|
||
string[i++] = '\n'; /* insert line feed in buffer */
|
||
cur_line++;
|
||
cur_col = 0;
|
||
if (cur_line >= n_lines)
|
||
{
|
||
zscroll(ul_line, ul_col, n_lines, n_cols, t_attrib);
|
||
cur_line = n_lines-1;
|
||
}
|
||
rlsstr(sh_buffer);
|
||
if (!(sh_buffer = getmem(i))) getmem_error(rtn_name);
|
||
str2str(sh_buffer, string, i);
|
||
sh_buffer[i-1] = '\0';
|
||
sh_length = i-2;
|
||
break;
|
||
|
||
case '\n': /* ignore line feed key */
|
||
break;
|
||
one_char:
|
||
default: if (i >= len)
|
||
zbell();
|
||
else echo_char(ch);
|
||
} /* end: switch(ch) */
|
||
} while (ch != '\r');
|
||
zcuroff();
|
||
put_word(page, disp+CUR_LINE, cur_line);
|
||
put_word(page, disp+CUR_COL, cur_col);
|
||
*ln = i;
|
||
}
|
||
else
|
||
{
|
||
printf("[VM INTERNAL ERROR] Bad port for window input\n");
|
||
force_debug();
|
||
}
|
||
if (rlsmem(row, len2) || rlsmem(column, len2))
|
||
rlsmem_error(rtn_name);
|
||
} /* end of function: char *read_window(window) */
|
||
|
||
/************************************************************************/
|
||
/* Echo Single Character */
|
||
/************************************************************************/
|
||
echo_char(ch)
|
||
int ch;
|
||
{
|
||
int j; /* index variable */
|
||
string[i++] = ch;
|
||
if (!insert_mode) sh_ptr++;
|
||
if (cur_col >= n_cols)
|
||
{
|
||
cur_line++;
|
||
cur_col = 0;
|
||
}
|
||
if (cur_line >= n_lines)
|
||
{
|
||
zscroll(ul_line, ul_col, n_lines, n_cols, t_attrib);
|
||
cur_line = n_lines-1;
|
||
cur_col = 0;
|
||
for (j = 0; j < i; j++) row[j]--;
|
||
}
|
||
row[i-1] = cur_line;
|
||
column[i-1] = cur_col;
|
||
if (ch == '\t')
|
||
{
|
||
if((cur_col += (8 - (cur_col % 8)))>n_cols) cur_col = n_cols;
|
||
if (ul_col + cur_col >= 80) zputcur(cur_line, 79);
|
||
}
|
||
else
|
||
{
|
||
zputc(ul_line + cur_line, ul_col + cur_col, ch, t_attrib);
|
||
cur_col++;
|
||
}
|
||
} /* end of function: out_char(ch) */
|
||
|
||
/************************************************************************/
|
||
/* Force Value Into Range */
|
||
/* */
|
||
/* Purpose: To test a value to determine if it falls within a range */
|
||
/* of values, as specified by an lower and upper bound. */
|
||
/* If the value is within the range, the value is returned */
|
||
/* unchanged. If it is outside the range, the value of the*/
|
||
/* endpoint nearest its value is returned. */
|
||
/************************************************************************/
|
||
fit_in_range(value, lower, upper)
|
||
int value; /* value to be tested */
|
||
int lower; /* lower bound of range */
|
||
int upper; /* upper bound of range */
|
||
{
|
||
return(value < lower ? lower : (value > upper ? upper : value));
|
||
} /* end of function: fit_in_range(value, lower, upper) */
|
||
|
||
/************************************************************************/
|
||
/* Support for "read-char-ready?" */
|
||
/************************************************************************/
|
||
rd_ch_rdy(port)
|
||
int port[2]; /* register containing port designation */
|
||
{
|
||
int b_pos; /* current buffer position */
|
||
int ch; /* character read from a file */
|
||
int flags; /* port flags */
|
||
int page; /* port's page number */
|
||
int retstat = 0; /* the return status */
|
||
|
||
if (!get_port(port, 0))
|
||
{
|
||
port[C_PAGE] = SPECCHAR*2; /* prepare to return a character */
|
||
page = CORRPAGE(tmp_page);
|
||
if ((b_pos = get_word(page, tmp_disp+BUF_POS)) <
|
||
get_word(page, tmp_disp+BUF_END))
|
||
{
|
||
ch = get_byte(page, tmp_disp+BUFR+b_pos);
|
||
return_T:
|
||
if (ch == '\032' && !(get_word(page,tmp_disp+P_FLAGS) & BINARY))
|
||
goto return_eof;
|
||
port[C_DISP] = ch;
|
||
goto end_of_routine;
|
||
}
|
||
else /* no character in input buffer */
|
||
{
|
||
if ((flags = get_byte(page, tmp_disp+P_FLAGS)) & WINDOW)
|
||
{
|
||
if ((ch = zch_rdy()))
|
||
{
|
||
ch = ch & 0x00ff;
|
||
goto return_T;
|
||
}
|
||
}
|
||
else /* not a window */
|
||
{
|
||
if (flags & OPEN)
|
||
{
|
||
ssetadr(tmp_page, tmp_disp);
|
||
ch = take_ch();
|
||
if (ch != 256)
|
||
{
|
||
pushchar();
|
||
port[C_DISP] = ch;
|
||
} /* end: if (ch != 256) */
|
||
else
|
||
{
|
||
return_eof:
|
||
port[C_PAGE] = EOF_PAGE*2;
|
||
port[C_DISP] = EOF_DISP;
|
||
} /* end: else */
|
||
goto end_of_routine;
|
||
} /* end: if (flags & OPEN) */
|
||
} /* end: else /* not a window */ */
|
||
} /* end: else /* no character in input buffer */ */
|
||
} /* end: if (!get_port(port, 0)) */
|
||
else
|
||
{
|
||
set_src_err("CHAR-READY?", 1, port);
|
||
retstat = -1;
|
||
}
|
||
/* no character available-- return '() */
|
||
port[C_PAGE] = port[C_DISP] = 0;
|
||
end_of_routine:
|
||
return(retstat);
|
||
} /* end of function: rd_ch_rdy(port) */
|
||
|
||
/************************************************************************/
|
||
/* Support for "read-char" */
|
||
/************************************************************************/
|
||
read_char(port)
|
||
int port[2];
|
||
{
|
||
int i; /* temporary */ /* 2-11-86 */
|
||
int page; /* port's page number */
|
||
int retstat = 0; /* the return status */
|
||
|
||
if (!get_port(port, 0))
|
||
{
|
||
page = CORRPAGE(tmp_page);
|
||
port[C_PAGE] = SPECCHAR*2;
|
||
if ((i = get_byte(page, tmp_disp+P_FLAGS)) & WINDOW && /* 2-11-86 */
|
||
!(i & STRSRC) &&
|
||
get_word(page, tmp_disp+BUF_POS) >= get_word(page, tmp_disp+BUF_END))
|
||
{
|
||
zputcur(get_word(page,tmp_disp+UL_LINE)+get_word(page,tmp_disp+CUR_LINE),
|
||
get_word(page,tmp_disp+UL_COL)+get_word(page,tmp_disp+CUR_COL));
|
||
zcuron();
|
||
port[C_DISP] = getch();
|
||
zcuroff();
|
||
put_byte(page, tmp_disp+BUFR, port[C_DISP]);
|
||
put_word(page, tmp_disp+BUF_POS, 1);
|
||
put_word(page, tmp_disp+BUF_END, 1);
|
||
}
|
||
else
|
||
{
|
||
ssetadr(tmp_page,tmp_disp);
|
||
if ((port[C_DISP] = take_ch()) == 256)
|
||
{
|
||
port[C_PAGE] = EOF_PAGE*2;
|
||
port[C_DISP] = EOF_DISP;
|
||
}
|
||
}
|
||
}
|
||
else
|
||
{
|
||
set_src_err("READ-CHAR", 1, port);
|
||
retstat = -1;
|
||
}
|
||
return(retstat);
|
||
} /* end of function: read_char(port) */
|
||
|
||
/************************************************************************/
|
||
/* Set Port Address */
|
||
/************************************************************************/
|
||
setadr(pg, ds, direction)
|
||
int pg; /* the port's page number */
|
||
int ds; /* the port's displacement */
|
||
int direction; /* read/write flag */
|
||
{
|
||
if (ptype[pg] == PORTTYPE*2)
|
||
{
|
||
port_reg[C_PAGE] = ADJPAGE((port_page = pg));
|
||
port_reg[C_DISP] = port_disp = ds;
|
||
handle = get_word(pg, ds+HANDLE);
|
||
direction = get_word(pg, ds+P_FLAGS);
|
||
window_p = direction & WINDOW;
|
||
string_p = direction & STRSRC;
|
||
}
|
||
else
|
||
{
|
||
printf("[VM INTERNAL ERROR] setadr: bad port\n");
|
||
force_debug();
|
||
return(1);
|
||
}
|
||
return(0);
|
||
} /* end of function: setadr(pg, ds, direction) */
|
||
|
||
/************************************************************************/
|
||
/* Output a Single Character */
|
||
/************************************************************************/
|
||
givechar(ch)
|
||
int ch; /* the character to be output */
|
||
{
|
||
int cur_col; /* the current column */
|
||
int n_cols; /* number of columns */
|
||
int length; /* character string length for output */
|
||
int stat; /* status returned from zwrite */ /* 2-11-86 */
|
||
int sav_page,sav_disp;
|
||
|
||
/*if (ch == '\n') ch = '\r'; Don't change! *** JHAO ***/
|
||
|
||
/* If transcript file "on", check this port for transcript-enable */
|
||
if (TRNS_pag && (get_word(port_page, port_disp+P_FLAGS) & TRANSCRIPT))
|
||
{
|
||
sav_page = port_page;
|
||
sav_disp = port_disp;
|
||
setadr(CORRPAGE(TRNS_pag), TRNS_dis, 1);
|
||
givechar(ch);
|
||
setadr(sav_page, sav_disp, 1);
|
||
} /* end: if (TRNS_pag) */
|
||
|
||
if (window_p)
|
||
{
|
||
if (!string_p)
|
||
{
|
||
if (ch == '\r') ch = '\n';
|
||
putc_window(port_reg, ch);
|
||
}
|
||
}
|
||
else
|
||
{
|
||
n_cols = get_word(port_page, port_disp+N_COLS);
|
||
cur_col = get_word(port_page, port_disp+CUR_COL);
|
||
length = 1;
|
||
if (ch == '\n')
|
||
{
|
||
ch = '\r';
|
||
if ((stat = zwrite(handle, &ch, &length))) /* 2-11-86 */
|
||
goto zerror;
|
||
ch = '\n';
|
||
length = 1;
|
||
if ((stat = zwrite(handle, &ch, &length))) /* 2-11-86 */
|
||
goto zerror;
|
||
}
|
||
else
|
||
{
|
||
if ((stat = zwrite(handle, &ch, &length))) /* 2-11-86 */
|
||
goto zerror;
|
||
if (ch == '\r')
|
||
{
|
||
if (handle != prn_handle)
|
||
{ /* write to file CR = CRLF */
|
||
ch = '\n';
|
||
length = 1;
|
||
if ((stat = zwrite(handle, &ch, &length))) /* 2-11-86 */
|
||
goto zerror;
|
||
}
|
||
}
|
||
}
|
||
switch (ch)
|
||
{
|
||
case '\b':
|
||
cur_col--;
|
||
if (cur_col < 0) cur_col = 0;
|
||
break;
|
||
case '\t':
|
||
cur_col += (8 - (cur_col % 8));
|
||
break;
|
||
case '\r':
|
||
case '\n':
|
||
cur_col = 0;
|
||
break;
|
||
default:
|
||
if (cur_col >= n_cols)
|
||
cur_col = 0;
|
||
else cur_col++;
|
||
}
|
||
put_word(port_page, port_disp+CUR_COL, cur_col);
|
||
}
|
||
return(0);
|
||
|
||
zerror: /* 2-11-86 */
|
||
printf("[VM ERROR encountered!] Write error: DOS error code %d\n%s",
|
||
stat,"Attempting to execute SCHEME-RESET\n[Returning to top level]");
|
||
force_reset();
|
||
return(0);
|
||
|
||
|
||
} /* end of function: givechar(ch) */
|
||
|
||
/************************************************************************/
|
||
/* Input a Single Character */
|
||
/* */
|
||
/* Description: Accepts the next character from the currently active */
|
||
/* port. */
|
||
/* */
|
||
/* Calling Sequence: ch = takechar(); */
|
||
/* Where ch -- the character read or EOF (0x0100) */
|
||
/* */
|
||
/* Note: This routine reads from the port data object previously */
|
||
/* defined by a call to "SETADR". */
|
||
/************************************************************************/
|
||
takechar()
|
||
{
|
||
char buffer[BUFFSIZE];/* local buffer for sequential read request */
|
||
int ch; /* the character to be returned */
|
||
int cur_chr; /* buffer position of the current character */
|
||
int i; /* index variable */
|
||
int length; /* buffer length; number of characters read */
|
||
int sav_page,sav_disp;/* port pointer save area */
|
||
int stat; /* status variable for read requests */
|
||
|
||
cur_chr = get_word(port_page, port_disp+BUF_POS);
|
||
if (cur_chr >= get_word(port_page, port_disp+BUF_END))
|
||
{ /* buffer empty-- fill it up */
|
||
length = BUFFSIZE;
|
||
if (window_p)
|
||
{
|
||
if (string_p)
|
||
{
|
||
if (stringrd(port_page, port_disp, buffer, &length))
|
||
printf("[VM INTERNAL ERROR] takechar: source not a string\n");
|
||
}
|
||
else
|
||
{
|
||
read_window(port_reg, buffer, &length);
|
||
/* If transcript file "on", check this file for transcript-enable */
|
||
if (TRNS_pag && (get_word(port_page, port_disp+P_FLAGS) & TRANSCRIPT))
|
||
{
|
||
sav_page = port_page;
|
||
sav_disp = port_disp;
|
||
setadr(CORRPAGE(TRNS_pag), TRNS_dis, 1);
|
||
printstr(buffer, length - 1);
|
||
setadr(sav_page, sav_disp, 1);
|
||
} /* end: if (TRNS_pag ...) */
|
||
}
|
||
}
|
||
else
|
||
{
|
||
if ((stat = zread(handle, buffer, &length)))
|
||
{
|
||
printf("[VM ERROR encountered!] Read error: DOS error code %d\n%s",stat,
|
||
"Attempting to execute SCHEME-RESET\n[Returning to top level]");
|
||
force_reset();
|
||
}
|
||
}
|
||
put_word(port_page, port_disp+BUF_END, length);
|
||
if (length == 0)
|
||
{
|
||
put_word(port_page, port_disp+BUF_POS, 0);
|
||
return(256);
|
||
}
|
||
toblock(port_reg, BUFR, buffer, length);
|
||
cur_chr = 0;
|
||
}
|
||
|
||
/* return the next character from the input buffer */
|
||
put_word(port_page, port_disp+BUF_POS, cur_chr+1);
|
||
ch = get_byte(port_page, port_disp+BUFR+cur_chr);
|
||
|
||
/* test for a control-Z-- if so, and we've got a text file, return EOF */
|
||
if (ch == '\032' && !(get_word(port_page, port_disp+P_FLAGS) & BINARY))
|
||
ch = 256;
|
||
|
||
return(ch);
|
||
} /* end of function: takechar() */
|
||
|
||
/************************************************************************/
|
||
/* Push a Single Character Back into the Input Buffer */
|
||
/************************************************************************/
|
||
pushchar()
|
||
{
|
||
int cur_chr; /* buffer position of the current character */
|
||
|
||
cur_chr = get_word(port_page, port_disp+BUF_POS);
|
||
if (cur_chr > 0)
|
||
{
|
||
cur_chr--;
|
||
put_word(port_page, port_disp+BUF_POS, cur_chr);
|
||
}
|
||
else
|
||
{
|
||
printf("[VM INTERNAL ERROR] pushchar: failed\n");
|
||
force_debug();
|
||
}
|
||
} /* end of function: pushchar() */
|
||
|
||
|
||
/************************************************************************/
|
||
/* Return Number of Spaces Remaining on Current Line */
|
||
/* */
|
||
/* Description: The routine interrogates a port data object and */
|
||
/* returns the number of print positions remaining on the */
|
||
/* current line. If no line length is associated with the */
|
||
/* port (i.e., the line length is zero), the value 0x7fff */
|
||
/* is returned. This routine works for both file and */
|
||
/* window port data objects. */
|
||
/* */
|
||
/* Calling Sequence: setadr(pg, ds); */
|
||
/* space = currspc(); */
|
||
/* */
|
||
/* Where pg ---- the port's page number */
|
||
/* ds ---- the port's displacement */
|
||
/* space - the number of positions remaining on the */
|
||
/* current print line */
|
||
/************************************************************************/
|
||
currspc()
|
||
{
|
||
int cur_col;
|
||
int line_length; /* the port's line length */
|
||
|
||
cur_col = get_word(port_page, port_disp+CUR_COL);
|
||
line_length = get_word(port_page, port_disp+N_COLS);
|
||
return(line_length ? line_length - cur_col : 0x7fff);
|
||
} /* end of function: currspc() */
|
||
|
||
/************************************************************************/
|
||
/* Return Current Column */
|
||
/************************************************************************/
|
||
curr_col()
|
||
{
|
||
return(get_word(port_page, port_disp+CUR_COL));
|
||
}
|
||
/* end of function: curr_col() */
|
||
******************************************/
|
||
|
||
/************ The following module is not called by anyone
|
||
/************************************************************************/
|
||
/* Return Line Length of a Port/Window */
|
||
/************************************************************************/
|
||
lnlen(pg,ds)
|
||
int pg,ds;
|
||
{
|
||
return(ptype[pg] == PORTTYPE*2 ? get_word(pg,ds+N_COLS) : -1);
|
||
}
|
||
****************************************************/
|
||
|
||
/***** Code turned off 17 May 1985 *****
|
||
/************************************************************************/
|
||
/* Return Line Length of a Port/Window */
|
||
/************************************************************************/
|
||
set_lnlen(pg,ds,len)
|
||
int pg,ds,len;
|
||
{
|
||
if (ptype[pg] == PORTTYPE*2)
|
||
{
|
||
if (len >= 0) put_word(pg,ds+N_COLS,len);
|
||
}
|
||
else
|
||
{
|
||
printf("set_lnlen: bad port\n");
|
||
force_debug();
|
||
}
|
||
} /* end of function: set_lnlen(pg,ds,len) */
|
||
***** Code turned off 17 May 1985 *****/
|
||
/**************
|
||
/************************************************************************/
|
||
/* Modify Transcript File Status */
|
||
/************************************************************************/
|
||
trns_chg(reg)
|
||
int reg[2];
|
||
{
|
||
int mode;
|
||
int page;
|
||
|
||
if (ptype[(page = CORRPAGE(reg[C_PAGE]))] == PORTTYPE*2 &&
|
||
(mode = get_word(page, reg[C_DISP] + P_FLAGS)) & OPEN &&
|
||
mode & 0x03)
|
||
{
|
||
TRNS_pag = reg[C_PAGE];
|
||
TRNS_dis = reg[C_DISP];
|
||
}
|
||
else
|
||
{
|
||
TRNS_pag = TRNS_dis = 0;
|
||
}
|
||
} /* end of function: trns_chg(reg) */
|
||
|
||
/************************************************************************/
|
||
/* Write Message to the who-line */
|
||
/************************************************************************/
|
||
who_write(str)
|
||
char *str;
|
||
{
|
||
extern int port_r[2];
|
||
int ds,pg; /* page and displacement components of active port */
|
||
int ppg;
|
||
|
||
/* save the current port */
|
||
ds = port_r[C_DISP];
|
||
pg = CORRPAGE(port_r[C_PAGE]);
|
||
ppg = port_r[C_PAGE];
|
||
|
||
/* write message to the "who line" */
|
||
ssetadr(ADJPAGE(WHO_PAGE), WHO_DISP);
|
||
printstr(str, strlen(str));
|
||
|
||
/* restore the port which was in effect when we started */
|
||
if (ptype[pg] == PORTTYPE*2 && get_byte(pg,ds) == PORTTYPE)
|
||
ssetadr(ppg, ds);
|
||
} /* end of function: who_write(str) */
|
||
**************************************************/
|
||
|
||
/************************************************************************/
|
||
/* Write "GC On"Message to the who-line */
|
||
/************************************************************************/
|
||
gc_on()
|
||
{
|
||
int lcl_reg[2];
|
||
char *text;
|
||
char *string_asciz();
|
||
|
||
GC_ING = 1;
|
||
|
||
intern(lcl_reg, "PCS-GC-MESSAGE", 14);
|
||
if (sym_lookup (lcl_reg, GNV_reg) &&
|
||
(text = string_asciz(lcl_reg)))
|
||
{
|
||
who_write("\n");
|
||
who_write(text);
|
||
rlsstr(text);
|
||
}
|
||
else
|
||
{
|
||
who_write("\n * Garbage Collecting *");
|
||
}
|
||
} /* end of function: gc_on() */
|
||
|
||
/************************************************************************/
|
||
/* Un-Write "GC On"Message to the who-line */
|
||
/************************************************************************/
|
||
gc_off()
|
||
{
|
||
|
||
GC_ING = 0;
|
||
|
||
who_clear();
|
||
} /* end of function: gc_off() */
|
||
|