#define EXTERN extern
#include "mpd.h"
void resumeiteration ( )
{/* 45 10 */ halfword p, q ;
p = mem [ loopptr + 1 ] .hhfield .lhfield ;
if ( p == 2 )
{
p = mem [ loopptr + 1 ] .hhfield .v.RH ;
curexp = mem [ p + 1 ] .cint ;
if ( ( ( mem [ p + 2 ] .cint > 0 ) && ( curexp > mem [ p + 3 ] .cint ) )
|| ( ( mem [ p + 2 ] .cint < 0 ) && ( curexp < mem [ p + 3 ] .cint ) ) )
goto lab45 ;
curtype = 16 ;
q = stashcurexp () ;
mem [ p + 1 ] .cint = curexp + mem [ p + 2 ] .cint ;
}
else if ( p == 0 )
{
p = mem [ loopptr + 1 ] .hhfield .v.RH ;
if ( p == 0 )
goto lab45 ;
mem [ loopptr + 1 ] .hhfield .v.RH = mem [ p ] .hhfield .v.RH ;
q = mem [ p ] .hhfield .lhfield ;
{
mem [ p ] .hhfield .v.RH = avail ;
avail = p ;
;
#ifdef STAT
decr ( dynused ) ;
#endif /* STAT */
}
}
else if ( p == 1 )
{
begintokenlist ( mem [ loopptr ] .hhfield .lhfield , 16 ) ;
goto lab10 ;
}
else {
q = mem [ loopptr + 1 ] .hhfield .v.RH ;
if ( q == 0 )
goto lab45 ;
if ( ! ( mem [ q ] .hhfield .b0 >= 4 ) )
q = mem [ q ] .hhfield .v.RH ;
else if ( ! ( mem [ q ] .hhfield .b0 >= 6 ) )
q = skip1component ( q ) ;
else goto lab45 ;
curexp = copyobjects ( mem [ loopptr + 1 ] .hhfield .v.RH , q ) ;
initbbox ( curexp ) ;
curtype = 10 ;
mem [ loopptr + 1 ] .hhfield .v.RH = q ;
q = stashcurexp () ;
}
begintokenlist ( mem [ loopptr ] .hhfield .lhfield , 17 ) ;
stackargument ( q ) ;
if ( internal [ 6 ] > 65536L )
{
begindiagnostic () ;
printnl ( 777 ) ;
if ( ( q != 0 ) && ( mem [ q ] .hhfield .v.RH == 1 ) )
printexp ( q , 1 ) ;
else showtokenlist ( q , 0 , 50 , 0 ) ;
printchar ( 125 ) ;
enddiagnostic ( false ) ;
}
goto lab10 ;
lab45: stopiteration () ;
lab10: ;
}
void stopiteration ( )
{halfword p, q ;
p = mem [ loopptr + 1 ] .hhfield .lhfield ;
if ( p == 2 )
freenode ( mem [ loopptr + 1 ] .hhfield .v.RH , 4 ) ;
else if ( p == 0 )
{
q = mem [ loopptr + 1 ] .hhfield .v.RH ;
while ( q != 0 ) {
p = mem [ q ] .hhfield .lhfield ;
if ( p != 0 )
if ( mem [ p ] .hhfield .v.RH == 1 )
{
recyclevalue ( p ) ;
freenode ( p , 2 ) ;
}
else flushtokenlist ( p ) ;
p = q ;
q = mem [ q ] .hhfield .v.RH ;
{
mem [ p ] .hhfield .v.RH = avail ;
avail = p ;
;
#ifdef STAT
decr ( dynused ) ;
#endif /* STAT */
}
}
}
else if ( p > 2 )
if ( mem [ p ] .hhfield .lhfield == 0 )
tossedges ( p ) ;
else decr ( mem [ p ] .hhfield .lhfield ) ;
p = loopptr ;
loopptr = mem [ p ] .hhfield .v.RH ;
flushtokenlist ( mem [ p ] .hhfield .lhfield ) ;
freenode ( p , 2 ) ;
}
void zpackbufferedname ( n , a , b )
smallnumber n ;
integer a ;
integer b ;
{integer k ;
ASCIIcode c ;
integer j ;
if ( n + b - a + 5 > filenamesize )
b = a + filenamesize - n - 5 ;
k = 0 ;
{register integer for_end; j = 1 ; for_end = n ; if ( j <= for_end) do
{
c = xord [ MPmemdefault [ j ] ] ;
incr ( k ) ;
if ( k <= filenamesize )
nameoffile [ k ] = xchr [ c ] ;
}
while ( j++ < for_end ) ; }
{register integer for_end; j = a ; for_end = b ; if ( j <= for_end) do
{
c = buffer [ j ] ;
incr ( k ) ;
if ( k <= filenamesize )
nameoffile [ k ] = xchr [ c ] ;
}
while ( j++ < for_end ) ; }
{register integer for_end; j = 6 ; for_end = 9 ; if ( j <= for_end) do
{
c = xord [ MPmemdefault [ j ] ] ;
incr ( k ) ;
if ( k <= filenamesize )
nameoffile [ k ] = xchr [ c ] ;
}
while ( j++ < for_end ) ; }
if ( k <= filenamesize )
namelength = k ;
else namelength = filenamesize ;
{register integer for_end; k = namelength + 1 ; for_end = filenamesize
; if ( k <= for_end) do
nameoffile [ k ] = ' ' ;
while ( k++ < for_end ) ; }
}
strnumber makenamestring ( )
{register strnumber Result; integer k, kstart ;
k = 1 ;
while ( ( k < filenamesize ) && ( xord [ realnameoffile [ k ] ] != 32 ) )
incr ( k ) ;
namelength = k - 1 ;
if ( stroverflowed )
Result = 63 ;
else {
if ( ( xord [ realnameoffile [ 1 ] ] == 46 ) && ( xord [ realnameoffile [
2 ] ] == 47 ) )
kstart = 3 ;
else kstart = 1 ;
{
if ( poolptr + namelength - kstart - 1 > maxpoolptr )
if ( poolptr + namelength - kstart - 1 > poolsize )
docompaction ( namelength - kstart - 1 ) ;
else maxpoolptr = poolptr + namelength - kstart - 1 ;
}
{register integer for_end; k = kstart ; for_end = namelength ; if ( k <=
for_end) do
{
strpool [ poolptr ] = xord [ realnameoffile [ k ] ] ;
incr ( poolptr ) ;
}
while ( k++ < for_end ) ; }
Result = makestring () ;
}
return(Result) ;
}
void scanfilename ( )
{/* 30 */ beginname () ;
while ( ( buffer [ curinput .locfield ] == 32 ) || ( buffer [ curinput .locfield ] == 9 ) ) incr ( curinput .locfield ) ;
while ( true ) {
if ( ( buffer [ curinput .locfield ] == 59 ) || ( buffer [ curinput .locfield ] == 37 ) )
goto lab30 ;
if ( ! morename ( buffer [ curinput .locfield ] ) )
goto lab30 ;
incr ( curinput .locfield ) ;
}
lab30: endname () ;
}
void zpackjobname ( s )
strnumber s ;
{{
if ( strref [ s ] < 127 )
incr ( strref [ s ] ) ;
}
{
if ( strref [ curname ] < 127 )
if ( strref [ curname ] > 1 )
decr ( strref [ curname ] ) ;
else flushstring ( curname ) ;
}
{
if ( strref [ curarea ] < 127 )
if ( strref [ curarea ] > 1 )
decr ( strref [ curarea ] ) ;
else flushstring ( curarea ) ;
}
{
if ( strref [ curext ] < 127 )
if ( strref [ curext ] > 1 )
decr ( strref [ curext ] ) ;
else flushstring ( curext ) ;
}
curarea = 285 ;
curext = s ;
curname = jobname ;
packfilename ( curname , curarea , curext ) ;
}
void zpromptfilename ( s , e )
strnumber s ;
strnumber e ;
{/* 30 */ integer k ;
if ( interaction == 2 )
;
if ( s == 786 )
{
if ( interaction == 3 )
;
printnl ( 263 ) ;
print ( 787 ) ;
}
else {
if ( interaction == 3 )
;
printnl ( 263 ) ;
print ( 788 ) ;
}
printfilename ( curname , curarea , curext ) ;
print ( 789 ) ;
if ( e == 285 )
showcontext () ;
printnl ( 790 ) ;
print ( s ) ;
if ( interaction < 2 )
fatalerror ( 791 ) ;
flush ( termin ) ;
{
;
print ( 792 ) ;
terminput () ;
}
{
beginname () ;
k = first ;
while ( ( ( buffer [ k ] == 32 ) || ( buffer [ k ] == 9 ) ) && ( k < last
) ) incr ( k ) ;
while ( true ) {
if ( k == last )
goto lab30 ;
if ( ! morename ( buffer [ k ] ) )
goto lab30 ;
incr ( k ) ;
}
lab30: endname () ;
}
if ( curext == 285 )
curext = e ;
packfilename ( curname , curarea , curext ) ;
}
void openlogfile ( )
{char oldsetting ;
integer k ;
integer l ;
integer m ;
char months[37] ;
oldsetting = selector ;
if ( jobname == 0 )
jobname = 793 ;
packjobname ( 794 ) ;
while ( ! aopenout ( logfile ) ) {
selector = 5 ;
promptfilename ( 796 , 794 ) ;
}
mplogname = amakenamestring ( logfile ) ;
selector = 6 ;
logopened = true ;
{
Fputs( logfile , "This is MetaPost, C Version 0.631" ) ;
print ( memident ) ;
print ( 797 ) ;
printint ( roundunscaled ( internal [ 15 ] ) ) ;
printchar ( 32 ) ;
(void) strcpy(months + 1, "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC") ;
m = roundunscaled ( internal [ 14 ] ) ;
{register integer for_end; k = 3 * m - 2 ; for_end = 3 * m ; if ( k <=
for_end) do
putc ( months [ k ] , logfile );
while ( k++ < for_end ) ; }
printchar ( 32 ) ;
printint ( roundunscaled ( internal [ 13 ] ) ) ;
printchar ( 32 ) ;
m = roundunscaled ( internal [ 16 ] ) ;
printdd ( m / 60 ) ;
printchar ( 58 ) ;
printdd ( m % 60 ) ;
}
inputstack [ inputptr ] = curinput ;
printnl ( 795 ) ;
l = inputstack [ 0 ] .limitfield - 1 ;
{register integer for_end; k = 1 ; for_end = l ; if ( k <= for_end) do
print ( buffer [ k ] ) ;
while ( k++ < for_end ) ; }
println () ;
selector = oldsetting + 2 ;
}
boolean ztryextension ( ext )
strnumber ext ;
{register boolean Result; packfilename ( curname , curarea , ext ) ;
inamestack [ curinput .indexfield ] = curname ;
iareastack [ curinput .indexfield ] = curarea ;
if ( strvsstr ( ext , 798 ) == 0 )
Result = aopenin ( inputfile [ curinput .indexfield ] , 6 ) ;
else Result = aopenin ( inputfile [ curinput .indexfield ] , 9 ) ;
return(Result) ;
}
void startinput ( )
{/* 30 */ while ( ( curinput .indexfield > 15 ) && ( curinput .locfield == 0
) ) endtokenlist () ;
if ( ( curinput .indexfield > 15 ) )
{
{
if ( interaction == 3 )
;
printnl ( 263 ) ;
print ( 800 ) ;
}
{
helpptr = 3 ;
helpline [ 2 ] = 801 ;
helpline [ 1 ] = 802 ;
helpline [ 0 ] = 803 ;
}
error () ;
}
if ( ( curinput .indexfield <= 15 ) )
scanfilename () ;
else {
curname = 285 ;
curext = 285 ;
curarea = 285 ;
}
while ( true ) {
beginfilereading () ;
if ( curext == 285 )
if ( tryextension ( 799 ) )
goto lab30 ;
else if ( tryextension ( 285 ) )
goto lab30 ;
else if ( tryextension ( 798 ) )
goto lab30 ;
else ;
else if ( tryextension ( curext ) )
goto lab30 ;
endfilereading () ;
promptfilename ( 786 , 285 ) ;
}
lab30: curinput .namefield = amakenamestring ( inputfile [ curinput .indexfield ] ) ;
if ( inamestack [ curinput .indexfield ] == curname )
{
if ( strref [ curname ] < 127 )
incr ( strref [ curname ] ) ;
}
if ( iareastack [ curinput .indexfield ] == curarea )
{
if ( strref [ curarea ] < 127 )
incr ( strref [ curarea ] ) ;
}
if ( jobname == 0 )
{
jobname = curname ;
strref [ jobname ] = 127 ;
openlogfile () ;
}
if ( termoffset + ( strstart [ nextstr [ curinput .namefield ] ] - strstart
[ curinput .namefield ] ) > maxprintline - 2 )
println () ;
else if ( ( termoffset > 0 ) || ( fileoffset > 0 ) )
printchar ( 32 ) ;
printchar ( 40 ) ;
incr ( openparens ) ;
print ( curinput .namefield ) ;
flush ( termout ) ;
{
linestack [ curinput .indexfield ] = 1 ;
if ( inputln ( inputfile [ curinput .indexfield ] , false ) )
;
firmuptheline () ;
buffer [ curinput .limitfield ] = 37 ;
first = curinput .limitfield + 1 ;
curinput .locfield = curinput .startfield ;
}
}
void zcopyoldname ( s )
strnumber s ;
{integer k ;
poolpointer j ;
k = 0 ;
{register integer for_end; j = strstart [ s ] ; for_end = strstart [
nextstr [ s ] ] - 1 ; if ( j <= for_end) do
{
incr ( k ) ;
if ( k <= filenamesize )
oldfilename [ k ] = xchr [ strpool [ j ] ] ;
}
while ( j++ < for_end ) ; }
if ( k <= filenamesize )
oldnamelength = k ;
else oldnamelength = filenamesize ;
{register integer for_end; k = oldnamelength + 1 ; for_end = filenamesize
; if ( k <= for_end) do
oldfilename [ k ] = ' ' ;
while ( k++ < for_end ) ; }
}
void startmpxinput ( )
{/* 10 45 */ integer k ;
packfilename ( inamestack [ curinput .indexfield ] , iareastack [ curinput .indexfield ] , 804 ) ;
copyoldname ( curinput .namefield ) ;
if ( ! callmakempx ( oldfilename , nameoffile ) )
goto lab45 ;
beginfilereading () ;
if ( ! aopenin ( inputfile [ curinput .indexfield ] , 0 ) )
{
endfilereading () ;
goto lab45 ;
}
curinput .namefield = amakenamestring ( inputfile [ curinput .indexfield ] )
;
mpxname [ curinput .indexfield ] = curinput .namefield ;
{
if ( strref [ curinput .namefield ] < 127 )
incr ( strref [ curinput .namefield ] ) ;
}
{
linestack [ curinput .indexfield ] = 1 ;
if ( inputln ( inputfile [ curinput .indexfield ] , false ) )
;
firmuptheline () ;
buffer [ curinput .limitfield ] = 37 ;
first = curinput .limitfield + 1 ;
curinput .locfield = curinput .startfield ;
}
goto lab10 ;
lab45: if ( interaction == 3 )
;
printnl ( 805 ) ;
{register integer for_end; k = 1 ; for_end = oldnamelength ; if ( k <=
for_end) do
print ( xord [ oldfilename [ k ] ] ) ;
while ( k++ < for_end ) ; }
printnl ( 805 ) ;
{register integer for_end; k = 1 ; for_end = namelength ; if ( k <=
for_end) do
print ( xord [ nameoffile [ k ] ] ) ;
while ( k++ < for_end ) ; }
printnl ( 806 ) ;
{
helpptr = 4 ;
helpline [ 3 ] = 807 ;
helpline [ 2 ] = 808 ;
helpline [ 1 ] = 809 ;
helpline [ 0 ] = 810 ;
}
{
if ( interaction == 3 )
interaction = 2 ;
if ( logopened )
error () ;
;
#ifdef DEBUG
if ( interaction > 0 )
debughelp () ;
#endif /* DEBUG */
history = 3 ;
jumpout () ;
}
lab10: ;
}
boolean zstartreadinput ( s , n )
strnumber s ;
readfindex n ;
{/* 10 45 */ register boolean Result; strscanfile ( s ) ;
packfilename ( curname , curarea , curext ) ;
beginfilereading () ;
if ( ! aopenin ( rdfile [ n ] , 0 ) )
goto lab45 ;
if ( ! inputln ( rdfile [ n ] , false ) )
goto lab45 ;
rdfname [ n ] = s ;
{
if ( strref [ s ] < 127 )
incr ( strref [ s ] ) ;
}
Result = true ;
goto lab10 ;
lab45: endfilereading () ;
Result = false ;
lab10: ;
return(Result) ;
}
void zopenwritefile ( s , n )
strnumber s ;
readfindex n ;
{strscanfile ( s ) ;
packfilename ( curname , curarea , curext ) ;
while ( ! aopenout ( wrfile [ n ] ) ) promptfilename ( 811 , 285 ) ;
wrfname [ n ] = s ;
{
if ( strref [ s ] < 127 )
incr ( strref [ s ] ) ;
}
}
void zbadexp ( s )
strnumber s ;
{char saveflag ;
{
if ( interaction == 3 )
;
printnl ( 263 ) ;
print ( s ) ;
}
print ( 819 ) ;
printcmdmod ( curcmd , curmod ) ;
printchar ( 39 ) ;
{
helpptr = 4 ;
helpline [ 3 ] = 820 ;
helpline [ 2 ] = 821 ;
helpline [ 1 ] = 822 ;
helpline [ 0 ] = 823 ;
}
backinput () ;
cursym = 0 ;
curcmd = 44 ;
curmod = 0 ;
inserror () ;
saveflag = varflag ;
varflag = 0 ;
getxnext () ;
varflag = saveflag ;
}
void zstashin ( p )
halfword p ;
{halfword q ;
mem [ p ] .hhfield .b0 = curtype ;
if ( curtype == 16 )
mem [ p + 1 ] .cint = curexp ;
else {
if ( curtype == 19 )
{
q = singledependency ( curexp ) ;
if ( q == depfinal )
{
mem [ p ] .hhfield .b0 = 16 ;
mem [ p + 1 ] .cint = 0 ;
freenode ( q , 2 ) ;
}
else {
mem [ p ] .hhfield .b0 = 17 ;
newdep ( p , q ) ;
}
recyclevalue ( curexp ) ;
}
else {
mem [ p + 1 ] = mem [ curexp + 1 ] ;
mem [ mem [ p + 1 ] .hhfield .lhfield ] .hhfield .v.RH = p ;
}
freenode ( curexp , 2 ) ;
}
curtype = 1 ;
}
void backexpr ( )
{halfword p ;
p = stashcurexp () ;
mem [ p ] .hhfield .v.RH = 0 ;
begintokenlist ( p , 19 ) ;
}
void badsubscript ( )
{disperr ( 0 , 837 ) ;
{
helpptr = 3 ;
helpline [ 2 ] = 838 ;
helpline [ 1 ] = 839 ;
helpline [ 0 ] = 840 ;
}
flusherror ( 0 ) ;
}
void zobliterated ( q )
halfword q ;
{{
if ( interaction == 3 )
;
printnl ( 263 ) ;
print ( 841 ) ;
}
showtokenlist ( q , 0 , 1000 , 0 ) ;
print ( 842 ) ;
{
helpptr = 5 ;
helpline [ 4 ] = 843 ;
helpline [ 3 ] = 844 ;
helpline [ 2 ] = 845 ;
helpline [ 1 ] = 846 ;
helpline [ 0 ] = 847 ;
}
}
void zbinarymac ( p , c , n )
halfword p ;
halfword c ;
halfword n ;
{halfword q, r ;
q = getavail () ;
r = getavail () ;
mem [ q ] .hhfield .v.RH = r ;
mem [ q ] .hhfield .lhfield = p ;
mem [ r ] .hhfield .lhfield = stashcurexp () ;
macrocall ( c , q , n ) ;
}
void knownpair ( )
{halfword p ;
if ( curtype != 14 )
{
disperr ( 0 , 858 ) ;
{
helpptr = 5 ;
helpline [ 4 ] = 859 ;
helpline [ 3 ] = 860 ;
helpline [ 2 ] = 861 ;
helpline [ 1 ] = 862 ;
helpline [ 0 ] = 863 ;
}
putgetflusherror ( 0 ) ;
curx = 0 ;
cury = 0 ;
}
else {
p = mem [ curexp + 1 ] .cint ;
if ( mem [ p ] .hhfield .b0 == 16 )
curx = mem [ p + 1 ] .cint ;
else {
disperr ( p , 864 ) ;
{
helpptr = 5 ;
helpline [ 4 ] = 865 ;
helpline [ 3 ] = 860 ;
helpline [ 2 ] = 861 ;
helpline [ 1 ] = 862 ;
helpline [ 0 ] = 863 ;
}
putgeterror () ;
recyclevalue ( p ) ;
curx = 0 ;
}
if ( mem [ p + 2 ] .hhfield .b0 == 16 )
cury = mem [ p + 3 ] .cint ;
else {
disperr ( p + 2 , 866 ) ;
{
helpptr = 5 ;
helpline [ 4 ] = 867 ;
helpline [ 3 ] = 860 ;
helpline [ 2 ] = 861 ;
helpline [ 1 ] = 862 ;
helpline [ 0 ] = 863 ;
}
putgeterror () ;
recyclevalue ( p + 2 ) ;
cury = 0 ;
}
flushcurexp ( 0 ) ;
}
}
halfword newknot ( )
{register halfword Result; halfword q ;
q = getnode ( 7 ) ;
mem [ q ] .hhfield .b0 = 0 ;
mem [ q ] .hhfield .b1 = 0 ;
mem [ q ] .hhfield .v.RH = q ;
knownpair () ;
mem [ q + 1 ] .cint = curx ;
mem [ q + 2 ] .cint = cury ;
Result = q ;
return(Result) ;
}
smallnumber scandirection ( )
{register smallnumber Result; char t ;
scaled x ;
getxnext () ;
if ( curcmd == 62 )
{
getxnext () ;
scanexpression () ;
if ( ( curtype != 16 ) || ( curexp < 0 ) )
{
disperr ( 0 , 870 ) ;
{
helpptr = 1 ;
helpline [ 0 ] = 871 ;
}
putgetflusherror ( 65536L ) ;
}
t = 3 ;
}
else {
scanexpression () ;
if ( curtype > 14 )
{
if ( curtype != 16 )
{
disperr ( 0 , 864 ) ;
{
helpptr = 5 ;
helpline [ 4 ] = 865 ;
helpline [ 3 ] = 860 ;
helpline [ 2 ] = 861 ;
helpline [ 1 ] = 862 ;
helpline [ 0 ] = 863 ;
}
putgetflusherror ( 0 ) ;
}
x = curexp ;
if ( curcmd != 81 )
{
missingerr ( 44 ) ;
{
helpptr = 2 ;
helpline [ 1 ] = 872 ;
helpline [ 0 ] = 873 ;
}
backerror () ;
}
getxnext () ;
scanexpression () ;
if ( curtype != 16 )
{
disperr ( 0 , 866 ) ;
{
helpptr = 5 ;
helpline [ 4 ] = 867 ;
helpline [ 3 ] = 860 ;
helpline [ 2 ] = 861 ;
helpline [ 1 ] = 862 ;
helpline [ 0 ] = 863 ;
}
putgetflusherror ( 0 ) ;
}
cury = curexp ;
curx = x ;
}
else knownpair () ;
if ( ( curx == 0 ) && ( cury == 0 ) )
t = 4 ;
else {
t = 2 ;
curexp = narg ( curx , cury ) ;
}
}
if ( curcmd != 67 )
{
missingerr ( 125 ) ;
{
helpptr = 3 ;
helpline [ 2 ] = 868 ;
helpline [ 1 ] = 869 ;
helpline [ 0 ] = 739 ;
}
backerror () ;
}
getxnext () ;
Result = t ;
return(Result) ;
}
void finishread ( )
{poolpointer k ;
{
if ( poolptr + last - curinput .startfield > maxpoolptr )
if ( poolptr + last - curinput .startfield > poolsize )
docompaction ( last - curinput .startfield ) ;
else maxpoolptr = poolptr + last - curinput .startfield ;
}
{register integer for_end; k = curinput .startfield ; for_end = last - 1
; if ( k <= for_end) do
{
strpool [ poolptr ] = buffer [ k ] ;
incr ( poolptr ) ;
}
while ( k++ < for_end ) ; }
endfilereading () ;
curtype = 4 ;
curexp = makestring () ;
}
void zdonullary ( c )
quarterword c ;
{{
if ( aritherror )
cleararith () ;
}
if ( internal [ 6 ] > 131072L )
showcmdmod ( 35 , c ) ;
switch ( c )
{case 30 :
case 31 :
{
curtype = 2 ;
curexp = c ;
}
break ;
case 32 :
{
curtype = 10 ;
curexp = getnode ( 8 ) ;
initedges ( curexp ) ;
}
break ;
case 33 :
{
curtype = 6 ;
curexp = getpencircle ( 0 ) ;
}
break ;
case 37 :
{
curtype = 16 ;
curexp = normrand () ;
}
break ;
case 36 :
{
curtype = 6 ;
curexp = getpencircle ( 65536L ) ;
}
break ;
case 34 :
{
if ( jobname == 0 )
openlogfile () ;
curtype = 4 ;
curexp = jobname ;
}
break ;
case 35 :
{
if ( interaction <= 1 )
fatalerror ( 884 ) ;
beginfilereading () ;
curinput .namefield = 1 ;
curinput .limitfield = curinput .startfield ;
{
;
print ( 285 ) ;
terminput () ;
}
finishread () ;
}
break ;
}
{
if ( aritherror )
cleararith () ;
}
}
boolean znicepair ( p , t )
integer p ;
quarterword t ;
{/* 10 */ register boolean Result; if ( t == 14 )
{
p = mem [ p + 1 ] .cint ;
if ( mem [ p ] .hhfield .b0 == 16 )
if ( mem [ p + 2 ] .hhfield .b0 == 16 )
{
Result = true ;
goto lab10 ;
}
}
Result = false ;
lab10: ;
return(Result) ;
}
boolean znicecolororpair ( p , t )
integer p ;
quarterword t ;
{/* 10 */ register boolean Result; halfword q, r ;
if ( ( t != 14 ) && ( t != 13 ) )
Result = false ;
else {
q = mem [ p + 1 ] .cint ;
r = q + bignodesize [ mem [ p ] .hhfield .b0 ] ;
do {
r = r - 2 ;
if ( mem [ r ] .hhfield .b0 != 16 )
{
Result = false ;
goto lab10 ;
}
} while ( ! ( r == q ) ) ;
Result = true ;
}
lab10: ;
return(Result) ;
}
void zprintknownorunknowntype ( t , v )
smallnumber t ;
integer v ;
{printchar ( 40 ) ;
if ( t > 16 )
print ( 885 ) ;
else {
if ( ( t == 14 ) || ( t == 13 ) )
if ( ! nicecolororpair ( v , t ) )
print ( 886 ) ;
printtype ( t ) ;
}
printchar ( 41 ) ;
}
void zbadunary ( c )
quarterword c ;
{disperr ( 0 , 887 ) ;
printop ( c ) ;
printknownorunknowntype ( curtype , curexp ) ;
{
helpptr = 3 ;
helpline [ 2 ] = 888 ;
helpline [ 1 ] = 889 ;
helpline [ 0 ] = 890 ;
}
putgeterror () ;
}
void znegatedeplist ( p )
halfword p ;
{/* 10 */ while ( true ) {
mem [ p + 1 ] .cint = - (integer) mem [ p + 1 ] .cint ;
if ( mem [ p ] .hhfield .lhfield == 0 )
goto lab10 ;
p = mem [ p ] .hhfield .v.RH ;
}
lab10: ;
}
void pairtopath ( )
{curexp = newknot () ;
curtype = 8 ;
}
void ztakepart ( c )
quarterword c ;
{halfword p ;
p = mem [ curexp + 1 ] .cint ;
mem [ 10 ] .cint = p ;
mem [ 9 ] .hhfield .b0 = curtype ;
mem [ p ] .hhfield .v.RH = 9 ;
freenode ( curexp , 2 ) ;
makeexpcopy ( p + sectoroffset [ c - 48 ] ) ;
recyclevalue ( 9 ) ;
}
void ztakepictpart ( c )
quarterword c ;
{/* 10 45 */ halfword p ;
p = mem [ curexp + 7 ] .hhfield .v.RH ;
if ( p != 0 )
{
switch ( c )
{case 53 :
case 54 :
case 55 :
case 56 :
case 57 :
case 58 :
if ( mem [ p ] .hhfield .b0 == 3 )
flushcurexp ( mem [ p + c - 45 ] .cint ) ;
else goto lab45 ;
break ;
case 59 :
case 60 :
case 61 :
if ( ( mem [ p ] .hhfield .b0 < 4 ) )
flushcurexp ( mem [ p + c - 57 ] .cint ) ;
else goto lab45 ;
break ;
case 63 :
if ( mem [ p ] .hhfield .b0 != 3 )
goto lab45 ;
else {
flushcurexp ( mem [ p + 1 ] .hhfield .v.RH ) ;
{
if ( strref [ curexp ] < 127 )
incr ( strref [ curexp ] ) ;
}
curtype = 4 ;
}
break ;
case 62 :
if ( mem [ p ] .hhfield .b0 != 3 )
goto lab45 ;
else {
flushcurexp ( fontname [ mem [ p + 1 ] .hhfield .lhfield ] ) ;
{
if ( strref [ curexp ] < 127 )
incr ( strref [ curexp ] ) ;
}
curtype = 4 ;
}
break ;
case 64 :
if ( mem [ p ] .hhfield .b0 == 3 )
goto lab45 ;
else if ( ( mem [ p ] .hhfield .b0 >= 6 ) )
confusion ( 892 ) ;
else {
flushcurexp ( copypath ( mem [ p + 1 ] .hhfield .v.RH ) ) ;
curtype = 8 ;
}
break ;
case 65 :
if ( ! ( mem [ p ] .hhfield .b0 < 3 ) )
goto lab45 ;
else if ( mem [ p + 1 ] .hhfield .lhfield == 0 )
goto lab45 ;
else {
flushcurexp ( makepen ( copypath ( mem [ p + 1 ] .hhfield .lhfield ) , false ) ) ;
curtype = 6 ;
}
break ;
case 66 :
if ( mem [ p ] .hhfield .b0 != 2 )
goto lab45 ;
else if ( mem [ p + 6 ] .hhfield .v.RH == 0 )
goto lab45 ;
else {
flushcurexp ( mem [ p + 6 ] .hhfield .v.RH ) ;
incr ( mem [ curexp ] .hhfield .lhfield ) ;
curtype = 10 ;
}
break ;
}
goto lab10 ;
}
lab45: switch ( c )
{case 63 :
case 62 :
{
flushcurexp ( 285 ) ;
curtype = 4 ;
}
break ;
case 64 :
{
flushcurexp ( getnode ( 7 ) ) ;
mem [ curexp ] .hhfield .b0 = 0 ;
mem [ curexp ] .hhfield .b1 = 0 ;
mem [ curexp ] .hhfield .v.RH = curexp ;
mem [ curexp + 1 ] .cint = 0 ;
mem [ curexp + 2 ] .cint = 0 ;
curtype = 8 ;
}
break ;
case 65 :
{
flushcurexp ( getpencircle ( 0 ) ) ;
curtype = 6 ;
}
break ;
case 66 :
{
flushcurexp ( getnode ( 8 ) ) ;
initedges ( curexp ) ;
curtype = 10 ;
}
break ;
default:
flushcurexp ( 0 ) ;
break ;
}
lab10: ;
}
void zstrtonum ( c )
quarterword c ;
{integer n ;
ASCIIcode m ;
poolpointer k ;
char b ;
boolean badchar ;
if ( c == 49 )
if ( ( strstart [ nextstr [ curexp ] ] - strstart [ curexp ] ) == 0 )
n = -1 ;
else n = strpool [ strstart [ curexp ] ] ;
else {
if ( c == 47 )
b = 8 ;
else b = 16 ;
n = 0 ;
badchar = false ;
{register integer for_end; k = strstart [ curexp ] ; for_end = strstart [
nextstr [ curexp ] ] - 1 ; if ( k <= for_end) do
{
m = strpool [ k ] ;
if ( ( m >= 48 ) && ( m <= 57 ) )
m = m - 48 ;
else if ( ( m >= 65 ) && ( m <= 70 ) )
m = m - 55 ;
else if ( ( m >= 97 ) && ( m <= 102 ) )
m = m - 87 ;
else {
badchar = true ;
m = 0 ;
}
if ( m >= b )
{
badchar = true ;
m = 0 ;
}
if ( n < 32768L / b )
n = n * b + m ;
else n = 32767 ;
}
while ( k++ < for_end ) ; }
if ( badchar )
{
disperr ( 0 , 893 ) ;
if ( c == 47 )
{
helpptr = 1 ;
helpline [ 0 ] = 894 ;
}
else {
helpptr = 1 ;
helpline [ 0 ] = 895 ;
}
putgeterror () ;
}
if ( ( n > 4095 ) )
if ( internal [ 30 ] > 0 )
{
{
if ( interaction == 3 )
;
printnl ( 263 ) ;
print ( 896 ) ;
}
printint ( n ) ;
printchar ( 41 ) ;
{
helpptr = 2 ;
helpline [ 1 ] = 897 ;
helpline [ 0 ] = 606 ;
}
putgeterror () ;
}
}
flushcurexp ( n * 65536L ) ;
}
scaled pathlength ( )
{register scaled Result; scaled n ;
halfword p ;
p = curexp ;
if ( mem [ p ] .hhfield .b0 == 0 )
n = -65536L ;
else n = 0 ;
do {
p = mem [ p ] .hhfield .v.RH ;
n = n + 65536L ;
} while ( ! ( p == curexp ) ) ;
Result = n ;
return(Result) ;
}
scaled pictlength ( )
{/* 40 */ register scaled Result; scaled n ;
halfword p ;
n = 0 ;
p = mem [ curexp + 7 ] .hhfield .v.RH ;
if ( p != 0 )
{
if ( ( mem [ p ] .hhfield .b0 >= 4 ) )
if ( skip1component ( p ) == 0 )
p = mem [ p ] .hhfield .v.RH ;
while ( p != 0 ) {
if ( ! ( mem [ p ] .hhfield .b0 >= 4 ) )
p = mem [ p ] .hhfield .v.RH ;
else if ( ! ( mem [ p ] .hhfield .b0 >= 6 ) )
p = skip1component ( p ) ;
else goto lab40 ;
n = n + 65536L ;
}
}
lab40: Result = n ;
return(Result) ;
}
scaled zcountturns ( c )
halfword c ;
{register scaled Result; halfword p ;
integer t ;
t = 0 ;
p = c ;
do {
t = t + mem [ p ] .hhfield .lhfield - 16384 ;
p = mem [ p ] .hhfield .v.RH ;
} while ( ! ( p == c ) ) ;
Result = ( t / 3 ) * 65536L ;
return(Result) ;
}
void ztestknown ( c )
quarterword c ;
{/* 30 */ char b ;
halfword p, q ;
b = 31 ;
switch ( curtype )
{case 1 :
case 2 :
case 4 :
case 6 :
case 8 :
case 10 :
case 16 :
b = 30 ;
break ;
case 12 :
case 13 :
case 14 :
{
p = mem [ curexp + 1 ] .cint ;
q = p + bignodesize [ curtype ] ;
do {
q = q - 2 ;
if ( mem [ q ] .hhfield .b0 != 16 )
goto lab30 ;
} while ( ! ( q == p ) ) ;
b = 30 ;
lab30: ;
}
break ;
default:
;
break ;
}
if ( c == 40 )
flushcurexp ( b ) ;
else flushcurexp ( 61 - b ) ;
curtype = 2 ;
}
void zpairvalue ( x , y )
scaled x ;
scaled y ;
{halfword p ;
p = getnode ( 2 ) ;
flushcurexp ( p ) ;
curtype = 14 ;
mem [ p ] .hhfield .b0 = 14 ;
mem [ p ] .hhfield .b1 = 14 ;
initbignode ( p ) ;
p = mem [ p + 1 ] .cint ;
mem [ p ] .hhfield .b0 = 16 ;
mem [ p + 1 ] .cint = x ;
mem [ p + 2 ] .hhfield .b0 = 16 ;
mem [ p + 3 ] .cint = y ;
}
boolean getcurbbox ( )
{/* 10 */ register boolean Result; switch ( curtype )
{case 10 :
{
setbbox ( curexp , true ) ;
if ( mem [ curexp + 2 ] .cint > mem [ curexp + 4 ] .cint )
{
bbmin [ 0 ] = 0 ;
bbmax [ 0 ] = 0 ;
bbmin [ 1 ] = 0 ;
bbmax [ 1 ] = 0 ;
}
else {
bbmin [ 0 ] = mem [ curexp + 2 ] .cint ;
bbmax [ 0 ] = mem [ curexp + 4 ] .cint ;
bbmin [ 1 ] = mem [ curexp + 3 ] .cint ;
bbmax [ 1 ] = mem [ curexp + 5 ] .cint ;
}
}
break ;
case 8 :
pathbbox ( curexp ) ;
break ;
case 6 :
penbbox ( curexp ) ;
break ;
default:
{
Result = false ;
goto lab10 ;
}
break ;
}
Result = true ;
lab10: ;
return(Result) ;
}
void doreadfrom ( )
{/* 10 22 40 45 */ readfindex n, n0 ;
n = readfiles ;
n0 = readfiles ;
do {
lab22: if ( n > 0 )
decr ( n ) ;
else {
if ( n0 == readfiles )
if ( readfiles < maxreadfiles )
incr ( readfiles ) ;
else overflow ( 899 , maxreadfiles ) ;
n = n0 ;
if ( startreadinput ( curexp , n ) )
goto lab40 ;
else goto lab45 ;
}
if ( rdfname [ n ] == 0 )
{
n0 = n ;
goto lab22 ;
}
} while ( ! ( strvsstr ( curexp , rdfname [ n ] ) == 0 ) ) ;
beginfilereading () ;
curinput .namefield = 1 ;
if ( inputln ( rdfile [ n ] , true ) )
goto lab40 ;
endfilereading () ;
lab45: aclose ( rdfile [ n ] ) ;
{
if ( strref [ rdfname [ n ] ] < 127 )
if ( strref [ rdfname [ n ] ] > 1 )
decr ( strref [ rdfname [ n ] ] ) ;
else flushstring ( rdfname [ n ] ) ;
}
rdfname [ n ] = 0 ;
if ( n == readfiles - 1 )
readfiles = n ;
if ( eofline == 0 )
{
{
strpool [ poolptr ] = 0 ;
incr ( poolptr ) ;
}
eofline = makestring () ;
strref [ eofline ] = 127 ;
}
flushcurexp ( eofline ) ;
curtype = 4 ;
goto lab10 ;
lab40: flushcurexp ( 0 ) ;
finishread () ;
lab10: ;
}
void zdounary ( c )
quarterword c ;
{halfword p, q, r ;
integer x ;
{
if ( aritherror )
cleararith () ;
}
if ( internal [ 6 ] > 131072L )
{
begindiagnostic () ;
printnl ( 123 ) ;
printop ( c ) ;
printchar ( 40 ) ;
printexp ( 0 , 0 ) ;
print ( 891 ) ;
enddiagnostic ( false ) ;
}
switch ( c )
{case 88 :
if ( curtype < 13 )
badunary ( 88 ) ;
break ;
case 89 :
switch ( curtype )
{case 13 :
case 14 :
case 19 :
{
q = curexp ;
makeexpcopy ( q ) ;
if ( curtype == 17 )
negatedeplist ( mem [ curexp + 1 ] .hhfield .v.RH ) ;
else if ( curtype <= 14 )
{
p = mem [ curexp + 1 ] .cint ;
r = p + bignodesize [ curtype ] ;
do {
r = r - 2 ;
if ( mem [ r ] .hhfield .b0 == 16 )
mem [ r + 1 ] .cint = - (integer) mem [ r + 1 ] .cint ;
else negatedeplist ( mem [ r + 1 ] .hhfield .v.RH ) ;
} while ( ! ( r == p ) ) ;
}
recyclevalue ( q ) ;
freenode ( q , 2 ) ;
}
break ;
case 17 :
case 18 :
negatedeplist ( mem [ curexp + 1 ] .hhfield .v.RH ) ;
break ;
case 16 :
curexp = - (integer) curexp ;
break ;
default:
badunary ( 89 ) ;
break ;
}
break ;
case 42 :
if ( curtype != 2 )
badunary ( 42 ) ;
else curexp = 61 - curexp ;
break ;
case 67 :
case 68 :
case 69 :
case 70 :
case 71 :
case 72 :
case 73 :
case 39 :
case 74 :
if ( curtype != 16 )
badunary ( c ) ;
else switch ( c )
{case 67 :
curexp = squarert ( curexp ) ;
break ;
case 68 :
curexp = mexp ( curexp ) ;
break ;
case 69 :
curexp = mlog ( curexp ) ;
break ;
case 70 :
case 71 :
{
nsincos ( ( curexp % 23592960L ) * 16 ) ;
if ( c == 70 )
curexp = roundfraction ( nsin ) ;
else curexp = roundfraction ( ncos ) ;
}
break ;
case 72 :
curexp = floorscaled ( curexp ) ;
break ;
case 73 :
curexp = unifrand ( curexp ) ;
break ;
case 39 :
{
if ( odd ( roundunscaled ( curexp ) ) )
curexp = 30 ;
else curexp = 31 ;
curtype = 2 ;
}
break ;
case 74 :
{
curexp = roundunscaled ( curexp ) % 256 ;
if ( curexp < 0 )
curexp = curexp + 256 ;
if ( charexists [ curexp ] )
curexp = 30 ;
else curexp = 31 ;
curtype = 2 ;
}
break ;
}
break ;
case 81 :
if ( nicepair ( curexp , curtype ) )
{
p = mem [ curexp + 1 ] .cint ;
x = narg ( mem [ p + 1 ] .cint , mem [ p + 3 ] .cint ) ;
if ( x >= 0 )
flushcurexp ( ( x + 8 ) / 16 ) ;
else flushcurexp ( - (integer) ( ( - (integer) x + 8 ) / 16 ) ) ;
}
else badunary ( 81 ) ;
break ;
case 53 :
case 54 :
if ( ( curtype == 14 ) || ( curtype == 12 ) )
takepart ( c ) ;
else if ( curtype == 10 )
takepictpart ( c ) ;
else badunary ( c ) ;
break ;
case 55 :
case 56 :
case 57 :
case 58 :
if ( curtype == 12 )
takepart ( c ) ;
else if ( curtype == 10 )
takepictpart ( c ) ;
else badunary ( c ) ;
break ;
case 59 :
case 60 :
case 61 :
if ( curtype == 13 )
takepart ( c ) ;
else if ( curtype == 10 )
takepictpart ( c ) ;
else badunary ( c ) ;
break ;
case 62 :
case 63 :
case 64 :
case 65 :
case 66 :
if ( curtype == 10 )
takepictpart ( c ) ;
else badunary ( c ) ;
break ;
case 50 :
if ( curtype != 16 )
badunary ( 50 ) ;
else {
curexp = roundunscaled ( curexp ) % 256 ;
curtype = 4 ;
if ( curexp < 0 )
curexp = curexp + 256 ;
if ( ( strstart [ nextstr [ curexp ] ] - strstart [ curexp ] ) != 1 )
{
{
if ( poolptr + 1 > maxpoolptr )
if ( poolptr + 1 > poolsize )
docompaction ( 1 ) ;
else maxpoolptr = poolptr + 1 ;
}
{
strpool [ poolptr ] = curexp ;
incr ( poolptr ) ;
}
curexp = makestring () ;
}
}
break ;
case 43 :
if ( curtype != 16 )
badunary ( 43 ) ;
else {
oldsetting = selector ;
selector = 10 ;
printscaled ( curexp ) ;
curexp = makestring () ;
selector = oldsetting ;
curtype = 4 ;
}
break ;
case 47 :
case 48 :
case 49 :
if ( curtype != 4 )
badunary ( c ) ;
else strtonum ( c ) ;
break ;
case 75 :
if ( curtype != 4 )
badunary ( 75 ) ;
else flushcurexp ( ( fontdsize [ findfont ( curexp ) ] + 8 ) / 16 ) ;
break ;
case 51 :
switch ( curtype )
{case 4 :
flushcurexp ( ( strstart [ nextstr [ curexp ] ] - strstart [ curexp ] )
* 65536L ) ;
break ;
case 8 :
flushcurexp ( pathlength () ) ;
break ;
case 16 :
curexp = abs ( curexp ) ;
break ;
case 10 :
flushcurexp ( pictlength () ) ;
break ;
default:
if ( nicepair ( curexp , curtype ) )
flushcurexp ( pythadd ( mem [ mem [ curexp + 1 ] .cint + 1 ] .cint , mem
[ mem [ curexp + 1 ] .cint + 3 ] .cint ) ) ;
else badunary ( c ) ;
break ;
}
break ;
case 52 :
if ( curtype == 14 )
flushcurexp ( 0 ) ;
else if ( curtype != 8 )
badunary ( 52 ) ;
else if ( mem [ curexp ] .hhfield .b0 == 0 )
flushcurexp ( 0 ) ;
else {
curexp = offsetprep ( curexp , 13 ) ;
if ( internal [ 5 ] > 65536L )
printspec ( curexp , 13 , 898 ) ;
flushcurexp ( countturns ( curexp ) ) ;
}
break ;
case 2 :
{
if ( ( curtype >= 2 ) && ( curtype <= 3 ) )
flushcurexp ( 30 ) ;
else flushcurexp ( 31 ) ;
curtype = 2 ;
}
break ;
case 4 :
{
if ( ( curtype >= 4 ) && ( curtype <= 5 ) )
flushcurexp ( 30 ) ;
else flushcurexp ( 31 ) ;
curtype = 2 ;
}
break ;
case 6 :
{
if ( ( curtype >= 6 ) && ( curtype <= 7 ) )
flushcurexp ( 30 ) ;
else flushcurexp ( 31 ) ;
curtype = 2 ;
}
break ;
case 8 :
{
if ( ( curtype >= 8 ) && ( curtype <= 9 ) )
flushcurexp ( 30 ) ;
else flushcurexp ( 31 ) ;
curtype = 2 ;
}
break ;
case 10 :
{
if ( ( curtype >= 10 ) && ( curtype <= 11 ) )
flushcurexp ( 30 ) ;
else flushcurexp ( 31 ) ;
curtype = 2 ;
}
break ;
case 12 :
case 13 :
case 14 :
{
if ( curtype == c )
flushcurexp ( 30 ) ;
else flushcurexp ( 31 ) ;
curtype = 2 ;
}
break ;
case 15 :
{
if ( ( curtype >= 16 ) && ( curtype <= 19 ) )
flushcurexp ( 30 ) ;
else flushcurexp ( 31 ) ;
curtype = 2 ;
}
break ;
case 40 :
case 41 :
testknown ( c ) ;
break ;
case 82 :
{
if ( curtype != 8 )
flushcurexp ( 31 ) ;
else if ( mem [ curexp ] .hhfield .b0 != 0 )
flushcurexp ( 30 ) ;
else flushcurexp ( 31 ) ;
curtype = 2 ;
}
break ;
case 80 :
{
if ( curtype == 14 )
pairtopath () ;
if ( curtype != 8 )
badunary ( 80 ) ;
else flushcurexp ( getarclength ( curexp ) ) ;
}
break ;
case 83 :
case 84 :
case 85 :
case 86 :
case 87 :
{
if ( curtype != 10 )
flushcurexp ( 31 ) ;
else if ( mem [ curexp + 7 ] .hhfield .v.RH == 0 )
flushcurexp ( 31 ) ;
else if ( mem [ mem [ curexp + 7 ] .hhfield .v.RH ] .hhfield .b0 == c -
82 )
flushcurexp ( 30 ) ;
else flushcurexp ( 31 ) ;
curtype = 2 ;
}
break ;
case 46 :
{
if ( curtype == 14 )
pairtopath () ;
if ( curtype != 8 )
badunary ( 46 ) ;
else {
curtype = 6 ;
curexp = makepen ( curexp , true ) ;
}
}
break ;
case 45 :
if ( curtype != 6 )
badunary ( 45 ) ;
else {
curtype = 8 ;
makepath ( curexp ) ;
}
break ;
case 44 :
if ( curtype == 8 )
{
p = htapypoc ( curexp ) ;
if ( mem [ p ] .hhfield .b1 == 0 )
p = mem [ p ] .hhfield .v.RH ;
tossknotlist ( curexp ) ;
curexp = p ;
}
else if ( curtype == 14 )
pairtopath () ;
else badunary ( 44 ) ;
break ;
case 76 :
if ( ! getcurbbox () )
badunary ( 76 ) ;
else pairvalue ( bbmin [ 0 ] , bbmin [ 1 ] ) ;
break ;
case 77 :
if ( ! getcurbbox () )
badunary ( 77 ) ;
else pairvalue ( bbmax [ 0 ] , bbmin [ 1 ] ) ;
break ;
case 78 :
if ( ! getcurbbox () )
badunary ( 78 ) ;
else pairvalue ( bbmin [ 0 ] , bbmax [ 1 ] ) ;
break ;
case 79 :
if ( ! getcurbbox () )
badunary ( 79 ) ;
else pairvalue ( bbmax [ 0 ] , bbmax [ 1 ] ) ;
break ;
case 38 :
if ( curtype != 4 )
badunary ( 38 ) ;
else doreadfrom () ;
break ;
}
{
if ( aritherror )
cleararith () ;
}
}
void zbadbinary ( p , c )
halfword p ;
quarterword c ;
{disperr ( p , 285 ) ;
disperr ( 0 , 887 ) ;
if ( c >= 114 )
printop ( c ) ;
printknownorunknowntype ( mem [ p ] .hhfield .b0 , p ) ;
if ( c >= 114 )
print ( 489 ) ;
else printop ( c ) ;
printknownorunknowntype ( curtype , curexp ) ;
{
helpptr = 3 ;
helpline [ 2 ] = 888 ;
helpline [ 1 ] = 900 ;
helpline [ 0 ] = 901 ;
}
putgeterror () ;
}
halfword ztarnished ( p )
halfword p ;
{/* 10 */ register halfword Result; halfword q ;
halfword r ;
q = mem [ p + 1 ] .cint ;
r = q + bignodesize [ mem [ p ] .hhfield .b0 ] ;
do {
r = r - 2 ;
if ( mem [ r ] .hhfield .b0 == 19 )
{
Result = 1 ;
goto lab10 ;
}
} while ( ! ( r == q ) ) ;
Result = 0 ;
lab10: ;
return(Result) ;
}
void zdepfinish ( v , q , t )
halfword v ;
halfword q ;
smallnumber t ;
{halfword p ;
scaled vv ;
if ( q == 0 )
p = curexp ;
else p = q ;
mem [ p + 1 ] .hhfield .v.RH = v ;
mem [ p ] .hhfield .b0 = t ;
if ( mem [ v ] .hhfield .lhfield == 0 )
{
vv = mem [ v + 1 ] .cint ;
if ( q == 0 )
flushcurexp ( vv ) ;
else {
recyclevalue ( p ) ;
mem [ q ] .hhfield .b0 = 16 ;
mem [ q + 1 ] .cint = vv ;
}
}
else if ( q == 0 )
curtype = t ;
if ( fixneeded )
fixdependencies () ;
}
void zaddorsubtract ( p , q , c )
halfword p ;
halfword q ;
quarterword c ;
{/* 30 10 */ smallnumber s, t ;
halfword r ;
integer v ;
if ( q == 0 )
{
t = curtype ;
if ( t < 17 )
v = curexp ;
else v = mem [ curexp + 1 ] .hhfield .v.RH ;
}
else {
t = mem [ q ] .hhfield .b0 ;
if ( t < 17 )
v = mem [ q + 1 ] .cint ;
else v = mem [ q + 1 ] .hhfield .v.RH ;
}
if ( t == 16 )
{
if ( c == 89 )
v = - (integer) v ;
if ( mem [ p ] .hhfield .b0 == 16 )
{
v = slowadd ( mem [ p + 1 ] .cint , v ) ;
if ( q == 0 )
curexp = v ;
else mem [ q + 1 ] .cint = v ;
goto lab10 ;
}
r = mem [ p + 1 ] .hhfield .v.RH ;
while ( mem [ r ] .hhfield .lhfield != 0 ) r = mem [ r ] .hhfield .v.RH ;
mem [ r + 1 ] .cint = slowadd ( mem [ r + 1 ] .cint , v ) ;
if ( q == 0 )
{
q = getnode ( 2 ) ;
curexp = q ;
curtype = mem [ p ] .hhfield .b0 ;
mem [ q ] .hhfield .b1 = 14 ;
}
mem [ q + 1 ] .hhfield .v.RH = mem [ p + 1 ] .hhfield .v.RH ;
mem [ q ] .hhfield .b0 = mem [ p ] .hhfield .b0 ;
mem [ q + 1 ] .hhfield .lhfield = mem [ p + 1 ] .hhfield .lhfield ;
mem [ mem [ p + 1 ] .hhfield .lhfield ] .hhfield .v.RH = q ;
mem [ p ] .hhfield .b0 = 16 ;
}
else {
if ( c == 89 )
negatedeplist ( v ) ;
if ( mem [ p ] .hhfield .b0 == 16 )
{
while ( mem [ v ] .hhfield .lhfield != 0 ) v = mem [ v ] .hhfield .v.RH
;
mem [ v + 1 ] .cint = slowadd ( mem [ p + 1 ] .cint , mem [ v + 1 ] .cint ) ;
}
else {
s = mem [ p ] .hhfield .b0 ;
r = mem [ p + 1 ] .hhfield .v.RH ;
if ( t == 17 )
{
if ( s == 17 )
if ( maxcoef ( r ) + maxcoef ( v ) < 626349397L )
{
v = pplusq ( v , r , 17 ) ;
goto lab30 ;
}
t = 18 ;
v = poverv ( v , 65536L , 17 , 18 ) ;
}
if ( s == 18 )
v = pplusq ( v , r , 18 ) ;
else v = pplusfq ( v , 65536L , r , 18 , 17 ) ;
lab30: if ( q != 0 )
depfinish ( v , q , t ) ;
else {
curtype = t ;
depfinish ( v , 0 , t ) ;
}
}
}
lab10: ;
}
void zdepmult ( p , v , visscaled )
halfword p ;
integer v ;
boolean visscaled ;
{/* 10 */ halfword q ;
smallnumber s, t ;
if ( p == 0 )
q = curexp ;
else if ( mem [ p ] .hhfield .b0 != 16 )
q = p ;
else {
if ( visscaled )
mem [ p + 1 ] .cint = takescaled ( mem [ p + 1 ] .cint , v ) ;
else mem [ p + 1 ] .cint = takefraction ( mem [ p + 1 ] .cint , v ) ;
goto lab10 ;
}
t = mem [ q ] .hhfield .b0 ;
q = mem [ q + 1 ] .hhfield .v.RH ;
s = t ;
if ( t == 17 )
if ( visscaled )
if ( abvscd ( maxcoef ( q ) , abs ( v ) , 626349396L , 65536L ) >= 0 )
t = 18 ;
q = ptimesv ( q , v , s , t , visscaled ) ;
depfinish ( q , p , t ) ;
lab10: ;
}
void zhardtimes ( p )
halfword p ;
{/* 30 */ halfword q ;
halfword r ;
scaled v ;
if ( mem [ p ] .hhfield .b0 <= 14 )
{
q = stashcurexp () ;
unstashcurexp ( p ) ;
p = q ;
}
r = mem [ curexp + 1 ] .cint + bignodesize [ curtype ] ;
while ( true ) {
r = r - 2 ;
v = mem [ r + 1 ] .cint ;
mem [ r ] .hhfield .b0 = mem [ p ] .hhfield .b0 ;
if ( r == mem [ curexp + 1 ] .cint )
goto lab30 ;
newdep ( r , copydeplist ( mem [ p + 1 ] .hhfield .v.RH ) ) ;
depmult ( r , v , true ) ;
}
lab30: mem [ r + 1 ] = mem [ p + 1 ] ;
mem [ mem [ p + 1 ] .hhfield .lhfield ] .hhfield .v.RH = r ;
freenode ( p , 2 ) ;
depmult ( r , v , true ) ;
}