void ComRead( void )
{
char *cursor;
uint column;
char ch;
byte chtype;
uint stmt_type;
unsigned_32 stmt_no;
bool stno_found;
byte cont_type;
bool done_scan;
ftnoption save_options;
// Comment processor sets "Options" so that
// c$warn
// c$notime=5
// is diagnosed if /nowarn is specified
// "Options" must be saved so that we don't get an unreferenced warning
// message in the following case.
// c$noreference
// integer*4 sam
// c$reference
// end
save_options = Options;
stmt_type = STMT_COMMENT;
cont_type = 0;
cursor = 0;
column = FIRST_COL - 1;
stmt_no = 0;
stno_found = FALSE;
done_scan = FALSE;
for(;;) {
ReadSrc();
if( ProgSw & PS_SOURCE_EOF ) break;
if( CurrFile->flags & CONC_PENDING ) break;
// column starts off before current column
column = FIRST_COL - 1;
cursor = SrcBuff;
ch = *cursor;
if( ( ch != 'C' ) && ( ch != 'c' ) && ( ch != '*' ) ) {
if( ProgSw & PS_SKIP_SOURCE ) continue;
if( ( ch == 'D' ) || ( ch == 'd' ) ) {
if( !(ExtnSw & XS_D_IN_COLUMN_1) ) {
Extension( CC_D_IN_COLUMN_1 );
ExtnSw |= XS_D_IN_COLUMN_1;
}
if( !CompileDebugStmts() ) continue;
ch = ' ';
}
// not a comment (but it might be a blank line)
// try for a statement number
stmt_no = 0;
stno_found = FALSE;
for(;;) {
chtype = CharSetInfo.character_set[ (unsigned char)ch ];
if( chtype == C_EL ) break;
if( ( chtype == C_CM ) && ( column != CONT_COL - 1 ) ) {
if( ( ExtnSw & XS_EOL_COMMENT ) == 0 ) {
Extension( CC_EOL_COMMENT );
ExtnSw |= XS_EOL_COMMENT;
}
break;
}
if( chtype == C_SP ) {
++column;
} else if( chtype == C_TC ) {
column += 8 - column % 8;
} else if( CharSetInfo.is_double_byte_blank( cursor ) ) {
cursor++;
column += 2;
} else {
// a digit in the statement number field
++column;
if( ( chtype == C_DI ) && ( column != CONT_COL ) ) {
stmt_type = STMT_START;
if( column > CONT_COL ) {
done_scan = TRUE;
break;
}
stmt_no = 10 * stmt_no + ch - '0';
stno_found = TRUE;
} else {
stmt_type = STMT_START;
if( column != CONT_COL ) {
done_scan = TRUE;
break;
}
// its in the continuation column
if( ch != '0' ) {
// we have a genuine continuation line
// but save the type for later diagnosis
cont_type = chtype;
stmt_type = STMT_CONT;
// position to column 7
++column;
++cursor;
done_scan = TRUE;
break;
}
}
}
++cursor;
ch = *cursor;
if( column >= LastColumn ) {
// Consider: Column 73
// 1 |
// 0123 2001
*cursor = NULLCHAR;
break;
}
}
if( done_scan ) break;
if( stmt_type != STMT_COMMENT ) break;
}
Comment();
// quit if the comment simulates EOF (i.e. C$DATA)
if( ProgSw & PS_SOURCE_EOF ) break;
// quit if c$include encountered
if( CurrFile->flags & INC_PENDING ) break;
}
Cursor = cursor;
Column = column - 1;
NextStmtNo = stmt_no;
StmtNoFound = stno_found;
StmtType = stmt_type;
ContType = cont_type;
Options = save_options;
}
void Scan( void ) {
//==============
// Collect a token.
token_state state2;
byte ch;
token_state old_state;
char *dpt = NULL;
byte tab;
int len;
int hlen;
TOKCLASS class;
char_class ch_class;
char_class wasextch;
if( !(LexToken.flags & TK_LAST) ) {
wasextch = 0;
old_state = SNS;
LexToken.start = LexToken.stop;
LexToken.col = Column;
LexToken.line = Line;
for(;;) {
ch = *Cursor;
ch_class = CharSetInfo.character_set[ ch ];
wasextch |= ch_class;
state2 = StateTable[ State ][ ch_class & C_MASK ];
switch( state2 ) {
case SAN :
case SLG :
if( ch_class & C_LOW ) { // lower case character
ch += 'A' - 'a';
}
*TkCrsr = ch;
TkCrsr++;
State = state2;
break;
case SDB :
if( CharSetInfo.character_width( Cursor ) != 2 ) {
Error( CC_BAD_CHAR );
} else if( CharSetInfo.is_double_byte_blank( Cursor ) ) {
*Cursor = ' ';
*( Cursor + 1 ) = ' ';
Column--; // compensate for Column++ and Cursor++
Cursor--; // after select
} else {
State = StateTable[ State ][ C_AL ];
*TkCrsr = ch;
TkCrsr++;
Cursor++;
Column++;
*TkCrsr = *Cursor;
TkCrsr++;
}
break;
case SNM :
case SFT :
case SEN :
*TkCrsr = ch;
TkCrsr++;
State = state2;
break;
case SSG :
*TkCrsr = ch;
TkCrsr++;
// 0..71 is the statement area
// 72..79 is the sequence area
++Cursor;
if( ++Column >= LastColumn ) { // we've just processed column 72
*Cursor = NULLCHAR;
}
State = SOP;
class = TO_OPR;
goto token;
case SEX :
case SLX :
if( LexToken.flags & TK_LENSPEC ) {
LexToken.flags &= ~TK_LENSPEC;
goto token;
}
if( ch_class & C_LOW ) { // lower case character
ch += 'A' - 'a';
}
State = state2;
switch( ch ) {
case( 'Q' ):
class = TokenEXT;
break;
case( 'D' ):
class = TokenDBL;
break;
case( 'E' ):
class = TokenREA;
break;
}
*TkCrsr = ch;
TkCrsr++;
break;
case SML :
case SLL :
dpt = TkCrsr;
old_state = State;
*TkCrsr = ch;
TkCrsr++;
State = state2;
break;
case SFQ :
State = SIQ;
break;
case SIQ :
state2 = SIQ;
case SFM :
if( ch_class == C_TC ) {
tab = 8 - Column % 8;
// Column gets incremented normally at bottom of loop
Column += tab - 1;
memset( TkCrsr, ' ', tab );
TkCrsr += tab;
} else {
*TkCrsr = ch;
TkCrsr++;
}
State = state2;
break;
case SOL :
case SHX :
case SCS :
*TkCrsr = NULLCHAR; // for conversion routines
TkCrsr++;
case SAP :
State = state2;
break;
case SSO :
goto token;
case SOP :
*TkCrsr = ch;
TkCrsr++;
// 0..71 is the statement area
// 72..79 is the sequence area
++Cursor;
if( ++Column >= LastColumn ) { // we've just processed column 72
*Cursor = NULLCHAR;
}
State = SOP;
class = TO_OPR;
goto token;
case SFL :
if( old_state == SNS ) {
// Consider: i .eq. j
LkUpLog();
if( LexToken.log != BAD_LOG ) {
// if it's a valid logical operator,
// set final state to SFL
State = state2;
} else if( dpt == NULL ) {
dpt = LexToken.start;
}
} else {
// Consider: 1 .eq. 2
State = state2;
}
goto token;
case SHL :
if( LexToken.flags & TK_LENSPEC ) {
LexToken.flags &= ~TK_LENSPEC;
goto token;
}
*TkCrsr = NULLCHAR;
len = atoi( LexToken.start );
LexToken.start = TkCrsr;
State = SIH;
class = TO_LIT;
StmtSw |= SS_HOLLERITH;
break;
case SIH :
if( TkCrsr - LexToken.start >= len ) {
TkCrsr = LexToken.start + len; // in case of TABCHAR
State = SSO;
goto token;
}
if( ch_class == C_TC ) {
tab = 8 - Column % 8;
// Column gets incremented normally at bottom of loop
Column += tab - 1;
memset( TkCrsr, ' ', tab );
TkCrsr += tab;
} else {
*TkCrsr = ch;
TkCrsr++;
}
break;
case SSP :
if( State == SNS ) {
LexToken.col = Column;
}
break;
case STC :
// Column gets incremented normally at bottom of loop
Column += 7 - Column % 8;
break;
case SBC :
Error( CC_BAD_CHAR );
break;
case SCM :
if( !(ExtnSw & XS_EOL_COMMENT) ) {
Extension( CC_EOL_COMMENT );
ExtnSw |= XS_EOL_COMMENT;
}
case SNR :
if( LexToken.flags & TK_INCLUDE ) {
LexToken.flags |= TK_LAST;
goto token;
}
// 0..71 is the statement area
// 72..79 is the sequence area
// calculate the number of spaces
// that we may require for filling
tab = LastColumn - Column;
ComRead();
if( StmtType != STMT_CONT ) {
LexToken.flags |= TK_LAST;
goto token;
}
if( ( State == SIQ ) || ( State == SIH ) || ( State == SFM ) ) {
memset( TkCrsr, ' ', tab );
TkCrsr += tab;
}
++Line;
ComPrint();
ScanNum();
if( Line >= 20 ) {
if( !(ExtnSw & XS_CONT_20) ) {
Extension( CC_TOO_MANY_CONT );
ExtnSw |= XS_CONT_20;
}
if( (TkCrsr-TokenBuff) + (LastColumn-CONT_COL) > TOKLEN ) {
TkCrsr = TokenBuff; // so we don't overflow TokenBuff
if( !(StmtSw & SS_CONT_ERROR_ISSUED) ) {
Error( CC_CONT_OVERFLOW );
StmtSw |= SS_CONT_ERROR_ISSUED;
}
}
}
if( State == SNS ) {
LexToken.col = Column;
}
Column--; // to offset ++Cursor and ++Column in code
Cursor--; // after } (must be after ScanNum
break; // and Error since Error uses Column)
}
// 0..71 is the statement area
// 72..79 is the sequence area
++Cursor;
if( ++Column >= LastColumn ) { // we've just processed column 72
*Cursor = NULLCHAR;
}
}
token: LexToken.stop = TkCrsr;
state2 = State; // final state for Scan
State = SNS; // set to no state for next time
switch( state2 ) {
case SAN :
class = TO_NAM;
break;
case SNM :
class = TO_INT;
break;
case SFT :
class = TokenREA;
break;
case SOL :
class = TO_OCT;
break;
case SHX :
class = TO_HEX;
break;
case SCS :
case SAP :
class = TO_LIT;
break;
case SFL :
if( old_state == SNS ) {
LexToken.start++; // skip over starting dot
// 0..71 is the statement area
// 72..79 is the sequence area
++Cursor;
if( ++Column >= LastColumn ) { // just processed column 72
*Cursor = NULLCHAR;
}
class = TO_LGL;
} else {