int COMMAPI ComGetc(HCOMM hc)
{
DWORD dwBytesRead;
BYTE b;
if (!ComIsOnline(hc))
return -1;
return (ComRead(hc, &b, 1, &dwBytesRead) == 1) ? b : -1;
}
static bool CompSProg( void )
{
bool fini_subprog;
InitSubProg();
fini_subprog = FALSE;
for(;;) {
for(;;) {
if( CurrFile->flags & INC_PENDING ) {
CurrFile->flags &= ~INC_PENDING;
ProcInclude();
ComRead();
} else if( CurrFile->flags & CONC_PENDING ) {
if( ( ProgSw & PS_DONT_GENERATE ) &&
( ( Options & OPT_SYNTAX ) == 0 ) &&
( ( ProgSw & PS_ERROR ) == 0 ) &&
( CurrFile->link == NULL ) ) break;
Conclude();
if( CurrFile == NULL ) break;
ComRead();
} else {
break;
}
}
Options = NewOptions;
if( ProgSw & ( PS_SOURCE_EOF | PS_END_OF_SUBPROG ) ) break;
CompStatement();
if( ProgSw & ( PS_SOURCE_EOF | PS_END_OF_SUBPROG ) ) {
// consider: call sam
// end
// c$include sam
// Before we open 'sam', we must finish off the subprogram
// so we get the correct file name in the traceback.
FiniSubProg();
fini_subprog = TRUE;
}
if( TBreak() ) return( TRUE );
}
if( !fini_subprog ) {
FiniSubProg();
}
return( FALSE );
}
void InvokeCompile( void )
{
InitMacros();
ComRead(); // pre-read must occur here in case of null program
if( ProgSw & PS_SOURCE_EOF ) {
Conclude();
} else {
DoCompile();
}
FiniMacros();
}
void CpInclude(void) {
//===================
// Process INCLUDE statement.
// INCLUDE 'file-name'
char *lit;
StmtExtension( SP_STRUCTURED_EXT );
if( RecLiteral() ) {
lit = MkNodeStr( CITNode );
AdvanceITPtr();
if( ReqEOS() ) {
Include( lit );
ComRead();
}
FrNodeStr( lit );
} else {
Error( SX_EXPECT_CHAR_CONST );
}
}
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;
len = 0;
tab = 0;
class = 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 {
