#define TANGLE
#include "cpascal.h"
/* 9999 */
#define bufsize ( 3000 )
#define maxbytes ( 45000L )
#define maxtoks ( 60000L )
#define maxnames ( 6000 )
#define maxtexts ( 5000 )
#define hashsize ( 353 )
#define longestname ( 400 )
#define linelength ( 72 )
#define outbufsize ( 144 )
#define stacksize ( 100 )
#define maxidlength ( 50 )
#define unambiglength ( 32 )
typedef unsigned char ASCIIcode ;
typedef text /* of ASCIIcode */ textfile ;
typedef unsigned char eightbits ;
typedef unsigned short sixteenbits ;
typedef integer namepointer ;
typedef integer textpointer ;
typedef struct {
sixteenbits endfield ;
sixteenbits bytefield ;
namepointer namefield ;
textpointer replfield ;
short modfield ;
} outputstate ;
char history ;
ASCIIcode xord[256] ;
ASCIIcode xchr[256] ;
textfile webfile ;
textfile changefile ;
textfile Pascalfile ;
textfile pool ;
ASCIIcode buffer[bufsize + 1] ;
boolean phaseone ;
ASCIIcode bytemem[3][maxbytes + 1] ;
eightbits tokmem[4][maxtoks + 1] ;
sixteenbits bytestart[maxnames + 1] ;
sixteenbits tokstart[maxtexts + 1] ;
sixteenbits link[maxnames + 1] ;
sixteenbits ilk[maxnames + 1] ;
sixteenbits equiv[maxnames + 1] ;
sixteenbits textlink[maxtexts + 1] ;
namepointer nameptr ;
namepointer stringptr ;
integer byteptr[3] ;
integer poolchecksum ;
textpointer textptr ;
integer tokptr[4] ;
char z ;
integer idfirst ;
integer idloc ;
integer doublechars ;
sixteenbits hash[hashsize + 1], chophash[hashsize + 1] ;
ASCIIcode choppedid[unambiglength + 1] ;
ASCIIcode modtext[longestname + 1] ;
textpointer lastunnamed ;
outputstate curstate ;
outputstate stack[stacksize + 1] ;
integer stackptr ;
char zo ;
eightbits bracelevel ;
integer curval ;
ASCIIcode outbuf[outbufsize + 1] ;
integer outptr ;
integer breakptr ;
integer semiptr ;
eightbits outstate ;
integer outval, outapp ;
ASCIIcode outsign ;
schar lastsign ;
ASCIIcode outcontrib[linelength + 1] ;
integer ii ;
integer line ;
integer otherline ;
integer templine ;
integer limit ;
integer loc ;
boolean inputhasended ;
boolean changing ;
ASCIIcode changebuffer[bufsize + 1] ;
integer changelimit ;
namepointer curmodule ;
boolean scanninghex ;
eightbits nextcontrol ;
textpointer currepltext ;
short modulecount ;
cstring webname, chgname, pascalname, poolname ;
#include "tangle.h"
void
#ifdef HAVE_PROTOTYPES
error ( void )
#else
error ( )
#endif
{
integer j ;
integer k, l ;
if ( phaseone )
{
if ( changing )
Fputs( stdout , ". (change file " ) ;
else
Fputs( stdout , ". (" ) ;
fprintf( stdout , "%s%ld%c\n", "l." , (long)line , ')' ) ;
if ( loc >= limit )
l = limit ;
else l = loc ;
{register integer for_end; k = 1 ;for_end = l ; if ( k <= for_end) do
if ( buffer [k - 1 ]== 9 )
putc ( ' ' , stdout );
else
putc ( xchr [buffer [k - 1 ]], stdout );
while ( k++ < for_end ) ;}
putc ('\n', stdout );
{register integer for_end; k = 1 ;for_end = l ; if ( k <= for_end) do
putc ( ' ' , stdout );
while ( k++ < for_end ) ;}
{register integer for_end; k = l + 1 ;for_end = limit ; if ( k <=
for_end) do
putc ( xchr [buffer [k - 1 ]], stdout );
while ( k++ < for_end ) ;}
putc ( ' ' , stdout );
}
else {
fprintf( stdout , "%s%ld%c\n", ". (l." , (long)line , ')' ) ;
{register integer for_end; j = 1 ;for_end = outptr ; if ( j <= for_end)
do
putc ( xchr [outbuf [j - 1 ]], stdout );
while ( j++ < for_end ) ;}
Fputs( stdout , "... " ) ;
}
fflush ( stdout ) ;
history = 2 ;
}
void
#ifdef HAVE_PROTOTYPES
parsearguments ( void )
#else
parsearguments ( )
#endif
{
#define noptions ( 3 )
getoptstruct longoptions[noptions + 1] ;
integer getoptreturnval ;
cinttype optionindex ;
integer currentoption ;
currentoption = 0 ;
longoptions [currentoption ].name = "help" ;
longoptions [currentoption ].hasarg = 0 ;
longoptions [currentoption ].flag = 0 ;
longoptions [currentoption ].val = 0 ;
currentoption = currentoption + 1 ;
longoptions [currentoption ].name = "version" ;
longoptions [currentoption ].hasarg = 0 ;
longoptions [currentoption ].flag = 0 ;
longoptions [currentoption ].val = 0 ;
currentoption = currentoption + 1 ;
longoptions [currentoption ].name = 0 ;
longoptions [currentoption ].hasarg = 0 ;
longoptions [currentoption ].flag = 0 ;
longoptions [currentoption ].val = 0 ;
do {
getoptreturnval = getoptlongonly ( argc , argv , "" , longoptions ,
addressof ( optionindex ) ) ;
if ( getoptreturnval == -1 )
{
;
}
else if ( getoptreturnval == 63 )
{
usage ( 1 , "tangle" ) ;
}
else if ( ( strcmp ( longoptions [optionindex ].name , "help" ) == 0 ) )
{
usage ( 0 , TANGLEHELP ) ;
}
else if ( ( strcmp ( longoptions [optionindex ].name , "version" ) == 0
) )
{
printversionandexit ( "This is TANGLE, Version 4.3" , nil , "D.E. Knuth"
) ;
}
} while ( ! ( getoptreturnval == -1 ) ) ;
if ( ( optind + 1 != argc ) && ( optind + 2 != argc ) )
{
fprintf( stderr , "%s\n", "tangle: Need one or two file arguments." ) ;
usage ( 1 , "tangle" ) ;
}
webname = extendfilename ( cmdline ( optind ) , "web" ) ;
if ( optind + 2 == argc )
{
chgname = extendfilename ( cmdline ( optind + 1 ) , "ch" ) ;
}
pascalname = basenamechangesuffix ( webname , ".web" , ".p" ) ;
}
void
#ifdef HAVE_PROTOTYPES
initialize ( void )
#else
initialize ( )
#endif
{
unsigned char i ;
char wi ;
char zi ;
integer h ;
kpsesetprogname ( argv [0 ]) ;
parsearguments () ;
history = 0 ;
xchr [32 ]= ' ' ;
xchr [33 ]= '!' ;
xchr [34 ]= '"' ;
xchr [35 ]= '#' ;
xchr [36 ]= '$' ;
xchr [37 ]= '%' ;
xchr [38 ]= '&' ;
xchr [39 ]= '\'' ;
xchr [40 ]= '(' ;
xchr [41 ]= ')' ;
xchr [42 ]= '*' ;
xchr [43 ]= '+' ;
xchr [44 ]= ',' ;
xchr [45 ]= '-' ;
xchr [46 ]= '.' ;
xchr [47 ]= '/' ;
xchr [48 ]= '0' ;
xchr [49 ]= '1' ;
xchr [50 ]= '2' ;
xchr [51 ]= '3' ;
xchr [52 ]= '4' ;
xchr [53 ]= '5' ;
xchr [54 ]= '6' ;
xchr [55 ]= '7' ;
xchr [56 ]= '8' ;
xchr [57 ]= '9' ;
xchr [58 ]= ':' ;
xchr [59 ]= ';' ;
xchr [60 ]= '<' ;
xchr [61 ]= '=' ;
xchr [62 ]= '>' ;
xchr [63 ]= '?' ;
xchr [64 ]= '@' ;
xchr [65 ]= 'A' ;
xchr [66 ]= 'B' ;
xchr [67 ]= 'C' ;
xchr [68 ]= 'D' ;
xchr [69 ]= 'E' ;
xchr [70 ]= 'F' ;
xchr [71 ]= 'G' ;
xchr [72 ]= 'H' ;
xchr [73 ]= 'I' ;
xchr [74 ]= 'J' ;
xchr [75 ]= 'K' ;
xchr [76 ]= 'L' ;
xchr [77 ]= 'M' ;
xchr [78 ]= 'N' ;
xchr [79 ]= 'O' ;
xchr [80 ]= 'P' ;
xchr [81 ]= 'Q' ;
xchr [82 ]= 'R' ;
xchr [83 ]= 'S' ;
xchr [84 ]= 'T' ;
xchr [85 ]= 'U' ;
xchr [86 ]= 'V' ;
xchr [87 ]= 'W' ;
xchr [88 ]= 'X' ;
xchr [89 ]= 'Y' ;
xchr [90 ]= 'Z' ;
xchr [91 ]= '[' ;
xchr [92 ]= '\\' ;
xchr [93 ]= ']' ;
xchr [94 ]= '^' ;
xchr [95 ]= '_' ;
xchr [96 ]= '`' ;
xchr [97 ]= 'a' ;
xchr [98 ]= 'b' ;
xchr [99 ]= 'c' ;
xchr [100 ]= 'd' ;
xchr [101 ]= 'e' ;
xchr [102 ]= 'f' ;
xchr [103 ]= 'g' ;
xchr [104 ]= 'h' ;
xchr [105 ]= 'i' ;
xchr [106 ]= 'j' ;
xchr [107 ]= 'k' ;
xchr [108 ]= 'l' ;
xchr [109 ]= 'm' ;
xchr [110 ]= 'n' ;
xchr [111 ]= 'o' ;
xchr [112 ]= 'p' ;
xchr [113 ]= 'q' ;
xchr [114 ]= 'r' ;
xchr [115 ]= 's' ;
xchr [116 ]= 't' ;
xchr [117 ]= 'u' ;
xchr [118 ]= 'v' ;
xchr [119 ]= 'w' ;
xchr [120 ]= 'x' ;
xchr [121 ]= 'y' ;
xchr [122 ]= 'z' ;
xchr [123 ]= '{' ;
xchr [124 ]= '|' ;
xchr [125 ]= '}' ;
xchr [126 ]= '~' ;
xchr [0 ]= ' ' ;
xchr [127 ]= ' ' ;
{register integer for_end; i = 1 ;for_end = 31 ; if ( i <= for_end) do
xchr [i ]= chr ( i ) ;
while ( i++ < for_end ) ;}
{register integer for_end; i = 128 ;for_end = 255 ; if ( i <= for_end) do
xchr [i ]= chr ( i ) ;
while ( i++ < for_end ) ;}
{register integer for_end; i = 0 ;for_end = 255 ; if ( i <= for_end) do
xord [chr ( i ) ]= 32 ;
while ( i++ < for_end ) ;}
{register integer for_end; i = 1 ;for_end = 255 ; if ( i <= for_end) do
xord [xchr [i ]]= i ;
while ( i++ < for_end ) ;}
xord [' ' ]= 32 ;
rewrite ( Pascalfile , pascalname ) ;
{register integer for_end; wi = 0 ;for_end = 2 ; if ( wi <= for_end) do
{
bytestart [wi ]= 0 ;
byteptr [wi ]= 0 ;
}
while ( wi++ < for_end ) ;}
bytestart [3 ]= 0 ;
nameptr = 1 ;
stringptr = 256 ;
poolchecksum = 271828L ;
{register integer for_end; zi = 0 ;for_end = 3 ; if ( zi <= for_end) do
{
tokstart [zi ]= 0 ;
tokptr [zi ]= 0 ;
}
while ( zi++ < for_end ) ;}
tokstart [4 ]= 0 ;
textptr = 1 ;
z = 1 % 4 ;
ilk [0 ]= 0 ;
equiv [0 ]= 0 ;
{register integer for_end; h = 0 ;for_end = hashsize - 1 ; if ( h <=
for_end) do
{
hash [h ]= 0 ;
chophash [h ]= 0 ;
}
while ( h++ < for_end ) ;}
lastunnamed = 0 ;
textlink [0 ]= 0 ;
scanninghex = false ;
modtext [0 ]= 32 ;
}
void
#ifdef HAVE_PROTOTYPES
openinput ( void )
#else
openinput ( )
#endif
{
reset ( webfile , webname ) ;
if ( chgname )
reset ( changefile , chgname ) ;
}
boolean
#ifdef HAVE_PROTOTYPES
zinputln ( textfile f )
#else
zinputln ( f )
textfile f ;
#endif
{
register boolean Result; integer finallimit ;
limit = 0 ;
finallimit = 0 ;
if ( eof ( f ) )
Result = false ;
else {
while ( ! eoln ( f ) ) {
buffer [limit ]= xord [getc ( f ) ];
limit = limit + 1 ;
if ( buffer [limit - 1 ]!= 32 )
finallimit = limit ;
if ( limit == bufsize )
{
while ( ! eoln ( f ) ) vgetc ( f ) ;
limit = limit - 1 ;
if ( finallimit > limit )
finallimit = limit ;
{
putc ('\n', stdout );
Fputs( stdout , "! Input line too long" ) ;
}
loc = 0 ;
error () ;
}
}
readln ( f ) ;
limit = finallimit ;
Result = true ;
}
return Result ;
}
void
#ifdef HAVE_PROTOTYPES
zprintid ( namepointer p )
#else
zprintid ( p )
namepointer p ;
#endif
{
integer k ;
char w ;
if ( p >= nameptr )
Fputs( stdout , "IMPOSSIBLE" ) ;
else {
w = p % 3 ;
{register integer for_end; k = bytestart [p ];for_end = bytestart [p
+ 3 ]- 1 ; if ( k <= for_end) do
putc ( xchr [bytemem [w ][ k ]], stdout );
while ( k++ < for_end ) ;}
}
}
namepointer
#ifdef HAVE_PROTOTYPES
zidlookup ( eightbits t )
#else
zidlookup ( t )
eightbits t ;
#endif
{
/* 31 32 */ register namepointer Result; eightbits c ;
integer i ;
integer h ;
integer k ;
char w ;
integer l ;
namepointer p, q ;
integer s ;
l = idloc - idfirst ;
h = buffer [idfirst ];
i = idfirst + 1 ;
while ( i < idloc ) {
h = ( h + h + buffer [i ]) % hashsize ;
i = i + 1 ;
}
p = hash [h ];
while ( p != 0 ) {
if ( bytestart [p + 3 ]- bytestart [p ]== l )
{
i = idfirst ;
k = bytestart [p ];
w = p % 3 ;
while ( ( i < idloc ) && ( buffer [i ]== bytemem [w ][ k ]) ) {
i = i + 1 ;
k = k + 1 ;
}
if ( i == idloc )
goto lab31 ;
}
p = link [p ];
}
p = nameptr ;
link [p ]= hash [h ];
hash [h ]= p ;
lab31: ;
if ( ( p == nameptr ) || ( t != 0 ) )
{
if ( ( ( p != nameptr ) && ( t != 0 ) && ( ilk [p ]== 0 ) ) || ( ( p ==
nameptr ) && ( t == 0 ) && ( buffer [idfirst ]!= 34 ) ) )
{
i = idfirst ;
s = 0 ;
h = 0 ;
while ( ( i < idloc ) && ( s < unambiglength ) ) {
if ( buffer [i ]!= 95 )
{
choppedid [s ]= buffer [i ];
h = ( h + h + choppedid [s ]) % hashsize ;
s = s + 1 ;
}
i = i + 1 ;
}
choppedid [s ]= 0 ;
}
if ( p != nameptr )
{
if ( ilk [p ]== 0 )
{
if ( t == 1 )
{
putc ('\n', stdout );
Fputs( stdout , "! This identifier has already appeared" ) ;
error () ;
}
q = chophash [h ];
if ( q == p )
chophash [h ]= equiv [p ];
else {
while ( equiv [q ]!= p ) q = equiv [q ];
equiv [q ]= equiv [p ];
}
}
else {
putc ('\n', stdout );
Fputs( stdout , "! This identifier was defined before" ) ;
error () ;
}
ilk [p ]= t ;
}
else {
if ( ( t == 0 ) && ( buffer [idfirst ]!= 34 ) )
{
q = chophash [h ];
while ( q != 0 ) {
{
k = bytestart [q ];
s = 0 ;
w = q % 3 ;
while ( ( k < bytestart [q + 3 ]) && ( s < unambiglength ) ) {
c = bytemem [w ][ k ];
if ( c != 95 )
{
if ( choppedid [s ]!= c )
goto lab32 ;
s = s + 1 ;
}
k = k + 1 ;
}
if ( ( k == bytestart [q + 3 ]) && ( choppedid [s ]!= 0 ) )
goto lab32 ;
{
putc ('\n', stdout );
Fputs( stdout , "! Identifier conflict with " ) ;
}
{register integer for_end; k = bytestart [q ];for_end =
bytestart [q + 3 ]- 1 ; if ( k <= for_end) do
putc ( xchr [bytemem [w ][ k ]], stdout );
while ( k++ < for_end ) ;}
error () ;
q = 0 ;
lab32: ;
}
q = equiv [q ];
}
equiv [p ]= chophash [h ];
chophash [h ]= p ;
}
w = nameptr % 3 ;
k = byteptr [w ];
if ( k + l > maxbytes )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "byte memory" , " capacity exceeded" )
;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
if ( nameptr > maxnames - 3 )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "name" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
i = idfirst ;
while ( i < idloc ) {
bytemem [w ][ k ]= buffer [i ];
k = k + 1 ;
i = i + 1 ;
}
byteptr [w ]= k ;
bytestart [nameptr + 3 ]= k ;
nameptr = nameptr + 1 ;
if ( buffer [idfirst ]!= 34 )
ilk [p ]= t ;
else {
ilk [p ]= 1 ;
if ( l - doublechars == 2 )
equiv [p ]= buffer [idfirst + 1 ]+ 32768L ;
else {
if ( stringptr == 256 )
{
poolname = basenamechangesuffix ( webname , ".web" , ".pool" ) ;
rewrite ( pool , poolname ) ;
}
equiv [p ]= stringptr + 32768L ;
l = l - doublechars - 1 ;
if ( l > 99 )
{
putc ('\n', stdout );
Fputs( stdout , "! Preprocessed string is too long" ) ;
error () ;
}
stringptr = stringptr + 1 ;
fprintf( pool , "%c%c", xchr [48 + l / 10 ], xchr [48 + l % 10 ]) ;
poolchecksum = poolchecksum + poolchecksum + l ;
while ( poolchecksum > 536870839L ) poolchecksum = poolchecksum -
536870839L ;
i = idfirst + 1 ;
while ( i < idloc ) {
putc ( xchr [buffer [i ]], pool );
poolchecksum = poolchecksum + poolchecksum + buffer [i ];
while ( poolchecksum > 536870839L ) poolchecksum = poolchecksum -
536870839L ;
if ( ( buffer [i ]== 34 ) || ( buffer [i ]== 64 ) )
i = i + 2 ;
else i = i + 1 ;
}
putc ('\n', pool );
}
}
}
}
Result = p ;
return Result ;
}
namepointer
#ifdef HAVE_PROTOTYPES
zmodlookup ( sixteenbits l )
#else
zmodlookup ( l )
sixteenbits l ;
#endif
{
/* 31 */ register namepointer Result; char c ;
integer j ;
integer k ;
char w ;
namepointer p ;
namepointer q ;
c = 2 ;
q = 0 ;
p = ilk [0 ];
while ( p != 0 ) {
{
k = bytestart [p ];
w = p % 3 ;
c = 1 ;
j = 1 ;
while ( ( k < bytestart [p + 3 ]) && ( j <= l ) && ( modtext [j ]==
bytemem [w ][ k ]) ) {
k = k + 1 ;
j = j + 1 ;
}
if ( k == bytestart [p + 3 ])
if ( j > l )
c = 1 ;
else c = 4 ;
else if ( j > l )
c = 3 ;
else if ( modtext [j ]< bytemem [w ][ k ])
c = 0 ;
else c = 2 ;
}
q = p ;
if ( c == 0 )
p = link [q ];
else if ( c == 2 )
p = ilk [q ];
else goto lab31 ;
}
w = nameptr % 3 ;
k = byteptr [w ];
if ( k + l > maxbytes )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "byte memory" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
if ( nameptr > maxnames - 3 )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "name" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
p = nameptr ;
if ( c == 0 )
link [q ]= p ;
else ilk [q ]= p ;
link [p ]= 0 ;
ilk [p ]= 0 ;
c = 1 ;
equiv [p ]= 0 ;
{register integer for_end; j = 1 ;for_end = l ; if ( j <= for_end) do
bytemem [w ][ k + j - 1 ]= modtext [j ];
while ( j++ < for_end ) ;}
byteptr [w ]= k + l ;
bytestart [nameptr + 3 ]= k + l ;
nameptr = nameptr + 1 ;
lab31: if ( c != 1 )
{
{
putc ('\n', stdout );
Fputs( stdout , "! Incompatible section names" ) ;
error () ;
}
p = 0 ;
}
Result = p ;
return Result ;
}
namepointer
#ifdef HAVE_PROTOTYPES
zprefixlookup ( sixteenbits l )
#else
zprefixlookup ( l )
sixteenbits l ;
#endif
{
register namepointer Result; char c ;
integer count ;
integer j ;
integer k ;
char w ;
namepointer p ;
namepointer q ;
namepointer r ;
q = 0 ;
p = ilk [0 ];
count = 0 ;
r = 0 ;
while ( p != 0 ) {
{
k = bytestart [p ];
w = p % 3 ;
c = 1 ;
j = 1 ;
while ( ( k < bytestart [p + 3 ]) && ( j <= l ) && ( modtext [j ]==
bytemem [w ][ k ]) ) {
k = k + 1 ;
j = j + 1 ;
}
if ( k == bytestart [p + 3 ])
if ( j > l )
c = 1 ;
else c = 4 ;
else if ( j > l )
c = 3 ;
else if ( modtext [j ]< bytemem [w ][ k ])
c = 0 ;
else c = 2 ;
}
if ( c == 0 )
p = link [p ];
else if ( c == 2 )
p = ilk [p ];
else {
r = p ;
count = count + 1 ;
q = ilk [p ];
p = link [p ];
}
if ( p == 0 )
{
p = q ;
q = 0 ;
}
}
if ( count != 1 )
if ( count == 0 )
{
putc ('\n', stdout );
Fputs( stdout , "! Name does not match" ) ;
error () ;
}
else {
putc ('\n', stdout );
Fputs( stdout , "! Ambiguous prefix" ) ;
error () ;
}
Result = r ;
return Result ;
}
void
#ifdef HAVE_PROTOTYPES
zstoretwobytes ( sixteenbits x )
#else
zstoretwobytes ( x )
sixteenbits x ;
#endif
{
if ( tokptr [z ]+ 2 > maxtoks )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "token" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
tokmem [z ][ tokptr [z ]]= x / 256 ;
tokmem [z ][ tokptr [z ]+ 1 ]= x % 256 ;
tokptr [z ]= tokptr [z ]+ 2 ;
}
void
#ifdef HAVE_PROTOTYPES
zpushlevel ( namepointer p )
#else
zpushlevel ( p )
namepointer p ;
#endif
{
if ( stackptr == stacksize )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "stack" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
else {
stack [stackptr ]= curstate ;
stackptr = stackptr + 1 ;
curstate .namefield = p ;
curstate .replfield = equiv [p ];
zo = curstate .replfield % 4 ;
curstate .bytefield = tokstart [curstate .replfield ];
curstate .endfield = tokstart [curstate .replfield + 4 ];
curstate .modfield = 0 ;
}
}
void
#ifdef HAVE_PROTOTYPES
poplevel ( void )
#else
poplevel ( )
#endif
{
/* 10 */ if ( textlink [curstate .replfield ]== 0 )
{
if ( ilk [curstate .namefield ]== 3 )
{
nameptr = nameptr - 1 ;
textptr = textptr - 1 ;
z = textptr % 4 ;
tokptr [z ]= tokstart [textptr ];
}
}
else if ( textlink [curstate .replfield ]< maxtexts )
{
curstate .replfield = textlink [curstate .replfield ];
zo = curstate .replfield % 4 ;
curstate .bytefield = tokstart [curstate .replfield ];
curstate .endfield = tokstart [curstate .replfield + 4 ];
goto lab10 ;
}
stackptr = stackptr - 1 ;
if ( stackptr > 0 )
{
curstate = stack [stackptr ];
zo = curstate .replfield % 4 ;
}
lab10: ;
}
sixteenbits
#ifdef HAVE_PROTOTYPES
getoutput ( void )
#else
getoutput ( )
#endif
{
/* 20 30 31 */ register sixteenbits Result; sixteenbits a ;
eightbits b ;
sixteenbits bal ;
integer k ;
char w ;
lab20: if ( stackptr == 0 )
{
a = 0 ;
goto lab31 ;
}
if ( curstate .bytefield == curstate .endfield )
{
curval = - (integer) curstate .modfield ;
poplevel () ;
if ( curval == 0 )
goto lab20 ;
a = 129 ;
goto lab31 ;
}
a = tokmem [zo ][ curstate .bytefield ];
curstate .bytefield = curstate .bytefield + 1 ;
if ( a < 128 )
if ( a == 0 )
{
pushlevel ( nameptr - 1 ) ;
goto lab20 ;
}
else goto lab31 ;
a = ( a - 128 ) * 256 + tokmem [zo ][ curstate .bytefield ];
curstate .bytefield = curstate .bytefield + 1 ;
if ( a < 10240 )
{
switch ( ilk [a ])
{case 0 :
{
curval = a ;
a = 130 ;
}
break ;
case 1 :
{
curval = equiv [a ]- 32768L ;
a = 128 ;
}
break ;
case 2 :
{
pushlevel ( a ) ;
goto lab20 ;
}
break ;
case 3 :
{
while ( ( curstate .bytefield == curstate .endfield ) && ( stackptr >
0 ) ) poplevel () ;
if ( ( stackptr == 0 ) || ( tokmem [zo ][ curstate .bytefield ]!= 40
) )
{
{
putc ('\n', stdout );
Fputs( stdout , "! No parameter given for " ) ;
}
printid ( a ) ;
error () ;
goto lab20 ;
}
bal = 1 ;
curstate .bytefield = curstate .bytefield + 1 ;
while ( true ) {
b = tokmem [zo ][ curstate .bytefield ];
curstate .bytefield = curstate .bytefield + 1 ;
if ( b == 0 )
storetwobytes ( nameptr + 32767 ) ;
else {
if ( b >= 128 )
{
{
if ( tokptr [z ]== maxtoks )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "token" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
tokmem [z ][ tokptr [z ]]= b ;
tokptr [z ]= tokptr [z ]+ 1 ;
}
b = tokmem [zo ][ curstate .bytefield ];
curstate .bytefield = curstate .bytefield + 1 ;
}
else switch ( b )
{case 40 :
bal = bal + 1 ;
break ;
case 41 :
{
bal = bal - 1 ;
if ( bal == 0 )
goto lab30 ;
}
break ;
case 39 :
do {
{
if ( tokptr [z ]== maxtoks )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "token" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
tokmem [z ][ tokptr [z ]]= b ;
tokptr [z ]= tokptr [z ]+ 1 ;
}
b = tokmem [zo ][ curstate .bytefield ];
curstate .bytefield = curstate .bytefield + 1 ;
} while ( ! ( b == 39 ) ) ;
break ;
default:
;
break ;
}
{
if ( tokptr [z ]== maxtoks )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "token" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
tokmem [z ][ tokptr [z ]]= b ;
tokptr [z ]= tokptr [z ]+ 1 ;
}
}
}
lab30: ;
equiv [nameptr ]= textptr ;
ilk [nameptr ]= 2 ;
w = nameptr % 3 ;
k = byteptr [w ];
if ( nameptr > maxnames - 3 )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "name" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
bytestart [nameptr + 3 ]= k ;
nameptr = nameptr + 1 ;
if ( textptr > maxtexts - 4 )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "text" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
textlink [textptr ]= 0 ;
tokstart [textptr + 4 ]= tokptr [z ];
textptr = textptr + 1 ;
z = textptr % 4 ;
pushlevel ( a ) ;
goto lab20 ;
}
break ;
default:
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%c", "! This can't happen (" , "output" , ')' ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
break ;
}
goto lab31 ;
}
if ( a < 20480 )
{
a = a - 10240 ;
if ( equiv [a ]!= 0 )
pushlevel ( a ) ;
else if ( a != 0 )
{
{
putc ('\n', stdout );
Fputs( stdout , "! Not present: <" ) ;
}
printid ( a ) ;
putc ( '>' , stdout );
error () ;
}
goto lab20 ;
}
curval = a - 20480 ;
a = 129 ;
curstate .modfield = curval ;
lab31: Result = a ;
return Result ;
}
void
#ifdef HAVE_PROTOTYPES
flushbuffer ( void )
#else
flushbuffer ( )
#endif
{
integer k ;
integer b ;
b = breakptr ;
if ( ( semiptr != 0 ) && ( outptr - semiptr <= linelength ) )
breakptr = semiptr ;
{register integer for_end; k = 1 ;for_end = breakptr ; if ( k <= for_end)
do
putc ( xchr [outbuf [k - 1 ]], Pascalfile );
while ( k++ < for_end ) ;}
putc ('\n', Pascalfile );
line = line + 1 ;
if ( line % 100 == 0 )
{
putc ( '.' , stdout );
if ( line % 500 == 0 )
fprintf( stdout , "%ld", (long)line ) ;
fflush ( stdout ) ;
}
if ( breakptr < outptr )
{
if ( outbuf [breakptr ]== 32 )
{
breakptr = breakptr + 1 ;
if ( breakptr > b )
b = breakptr ;
}
{register integer for_end; k = breakptr ;for_end = outptr - 1 ; if ( k
<= for_end) do
outbuf [k - breakptr ]= outbuf [k ];
while ( k++ < for_end ) ;}
}
outptr = outptr - breakptr ;
breakptr = b - breakptr ;
semiptr = 0 ;
if ( outptr > linelength )
{
{
putc ('\n', stdout );
Fputs( stdout , "! Long line must be truncated" ) ;
error () ;
}
outptr = linelength ;
}
}
void
#ifdef HAVE_PROTOTYPES
zappval ( integer v )
#else
zappval ( v )
integer v ;
#endif
{
integer k ;
k = outbufsize ;
do {
outbuf [k ]= v % 10 ;
v = v / 10 ;
k = k - 1 ;
} while ( ! ( v == 0 ) ) ;
do {
k = k + 1 ;
{
outbuf [outptr ]= outbuf [k ]+ 48 ;
outptr = outptr + 1 ;
}
} while ( ! ( k == outbufsize ) ) ;
}
void
#ifdef HAVE_PROTOTYPES
zsendout ( eightbits t , sixteenbits v )
#else
zsendout ( t , v )
eightbits t ;
sixteenbits v ;
#endif
{
/* 20 */ integer k ;
lab20: switch ( outstate )
{case 1 :
if ( t != 3 )
{
breakptr = outptr ;
if ( t == 2 )
{
outbuf [outptr ]= 32 ;
outptr = outptr + 1 ;
}
}
break ;
case 2 :
{
{
outbuf [outptr ]= 44 - outapp ;
outptr = outptr + 1 ;
}
if ( outptr > linelength )
flushbuffer () ;
breakptr = outptr ;
}
break ;
case 3 :
case 4 :
{
if ( ( outval < 0 ) || ( ( outval == 0 ) && ( lastsign < 0 ) ) )
{
outbuf [outptr ]= 45 ;
outptr = outptr + 1 ;
}
else if ( outsign > 0 )
{
outbuf [outptr ]= outsign ;
outptr = outptr + 1 ;
}
appval ( abs ( outval ) ) ;
if ( outptr > linelength )
flushbuffer () ;
outstate = outstate - 2 ;
goto lab20 ;
}
break ;
case 5 :
{
if ( ( t == 3 ) || ( ( ( t == 2 ) && ( v == 3 ) && ( ( ( outcontrib [1
]== 68 ) && ( outcontrib [2 ]== 73 ) && ( outcontrib [3 ]== 86 ) )
|| ( ( outcontrib [1 ]== 100 ) && ( outcontrib [2 ]== 105 ) && (
outcontrib [3 ]== 118 ) ) || ( ( outcontrib [1 ]== 77 ) && (
outcontrib [2 ]== 79 ) && ( outcontrib [3 ]== 68 ) ) || ( (
outcontrib [1 ]== 109 ) && ( outcontrib [2 ]== 111 ) && ( outcontrib
[3 ]== 100 ) ) ) ) || ( ( t == 0 ) && ( ( v == 42 ) || ( v == 47 ) ) )
) )
{
if ( ( outval < 0 ) || ( ( outval == 0 ) && ( lastsign < 0 ) ) )
{
outbuf [outptr ]= 45 ;
outptr = outptr + 1 ;
}
else if ( outsign > 0 )
{
outbuf [outptr ]= outsign ;
outptr = outptr + 1 ;
}
appval ( abs ( outval ) ) ;
if ( outptr > linelength )
flushbuffer () ;
outsign = 43 ;
outval = outapp ;
}
else outval = outval + outapp ;
outstate = 3 ;
goto lab20 ;
}
break ;
case 0 :
if ( t != 3 )
breakptr = outptr ;
break ;
default:
;
break ;
}
if ( t != 0 )
{register integer for_end; k = 1 ;for_end = v ; if ( k <= for_end) do
{
outbuf [outptr ]= outcontrib [k ];
outptr = outptr + 1 ;
}
while ( k++ < for_end ) ;}
else {
outbuf [outptr ]= v ;
outptr = outptr + 1 ;
}
if ( outptr > linelength )
flushbuffer () ;
if ( ( t == 0 ) && ( ( v == 59 ) || ( v == 125 ) ) )
{
semiptr = outptr ;
breakptr = outptr ;
}
if ( t >= 2 )
outstate = 1 ;
else outstate = 0 ;
}
void
#ifdef HAVE_PROTOTYPES
zsendsign ( integer v )
#else
zsendsign ( v )
integer v ;
#endif
{
switch ( outstate )
{case 2 :
case 4 :
outapp = outapp * v ;
break ;
case 3 :
{
outapp = v ;
outstate = 4 ;
}
break ;
case 5 :
{
outval = outval + outapp ;
outapp = v ;
outstate = 4 ;
}
break ;
default:
{
breakptr = outptr ;
outapp = v ;
outstate = 2 ;
}
break ;
}
lastsign = outapp ;
}
void
#ifdef HAVE_PROTOTYPES
zsendval ( integer v )
#else
zsendval ( v )
integer v ;
#endif
{
/* 666 10 */ switch ( outstate )
{case 1 :
{
if ( ( outptr == breakptr + 3 ) || ( ( outptr == breakptr + 4 ) && (
outbuf [breakptr ]== 32 ) ) )
if ( ( ( outbuf [outptr - 3 ]== 68 ) && ( outbuf [outptr - 2 ]== 73
) && ( outbuf [outptr - 1 ]== 86 ) ) || ( ( outbuf [outptr - 3 ]==
100 ) && ( outbuf [outptr - 2 ]== 105 ) && ( outbuf [outptr - 1 ]==
118 ) ) || ( ( outbuf [outptr - 3 ]== 77 ) && ( outbuf [outptr - 2 ]
== 79 ) && ( outbuf [outptr - 1 ]== 68 ) ) || ( ( outbuf [outptr - 3
]== 109 ) && ( outbuf [outptr - 2 ]== 111 ) && ( outbuf [outptr - 1
]== 100 ) ) )
goto lab666 ;
outsign = 32 ;
outstate = 3 ;
outval = v ;
breakptr = outptr ;
lastsign = 1 ;
}
break ;
case 0 :
{
if ( ( outptr == breakptr + 1 ) && ( ( outbuf [breakptr ]== 42 ) || (
outbuf [breakptr ]== 47 ) ) )
goto lab666 ;
outsign = 0 ;
outstate = 3 ;
outval = v ;
breakptr = outptr ;
lastsign = 1 ;
}
break ;
case 2 :
{
outsign = 43 ;
outstate = 3 ;
outval = outapp * v ;
}
break ;
case 3 :
{
outstate = 5 ;
outapp = v ;
{
putc ('\n', stdout );
Fputs( stdout , "! Two numbers occurred without a sign between them" ) ;
error () ;
}
}
break ;
case 4 :
{
outstate = 5 ;
outapp = outapp * v ;
}
break ;
case 5 :
{
outval = outval + outapp ;
outapp = v ;
{
putc ('\n', stdout );
Fputs( stdout , "! Two numbers occurred without a sign between them" ) ;
error () ;
}
}
break ;
default:
goto lab666 ;
break ;
}
goto lab10 ;
lab666: if ( v >= 0 )
{
if ( outstate == 1 )
{
breakptr = outptr ;
{
outbuf [outptr ]= 32 ;
outptr = outptr + 1 ;
}
}
appval ( v ) ;
if ( outptr > linelength )
flushbuffer () ;
outstate = 1 ;
}
else {
{
outbuf [outptr ]= 40 ;
outptr = outptr + 1 ;
}
{
outbuf [outptr ]= 45 ;
outptr = outptr + 1 ;
}
appval ( - (integer) v ) ;
{
outbuf [outptr ]= 41 ;
outptr = outptr + 1 ;
}
if ( outptr > linelength )
flushbuffer () ;
outstate = 0 ;
}
lab10: ;
}
void
#ifdef HAVE_PROTOTYPES
sendtheoutput ( void )
#else
sendtheoutput ( )
#endif
{
/* 2 21 22 */ eightbits curchar ;
integer k ;
integer j ;
char w ;
integer n ;
while ( stackptr > 0 ) {
curchar = getoutput () ;
lab21: switch ( curchar )
{case 0 :
;
break ;
case 65 :
case 66 :
case 67 :
case 68 :
case 69 :
case 70 :
case 71 :
case 72 :
case 73 :
case 74 :
case 75 :
case 76 :
case 77 :
case 78 :
case 79 :
case 80 :
case 81 :
case 82 :
case 83 :
case 84 :
case 85 :
case 86 :
case 87 :
case 88 :
case 89 :
case 90 :
case 97 :
case 98 :
case 99 :
case 100 :
case 101 :
case 102 :
case 103 :
case 104 :
case 105 :
case 106 :
case 107 :
case 108 :
case 109 :
case 110 :
case 111 :
case 112 :
case 113 :
case 114 :
case 115 :
case 116 :
case 117 :
case 118 :
case 119 :
case 120 :
case 121 :
case 122 :
{
outcontrib [1 ]= curchar ;
sendout ( 2 , 1 ) ;
}
break ;
case 130 :
{
k = 0 ;
j = bytestart [curval ];
w = curval % 3 ;
while ( ( k < maxidlength ) && ( j < bytestart [curval + 3 ]) ) {
k = k + 1 ;
outcontrib [k ]= bytemem [w ][ j ];
j = j + 1 ;
if ( outcontrib [k ]== 95 )
k = k - 1 ;
}
sendout ( 2 , k ) ;
}
break ;
case 48 :
case 49 :
case 50 :
case 51 :
case 52 :
case 53 :
case 54 :
case 55 :
case 56 :
case 57 :
{
n = 0 ;
do {
curchar = curchar - 48 ;
if ( n >= 214748364L )
{
putc ('\n', stdout );
Fputs( stdout , "! Constant too big" ) ;
error () ;
}
else n = 10 * n + curchar ;
curchar = getoutput () ;
} while ( ! ( ( curchar > 57 ) || ( curchar < 48 ) ) ) ;
sendval ( n ) ;
k = 0 ;
if ( curchar == 101 )
curchar = 69 ;
if ( curchar == 69 )
goto lab2 ;
else goto lab21 ;
}
break ;
case 125 :
sendval ( poolchecksum ) ;
break ;
case 12 :
{
n = 0 ;
curchar = 48 ;
do {
curchar = curchar - 48 ;
if ( n >= 268435456L )
{
putc ('\n', stdout );
Fputs( stdout , "! Constant too big" ) ;
error () ;
}
else n = 8 * n + curchar ;
curchar = getoutput () ;
} while ( ! ( ( curchar > 55 ) || ( curchar < 48 ) ) ) ;
sendval ( n ) ;
goto lab21 ;
}
break ;
case 13 :
{
n = 0 ;
curchar = 48 ;
do {
if ( curchar >= 65 )
curchar = curchar - 55 ;
else curchar = curchar - 48 ;
if ( n >= 134217728L )
{
putc ('\n', stdout );
Fputs( stdout , "! Constant too big" ) ;
error () ;
}
else n = 16 * n + curchar ;
curchar = getoutput () ;
} while ( ! ( ( curchar > 70 ) || ( curchar < 48 ) || ( ( curchar > 57
) && ( curchar < 65 ) ) ) ) ;
sendval ( n ) ;
goto lab21 ;
}
break ;
case 128 :
sendval ( curval ) ;
break ;
case 46 :
{
k = 1 ;
outcontrib [1 ]= 46 ;
curchar = getoutput () ;
if ( curchar == 46 )
{
outcontrib [2 ]= 46 ;
sendout ( 1 , 2 ) ;
}
else if ( ( curchar >= 48 ) && ( curchar <= 57 ) )
goto lab2 ;
else {
sendout ( 0 , 46 ) ;
goto lab21 ;
}
}
break ;
case 43 :
case 45 :
sendsign ( 44 - curchar ) ;
break ;
case 4 :
{
outcontrib [1 ]= 97 ;
outcontrib [2 ]= 110 ;
outcontrib [3 ]= 100 ;
sendout ( 2 , 3 ) ;
}
break ;
case 5 :
{
outcontrib [1 ]= 110 ;
outcontrib [2 ]= 111 ;
outcontrib [3 ]= 116 ;
sendout ( 2 , 3 ) ;
}
break ;
case 6 :
{
outcontrib [1 ]= 105 ;
outcontrib [2 ]= 110 ;
sendout ( 2 , 2 ) ;
}
break ;
case 31 :
{
outcontrib [1 ]= 111 ;
outcontrib [2 ]= 114 ;
sendout ( 2 , 2 ) ;
}
break ;
case 24 :
{
outcontrib [1 ]= 58 ;
outcontrib [2 ]= 61 ;
sendout ( 1 , 2 ) ;
}
break ;
case 26 :
{
outcontrib [1 ]= 60 ;
outcontrib [2 ]= 62 ;
sendout ( 1 , 2 ) ;
}
break ;
case 28 :
{
outcontrib [1 ]= 60 ;
outcontrib [2 ]= 61 ;
sendout ( 1 , 2 ) ;
}
break ;
case 29 :
{
outcontrib [1 ]= 62 ;
outcontrib [2 ]= 61 ;
sendout ( 1 , 2 ) ;
}
break ;
case 30 :
{
outcontrib [1 ]= 61 ;
outcontrib [2 ]= 61 ;
sendout ( 1 , 2 ) ;
}
break ;
case 32 :
{
outcontrib [1 ]= 46 ;
outcontrib [2 ]= 46 ;
sendout ( 1 , 2 ) ;
}
break ;
case 39 :
{
k = 1 ;
outcontrib [1 ]= 39 ;
do {
if ( k < linelength )
k = k + 1 ;
outcontrib [k ]= getoutput () ;
} while ( ! ( ( outcontrib [k ]== 39 ) || ( stackptr == 0 ) ) ) ;
if ( k == linelength )
{
putc ('\n', stdout );
Fputs( stdout , "! String too long" ) ;
error () ;
}
sendout ( 1 , k ) ;
curchar = getoutput () ;
if ( curchar == 39 )
outstate = 6 ;
goto lab21 ;
}
break ;
case 33 :
case 34 :
case 35 :
case 36 :
case 37 :
case 38 :
case 40 :
case 41 :
case 42 :
case 44 :
case 47 :
case 58 :
case 59 :
case 60 :
case 61 :
case 62 :
case 63 :
case 64 :
case 91 :
case 92 :
case 93 :
case 94 :
case 95 :
case 96 :
case 123 :
case 124 :
sendout ( 0 , curchar ) ;
break ;
case 9 :
{
if ( bracelevel == 0 )
sendout ( 0 , 123 ) ;
else sendout ( 0 , 91 ) ;
bracelevel = bracelevel + 1 ;
}
break ;
case 10 :
if ( bracelevel > 0 )
{
bracelevel = bracelevel - 1 ;
if ( bracelevel == 0 )
sendout ( 0 , 125 ) ;
else sendout ( 0 , 93 ) ;
}
else {
putc ('\n', stdout );
Fputs( stdout , "! Extra @}" ) ;
error () ;
}
break ;
case 129 :
{
if ( bracelevel == 0 )
sendout ( 0 , 123 ) ;
else sendout ( 0 , 91 ) ;
if ( curval < 0 )
{
sendout ( 0 , 58 ) ;
sendval ( - (integer) curval ) ;
}
else {
sendval ( curval ) ;
sendout ( 0 , 58 ) ;
}
if ( bracelevel == 0 )
sendout ( 0 , 125 ) ;
else sendout ( 0 , 93 ) ;
}
break ;
case 127 :
{
sendout ( 3 , 0 ) ;
outstate = 6 ;
}
break ;
case 2 :
{
k = 0 ;
do {
if ( k < linelength )
k = k + 1 ;
outcontrib [k ]= getoutput () ;
} while ( ! ( ( outcontrib [k ]== 2 ) || ( stackptr == 0 ) ) ) ;
if ( k == linelength )
{
putc ('\n', stdout );
Fputs( stdout , "! Verbatim string too long" ) ;
error () ;
}
sendout ( 1 , k - 1 ) ;
}
break ;
case 3 :
{
sendout ( 1 , 0 ) ;
while ( outptr > 0 ) {
if ( outptr <= linelength )
breakptr = outptr ;
flushbuffer () ;
}
outstate = 0 ;
}
break ;
default:
{
putc ('\n', stdout );
fprintf( stdout , "%s%ld", "! Can't output ASCII code " , (long)curchar ) ;
error () ;
}
break ;
}
goto lab22 ;
lab2: do {
if ( k < linelength )
k = k + 1 ;
outcontrib [k ]= curchar ;
curchar = getoutput () ;
if ( ( outcontrib [k ]== 69 ) && ( ( curchar == 43 ) || ( curchar ==
45 ) ) )
{
if ( k < linelength )
k = k + 1 ;
outcontrib [k ]= curchar ;
curchar = getoutput () ;
}
else if ( curchar == 101 )
curchar = 69 ;
} while ( ! ( ( curchar != 69 ) && ( ( curchar < 48 ) || ( curchar > 57 )
) ) ) ;
if ( k == linelength )
{
putc ('\n', stdout );
Fputs( stdout , "! Fraction too long" ) ;
error () ;
}
sendout ( 3 , k ) ;
goto lab21 ;
lab22: ;
}
}
boolean
#ifdef HAVE_PROTOTYPES
linesdontmatch ( void )
#else
linesdontmatch ( )
#endif
{
/* 10 */ register boolean Result; integer k ;
Result = true ;
if ( changelimit != limit )
goto lab10 ;
if ( limit > 0 )
{register integer for_end; k = 0 ;for_end = limit - 1 ; if ( k <= for_end)
do
if ( changebuffer [k ]!= buffer [k ])
goto lab10 ;
while ( k++ < for_end ) ;}
Result = false ;
lab10: ;
return Result ;
}
void
#ifdef HAVE_PROTOTYPES
primethechangebuffer ( void )
#else
primethechangebuffer ( )
#endif
{
/* 22 30 10 */ integer k ;
changelimit = 0 ;
while ( true ) {
line = line + 1 ;
if ( ! inputln ( changefile ) )
goto lab10 ;
if ( limit < 2 )
goto lab22 ;
if ( buffer [0 ]!= 64 )
goto lab22 ;
if ( ( buffer [1 ]>= 88 ) && ( buffer [1 ]<= 90 ) )
buffer [1 ]= buffer [1 ]+ 32 ;
if ( buffer [1 ]== 120 )
goto lab30 ;
if ( ( buffer [1 ]== 121 ) || ( buffer [1 ]== 122 ) )
{
loc = 2 ;
{
putc ('\n', stdout );
Fputs( stdout , "! Where is the matching @x?" ) ;
error () ;
}
}
lab22: ;
}
lab30: ;
do {
line = line + 1 ;
if ( ! inputln ( changefile ) )
{
{
putc ('\n', stdout );
Fputs( stdout , "! Change file ended after @x" ) ;
error () ;
}
goto lab10 ;
}
} while ( ! ( limit > 0 ) ) ;
{
changelimit = limit ;
if ( limit > 0 )
{register integer for_end; k = 0 ;for_end = limit - 1 ; if ( k <=
for_end) do
changebuffer [k ]= buffer [k ];
while ( k++ < for_end ) ;}
}
lab10: ;
}
void
#ifdef HAVE_PROTOTYPES
checkchange ( void )
#else
checkchange ( )
#endif
{
/* 10 */ integer n ;
integer k ;
if ( linesdontmatch () )
goto lab10 ;
n = 0 ;
while ( true ) {
changing = ! changing ;
templine = otherline ;
otherline = line ;
line = templine ;
line = line + 1 ;
if ( ! inputln ( changefile ) )
{
{
putc ('\n', stdout );
Fputs( stdout , "! Change file ended before @y" ) ;
error () ;
}
changelimit = 0 ;
changing = ! changing ;
templine = otherline ;
otherline = line ;
line = templine ;
goto lab10 ;
}
if ( limit > 1 )
if ( buffer [0 ]== 64 )
{
if ( ( buffer [1 ]>= 88 ) && ( buffer [1 ]<= 90 ) )
buffer [1 ]= buffer [1 ]+ 32 ;
if ( ( buffer [1 ]== 120 ) || ( buffer [1 ]== 122 ) )
{
loc = 2 ;
{
putc ('\n', stdout );
Fputs( stdout , "! Where is the matching @y?" ) ;
error () ;
}
}
else if ( buffer [1 ]== 121 )
{
if ( n > 0 )
{
loc = 2 ;
{
putc ('\n', stdout );
fprintf( stdout , "%s%ld%s", "! Hmm... " , (long)n , " of the preceding lines failed to match" ) ;
error () ;
}
}
goto lab10 ;
}
}
{
changelimit = limit ;
if ( limit > 0 )
{register integer for_end; k = 0 ;for_end = limit - 1 ; if ( k <=
for_end) do
changebuffer [k ]= buffer [k ];
while ( k++ < for_end ) ;}
}
changing = ! changing ;
templine = otherline ;
otherline = line ;
line = templine ;
line = line + 1 ;
if ( ! inputln ( webfile ) )
{
{
putc ('\n', stdout );
Fputs( stdout , "! WEB file ended during a change" ) ;
error () ;
}
inputhasended = true ;
goto lab10 ;
}
if ( linesdontmatch () )
n = n + 1 ;
}
lab10: ;
}
void
#ifdef HAVE_PROTOTYPES
getline ( void )
#else
getline ( )
#endif
{
/* 20 */ lab20: if ( changing )
{
line = line + 1 ;
if ( ! inputln ( changefile ) )
{
{
putc ('\n', stdout );
Fputs( stdout , "! Change file ended without @z" ) ;
error () ;
}
buffer [0 ]= 64 ;
buffer [1 ]= 122 ;
limit = 2 ;
}
if ( limit > 1 )
if ( buffer [0 ]== 64 )
{
if ( ( buffer [1 ]>= 88 ) && ( buffer [1 ]<= 90 ) )
buffer [1 ]= buffer [1 ]+ 32 ;
if ( ( buffer [1 ]== 120 ) || ( buffer [1 ]== 121 ) )
{
loc = 2 ;
{
putc ('\n', stdout );
Fputs( stdout , "! Where is the matching @z?" ) ;
error () ;
}
}
else if ( buffer [1 ]== 122 )
{
primethechangebuffer () ;
changing = ! changing ;
templine = otherline ;
otherline = line ;
line = templine ;
}
}
}
if ( ! changing )
{
{
line = line + 1 ;
if ( ! inputln ( webfile ) )
inputhasended = true ;
else if ( limit == changelimit )
if ( buffer [0 ]== changebuffer [0 ])
if ( changelimit > 0 )
checkchange () ;
}
if ( changing )
goto lab20 ;
}
loc = 0 ;
buffer [limit ]= 32 ;
}
eightbits
#ifdef HAVE_PROTOTYPES
zcontrolcode ( ASCIIcode c )
#else
zcontrolcode ( c )
ASCIIcode c ;
#endif
{
register eightbits Result; switch ( c )
{case 64 :
Result = 64 ;
break ;
case 39 :
Result = 12 ;
break ;
case 34 :
Result = 13 ;
break ;
case 36 :
Result = 125 ;
break ;
case 32 :
case 9 :
Result = 136 ;
break ;
case 42 :
{
fprintf( stdout , "%c%ld", '*' , (long)modulecount + 1 ) ;
fflush ( stdout ) ;
Result = 136 ;
}
break ;
case 68 :
case 100 :
Result = 133 ;
break ;
case 70 :
case 102 :
Result = 132 ;
break ;
case 123 :
Result = 9 ;
break ;
case 125 :
Result = 10 ;
break ;
case 80 :
case 112 :
Result = 134 ;
break ;
case 84 :
case 116 :
case 94 :
case 46 :
case 58 :
Result = 131 ;
break ;
case 38 :
Result = 127 ;
break ;
case 60 :
Result = 135 ;
break ;
case 61 :
Result = 2 ;
break ;
case 92 :
Result = 3 ;
break ;
default:
Result = 0 ;
break ;
}
return Result ;
}
eightbits
#ifdef HAVE_PROTOTYPES
skipahead ( void )
#else
skipahead ( )
#endif
{
/* 30 */ register eightbits Result; eightbits c ;
while ( true ) {
if ( loc > limit )
{
getline () ;
if ( inputhasended )
{
c = 136 ;
goto lab30 ;
}
}
buffer [limit + 1 ]= 64 ;
while ( buffer [loc ]!= 64 ) loc = loc + 1 ;
if ( loc <= limit )
{
loc = loc + 2 ;
c = controlcode ( buffer [loc - 1 ]) ;
if ( ( c != 0 ) || ( buffer [loc - 1 ]== 62 ) )
goto lab30 ;
}
}
lab30: Result = c ;
return Result ;
}
void
#ifdef HAVE_PROTOTYPES
skipcomment ( void )
#else
skipcomment ( )
#endif
{
/* 10 */ eightbits bal ;
ASCIIcode c ;
bal = 0 ;
while ( true ) {
if ( loc > limit )
{
getline () ;
if ( inputhasended )
{
{
putc ('\n', stdout );
Fputs( stdout , "! Input ended in mid-comment" ) ;
error () ;
}
goto lab10 ;
}
}
c = buffer [loc ];
loc = loc + 1 ;
if ( c == 64 )
{
c = buffer [loc ];
if ( ( c != 32 ) && ( c != 9 ) && ( c != 42 ) && ( c != 122 ) && ( c !=
90 ) )
loc = loc + 1 ;
else {
{
putc ('\n', stdout );
Fputs( stdout , "! Section ended in mid-comment" ) ;
error () ;
}
loc = loc - 1 ;
goto lab10 ;
}
}
else if ( ( c == 92 ) && ( buffer [loc ]!= 64 ) )
loc = loc + 1 ;
else if ( c == 123 )
bal = bal + 1 ;
else if ( c == 125 )
{
if ( bal == 0 )
goto lab10 ;
bal = bal - 1 ;
}
}
lab10: ;
}
eightbits
#ifdef HAVE_PROTOTYPES
getnext ( void )
#else
getnext ( )
#endif
{
/* 20 30 31 */ register eightbits Result; eightbits c ;
eightbits d ;
integer j, k ;
lab20: if ( loc > limit )
{
getline () ;
if ( inputhasended )
{
c = 136 ;
goto lab31 ;
}
}
c = buffer [loc ];
loc = loc + 1 ;
if ( scanninghex )
if ( ( ( c >= 48 ) && ( c <= 57 ) ) || ( ( c >= 65 ) && ( c <= 70 ) ) )
goto lab31 ;
else scanninghex = false ;
switch ( c )
{case 65 :
case 66 :
case 67 :
case 68 :
case 69 :
case 70 :
case 71 :
case 72 :
case 73 :
case 74 :
case 75 :
case 76 :
case 77 :
case 78 :
case 79 :
case 80 :
case 81 :
case 82 :
case 83 :
case 84 :
case 85 :
case 86 :
case 87 :
case 88 :
case 89 :
case 90 :
case 97 :
case 98 :
case 99 :
case 100 :
case 101 :
case 102 :
case 103 :
case 104 :
case 105 :
case 106 :
case 107 :
case 108 :
case 109 :
case 110 :
case 111 :
case 112 :
case 113 :
case 114 :
case 115 :
case 116 :
case 117 :
case 118 :
case 119 :
case 120 :
case 121 :
case 122 :
{
if ( ( ( c == 101 ) || ( c == 69 ) ) && ( loc > 1 ) )
if ( ( buffer [loc - 2 ]<= 57 ) && ( buffer [loc - 2 ]>= 48 ) )
c = 0 ;
if ( c != 0 )
{
loc = loc - 1 ;
idfirst = loc ;
do {
loc = loc + 1 ;
d = buffer [loc ];
} while ( ! ( ( ( d < 48 ) || ( ( d > 57 ) && ( d < 65 ) ) || ( ( d >
90 ) && ( d < 97 ) ) || ( d > 122 ) ) && ( d != 95 ) ) ) ;
if ( loc > idfirst + 1 )
{
c = 130 ;
idloc = loc ;
}
}
else c = 69 ;
}
break ;
case 34 :
{
doublechars = 0 ;
idfirst = loc - 1 ;
do {
d = buffer [loc ];
loc = loc + 1 ;
if ( ( d == 34 ) || ( d == 64 ) )
if ( buffer [loc ]== d )
{
loc = loc + 1 ;
d = 0 ;
doublechars = doublechars + 1 ;
}
else {
if ( d == 64 )
{
putc ('\n', stdout );
Fputs( stdout , "! Double @ sign missing" ) ;
error () ;
}
}
else if ( loc > limit )
{
{
putc ('\n', stdout );
Fputs( stdout , "! String constant didn't end" ) ;
error () ;
}
d = 34 ;
}
} while ( ! ( d == 34 ) ) ;
idloc = loc - 1 ;
c = 130 ;
}
break ;
case 64 :
{
c = controlcode ( buffer [loc ]) ;
loc = loc + 1 ;
if ( c == 0 )
goto lab20 ;
else if ( c == 13 )
scanninghex = true ;
else if ( c == 135 )
{
k = 0 ;
while ( true ) {
if ( loc > limit )
{
getline () ;
if ( inputhasended )
{
{
putc ('\n', stdout );
Fputs( stdout , "! Input ended in section name" ) ;
error () ;
}
goto lab30 ;
}
}
d = buffer [loc ];
if ( d == 64 )
{
d = buffer [loc + 1 ];
if ( d == 62 )
{
loc = loc + 2 ;
goto lab30 ;
}
if ( ( d == 32 ) || ( d == 9 ) || ( d == 42 ) )
{
{
putc ('\n', stdout );
Fputs( stdout , "! Section name didn't end" ) ;
error () ;
}
goto lab30 ;
}
k = k + 1 ;
modtext [k ]= 64 ;
loc = loc + 1 ;
}
loc = loc + 1 ;
if ( k < longestname - 1 )
k = k + 1 ;
if ( ( d == 32 ) || ( d == 9 ) )
{
d = 32 ;
if ( modtext [k - 1 ]== 32 )
k = k - 1 ;
}
modtext [k ]= d ;
}
lab30: if ( k >= longestname - 2 )
{
{
putc ('\n', stdout );
Fputs( stdout , "! Section name too long: " ) ;
}
{register integer for_end; j = 1 ;for_end = 25 ; if ( j <=
for_end) do
putc ( xchr [modtext [j ]], stdout );
while ( j++ < for_end ) ;}
Fputs( stdout , "..." ) ;
if ( history == 0 )
history = 1 ;
}
if ( ( modtext [k ]== 32 ) && ( k > 0 ) )
k = k - 1 ;
if ( k > 3 )
{
if ( ( modtext [k ]== 46 ) && ( modtext [k - 1 ]== 46 ) && (
modtext [k - 2 ]== 46 ) )
curmodule = prefixlookup ( k - 3 ) ;
else curmodule = modlookup ( k ) ;
}
else curmodule = modlookup ( k ) ;
}
else if ( c == 131 )
{
do {
c = skipahead () ;
} while ( ! ( c != 64 ) ) ;
if ( buffer [loc - 1 ]!= 62 )
{
putc ('\n', stdout );
Fputs( stdout , "! Improper @ within control text" ) ;
error () ;
}
goto lab20 ;
}
}
break ;
case 46 :
if ( buffer [loc ]== 46 )
{
if ( loc <= limit )
{
c = 32 ;
loc = loc + 1 ;
}
}
else if ( buffer [loc ]== 41 )
{
if ( loc <= limit )
{
c = 93 ;
loc = loc + 1 ;
}
}
break ;
case 58 :
if ( buffer [loc ]== 61 )
{
if ( loc <= limit )
{
c = 24 ;
loc = loc + 1 ;
}
}
break ;
case 61 :
if ( buffer [loc ]== 61 )
{
if ( loc <= limit )
{
c = 30 ;
loc = loc + 1 ;
}
}
break ;
case 62 :
if ( buffer [loc ]== 61 )
{
if ( loc <= limit )
{
c = 29 ;
loc = loc + 1 ;
}
}
break ;
case 60 :
if ( buffer [loc ]== 61 )
{
if ( loc <= limit )
{
c = 28 ;
loc = loc + 1 ;
}
}
else if ( buffer [loc ]== 62 )
{
if ( loc <= limit )
{
c = 26 ;
loc = loc + 1 ;
}
}
break ;
case 40 :
if ( buffer [loc ]== 42 )
{
if ( loc <= limit )
{
c = 9 ;
loc = loc + 1 ;
}
}
else if ( buffer [loc ]== 46 )
{
if ( loc <= limit )
{
c = 91 ;
loc = loc + 1 ;
}
}
break ;
case 42 :
if ( buffer [loc ]== 41 )
{
if ( loc <= limit )
{
c = 10 ;
loc = loc + 1 ;
}
}
break ;
case 32 :
case 9 :
goto lab20 ;
break ;
case 123 :
{
skipcomment () ;
goto lab20 ;
}
break ;
case 125 :
{
{
putc ('\n', stdout );
Fputs( stdout , "! Extra }" ) ;
error () ;
}
goto lab20 ;
}
break ;
default:
if ( c >= 128 )
goto lab20 ;
else ;
break ;
}
lab31: Result = c ;
return Result ;
}
void
#ifdef HAVE_PROTOTYPES
zscannumeric ( namepointer p )
#else
zscannumeric ( p )
namepointer p ;
#endif
{
/* 21 30 */ integer accumulator ;
schar nextsign ;
namepointer q ;
integer val ;
accumulator = 0 ;
nextsign = 1 ;
while ( true ) {
nextcontrol = getnext () ;
lab21: switch ( nextcontrol )
{case 48 :
case 49 :
case 50 :
case 51 :
case 52 :
case 53 :
case 54 :
case 55 :
case 56 :
case 57 :
{
val = 0 ;
do {
val = 10 * val + nextcontrol - 48 ;
nextcontrol = getnext () ;
} while ( ! ( ( nextcontrol > 57 ) || ( nextcontrol < 48 ) ) ) ;
{
accumulator = accumulator + nextsign * toint ( val ) ;
nextsign = 1 ;
}
goto lab21 ;
}
break ;
case 12 :
{
val = 0 ;
nextcontrol = 48 ;
do {
val = 8 * val + nextcontrol - 48 ;
nextcontrol = getnext () ;
} while ( ! ( ( nextcontrol > 55 ) || ( nextcontrol < 48 ) ) ) ;
{
accumulator = accumulator + nextsign * toint ( val ) ;
nextsign = 1 ;
}
goto lab21 ;
}
break ;
case 13 :
{
val = 0 ;
nextcontrol = 48 ;
do {
if ( nextcontrol >= 65 )
nextcontrol = nextcontrol - 7 ;
val = 16 * val + nextcontrol - 48 ;
nextcontrol = getnext () ;
} while ( ! ( ( nextcontrol > 70 ) || ( nextcontrol < 48 ) || ( (
nextcontrol > 57 ) && ( nextcontrol < 65 ) ) ) ) ;
{
accumulator = accumulator + nextsign * toint ( val ) ;
nextsign = 1 ;
}
goto lab21 ;
}
break ;
case 130 :
{
q = idlookup ( 0 ) ;
if ( ilk [q ]!= 1 )
{
nextcontrol = 42 ;
goto lab21 ;
}
{
accumulator = accumulator + nextsign * toint ( equiv [q ]- 32768L
) ;
nextsign = 1 ;
}
}
break ;
case 43 :
;
break ;
case 45 :
nextsign = - (integer) nextsign ;
break ;
case 132 :
case 133 :
case 135 :
case 134 :
case 136 :
goto lab30 ;
break ;
case 59 :
{
putc ('\n', stdout );
Fputs( stdout , "! Omit semicolon in numeric definition" ) ;
error () ;
}
break ;
default:
{
{
putc ('\n', stdout );
Fputs( stdout , "! Improper numeric definition will be flushed" ) ;
error () ;
}
do {
nextcontrol = skipahead () ;
} while ( ! ( ( nextcontrol >= 132 ) ) ) ;
if ( nextcontrol == 135 )
{
loc = loc - 2 ;
nextcontrol = getnext () ;
}
accumulator = 0 ;
goto lab30 ;
}
break ;
}
}
lab30: ;
if ( abs ( accumulator ) >= 32768L )
{
{
putc ('\n', stdout );
fprintf( stdout , "%s%ld", "! Value too big: " , (long)accumulator ) ;
error () ;
}
accumulator = 0 ;
}
equiv [p ]= accumulator + 32768L ;
}
void
#ifdef HAVE_PROTOTYPES
zscanrepl ( eightbits t )
#else
zscanrepl ( t )
eightbits t ;
#endif
{
/* 22 30 31 21 */ sixteenbits a ;
ASCIIcode b ;
eightbits bal ;
bal = 0 ;
while ( true ) {
lab22: a = getnext () ;
switch ( a )
{case 40 :
bal = bal + 1 ;
break ;
case 41 :
if ( bal == 0 )
{
putc ('\n', stdout );
Fputs( stdout , "! Extra )" ) ;
error () ;
}
else bal = bal - 1 ;
break ;
case 39 :
{
b = 39 ;
while ( true ) {
{
if ( tokptr [z ]== maxtoks )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "token" , " capacity exceeded" )
;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
tokmem [z ][ tokptr [z ]]= b ;
tokptr [z ]= tokptr [z ]+ 1 ;
}
if ( b == 64 )
if ( buffer [loc ]== 64 )
loc = loc + 1 ;
else {
putc ('\n', stdout );
Fputs( stdout , "! You should double @ signs in strings" ) ;
error () ;
}
if ( loc == limit )
{
{
putc ('\n', stdout );
Fputs( stdout , "! String didn't end" ) ;
error () ;
}
buffer [loc ]= 39 ;
buffer [loc + 1 ]= 0 ;
}
b = buffer [loc ];
loc = loc + 1 ;
if ( b == 39 )
{
if ( buffer [loc ]!= 39 )
goto lab31 ;
else {
loc = loc + 1 ;
{
if ( tokptr [z ]== maxtoks )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "token" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
tokmem [z ][ tokptr [z ]]= 39 ;
tokptr [z ]= tokptr [z ]+ 1 ;
}
}
}
}
lab31: ;
}
break ;
case 35 :
if ( t == 3 )
a = 0 ;
break ;
case 130 :
{
a = idlookup ( 0 ) ;
{
if ( tokptr [z ]== maxtoks )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "token" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
tokmem [z ][ tokptr [z ]]= ( a / 256 ) + 128 ;
tokptr [z ]= tokptr [z ]+ 1 ;
}
a = a % 256 ;
}
break ;
case 135 :
if ( t != 135 )
goto lab30 ;
else {
{
if ( tokptr [z ]== maxtoks )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "token" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
tokmem [z ][ tokptr [z ]]= ( curmodule / 256 ) + 168 ;
tokptr [z ]= tokptr [z ]+ 1 ;
}
a = curmodule % 256 ;
}
break ;
case 2 :
{
{
if ( tokptr [z ]== maxtoks )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "token" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
tokmem [z ][ tokptr [z ]]= 2 ;
tokptr [z ]= tokptr [z ]+ 1 ;
}
buffer [limit + 1 ]= 64 ;
lab21: if ( buffer [loc ]== 64 )
{
if ( loc < limit )
if ( buffer [loc + 1 ]== 64 )
{
{
if ( tokptr [z ]== maxtoks )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "token" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
tokmem [z ][ tokptr [z ]]= 64 ;
tokptr [z ]= tokptr [z ]+ 1 ;
}
loc = loc + 2 ;
goto lab21 ;
}
}
else {
{
if ( tokptr [z ]== maxtoks )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "token" , " capacity exceeded" )
;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
tokmem [z ][ tokptr [z ]]= buffer [loc ];
tokptr [z ]= tokptr [z ]+ 1 ;
}
loc = loc + 1 ;
goto lab21 ;
}
if ( loc >= limit )
{
putc ('\n', stdout );
Fputs( stdout , "! Verbatim string didn't end" ) ;
error () ;
}
else if ( buffer [loc + 1 ]!= 62 )
{
putc ('\n', stdout );
Fputs( stdout , "! You should double @ signs in verbatim strings" )
;
error () ;
}
loc = loc + 2 ;
}
break ;
case 133 :
case 132 :
case 134 :
if ( t != 135 )
goto lab30 ;
else {
{
putc ('\n', stdout );
fprintf( stdout , "%s%c%s", "! @" , xchr [buffer [loc - 1 ]], " is ignored in Pascal text" ) ;
error () ;
}
goto lab22 ;
}
break ;
case 136 :
goto lab30 ;
break ;
default:
;
break ;
}
{
if ( tokptr [z ]== maxtoks )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "token" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
tokmem [z ][ tokptr [z ]]= a ;
tokptr [z ]= tokptr [z ]+ 1 ;
}
}
lab30: nextcontrol = a ;
if ( bal > 0 )
{
if ( bal == 1 )
{
putc ('\n', stdout );
Fputs( stdout , "! Missing )" ) ;
error () ;
}
else {
putc ('\n', stdout );
fprintf( stdout , "%s%ld%s", "! Missing " , (long)bal , " )'s" ) ;
error () ;
}
while ( bal > 0 ) {
{
if ( tokptr [z ]== maxtoks )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "token" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
tokmem [z ][ tokptr [z ]]= 41 ;
tokptr [z ]= tokptr [z ]+ 1 ;
}
bal = bal - 1 ;
}
}
if ( textptr > maxtexts - 4 )
{
putc ('\n', stdout );
fprintf( stderr , "%s%s%s", "! Sorry, " , "text" , " capacity exceeded" ) ;
error () ;
history = 3 ;
uexit ( 1 ) ;
}
currepltext = textptr ;
tokstart [textptr + 4 ]= tokptr [z ];
textptr = textptr + 1 ;
if ( z == 3 )
z = 0 ;
else z = z + 1 ;
}
void
#ifdef HAVE_PROTOTYPES
zdefinemacro ( eightbits t )
#else
zdefinemacro ( t )
eightbits t ;
#endif
{
namepointer p ;
p = idlookup ( t ) ;
scanrepl ( t ) ;
equiv [p ]= currepltext ;
textlink [currepltext ]= 0 ;
}
void
#ifdef HAVE_PROTOTYPES
scanmodule ( void )
#else
scanmodule ( )
#endif
{
/* 22 30 10 */ namepointer p ;
modulecount = modulecount + 1 ;
nextcontrol = 0 ;
while ( true ) {
lab22: while ( nextcontrol <= 132 ) {
nextcontrol = skipahead () ;
if ( nextcontrol == 135 )
{
loc = loc - 2 ;
nextcontrol = getnext () ;
}
}
if ( nextcontrol != 133 )
goto lab30 ;
nextcontrol = getnext () ;
if ( nextcontrol != 130 )
{
{
putc ('\n', stdout );
fprintf( stdout , "%s%s", "! Definition flushed, must start with " , "identifier of length > 1" ) ;
error () ;
}
goto lab22 ;
}
nextcontrol = getnext () ;
if ( nextcontrol == 61 )
{
scannumeric ( idlookup ( 1 ) ) ;
goto lab22 ;
}
else if ( nextcontrol == 30 )
{
definemacro ( 2 ) ;
goto lab22 ;
}
else if ( nextcontrol == 40 )
{
nextcontrol = getnext () ;
if ( nextcontrol == 35 )
{
nextcontrol = getnext () ;
if ( nextcontrol == 41 )
{
nextcontrol = getnext () ;
if ( nextcontrol == 61 )
{
{
putc ('\n', stdout );
Fputs( stdout , "! Use == for macros" ) ;
error () ;
}
nextcontrol = 30 ;
}
if ( nextcontrol == 30 )
{
definemacro ( 3 ) ;
goto lab22 ;
}
}
}
}
{
putc ('\n', stdout );
Fputs( stdout , "! Definition flushed since it starts badly" ) ;
error () ;
}
}
lab30: ;
switch ( nextcontrol )
{case 134 :
p = 0 ;
break ;
case 135 :
{
p = curmodule ;
do {
nextcontrol = getnext () ;
} while ( ! ( nextcontrol != 43 ) ) ;
if ( ( nextcontrol != 61 ) && ( nextcontrol != 30 ) )
{
{
putc ('\n', stdout );
Fputs( stdout , "! Pascal text flushed, = sign is missing" ) ;
error () ;
}
do {
nextcontrol = skipahead () ;
} while ( ! ( nextcontrol == 136 ) ) ;
goto lab10 ;
}
}
break ;
default:
goto lab10 ;
break ;
}
storetwobytes ( 53248L + modulecount ) ;
scanrepl ( 135 ) ;
if ( p == 0 )
{
textlink [lastunnamed ]= currepltext ;
lastunnamed = currepltext ;
}
else if ( equiv [p ]== 0 )
equiv [p ]= currepltext ;
else {
p = equiv [p ];
while ( textlink [p ]< maxtexts ) p = textlink [p ];
textlink [p ]= currepltext ;
}
textlink [currepltext ]= maxtexts ;
lab10: ;
}
void mainbody() {
initialize () ;
openinput () ;
line = 0 ;
otherline = 0 ;
changing = true ;
primethechangebuffer () ;
changing = ! changing ;
templine = otherline ;
otherline = line ;
line = templine ;
limit = 0 ;
loc = 1 ;
buffer [0 ]= 32 ;
inputhasended = false ;
Fputs( stdout , "This is TANGLE, Version 4.3" ) ;
fprintf( stdout , "%s\n", versionstring ) ;
phaseone = true ;
modulecount = 0 ;
do {
nextcontrol = skipahead () ;
} while ( ! ( nextcontrol == 136 ) ) ;
while ( ! inputhasended ) scanmodule () ;
if ( changelimit != 0 )
{
{register integer for_end; ii = 0 ;for_end = changelimit ; if ( ii <=
for_end) do
buffer [ii ]= changebuffer [ii ];
while ( ii++ < for_end ) ;}
limit = changelimit ;
changing = true ;
line = otherline ;
loc = changelimit ;
{
putc ('\n', stdout );
Fputs( stdout , "! Change file entry did not match" ) ;
error () ;
}
}
phaseone = false ;
if ( textlink [0 ]== 0 )
{
{
putc ('\n', stdout );
Fputs( stdout , "! No output was specified." ) ;
}
if ( history == 0 )
history = 1 ;
}
else {
{
putc ('\n', stdout );
Fputs( stdout , "Writing the output file" ) ;
}
fflush ( stdout ) ;
stackptr = 1 ;
bracelevel = 0 ;
curstate .namefield = 0 ;
curstate .replfield = textlink [0 ];
zo = curstate .replfield % 4 ;
curstate .bytefield = tokstart [curstate .replfield ];
curstate .endfield = tokstart [curstate .replfield + 4 ];
curstate .modfield = 0 ;
outstate = 0 ;
outptr = 0 ;
breakptr = 0 ;
semiptr = 0 ;
outbuf [0 ]= 0 ;
line = 1 ;
sendtheoutput () ;
breakptr = outptr ;
semiptr = 0 ;
flushbuffer () ;
if ( bracelevel != 0 )
{
putc ('\n', stdout );
fprintf( stdout , "%s%ld", "! Program ended at brace level " , (long)bracelevel ) ;
error () ;
}
{
putc ('\n', stdout );
Fputs( stdout , "Done." ) ;
}
}
lab9999: if ( stringptr > 256 )
{
{
putc ('\n', stdout );
fprintf( stdout , "%ld%s", (long)stringptr - 256 , " strings written to string pool file." ) ;
}
putc ( '*' , pool );
{register integer for_end; ii = 1 ;for_end = 9 ; if ( ii <= for_end) do
{
outbuf [ii ]= poolchecksum % 10 ;
poolchecksum = poolchecksum / 10 ;
}
while ( ii++ < for_end ) ;}
{register integer for_end; ii = 9 ;for_end = 1 ; if ( ii >= for_end) do
putc ( xchr [48 + outbuf [ii ]], pool );
while ( ii-- > for_end ) ;}
putc ('\n', pool );
}
switch ( history )
{case 0 :
{
putc ('\n', stdout );
Fputs( stdout , "(No errors were found.)" ) ;
}
break ;
case 1 :
{
putc ('\n', stdout );
Fputs( stdout , "(Did you see the warning message above?)" ) ;
}
break ;
case 2 :
{
putc ('\n', stdout );
Fputs( stdout , "(Pardon me, but I think I spotted something wrong.)" )
;
}
break ;
case 3 :
{
putc ('\n', stdout );
Fputs( stdout , "(That was a fatal error, my friend.)" ) ;
}
break ;
}
putc ('\n', stdout );
if ( ( history != 0 ) && ( history != 1 ) )
uexit ( 1 ) ;
else uexit ( 0 ) ;
}
|
