| home
| contents
| previous
| next page
| send comment
| send link
| add bookmark |
PRS_STND.CPP
standard functions
/*-------------------------------------------------------------------*
Parser for standard procedures and functions
File: prs_stnd.cpp
Module: parser
by: Stephen R. Schmitt
*-------------------------------------------------------------------*/
#include "tpl_data.h"
#include <assert.h>
#include <stdlib.h>
/*
* External variables
*/
/* in tpl_main.cpp */
extern bool Debug_flag; // true in debug mode
/* in scn_main.cpp */
extern token_struct Token;
extern TOKEN_CODE String_type_list[];
/* in sym_tabl.cpp */
extern TYPE_STRUCT_PTR Integer_typep, Real_typep,
Boolean_typep, Char_typep,
String_typep, Null_typep;
/*-------------------------------------------------------------------*
Code Section
*-------------------------------------------------------------------*/
/*
* "standard_routine_call" processes a call to a standard
* procedure or function. A pointer is returned to the type
* structure of the call. The next global "Token" is obtained
* from the source file by each of the standard routine functions.
*
* returns: a pointer to the function's result type
*/
TYPE_STRUCT_PTR standard_routine_call()
{
TYPE_STRUCT_PTR ret_tp; // return value
switch (Token.code)
{
case ARCCOS:
case ARCSIN:
case ARCTAN:
case COS:
case COSH:
case EXP:
case GETEXP:
case LN:
case LOG2:
case LOG10:
case SIN:
case SINH:
case SQRT:
case TAN:
case TANH:
ret_tp = real_into_real();
break;
case ABS:
ret_tp = abs_func();
break;
case ARCTANXY:
ret_tp = arctanxy_func();
break;
case CURSOR:
ret_tp = cursor_proc();
break;
case CEIL:
case FLOOR:
case ROUND:
case SIGN:
ret_tp = real_into_integer();
break;
case CHR:
ret_tp = chr_func();
break;
case CLOSE:
case EOFF:
ret_tp = file_func();
break;
case EREALSTR:
ret_tp = erealstr_func();
break;
case FREALSTR:
ret_tp = frealstr_func();
break;
case GETKEY:
ret_tp = getkey_func();
break;
case INDEX:
ret_tp = index_func();
break;
case INTREAL:
ret_tp = intreal_func();
break;
case INTSTR:
ret_tp = intstr_func();
break;
case LENGTH:
ret_tp = length_func();
break;
case LOCATE:
ret_tp = locate_proc();
break;
case MAX:
case MIN:
ret_tp = max_min_func();
break;
case OPEN:
ret_tp = open_func();
break;
case ORD:
ret_tp = ord_func();
break;
case PRED:
case SUCC:
ret_tp = pred_succ_func();
break;
case PUTCH:
ret_tp = putch_proc();
break;
case PUTSTR:
ret_tp = putstr_proc();
break;
case PUTLINE:
ret_tp = putline_proc();
break;
case PUTPIXEL:
ret_tp = putpixel_proc();
break;
case RAND:
ret_tp = rand_func();
break;
case RANDINT:
ret_tp = randint_func();
break;
case RANDOMIZE:
ret_tp = randomize_proc();
break;
case RANDSEED:
ret_tp = randseed_proc();
break;
case REALSTR:
ret_tp = realstr_func();
break;
case REPEAT:
ret_tp = repeat_func();
break;
case SCROLL:
ret_tp = scroll_proc();
break;
case SETEXP:
ret_tp = setexp_func();
break;
case SETVIDEO:
ret_tp = setvideo_proc();
break;
case STRINT:
case STRREAL:
ret_tp = string_into_number();
break;
case VIDEOMODE:
case VIDEOTYPE:
ret_tp = video_func();
break;
case WATCH:
ret_tp = watch_proc();
break;
default:
assert(0);
break;
}
return ret_tp;
}
/*
* "real_into_real" processes a call to one of:
*
* arccos(r : real) : real
* arcsin(r : real) : real
* arctan(r: real): real
* cos(r : real) : real
* cosh(r : real) : real
* exp(r : real) : real
* getexp(r : real) : real
* ln(r : real) : real
* log2(r : real) : real
* log10(r : real) : real
* sin(r : real) : real
* sinh(r : real) : real
* sqrt(r : real) : real
* tan(r : real) : real
* tanh(r : real) : real
*
* returns: Real_typep
*/
TYPE_STRUCT_PTR real_into_real()
{
TOKEN_CODE code = Token.code; // of function
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_number_expression();
if_code_get_token_else_error(R_PAREN);
switch (code)
{
case ARCCOS:
emit_operator(CALL_stnd, SF_ARCCOS, 0, 0);
break;
case ARCSIN:
emit_operator(CALL_stnd, SF_ARCSIN, 0, 0);
break;
case ARCTAN:
emit_operator(CALL_stnd, SF_ARCTAN, 0, 0);
break;
case COS:
emit_operator(CALL_stnd, SF_COS, 0, 0);
break;
case COSH:
emit_operator(CALL_stnd, SF_COSH, 0, 0);
break;
case EXP:
emit_operator(CALL_stnd, SF_EXP, 0, 0);
break;
case GETEXP:
emit_operator(CALL_stnd, SF_GETEXP, 0, 0);
break;
case LN:
emit_operator(CALL_stnd, SF_LN, 0, 0);
break;
case LOG2:
emit_operator(CALL_stnd, SF_LOG2, 0, 0);
break;
case LOG10:
emit_operator(CALL_stnd, SF_LOG10, 0, 0);
break;
case SIN:
emit_operator(CALL_stnd, SF_SIN, 0, 0);
break;
case SINH:
emit_operator(CALL_stnd, SF_SINH, 0, 0);
break;
case SQRT:
emit_operator(CALL_stnd, SF_SQRT, 0, 0);
break;
case TAN:
emit_operator(CALL_stnd, SF_TAN, 0, 0);
break;
case TANH:
emit_operator(CALL_stnd, SF_TANH, 0, 0);
break;
default:
assert(0);
break;
}
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Real_typep;
}
/*
* "abs_func" processes a call to:
*
* abs(arg: real|int): real|int
*
* returns: a pointer to the function's result type
*/
TYPE_STRUCT_PTR abs_func()
{
TYPE_STRUCT_PTR tp;
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
tp = get_number_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_ABS, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return tp;
}
/*
* "arctanxy_func" processes a call to
*
* arctanxy(x, y : real) : real
*
* returns: Real_typep
*/
TYPE_STRUCT_PTR arctanxy_func()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_number_expression();
if_code_get_token_else_error(COMMA);
get_number_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_ARCTANXY, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Real_typep;
}
/*
* "real_into_integer" processes a call to one of:
*
* ceil( r : real) : int
* floor(r : real) : int
* round(r : real) : int
* sign( r : real) : int
*
* returns: Integer_typep
*/
TYPE_STRUCT_PTR real_into_integer()
{
TOKEN_CODE code; // of function
code = Token.code;
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_number_expression();
if_code_get_token_else_error(R_PAREN);
switch (code)
{
case CEIL:
emit_operator(CALL_stnd, SF_CEIL, 0, 0);
break;
case FLOOR:
emit_operator(CALL_stnd, SF_FLOOR, 0, 0);
break;
case ROUND:
emit_operator(CALL_stnd, SF_ROUND, 0, 0);
break;
case SIGN:
emit_operator(CALL_stnd, SF_SIGN, 0, 0);
break;
default:
assert(0);
break;
}
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Integer_typep;
}
/*
* "chr_func" processes a call to:
*
* chr(i : int) : char
*
* returns: Char_typep
*/
TYPE_STRUCT_PTR chr_func()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_CHR, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Char_typep;
}
/*
* "file_func" processes a call to either of:
*
* close(stream : int) : boolean
* eof(stream: int) : boolean
*
* returns: Boolean_typep
*/
TYPE_STRUCT_PTR file_func()
{
TOKEN_CODE code = Token.code; // of function
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
switch (code)
{
case CLOSE:
emit_operator(CALL_stnd, SF_CLOSE, 0, 0);
break;
case EOFF:
emit_operator(CALL_stnd, SF_EOFF, 0, 0);
break;
default:
assert(0);
break;
}
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Boolean_typep;
}
/*
* "erealstr_func" processes a call to:
*
* erealstr(r : real,
* stringWidth,
* fractionWidth,
* exponentWidth : int) : string
*
* returns: String_typep
*/
TYPE_STRUCT_PTR erealstr_func()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_number_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_EREALSTR, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return String_typep;
}
/*
* "frealstr_func" processes a call to:
*
* frealstr(r: real,
* stringWidth,
* fractionWidth : int) : string
*
* returns: String_typep
*/
TYPE_STRUCT_PTR frealstr_func()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_number_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_FREALSTR, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return String_typep;
}
/*
* "getkey_func" processes a call to:
*
* getkey : int
*
* returns: Integer_typep
*/
TYPE_STRUCT_PTR getkey_func()
{
get_token(); // after <function>
emit_operator(CALL_stnd, SF_GETKEY, 0, 0);
return Integer_typep;
}
/*
* "index_func" processes a call to:
*
* index(s, patt: string): int
*
* returns: Integer_typep
*/
TYPE_STRUCT_PTR index_func()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
string_expression(); // and get next token
if_code_get_token_else_error(COMMA);
string_expression(); // and get next token
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_INDEX, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Integer_typep;
}
/*
* "intreal_func" processes a call to:
*
* intreal(i : int) : real
*
* returns: Real_typep
*/
TYPE_STRUCT_PTR intreal_func()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_INTREAL, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Real_typep;
}
/*
* "intstr_func" processes a call to:
*
* intstr(i : int,
* stringWidth : int) : string
*
* returns: String_typep
*/
TYPE_STRUCT_PTR intstr_func()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_INTSTR, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return String_typep;
}
/*
* "length_func" processes a call to:
*
* length(s : string) : int
*
* returns: Integer_typep
*/
TYPE_STRUCT_PTR length_func()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
string_expression(); // and get next token
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_LENGTH, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Integer_typep;
}
/*
* "max_min_func" processes a call to one of:
*
* max(expr1, expr2) : real|int
* min(expr1, expr2) : real|int
*
* returns: a pointer to result type
*/
TYPE_STRUCT_PTR max_min_func()
{
TYPE_STRUCT_PTR tp1, tp2, result_tp;
TOKEN_CODE code = Token.code; // of function
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
tp1 = get_number_expression();
if_code_get_token_else_error(COMMA);
tp2 = get_number_expression();
if_code_get_token_else_error(R_PAREN);
if ((tp1 == Real_typep) || (tp2 == Real_typep))
result_tp = Real_typep;
else
result_tp = Integer_typep;
switch (code)
{
case MAX:
emit_operator(CALL_stnd, SF_MAX, 0, 0);
break;
case MIN:
emit_operator(CALL_stnd, SF_MIN, 0, 0);
break;
default:
assert(0);
break;
}
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return result_tp;
}
/*
* "open_func" processes a call to:
*
* open(name, mode : string) : int
*
* returns: Integer_typep
*/
TYPE_STRUCT_PTR open_func()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
string_expression(); // and get next token
if_code_get_token_else_error(COMMA);
string_expression(); // and get next token
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_OPEN, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Integer_typep;
}
/*
* "ord_func" processes a call to one of:
*
* ord(ch : char) : int
*
* returns: Integer_typep
*/
TYPE_STRUCT_PTR ord_func()
{
TYPE_STRUCT_PTR tp;
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
tp = expression(); // and get next token
if (tp != Char_typep)
compile_error(M_INVALID, M_TYPE, M_0);
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_ORD, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Integer_typep;
}
/*
* "pred_succ_func" processes a call to one of:
*
* pred(expr) : expr type
* succ(expr) : expr type
*
* returns: a pointer to the expression type
*/
TYPE_STRUCT_PTR pred_succ_func()
{
TYPE_STRUCT_PTR tp, expr_tp;
TOKEN_CODE code = Token.code; // of function
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
tp = expression(); // and get next token
if ((tp != Integer_typep)&&
(tp->form != ENUM_FORM ))
{
expr_tp = Integer_typep; // default type
compile_error(M_INVALID, M_TYPE, M_0);
}
if_code_get_token_else_error(R_PAREN);
if (tp == Integer_typep)
{
// put delta on top of stack
expr_tp = Integer_typep;
emit_push_imm_integer(+1L);
switch (code)
{
case PRED:
emit_operator(ISUB, NO_CODE, 0, 0);
break;
case SUCC:
emit_operator(IADD, NO_CODE, 0, 0);
break;
default:
assert(0);
break;
}
}
else if (tp->form == ENUM_FORM)
{
// put max on top of stack
expr_tp = tp;
emit_push_imm_index(tp->enumeration.max);
switch (code)
{
case PRED:
emit_operator(CALL_stnd, SF_PRED, 0, 0);
break;
case SUCC:
emit_operator(CALL_stnd, SF_SUCC, 0, 0);
break;
default:
assert(0);
break;
}
}
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return expr_tp;
}
/*
* "rand_func" processes a call to:
*
* rand : real
*
* returns: Real_typep
*/
TYPE_STRUCT_PTR rand_func()
{
get_token(); // after <function>
emit_operator(CALL_stnd, SF_RAND, 0, 0);
return Real_typep;
}
/*
* "randint_func" processes a call to:
*
* randint(low, high : int) : int
*
* returns: Integer_typep
*/
TYPE_STRUCT_PTR randint_func()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_RANDINT, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Integer_typep;
}
/*
* "randomize_proc" processes a call to:
*
* randomize
*
* returns: Null_typep
*/
TYPE_STRUCT_PTR randomize_proc()
{
get_token(); // after <function>
emit_operator(CALL_stnd, SP_RANDOMIZE, 0, 0);
return Null_typep;
}
/*
* "randseed_proc" processes a call to:
*
* randseed(new_seed : int)
*
* returns: Null_typep
*/
TYPE_STRUCT_PTR randseed_proc()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SP_RANDSEED, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Null_typep;
}
/*
* "realstr_func" processes a call to:
*
* realstr(r: real,
* stringWidth : int) : string
*
* returns: String_typep
*/
TYPE_STRUCT_PTR realstr_func()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_number_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_REALSTR, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return String_typep;
}
/*
* "repeat_func" processes a call to:
*
* repeat(s:string, i:int): string
*
* returns: String_typep
*/
TYPE_STRUCT_PTR repeat_func()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
string_expression(); // and get next token
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_REPEAT, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return String_typep;
}
/*
* "setexp_func" processes a call to
*
* setexp(r : real, e : int) : real
*
* returns: Real_typep
*/
TYPE_STRUCT_PTR setexp_func()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_number_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SF_SETEXP, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Real_typep;
}
/*
* "string_into_number" processes a call to one of:
*
* strint( s : string) : int
* strreal(s : string) : real
*
* returns: a pointer to the function's result type
*/
TYPE_STRUCT_PTR string_into_number()
{
TYPE_STRUCT_PTR result_tp;
TOKEN_CODE code = Token.code; // of function
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
string_expression(); // and get next token
if_code_get_token_else_error(R_PAREN);
switch (code)
{
case STRINT:
result_tp = Integer_typep;
emit_operator(CALL_stnd, SF_STRINT, 0, 0);
break;
case STRREAL:
result_tp = Real_typep;
emit_operator(CALL_stnd, SF_STRREAL, 0, 0);
break;
default:
assert(0);
break;
}
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return result_tp;
}
/*
* "watch_proc" processes a call to:
*
* watch(expression)
*
* returns: Null_typep
*/
TYPE_STRUCT_PTR watch_proc()
{
int count;
SYMTAB_NODE_PTR idp;
TYPE_STRUCT_PTR tp;
get_token(); // after <function>
if ((Token.code == L_PAREN) && !Debug_flag)
{
// do not generate code when not in debug mode
count = 1;
while (count > 0)
{
get_token();
if (Token.code == L_PAREN)
count++;
else if (Token.code == R_PAREN)
count--;
}
get_token(); // after ")"
}
else if (Token.code == L_PAREN)
{
get_token(); // after "("
if (Token.code == ID_TOKEN) // get the output type
{
idp = search_symbol_tables(Token.lexeme);
if (idp == NULL)
{
compile_error(M_UNDEFINED, M_IDENTIFIER, M_0);
get_token(); // after <id>
}
else
{
if (idp->typep->form == STRING_FORM)
tp = string_expression();
else
tp = expression();
}
}
else if (token_in(String_type_list))
tp = string_expression(); // and get next token
else
tp = expression(); // and get next token
if_code_get_token_else_error(R_PAREN);
// now emit code
emit_push_imm_real(1.0); // width
if (tp == Null_typep) // source code error
emit_operator(NO_CODE, NO_CODE, 0, 0);
else if (tp == Real_typep)
emit_operator(CALL_stnd, SF_REALSTR, 0, 0);
else if (tp == Integer_typep)
emit_operator(CALL_stnd, SF_INTSTR, 0, 0);
else if (tp == Char_typep)
emit_operator(FORMAT_CHR, NO_CODE, 0, 0);
else if ((tp == Boolean_typep ) || (tp->form == ENUM_FORM))
emit_operator(FORMAT_INDEX, NO_CODE, 0, 0);
else if (tp->form == STRING_FORM)
emit_operator(FORMAT_STR, NO_CODE, 0, 0);
else
compile_error(M_INVALID, M_TYPE, M_0);
emit_operator(CALL_stnd, SP_WATCH, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Null_typep;
}
/*
* "putch_proc" processes a call to:
*
* putch(ch : char, foreground : int, background : int)
*
* black = 0
* blue = 1
* green = 2
* cyan = 3
* red = 4
* magenta = 5
* brown = 6
* light_gray = 7
* dark_gray = 8
* light_blue = 9
* light_green = 10
* light_cyan = 11
* light_red = 12
* light_magenta = 13
* yellow = 14
* white = 15
* blink = 128
*
* returns: Null_typep
*/
TYPE_STRUCT_PTR putch_proc()
{
TYPE_STRUCT_PTR tp;
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
tp = expression(); // and get next token
if (tp != Char_typep)
compile_error(M_INVALID, M_TYPE, M_0);
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SP_PUTCH, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Null_typep;
}
/*
* "putstr_proc" processes a call to:
*
* putstr(str : string, foreground : int, background : int)
*
* returns: Null_typep
*/
TYPE_STRUCT_PTR putstr_proc()
{
TYPE_STRUCT_PTR tp;
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
tp = string_expression(); // and get next token
if (tp->form != STRING_FORM)
compile_error(M_INVALID, M_TYPE, M_0);
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SP_PUTSTR, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Null_typep;
}
/*
* "cursor_proc" processes a call to:
*
* cursor(type : int)
*
* no cursor - 0
* normal cursor - 1
* solid cursor - 2
*
* returns: Null_typep
*/
TYPE_STRUCT_PTR cursor_proc()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SP_CURSOR, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Null_typep;
}
/*
* "locate_proc" processes a call to:
*
* locate(row, column : int)
*
* row : 0...24
* column : 0...79
*
* origin is at upper left of text screen
*
* returns: Null_typep
*/
TYPE_STRUCT_PTR locate_proc()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SP_LOCATE, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Null_typep;
}
/*
* "scroll_proc" processes a call to:
*
* scroll(top : int, bottom : int,
* left : int, right : int,
* foreground : int, background : int,
* rows_to_scroll : int)
*
* top, bottom, left, right : region on text screen to scroll
* foreground : new text foreground color
* background : new text background color
* rows_to_scroll : +val is up, -val is down, 0 for all
*
* returns: Null_typep
*/
TYPE_STRUCT_PTR scroll_proc()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SP_SCROLL, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Null_typep;
}
/*
* "setvideo_proc" processes a call to:
*
* setvideo(mode : int)
*
* which sets the video mode for text or graphics:
*
* mode lines type adapters max pages
*
* 0 40x25 B&W text CGA, EGA, VGA 8
* 1 40x25 color text CGA, EGA, VGA 8
* 2 80x25 B&W text CGA, EGA, VGA 8, 4(CGA)
* 3 80x25 color text CGA, EGA, VGA 8, 4(CGA)
* 4 320x200 4 colors CGA, EGA, VGA 1
* 5 320x200 B&W CGA, EGA, VGA 1
* 6 640x200 2 colors CGA, EGA, VGA 1
* 7 80x25 monochrome MDA, EGA, VGA 8, 1(MDA)
* 8 160x200 16 colors PCjr 1
* 9 320x200 16 colors PCjr 1
* 10 640x200 1 color PCjr 1
* 11 reserved
* 12 reserved
* 13 320x200 16 colors EGA, VGA 8
* 14 640x200 16 colors EGA, VGA 4
* 15 640x350 monochrome EGA, VGA 2
* 16 640x350 16 colors EGA, VGA 2
* 17 640x480 2 colors VGA 1
* 18 640x480 16 colors VGA 1
* 19 320x200 256 colors VGA 1
*
* returns: Null_typep
*/
TYPE_STRUCT_PTR setvideo_proc()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SP_SETVIDEO, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Null_typep;
}
/*
* "video_func" processes a function call to either:
*
* videomode : int
* videotype : int
*
* "videomode" returns the current video mode (see setvideo)
* "videotype" returns the video equipment type of the system:
*
* 0 - no display
* 1 - MDA
* 2 - CGA
* 4 - EGA with standard color display
* 5 - EGA with monochrome display
* 6 - PGA (professional graphics adapter)
* 7 - VGA with analog monochrome display
* 8 - VGA with analog color display
*
* returns: Integer_typep
*/
TYPE_STRUCT_PTR video_func()
{
switch (Token.code)
{
case VIDEOMODE:
emit_operator(CALL_stnd, SF_VIDEOMODE, 0, 0);
break;
case VIDEOTYPE:
emit_operator(CALL_stnd, SF_VIDEOTYPE, 0, 0);
break;
default:
assert(0);
break;
}
get_token(); // after <function>
return Integer_typep;
}
/*
* "putpixel_proc" processes a call to:
*
* putpixel(x, y, color : int)
*
* which sets the graphics pixel at (x, y) to color
*
* returns: Null_typep
*/
TYPE_STRUCT_PTR putpixel_proc()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SP_PUTPIXEL, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Null_typep;
}
/*
* "putline_proc" processes a call to:
*
* putline(x1, y1, x2, y2, color)
*
* which draws a line on the graphics screen from
* (x1, y1) to (x2, y2) in a selected color
*
* returns: Null_typep
*/
TYPE_STRUCT_PTR putline_proc()
{
get_token(); // after <function>
if (Token.code == L_PAREN)
{
get_token(); // after "("
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(COMMA);
get_integer_expression();
if_code_get_token_else_error(R_PAREN);
emit_operator(CALL_stnd, SP_PUTLINE, 0, 0);
}
else
compile_error(M_MISSING, M_LPAREN, M_0);
return Null_typep;
}
| home
| contents
| previous
| next page
| send comment
| send link
| add bookmark |
Copyright © 2004, Stephen R. Schmitt