yylex()
{
int c;
c = s_yylex(allowcom);
printt1( "Token %d\n", c );
return c;
}
/* setup pg_out window to get ready to run */
prep_to_run()
{
#ifdef HAS_INTERP
if( work_debug(curr_workspace) & DBF_ON ) {
change_pg_out(work_owindow(curr_workspace));
printt1( "Setting program output to window %x\n", pg_out );
}
else {
change_pg_out(curWindows[MAINWIN]);
werase( pg_out );
wmove( pg_out, 0, 0);
printt0( "Using main win for program output\n" );
wrefresh( pg_out );
}
scrollok( pg_out, TRUE );
curOff( pg_out );
#endif HAS_INTERP
}
init_ws()
{
#ifndef GEM
extern alice_window main_win;
curr_window = &main_win;
#endif
curr_workspace = ws_list = Tptr(main_ws);
#ifndef GEM
main_win.wspace = curr_workspace;
#endif
linkup( curr_workspace, 0, make_stub( C_ROOT ) );
work_name(curr_workspace) = "main";
work_debug( curr_workspace ) = 0;
#ifdef GEM
do_gdupdate();
#endif
printt1( "Initialize workspaces - main_ws is %x\n", Tptr(main_ws) );
/* an init_pwork will be done later if we decide to clip */
}
int
s_yylex()
{
register c;
register char *cp;
int f;
char delim;
if (yylineno == 0)
incrlineno();
while(1) {
/*
* skip white space
*/
if (c = lookaheadchar ) {
lookaheadchar = 0;
}
else
c = readkey();
cp = yytext;
while (c == ' ' || c == '\t' || c == 0 || c == 12 /* FF */) {
c = readkey();
}
yytext[0] = c; yytext[1] = yytext[2] = 0;
if( isascii(c) && (isalpha( c ) || c == '_') ) {
do {
*cp++ = c;
c = readkey();
} while (isascii(c) && (isalnum(c) || c == '_'));
*cp = 0;
lookaheadchar = c;
c = look_kw(yytext);
clearla();
if (c == 0) {
yylval.strval = allocstring(yytext);
return (YID);
}
return c;
}
else if( isascii(c) && isdigit(c) ) {
f = 0;
do {
*cp++ = c;
c = readkey();
} while (isascii(c) && isdigit(c));
if (c == '.') {
c = readkey();
if (c == '.') {
*cp = 0;
lookaheadchar = YDOTDOT;
yylval.strval = allocstring(yytext);
return (YINT);
}
infpnumb:
f++;
*cp++ = '.';
if (!isascii(c) || !isdigit(c)) {
scanerror("syntax error: digits required after decimal point");
*cp++ = '0';
} else
while (isdigit(c)) {
*cp++ = c;
c = readkey();
}
}
if (c == 'e' || c == 'E') {
f++;
*cp++ = c;
if ((c = lookaheadchar) == 0)
c = readkey();
if (c == '+' || c == '-') {
*cp++ = c;
c = readkey();
}
if (!isascii(c) || !isdigit(c)) {
scanerror("syntax error: digits required in exponent");
*cp++ = '0';
} else
while (isascii(c) && isdigit(c)) {
*cp++ = c;
c = readkey();
}
}
*cp = 0;
lookaheadchar = c;
clearla();
yylval.strval = allocstring(yytext);
if (f)
return (YNUMB);
return (YINT);
}
printt2("Select on char %d - %c\n", c, c );
switch (c) {
case EOF:
return 0;
case ' ':
case '\t':
case 12: /* form feed */
break;
case '"':
case '\'':
*cp++ = delim = c;
do {
do {
c = readkey();
if (c == '\n' || c == EOFCHAR) {
scanerror("syntax error: unmatched quote for string" );
if (cp == yytext)
*cp++ = ' ', cp++;
return YILLCH;
}
*cp++ = c;
} while (c != delim);
c = readkey();
} while (c == delim);
if( c == '^' || c== '#' ) {
par_error( "Can't imbed ^A or #nnn codes in strings. Try concatenating strings together\n" );
}
*--cp = 0;
#ifndef TURBO
if (cp == yytext && delim == '\'') {
scanerror("syntax error: null string not allowed");
*cp++ = ' ';
*cp++ = 0;
}
#endif
lookaheadchar = c;
clearla();
/* len of 2 means 1 char and 1 quote char */
if (delim == '"' || strlen(yytext) != 2) {
yylval.strval = allocstring(yytext);
return (YSTRING);
}
else {
yylval.intval = yytext[1];
return (YCHAR);
}
case '.':
c = readkey();
if (c == '.')
return (YDOTDOT);
if (isdigit(c)) {
scanerror("syntax error: digits required before decimal point");
*cp++ = '0';
goto infpnumb;
}
lookaheadchar = c;
clearla();
return '.';
case '\n':
break;
case '{': /* { ... } comment */
delim = '{';
comment:
c = readkey();
#ifdef TURBO
if (c == '$' && turbo_flag) {
f = scanturbo();
if (f >= 0)
return f;
}
else
#endif
if (c == '+') {
/* Stubs generated by alist, we know they use {} */
f = scanstub();
if (f == YC_BLCOMMENT) {
/* Kludge - throw away to keep grammar LALR.
* Doesn't matter since they will be generated
* in all appropriate places anyway.
*/
continue; /* outer while loop */
}
if (f >= 0)
return f;
}
else {
for (;;) {
if (delim=='{' && c == '}') {
break;
}
if (c == '\n') {
/* Break into one line pieces */
*cp++ = 0;
savecomment(yytext);
cp = yytext;
*cp = 0;
} else {
*cp++ = c;
if (c <= 0) {
/* nonterminated comment */
/* This "can't happen" */
fatal("Bug - nonterm comment");
}
}
c = readkey();
if (delim=='(' && c == ')' && cp[-1] == '*') {
*--cp = 0;
break;
}
}
*cp++ = 0;
}
/*
* Comments generated by the lister for procedure or
* function calls (in parens, ending in =) are ignored.
*/
if (parendepth <= 0 || cp[-2] != '=')
savecomment(yytext);
clearla();
cp = yytext;
*cp = 0;
if (allowcom)
return 0;
break;
case ':':
if ((c=readkey()) == '=') {
*++cp = c;
return YCOLEQUALS;
}
lookaheadchar = c;
clearla();
return ':';
case '(':
if ((c=readkey()) == '*') {
delim = '(';
goto comment;
}
lookaheadchar = c;
clearla();
parendepth++;
return '(';
case ')':
parendepth--;
return ')';
case '$':
while( isxdigit(c = readkey()) )
*++cp = c;
*++cp = 0;
lookaheadchar = c;
if( strlen(yytext) <= 1 )
return YILLCH;
yylval.strval = allocstring(yytext);
return YINT;
case '#':
c = readkey();
if( c == '$' ) {
unsigned hxnum;
while( isxdigit(c = readkey()) )
hxnum = (hxnum << 4) + ((c > '9') ? 9 : 0)
+ (c & 0xf);
lookaheadchar = c;
yylval.intval = hxnum;
return YCHAR;
}
else while (isdigit(c)) {
*++cp = c;
c = readkey();
}
*++cp = 0;
lookaheadchar = c;
yylval.intval = atoi(&yytext[1]);
return YCHAR;
case '^':
c = readkey();
if (strchr("\\_", c)) { /* others include []@^ */
yylval.intval = c & 0x1f;
return YCHAR;
}
else {
lookaheadchar = c;
yylval.intval = '^';
return YPTR;
}
case '@':
yylval.intval = '@';
return YPTR;
case ';':
case ',':
case '=':
case '*':
case '+':
case '/':
case '-':
case '[':
case ']':
case '<':
case '>':
case '_':
case '\\':
case '}': /* for DO..SET */
return c;
case YDOTDOT:
return YDOTDOT;
default:
if (c <= 0)
return (0);
do
lookaheadchar = readkey();
while (lookaheadchar == c);
clearla();
printt1("illegal char in scanner %o\n", c);
return (YILLCH);
}
} /* big while */
}
int mainloop()
{
unsigned cmd;
nodep myLine;
extern int phys_pcode;
extern int row, scol, ecol;
int curserr;
for (;;) {
here(1);
checkfar(1);
printt5("mainloop, cursor %x, ocursor %x, srch_row %d, srch_real %d, look.=%x\n",
cursor, ocursor, srch_row, srch_real, lookaheadchar);
hist_mark();
printt0("back from hist_mark()\n");
if (lookaheadchar == AL_NOP || lookaheadchar == ' ')
lookaheadchar = 0;
/*
* Redisplay unconditionally, not just when there's no
* typeahead, because often there is typeahead of the
* terminating character, like comma or right paren.
* Ideally the redisplay should be done only if dirty
* from the keyboard driver when we are ready for real
* input.
*/
newrange(FALSE);
display(FALSE);
/*
* ocursor is set by arrow keys to indicate that that's
* where the arrow keys left the cursor. Only if it
* was set (possibly in them middle of a token) and
* hasn't moved since do we want to leave it alone.
*/
here(2);
checkfar(2);
if (cursor != ocursor) {
/* don't do if moves are in type-ahead */
find_phys_cursor( curr_window, cursor,anywflag);
anywflag = FALSE;
phys_pcode = kcget( -1, cursor );
flusht();
}
here(3);
ocursor = NIL;
CheckAt = NIL;
CodeChanged = FALSE;
if( autsave && ascount++ > autsave ) {
ascount = 0;
if( work_fname( curr_workspace ) ) {
save(0);
statusLine();
}
else
warning( ER(220,"autosave`Automatic Save is engaged but there is no file name.") );
}
here(4);
cmd = topcmd( srch_row, srch_real, srch_real+srch_width, cursnode );
printt2("mainloop: topcmd returns %s (%d)\n", tokname(cmd), cmd);
mark_line( cursor, SMALL_CHANGE );
do_command(cmd);
here(5);
checkfar(3);
/* never leave the cursor on a list or below hide */
cursor = hidebound(realcp( cursor ));
mark_line( cursor, SMALL_CHANGE );
curserr = node_flag(cursor) & NF_ERROR;
if( curserr && !WhereDeclsChanged )
{
NodeNum cltype = ntype( t_up_to_line(cursor));
if( ntype_info(cltype) & F_DECLARE||highType( cltype ) )
{
WhereDeclsChanged = my_block(cursor);
printt1("mainloop: WhereDeclsChanged=%x\n",
WhereDeclsChanged);
}
}
/*
* Whenever a graft, etc takes place we check to see
* if changes are being made to a declaration. If they
* are then we set WhereDeclsChanged. If it has been
* set when we get back here we recompile its declaration
* block.
*/
if (CheckSpeed && WhereDeclsChanged &&
(CheckSpeed >= 4 || CodeChanged ||
WhereDeclsChanged != OldDeclsChanged) )
{
if( CheckSpeed < 4 && WhereDeclsChanged != OldDeclsChanged )
{
nodep decswap;
decswap = OldDeclsChanged;
OldDeclsChanged = WhereDeclsChanged;
WhereDeclsChanged = decswap;
printt1("mainloop: WhereDeclsChanged=%x (2)\n",
WhereDeclsChanged);
}
if( WhereDeclsChanged )
{
clr_node_flag(WhereDeclsChanged, NF_TCHECKED);
here(4);
checkfar(4);
c_comp_decls(my_scope(WhereDeclsChanged),
WhereDeclsChanged,
CheckSpeed < 6 ? TC_NOSTUBS :
(TC_DESCEND | TC_FULL) );
here(5);
checkfar(5);
WhereDeclsChanged = NIL;
}
}
/*
* Typecheck the current line. This was added late in the
* game, and isn't really the best way of doing things.
* Every time we return from a command, we typecheck
* the current line (or if CheckAt has already been set
* by a skip down routine, we typecheck there). We
* don't typecheck declarations.
*/
printt2("CheckAt=%x, cursor=%x\n", CheckAt, cursor);
if (!CheckAt && (curserr||is_undid(cursor))) CheckAt = cursor;
if( CheckAt && CheckSpeed )
{
myLine = t_up_to_line(CheckAt);
if (!( highType(ntype(myLine)) ||
(ntype_info(ntype(myLine)) & F_DECLARE)) )
{
printt2("mainloop: c_typecheck(%x, 0, %x)\n",
(int)myLine, TC_NOSTUBS|TC_ONERROR);
c_typecheck(myLine, 0, TC_NOSTUBS|TC_ONERROR );
here(6);
checkfar(6);
}
}
/* if code was changed, clear chance at resuming */
if( CodeChanged )
clear_resume();
#ifdef CHECKSUM
cscheck();
#endif
}
}