{4:}{9:} [inherit('sys$library:starlet')] {:9}PROGRAM MF;LABEL{6:}1,9998,9999;{:6}CONST{11:}MEMMAX=65534; MAXINTERNAL=100;BUFSIZE=500;ERRORLINE=72;HALFERRORLIN=42; MAXPRINTLINE=79;STACKSIZE=30;MAXSTRINGS=2000;STRINGVACANC=8000; POOLSIZE=32000;MOVESIZE=5000;MAXWIGGLE=300;GFBUFSIZE=1024; VAXBLOCKLENG=512;FILENAMESIZE=255;PATHSIZE=300;BISTACKSIZE=785; HEADERSIZE=100;LIGTABLESIZE=5000;MAXKERNS=500;MAXFONTDIMEN=50;{:11} TYPE{18:}ASCIICODE=0..255;{:18}{24:}EIGHTBITS=0..255;ALPHAFILE= text ; BYTEBLOCK=PACKED ARRAY[0..VAXBLOCKLENG-1]OF EIGHTBITS; BYTEFILE=PACKED FILE OF BYTEBLOCK;{:24}{37:}POOLPOINTER=0..POOLSIZE; STRNUMBER=0..MAXSTRINGS;PACKEDASCIIC=0..255;{:37}{101:}SCALED=INTEGER; SMALLNUMBER=0..63;{:101}{105:}FRACTION=INTEGER;{:105}{106:} ANGLE=INTEGER;{:106}{156:}QUARTERWORD=0..255;HALFWORD=0..65535; TWOCHOICES=1..2;THREECHOICES=1..3;TWOHALVES=PACKED RECORD RH:HALFWORD; CASE TWOCHOICES OF 1:(LH:HALFWORD);2:(B0:QUARTERWORD;B1:QUARTERWORD); END;FOURQUARTERS=PACKED RECORD B0:QUARTERWORD;B1:QUARTERWORD; B2:QUARTERWORD;B3:QUARTERWORD;END; MEMORYWORD=RECORD CASE THREECHOICES OF 1:(INT:INTEGER);2:(HH:TWOHALVES); 3:(QQQQ:FOURQUARTERS);END; WORDBLOCK=PACKED ARRAY[0..VAXBLOCKLENG-1]OF MEMORYWORD; WORDFILE=PACKED FILE OF WORDBLOCK;{:156}{186:}COMMANDCODE=1..85;{:186} {565:}SCREENROW=INTEGER;SCREENCOL=INTEGER; TRANSSPEC=ARRAY[0..65536]OF SCREENCOL;PIXELCOLOR=0..1;{:565}{571:} WINDOWNUMBER=0..15;{:571}{627:} INSTATERECOR=RECORD INDEXFIELD:QUARTERWORD; STARTFIELD,LOCFIELD,LIMITFIELD,NAMEFIELD:HALFWORD;END;{:627}{1151:} GFINDEX=0..GFBUFSIZE;{:1151}{1235:}SIGNEDHALFWO=[ word ]-32768..32767; SIXTEENBITS=[ word ]0..65535;FILESIZE=[ word ]0..FILENAMESIZE;{:1235} {1238:}UNSAFEFILE=[UNSAFE]FILE OF CHAR;FABPTR=^ FAB$type ; RABPTR=^ RAB$type ;NAMPTR=^ NAM$type ;CHRPTR=^CHAR;{:1238}{1242:} VMSITEMLIST=PACKED RECORD CASE BOOLEAN OF TRUE:(BUFFERLENGTH:SIXTEENBITS ;ITEMCODE:SIXTEENBITS;BUFFERADDR:[ long ]INTEGER; RETLENADDR:[ long ]INTEGER);FALSE:(NEXTITEM:[ long ]INTEGER)END;{:1242} {1246:}DESCRTYPE=PACKED RECORD LEN:SIXTEENBITS;DESCTYPE:EIGHTBITS; DESCCLASS:EIGHTBITS;STRING:[ long ]INTEGER;END;DESCRPTR=^DESCRTYPE; {:1246}{1248:} EDITORIDENT=PACKED RECORD LOGICAL:PACKED ARRAY[1..FILENAMESIZE]OF CHAR; IMAGE,ENTRY,QUITTING,EXITING,CMDTEXT:STRNUMBER;CMDOFFSET:INTEGER; STARTQUAL,EDTLIKE:BOOLEAN END;{:1248}{1251:} EDITRESULT=(FAILED,QUIT,EDITED);{:1251}VAR{13:}BAD:INTEGER;{:13}{20:} XORD:ARRAY[CHAR]OF ASCIICODE;XCHR:ARRAY[ASCIICODE]OF CHAR;{:20}{25:} NAMEOFFILE,DEFAULTNAME:PACKED ARRAY[1..FILENAMESIZE]OF CHAR; NAMELENGTH,DEFLTLENGTH:FILESIZE;{:25}{29:}AUXBUF:VARYING[133]OF CHAR; BUFFER:ARRAY[0..BUFSIZE]OF ASCIICODE;FIRST:0..BUFSIZE;LAST:0..BUFSIZE; MAXBUFSTACK:0..BUFSIZE;{:29}{31:}TERMIN:ALPHAFILE;TERMOUT:ALPHAFILE; {:31}{38:}STRPOOL:PACKED ARRAY[POOLPOINTER]OF PACKEDASCIIC; STRSTART:ARRAY[STRNUMBER]OF POOLPOINTER;POOLPTR:POOLPOINTER; STRPTR:STRNUMBER;INITPOOLPTR:POOLPOINTER;INITSTRPTR:STRNUMBER; MAXPOOLPTR:POOLPOINTER;MAXSTRPTR:STRNUMBER;{:38}{42:} STRREF:ARRAY[STRNUMBER]OF 0..127;{:42}{50:}POOLFILE:ALPHAFILE;{:50}{54:} LOGFILE:ALPHAFILE;AUXFILE:ALPHAFILE;SELECTOR:0..6; DIG:ARRAY[0..22]OF 0..15;TALLY:INTEGER;TERMOFFSET:0..MAXPRINTLINE; FILEOFFSET:0..MAXPRINTLINE;TRICKBUF:ARRAY[0..ERRORLINE]OF ASCIICODE; TRICKCOUNT:INTEGER;FIRSTCOUNT:INTEGER;{:54}{68:}INTERACTION:0..3;{:68} {71:}DELETIONSALL:BOOLEAN;HISTORY:0..3;ERRORCOUNT:-1..100;{:71}{74:} HELPLINE:ARRAY[0..5]OF STRNUMBER;HELPPTR:0..6;USEERRHELP:BOOLEAN; ERRHELP:STRNUMBER;{:74}{91:}INTERRUPT:[ volatile ]INTEGER; OKTOINTERRUP:BOOLEAN;{:91}{97:}ARITHERROR:[global]BOOLEAN;{:97}{129:} TWOTOTHE:ARRAY[0..30]OF INTEGER;SPECLOG:ARRAY[1..28]OF INTEGER;{:129} {137:}SPECATAN:ARRAY[1..26]OF ANGLE;{:137}{144:}NSIN,NCOS:FRACTION; {:144}{148:}RANDOMS:ARRAY[0..54]OF FRACTION;JRANDOM:0..54;{:148}{159:} MEM:ARRAY[0..MEMMAX]OF MEMORYWORD;LOMEMMAX:HALFWORD;HIMEMMIN:HALFWORD; {:159}{160:}VARUSED,DYNUSED:INTEGER;{:160}{161:}AVAIL:HALFWORD; MEMEND:HALFWORD;{:161}{166:}ROVER:HALFWORD;{:166}{178:} {FREE:PACKED ARRAY[0..MEMMAX]OF BOOLEAN; WASFREE:PACKED ARRAY[0..MEMMAX]OF BOOLEAN; WASMEMEND,WASLOMAX,WASHIMIN:HALFWORD;PANICKING:BOOLEAN;}{:178}{190:} INTERNAL:ARRAY[1..MAXINTERNAL]OF SCALED; INTNAME:ARRAY[1..MAXINTERNAL]OF STRNUMBER;INTPTR:41..MAXINTERNAL;{:190} {196:}OLDSETTING:0..6;{:196}{198:}CHARCLASS:ARRAY[ASCIICODE]OF 0..20; {:198}{200:}HASHUSED:HALFWORD;STCOUNT:INTEGER;{:200}{201:} HASH:ARRAY[1..2369]OF TWOHALVES;EQTB:ARRAY[1..2369]OF TWOHALVES;{:201} {225:}GPOINTER:HALFWORD;{:225}{230:} BIGNODESIZE:ARRAY[13..14]OF SMALLNUMBER;{:230}{250:}SAVEPTR:HALFWORD; {:250}{267:}PATHTAIL:HALFWORD;{:267}{279:} DELTAX,DELTAY,DELTA:ARRAY[0..PATHSIZE]OF SCALED; PSI:ARRAY[1..PATHSIZE]OF ANGLE;{:279}{283:} THETA:ARRAY[0..PATHSIZE]OF ANGLE;UU:ARRAY[0..PATHSIZE]OF FRACTION; VV:ARRAY[0..PATHSIZE]OF ANGLE;WW:ARRAY[0..PATHSIZE]OF FRACTION;{:283} {298:}ST,CT,SF,CF:FRACTION;{:298}{308:} MOVE:ARRAY[0..MOVESIZE]OF INTEGER;MOVEPTR:0..MOVESIZE;{:308}{309:} BISECTSTACK:ARRAY[0..BISTACKSIZE]OF INTEGER;BISECTPTR:0..BISTACKSIZE; {:309}{327:}CUREDGES:HALFWORD;CURWT:INTEGER;{:327}{371:}TRACEX:INTEGER; TRACEY:INTEGER;TRACEYY:INTEGER;{:371}{379:}OCTANT:1..8;{:379}{389:} CURX,CURY:SCALED;{:389}{395:}OCTANTDIR:ARRAY[1..8]OF STRNUMBER;{:395} {403:}CURSPEC:HALFWORD;TURNINGNUMBE:INTEGER;CURPEN:HALFWORD; CURPATHTYPE:0..1;MAXALLOWED:SCALED;{:403}{427:} BEFORE,AFTER:ARRAY[0..MAXWIGGLE]OF SCALED; NODETOROUND:ARRAY[0..MAXWIGGLE]OF HALFWORD;CURROUNDINGP:0..MAXWIGGLE; MAXROUNDINGP:0..MAXWIGGLE;{:427}{430:}CURGRAN:SCALED;{:430}{448:} OCTANTNUMBER:ARRAY[1..8]OF 1..8;OCTANTCODE:ARRAY[1..8]OF 1..8;{:448} {455:}REVTURNS:BOOLEAN;{:455}{461:} YCORR,XYCORR,ZCORR:ARRAY[1..8]OF 0..1;XCORR:ARRAY[1..8]OF-1..1;{:461} {464:}M0,N0,M1,N1:INTEGER;D0,D1:0..1;{:464}{507:} ENVMOVE:ARRAY[0..MOVESIZE]OF INTEGER;{:507}{552:}TOLSTEP:0..6;{:552} {555:}CURT,CURTT:INTEGER;TIMETOGO:INTEGER;MAXT:INTEGER;{:555}{557:} DELX,DELY:INTEGER;TOL:INTEGER;UV,XY:0..BISTACKSIZE;THREEL:INTEGER; APPRT,APPRTT:INTEGER;{:557}{568:} STARTENTRY,BLANKENTRY,DRAWENTRY,UPDATEENTRY,CLOSEENTRY:INTEGER; DISPLAYAVAIL:BOOLEAN;SCREENDEPTH:SCREENROW;SCREENWIDTH:SCREENCOL;{:568} {569:}SCREENSTARTE:BOOLEAN;SCREENOK:BOOLEAN;{:569}{572:} WINDOWOPEN:ARRAY[WINDOWNUMBER]OF BOOLEAN; LEFTCOL:ARRAY[WINDOWNUMBER]OF SCREENCOL; RIGHTCOL:ARRAY[WINDOWNUMBER]OF SCREENCOL; TOPROW:ARRAY[WINDOWNUMBER]OF SCREENROW; BOTROW:ARRAY[WINDOWNUMBER]OF SCREENROW; MWINDOW:ARRAY[WINDOWNUMBER]OF INTEGER; NWINDOW:ARRAY[WINDOWNUMBER]OF INTEGER; WINDOWTIME:ARRAY[WINDOWNUMBER]OF INTEGER;{:572}{579:} ROWTRANSITIO:TRANSSPEC;{:579}{585:}SERIALNO:INTEGER;{:585}{592:} FIXNEEDED:BOOLEAN;WATCHCOEFS:BOOLEAN;DEPFINAL:HALFWORD;{:592}{624:} CURCMD:EIGHTBITS;CURMOD:INTEGER;CURSYM:HALFWORD;{:624}{628:} INPUTSTACK:ARRAY[0..STACKSIZE]OF INSTATERECOR;INPUTPTR:0..STACKSIZE; MAXINSTACK:0..STACKSIZE;CURINPUT:INSTATERECOR;{:628}{631:}INOPEN:0..6; OPENPARENS:0..6;INPUTFILE:ARRAY[1..6]OF ALPHAFILE;LINE:INTEGER; LINESTACK:ARRAY[1..6]OF INTEGER;{:631}{633:} PARAMSTACK:ARRAY[0..150]OF HALFWORD;PARAMPTR:0..150; MAXPARAMSTAC:INTEGER;{:633}{634:}FILEPTR:0..STACKSIZE;{:634}{659:} SCANNERSTATU:0..6;WARNINGINFO:INTEGER;{:659}{680:}FORCEEOF:BOOLEAN; {:680}{699:}BGLOC,EGLOC:1..2369;{:699}{738:}CONDPTR:HALFWORD; IFLIMIT:0..4;CURIF:SMALLNUMBER;IFLINE:INTEGER;{:738}{752:} LOOPPTR:HALFWORD;{:752}{767:}CURNAME:STRNUMBER;CURAREA:STRNUMBER; CUREXT:STRNUMBER;{:767}{768:}AREADELIMITE:POOLPOINTER;MFAREA:STRNUMBER; INPNAME:PACKED ARRAY[1..FILENAMESIZE]OF CHAR;INPLEN:FILESIZE;I:INTEGER; EXTDELIMITER:POOLPOINTER;{:768}{775:} MFBNAMEDEFAU:PACKED ARRAY[1..10]OF CHAR; MFBASEDEFAUL:PACKED ARRAY[1..FILENAMESIZE]OF CHAR; POOLNAME:PACKED ARRAY[1..FILENAMESIZE]OF CHAR; POOLFNAME:PACKED ARRAY[1..7]OF CHAR;BASEAREALENG:FILESIZE; BASEDEFAULTL:INTEGER;{:775}{782:}JOBNAME:STRNUMBER;LOGOPENED:BOOLEAN; LOGNAME:STRNUMBER;{:782}{785:}GFEXT:STRNUMBER;{:785}{791:} GFFILE:BYTEFILE;OUTPUTFILENA:STRNUMBER;{:791}{796:}CURTYPE:SMALLNUMBER; CUREXP:INTEGER;{:796}{813:}MAXC:ARRAY[17..18]OF INTEGER; MAXPTR:ARRAY[17..18]OF HALFWORD;MAXLINK:ARRAY[17..18]OF HALFWORD;{:813} {821:}VARFLAG:0..85;{:821}{954:}TXX,TXY,TYX,TYY,TX,TY:SCALED;{:954} {1077:}STARTSYM:HALFWORD;{:1077}{1084:}LONGHELPSEEN:BOOLEAN;{:1084} {1087:}TFMFILE:BYTEFILE;METRICFILENA:STRNUMBER;{:1087}{1096:} BC,EC:EIGHTBITS;TFMWIDTH:ARRAY[EIGHTBITS]OF SCALED; TFMHEIGHT:ARRAY[EIGHTBITS]OF SCALED;TFMDEPTH:ARRAY[EIGHTBITS]OF SCALED; TFMITALCORR:ARRAY[EIGHTBITS]OF SCALED; CHAREXISTS:ARRAY[EIGHTBITS]OF BOOLEAN;CHARTAG:ARRAY[EIGHTBITS]OF 0..3; CHARREMAINDE:ARRAY[EIGHTBITS]OF 0..LIGTABLESIZE; HEADERBYTE:ARRAY[1..HEADERSIZE]OF-1..255; LIGKERN:ARRAY[0..LIGTABLESIZE]OF FOURQUARTERS;NL:0..32511; KERN:ARRAY[0..MAXKERNS]OF SCALED;NK:0..MAXKERNS; EXTEN:ARRAY[EIGHTBITS]OF FOURQUARTERS;NE:0..256; PARAM:ARRAY[1..MAXFONTDIMEN]OF SCALED;NP:0..MAXFONTDIMEN; NW,NH,ND,NI:0..256;SKIPTABLE:ARRAY[EIGHTBITS]OF 0..LIGTABLESIZE; LKSTARTED:BOOLEAN;BCHAR:INTEGER;BCHLABEL:0..LIGTABLESIZE; LL,LLL:0..LIGTABLESIZE;LABELLOC:ARRAY[0..256]OF-1..LIGTABLESIZE; LABELCHAR:ARRAY[1..256]OF EIGHTBITS;LABELPTR:0..256;{:1096}{1119:} PERTURBATION:SCALED;EXCESS:INTEGER;{:1119}{1125:} DIMENHEAD:ARRAY[1..4]OF HALFWORD;{:1125}{1130:}MAXTFMDIMEN:SCALED; TFMCHANGED:INTEGER;{:1130}{1149:}GFMINM,GFMAXM,GFMINN,GFMAXN:INTEGER; GFPREVPTR:INTEGER;TOTALCHARS:INTEGER;CHARPTR:ARRAY[EIGHTBITS]OF INTEGER; GFDX,GFDY:ARRAY[EIGHTBITS]OF INTEGER;{:1149}{1152:} GBUFFER:[ volatile , aligned (9)]PACKED RECORD CASE BOOLEAN OF FALSE:(B: PACKED ARRAY[GFINDEX]OF EIGHTBITS);TRUE:(L:BYTEBLOCK;R:BYTEBLOCK; J:EIGHTBITS);END;HALFBUF:GFINDEX;GFLIMIT:GFINDEX;GFPTR:GFINDEX; GFOFFSET:INTEGER;{:1152}{1162:}BOCC,BOCP:INTEGER;{:1162}{1183:} BASEIDENT:STRNUMBER;{:1183}{1188:}BASEFILE:WORDFILE;{:1188}{1203:} READYALREADY:INTEGER;INITFLAG:BOOLEAN;{:1203}{1217:} COPYERR:(IGNOREIT,PRINTIT,SAVEIT);LABELSIZE:-1..14;{:1217}{1230:} BASEQUAL,GFQUAL,CMDLINEPRESE,EDITQUAL,CONTINUEQUAL,BATCHQUAL,LOGQUAL, DIAGQUAL:BOOLEAN;DIAGFILE:ALPHAFILE;DIAGNAME:STRNUMBER; TEMPFILE:ALPHAFILE; LOGFNAME,DIAGFNAME,EDITNAME,GFFNAME:PACKED ARRAY[1..FILENAMESIZE]OF CHAR ;LOGFLEN,DIAGFLEN,GFFLEN,EDITLEN:FILESIZE;{:1230}{1234:} GFCOUNT:0..VAXBLOCKLENG;TFMCOUNT:0..VAXBLOCKLENG; BASECOUNT:0..VAXBLOCKLENG;{:1234}{1236:}ITM:ARRAY[1..4]OF unsigned ; RES:[ volatile ]INTEGER;TTCHAN:[ volatile ]SIGNEDHALFWO;{:1236}{1240:} INFAB,OUTFAB,FYLFAB:FABPTR;INRAB,OUTRAB,FYLRAB:RABPTR; LASTLENGTH:INTEGER;LASTNAME:PACKED ARRAY[1..FILENAMESIZE]OF CHAR;{:1240} {1249:}EDITOR:PACKED ARRAY[1..4]OF EDITORIDENT;{:1249}{1277:} EMPTYEDITOR:EDITORIDENT;{:1277}{33:}PROCEDURE WAKEUPTERMIN; BEGIN OUTRAB^.RAB$V_CCO:=TRUE;WRITELN(TERMOUT);OUTRAB^.RAB$V_CCO:=FALSE; END;{:33}{1232:} [external]FUNCTION cli$present( %stdescr ENTITY:[ volatile ]PACKED ARRAY [L1..U1:INTEGER]OF CHAR:= %immed 0):INTEGER;EXTERN; [external]FUNCTION cli$get_value( %stdescr ENTITY:[ volatile ]PACKED ARRAY[L1..U1:INTEGER]OF CHAR:= %immed 0; %stdescr RETURNS:[ volatile ]PACKED ARRAY[L2..U2:INTEGER]OF CHAR:= %immed 0;VAR RETLEN:[ volatile ]SIXTEENBITS:= %immed 0):INTEGER;EXTERN; [external]FUNCTION lib$get_foreign( %stdescr CMDLIN:[ volatile ]PACKED ARRAY[L1..U1:INTEGER]OF CHAR:= %immed 0; %stdescr PROMPT:[ volatile ]PACKED ARRAY[L2..U2:INTEGER]OF CHAR:= %immed 0;VAR LEN:[ volatile ]SIXTEENBITS:= %immed 0; VAR FLAG:[ volatile ]INTEGER:= %immed 0):INTEGER;EXTERN;{:1232}{1237:} [ASYNCHRONOUS]PROCEDURE CTRLCROUT;BEGIN INTERRUPT:=1; $qiow(,TTCHAN, io$_setmode + io$m_ctrlcast ,,,, %immed CTRLCROUT,, %immed 3,,,);;END;{:1237}{1239:}FUNCTION USERRESET(VAR FAB: FAB$type ; VAR RAB: RAB$type ;VAR F:UNSAFEFILE):INTEGER;VAR STATUS:INTEGER; NAM:NAMPTR;P:CHRPTR;I:INTEGER;BEGIN LASTLENGTH:=0;STATUS:=$open(FAB); IF ODD(STATUS)THEN STATUS:=$connect(RAB); IF ODD(STATUS)THEN BEGIN NAM:=FAB.FAB$L_NAM::NAMPTR; IF NAM<>NIL THEN LASTLENGTH:=NAM^.NAM$B_RSL; FOR I:=1 TO LASTLENGTH DO BEGIN P:=(NAM^.NAM$L_RSA::INTEGER+I-1)::CHRPTR ;LASTNAME[I]:=P^;END;END;USERRESET:=STATUS;END; FUNCTION USERREWRITE(VAR FAB: FAB$type ;VAR RAB: RAB$type ; VAR F:UNSAFEFILE):INTEGER;VAR STATUS:INTEGER;NAM:NAMPTR;P:CHRPTR; I:INTEGER;BEGIN STATUS:=$create(FAB); IF ODD(STATUS)THEN STATUS:=$connect(RAB); IF ODD(STATUS)THEN BEGIN NAM:=FAB.FAB$L_NAM::NAMPTR; IF NAM<>NIL THEN LASTLENGTH:=NAM^.NAM$B_RSL; FOR I:=1 TO LASTLENGTH DO BEGIN P:=(NAM^.NAM$L_RSA::INTEGER+I-1)::CHRPTR ;LASTNAME[I]:=P^;END;END;USERREWRITE:=STATUS;END; FUNCTION PAS$FAB(VAR FOOBAR:UNSAFEFILE):FABPTR;EXTERN; FUNCTION PAS$RAB(VAR FOOBAR:UNSAFEFILE):RABPTR;EXTERN;{:1239}{1241:} FUNCTION TRANSLATE(VAR T:PACKED ARRAY[L1..U1:INTEGER]OF CHAR; VAR LEN:SIGNEDHALFWO):BOOLEAN;VAR S:VARYING[FILENAMESIZE]OF CHAR; TRNLNMRETURN:INTEGER;RETURNLENGTH:[ volatile ]INTEGER; ATTRIBUTES:UNSIGNED;ITEMLIST:[ volatile ]ARRAY[0..1]OF VMSITEMLIST; BEGIN S:= substr (T,1,LEN);ATTRIBUTES:= lnm$m_case_blind ; RETURNLENGTH:=0;WITH ITEMLIST[0]DO BEGIN BUFFERLENGTH:=FILENAMESIZE; ITEMCODE:= lnm$_string ;BUFFERADDR:= iaddress(T); RETLENADDR:= iaddress(RETURNLENGTH);END;ITEMLIST[1].NEXTITEM:=0; TRNLNMRETURN:= $trnlnm(ATTRIBUTES,'LNM$DCL_LOGICAL',S,,ITEMLIST); LEN:=RETURNLENGTH;TRANSLATE:=TRNLNMRETURN= sts$k_success ;END;{:1241} {1243:}[external]FUNCTION lib$callg( %immed ARGLIST:[ long ]INTEGER; %immed USERPROC:[ long ]INTEGER):INTEGER;EXTERN; FUNCTION CALLEDITOR(PROC:[ long ]INTEGER; PARAM1,PARAM3:[ volatile ]DESCRPTR):INTEGER; VAR CALLGDESCRIP:PACKED ARRAY[1..4]OF[ long ]INTEGER; BEGIN CALLGDESCRIP[1]:=1;CALLGDESCRIP[2]:=PARAM1::INTEGER; IF PARAM3<>NIL THEN BEGIN CALLGDESCRIP[1]:=3;CALLGDESCRIP[3]:=0; CALLGDESCRIP[4]:=PARAM3::INTEGER;END; CALLEDITOR:= lib$callg( iaddress(CALLGDESCRIP),PROC)END;{:1243}{1244:} FUNCTION str$get1_dx( %ref ALLOC:SIXTEENBITS; %immed DESCRP:DESCRPTR):INTEGER;EXTERN; FUNCTION str$free1_dx( %immed DESCRP:DESCRPTR):INTEGER;EXTERN; PROCEDURE lib$signal( %immed CONDCODE:INTEGER);EXTERN;{:1244}{1245:} PROCEDURE STRTODESCR(POOLSTRING:STRNUMBER; VAR DYNAMSTR:[ volatile ]DESCRPTR);VAR CHPTR,STRSTAT:INTEGER; STRSIZE:SIXTEENBITS;CHCTR:CHRPTR; BEGIN IF DYNAMSTR=NIL THEN BEGIN NEW(DYNAMSTR); WITH DYNAMSTR^DO BEGIN LEN:=0;DESCTYPE:= dsc$k_dtype_t ; DESCCLASS:= dsc$k_class_d ;STRING:=0 END; END ELSE IF DYNAMSTR^.LEN<>0 THEN BEGIN STRSTAT:= str$free1_dx(DYNAMSTR) ;IF NOT ODD(STRSTAT)THEN lib$signal(STRSTAT)END; CHPTR:=STRSTART[POOLSTRING]; STRSIZE:=STRSTART[POOLSTRING+1]-STRSTART[POOLSTRING]; STRSTAT:= str$get1_dx(STRSIZE,DYNAMSTR); IF NOT ODD(STRSTAT)THEN lib$signal(STRSTAT); CHCTR:=DYNAMSTR^.STRING::CHRPTR; WHILE STRSIZE>0 DO BEGIN CHCTR^:=XCHR[STRPOOL[CHPTR]]; CHCTR:=(CHCTR::INTEGER+1)::CHRPTR;CHPTR:=CHPTR+1;STRSIZE:=STRSIZE-1 END; END;{:1245}{1247:}PROCEDURE RELEASE(STRING:DESCRPTR); VAR STRSTAT:INTEGER; BEGIN IF STRING<>NIL THEN BEGIN STRSTAT:= str$free1_dx(STRING); IF NOT ODD(STRSTAT)THEN lib$signal(STRSTAT);DISPOSE(STRING);STRING:=NIL; END;END;{:1247}{1252:} [external]FUNCTION lib$find_image_symbol ( %immed FILENM:DESCRPTR; %immed SYMBOL:DESCRPTR; %ref SYMBOLVALUE:[ volatile , long ]INTEGER; %immed IMAGENAME:DESCRPTR:= %immed 0):INTEGER;EXTERN; [external]FUNCTION lib$spawn( %immed CMD:DESCRPTR; %immed SYSINPUT:DESCRPTR:= %immed 0; %immed SYSOUTPUT:DESCRPTR:= %immed 0; %ref FLAGS:[ long ]INTEGER:= %immed 0; %immed PRCNM:DESCRPTR:= %immed 0; %ref PID:[ long ]INTEGER:= %immed 0; %ref STATUS:[ long ]INTEGER:= %immed 0):INTEGER;EXTERN; FUNCTION EDIT(FILENM,CMDFILE:STRNUMBER;EDITOR:EDITORIDENT):EDITRESULT; VAR EDITCOMMANDL:DESCRPTR;CHARCT:SIXTEENBITS;EDITORENTRY:INTEGER; EDITORSTATUS,STRSTAT:INTEGER;CHPTR:CHRPTR;QUITSTATUS,EXITSTATUS:INTEGER; IMAGESYMBOL,ENTRYPOINT,BADSYMBOL,GOODSYMBOL:DESCRPTR; EDITFILE,EDITCMD:DESCRPTR;BEGIN{1259:}RESET(TEMPFILE);CHARCT:=1; WHILE NOT EOF(TEMPFILE)DO BEGIN GET(TEMPFILE); CHARCT:=CHARCT+1 END{:1259};EDITCOMMANDL:=NIL;{1260:}NEW(EDITCOMMANDL); WITH EDITCOMMANDL^DO BEGIN LEN:=0;DESCTYPE:= dsc$k_dtype_t ; DESCCLASS:= dsc$k_class_d ;STRING:=0 END; STRSTAT:= str$get1_dx(CHARCT,EDITCOMMANDL); IF NOT ODD(STRSTAT)THEN lib$signal(STRSTAT); CHPTR:=EDITCOMMANDL^.STRING::CHRPTR;RESET(TEMPFILE); WHILE NOT EOF(TEMPFILE)DO BEGIN CHPTR^:=TEMPFILE^;GET(TEMPFILE); CHPTR:=(CHPTR::INTEGER+1)::CHRPTR END{:1260};EDITFILE:=NIL;EDITCMD:=NIL; IF EDITOR.EDTLIKE THEN BEGIN STRTODESCR(FILENM,EDITFILE); STRTODESCR(CMDFILE,EDITCMD);END;EDIT:=FAILED;EDITORSTATUS:=4; QUITSTATUS:=0;EXITSTATUS:= sts$k_success ;{1253:}IMAGESYMBOL:=NIL; ENTRYPOINT:=NIL;BADSYMBOL:=NIL;GOODSYMBOL:=NIL; STRTODESCR(EDITOR.IMAGE,IMAGESYMBOL); STRTODESCR(EDITOR.ENTRY,ENTRYPOINT); STRTODESCR(EDITOR.QUITTING,BADSYMBOL); STRTODESCR(EDITOR.EXITING,GOODSYMBOL){:1253}; IF EDITOR.IMAGE<>0 THEN BEGIN IF lib$find_image_symbol (IMAGESYMBOL, ENTRYPOINT,EDITORENTRY)= sts$k_success THEN{1254:}BEGIN{1257:} IF EDITOR.QUITTING<>0 THEN IF NOT ODD( lib$find_image_symbol ( IMAGESYMBOL,BADSYMBOL,QUITSTATUS))THEN QUITSTATUS:= sts$k_success ; IF EDITOR.EXITING<>0 THEN IF NOT ODD( lib$find_image_symbol (IMAGESYMBOL ,GOODSYMBOL,EXITSTATUS))THEN EXITSTATUS:= sts$k_success {:1257}; IF EDITOR.EDTLIKE THEN EDITORSTATUS:=CALLEDITOR(EDITORENTRY,EDITFILE, EDITCMD)ELSE{1258:}BEGIN CHPTR:=EDITCOMMANDL^.STRING::CHRPTR; FOR CHARCT:=1 TO EDITOR.CMDOFFSET DO BEGIN CHPTR^:=' '; CHPTR:=(CHPTR::INTEGER+1)::CHRPTR END; EDITORSTATUS:=CALLEDITOR(EDITORENTRY,EDITCOMMANDL,NIL);END{:1258}; END{:1254}ELSE EDITOR.IMAGE:=0 END; IF EDITOR.IMAGE=0 THEN STRSTAT:= lib$spawn(CMD:=EDITCOMMANDL,STATUS:= EDITORSTATUS);{1255:}RELEASE(IMAGESYMBOL);RELEASE(ENTRYPOINT); RELEASE(BADSYMBOL);RELEASE(GOODSYMBOL);RELEASE(EDITCOMMANDL); RELEASE(EDITFILE);RELEASE(EDITCMD);{:1255};{1256:} IF EDITORSTATUS>= sts$m_inhib_msg THEN EDITORSTATUS:=EDITORSTATUS- sts$m_inhib_msg ; IF EDITORSTATUS=EXITSTATUS THEN EDIT:=EDITED ELSE IF EDITORSTATUS= QUITSTATUS THEN EDIT:=QUIT{:1256}END;{:1252}PROCEDURE INITIALIZE; VAR{19:}I:INTEGER;{:19}{130:}K:INTEGER;{:130}BEGIN{21:}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]:='~';{:21}{22:}FOR I:=0 TO 31 DO XCHR[I]:=' '; XCHR[12]:=CHR(12);XCHR[9]:=CHR(9);FOR I:=127 TO 255 DO XCHR[I]:=' '; {:22}{23:}FOR I:=0 TO 255 DO XORD[CHR(I)]:=127; FOR I:=128 TO 255 DO XORD[XCHR[I]]:=I; FOR I:=0 TO 126 DO XORD[XCHR[I]]:=I;{:23}{69:}INTERACTION:=3;{:69}{72:} DELETIONSALL:=TRUE;ERRORCOUNT:=0;{:72}{75:}HELPPTR:=0;USEERRHELP:=FALSE; ERRHELP:=0;{:75}{92:}INTERRUPT:=0;OKTOINTERRUP:=TRUE; IF $assign('SYS$COMMAND',TTCHAN,,)= sts$k_success THEN $qiow(,TTCHAN, io$_setmode + io$m_ctrlcast ,,,, %immed CTRLCROUT,, %immed 3,,,);;{:92} {98:}ARITHERROR:=FALSE;{:98}{131:}TWOTOTHE[0]:=1; FOR K:=1 TO 30 DO TWOTOTHE[K]:=2*TWOTOTHE[K-1];SPECLOG[1]:=93032640; SPECLOG[2]:=38612034;SPECLOG[3]:=17922280;SPECLOG[4]:=8662214; SPECLOG[5]:=4261238;SPECLOG[6]:=2113709;SPECLOG[7]:=1052693; SPECLOG[8]:=525315;SPECLOG[9]:=262400;SPECLOG[10]:=131136; SPECLOG[11]:=65552;SPECLOG[12]:=32772;SPECLOG[13]:=16385; FOR K:=14 TO 27 DO SPECLOG[K]:=TWOTOTHE[27-K];SPECLOG[28]:=1;{:131} {138:}SPECATAN[1]:=27855475;SPECATAN[2]:=14718068;SPECATAN[3]:=7471121; SPECATAN[4]:=3750058;SPECATAN[5]:=1876857;SPECATAN[6]:=938658; SPECATAN[7]:=469357;SPECATAN[8]:=234682;SPECATAN[9]:=117342; SPECATAN[10]:=58671;SPECATAN[11]:=29335;SPECATAN[12]:=14668; SPECATAN[13]:=7334;SPECATAN[14]:=3667;SPECATAN[15]:=1833; SPECATAN[16]:=917;SPECATAN[17]:=458;SPECATAN[18]:=229;SPECATAN[19]:=115; SPECATAN[20]:=57;SPECATAN[21]:=29;SPECATAN[22]:=14;SPECATAN[23]:=7; SPECATAN[24]:=4;SPECATAN[25]:=2;SPECATAN[26]:=1;{:138}{179:} {WASMEMEND:=0;WASLOMAX:=0;WASHIMIN:=MEMMAX;PANICKING:=FALSE;}{:179} {191:}FOR K:=1 TO 41 DO INTERNAL[K]:=0;INTPTR:=41;{:191}{199:} FOR K:=48 TO 57 DO CHARCLASS[K]:=0;CHARCLASS[46]:=1;CHARCLASS[32]:=2; CHARCLASS[37]:=3;CHARCLASS[34]:=4;CHARCLASS[44]:=5;CHARCLASS[59]:=6; CHARCLASS[40]:=7;CHARCLASS[41]:=8;FOR K:=65 TO 90 DO CHARCLASS[K]:=9; FOR K:=97 TO 122 DO CHARCLASS[K]:=9;CHARCLASS[95]:=9;CHARCLASS[60]:=10; CHARCLASS[61]:=10;CHARCLASS[62]:=10;CHARCLASS[58]:=10; CHARCLASS[124]:=10;CHARCLASS[96]:=11;CHARCLASS[39]:=11; CHARCLASS[43]:=12;CHARCLASS[45]:=12;CHARCLASS[47]:=13;CHARCLASS[42]:=13; CHARCLASS[92]:=13;CHARCLASS[33]:=14;CHARCLASS[63]:=14;CHARCLASS[35]:=15; CHARCLASS[38]:=15;CHARCLASS[64]:=15;CHARCLASS[36]:=15;CHARCLASS[94]:=16; CHARCLASS[126]:=16;CHARCLASS[91]:=17;CHARCLASS[93]:=18; CHARCLASS[123]:=19;CHARCLASS[125]:=19; FOR K:=0 TO 31 DO CHARCLASS[K]:=20;CHARCLASS[9]:=2;CHARCLASS[12]:=2; FOR K:=127 TO 255 DO CHARCLASS[K]:=20;{:199}{202:}HASH[1].LH:=0; HASH[1].RH:=0;EQTB[1].LH:=41;EQTB[1].RH:=0; FOR K:=2 TO 2369 DO BEGIN HASH[K]:=HASH[1];EQTB[K]:=EQTB[1];END;{:202} {231:}BIGNODESIZE[13]:=12;BIGNODESIZE[14]:=4;{:231}{251:}SAVEPTR:=0; {:251}{396:}OCTANTDIR[1]:=548;OCTANTDIR[5]:=549;OCTANTDIR[6]:=550; OCTANTDIR[2]:=551;OCTANTDIR[4]:=552;OCTANTDIR[8]:=553;OCTANTDIR[7]:=554; OCTANTDIR[3]:=555;{:396}{428:}MAXROUNDINGP:=0;{:428}{449:} OCTANTCODE[1]:=1;OCTANTCODE[2]:=5;OCTANTCODE[3]:=6;OCTANTCODE[4]:=2; OCTANTCODE[5]:=4;OCTANTCODE[6]:=8;OCTANTCODE[7]:=7;OCTANTCODE[8]:=3; FOR K:=1 TO 8 DO OCTANTNUMBER[OCTANTCODE[K]]:=K;{:449}{456:} REVTURNS:=FALSE;{:456}{462:}XCORR[1]:=0;YCORR[1]:=0;XYCORR[1]:=0; XCORR[5]:=0;YCORR[5]:=0;XYCORR[5]:=1;XCORR[6]:=-1;YCORR[6]:=1; XYCORR[6]:=0;XCORR[2]:=1;YCORR[2]:=0;XYCORR[2]:=1;XCORR[4]:=0; YCORR[4]:=1;XYCORR[4]:=1;XCORR[8]:=0;YCORR[8]:=1;XYCORR[8]:=0; XCORR[7]:=1;YCORR[7]:=0;XYCORR[7]:=1;XCORR[3]:=-1;YCORR[3]:=1; XYCORR[3]:=0;FOR K:=1 TO 8 DO ZCORR[K]:=XYCORR[K]-XCORR[K];{:462}{570:} SCREENSTARTE:=FALSE;SCREENOK:=FALSE;{:570}{573:} FOR K:=0 TO 15 DO BEGIN WINDOWOPEN[K]:=FALSE;WINDOWTIME[K]:=0;END;{:573} {593:}FIXNEEDED:=FALSE;WATCHCOEFS:=TRUE;{:593}{739:}CONDPTR:=0; IFLIMIT:=0;CURIF:=0;IFLINE:=0;{:739}{753:}LOOPPTR:=0;{:753}{776:} MFBNAMEDEFAU:='plain.base';POOLFNAME:='MF.POOL'; cli$get_value('MFBASES',MFBASEDEFAUL,BASEAREALENG); POOLNAME:=MFBASEDEFAUL; FOR I:=1 TO 7 DO POOLNAME[I+BASEAREALENG]:=POOLFNAME[I]; FOR I:=1 TO 10 DO MFBASEDEFAUL[I+BASEAREALENG]:=MFBNAMEDEFAU[I]; BASEDEFAULTL:=BASEAREALENG+10;{:776}{797:}CUREXP:=0;{:797}{822:} VARFLAG:=0;{:822}{1078:}STARTSYM:=0;{:1078}{1085:}LONGHELPSEEN:=FALSE; {:1085}{1097:}FOR K:=0 TO 255 DO BEGIN TFMWIDTH[K]:=0;TFMHEIGHT[K]:=0; TFMDEPTH[K]:=0;TFMITALCORR[K]:=0;CHAREXISTS[K]:=FALSE;CHARTAG[K]:=0; CHARREMAINDE[K]:=0;SKIPTABLE[K]:=LIGTABLESIZE;END; FOR K:=1 TO HEADERSIZE DO HEADERBYTE[K]:=-1;BC:=255;EC:=0;NL:=0;NK:=0; NE:=0;NP:=0;INTERNAL[41]:=-65536;BCHLABEL:=LIGTABLESIZE;LABELLOC[0]:=-1; LABELPTR:=0;{:1097}{1150:}GFPREVPTR:=0;TOTALCHARS:=0;{:1150}{1153:} HALFBUF:=GFBUFSIZE DIV 2;GFLIMIT:=GFBUFSIZE;GFPTR:=0;GFOFFSET:=0;{:1153} {1184:}BASEIDENT:=0;{:1184}{1250:} WITH EDITOR[1]DO BEGIN LOGICAL:='CALLABLE_LSE';IMAGE:=1084;ENTRY:=1085; QUITTING:=1086;EXITING:=1087;CMDTEXT:=1088;CMDOFFSET:=0;STARTQUAL:=TRUE; EDTLIKE:=FALSE;END;WITH EDITOR[2]DO BEGIN LOGICAL:='CALLABLE_TPU'; IMAGE:=1089;ENTRY:=1090;QUITTING:=1086;EXITING:=1087;CMDTEXT:=1091; CMDOFFSET:=5;STARTQUAL:=TRUE;EDTLIKE:=FALSE;END; WITH EDITOR[3]DO BEGIN LOGICAL:='CALLABLE_EDT';IMAGE:=1092;ENTRY:=1093; QUITTING:=0;EXITING:=0;CMDTEXT:=1094;CMDOFFSET:=0;STARTQUAL:=FALSE; EDTLIKE:=TRUE;END;WITH EDITOR[4]DO BEGIN LOGICAL:='CALLABLE_TECO'; IMAGE:=1095;ENTRY:=1096;QUITTING:=0;EXITING:=0;CMDTEXT:=1097; CMDOFFSET:=0;STARTQUAL:=FALSE;EDTLIKE:=TRUE;END;{:1250}{1278:} WITH EMPTYEDITOR DO BEGIN LOGICAL:='';IMAGE:=0;ENTRY:=0;QUITTING:=0; EXITING:=0;CMDTEXT:=0;CMDOFFSET:=0;STARTQUAL:=FALSE;EDTLIKE:=FALSE;END; {:1278}END;{56:}PROCEDURE DIAGCHAR(S:INTEGER);VAR CH:CHAR; BEGIN CH:=XCHR[S];IF DIAGQUAL THEN WRITE(DIAGFILE,CH); IF CH='"'THEN IF DIAGQUAL THEN WRITE(DIAGFILE,CH)END; PROCEDURE TEMPCHAR(S:INTEGER);VAR CH:CHAR;BEGIN CH:=XCHR[S]; WRITE(TEMPFILE,CH);IF CH='"'THEN WRITE(TEMPFILE,CH)END; PROCEDURE DIAGPRINT(S:INTEGER);VAR J:POOLPOINTER;BEGIN J:=STRSTART[S]; WHILE J0 THEN DIAGCHAR(S); IF LABELSIZE>0 THEN LABELSIZE:=LABELSIZE-1 END;IGNOREIT:; SAVEIT:TEMPCHAR(S)END{:1216}; CASE SELECTOR OF 3:BEGIN WRITE(TERMOUT,XCHR[S]); IF LOGQUAL THEN WRITE(LOGFILE,XCHR[S]);TERMOFFSET:=TERMOFFSET+1; FILEOFFSET:=FILEOFFSET+1; IF TERMOFFSET=MAXPRINTLINE THEN BEGIN WRITELN(TERMOUT,CHR(13),CHR(10)); TERMOFFSET:=0;END; IF FILEOFFSET=MAXPRINTLINE THEN BEGIN IF LOGQUAL THEN WRITELN(LOGFILE); FILEOFFSET:=0;END;END;2:BEGIN IF LOGQUAL THEN WRITE(LOGFILE,XCHR[S]); FILEOFFSET:=FILEOFFSET+1;IF FILEOFFSET=MAXPRINTLINE THEN PRINTLN;END; 1:BEGIN WRITE(TERMOUT,XCHR[S]);TERMOFFSET:=TERMOFFSET+1; IF TERMOFFSET=MAXPRINTLINE THEN PRINTLN;END;0:; 4:IF TALLY=STRPTR)THEN S:=259;J:=STRSTART[S]; WHILE J=STRPTR)THEN S:=259;J:=STRSTART[S]; WHILE J0)AND(ODD(SELECTOR)))OR((FILEOFFSET>0)AND(SELECTOR >=2))THEN PRINTLN;PRINT(S);END;{:62}{63:} PROCEDURE PRINTTHEDIGS(K:EIGHTBITS);BEGIN WHILE K>0 DO BEGIN K:=K-1; PRINTCHAR(48+DIG[K]);END;END;{:63}{64:}PROCEDURE PRINTINT(N:INTEGER); VAR K:0..23;M:INTEGER;BEGIN K:=0;IF N<0 THEN BEGIN PRINTCHAR(45); IF N>-100000000 THEN N:=-N ELSE BEGIN M:=-1-N;N:=M DIV 10; M:=(M MOD 10)+1;K:=1;IF M<10 THEN DIG[0]:=M ELSE BEGIN DIG[0]:=0;N:=N+1; END;END;END;REPEAT DIG[K]:=N MOD 10;N:=N DIV 10;K:=K+1;UNTIL N=0; PRINTTHEDIGS(K);END;{:64}{103:}PROCEDURE PRINTSCALED(S:SCALED); VAR DELTA:SCALED;BEGIN IF S<0 THEN BEGIN PRINTCHAR(45);S:=-S;END; PRINTINT(S DIV 65536);S:=10*(S MOD 65536)+5; IF S<>5 THEN BEGIN DELTA:=10;PRINTCHAR(46); REPEAT IF DELTA>65536 THEN S:=S+32768-(DELTA DIV 2); PRINTCHAR(48+(S DIV 65536));S:=10*(S MOD 65536);DELTA:=DELTA*10; UNTIL S<=DELTA;END;END;{:103}{104:}PROCEDURE PRINTTWO(X,Y:SCALED); BEGIN PRINTCHAR(40);PRINTSCALED(X);PRINTCHAR(44);PRINTSCALED(Y); PRINTCHAR(41);END;{:104}{187:}PROCEDURE PRINTTYPE(T:SMALLNUMBER); BEGIN CASE T OF 1:PRINT(324);2:PRINT(325);3:PRINT(326);4:PRINT(327); 5:PRINT(328);6:PRINT(329);7:PRINT(330);8:PRINT(331);9:PRINT(332); 10:PRINT(333);11:PRINT(334);12:PRINT(335);13:PRINT(336);14:PRINT(337); 16:PRINT(338);17:PRINT(339);18:PRINT(340);15:PRINT(341);19:PRINT(342); 20:PRINT(343);21:PRINT(344);22:PRINT(345);23:PRINT(346); OTHERWISE PRINT(347)END;END;{:187}{195:}PROCEDURE BEGINDIAGNOS; BEGIN OLDSETTING:=SELECTOR; IF(INTERNAL[13]<=0)AND(SELECTOR=3)THEN BEGIN SELECTOR:=SELECTOR-1; IF HISTORY=0 THEN HISTORY:=1;END;END; PROCEDURE ENDDIAGNOSTI(BLANKLINE:BOOLEAN);BEGIN PRINTNL(285); IF BLANKLINE THEN PRINTLN;SELECTOR:=OLDSETTING;END;{:195}{197:} PROCEDURE PRINTDIAGNOS(S,T:STRNUMBER;NULINE:BOOLEAN);BEGIN BEGINDIAGNOS; IF NULINE THEN PRINTNL(S)ELSE PRINT(S);PRINT(265);PRINTINT(LINE); PRINT(T);PRINTCHAR(58);END;{:197}{773:} PROCEDURE PRINTFILENAM(N,A,E:INTEGER);BEGIN PRINT(A);PRINT(N);PRINT(E); END;{:773}{1261:}PROCEDURE EDITLOCATE(LINE,COL:INTEGER); BEGIN PRINT(1098);PRINTINT(LINE);PRINTCHAR(44);PRINTINT(COL); PRINT(1099)END;{:1261}{1262:}FUNCTION EDITFILE(STACKITEM:INSTATERECOR; LINE:INTEGER):BOOLEAN;FORWARD;{:1262}{73:}PROCEDURE NORMALIZESEL; FORWARD;PROCEDURE GETNEXT;FORWARD;PROCEDURE TERMINPUT;FORWARD; PROCEDURE SHOWCONTEXT;FORWARD;PROCEDURE BEGINFILEREA;FORWARD; PROCEDURE OPENLOGFILE;FORWARD;PROCEDURE CLOSEFILESAN;FORWARD; PROCEDURE CLEARFORERRO;FORWARD;{PROCEDURE DEBUGHELP;FORWARD;}{43:} PROCEDURE FLUSHSTRING(S:STRNUMBER); BEGIN IF S0;POOLPTR:=STRSTART[STRPTR];END;{:43}{:73}{76:} PROCEDURE JUMPOUT;BEGIN GOTO 9998;END;{:76}{77:}PROCEDURE ERROR; LABEL 22,10;VAR C:ASCIICODE;S1,S2,S3:INTEGER;J:POOLPOINTER; BEGIN IF HISTORY<2 THEN HISTORY:=2;PRINTCHAR(46);{1218:} COPYERR:=IGNOREIT;RESET(TEMPFILE){:1218};SHOWCONTEXT; IF INTERACTION=3 THEN{78:}WHILE TRUE DO BEGIN 22:CLEARFORERRO; BEGIN WAKEUPTERMIN;PRINT(263);TERMINPUT;END;IF LAST=FIRST THEN GOTO 10; C:=BUFFER[FIRST];IF C>=97 THEN C:=C-32;{79:} CASE C OF 48,49,50,51,52,53,54,55,56,57:IF DELETIONSALL THEN{83:} BEGIN S1:=CURCMD;S2:=CURMOD;S3:=CURSYM;OKTOINTERRUP:=FALSE; IF(LAST>FIRST+1)AND(BUFFER[FIRST+1]>=48)AND(BUFFER[FIRST+1]<=57)THEN C:= C*10+BUFFER[FIRST+1]-48*11 ELSE C:=C-48;WHILE C>0 DO BEGIN GETNEXT; {743:} IF CURCMD=39 THEN BEGIN IF STRREF[CURMOD]<127 THEN IF STRREF[CURMOD]>1 THEN STRREF[CURMOD]:=STRREF[CURMOD]-1 ELSE FLUSHSTRING(CURMOD);END{:743} ;C:=C-1;END;CURCMD:=S1;CURMOD:=S2;CURSYM:=S3;OKTOINTERRUP:=TRUE; BEGIN HELPPTR:=2;HELPLINE[1]:=278;HELPLINE[0]:=279;END;SHOWCONTEXT; GOTO 22;END{:83};{68:BEGIN DEBUGHELP;GOTO 22;END;} 69:IF FILEPTR>0 THEN BEGIN IF EDITFILE(INPUTSTACK[FILEPTR],LINE)THEN BEGIN IF CONTINUEQUAL THEN BEGIN SHOWCONTEXT;GOTO 22; END ELSE BEGIN INTERACTION:=2;JUMPOUT;END END ELSE BEGIN PRINTNL(264); PRINT(INPUTSTACK[FILEPTR].NAMEFIELD);PRINT(265);PRINTINT(LINE); INTERACTION:=2;JUMPOUT;END END;72:{84:} BEGIN IF USEERRHELP THEN BEGIN{85:}J:=STRSTART[ERRHELP]; WHILE J37 THEN PRINT(STRPOOL [J])ELSE IF J+1=STRSTART[ERRHELP+1]THEN PRINTLN ELSE IF STRPOOL[J+1]<>37 THEN PRINTLN ELSE BEGIN J:=J+1;PRINTCHAR(37);END;J:=J+1;END{:85}; USEERRHELP:=FALSE;END ELSE BEGIN IF HELPPTR=0 THEN BEGIN HELPPTR:=2; HELPLINE[1]:=280;HELPLINE[0]:=281;END;REPEAT HELPPTR:=HELPPTR-1; PRINT(HELPLINE[HELPPTR]);PRINTLN;UNTIL HELPPTR=0;END;BEGIN HELPPTR:=4; HELPLINE[3]:=282;HELPLINE[2]:=281;HELPLINE[1]:=283;HELPLINE[0]:=284;END; GOTO 22;END{:84};73:{82:}BEGIN BEGINFILEREA; IF LAST>FIRST+1 THEN BEGIN CURINPUT.LOCFIELD:=FIRST+1;BUFFER[FIRST]:=32; END ELSE BEGIN BEGIN WAKEUPTERMIN;PRINT(277);TERMINPUT;END; CURINPUT.LOCFIELD:=FIRST;END;FIRST:=LAST+1;CURINPUT.LIMITFIELD:=LAST; GOTO 10;END{:82};81,82,83:{81:}BEGIN ERRORCOUNT:=0;INTERACTION:=0+C-81; PRINT(272);CASE C OF 81:PRINT(273);82:PRINT(274);83:PRINT(275);END; PRINT(276);PRINTLN;IF ODD(SELECTOR)THEN WRITELN(TERMOUT); IF C=81 THEN SELECTOR:=SELECTOR-1;GOTO 10;END{:81}; 88:BEGIN INTERACTION:=2;JUMPOUT;END;OTHERWISE END;{80:}BEGIN PRINT(266); PRINTNL(267);PRINTNL(268);IF FILEPTR>0 THEN PRINT(269); IF DELETIONSALL THEN PRINTNL(270);PRINTNL(271);END{:80}{:79};END{:78}; ERRORCOUNT:=ERRORCOUNT+1;IF ERRORCOUNT=100 THEN BEGIN PRINTNL(262); HISTORY:=3;JUMPOUT;END;{86:}IF INTERACTION>0 THEN SELECTOR:=SELECTOR-1; IF USEERRHELP THEN BEGIN PRINTNL(285);{85:}J:=STRSTART[ERRHELP]; WHILE J37 THEN PRINT(STRPOOL [J])ELSE IF J+1=STRSTART[ERRHELP+1]THEN PRINTLN ELSE IF STRPOOL[J+1]<>37 THEN PRINTLN ELSE BEGIN J:=J+1;PRINTCHAR(37);END;J:=J+1;END{:85}; END ELSE WHILE HELPPTR>0 DO BEGIN HELPPTR:=HELPPTR-1; PRINTNL(HELPLINE[HELPPTR]);END;PRINTLN; IF INTERACTION>0 THEN SELECTOR:=SELECTOR+1;PRINTLN{:86};10:END;{:77} {88:}PROCEDURE FATALERROR(S:STRNUMBER);BEGIN NORMALIZESEL; BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT; REWRITE(TEMPFILE);PRINT(286);END;BEGIN HELPPTR:=1;HELPLINE[0]:=S;END; BEGIN IF INTERACTION=3 THEN INTERACTION:=2;IF LOGOPENED THEN ERROR; {IF INTERACTION>0 THEN DEBUGHELP;}HISTORY:=3;JUMPOUT;END;END;{:88}{89:} PROCEDURE OVERFLOW(S:STRNUMBER;N:INTEGER);BEGIN NORMALIZESEL; BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT; REWRITE(TEMPFILE);PRINT(287);END;PRINT(S);PRINTCHAR(61);PRINTINT(N); PRINTCHAR(93);BEGIN HELPPTR:=2;HELPLINE[1]:=288;HELPLINE[0]:=289;END; BEGIN IF INTERACTION=3 THEN INTERACTION:=2;IF LOGOPENED THEN ERROR; {IF INTERACTION>0 THEN DEBUGHELP;}HISTORY:=3;JUMPOUT;END;END;{:89}{90:} PROCEDURE CONFUSION(S:STRNUMBER);BEGIN NORMALIZESEL; IF HISTORY<2 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(290);END;PRINT(S); PRINTCHAR(41);BEGIN HELPPTR:=1;HELPLINE[0]:=291;END; END ELSE BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(292);END;BEGIN HELPPTR:=2; HELPLINE[1]:=293;HELPLINE[0]:=294;END;END; BEGIN IF INTERACTION=3 THEN INTERACTION:=2;IF LOGOPENED THEN ERROR; {IF INTERACTION>0 THEN DEBUGHELP;}HISTORY:=3;JUMPOUT;END;END;{:90}{:4} {26:}FUNCTION AOPENIN(VAR F:ALPHAFILE):BOOLEAN; BEGIN open(F,NAMEOFFILE, readonly ,user_action:=USERRESET, error:=continue); IF STATUS(F)>0 THEN AOPENIN:=FALSE ELSE BEGIN RESET(F,error:=continue); AOPENIN:=STATUS(F)<=0;END;END; FUNCTION AOPENOUT(VAR F:ALPHAFILE):BOOLEAN; BEGIN open(F,NAMEOFFILE, new ,16383,disposition:=delete, default := DEFAULTNAME,user_action:=USERREWRITE,error:=continue); IF STATUS(F)>0 THEN AOPENOUT:=FALSE ELSE BEGIN LINELIMIT(F,MAXINT); REWRITE(F,error:=continue);AOPENOUT:=STATUS(F)<=0;END;END; FUNCTION BOPENOUT(VAR F:BYTEFILE):BOOLEAN; BEGIN open(F,NAMEOFFILE, new ,disposition:=delete, default :=DEFAULTNAME ,user_action:=USERREWRITE,error:=continue); IF STATUS(F)>0 THEN BOPENOUT:=FALSE ELSE BEGIN REWRITE(F,error:=continue );BOPENOUT:=STATUS(F)<=0;END;END; FUNCTION WOPENIN(VAR F:WORDFILE):BOOLEAN; BEGIN open(F,NAMEOFFILE, readonly ,user_action:=USERRESET, error:=continue); IF STATUS(F)>0 THEN WOPENIN:=FALSE ELSE BEGIN RESET(F,error:=continue); WOPENIN:=STATUS(F)<=0;END;BASECOUNT:=0;END; FUNCTION WOPENOUT(VAR F:WORDFILE):BOOLEAN; BEGIN open(F,NAMEOFFILE, new ,disposition:=delete, default :=DEFAULTNAME ,user_action:=USERREWRITE,error:=continue); IF STATUS(F)>0 THEN WOPENOUT:=FALSE ELSE BEGIN REWRITE(F,error:=continue );WOPENOUT:=STATUS(F)<=0;END;BASECOUNT:=0;END;{:26}{27:} PROCEDURE ACLOSE(VAR F:ALPHAFILE); BEGIN CLOSE(F,disposition:=save,error:=continue);END; PROCEDURE BCLOSE(VAR F:BYTEFILE); BEGIN CLOSE(F,disposition:=save,error:=continue);END; PROCEDURE WCLOSE(VAR F:WORDFILE); BEGIN CLOSE(F,disposition:=save,error:=continue);END;{:27}{30:} FUNCTION INPUTLN(VAR F:ALPHAFILE;BYPASSEOLN:BOOLEAN):BOOLEAN;LABEL 40; VAR LEN:INTEGER;K:0..BUFSIZE;BEGIN LAST:=FIRST; IF STATUS(F)<>0 THEN INPUTLN:=FALSE ELSE BEGIN WHILE NOT EOLN(F)DO BEGIN READ(F,AUXBUF,error:=continue);LEN:=AUXBUF.length; IF LAST+LEN>=MAXBUFSTACK THEN BEGIN IF LAST+LENFIRST THEN IF BUFFER[LAST-1]=32 THEN BEGIN LAST:=LAST-1; GOTO 40;END;INPUTLN:=TRUE;READLN(F,error:=continue);END;END;{:30}{36:} FUNCTION INITTERMINAL:BOOLEAN;LABEL 10; VAR USERSCOMMAND:PACKED ARRAY[1..300]OF CHAR;LEN:SIXTEENBITS;I:INTEGER; BEGIN BEGIN open(TERMIN, 'SYS$INPUT' );RESET(TERMIN); INFAB:= PAS$FAB(TERMIN);INRAB:= PAS$RAB(TERMIN);END; IF CMDLINEPRESE THEN cli$get_value('COMMAND_LINE',USERSCOMMAND,LEN)ELSE lib$get_foreign(USERSCOMMAND,,LEN);I:=1; WHILE(I<=LEN)AND(USERSCOMMAND[I]=' ')DO I:=I+1; IF I<=LEN THEN BEGIN CURINPUT.LOCFIELD:=FIRST;LAST:=FIRST; WHILE I<=LEN DO BEGIN BUFFER[LAST]:=XORD[USERSCOMMAND[I]]; IF CMDLINEPRESE THEN IF(BUFFER[LAST]>=65)AND(BUFFER[LAST]<=90)THEN BUFFER[LAST]:=BUFFER[LAST]+32;LAST:=LAST+1;I:=I+1;END; INITTERMINAL:=TRUE;GOTO 10;END;WHILE TRUE DO BEGIN WAKEUPTERMIN; WRITE(TERMOUT,'**');IF ODD(SELECTOR)THEN WRITELN(TERMOUT); IF NOT INPUTLN(TERMIN,TRUE)THEN BEGIN WRITE(TERMOUT,CHR(13),CHR(10)); WRITELN(TERMOUT,'! End of file on the terminal... why?',CHR(13),CHR(10)) ;INITTERMINAL:=FALSE;GOTO 10;END;CURINPUT.LOCFIELD:=FIRST; WHILE(CURINPUT.LOCFIELDBUFFER[K]THEN BEGIN RESULT :=FALSE;GOTO 45;END;J:=J+1;K:=K+1;END;RESULT:=TRUE;45:STREQBUF:=RESULT; END;{:45}{46:}FUNCTION STRVSSTR(S,T:STRNUMBER):INTEGER;LABEL 10; VAR J,K:POOLPOINTER;LS,LT:INTEGER;L:INTEGER; BEGIN LS:=(STRSTART[S+1]-STRSTART[S]);LT:=(STRSTART[T+1]-STRSTART[T]); IF LS<=LT THEN L:=LS ELSE L:=LT;J:=STRSTART[S];K:=STRSTART[T]; WHILE L>0 DO BEGIN IF STRPOOL[J]<>STRPOOL[K]THEN BEGIN STRVSSTR:=STRPOOL [J]-STRPOOL[K];GOTO 10;END;J:=J+1;K:=K+1;L:=L-1;END;STRVSSTR:=LS-LT; 10:END;{:46}{47:}FUNCTION GETSTRINGSST:BOOLEAN;LABEL 30,10; VAR K,L:0..255;M,N:CHAR;G:STRNUMBER;A:INTEGER;C:BOOLEAN; BEGIN POOLPTR:=0;STRPTR:=0;MAXPOOLPTR:=0;MAXSTRPTR:=0;STRSTART[0]:=0; {48:}FOR K:=0 TO 255 DO BEGIN IF({49:}(K<32)OR(K>126){:49} )THEN BEGIN BEGIN STRPOOL[POOLPTR]:=94;POOLPTR:=POOLPTR+1;END; BEGIN STRPOOL[POOLPTR]:=94;POOLPTR:=POOLPTR+1;END; IF K<64 THEN BEGIN STRPOOL[POOLPTR]:=K+64;POOLPTR:=POOLPTR+1; END ELSE IF K<128 THEN BEGIN STRPOOL[POOLPTR]:=K-64;POOLPTR:=POOLPTR+1; END ELSE BEGIN L:=K DIV 16;IF L<10 THEN BEGIN STRPOOL[POOLPTR]:=L+48; POOLPTR:=POOLPTR+1;END ELSE BEGIN STRPOOL[POOLPTR]:=L+87; POOLPTR:=POOLPTR+1;END;L:=K MOD 16; IF L<10 THEN BEGIN STRPOOL[POOLPTR]:=L+48;POOLPTR:=POOLPTR+1; END ELSE BEGIN STRPOOL[POOLPTR]:=L+87;POOLPTR:=POOLPTR+1;END;END; END ELSE BEGIN STRPOOL[POOLPTR]:=K;POOLPTR:=POOLPTR+1;END;G:=MAKESTRING; STRREF[G]:=127;END{:48};{51:}NAMEOFFILE:=POOLNAME; IF AOPENIN(POOLFILE)THEN BEGIN C:=FALSE;REPEAT{52:} BEGIN IF EOF(POOLFILE)THEN BEGIN WAKEUPTERMIN; WRITELN(TERMOUT,'! MF.POOL has no check sum.',CHR(13),CHR(10)); ACLOSE(POOLFILE);GETSTRINGSST:=FALSE;GOTO 10;END;READ(POOLFILE,M,N); IF M='*'THEN{53:}BEGIN A:=0;K:=1; WHILE TRUE DO BEGIN IF(XORD[N]<48)OR(XORD[N]>57)THEN BEGIN WAKEUPTERMIN; WRITELN(TERMOUT,'! MF.POOL check sum doesn''t have nine digits.',CHR(13) ,CHR(10));ACLOSE(POOLFILE);GETSTRINGSST:=FALSE;GOTO 10;END; A:=10*A+XORD[N]-48;IF K=9 THEN GOTO 30;K:=K+1;READ(POOLFILE,N);END; 30:IF A<>531421597 THEN BEGIN WAKEUPTERMIN; WRITELN(TERMOUT,'! MF.POOL doesn''t match; TANGLE me again.',CHR(13),CHR (10));ACLOSE(POOLFILE);GETSTRINGSST:=FALSE;GOTO 10;END;C:=TRUE;END{:53} ELSE BEGIN IF(XORD[M]<48)OR(XORD[M]>57)OR(XORD[N]<48)OR(XORD[N]>57)THEN BEGIN WAKEUPTERMIN; WRITELN(TERMOUT,'! MF.POOL line doesn''t begin with two digits.',CHR(13) ,CHR(10));ACLOSE(POOLFILE);GETSTRINGSST:=FALSE;GOTO 10;END; L:=XORD[M]*10+XORD[N]-48*11; IF POOLPTR+L+STRINGVACANC>POOLSIZE THEN BEGIN WAKEUPTERMIN; WRITELN(TERMOUT,'! You have to increase POOLSIZE.',CHR(13),CHR(10)); ACLOSE(POOLFILE);GETSTRINGSST:=FALSE;GOTO 10;END; FOR K:=1 TO L DO BEGIN IF EOLN(POOLFILE)THEN M:=' 'ELSE READ(POOLFILE,M) ;BEGIN STRPOOL[POOLPTR]:=XORD[M];POOLPTR:=POOLPTR+1;END;END; READLN(POOLFILE);G:=MAKESTRING;STRREF[G]:=127;END;END{:52};UNTIL C; ACLOSE(POOLFILE);GETSTRINGSST:=TRUE;END ELSE BEGIN WAKEUPTERMIN; WRITELN(TERMOUT,'! I can''t read MF.POOL.',CHR(13),CHR(10)); ACLOSE(POOLFILE);GETSTRINGSST:=FALSE;GOTO 10;END{:51};10:END;{:47}{65:} PROCEDURE PRINTDD(N:INTEGER);BEGIN N:=ABS(N)MOD 100; PRINTCHAR(48+(N DIV 10));PRINTCHAR(48+(N MOD 10));END;{:65}{66:} PROCEDURE TERMINPUT;VAR K:0..BUFSIZE; BEGIN IF ODD(SELECTOR)THEN WRITELN(TERMOUT); IF NOT INPUTLN(TERMIN,TRUE)THEN FATALERROR(260);INRAB^.RAB$V_PTA:=FALSE; TERMOFFSET:=0;SELECTOR:=SELECTOR-1; IF LAST<>FIRST THEN FOR K:=FIRST TO LAST-1 DO PRINT(BUFFER[K]);PRINTLN; BUFFER[LAST]:=37;SELECTOR:=SELECTOR+1;END;{:66}{87:} PROCEDURE NORMALIZESEL; BEGIN IF LOGOPENED THEN SELECTOR:=3 ELSE SELECTOR:=1; IF JOBNAME=0 THEN OPENLOGFILE; IF INTERACTION=0 THEN SELECTOR:=SELECTOR-1;END;{:87}{93:} PROCEDURE PAUSEFORINST;BEGIN IF OKTOINTERRUP THEN BEGIN INTERACTION:=3; IF(SELECTOR=2)OR(SELECTOR=0)THEN SELECTOR:=SELECTOR+1; BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT; REWRITE(TEMPFILE);PRINT(295);END;BEGIN HELPPTR:=3;HELPLINE[2]:=296; HELPLINE[1]:=297;HELPLINE[0]:=298;END;DELETIONSALL:=FALSE;ERROR; DELETIONSALL:=TRUE;INTERRUPT:=0;END;END;{:93}{94:} PROCEDURE MISSINGERR(S:STRNUMBER); BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(299);END;PRINT(S);PRINT(300); END;{:94}{99:}PROCEDURE CLEARARITH; BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(301);END;BEGIN HELPPTR:=4; HELPLINE[3]:=302;HELPLINE[2]:=303;HELPLINE[1]:=304;HELPLINE[0]:=305;END; ERROR;ARITHERROR:=FALSE;END;{:99}{100:} FUNCTION SLOWADD(X,Y:INTEGER):INTEGER; BEGIN IF X>=0 THEN IF Y<=2147483647-X THEN SLOWADD:=X+Y ELSE BEGIN ARITHERROR:=TRUE;SLOWADD:=2147483647; END ELSE IF-Y<=2147483647+X THEN SLOWADD:=X+Y ELSE BEGIN ARITHERROR:= TRUE;SLOWADD:=-2147483647;END;END;{:100}{102:} FUNCTION ROUNDDECIMAL(K:SMALLNUMBER):SCALED;VAR A:INTEGER;BEGIN A:=0; WHILE K>0 DO BEGIN K:=K-1;A:=(A+DIG[K]*131072)DIV 10;END; ROUNDDECIMAL:=(A+1)DIV 2;END;{:102}{107:} [external]FUNCTION MAKEFRACTION(P,Q:INTEGER):FRACTION;EXTERN;{:107} {111:}[external]FUNCTION TAKEFRACTION(Q:INTEGER;F:FRACTION):INTEGER; EXTERN;{:111}{113:}[external]FUNCTION TAKESCALED(Q:INTEGER; F:SCALED):INTEGER;EXTERN;{:113}{115:} [external]FUNCTION MAKESCALED(P,Q:INTEGER):SCALED;EXTERN;{:115}{116:} FUNCTION VELOCITY(ST,CT,SF,CF:FRACTION;T:SCALED):FRACTION; VAR ACC,NUM,DENOM:INTEGER; BEGIN ACC:=TAKEFRACTION(ST-(SF DIV 16),SF-(ST DIV 16)); ACC:=TAKEFRACTION(ACC,CT-CF);NUM:=536870912+TAKEFRACTION(ACC,379625062); DENOM:=805306368+TAKEFRACTION(CT,497706707)+TAKEFRACTION(CF,307599661); IF T<>65536 THEN NUM:=MAKESCALED(NUM,T); IF NUM DIV 4>=DENOM THEN VELOCITY:=1073741824 ELSE VELOCITY:= MAKEFRACTION(NUM,DENOM);END;{:116}{117:} FUNCTION ABVSCD(A,B,C,D:INTEGER):INTEGER;LABEL 10;VAR Q,R:INTEGER; BEGIN{118:}IF A<0 THEN BEGIN A:=-A;B:=-B;END;IF C<0 THEN BEGIN C:=-C; D:=-D;END; IF D<=0 THEN BEGIN IF B>=0 THEN IF((A=0)OR(B=0))AND((C=0)OR(D=0))THEN BEGIN ABVSCD:=0;GOTO 10;END ELSE BEGIN ABVSCD:=1;GOTO 10;END; IF D=0 THEN IF A=0 THEN BEGIN ABVSCD:=0;GOTO 10; END ELSE BEGIN ABVSCD:=-1;GOTO 10;END;Q:=A;A:=C;C:=Q;Q:=-B;B:=-D;D:=Q; END ELSE IF B<=0 THEN BEGIN IF B<0 THEN IF A>0 THEN BEGIN ABVSCD:=-1; GOTO 10;END;IF C=0 THEN BEGIN ABVSCD:=0;GOTO 10; END ELSE BEGIN ABVSCD:=-1;GOTO 10;END;END{:118}; WHILE TRUE DO BEGIN Q:=A DIV D;R:=C DIV B; IF Q<>R THEN IF Q>R THEN BEGIN ABVSCD:=1;GOTO 10; END ELSE BEGIN ABVSCD:=-1;GOTO 10;END;Q:=A MOD D;R:=C MOD B; IF R=0 THEN IF Q=0 THEN BEGIN ABVSCD:=0;GOTO 10; END ELSE BEGIN ABVSCD:=1;GOTO 10;END;IF Q=0 THEN BEGIN ABVSCD:=-1; GOTO 10;END;A:=B;B:=Q;C:=D;D:=R;END;10:END;{:117}{119:} FUNCTION FLOORSCALED(X:SCALED):SCALED;VAR BECAREFUL:INTEGER; BEGIN IF X>=0 THEN FLOORSCALED:=X-(X MOD 65536)ELSE BEGIN BECAREFUL:=X+1 ;FLOORSCALED:=X+((-BECAREFUL)MOD 65536)-65535;END;END; FUNCTION FLOORUNSCALE(X:SCALED):INTEGER;VAR BECAREFUL:INTEGER; BEGIN IF X>=0 THEN FLOORUNSCALE:=X DIV 65536 ELSE BEGIN BECAREFUL:=X+1; FLOORUNSCALE:=-(1+((-BECAREFUL)DIV 65536));END;END; FUNCTION ROUNDUNSCALE(X:SCALED):INTEGER;VAR BECAREFUL:INTEGER; BEGIN IF X>=32768 THEN ROUNDUNSCALE:=1+((X-32768)DIV 65536)ELSE IF X>= -32768 THEN ROUNDUNSCALE:=0 ELSE BEGIN BECAREFUL:=X+1; ROUNDUNSCALE:=-(1+((-BECAREFUL-32768)DIV 65536));END;END; FUNCTION ROUNDFRACTIO(X:FRACTION):SCALED;VAR BECAREFUL:INTEGER; BEGIN IF X>=2048 THEN ROUNDFRACTIO:=1+((X-2048)DIV 4096)ELSE IF X>=-2048 THEN ROUNDFRACTIO:=0 ELSE BEGIN BECAREFUL:=X+1; ROUNDFRACTIO:=-(1+((-BECAREFUL-2048)DIV 4096));END;END;{:119}{121:} FUNCTION SQUARERT(X:SCALED):SCALED;VAR K:SMALLNUMBER;Y,Q:INTEGER; BEGIN IF X<=0 THEN{122:} BEGIN IF X<0 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(306);END; PRINTSCALED(X);PRINT(307);BEGIN HELPPTR:=2;HELPLINE[1]:=308; HELPLINE[0]:=309;END;ERROR;END;SQUARERT:=0;END{:122}ELSE BEGIN K:=23; Q:=2;WHILE X<536870912 DO BEGIN K:=K-1;X:=X+X+X+X;END; IF X<1073741824 THEN Y:=0 ELSE BEGIN X:=X-1073741824;Y:=1;END; REPEAT{123:}X:=X+X;Y:=Y+Y;IF X>=1073741824 THEN BEGIN X:=X-1073741824; Y:=Y+1;END;X:=X+X;Y:=Y+Y-Q;Q:=Q+Q; IF X>=1073741824 THEN BEGIN X:=X-1073741824;Y:=Y+1;END; IF Y>Q THEN BEGIN Y:=Y-Q;Q:=Q+2;END ELSE IF Y<=0 THEN BEGIN Q:=Q-2; Y:=Y+Q;END;K:=K-1{:123};UNTIL K=0;SQUARERT:=(Q)DIV 2;END;END;{:121} {124:}FUNCTION PYTHADD(A,B:INTEGER):INTEGER;LABEL 30;VAR R:FRACTION; BIG:BOOLEAN;BEGIN A:=ABS(A);B:=ABS(B);IF A0 THEN BEGIN IF A<536870912 THEN BIG:=FALSE ELSE BEGIN A:=A DIV 4; B:=B DIV 4;BIG:=TRUE;END;{125:}WHILE TRUE DO BEGIN R:=MAKEFRACTION(B,A); R:=TAKEFRACTION(R,R);IF R=0 THEN GOTO 30; R:=MAKEFRACTION(R,1073741824+R);A:=A+TAKEFRACTION(A+A,R); B:=TAKEFRACTION(B,R);END;30:{:125}; IF BIG THEN IF A<536870912 THEN A:=A+A+A+A ELSE BEGIN ARITHERROR:=TRUE; A:=2147483647;END;END;PYTHADD:=A;END;{:124}{126:} FUNCTION PYTHSUB(A,B:INTEGER):INTEGER;LABEL 30;VAR R:FRACTION; BIG:BOOLEAN;BEGIN A:=ABS(A);B:=ABS(B);IF A<=B THEN{128:} BEGIN IF A1073741828 DO{133:} BEGIN Z:=((X-1)DIV TWOTOTHE[K])+1; WHILE X<1073741824+Z DO BEGIN Z:=(Z+1)DIV 2;K:=K+1;END;Y:=Y+SPECLOG[K]; X:=X-Z;END{:133};MLOG:=Y DIV 8;END;END;{:132}{135:} FUNCTION MEXP(X:SCALED):SCALED;VAR K:SMALLNUMBER;Y,Z:INTEGER; BEGIN IF X>174436200 THEN BEGIN ARITHERROR:=TRUE;MEXP:=2147483647; END ELSE IF X<-197694359 THEN MEXP:=0 ELSE BEGIN IF X<=0 THEN BEGIN Z:= -8*X;Y:=1048576; END ELSE BEGIN IF X<=127919879 THEN Z:=1023359037-8*X ELSE Z:=8*( 174436200-X);Y:=2147483647;END;{136:}K:=1; WHILE Z>0 DO BEGIN WHILE Z>=SPECLOG[K]DO BEGIN Z:=Z-SPECLOG[K]; Y:=Y-1-((Y-TWOTOTHE[K-1])DIV TWOTOTHE[K]);END;K:=K+1;END{:136}; IF X<=127919879 THEN MEXP:=(Y+8)DIV 16 ELSE MEXP:=Y;END;END;{:135}{139:} FUNCTION NARG(X,Y:INTEGER):ANGLE;VAR Z:ANGLE;T:INTEGER;K:SMALLNUMBER; OCTANT:1..8;BEGIN IF X>=0 THEN OCTANT:=1 ELSE BEGIN X:=-X;OCTANT:=2;END; IF Y<0 THEN BEGIN Y:=-Y;OCTANT:=OCTANT+2;END;IF X=536870912 DO BEGIN X:=(X)DIV 2;Y:=(Y)DIV 2;END; Z:=0;IF Y>0 THEN BEGIN WHILE X<268435456 DO BEGIN X:=X+X;Y:=Y+Y;END; {143:}K:=0;REPEAT Y:=Y+Y;K:=K+1;IF Y>X THEN BEGIN Z:=Z+SPECATAN[K];T:=X; X:=X+(Y DIV TWOTOTHE[K+K]);Y:=Y-T;END;UNTIL K=15;REPEAT Y:=Y+Y;K:=K+1; IF Y>X THEN BEGIN Z:=Z+SPECATAN[K];Y:=Y-X;END;UNTIL K=26{:143};END{:142} ;{141:}CASE OCTANT OF 1:NARG:=Z;5:NARG:=94371840-Z;6:NARG:=94371840+Z; 2:NARG:=188743680-Z;4:NARG:=Z-188743680;8:NARG:=-Z-94371840; 7:NARG:=Z-94371840;3:NARG:=-Z;END{:141};END;END;{:139}{145:} PROCEDURE NSINCOS(Z:ANGLE);VAR K:SMALLNUMBER;Q:0..7;R:FRACTION; X,Y,T:INTEGER;BEGIN WHILE Z<0 DO Z:=Z+377487360;Z:=Z MOD 377487360; Q:=Z DIV 47185920;Z:=Z MOD 47185920;X:=268435456;Y:=X; IF NOT ODD(Q)THEN Z:=47185920-Z;{147:}K:=1; WHILE Z>0 DO BEGIN IF Z>=SPECATAN[K]THEN BEGIN Z:=Z-SPECATAN[K];T:=X; X:=T+Y DIV TWOTOTHE[K];Y:=Y-T DIV TWOTOTHE[K];END;K:=K+1;END; IF Y<0 THEN Y:=0{:147};{146:}CASE Q OF 0:;1:BEGIN T:=X;X:=Y;Y:=T;END; 2:BEGIN T:=X;X:=-Y;Y:=T;END;3:X:=-X;4:BEGIN X:=-X;Y:=-Y;END; 5:BEGIN T:=X;X:=-Y;Y:=-T;END;6:BEGIN T:=X;X:=Y;Y:=-T;END;7:Y:=-Y; END{:146};R:=PYTHADD(X,Y);NCOS:=MAKEFRACTION(X,R); NSIN:=MAKEFRACTION(Y,R);END;{:145}{149:}PROCEDURE NEWRANDOMS; VAR K:0..54;X:FRACTION; BEGIN FOR K:=0 TO 23 DO BEGIN X:=RANDOMS[K]-RANDOMS[K+31]; IF X<0 THEN X:=X+268435456;RANDOMS[K]:=X;END; FOR K:=24 TO 54 DO BEGIN X:=RANDOMS[K]-RANDOMS[K-24]; IF X<0 THEN X:=X+268435456;RANDOMS[K]:=X;END;JRANDOM:=54;END;{:149} {150:}PROCEDURE INITRANDOMS(SEED:SCALED);VAR J,JJ,K:FRACTION;I:0..54; BEGIN J:=ABS(SEED);WHILE J>=268435456 DO J:=(J)DIV 2;K:=1; FOR I:=0 TO 54 DO BEGIN JJ:=K;K:=J-K;J:=JJ;IF K<0 THEN K:=K+268435456; RANDOMS[(I*21)MOD 55]:=J;END;NEWRANDOMS;NEWRANDOMS;NEWRANDOMS;END;{:150} {151:}FUNCTION UNIFRAND(X:SCALED):SCALED;VAR Y:SCALED; BEGIN IF JRANDOM=0 THEN NEWRANDOMS ELSE JRANDOM:=JRANDOM-1; Y:=TAKEFRACTION(ABS(X),RANDOMS[JRANDOM]); IF Y=ABS(X)THEN UNIFRAND:=0 ELSE IF X>0 THEN UNIFRAND:=Y ELSE UNIFRAND:= -Y;END;{:151}{152:}FUNCTION NORMRAND:SCALED;VAR X,U,L:INTEGER; BEGIN REPEAT REPEAT IF JRANDOM=0 THEN NEWRANDOMS ELSE JRANDOM:=JRANDOM-1 ;X:=TAKEFRACTION(112429,RANDOMS[JRANDOM]-134217728); IF JRANDOM=0 THEN NEWRANDOMS ELSE JRANDOM:=JRANDOM-1; U:=RANDOMS[JRANDOM];UNTIL ABS(X)=0;NORMRAND:=X;END;{:152} {157:}{PROCEDURE PRINTWORD(W:MEMORYWORD);BEGIN PRINTINT(W.INT); PRINTCHAR(32);PRINTSCALED(W.INT);PRINTCHAR(32); PRINTSCALED(W.INT DIV 4096);PRINTLN;PRINTINT(W.HH.LH);PRINTCHAR(61); PRINTINT(W.HH.B0);PRINTCHAR(58);PRINTINT(W.HH.B1);PRINTCHAR(59); PRINTINT(W.HH.RH);PRINTCHAR(32);PRINTINT(W.QQQQ.B0);PRINTCHAR(58); PRINTINT(W.QQQQ.B1);PRINTCHAR(58);PRINTINT(W.QQQQ.B2);PRINTCHAR(58); PRINTINT(W.QQQQ.B3);END;}{:157}{162:}{217:}PROCEDURE PRINTCAPSULE; FORWARD;PROCEDURE SHOWTOKENLIS(P,Q:INTEGER;L,NULLTALLY:INTEGER); LABEL 10;VAR CLASS,C:SMALLNUMBER;R,V:INTEGER;BEGIN CLASS:=3; TALLY:=NULLTALLY;WHILE(P<>0)AND(TALLYMEMEND)THEN BEGIN PRINT(493);GOTO 10;END; IF P4 THEN PRINT(496)ELSE BEGIN PRINTCHAR(34); SLOWPRINT(MEM[P+1].INT);PRINTCHAR(34);C:=4; END ELSE IF(MEM[P].HH.B1<>11)OR(MEM[P].HH.B0<1)OR(MEM[P].HH.B0>19)THEN PRINT(496)ELSE BEGIN GPOINTER:=P;PRINTCAPSULE;C:=8;END{:219} ELSE BEGIN R:=MEM[P].HH.LH;IF R>=2370 THEN{222:} BEGIN IF R<2520 THEN BEGIN PRINT(498);R:=R-(2370); END ELSE IF R<2670 THEN BEGIN PRINT(499);R:=R-(2520); END ELSE BEGIN PRINT(500);R:=R-(2670);END;PRINTINT(R);PRINTCHAR(41); C:=8;END{:222}ELSE IF R<1 THEN IF R=0 THEN{221:} BEGIN IF CLASS=17 THEN PRINTCHAR(32);PRINT(497);C:=18;END{:221} ELSE PRINT(494)ELSE BEGIN R:=HASH[R].RH; IF(R<0)OR(R>=STRPTR)THEN PRINT(495)ELSE{223:} BEGIN C:=CHARCLASS[STRPOOL[STRSTART[R]]]; IF C=CLASS THEN CASE C OF 9:PRINTCHAR(46);5,6,7,8:; OTHERWISE PRINTCHAR(32)END;PRINT(R);END{:223};END;END{:218};CLASS:=C; P:=MEM[P].HH.RH;END;IF P<>0 THEN PRINT(492);10:END;{:217}{665:} PROCEDURE RUNAWAY;BEGIN IF SCANNERSTATU>2 THEN BEGIN PRINTNL(636); CASE SCANNERSTATU OF 3:PRINT(637);4,5:PRINT(638);6:PRINT(639);END; PRINTLN;SHOWTOKENLIS(MEM[65532].HH.RH,0,ERRORLINE-10,0);END;END;{:665} {:162}{163:}FUNCTION GETAVAIL:HALFWORD;VAR P:HALFWORD;BEGIN P:=AVAIL; IF P<>0 THEN AVAIL:=MEM[AVAIL].HH.RH ELSE IF MEMENDP+1 THEN{170:}BEGIN MEM[P].HH.LH:=R-P; ROVER:=P;GOTO 40;END{:170};IF R=P THEN IF MEM[P+1].HH.RH<>P THEN{171:} BEGIN ROVER:=MEM[P+1].HH.RH;T:=MEM[P+1].HH.LH;MEM[ROVER+1].HH.LH:=T; MEM[T+1].HH.RH:=ROVER;GOTO 40;END{:171};MEM[P].HH.LH:=Q-P{:169}; P:=MEM[P+1].HH.RH;UNTIL P=ROVER; IF S=1073741824 THEN BEGIN GETNODE:=65535;GOTO 10;END; IF LOMEMMAX+2=1998 THEN T:=LOMEMMAX+1000 ELSE T:=LOMEMMAX +1+(HIMEMMIN-LOMEMMAX)DIV 2;IF T>65535 THEN T:=65535; P:=MEM[ROVER+1].HH.LH;Q:=LOMEMMAX;MEM[P+1].HH.RH:=Q; MEM[ROVER+1].HH.LH:=Q;MEM[Q+1].HH.RH:=ROVER;MEM[Q+1].HH.LH:=P; MEM[Q].HH.RH:=65535;MEM[Q].HH.LH:=T-LOMEMMAX;LOMEMMAX:=T; MEM[LOMEMMAX].HH.RH:=0;MEM[LOMEMMAX].HH.LH:=0;ROVER:=Q;GOTO 20;END{:168} ;OVERFLOW(316,MEMMAX+1);40:MEM[R].HH.RH:=0;VARUSED:=VARUSED+S; GETNODE:=R;10:END;{:167}{172:}PROCEDURE FREENODE(P:HALFWORD;S:HALFWORD); VAR Q:HALFWORD;BEGIN MEM[P].HH.LH:=S;MEM[P].HH.RH:=65535; Q:=MEM[ROVER+1].HH.LH;MEM[P+1].HH.LH:=Q;MEM[P+1].HH.RH:=ROVER; MEM[ROVER+1].HH.LH:=P;MEM[Q+1].HH.RH:=P;VARUSED:=VARUSED-S;END;{:172} {173:}PROCEDURE SORTAVAIL;VAR P,Q,R:HALFWORD;OLDROVER:HALFWORD; BEGIN P:=GETNODE(1073741824);P:=MEM[ROVER+1].HH.RH; MEM[ROVER+1].HH.RH:=65535;OLDROVER:=ROVER;WHILE P<>OLDROVER DO{174:} IF P65535 DO BEGIN MEM[MEM[P+1].HH.RH+1].HH.LH:=P; P:=MEM[P+1].HH.RH;END;MEM[P+1].HH.RH:=ROVER;MEM[ROVER+1].HH.LH:=P;END; {:173}{177:}PROCEDURE FLUSHLIST(P:HALFWORD);LABEL 30;VAR Q,R:HALFWORD; BEGIN IF P>=HIMEMMIN THEN IF P<>65534 THEN BEGIN R:=P;REPEAT Q:=R; R:=MEM[R].HH.RH;DYNUSED:=DYNUSED-1;IF R0 DO BEGIN Q:=P;P:=MEM[P].HH.RH; IF Q0 DO BEGIN IF(P>MEMEND)OR(P=LOMEMMAX)OR(P<0)THEN CLOBBERED:=TRUE ELSE IF(MEM[P+1].HH.RH >=LOMEMMAX)OR(MEM[P+1].HH.RH<0)THEN CLOBBERED:=TRUE ELSE IF NOT((MEM[P]. HH.RH=65535))OR(MEM[P].HH.LH<2)OR(P+MEM[P].HH.LH>LOMEMMAX)OR(MEM[MEM[P+1 ].HH.RH+1].HH.LH<>P)THEN CLOBBERED:=TRUE; IF CLOBBERED THEN BEGIN PRINTNL(318);PRINTINT(Q);GOTO 32;END; FOR Q:=P TO P+MEM[P].HH.LH-1 DO BEGIN IF FREE[Q]THEN BEGIN PRINTNL(319); PRINTINT(Q);GOTO 32;END;FREE[Q]:=TRUE;END;Q:=P;P:=MEM[P+1].HH.RH; UNTIL P=ROVER;32:[:182];[183:]P:=0; WHILE P<=LOMEMMAX DO BEGIN IF(MEM[P].HH.RH=65535)THEN BEGIN PRINTNL(320) ;PRINTINT(P);END;WHILE(P<=LOMEMMAX)AND NOT FREE[P]DO P:=P+1; WHILE(P<=LOMEMMAX)AND FREE[P]DO P:=P+1;END[:183];[617:]Q:=13; P:=MEM[Q].HH.RH; WHILE P<>13 DO BEGIN IF MEM[P+1].HH.LH<>Q THEN BEGIN PRINTNL(596); PRINTINT(P);END;P:=MEM[P+1].HH.RH;R:=HIMEMMIN; REPEAT IF MEM[P].HH.LH>=R THEN BEGIN PRINTNL(597);PRINTINT(P);END; R:=MEM[P].HH.LH;Q:=P;P:=MEM[Q].HH.RH;UNTIL R=0;END[:617]; IF PRINTLOCS THEN[184:]BEGIN PRINTNL(321); FOR P:=0 TO LOMEMMAX DO IF NOT FREE[P]AND((P>WASLOMAX)OR WASFREE[P])THEN BEGIN PRINTCHAR(32);PRINTINT(P);END; FOR P:=HIMEMMIN TO MEMEND DO IF NOT FREE[P]AND((P WASMEMEND)OR WASFREE[P])THEN BEGIN PRINTCHAR(32);PRINTINT(P);END; END[:184];FOR P:=0 TO LOMEMMAX DO WASFREE[P]:=FREE[P]; FOR P:=HIMEMMIN TO MEMEND DO WASFREE[P]:=FREE[P];WASMEMEND:=MEMEND; WASLOMAX:=LOMEMMAX;WASHIMIN:=HIMEMMIN;END;}{:180}{185:} {PROCEDURE SEARCHMEM(P:HALFWORD);VAR Q:INTEGER; BEGIN FOR Q:=0 TO LOMEMMAX DO BEGIN IF MEM[Q].HH.RH=P THEN BEGIN PRINTNL (322);PRINTINT(Q);PRINTCHAR(41);END; IF MEM[Q].HH.LH=P THEN BEGIN PRINTNL(323);PRINTINT(Q);PRINTCHAR(41);END; END; FOR Q:=HIMEMMIN TO MEMEND DO BEGIN IF MEM[Q].HH.RH=P THEN BEGIN PRINTNL( 322);PRINTINT(Q);PRINTCHAR(41);END; IF MEM[Q].HH.LH=P THEN BEGIN PRINTNL(323);PRINTINT(Q);PRINTCHAR(41);END; END; [209:]FOR Q:=1 TO 2369 DO BEGIN IF EQTB[Q].RH=P THEN BEGIN PRINTNL(458); PRINTINT(Q);PRINTCHAR(41);END;END[:209];END;}{:185}{189:} PROCEDURE PRINTOP(C:QUARTERWORD); BEGIN IF C<=15 THEN PRINTTYPE(C)ELSE CASE C OF 30:PRINT(348); 31:PRINT(349);32:PRINT(350);33:PRINT(351);34:PRINT(352);35:PRINT(353); 36:PRINT(354);37:PRINT(355);38:PRINT(356);39:PRINT(357);40:PRINT(358); 41:PRINT(359);42:PRINT(360);43:PRINT(361);44:PRINT(362);45:PRINT(363); 46:PRINT(364);47:PRINT(365);48:PRINT(366);49:PRINT(367);50:PRINT(368); 51:PRINT(369);52:PRINT(370);53:PRINT(371);54:PRINT(372);55:PRINT(373); 56:PRINT(374);57:PRINT(375);58:PRINT(376);59:PRINT(377);60:PRINT(378); 61:PRINT(379);62:PRINT(380);63:PRINT(381);64:PRINT(382);65:PRINT(383); 66:PRINT(384);67:PRINT(385);68:PRINT(386);69:PRINTCHAR(43); 70:PRINTCHAR(45);71:PRINTCHAR(42);72:PRINTCHAR(47);73:PRINT(387); 74:PRINT(311);75:PRINT(388);76:PRINT(389);77:PRINTCHAR(60); 78:PRINT(390);79:PRINTCHAR(62);80:PRINT(391);81:PRINTCHAR(61); 82:PRINT(392);83:PRINT(38);84:PRINT(393);85:PRINT(394);86:PRINT(395); 87:PRINT(396);88:PRINT(397);89:PRINT(398);90:PRINT(399);91:PRINT(400); 92:PRINT(401);94:PRINT(402);95:PRINT(403);96:PRINT(404);97:PRINT(405); 98:PRINT(406);99:PRINT(407);100:PRINT(408);OTHERWISE PRINT(409)END;END; {:189}{194:}PROCEDURE FIXDATEANDTI;VAR T:ARRAY[1..7]OF SIGNEDHALFWO; BEGIN $numtim(T);INTERNAL[14]:=T[1]*65536;INTERNAL[15]:=T[2]*65536; INTERNAL[16]:=T[3]*65536;INTERNAL[17]:=(T[4]*60+T[5])*65536;END;{:194} {205:}FUNCTION IDLOOKUP(J,L:INTEGER):HALFWORD;LABEL 40;VAR H:INTEGER; P:HALFWORD;K:HALFWORD;BEGIN IF L=1 THEN{206:}BEGIN P:=BUFFER[J]+1; HASH[P].RH:=P-1;GOTO 40;END{:206};{208:}H:=BUFFER[J]; FOR K:=J+1 TO J+L-1 DO BEGIN H:=H+H+BUFFER[K]; WHILE H>=1777 DO H:=H-1777;END{:208};P:=H+257; WHILE TRUE DO BEGIN IF HASH[P].RH>0 THEN IF(STRSTART[HASH[P].RH+1]- STRSTART[HASH[P].RH])=L THEN IF STREQBUF(HASH[P].RH,J)THEN GOTO 40; IF HASH[P].LH=0 THEN{207:} BEGIN IF HASH[P].RH>0 THEN BEGIN REPEAT IF(HASHUSED=257)THEN OVERFLOW( 457,2100);HASHUSED:=HASHUSED-1;UNTIL HASH[HASHUSED].RH=0; HASH[P].LH:=HASHUSED;P:=HASHUSED;END; BEGIN IF POOLPTR+L>MAXPOOLPTR THEN BEGIN IF POOLPTR+L>POOLSIZE THEN OVERFLOW(257,POOLSIZE-INITPOOLPTR);MAXPOOLPTR:=POOLPTR+L;END;END; FOR K:=J TO J+L-1 DO BEGIN STRPOOL[POOLPTR]:=BUFFER[K]; POOLPTR:=POOLPTR+1;END;HASH[P].RH:=MAKESTRING;STRREF[HASH[P].RH]:=127; STCOUNT:=STCOUNT+1;GOTO 40;END{:207};P:=HASH[P].LH;END;40:IDLOOKUP:=P; END;{:205}{210:}PROCEDURE PRIMITIVE(S:STRNUMBER;C:HALFWORD;O:HALFWORD); VAR K:POOLPOINTER;J:SMALLNUMBER;L:SMALLNUMBER;BEGIN K:=STRSTART[S]; L:=STRSTART[S+1]-K;FOR J:=0 TO L-1 DO BUFFER[J]:=STRPOOL[K+J]; CURSYM:=IDLOOKUP(0,L);IF S>=256 THEN BEGIN FLUSHSTRING(STRPTR-1); HASH[CURSYM].RH:=S;END;EQTB[CURSYM].LH:=C;EQTB[CURSYM].RH:=O;END;{:210} {215:}FUNCTION NEWNUMTOK(V:SCALED):HALFWORD;VAR P:HALFWORD; BEGIN P:=GETNODE(2);MEM[P+1].INT:=V;MEM[P].HH.B0:=16;MEM[P].HH.B1:=12; NEWNUMTOK:=P;END;{:215}{216:}PROCEDURE TOKENRECYCLE;FORWARD; PROCEDURE FLUSHTOKENLI(P:HALFWORD);VAR Q:HALFWORD; BEGIN WHILE P<>0 DO BEGIN Q:=P;P:=MEM[P].HH.RH; IF Q>=HIMEMMIN THEN BEGIN MEM[Q].HH.RH:=AVAIL;AVAIL:=Q; DYNUSED:=DYNUSED-1;END ELSE BEGIN CASE MEM[Q].HH.B0 OF 1,2,16:; 4:BEGIN IF STRREF[MEM[Q+1].INT]<127 THEN IF STRREF[MEM[Q+1].INT]>1 THEN STRREF[MEM[Q+1].INT]:=STRREF[MEM[Q+1].INT]-1 ELSE FLUSHSTRING(MEM[Q+1]. INT);END;3,5,7,12,10,6,9,8,11,14,13,17,18,19:BEGIN GPOINTER:=Q; TOKENRECYCLE;END;OTHERWISE CONFUSION(491)END;FREENODE(Q,2);END;END;END; {:216}{226:}PROCEDURE DELETEMACREF(P:HALFWORD); BEGIN IF MEM[P].HH.LH=0 THEN FLUSHTOKENLI(P)ELSE MEM[P].HH.LH:=MEM[P].HH .LH-1;END;{:226}{227:}{625:}PROCEDURE PRINTCMDMOD(C,M:INTEGER); BEGIN CASE C OF{212:}18:PRINT(462);77:PRINT(461);59:PRINT(464); 72:PRINT(463);79:PRINT(460);32:PRINT(465);81:PRINT(58);82:PRINT(44); 57:PRINT(466);19:PRINT(467);60:PRINT(468);27:PRINT(469);11:PRINT(470); 80:PRINT(459);84:PRINT(453);26:PRINT(471);6:PRINT(472);9:PRINT(473); 70:PRINT(474);73:PRINT(475);13:PRINT(476);46:PRINT(123);63:PRINT(91); 14:PRINT(477);15:PRINT(478);69:PRINT(479);28:PRINT(480);47:PRINT(409); 24:PRINT(481);7:PRINTCHAR(92);65:PRINT(125);64:PRINT(93);12:PRINT(482); 8:PRINT(483);83:PRINT(59);17:PRINT(484);78:PRINT(485);74:PRINT(486); 35:PRINT(487);58:PRINT(488);71:PRINT(489);75:PRINT(490);{:212}{684:} 16:IF M<=2 THEN IF M=1 THEN PRINT(653)ELSE IF M<1 THEN PRINT(454)ELSE PRINT(654)ELSE IF M=53 THEN PRINT(655)ELSE IF M=44 THEN PRINT(656)ELSE PRINT(657); 4:IF M<=1 THEN IF M=1 THEN PRINT(660)ELSE PRINT(455)ELSE IF M=2370 THEN PRINT(658)ELSE PRINT(659);{:684}{689:}61:CASE M OF 1:PRINT(662); 2:PRINTCHAR(64);3:PRINT(663);OTHERWISE PRINT(661)END;{:689}{696:} 56:IF M>=2370 THEN IF M=2370 THEN PRINT(674)ELSE IF M=2520 THEN PRINT( 675)ELSE PRINT(676)ELSE IF M<2 THEN PRINT(677)ELSE IF M=2 THEN PRINT(678 )ELSE PRINT(679);{:696}{710:}3:IF M=0 THEN PRINT(689)ELSE PRINT(615); {:710}{741:}1,2:CASE M OF 1:PRINT(716);2:PRINT(452);3:PRINT(717); OTHERWISE PRINT(718)END;{:741}{894:} 33,34,37,55,45,50,36,43,54,48,51,52:PRINTOP(M);{:894}{1014:} 30:PRINTTYPE(M);{:1014}{1019:}85:IF M=0 THEN PRINT(910)ELSE PRINT(911); {:1019}{1025:}23:CASE M OF 0:PRINT(273);1:PRINT(274);2:PRINT(275); OTHERWISE PRINT(917)END;{:1025}{1028:} 21:IF M=0 THEN PRINT(918)ELSE PRINT(919);{:1028}{1038:} 22:CASE M OF 0:PRINT(933);1:PRINT(934);2:PRINT(935);3:PRINT(936); OTHERWISE PRINT(937)END;{:1038}{1043:} 31,62:BEGIN IF C=31 THEN PRINT(940)ELSE PRINT(941);PRINT(942); PRINT(HASH[M].RH);END;41:IF M=0 THEN PRINT(943)ELSE PRINT(944); 10:PRINT(945);53,44,49:BEGIN PRINTCMDMOD(16,C);PRINT(946);PRINTLN; SHOWTOKENLIS(MEM[MEM[M].HH.RH].HH.RH,0,1000,0);END;5:PRINT(947); 40:PRINT(INTNAME[M]);{:1043}{1053:} 68:IF M=1 THEN PRINT(954)ELSE IF M=0 THEN PRINT(955)ELSE PRINT(956); 66:IF M=6 THEN PRINT(957)ELSE PRINT(958); 67:IF M=0 THEN PRINT(959)ELSE PRINT(960);{:1053}{1080:} 25:IF M<1 THEN PRINT(990)ELSE IF M=1 THEN PRINT(991)ELSE PRINT(992); {:1080}{1102:}20:CASE M OF 0:PRINT(1002);1:PRINT(1003);2:PRINT(1004); 3:PRINT(1005);OTHERWISE PRINT(1006)END;{:1102}{1109:} 76:CASE M OF 0:PRINT(1024);1:PRINT(1025);2:PRINT(1027);3:PRINT(1029); 5:PRINT(1026);6:PRINT(1028);7:PRINT(1030);11:PRINT(1031); OTHERWISE PRINT(1032)END;{:1109}{1180:} 29:IF M=16 THEN PRINT(1057)ELSE PRINT(1056);{:1180} OTHERWISE PRINT(601)END;END;{:625}PROCEDURE SHOWMACRO(P:HALFWORD; Q,L:INTEGER);LABEL 10;VAR R:HALFWORD;BEGIN P:=MEM[P].HH.RH; WHILE MEM[P].HH.LH>7 DO BEGIN R:=MEM[P].HH.RH;MEM[P].HH.RH:=0; SHOWTOKENLIS(P,0,L,0);MEM[P].HH.RH:=R;P:=R; IF L>0 THEN L:=L-TALLY ELSE GOTO 10;END;TALLY:=0; CASE MEM[P].HH.LH OF 0:PRINT(501);1,2,3:BEGIN PRINTCHAR(60); PRINTCMDMOD(56,MEM[P].HH.LH);PRINT(502);END;4:PRINT(503);5:PRINT(504); 6:PRINT(505);7:PRINT(506);END;SHOWTOKENLIS(MEM[P].HH.RH,Q,L-TALLY,0); 10:END;{:227}{232:}PROCEDURE INITBIGNODE(P:HALFWORD);VAR Q:HALFWORD; S:SMALLNUMBER;BEGIN S:=BIGNODESIZE[MEM[P].HH.B0];Q:=GETNODE(S); REPEAT S:=S-2;{586:}BEGIN MEM[Q+S].HH.B0:=19;SERIALNO:=SERIALNO+64; MEM[Q+S+1].INT:=SERIALNO;END{:586};MEM[Q+S].HH.B1:=(S)DIV 2+5; MEM[Q+S].HH.RH:=0;UNTIL S=0;MEM[Q].HH.RH:=P;MEM[P+1].INT:=Q;END;{:232} {233:}FUNCTION IDTRANSFORM:HALFWORD;VAR P,Q,R:HALFWORD; BEGIN P:=GETNODE(2);MEM[P].HH.B0:=13;MEM[P].HH.B1:=11;MEM[P+1].INT:=0; INITBIGNODE(P);Q:=MEM[P+1].INT;R:=Q+12;REPEAT R:=R-2;MEM[R].HH.B0:=16; MEM[R+1].INT:=0;UNTIL R=Q;MEM[Q+5].INT:=65536;MEM[Q+11].INT:=65536; IDTRANSFORM:=P;END;{:233}{234:}PROCEDURE NEWROOT(X:HALFWORD); VAR P:HALFWORD;BEGIN P:=GETNODE(2);MEM[P].HH.B0:=0;MEM[P].HH.B1:=0; MEM[P].HH.RH:=X;EQTB[X].RH:=P;END;{:234}{235:} PROCEDURE PRINTVARIABL(P:HALFWORD);LABEL 40,10;VAR Q:HALFWORD; R:HALFWORD;BEGIN WHILE MEM[P].HH.B1>=5 DO{237:} BEGIN CASE MEM[P].HH.B1 OF 5:PRINTCHAR(120);6:PRINTCHAR(121); 7:PRINT(509);8:PRINT(510);9:PRINT(511);10:PRINT(512); 11:BEGIN PRINT(513);PRINTINT(P-0);GOTO 10;END;END;PRINT(514); P:=MEM[P-2*(MEM[P].HH.B1-5)].HH.RH;END{:237};Q:=0; WHILE MEM[P].HH.B1>1 DO{236:} BEGIN IF MEM[P].HH.B1=3 THEN BEGIN R:=NEWNUMTOK(MEM[P+2].INT); REPEAT P:=MEM[P].HH.RH;UNTIL MEM[P].HH.B1=4; END ELSE IF MEM[P].HH.B1=2 THEN BEGIN P:=MEM[P].HH.RH;GOTO 40; END ELSE BEGIN IF MEM[P].HH.B1<>4 THEN CONFUSION(508);R:=GETAVAIL; MEM[R].HH.LH:=MEM[P+2].HH.LH;END;MEM[R].HH.RH:=Q;Q:=R; 40:P:=MEM[P+2].HH.RH;END{:236};R:=GETAVAIL;MEM[R].HH.LH:=MEM[P].HH.RH; MEM[R].HH.RH:=Q;IF MEM[P].HH.B1=1 THEN PRINT(507); SHOWTOKENLIS(R,0,2147483647,TALLY);FLUSHTOKENLI(R);10:END;{:235}{238:} FUNCTION INTERESTING(P:HALFWORD):BOOLEAN;VAR T:SMALLNUMBER; BEGIN IF INTERNAL[3]>0 THEN INTERESTING:=TRUE ELSE BEGIN T:=MEM[P].HH.B1 ;IF T>=5 THEN IF T<>11 THEN T:=MEM[MEM[P-2*(T-5)].HH.RH].HH.B1; INTERESTING:=(T<>11);END;END;{:238}{239:} FUNCTION NEWSTRUCTURE(P:HALFWORD):HALFWORD;VAR Q,R:HALFWORD; BEGIN CASE MEM[P].HH.B1 OF 0:BEGIN Q:=MEM[P].HH.RH;R:=GETNODE(2); EQTB[Q].RH:=R;END;3:{240:}BEGIN Q:=P;REPEAT Q:=MEM[Q].HH.RH; UNTIL MEM[Q].HH.B1=4;Q:=MEM[Q+2].HH.RH;R:=Q+1;REPEAT Q:=R; R:=MEM[R].HH.RH;UNTIL R=P;R:=GETNODE(3);MEM[Q].HH.RH:=R; MEM[R+2].INT:=MEM[P+2].INT;END{:240};4:{241:}BEGIN Q:=MEM[P+2].HH.RH; R:=MEM[Q+1].HH.LH;REPEAT Q:=R;R:=MEM[R].HH.RH;UNTIL R=P;R:=GETNODE(3); MEM[Q].HH.RH:=R;MEM[R+2]:=MEM[P+2]; IF MEM[P+2].HH.LH=0 THEN BEGIN Q:=MEM[P+2].HH.RH+1; WHILE MEM[Q].HH.RH<>P DO Q:=MEM[Q].HH.RH;MEM[Q].HH.RH:=R;END;END{:241}; OTHERWISE CONFUSION(515)END;MEM[R].HH.RH:=MEM[P].HH.RH;MEM[R].HH.B0:=21; MEM[R].HH.B1:=MEM[P].HH.B1;MEM[R+1].HH.LH:=P;MEM[P].HH.B1:=2; Q:=GETNODE(3);MEM[P].HH.RH:=Q;MEM[R+1].HH.RH:=Q;MEM[Q+2].HH.RH:=R; MEM[Q].HH.B0:=0;MEM[Q].HH.B1:=4;MEM[Q].HH.RH:=17;MEM[Q+2].HH.LH:=0; NEWSTRUCTURE:=R;END;{:239}{242:} FUNCTION FINDVARIABLE(T:HALFWORD):HALFWORD;LABEL 10; VAR P,Q,R,S:HALFWORD;PP,QQ,RR,SS:HALFWORD;N:INTEGER;SAVEWORD:MEMORYWORD; BEGIN P:=MEM[T].HH.LH;T:=MEM[T].HH.RH; IF EQTB[P].LH MOD 86<>41 THEN BEGIN FINDVARIABLE:=0;GOTO 10;END; IF EQTB[P].RH=0 THEN NEWROOT(P);P:=EQTB[P].RH;PP:=P; WHILE T<>0 DO BEGIN{243:} IF MEM[PP].HH.B0<>21 THEN BEGIN IF MEM[PP].HH.B0>21 THEN BEGIN FINDVARIABLE:=0;GOTO 10;END;SS:=NEWSTRUCTURE(PP);IF P=PP THEN P:=SS; PP:=SS;END;IF MEM[P].HH.B0<>21 THEN P:=NEWSTRUCTURE(P){:243}; IF T=21 THEN IF MEM[PP].HH.B0=21 THEN PP:=MEM[PP+1].HH.LH ELSE BEGIN FINDVARIABLE:=0;GOTO 10;END; IF MEM[P].HH.B0=21 THEN P:=MEM[P+1].HH.LH; IF MEM[P].HH.B0=0 THEN BEGIN IF MEM[PP].HH.B0=0 THEN BEGIN MEM[PP].HH.B0 :=15;MEM[PP+1].INT:=0;END;MEM[P].HH.B0:=MEM[PP].HH.B0;MEM[P+1].INT:=0; END;FINDVARIABLE:=P;10:END;{:242}{246:}{257:} PROCEDURE PRINTPATH(H:HALFWORD;S:STRNUMBER;NULINE:BOOLEAN);LABEL 30,31; VAR P,Q:HALFWORD;BEGIN PRINTDIAGNOS(517,S,NULINE);PRINTLN;P:=H; REPEAT Q:=MEM[P].HH.RH;IF(P=0)OR(Q=0)THEN BEGIN PRINTNL(259);GOTO 30; END;{258:}PRINTTWO(MEM[P+1].INT,MEM[P+2].INT); CASE MEM[P].HH.B1 OF 0:BEGIN IF MEM[P].HH.B0=4 THEN PRINT(518); IF(MEM[Q].HH.B0<>0)OR(Q<>H)THEN Q:=0;GOTO 31;END;1:{261:} BEGIN PRINT(524);PRINTTWO(MEM[P+5].INT,MEM[P+6].INT);PRINT(523); IF MEM[Q].HH.B0<>1 THEN PRINT(525)ELSE PRINTTWO(MEM[Q+3].INT,MEM[Q+4]. INT);GOTO 31;END{:261};4:{262:} IF(MEM[P].HH.B0<>1)AND(MEM[P].HH.B0<>4)THEN PRINT(518){:262};3,2:{263:} BEGIN IF MEM[P].HH.B0=4 THEN PRINT(525); IF MEM[P].HH.B1=3 THEN BEGIN PRINT(521);PRINTSCALED(MEM[P+5].INT); END ELSE BEGIN NSINCOS(MEM[P+5].INT);PRINTCHAR(123);PRINTSCALED(NCOS); PRINTCHAR(44);PRINTSCALED(NSIN);END;PRINTCHAR(125);END{:263}; OTHERWISE PRINT(259)END; IF MEM[Q].HH.B0<=1 THEN PRINT(519)ELSE IF(MEM[P+6].INT<>65536)OR(MEM[Q+4 ].INT<>65536)THEN{260:}BEGIN PRINT(522); IF MEM[P+6].INT<0 THEN PRINT(464);PRINTSCALED(ABS(MEM[P+6].INT)); IF MEM[P+6].INT<>MEM[Q+4].INT THEN BEGIN PRINT(523); IF MEM[Q+4].INT<0 THEN PRINT(464);PRINTSCALED(ABS(MEM[Q+4].INT));END; END{:260};31:{:258};P:=Q;IF(P<>H)OR(MEM[H].HH.B0<>0)THEN{259:} BEGIN PRINTNL(520);IF MEM[P].HH.B0=2 THEN BEGIN NSINCOS(MEM[P+3].INT); PRINTCHAR(123);PRINTSCALED(NCOS);PRINTCHAR(44);PRINTSCALED(NSIN); PRINTCHAR(125);END ELSE IF MEM[P].HH.B0=3 THEN BEGIN PRINT(521); PRINTSCALED(MEM[P+3].INT);PRINTCHAR(125);END;END{:259};UNTIL P=H; IF MEM[H].HH.B0<>0 THEN PRINT(386);30:ENDDIAGNOSTI(TRUE);END;{:257} {332:}{333:}PROCEDURE PRINTWEIGHT(Q:HALFWORD;XOFF:INTEGER); VAR W,M:INTEGER;D:INTEGER;BEGIN D:=MEM[Q].HH.LH;W:=D MOD 8; M:=(D DIV 8)-MEM[CUREDGES+3].HH.LH; IF FILEOFFSET>MAXPRINTLINE-9 THEN PRINTNL(32)ELSE PRINTCHAR(32); PRINTINT(M+XOFF);WHILE W>4 DO BEGIN PRINTCHAR(43);W:=W-1;END; WHILE W<4 DO BEGIN PRINTCHAR(45);W:=W+1;END;END;{:333} PROCEDURE PRINTEDGES(S:STRNUMBER;NULINE:BOOLEAN;XOFF,YOFF:INTEGER); VAR P,Q,R:HALFWORD;N:INTEGER;BEGIN PRINTDIAGNOS(532,S,NULINE); P:=MEM[CUREDGES].HH.LH;N:=MEM[CUREDGES+1].HH.RH-4096; WHILE P<>CUREDGES DO BEGIN Q:=MEM[P+1].HH.LH;R:=MEM[P+1].HH.RH; IF(Q>1)OR(R<>65534)THEN BEGIN PRINTNL(533);PRINTINT(N+YOFF); PRINTCHAR(58);WHILE Q>1 DO BEGIN PRINTWEIGHT(Q,XOFF);Q:=MEM[Q].HH.RH; END;PRINT(534);WHILE R<>65534 DO BEGIN PRINTWEIGHT(R,XOFF); R:=MEM[R].HH.RH;END;END;P:=MEM[P].HH.LH;N:=N-1;END;ENDDIAGNOSTI(TRUE); END;{:332}{388:}PROCEDURE UNSKEW(X,Y:SCALED;OCTANT:SMALLNUMBER); BEGIN CASE OCTANT OF 1:BEGIN CURX:=X+Y;CURY:=Y;END;5:BEGIN CURX:=Y; CURY:=X+Y;END;6:BEGIN CURX:=-Y;CURY:=X+Y;END;2:BEGIN CURX:=-X-Y;CURY:=Y; END;4:BEGIN CURX:=-X-Y;CURY:=-Y;END;8:BEGIN CURX:=-Y;CURY:=-X-Y;END; 7:BEGIN CURX:=Y;CURY:=-X-Y;END;3:BEGIN CURX:=X+Y;CURY:=-Y;END;END;END; {:388}{473:}PROCEDURE PRINTPEN(P:HALFWORD;S:STRNUMBER;NULINE:BOOLEAN); VAR NOTHINGPRINT:BOOLEAN;K:1..8;H:HALFWORD;M,N:INTEGER;W,WW:HALFWORD; BEGIN PRINTDIAGNOS(569,S,NULINE);NOTHINGPRINT:=TRUE;PRINTLN; FOR K:=1 TO 8 DO BEGIN OCTANT:=OCTANTCODE[K];H:=P+OCTANT; N:=MEM[H].HH.LH;W:=MEM[H].HH.RH;IF NOT ODD(K)THEN W:=MEM[W].HH.LH; FOR M:=1 TO N+1 DO BEGIN IF ODD(K)THEN WW:=MEM[W].HH.RH ELSE WW:=MEM[W]. HH.LH; IF(MEM[WW+1].INT<>MEM[W+1].INT)OR(MEM[WW+2].INT<>MEM[W+2].INT)THEN{474:} BEGIN IF NOTHINGPRINT THEN NOTHINGPRINT:=FALSE ELSE PRINTNL(571); UNSKEW(MEM[WW+1].INT,MEM[WW+2].INT,OCTANT);PRINTTWO(CURX,CURY);END{:474} ;W:=WW;END;END;IF NOTHINGPRINT THEN BEGIN W:=MEM[P+1].HH.RH; PRINTTWO(MEM[W+1].INT+MEM[W+2].INT,MEM[W+2].INT);END;PRINTNL(570); ENDDIAGNOSTI(TRUE);END;{:473}{589:}PROCEDURE PRINTDEPENDE(P:HALFWORD; T:SMALLNUMBER);LABEL 10;VAR V:INTEGER;PP,Q:HALFWORD;BEGIN PP:=P; WHILE TRUE DO BEGIN V:=ABS(MEM[P+1].INT);Q:=MEM[P].HH.LH; IF Q=0 THEN BEGIN IF(V<>0)OR(P=PP)THEN BEGIN IF MEM[P+1].INT>0 THEN IF P <>PP THEN PRINTCHAR(43);PRINTSCALED(MEM[P+1].INT);END;GOTO 10;END;{590:} IF MEM[P+1].INT<0 THEN PRINTCHAR(45)ELSE IF P<>PP THEN PRINTCHAR(43); IF T=17 THEN V:=ROUNDFRACTIO(V);IF V<>65536 THEN PRINTSCALED(V){:590}; IF MEM[Q].HH.B0<>19 THEN CONFUSION(587);PRINTVARIABL(Q); V:=MEM[Q+1].INT MOD 64;WHILE V>0 DO BEGIN PRINT(588);V:=V-2;END; P:=MEM[P].HH.RH;END;10:END;{:589}{801:}{805:} PROCEDURE PRINTDP(T:SMALLNUMBER;P:HALFWORD;VERBOSITY:SMALLNUMBER); VAR Q:HALFWORD;BEGIN Q:=MEM[P].HH.RH; IF(MEM[Q].HH.LH=0)OR(VERBOSITY>0)THEN PRINTDEPENDE(P,T)ELSE PRINT(762); END;{:805}{799:}FUNCTION STASHCUREXP:HALFWORD;VAR P:HALFWORD; BEGIN CASE CURTYPE OF 3,5,7,12,10,13,14,17,18,19:P:=CUREXP; OTHERWISE BEGIN P:=GETNODE(2);MEM[P].HH.B1:=11;MEM[P].HH.B0:=CURTYPE; MEM[P+1].INT:=CUREXP;END END;CURTYPE:=1;MEM[P].HH.RH:=1;STASHCUREXP:=P; END;{:799}{800:}PROCEDURE UNSTASHCUREX(P:HALFWORD); BEGIN CURTYPE:=MEM[P].HH.B0; CASE CURTYPE OF 3,5,7,12,10,13,14,17,18,19:CUREXP:=P; OTHERWISE BEGIN CUREXP:=MEM[P+1].INT;FREENODE(P,2);END END;END;{:800} PROCEDURE PRINTEXP(P:HALFWORD;VERBOSITY:SMALLNUMBER); VAR RESTORECUREX:BOOLEAN;T:SMALLNUMBER;V:INTEGER;Q:HALFWORD; BEGIN IF P<>0 THEN RESTORECUREX:=FALSE ELSE BEGIN P:=STASHCUREXP; RESTORECUREX:=TRUE;END;T:=MEM[P].HH.B0; IF T<17 THEN V:=MEM[P+1].INT ELSE IF T<19 THEN V:=MEM[P+1].HH.RH;{802:} CASE T OF 1:PRINT(324);2:IF V=30 THEN PRINT(348)ELSE PRINT(349); 3,5,7,12,10,15:{806:}BEGIN PRINTTYPE(T); IF V<>0 THEN BEGIN PRINTCHAR(32); WHILE(MEM[V].HH.B1=11)AND(V<>P)DO V:=MEM[V+1].INT;PRINTVARIABL(V);END; END{:806};4:BEGIN PRINTCHAR(34);SLOWPRINT(V);PRINTCHAR(34);END; 6,8,9,11:{804:} IF VERBOSITY<=1 THEN PRINTTYPE(T)ELSE BEGIN IF SELECTOR=3 THEN IF INTERNAL[13]<=0 THEN BEGIN SELECTOR:=1;PRINTTYPE(T);PRINT(760); SELECTOR:=3;END;CASE T OF 6:PRINTPEN(V,285,FALSE); 8:PRINTPATH(V,761,FALSE);9:PRINTPATH(V,285,FALSE);11:BEGIN CUREDGES:=V; PRINTEDGES(285,FALSE,0,0);END;END;END{:804}; 13,14:IF V=0 THEN PRINTTYPE(T)ELSE{803:}BEGIN PRINTCHAR(40); Q:=V+BIGNODESIZE[T]; REPEAT IF MEM[V].HH.B0=16 THEN PRINTSCALED(MEM[V+1].INT)ELSE IF MEM[V]. HH.B0=19 THEN PRINTVARIABL(V)ELSE PRINTDP(MEM[V].HH.B0,MEM[V+1].HH.RH, VERBOSITY);V:=V+2;IF V<>Q THEN PRINTCHAR(44);UNTIL V=Q;PRINTCHAR(41); END{:803};16:PRINTSCALED(V);17,18:PRINTDP(T,V,VERBOSITY); 19:PRINTVARIABL(P);OTHERWISE CONFUSION(759)END{:802}; IF RESTORECUREX THEN UNSTASHCUREX(P);END;{:801}{807:} PROCEDURE DISPERR(P:HALFWORD;S:STRNUMBER); BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(763);PRINTEXP(P,1); IF S<>285 THEN BEGIN PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE); PRINT(S);END;END;{:807}{594:}FUNCTION PPLUSFQ(P:HALFWORD;F:INTEGER; Q:HALFWORD;T,TT:SMALLNUMBER):HALFWORD;LABEL 30;VAR PP,QQ:HALFWORD; R,S:HALFWORD;THRESHOLD:INTEGER;V:INTEGER; BEGIN IF T=17 THEN THRESHOLD:=2685 ELSE THRESHOLD:=8;R:=65533; PP:=MEM[P].HH.LH;QQ:=MEM[Q].HH.LH; WHILE TRUE DO IF PP=QQ THEN IF PP=0 THEN GOTO 30 ELSE{595:} BEGIN IF TT=17 THEN V:=MEM[P+1].INT+TAKEFRACTION(F,MEM[Q+1].INT)ELSE V:= MEM[P+1].INT+TAKESCALED(F,MEM[Q+1].INT);MEM[P+1].INT:=V;S:=P; P:=MEM[P].HH.RH; IF ABS(V)=626349397 THEN IF WATCHCOEFS THEN BEGIN MEM[QQ].HH.B0:=0;FIXNEEDED:=TRUE;END; MEM[R].HH.RH:=S;R:=S;END;PP:=MEM[P].HH.LH;Q:=MEM[Q].HH.RH; QQ:=MEM[Q].HH.LH;END{:595}ELSE IF MEM[PP+1].INT(THRESHOLD)DIV 2 THEN BEGIN S:=GETNODE(2); MEM[S].HH.LH:=QQ;MEM[S+1].INT:=V; IF ABS(V)>=626349397 THEN IF WATCHCOEFS THEN BEGIN MEM[QQ].HH.B0:=0; FIXNEEDED:=TRUE;END;MEM[R].HH.RH:=S;R:=S;END;Q:=MEM[Q].HH.RH; QQ:=MEM[Q].HH.LH;END{:596}ELSE BEGIN MEM[R].HH.RH:=P;R:=P; P:=MEM[P].HH.RH;PP:=MEM[P].HH.LH;END; 30:IF T=17 THEN MEM[P+1].INT:=SLOWADD(MEM[P+1].INT,TAKEFRACTION(MEM[Q+1] .INT,F))ELSE MEM[P+1].INT:=SLOWADD(MEM[P+1].INT,TAKESCALED(MEM[Q+1].INT, F));MEM[R].HH.RH:=P;DEPFINAL:=P;PPLUSFQ:=MEM[65533].HH.RH;END;{:594} {600:}FUNCTION POVERV(P:HALFWORD;V:SCALED;T0,T1:SMALLNUMBER):HALFWORD; VAR R,S:HALFWORD;W:INTEGER;THRESHOLD:INTEGER;SCALINGDOWN:BOOLEAN; BEGIN IF T0<>T1 THEN SCALINGDOWN:=TRUE ELSE SCALINGDOWN:=FALSE; IF T1=17 THEN THRESHOLD:=1342 ELSE THRESHOLD:=4;R:=65533; WHILE MEM[P].HH.LH<>0 DO BEGIN IF SCALINGDOWN THEN IF ABS(V)<524288 THEN W:=MAKESCALED(MEM[P+1].INT,V*4096)ELSE W:=MAKESCALED(ROUNDFRACTIO(MEM[P +1].INT),V)ELSE W:=MAKESCALED(MEM[P+1].INT,V); IF ABS(W)<=THRESHOLD THEN BEGIN S:=MEM[P].HH.RH;FREENODE(P,2);P:=S; END ELSE BEGIN IF ABS(W)>=626349397 THEN BEGIN FIXNEEDED:=TRUE; MEM[MEM[P].HH.LH].HH.B0:=0;END;MEM[R].HH.RH:=P;R:=P;MEM[P+1].INT:=W; P:=MEM[P].HH.RH;END;END;MEM[R].HH.RH:=P; MEM[P+1].INT:=MAKESCALED(MEM[P+1].INT,V);POVERV:=MEM[65533].HH.RH;END; {:600}{602:}PROCEDURE VALTOOBIG(X:SCALED); BEGIN IF INTERNAL[40]>0 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(589); END;PRINTSCALED(X);PRINTCHAR(41);BEGIN HELPPTR:=4;HELPLINE[3]:=590; HELPLINE[2]:=591;HELPLINE[1]:=592;HELPLINE[0]:=593;END;ERROR;END;END; {:602}{603:}PROCEDURE MAKEKNOWN(P,Q:HALFWORD);VAR T:17..18; BEGIN MEM[MEM[Q].HH.RH+1].HH.LH:=MEM[P+1].HH.LH; MEM[MEM[P+1].HH.LH].HH.RH:=MEM[Q].HH.RH;T:=MEM[P].HH.B0; MEM[P].HH.B0:=16;MEM[P+1].INT:=MEM[Q+1].INT;FREENODE(Q,2); IF ABS(MEM[P+1].INT)>=268435456 THEN VALTOOBIG(MEM[P+1].INT); IF INTERNAL[2]>0 THEN IF INTERESTING(P)THEN BEGIN BEGINDIAGNOS; PRINTNL(594);PRINTVARIABL(P);PRINTCHAR(61);PRINTSCALED(MEM[P+1].INT); ENDDIAGNOSTI(FALSE);END; IF CUREXP=P THEN IF CURTYPE=T THEN BEGIN CURTYPE:=16; CUREXP:=MEM[P+1].INT;FREENODE(P,2);END;END;{:603}{604:} PROCEDURE FIXDEPENDENC;LABEL 30;VAR P,Q,R,S,T:HALFWORD;X:HALFWORD; BEGIN R:=MEM[13].HH.RH;S:=0;WHILE R<>13 DO BEGIN T:=R;{605:}R:=T+1; WHILE TRUE DO BEGIN Q:=MEM[R].HH.RH;X:=MEM[Q].HH.LH;IF X=0 THEN GOTO 30; IF MEM[X].HH.B0<=1 THEN BEGIN IF MEM[X].HH.B0<1 THEN BEGIN P:=GETAVAIL; MEM[P].HH.RH:=S;S:=P;MEM[S].HH.LH:=X;MEM[X].HH.B0:=1;END; MEM[Q+1].INT:=MEM[Q+1].INT DIV 4; IF MEM[Q+1].INT=0 THEN BEGIN MEM[R].HH.RH:=MEM[Q].HH.RH;FREENODE(Q,2); Q:=R;END;END;R:=Q;END;30:{:605};R:=MEM[Q].HH.RH; IF Q=MEM[T+1].HH.RH THEN MAKEKNOWN(T,Q);END; WHILE S<>0 DO BEGIN P:=MEM[S].HH.RH;X:=MEM[S].HH.LH; BEGIN MEM[S].HH.RH:=AVAIL;AVAIL:=S;DYNUSED:=DYNUSED-1;END;S:=P; MEM[X].HH.B0:=19;MEM[X+1].INT:=MEM[X+1].INT+2;END;FIXNEEDED:=FALSE;END; {:604}{268:}PROCEDURE TOSSKNOTLIST(P:HALFWORD);VAR Q:HALFWORD; R:HALFWORD;BEGIN Q:=P;REPEAT R:=MEM[Q].HH.RH;FREENODE(Q,7);Q:=R; UNTIL Q=P;END;{:268}{385:}PROCEDURE TOSSEDGES(H:HALFWORD); VAR P,Q:HALFWORD;BEGIN Q:=MEM[H].HH.RH; WHILE Q<>H DO BEGIN FLUSHLIST(MEM[Q+1].HH.RH); IF MEM[Q+1].HH.LH>1 THEN FLUSHLIST(MEM[Q+1].HH.LH);P:=Q;Q:=MEM[Q].HH.RH; FREENODE(P,2);END;FREENODE(H,6);END;{:385}{487:} PROCEDURE TOSSPEN(P:HALFWORD);VAR K:1..8;W,WW:HALFWORD; BEGIN IF P<>3 THEN BEGIN FOR K:=1 TO 8 DO BEGIN W:=MEM[P+K].HH.RH; REPEAT WW:=MEM[W].HH.RH;FREENODE(W,3);W:=WW;UNTIL W=MEM[P+K].HH.RH;END; FREENODE(P,10);END;END;{:487}{620:}PROCEDURE RINGDELETE(P:HALFWORD); VAR Q:HALFWORD;BEGIN Q:=MEM[P+1].INT; IF Q<>0 THEN IF Q<>P THEN BEGIN WHILE MEM[Q+1].INT<>P DO Q:=MEM[Q+1].INT ;MEM[Q+1].INT:=MEM[P+1].INT;END;END;{:620}{809:} PROCEDURE RECYCLEVALUE(P:HALFWORD);LABEL 30;VAR T:SMALLNUMBER;V:INTEGER; VV:INTEGER;Q,R,S,PP:HALFWORD;BEGIN T:=MEM[P].HH.B0; IF T<17 THEN V:=MEM[P+1].INT;CASE T OF 0,1,2,16,15:; 3,5,7,12,10:RINGDELETE(P); 4:BEGIN IF STRREF[V]<127 THEN IF STRREF[V]>1 THEN STRREF[V]:=STRREF[V]-1 ELSE FLUSHSTRING(V);END; 6:IF MEM[V].HH.LH=0 THEN TOSSPEN(V)ELSE MEM[V].HH.LH:=MEM[V].HH.LH-1; 9,8:TOSSKNOTLIST(V);11:TOSSEDGES(V);14,13:{810:} IF V<>0 THEN BEGIN Q:=V+BIGNODESIZE[T];REPEAT Q:=Q-2;RECYCLEVALUE(Q); UNTIL Q=V;FREENODE(V,BIGNODESIZE[T]);END{:810};17,18:{811:} BEGIN Q:=MEM[P+1].HH.RH;WHILE MEM[Q].HH.LH<>0 DO Q:=MEM[Q].HH.RH; MEM[MEM[P+1].HH.LH].HH.RH:=MEM[Q].HH.RH; MEM[MEM[Q].HH.RH+1].HH.LH:=MEM[P+1].HH.LH;MEM[Q].HH.RH:=0; FLUSHNODELIS(MEM[P+1].HH.RH);END{:811};19:{812:}BEGIN MAXC[17]:=0; MAXC[18]:=0;MAXLINK[17]:=0;MAXLINK[18]:=0;Q:=MEM[13].HH.RH; WHILE Q<>13 DO BEGIN S:=Q+1;WHILE TRUE DO BEGIN R:=MEM[S].HH.RH; IF MEM[R].HH.LH=0 THEN GOTO 30; IF MEM[R].HH.LH<>P THEN S:=R ELSE BEGIN T:=MEM[Q].HH.B0; MEM[S].HH.RH:=MEM[R].HH.RH;MEM[R].HH.LH:=Q; IF ABS(MEM[R+1].INT)>MAXC[T]THEN{814:} BEGIN IF MAXC[T]>0 THEN BEGIN MEM[MAXPTR[T]].HH.RH:=MAXLINK[T]; MAXLINK[T]:=MAXPTR[T];END;MAXC[T]:=ABS(MEM[R+1].INT);MAXPTR[T]:=R; END{:814}ELSE BEGIN MEM[R].HH.RH:=MAXLINK[T];MAXLINK[T]:=R;END;END;END; 30:Q:=MEM[R].HH.RH;END;IF(MAXC[17]>0)OR(MAXC[18]>0)THEN{815:} BEGIN IF(MAXC[17]>=268435456)OR(MAXC[17]DIV 4096>=MAXC[18])THEN T:=17 ELSE T:=18;{816:}S:=MAXPTR[T];PP:=MEM[S].HH.LH;V:=MEM[S+1].INT; IF T=17 THEN MEM[S+1].INT:=-268435456 ELSE MEM[S+1].INT:=-65536; R:=MEM[PP+1].HH.RH;MEM[S].HH.RH:=R; WHILE MEM[R].HH.LH<>0 DO R:=MEM[R].HH.RH;Q:=MEM[R].HH.RH; MEM[R].HH.RH:=0;MEM[Q+1].HH.LH:=MEM[PP+1].HH.LH; MEM[MEM[PP+1].HH.LH].HH.RH:=Q;BEGIN MEM[PP].HH.B0:=19; SERIALNO:=SERIALNO+64;MEM[PP+1].INT:=SERIALNO;END; IF CUREXP=PP THEN IF CURTYPE=T THEN CURTYPE:=19; IF INTERNAL[2]>0 THEN{817:}IF INTERESTING(P)THEN BEGIN BEGINDIAGNOS; PRINTNL(765);IF V>0 THEN PRINTCHAR(45); IF T=17 THEN VV:=ROUNDFRACTIO(MAXC[17])ELSE VV:=MAXC[18]; IF VV<>65536 THEN PRINTSCALED(VV);PRINTVARIABL(P); WHILE MEM[P+1].INT MOD 64>0 DO BEGIN PRINT(588); MEM[P+1].INT:=MEM[P+1].INT-2;END; IF T=17 THEN PRINTCHAR(61)ELSE PRINT(766);PRINTDEPENDE(S,T); ENDDIAGNOSTI(FALSE);END{:817}{:816};T:=35-T; IF MAXC[T]>0 THEN BEGIN MEM[MAXPTR[T]].HH.RH:=MAXLINK[T]; MAXLINK[T]:=MAXPTR[T];END;IF T<>17 THEN{818:} FOR T:=17 TO 18 DO BEGIN R:=MAXLINK[T]; WHILE R<>0 DO BEGIN Q:=MEM[R].HH.LH; MEM[Q+1].HH.RH:=PPLUSFQ(MEM[Q+1].HH.RH,MAKEFRACTION(MEM[R+1].INT,-V),S,T ,17);IF MEM[Q+1].HH.RH=DEPFINAL THEN MAKEKNOWN(Q,DEPFINAL);Q:=R; R:=MEM[R].HH.RH;FREENODE(Q,2);END;END{:818}ELSE{819:} FOR T:=17 TO 18 DO BEGIN R:=MAXLINK[T]; WHILE R<>0 DO BEGIN Q:=MEM[R].HH.LH; IF T=17 THEN BEGIN IF CUREXP=Q THEN IF CURTYPE=17 THEN CURTYPE:=18; MEM[Q+1].HH.RH:=POVERV(MEM[Q+1].HH.RH,65536,17,18);MEM[Q].HH.B0:=18; MEM[R+1].INT:=ROUNDFRACTIO(MEM[R+1].INT);END; MEM[Q+1].HH.RH:=PPLUSFQ(MEM[Q+1].HH.RH,MAKESCALED(MEM[R+1].INT,-V),S,18, 18);IF MEM[Q+1].HH.RH=DEPFINAL THEN MAKEKNOWN(Q,DEPFINAL);Q:=R; R:=MEM[R].HH.RH;FREENODE(Q,2);END;END{:819};FLUSHNODELIS(S); IF FIXNEEDED THEN FIXDEPENDENC;BEGIN IF ARITHERROR THEN CLEARARITH;END; END{:815};END{:812};20,21:CONFUSION(764); 22,23:DELETEMACREF(MEM[P+1].INT);END;MEM[P].HH.B0:=0;END;{:809}{808:} PROCEDURE FLUSHCUREXP(V:SCALED); BEGIN CASE CURTYPE OF 3,5,7,12,10,13,14,17,18,19:BEGIN RECYCLEVALUE( CUREXP);FREENODE(CUREXP,2);END; 6:IF MEM[CUREXP].HH.LH=0 THEN TOSSPEN(CUREXP)ELSE MEM[CUREXP].HH.LH:=MEM [CUREXP].HH.LH-1; 4:BEGIN IF STRREF[CUREXP]<127 THEN IF STRREF[CUREXP]>1 THEN STRREF[ CUREXP]:=STRREF[CUREXP]-1 ELSE FLUSHSTRING(CUREXP);END; 8,9:TOSSKNOTLIST(CUREXP);11:TOSSEDGES(CUREXP);OTHERWISE END;CURTYPE:=16; CUREXP:=V;END;{:808}{820:}PROCEDURE FLUSHERROR(V:SCALED);BEGIN ERROR; FLUSHCUREXP(V);END;PROCEDURE BACKERROR;FORWARD;PROCEDURE GETXNEXT; FORWARD;PROCEDURE PUTGETERROR;BEGIN BACKERROR;GETXNEXT;END; PROCEDURE PUTGETFLUSHE(V:SCALED);BEGIN PUTGETERROR;FLUSHCUREXP(V);END; {:820}{247:}PROCEDURE FLUSHBELOWVA(P:HALFWORD);VAR Q,R:HALFWORD; BEGIN IF MEM[P].HH.B0<>21 THEN RECYCLEVALUE(P)ELSE BEGIN Q:=MEM[P+1].HH. RH;WHILE MEM[Q].HH.B1=3 DO BEGIN FLUSHBELOWVA(Q);R:=Q;Q:=MEM[Q].HH.RH; FREENODE(R,3);END;R:=MEM[P+1].HH.LH;Q:=MEM[R].HH.RH;RECYCLEVALUE(R); IF MEM[P].HH.B1<=1 THEN FREENODE(R,2)ELSE FREENODE(R,3); REPEAT FLUSHBELOWVA(Q);R:=Q;Q:=MEM[Q].HH.RH;FREENODE(R,3);UNTIL Q=17; MEM[P].HH.B0:=0;END;END;{:247}PROCEDURE FLUSHVARIABL(P,T:HALFWORD; DISCARDSUFFI:BOOLEAN);LABEL 10;VAR Q,R:HALFWORD;N:HALFWORD; BEGIN WHILE T<>0 DO BEGIN IF MEM[P].HH.B0<>21 THEN GOTO 10; N:=MEM[T].HH.LH;T:=MEM[T].HH.RH;IF N=0 THEN BEGIN R:=P+1; Q:=MEM[R].HH.RH; WHILE MEM[Q].HH.B1=3 DO BEGIN FLUSHVARIABL(Q,T,DISCARDSUFFI); IF T=0 THEN IF MEM[Q].HH.B0=21 THEN R:=Q ELSE BEGIN MEM[R].HH.RH:=MEM[Q] .HH.RH;FREENODE(Q,3);END ELSE R:=Q;Q:=MEM[R].HH.RH;END;END; P:=MEM[P+1].HH.LH;REPEAT R:=P;P:=MEM[P].HH.RH;UNTIL MEM[P+2].HH.LH>=N; IF MEM[P+2].HH.LH<>N THEN GOTO 10;END; IF DISCARDSUFFI THEN FLUSHBELOWVA(P)ELSE BEGIN IF MEM[P].HH.B0=21 THEN P :=MEM[P+1].HH.LH;RECYCLEVALUE(P);END;10:END;{:246}{248:} FUNCTION UNDTYPE(P:HALFWORD):SMALLNUMBER; BEGIN CASE MEM[P].HH.B0 OF 0,1:UNDTYPE:=0;2,3:UNDTYPE:=3;4,5:UNDTYPE:=5; 6,7,8:UNDTYPE:=7;9,10:UNDTYPE:=10;11,12:UNDTYPE:=12; 13,14,15:UNDTYPE:=MEM[P].HH.B0;16,17,18,19:UNDTYPE:=15;END;END;{:248} {249:}PROCEDURE CLEARSYMBOL(P:HALFWORD;SAVING:BOOLEAN);VAR Q:HALFWORD; BEGIN Q:=EQTB[P].RH; CASE EQTB[P].LH MOD 86 OF 10,53,44,49:IF NOT SAVING THEN DELETEMACREF(Q) ; 41:IF Q<>0 THEN IF SAVING THEN MEM[Q].HH.B1:=1 ELSE BEGIN FLUSHBELOWVA(Q );FREENODE(Q,2);END;OTHERWISE END;EQTB[P]:=EQTB[2369];END;{:249}{252:} PROCEDURE SAVEVARIABLE(Q:HALFWORD);VAR P:HALFWORD; BEGIN IF SAVEPTR<>0 THEN BEGIN P:=GETNODE(2);MEM[P].HH.LH:=Q; MEM[P].HH.RH:=SAVEPTR;MEM[P+1].HH:=EQTB[Q];SAVEPTR:=P;END; CLEARSYMBOL(Q,(SAVEPTR<>0));END;{:252}{253:} PROCEDURE SAVEINTERNAL(Q:HALFWORD);VAR P:HALFWORD; BEGIN IF SAVEPTR<>0 THEN BEGIN P:=GETNODE(2);MEM[P].HH.LH:=2369+Q; MEM[P].HH.RH:=SAVEPTR;MEM[P+1].INT:=INTERNAL[Q];SAVEPTR:=P;END;END; {:253}{254:}PROCEDURE UNSAVE;VAR Q:HALFWORD;P:HALFWORD; BEGIN WHILE MEM[SAVEPTR].HH.LH<>0 DO BEGIN Q:=MEM[SAVEPTR].HH.LH; IF Q>2369 THEN BEGIN IF INTERNAL[8]>0 THEN BEGIN BEGINDIAGNOS; PRINTNL(516);PRINT(INTNAME[Q-(2369)]);PRINTCHAR(61); PRINTSCALED(MEM[SAVEPTR+1].INT);PRINTCHAR(125);ENDDIAGNOSTI(FALSE);END; INTERNAL[Q-(2369)]:=MEM[SAVEPTR+1].INT; END ELSE BEGIN IF INTERNAL[8]>0 THEN BEGIN BEGINDIAGNOS;PRINTNL(516); PRINT(HASH[Q].RH);PRINTCHAR(125);ENDDIAGNOSTI(FALSE);END; CLEARSYMBOL(Q,FALSE);EQTB[Q]:=MEM[SAVEPTR+1].HH; IF EQTB[Q].LH MOD 86=41 THEN BEGIN P:=EQTB[Q].RH; IF P<>0 THEN MEM[P].HH.B1:=0;END;END;P:=MEM[SAVEPTR].HH.RH; FREENODE(SAVEPTR,2);SAVEPTR:=P;END;P:=MEM[SAVEPTR].HH.RH; BEGIN MEM[SAVEPTR].HH.RH:=AVAIL;AVAIL:=SAVEPTR;DYNUSED:=DYNUSED-1;END; SAVEPTR:=P;END;{:254}{264:}FUNCTION COPYKNOT(P:HALFWORD):HALFWORD; VAR Q:HALFWORD;K:0..6;BEGIN Q:=GETNODE(7); FOR K:=0 TO 6 DO MEM[Q+K]:=MEM[P+K];COPYKNOT:=Q;END;{:264}{265:} FUNCTION COPYPATH(P:HALFWORD):HALFWORD;LABEL 10;VAR Q,PP,QQ:HALFWORD; BEGIN Q:=GETNODE(7);QQ:=Q;PP:=P; WHILE TRUE DO BEGIN MEM[QQ].HH.B0:=MEM[PP].HH.B0; MEM[QQ].HH.B1:=MEM[PP].HH.B1;MEM[QQ+1].INT:=MEM[PP+1].INT; MEM[QQ+2].INT:=MEM[PP+2].INT;MEM[QQ+3].INT:=MEM[PP+3].INT; MEM[QQ+4].INT:=MEM[PP+4].INT;MEM[QQ+5].INT:=MEM[PP+5].INT; MEM[QQ+6].INT:=MEM[PP+6].INT; IF MEM[PP].HH.RH=P THEN BEGIN MEM[QQ].HH.RH:=Q;COPYPATH:=Q;GOTO 10;END; MEM[QQ].HH.RH:=GETNODE(7);QQ:=MEM[QQ].HH.RH;PP:=MEM[PP].HH.RH;END; 10:END;{:265}{266:}FUNCTION HTAPYPOC(P:HALFWORD):HALFWORD;LABEL 10; VAR Q,PP,QQ,RR:HALFWORD;BEGIN Q:=GETNODE(7);QQ:=Q;PP:=P; WHILE TRUE DO BEGIN MEM[QQ].HH.B1:=MEM[PP].HH.B0; MEM[QQ].HH.B0:=MEM[PP].HH.B1;MEM[QQ+1].INT:=MEM[PP+1].INT; MEM[QQ+2].INT:=MEM[PP+2].INT;MEM[QQ+5].INT:=MEM[PP+3].INT; MEM[QQ+6].INT:=MEM[PP+4].INT;MEM[QQ+3].INT:=MEM[PP+5].INT; MEM[QQ+4].INT:=MEM[PP+6].INT; IF MEM[PP].HH.RH=P THEN BEGIN MEM[Q].HH.RH:=QQ;PATHTAIL:=PP;HTAPYPOC:=Q; GOTO 10;END;RR:=GETNODE(7);MEM[RR].HH.RH:=QQ;QQ:=RR;PP:=MEM[PP].HH.RH; END;10:END;{:266}{269:}{284:}{296:} FUNCTION CURLRATIO(GAMMA,ATENSION,BTENSION:SCALED):FRACTION; VAR ALPHA,BETA,NUM,DENOM,FF:FRACTION; BEGIN ALPHA:=MAKEFRACTION(65536,ATENSION); BETA:=MAKEFRACTION(65536,BTENSION); IF ALPHA<=BETA THEN BEGIN FF:=MAKEFRACTION(ALPHA,BETA); FF:=TAKEFRACTION(FF,FF);GAMMA:=TAKEFRACTION(GAMMA,FF); BETA:=BETA DIV 4096;DENOM:=TAKEFRACTION(GAMMA,ALPHA)+196608-BETA; NUM:=TAKEFRACTION(GAMMA,805306368-ALPHA)+BETA; END ELSE BEGIN FF:=MAKEFRACTION(BETA,ALPHA);FF:=TAKEFRACTION(FF,FF); BETA:=TAKEFRACTION(BETA,FF)DIV 4096; DENOM:=TAKEFRACTION(GAMMA,ALPHA)+(FF DIV 1365)-BETA; NUM:=TAKEFRACTION(GAMMA,805306368-ALPHA)+BETA;END; IF NUM>=DENOM+DENOM+DENOM+DENOM THEN CURLRATIO:=1073741824 ELSE CURLRATIO:=MAKEFRACTION(NUM,DENOM);END;{:296}{299:} PROCEDURE SETCONTROLS(P,Q:HALFWORD;K:INTEGER);VAR RR,SS:FRACTION; LT,RT:SCALED;SINE:FRACTION;BEGIN LT:=ABS(MEM[Q+4].INT); RT:=ABS(MEM[P+6].INT);RR:=VELOCITY(ST,CT,SF,CF,RT); SS:=VELOCITY(SF,CF,ST,CT,LT); IF(MEM[P+6].INT<0)OR(MEM[Q+4].INT<0)THEN{300:} IF((ST>=0)AND(SF>=0))OR((ST<=0)AND(SF<=0))THEN BEGIN SINE:=TAKEFRACTION( ABS(ST),CF)+TAKEFRACTION(ABS(SF),CT); IF SINE>0 THEN BEGIN SINE:=TAKEFRACTION(SINE,268500992); IF MEM[P+6].INT<0 THEN IF ABVSCD(ABS(SF),268435456,RR,SINE)<0 THEN RR:= MAKEFRACTION(ABS(SF),SINE); IF MEM[Q+4].INT<0 THEN IF ABVSCD(ABS(ST),268435456,SS,SINE)<0 THEN SS:= MAKEFRACTION(ABS(ST),SINE);END;END{:300}; MEM[P+5].INT:=MEM[P+1].INT+TAKEFRACTION(TAKEFRACTION(DELTAX[K],CT)- TAKEFRACTION(DELTAY[K],ST),RR); MEM[P+6].INT:=MEM[P+2].INT+TAKEFRACTION(TAKEFRACTION(DELTAY[K],CT)+ TAKEFRACTION(DELTAX[K],ST),RR); MEM[Q+3].INT:=MEM[Q+1].INT-TAKEFRACTION(TAKEFRACTION(DELTAX[K],CF)+ TAKEFRACTION(DELTAY[K],SF),SS); MEM[Q+4].INT:=MEM[Q+2].INT-TAKEFRACTION(TAKEFRACTION(DELTAY[K],CF)- TAKEFRACTION(DELTAX[K],SF),SS);MEM[P].HH.B1:=1;MEM[Q].HH.B0:=1;END; {:299}PROCEDURE SOLVECHOICES(P,Q:HALFWORD;N:HALFWORD);LABEL 40,10; VAR K:0..PATHSIZE;R,S,T:HALFWORD;{286:}AA,BB,CC,FF,ACC:FRACTION; DD,EE:SCALED;LT,RT:SCALED;{:286}BEGIN K:=0;S:=P; WHILE TRUE DO BEGIN T:=MEM[S].HH.RH;IF K=0 THEN{285:} CASE MEM[S].HH.B1 OF 2:IF MEM[T].HH.B0=2 THEN{301:} BEGIN AA:=NARG(DELTAX[0],DELTAY[0]);NSINCOS(MEM[P+5].INT-AA);CT:=NCOS; ST:=NSIN;NSINCOS(MEM[Q+3].INT-AA);CF:=NCOS;SF:=-NSIN;SETCONTROLS(P,Q,0); GOTO 10;END{:301}ELSE{293:} BEGIN VV[0]:=MEM[S+5].INT-NARG(DELTAX[0],DELTAY[0]); IF ABS(VV[0])>188743680 THEN IF VV[0]>0 THEN VV[0]:=VV[0]-377487360 ELSE VV[0]:=VV[0]+377487360;UU[0]:=0;WW[0]:=0;END{:293}; 3:IF MEM[T].HH.B0=3 THEN{302:}BEGIN MEM[P].HH.B1:=1;MEM[Q].HH.B0:=1; LT:=ABS(MEM[Q+4].INT);RT:=ABS(MEM[P+6].INT); IF RT=65536 THEN BEGIN IF DELTAX[0]>=0 THEN MEM[P+5].INT:=MEM[P+1].INT+( (DELTAX[0]+1)DIV 3)ELSE MEM[P+5].INT:=MEM[P+1].INT+((DELTAX[0]-1)DIV 3); IF DELTAY[0]>=0 THEN MEM[P+6].INT:=MEM[P+2].INT+((DELTAY[0]+1)DIV 3)ELSE MEM[P+6].INT:=MEM[P+2].INT+((DELTAY[0]-1)DIV 3); END ELSE BEGIN FF:=MAKEFRACTION(65536,3*RT); MEM[P+5].INT:=MEM[P+1].INT+TAKEFRACTION(DELTAX[0],FF); MEM[P+6].INT:=MEM[P+2].INT+TAKEFRACTION(DELTAY[0],FF);END; IF LT=65536 THEN BEGIN IF DELTAX[0]>=0 THEN MEM[Q+3].INT:=MEM[Q+1].INT-( (DELTAX[0]+1)DIV 3)ELSE MEM[Q+3].INT:=MEM[Q+1].INT-((DELTAX[0]-1)DIV 3); IF DELTAY[0]>=0 THEN MEM[Q+4].INT:=MEM[Q+2].INT-((DELTAY[0]+1)DIV 3)ELSE MEM[Q+4].INT:=MEM[Q+2].INT-((DELTAY[0]-1)DIV 3); END ELSE BEGIN FF:=MAKEFRACTION(65536,3*LT); MEM[Q+3].INT:=MEM[Q+1].INT-TAKEFRACTION(DELTAX[0],FF); MEM[Q+4].INT:=MEM[Q+2].INT-TAKEFRACTION(DELTAY[0],FF);END;GOTO 10; END{:302}ELSE{294:}BEGIN CC:=MEM[S+5].INT;LT:=ABS(MEM[T+4].INT); RT:=ABS(MEM[S+6].INT); IF(RT=65536)AND(LT=65536)THEN UU[0]:=MAKEFRACTION(CC+CC+65536,CC+131072) ELSE UU[0]:=CURLRATIO(CC,RT,LT);VV[0]:=-TAKEFRACTION(PSI[1],UU[0]); WW[0]:=0;END{:294};4:BEGIN UU[0]:=0;VV[0]:=0;WW[0]:=268435456;END; END{:285}ELSE CASE MEM[S].HH.B0 OF 5,4:{287:}BEGIN{288:} IF ABS(MEM[R+6].INT)=65536 THEN BEGIN AA:=134217728;DD:=2*DELTA[K]; END ELSE BEGIN AA:=MAKEFRACTION(65536,3*ABS(MEM[R+6].INT)-65536); DD:=TAKEFRACTION(DELTA[K],805306368-MAKEFRACTION(65536,ABS(MEM[R+6].INT) ));END;IF ABS(MEM[T+4].INT)=65536 THEN BEGIN BB:=134217728; EE:=2*DELTA[K-1]; END ELSE BEGIN BB:=MAKEFRACTION(65536,3*ABS(MEM[T+4].INT)-65536); EE:=TAKEFRACTION(DELTA[K-1],805306368-MAKEFRACTION(65536,ABS(MEM[T+4]. INT)));END;CC:=268435456-TAKEFRACTION(UU[K-1],AA){:288};{289:} DD:=TAKEFRACTION(DD,CC);LT:=ABS(MEM[S+4].INT);RT:=ABS(MEM[S+6].INT); IF LT<>RT THEN IF LT188743680 THEN IF THETA[N]>0 THEN THETA[N]:=THETA[N] -377487360 ELSE THETA[N]:=THETA[N]+377487360;GOTO 40;END{:292};END;R:=S; S:=T;K:=K+1;END;40:{297:} FOR K:=N-1 DOWNTO 0 DO THETA[K]:=VV[K]-TAKEFRACTION(THETA[K+1],UU[K]); S:=P;K:=0;REPEAT T:=MEM[S].HH.RH;NSINCOS(THETA[K]);ST:=NSIN;CT:=NCOS; NSINCOS(-PSI[K+1]-THETA[K+1]);SF:=NSIN;CF:=NCOS;SETCONTROLS(S,T,K); K:=K+1;S:=T;UNTIL K=N{:297};10:END;{:284} PROCEDURE MAKECHOICES(KNOTS:HALFWORD);LABEL 30;VAR H:HALFWORD; P,Q:HALFWORD;{280:}K,N:0..PATHSIZE;S,T:HALFWORD;DELX,DELY:SCALED; SINE,COSINE:FRACTION;{:280}BEGIN BEGIN IF ARITHERROR THEN CLEARARITH; END;IF INTERNAL[4]>0 THEN PRINTPATH(KNOTS,526,TRUE);{271:}P:=KNOTS; REPEAT Q:=MEM[P].HH.RH; IF MEM[P+1].INT=MEM[Q+1].INT THEN IF MEM[P+2].INT=MEM[Q+2].INT THEN IF MEM[P].HH.B1>1 THEN BEGIN MEM[P].HH.B1:=1; IF MEM[P].HH.B0=4 THEN BEGIN MEM[P].HH.B0:=3;MEM[P+3].INT:=65536;END; MEM[Q].HH.B0:=1;IF MEM[Q].HH.B1=4 THEN BEGIN MEM[Q].HH.B1:=3; MEM[Q+5].INT:=65536;END;MEM[P+5].INT:=MEM[P+1].INT; MEM[Q+3].INT:=MEM[P+1].INT;MEM[P+6].INT:=MEM[P+2].INT; MEM[Q+4].INT:=MEM[P+2].INT;END;P:=Q;UNTIL P=KNOTS{:271};{272:}H:=KNOTS; WHILE TRUE DO BEGIN IF MEM[H].HH.B0<>4 THEN GOTO 30; IF MEM[H].HH.B1<>4 THEN GOTO 30;H:=MEM[H].HH.RH; IF H=KNOTS THEN BEGIN MEM[H].HH.B0:=5;GOTO 30;END;END;30:{:272};P:=H; REPEAT{273:}Q:=MEM[P].HH.RH; IF MEM[P].HH.B1>=2 THEN BEGIN WHILE(MEM[Q].HH.B0=4)AND(MEM[Q].HH.B1=4)DO Q:=MEM[Q].HH.RH;{278:}{281:}K:=0;S:=P;N:=PATHSIZE; REPEAT T:=MEM[S].HH.RH;DELTAX[K]:=MEM[T+1].INT-MEM[S+1].INT; DELTAY[K]:=MEM[T+2].INT-MEM[S+2].INT; DELTA[K]:=PYTHADD(DELTAX[K],DELTAY[K]); IF K>0 THEN BEGIN SINE:=MAKEFRACTION(DELTAY[K-1],DELTA[K-1]); COSINE:=MAKEFRACTION(DELTAX[K-1],DELTA[K-1]); PSI[K]:=NARG(TAKEFRACTION(DELTAX[K],COSINE)+TAKEFRACTION(DELTAY[K],SINE) ,TAKEFRACTION(DELTAY[K],COSINE)-TAKEFRACTION(DELTAX[K],SINE));END; K:=K+1;S:=T;IF K=PATHSIZE THEN OVERFLOW(531,PATHSIZE);IF S=Q THEN N:=K; UNTIL(K>=N)AND(MEM[S].HH.B0<>5); IF K=N THEN PSI[N]:=0 ELSE PSI[K]:=PSI[1]{:281};{282:} IF MEM[Q].HH.B0=4 THEN BEGIN DELX:=MEM[Q+5].INT-MEM[Q+1].INT; DELY:=MEM[Q+6].INT-MEM[Q+2].INT; IF(DELX=0)AND(DELY=0)THEN BEGIN MEM[Q].HH.B0:=3;MEM[Q+3].INT:=65536; END ELSE BEGIN MEM[Q].HH.B0:=2;MEM[Q+3].INT:=NARG(DELX,DELY);END;END; IF(MEM[P].HH.B1=4)AND(MEM[P].HH.B0=1)THEN BEGIN DELX:=MEM[P+1].INT-MEM[P +3].INT;DELY:=MEM[P+2].INT-MEM[P+4].INT; IF(DELX=0)AND(DELY=0)THEN BEGIN MEM[P].HH.B1:=3;MEM[P+5].INT:=65536; END ELSE BEGIN MEM[P].HH.B1:=2;MEM[P+5].INT:=NARG(DELX,DELY);END; END{:282};SOLVECHOICES(P,Q,N){:278};END;P:=Q{:273};UNTIL P=H; IF INTERNAL[4]>0 THEN PRINTPATH(KNOTS,527,TRUE);IF ARITHERROR THEN{270:} BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(528);END;BEGIN HELPPTR:=2; HELPLINE[1]:=529;HELPLINE[0]:=530;END;PUTGETERROR;ARITHERROR:=FALSE; END{:270};END;{:269}{311:} PROCEDURE MAKEMOVES(XX0,XX1,XX2,XX3,YY0,YY1,YY2,YY3:SCALED; XICORR,ETACORR:SMALLNUMBER);LABEL 22,30,10; VAR X1,X2,X3,M,R,Y1,Y2,Y3,N,S,L:INTEGER;Q,T,U,X2A,X3A,Y2A,Y3A:INTEGER; BEGIN IF(XX3=XICORR THEN R:=(XX0-XICORR)MOD 65536 ELSE R:=65535-((-XX0+XICORR -1)MOD 65536);M:=(XX3-XX0+R)DIV 65536;Y1:=YY1-YY0;Y2:=YY2-YY1; Y3:=YY3-YY2; IF YY0>=ETACORR THEN S:=(YY0-ETACORR)MOD 65536 ELSE S:=65535-((-YY0+ ETACORR-1)MOD 65536);N:=(YY3-YY0+S)DIV 65536; IF(XX3-XX0>=268435456)OR(YY3-YY0>=268435456)THEN{313:} BEGIN X1:=(X1+XICORR)DIV 2;X2:=(X2+XICORR)DIV 2;X3:=(X3+XICORR)DIV 2; R:=(R+XICORR)DIV 2;Y1:=(Y1+ETACORR)DIV 2;Y2:=(Y2+ETACORR)DIV 2; Y3:=(Y3+ETACORR)DIV 2;S:=(S+ETACORR)DIV 2;L:=15;END{:313}; WHILE TRUE DO BEGIN 22:{314:}IF M=0 THEN{315:} WHILE N>0 DO BEGIN MOVEPTR:=MOVEPTR+1;MOVE[MOVEPTR]:=1;N:=N-1;END{:315} ELSE IF N=0 THEN{316:}MOVE[MOVEPTR]:=MOVE[MOVEPTR]+M{:316} ELSE IF M+N=2 THEN{317:}BEGIN R:=TWOTOTHE[L]-R;S:=TWOTOTHE[L]-S; WHILE L<30 DO BEGIN X3A:=X3;X2A:=(X2+X3+XICORR)DIV 2; X2:=(X1+X2+XICORR)DIV 2;X3:=(X2+X2A+XICORR)DIV 2;T:=X1+X2+X3; R:=R+R-XICORR;Y3A:=Y3;Y2A:=(Y2+Y3+ETACORR)DIV 2; Y2:=(Y1+Y2+ETACORR)DIV 2;Y3:=(Y2+Y2A+ETACORR)DIV 2;U:=Y1+Y2+Y3; S:=S+S-ETACORR;IF T=0 THEN{319:} BEGIN MOVE[MOVEPTR]:=MOVE[MOVEPTR]+1;MOVEPTR:=MOVEPTR+1; MOVE[MOVEPTR]:=1;END{:319}ELSE{320:}BEGIN MOVEPTR:=MOVEPTR+1; MOVE[MOVEPTR]:=2;END{:320};30:END{:317}ELSE BEGIN L:=L+1; BISECTSTACK[BISECTPTR+10]:=L;BISECTSTACK[BISECTPTR+2]:=X3; BISECTSTACK[BISECTPTR+1]:=(X2+X3+XICORR)DIV 2;X2:=(X1+X2+XICORR)DIV 2; X3:=(X2+BISECTSTACK[BISECTPTR+1]+XICORR)DIV 2; BISECTSTACK[BISECTPTR]:=X3;R:=R+R+XICORR;T:=X1+X2+X3+R; Q:=T DIV TWOTOTHE[L];BISECTSTACK[BISECTPTR+3]:=T MOD TWOTOTHE[L]; BISECTSTACK[BISECTPTR+4]:=M-Q;M:=Q;BISECTSTACK[BISECTPTR+7]:=Y3; BISECTSTACK[BISECTPTR+6]:=(Y2+Y3+ETACORR)DIV 2;Y2:=(Y1+Y2+ETACORR)DIV 2; Y3:=(Y2+BISECTSTACK[BISECTPTR+6]+ETACORR)DIV 2; BISECTSTACK[BISECTPTR+5]:=Y3;S:=S+S+ETACORR;U:=Y1+Y2+Y3+S; Q:=U DIV TWOTOTHE[L];BISECTSTACK[BISECTPTR+8]:=U MOD TWOTOTHE[L]; BISECTSTACK[BISECTPTR+9]:=N-Q;N:=Q;BISECTPTR:=BISECTPTR+11;GOTO 22; END{:314};IF BISECTPTR=0 THEN GOTO 10;{312:}BISECTPTR:=BISECTPTR-11; X1:=BISECTSTACK[BISECTPTR];X2:=BISECTSTACK[BISECTPTR+1]; X3:=BISECTSTACK[BISECTPTR+2];R:=BISECTSTACK[BISECTPTR+3]; M:=BISECTSTACK[BISECTPTR+4];Y1:=BISECTSTACK[BISECTPTR+5]; Y2:=BISECTSTACK[BISECTPTR+6];Y3:=BISECTSTACK[BISECTPTR+7]; S:=BISECTSTACK[BISECTPTR+8];N:=BISECTSTACK[BISECTPTR+9]; L:=BISECTSTACK[BISECTPTR+10]{:312};END;10:END;{:311}{321:} PROCEDURE SMOOTHMOVES(B,T:INTEGER);VAR K:1..MOVESIZE;A,AA,AAA:INTEGER; BEGIN IF T-B>=3 THEN BEGIN K:=B+2;AA:=MOVE[K-1];AAA:=MOVE[K-2]; REPEAT A:=MOVE[K];IF ABS(A-AA)>1 THEN{322:} IF A>AA THEN BEGIN IF AAA>=AA THEN IF A>=MOVE[K+1]THEN BEGIN MOVE[K-1]:= MOVE[K-1]+1;MOVE[K]:=A-1;END; END ELSE BEGIN IF AAA<=AA THEN IF A<=MOVE[K+1]THEN BEGIN MOVE[K-1]:=MOVE [K-1]-1;MOVE[K]:=A+1;END;END{:322};K:=K+1;AAA:=AA;AA:=A;UNTIL K=T;END; END;{:321}{326:}PROCEDURE INITEDGES(H:HALFWORD);BEGIN MEM[H].HH.LH:=H; MEM[H].HH.RH:=H;MEM[H+1].HH.LH:=8191;MEM[H+1].HH.RH:=1; MEM[H+2].HH.LH:=8191;MEM[H+2].HH.RH:=1;MEM[H+3].HH.LH:=4096; MEM[H+3].HH.RH:=0;MEM[H+4].INT:=0;MEM[H+5].HH.RH:=H;MEM[H+5].HH.LH:=0; END;{:326}{328:}PROCEDURE FIXOFFSET;VAR P,Q:HALFWORD;DELTA:INTEGER; BEGIN DELTA:=8*(MEM[CUREDGES+3].HH.LH-4096);MEM[CUREDGES+3].HH.LH:=4096; Q:=MEM[CUREDGES].HH.RH;WHILE Q<>CUREDGES DO BEGIN P:=MEM[Q+1].HH.RH; WHILE P<>65534 DO BEGIN MEM[P].HH.LH:=MEM[P].HH.LH-DELTA; P:=MEM[P].HH.RH;END;P:=MEM[Q+1].HH.LH; WHILE P>1 DO BEGIN MEM[P].HH.LH:=MEM[P].HH.LH-DELTA;P:=MEM[P].HH.RH;END; Q:=MEM[Q].HH.RH;END;END;{:328}{329:} PROCEDURE EDGEPREP(ML,MR,NL,NR:INTEGER);VAR DELTA:HALFWORD;P,Q:HALFWORD; BEGIN ML:=ML+4096;MR:=MR+4096;NL:=NL+4096;NR:=NR+4095; IF MLMEM[CUREDGES+2].HH.RH THEN MEM[CUREDGES+2].HH.RH:=MR; IF NOT(ABS(MEM[CUREDGES+2].HH.LH+MEM[CUREDGES+3].HH.LH-8192)<4096)OR NOT (ABS(MEM[CUREDGES+2].HH.RH+MEM[CUREDGES+3].HH.LH-8192)<4096)THEN FIXOFFSET; IF MEM[CUREDGES].HH.RH=CUREDGES THEN BEGIN MEM[CUREDGES+1].HH.LH:=NR+1; MEM[CUREDGES+1].HH.RH:=NR;END;IF NLMEM[CUREDGES+1].HH.RH THEN{331:} BEGIN DELTA:=NR-MEM[CUREDGES+1].HH.RH;MEM[CUREDGES+1].HH.RH:=NR; P:=MEM[CUREDGES].HH.LH;REPEAT Q:=GETNODE(2);MEM[Q+1].HH.RH:=65534; MEM[Q+1].HH.LH:=1;MEM[P].HH.RH:=Q;MEM[Q].HH.LH:=P;P:=Q;DELTA:=DELTA-1; UNTIL DELTA=0;MEM[P].HH.RH:=CUREDGES;MEM[CUREDGES].HH.LH:=P; IF MEM[CUREDGES+5].HH.RH=CUREDGES THEN MEM[CUREDGES+5].HH.LH:=NR+1; END{:331};END;{:329}{334:}FUNCTION COPYEDGES(H:HALFWORD):HALFWORD; VAR P,R:HALFWORD;HH,PP,QQ,RR,SS:HALFWORD;BEGIN HH:=GETNODE(6); MEM[HH+1]:=MEM[H+1];MEM[HH+2]:=MEM[H+2];MEM[HH+3]:=MEM[H+3]; MEM[HH+4]:=MEM[H+4];MEM[HH+5].HH.LH:=MEM[HH+1].HH.RH+1; MEM[HH+5].HH.RH:=HH;P:=MEM[H].HH.RH;QQ:=HH; WHILE P<>H DO BEGIN PP:=GETNODE(2);MEM[QQ].HH.RH:=PP;MEM[PP].HH.LH:=QQ; {335:}R:=MEM[P+1].HH.RH;RR:=PP+1;WHILE R<>65534 DO BEGIN SS:=GETAVAIL; MEM[RR].HH.RH:=SS;RR:=SS;MEM[RR].HH.LH:=MEM[R].HH.LH;R:=MEM[R].HH.RH; END;MEM[RR].HH.RH:=65534;R:=MEM[P+1].HH.LH;RR:=65533; WHILE R>1 DO BEGIN SS:=GETAVAIL;MEM[RR].HH.RH:=SS;RR:=SS; MEM[RR].HH.LH:=MEM[R].HH.LH;R:=MEM[R].HH.RH;END;MEM[RR].HH.RH:=R; MEM[PP+1].HH.LH:=MEM[65533].HH.RH{:335};P:=MEM[P].HH.RH;QQ:=PP;END; MEM[QQ].HH.RH:=HH;MEM[HH].HH.LH:=QQ;COPYEDGES:=HH;END;{:334}{336:} PROCEDURE YREFLECTEDGE;VAR P,Q,R:HALFWORD; BEGIN P:=MEM[CUREDGES+1].HH.LH; MEM[CUREDGES+1].HH.LH:=8191-MEM[CUREDGES+1].HH.RH; MEM[CUREDGES+1].HH.RH:=8191-P; MEM[CUREDGES+5].HH.LH:=8191-MEM[CUREDGES+5].HH.LH; P:=MEM[CUREDGES].HH.RH;Q:=CUREDGES;REPEAT R:=MEM[P].HH.RH; MEM[P].HH.RH:=Q;MEM[Q].HH.LH:=P;Q:=P;P:=R;UNTIL Q=CUREDGES; MEM[CUREDGES+4].INT:=0;END;{:336}{337:}PROCEDURE XREFLECTEDGE; VAR P,Q,R,S:HALFWORD;M:INTEGER;BEGIN P:=MEM[CUREDGES+2].HH.LH; MEM[CUREDGES+2].HH.LH:=8192-MEM[CUREDGES+2].HH.RH; MEM[CUREDGES+2].HH.RH:=8192-P;M:=(4096+MEM[CUREDGES+3].HH.LH)*8+8; MEM[CUREDGES+3].HH.LH:=4096;P:=MEM[CUREDGES].HH.RH;REPEAT{339:} Q:=MEM[P+1].HH.RH;R:=65534;WHILE Q<>65534 DO BEGIN S:=MEM[Q].HH.RH; MEM[Q].HH.RH:=R;R:=Q;MEM[R].HH.LH:=M-MEM[Q].HH.LH;Q:=S;END; MEM[P+1].HH.RH:=R{:339};{338:}Q:=MEM[P+1].HH.LH; WHILE Q>1 DO BEGIN MEM[Q].HH.LH:=M-MEM[Q].HH.LH;Q:=MEM[Q].HH.RH; END{:338};P:=MEM[P].HH.RH;UNTIL P=CUREDGES;MEM[CUREDGES+4].INT:=0;END; {:337}{340:}PROCEDURE YSCALEEDGES(S:INTEGER); VAR P,Q,PP,R,RR,SS:HALFWORD;T:INTEGER; BEGIN IF(S*(MEM[CUREDGES+1].HH.RH-4095)>=4096)OR(S*(MEM[CUREDGES+1].HH. LH-4096)<=-4096)THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(535);END; BEGIN HELPPTR:=3;HELPLINE[2]:=536;HELPLINE[1]:=537;HELPLINE[0]:=538;END; PUTGETERROR; END ELSE BEGIN MEM[CUREDGES+1].HH.RH:=S*(MEM[CUREDGES+1].HH.RH-4095) +4095;MEM[CUREDGES+1].HH.LH:=S*(MEM[CUREDGES+1].HH.LH-4096)+4096;{341:} P:=CUREDGES;REPEAT Q:=P;P:=MEM[P].HH.RH; FOR T:=2 TO S DO BEGIN PP:=GETNODE(2);MEM[Q].HH.RH:=PP;MEM[P].HH.LH:=PP; MEM[PP].HH.RH:=P;MEM[PP].HH.LH:=Q;Q:=PP;{335:}R:=MEM[P+1].HH.RH; RR:=PP+1;WHILE R<>65534 DO BEGIN SS:=GETAVAIL;MEM[RR].HH.RH:=SS;RR:=SS; MEM[RR].HH.LH:=MEM[R].HH.LH;R:=MEM[R].HH.RH;END;MEM[RR].HH.RH:=65534; R:=MEM[P+1].HH.LH;RR:=65533;WHILE R>1 DO BEGIN SS:=GETAVAIL; MEM[RR].HH.RH:=SS;RR:=SS;MEM[RR].HH.LH:=MEM[R].HH.LH;R:=MEM[R].HH.RH; END;MEM[RR].HH.RH:=R;MEM[PP+1].HH.LH:=MEM[65533].HH.RH{:335};END; UNTIL MEM[P].HH.RH=CUREDGES{:341};MEM[CUREDGES+4].INT:=0;END;END;{:340} {342:}PROCEDURE XSCALEEDGES(S:INTEGER);VAR P,Q:HALFWORD;T:0..65535; W:0..7;DELTA:INTEGER; BEGIN IF(S*(MEM[CUREDGES+2].HH.RH-4096)>=4096)OR(S*(MEM[CUREDGES+2].HH. LH-4096)<=-4096)THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(535);END; BEGIN HELPPTR:=3;HELPLINE[2]:=539;HELPLINE[1]:=537;HELPLINE[0]:=538;END; PUTGETERROR; END ELSE IF(MEM[CUREDGES+2].HH.RH<>4096)OR(MEM[CUREDGES+2].HH.LH<>4096) THEN BEGIN MEM[CUREDGES+2].HH.RH:=S*(MEM[CUREDGES+2].HH.RH-4096)+4096; MEM[CUREDGES+2].HH.LH:=S*(MEM[CUREDGES+2].HH.LH-4096)+4096; DELTA:=8*(4096-S*MEM[CUREDGES+3].HH.LH)+0;MEM[CUREDGES+3].HH.LH:=4096; {343:}Q:=MEM[CUREDGES].HH.RH;REPEAT P:=MEM[Q+1].HH.RH; WHILE P<>65534 DO BEGIN T:=MEM[P].HH.LH;W:=T MOD 8; MEM[P].HH.LH:=(T-W)*S+W+DELTA;P:=MEM[P].HH.RH;END;P:=MEM[Q+1].HH.LH; WHILE P>1 DO BEGIN T:=MEM[P].HH.LH;W:=T MOD 8; MEM[P].HH.LH:=(T-W)*S+W+DELTA;P:=MEM[P].HH.RH;END;Q:=MEM[Q].HH.RH; UNTIL Q=CUREDGES{:343};MEM[CUREDGES+4].INT:=0;END;END;{:342}{344:} PROCEDURE NEGATEEDGES(H:HALFWORD);LABEL 30;VAR P,Q,R,S,T,U:HALFWORD; BEGIN P:=MEM[H].HH.RH;WHILE P<>H DO BEGIN Q:=MEM[P+1].HH.LH; WHILE Q>1 DO BEGIN MEM[Q].HH.LH:=8-2*((MEM[Q].HH.LH)MOD 8)+MEM[Q].HH.LH; Q:=MEM[Q].HH.RH;END;Q:=MEM[P+1].HH.RH; IF Q<>65534 THEN BEGIN REPEAT MEM[Q].HH.LH:=8-2*((MEM[Q].HH.LH)MOD 8)+ MEM[Q].HH.LH;Q:=MEM[Q].HH.RH;UNTIL Q=65534;{345:}U:=P+1;Q:=MEM[U].HH.RH; R:=Q;S:=MEM[R].HH.RH; WHILE TRUE DO IF MEM[S].HH.LH>MEM[R].HH.LH THEN BEGIN MEM[U].HH.RH:=Q; IF S=65534 THEN GOTO 30;U:=R;Q:=S;R:=Q;S:=MEM[R].HH.RH; END ELSE BEGIN T:=S;S:=MEM[T].HH.RH;MEM[T].HH.RH:=Q;Q:=T;END; 30:MEM[R].HH.RH:=65534{:345};END;P:=MEM[P].HH.RH;END;MEM[H+4].INT:=0; END;{:344}{346:}PROCEDURE SORTEDGES(H:HALFWORD);LABEL 30;VAR K:HALFWORD; P,Q,R,S:HALFWORD;BEGIN R:=MEM[H+1].HH.LH;MEM[H+1].HH.LH:=0; P:=MEM[R].HH.RH;MEM[R].HH.RH:=65534;MEM[65533].HH.RH:=R; WHILE P>1 DO BEGIN K:=MEM[P].HH.LH;Q:=65533;REPEAT R:=Q;Q:=MEM[R].HH.RH; UNTIL K<=MEM[Q].HH.LH;MEM[R].HH.RH:=P;R:=MEM[P].HH.RH;MEM[P].HH.RH:=Q; P:=R;END;{347:}BEGIN R:=H+1;Q:=MEM[R].HH.RH;P:=MEM[65533].HH.RH; WHILE TRUE DO BEGIN K:=MEM[P].HH.LH;WHILE K>MEM[Q].HH.LH DO BEGIN R:=Q; Q:=MEM[R].HH.RH;END;MEM[R].HH.RH:=P;S:=MEM[P].HH.RH;MEM[P].HH.RH:=Q; IF S=65534 THEN GOTO 30;R:=P;P:=S;END;30:END{:347};END;{:346}{348:} PROCEDURE CULLEDGES(WLO,WHI,WOUT,WIN:INTEGER);LABEL 30; VAR P,Q,R,S:HALFWORD;W:INTEGER;D:INTEGER;M:INTEGER;MM:INTEGER; WW:INTEGER;PREVW:INTEGER;N,MINN,MAXN:HALFWORD;MIND,MAXD:HALFWORD; BEGIN MIND:=65535;MAXD:=0;MINN:=65535;MAXN:=0;P:=MEM[CUREDGES].HH.RH; N:=MEM[CUREDGES+1].HH.LH; WHILE P<>CUREDGES DO BEGIN IF MEM[P+1].HH.LH>1 THEN SORTEDGES(P); IF MEM[P+1].HH.RH<>65534 THEN{349:}BEGIN R:=65533;Q:=MEM[P+1].HH.RH; WW:=0;M:=1000000;PREVW:=0; WHILE TRUE DO BEGIN IF Q=65534 THEN MM:=1000000 ELSE BEGIN D:=MEM[Q].HH. LH;MM:=D DIV 8;WW:=WW+(D MOD 8)-4;END;IF MM>M THEN BEGIN{350:} IF W<>PREVW THEN BEGIN S:=GETAVAIL;MEM[R].HH.RH:=S; MEM[S].HH.LH:=8*M+4+W-PREVW;R:=S;PREVW:=W;END{:350}; IF Q=65534 THEN GOTO 30;END;M:=MM; IF WW>=WLO THEN IF WW<=WHI THEN W:=WIN ELSE W:=WOUT ELSE W:=WOUT; S:=MEM[Q].HH.RH;BEGIN MEM[Q].HH.RH:=AVAIL;AVAIL:=Q;DYNUSED:=DYNUSED-1; END;Q:=S;END;30:MEM[R].HH.RH:=65534;MEM[P+1].HH.RH:=MEM[65533].HH.RH; IF R<>65533 THEN{351:}BEGIN IF MINN=65535 THEN MINN:=N;MAXN:=N; IF MIND>MEM[MEM[65533].HH.RH].HH.LH THEN MIND:=MEM[MEM[65533].HH.RH].HH. LH;IF MAXDMAXN THEN{353:} BEGIN P:=MEM[CUREDGES].HH.RH;WHILE P<>CUREDGES DO BEGIN Q:=MEM[P].HH.RH; FREENODE(P,2);P:=Q;END;INITEDGES(CUREDGES);END{:353} ELSE BEGIN N:=MEM[CUREDGES+1].HH.LH;MEM[CUREDGES+1].HH.LH:=MINN; WHILE MINN>N DO BEGIN P:=MEM[CUREDGES].HH.RH; MEM[CUREDGES].HH.RH:=MEM[P].HH.RH;MEM[MEM[P].HH.RH].HH.LH:=CUREDGES; FREENODE(P,2);N:=N+1;END;N:=MEM[CUREDGES+1].HH.RH; MEM[CUREDGES+1].HH.RH:=MAXN;MEM[CUREDGES+5].HH.LH:=MAXN+1; MEM[CUREDGES+5].HH.RH:=CUREDGES; WHILE MAXNMOVESIZE THEN OVERFLOW(540,MOVESIZE); FOR J:=0 TO MSPREAD DO MOVE[J]:=65534{:356};{355:}P:=GETNODE(2); MEM[P+1].HH.RH:=65534;MEM[P+1].HH.LH:=0;MEM[P].HH.LH:=CUREDGES; MEM[MEM[CUREDGES].HH.RH].HH.LH:=P;P:=GETNODE(2);MEM[P+1].HH.RH:=65534; MEM[P].HH.LH:=MEM[CUREDGES].HH.LH;{:355};{365:} MMAGIC:=MEM[CUREDGES+2].HH.LH+MEM[CUREDGES+3].HH.LH-4096; NMAGIC:=8*MEM[CUREDGES+1].HH.RH+12{:365};REPEAT Q:=MEM[P].HH.LH; IF MEM[Q+1].HH.LH>1 THEN SORTEDGES(Q);{358:}R:=MEM[P+1].HH.RH; FREENODE(P,2);P:=R;PD:=MEM[P].HH.LH;PM:=PD DIV 8;R:=MEM[Q+1].HH.RH; RD:=MEM[R].HH.LH;RM:=RD DIV 8;W:=0; WHILE TRUE DO BEGIN IF PM0 THEN{362:} IF M<>MM THEN BEGIN IF MM-MMAGIC>=MOVESIZE THEN CONFUSION(510); EXTRAS:=(ABS(W)-1)DIV 3; IF EXTRAS>0 THEN BEGIN IF W>0 THEN XW:=+3 ELSE XW:=-3;WW:=W-EXTRAS*XW; END ELSE WW:=W;REPEAT J:=M-MMAGIC; FOR K:=1 TO EXTRAS DO BEGIN S:=GETAVAIL;MEM[S].HH.LH:=NMAGIC+XW; MEM[S].HH.RH:=MOVE[J];MOVE[J]:=S;END;S:=GETAVAIL; MEM[S].HH.LH:=NMAGIC+WW;MEM[S].HH.RH:=MOVE[J];MOVE[J]:=S;M:=M+1; UNTIL M=MM;END{:362};IF PDJJ;MEM[Q].HH.RH:=CUREDGES; MEM[CUREDGES].HH.LH:=Q;MEM[CUREDGES+5].HH.LH:=MEM[CUREDGES+1].HH.RH+1; MEM[CUREDGES+5].HH.RH:=CUREDGES;MEM[CUREDGES+4].INT:=0;END;{:364};END; {:354}{366:}PROCEDURE MERGEEDGES(H:HALFWORD);LABEL 30; VAR P,Q,R,PP,QQ,RR:HALFWORD;N:INTEGER;K:HALFWORD;DELTA:INTEGER; BEGIN IF MEM[H].HH.RH<>H THEN BEGIN IF(MEM[H+2].HH.LHMEM[CUREDGES+2].HH.RH)OR(MEM[H+1].HH.LHMEM[CUREDGES+1].HH.RH)THEN EDGEPREP( MEM[H+2].HH.LH-4096,MEM[H+2].HH.RH-4096,MEM[H+1].HH.LH-4096,MEM[H+1].HH. RH-4095);IF MEM[H+3].HH.LH<>MEM[CUREDGES+3].HH.LH THEN{367:} BEGIN PP:=MEM[H].HH.RH;DELTA:=8*(MEM[CUREDGES+3].HH.LH-MEM[H+3].HH.LH); REPEAT QQ:=MEM[PP+1].HH.RH; WHILE QQ<>65534 DO BEGIN MEM[QQ].HH.LH:=MEM[QQ].HH.LH+DELTA; QQ:=MEM[QQ].HH.RH;END;QQ:=MEM[PP+1].HH.LH; WHILE QQ>1 DO BEGIN MEM[QQ].HH.LH:=MEM[QQ].HH.LH+DELTA; QQ:=MEM[QQ].HH.RH;END;PP:=MEM[PP].HH.RH;UNTIL PP=H;END{:367}; N:=MEM[CUREDGES+1].HH.LH;P:=MEM[CUREDGES].HH.RH;PP:=MEM[H].HH.RH; WHILE N1 THEN IF MEM[P+1].HH.LH<=1 THEN MEM[P+1].HH.LH:=QQ ELSE BEGIN WHILE MEM[QQ].HH.RH>1 DO QQ:=MEM[QQ].HH.RH; MEM[QQ].HH.RH:=MEM[P+1].HH.LH;MEM[P+1].HH.LH:=MEM[PP+1].HH.LH;END; MEM[PP+1].HH.LH:=0;QQ:=MEM[PP+1].HH.RH; IF QQ<>65534 THEN BEGIN IF MEM[P+1].HH.LH=1 THEN MEM[P+1].HH.LH:=0; MEM[PP+1].HH.RH:=65534;R:=P+1;Q:=MEM[R].HH.RH; IF Q=65534 THEN MEM[P+1].HH.RH:=QQ ELSE WHILE TRUE DO BEGIN K:=MEM[QQ]. HH.LH;WHILE K>MEM[Q].HH.LH DO BEGIN R:=Q;Q:=MEM[R].HH.RH;END; MEM[R].HH.RH:=QQ;RR:=MEM[QQ].HH.RH;MEM[QQ].HH.RH:=Q; IF RR=65534 THEN GOTO 30;R:=QQ;QQ:=RR;END;END;30:{:368}; PP:=MEM[PP].HH.RH;P:=MEM[P].HH.RH;UNTIL PP=H;END;END;{:366}{369:} FUNCTION TOTALWEIGHT(H:HALFWORD):INTEGER;VAR P,Q:HALFWORD;N:INTEGER; M:0..65535;BEGIN N:=0;P:=MEM[H].HH.RH; WHILE P<>H DO BEGIN Q:=MEM[P+1].HH.RH;WHILE Q<>65534 DO{370:} BEGIN M:=MEM[Q].HH.LH;N:=N-((M MOD 8)-4)*(M DIV 8);Q:=MEM[Q].HH.RH; END{:370};Q:=MEM[P+1].HH.LH;WHILE Q>1 DO{370:}BEGIN M:=MEM[Q].HH.LH; N:=N-((M MOD 8)-4)*(M DIV 8);Q:=MEM[Q].HH.RH;END{:370};P:=MEM[P].HH.RH; END;TOTALWEIGHT:=N;END;{:369}{372:}PROCEDURE BEGINEDGETRA; BEGIN PRINTDIAGNOS(541,285,TRUE);PRINT(542);PRINTINT(CURWT); PRINTCHAR(41);TRACEX:=-4096;END;PROCEDURE TRACEACORNER; BEGIN IF FILEOFFSET>MAXPRINTLINE-13 THEN PRINTNL(285);PRINTCHAR(40); PRINTINT(TRACEX);PRINTCHAR(44);PRINTINT(TRACEYY);PRINTCHAR(41); TRACEY:=TRACEYY;END;PROCEDURE ENDEDGETRACI; BEGIN IF TRACEX=-4096 THEN PRINTNL(543)ELSE BEGIN TRACEACORNER; PRINTCHAR(46);END;ENDDIAGNOSTI(TRUE);END;{:372}{373:} PROCEDURE TRACENEWEDGE(R:HALFWORD;N:INTEGER);VAR D:INTEGER;W:-3..3; M,N0,N1:INTEGER;BEGIN D:=MEM[R].HH.LH;W:=(D MOD 8)-4; M:=(D DIV 8)-MEM[CUREDGES+3].HH.LH;IF W=CURWT THEN BEGIN N0:=N+1;N1:=N; END ELSE BEGIN N0:=N;N1:=N+1;END; IF M<>TRACEX THEN BEGIN IF TRACEX=-4096 THEN BEGIN PRINTNL(285); TRACEYY:=N0;END ELSE IF TRACEYY<>N0 THEN PRINTCHAR(63)ELSE TRACEACORNER; TRACEX:=M;TRACEACORNER;END ELSE BEGIN IF N0<>TRACEYY THEN PRINTCHAR(33); IF((N0TRACEYY))OR((N0>N1)AND(TRACEYN1 THEN BEGIN M0:=ROUNDUNSCALE(X0); M1:=ROUNDUNSCALE(X1);DELX:=X1-X0;DELY:=Y1-Y0;YT:=N0*65536-32768; Y0:=Y0-YT;Y1:=Y1-YT;IF N0N0 THEN IF N0 THEN TRACENEWEDGE(R,N);IF Y1<65536 THEN GOTO 30; P:=MEM[P].HH.RH;Y0:=Y0+65536;N:=N+1;END;30:END{:375}ELSE{376:} BEGIN BASE:=8*MEM[CUREDGES+3].HH.LH+4+CURWT; IF M0<=M1 THEN EDGEPREP(M0,M1,N1,N0)ELSE EDGEPREP(M1,M0,N1,N0);N0:=N0-1; {377:}N:=MEM[CUREDGES+5].HH.LH-4096;P:=MEM[CUREDGES+5].HH.RH; IF N<>N0 THEN IF N0 THEN TRACENEWEDGE(R,N);IF Y1>=0 THEN GOTO 31; P:=MEM[P].HH.LH;Y0:=Y0+65536;N:=N-1;END;31:END{:376}; MEM[CUREDGES+5].HH.RH:=P;MEM[CUREDGES+5].HH.LH:=N+4096;END;END;{:374} {378:}PROCEDURE MOVETOEDGES(M0,N0,M1,N1:INTEGER);LABEL 60,61,62,63,30; VAR DELTA:0..MOVESIZE;K:0..MOVESIZE;P,R:HALFWORD;DX:INTEGER; EDGEANDWEIGH:INTEGER;J:INTEGER;N:INTEGER;{SUM:INTEGER;} BEGIN DELTA:=N1-N0;{SUM:=MOVE[0]; FOR K:=1 TO DELTA DO SUM:=SUM+ABS(MOVE[K]); IF SUM<>M1-M0 THEN CONFUSION(48);}{380:}CASE OCTANT OF 1:BEGIN DX:=8; EDGEPREP(M0,M1,N0,N1);GOTO 60;END;5:BEGIN DX:=8;EDGEPREP(N0,N1,M0,M1); GOTO 62;END;6:BEGIN DX:=-8;EDGEPREP(-N1,-N0,M0,M1);N0:=-N0;GOTO 62;END; 2:BEGIN DX:=-8;EDGEPREP(-M1,-M0,N0,N1);M0:=-M0;GOTO 60;END; 4:BEGIN DX:=-8;EDGEPREP(-M1,-M0,-N1,-N0);M0:=-M0;GOTO 61;END; 8:BEGIN DX:=-8;EDGEPREP(-N1,-N0,-M1,-M0);N0:=-N0;GOTO 63;END; 7:BEGIN DX:=8;EDGEPREP(N0,N1,-M1,-M0);GOTO 63;END;3:BEGIN DX:=8; EDGEPREP(M0,M1,-N1,-N0);GOTO 61;END;END;{:380};60:{381:}{377:} N:=MEM[CUREDGES+5].HH.LH-4096;P:=MEM[CUREDGES+5].HH.RH; IF N<>N0 THEN IF N0 THEN BEGIN K:=0; EDGEANDWEIGH:=8*(M0+MEM[CUREDGES+3].HH.LH)+4-CURWT; REPEAT EDGEANDWEIGH:=EDGEANDWEIGH+DX*MOVE[K];BEGIN R:=AVAIL; IF R=0 THEN R:=GETAVAIL ELSE BEGIN AVAIL:=MEM[R].HH.RH;MEM[R].HH.RH:=0; DYNUSED:=DYNUSED+1;END;END;MEM[R].HH.RH:=MEM[P+1].HH.LH; MEM[R].HH.LH:=EDGEANDWEIGH;IF INTERNAL[10]>0 THEN TRACENEWEDGE(R,N); MEM[P+1].HH.LH:=R;P:=MEM[P].HH.RH;K:=K+1;N:=N+1;UNTIL K=DELTA;END; GOTO 30{:381};61:{382:}N0:=-N0-1;{377:}N:=MEM[CUREDGES+5].HH.LH-4096; P:=MEM[CUREDGES+5].HH.RH;IF N<>N0 THEN IF N0 THEN BEGIN K:=0; EDGEANDWEIGH:=8*(M0+MEM[CUREDGES+3].HH.LH)+4+CURWT; REPEAT EDGEANDWEIGH:=EDGEANDWEIGH+DX*MOVE[K];BEGIN R:=AVAIL; IF R=0 THEN R:=GETAVAIL ELSE BEGIN AVAIL:=MEM[R].HH.RH;MEM[R].HH.RH:=0; DYNUSED:=DYNUSED+1;END;END;MEM[R].HH.RH:=MEM[P+1].HH.LH; MEM[R].HH.LH:=EDGEANDWEIGH;IF INTERNAL[10]>0 THEN TRACENEWEDGE(R,N); MEM[P+1].HH.LH:=R;P:=MEM[P].HH.LH;K:=K+1;N:=N-1;UNTIL K=DELTA;END; GOTO 30{:382};62:{383:} EDGEANDWEIGH:=8*(N0+MEM[CUREDGES+3].HH.LH)+4-CURWT;N0:=M0;K:=0;{377:} N:=MEM[CUREDGES+5].HH.LH-4096;P:=MEM[CUREDGES+5].HH.RH; IF N<>N0 THEN IF N0 DO BEGIN BEGIN R:=AVAIL; IF R=0 THEN R:=GETAVAIL ELSE BEGIN AVAIL:=MEM[R].HH.RH;MEM[R].HH.RH:=0; DYNUSED:=DYNUSED+1;END;END;MEM[R].HH.RH:=MEM[P+1].HH.LH; MEM[R].HH.LH:=EDGEANDWEIGH;IF INTERNAL[10]>0 THEN TRACENEWEDGE(R,N); MEM[P+1].HH.LH:=R;P:=MEM[P].HH.RH;J:=J-1;N:=N+1;END; EDGEANDWEIGH:=EDGEANDWEIGH+DX;K:=K+1;UNTIL K>DELTA;GOTO 30{:383}; 63:{384:}EDGEANDWEIGH:=8*(N0+MEM[CUREDGES+3].HH.LH)+4+CURWT;N0:=-M0-1; K:=0;{377:}N:=MEM[CUREDGES+5].HH.LH-4096;P:=MEM[CUREDGES+5].HH.RH; IF N<>N0 THEN IF N0 DO BEGIN BEGIN R:=AVAIL; IF R=0 THEN R:=GETAVAIL ELSE BEGIN AVAIL:=MEM[R].HH.RH;MEM[R].HH.RH:=0; DYNUSED:=DYNUSED+1;END;END;MEM[R].HH.RH:=MEM[P+1].HH.LH; MEM[R].HH.LH:=EDGEANDWEIGH;IF INTERNAL[10]>0 THEN TRACENEWEDGE(R,N); MEM[P+1].HH.LH:=R;P:=MEM[P].HH.LH;J:=J-1;N:=N-1;END; EDGEANDWEIGH:=EDGEANDWEIGH+DX;K:=K+1;UNTIL K>DELTA;GOTO 30{:384}; 30:MEM[CUREDGES+5].HH.LH:=N+4096;MEM[CUREDGES+5].HH.RH:=P;END;{:378} {387:}PROCEDURE SKEW(X,Y:SCALED;OCTANT:SMALLNUMBER); BEGIN CASE OCTANT OF 1:BEGIN CURX:=X-Y;CURY:=Y;END;5:BEGIN CURX:=Y-X; CURY:=X;END;6:BEGIN CURX:=Y+X;CURY:=-X;END;2:BEGIN CURX:=-X-Y;CURY:=Y; END;4:BEGIN CURX:=-X+Y;CURY:=-Y;END;8:BEGIN CURX:=-Y+X;CURY:=-X;END; 7:BEGIN CURX:=-Y-X;CURY:=X;END;3:BEGIN CURX:=X+Y;CURY:=-Y;END;END;END; {:387}{390:}PROCEDURE ABNEGATE(X,Y:SCALED; OCTANTBEFORE,OCTANTAFTER:SMALLNUMBER); BEGIN IF(ODD(OCTANTBEFORE)AND ODD(OCTANTAFTER))OR(NOT ODD(OCTANTBEFORE) AND NOT ODD(OCTANTAFTER))THEN CURX:=X ELSE CURX:=-X; IF((OCTANTBEFORE>2)AND(OCTANTAFTER>2))OR((OCTANTBEFORE<=2)AND( OCTANTAFTER<=2))THEN CURY:=Y ELSE CURY:=-Y;END;{:390}{391:} FUNCTION CROSSINGPOIN(A,B,C:INTEGER):FRACTION;LABEL 10;VAR D:INTEGER; X,XX,X0,X1,X2:INTEGER;BEGIN IF A<0 THEN BEGIN CROSSINGPOIN:=0;GOTO 10; END;IF C>=0 THEN BEGIN IF B>=0 THEN IF C>0 THEN BEGIN CROSSINGPOIN:= 268435457;GOTO 10; END ELSE IF(A=0)AND(B=0)THEN BEGIN CROSSINGPOIN:=268435457;GOTO 10; END ELSE BEGIN CROSSINGPOIN:=268435456;GOTO 10;END; IF A=0 THEN BEGIN CROSSINGPOIN:=0;GOTO 10;END; END ELSE IF A=0 THEN IF B<=0 THEN BEGIN CROSSINGPOIN:=0;GOTO 10;END; {392:}D:=1;X0:=A;X1:=A-B;X2:=B-C;REPEAT X:=(X1+X2)DIV 2; IF X1-X0>X0 THEN BEGIN X2:=X;X0:=X0+X0;D:=D+D; END ELSE BEGIN XX:=X1+X-X0;IF XX>X0 THEN BEGIN X2:=X;X0:=X0+X0;D:=D+D; END ELSE BEGIN X0:=X0-XX; IF X<=X0 THEN IF X+X2<=X0 THEN BEGIN CROSSINGPOIN:=268435457;GOTO 10; END;X1:=X;D:=D+D+1;END;END;UNTIL D>=268435456; CROSSINGPOIN:=D-268435456{:392};10:END;{:391}{394:} PROCEDURE PRINTSPEC(S:STRNUMBER);LABEL 45,30;VAR P,Q:HALFWORD; OCTANT:SMALLNUMBER;BEGIN PRINTDIAGNOS(544,S,TRUE);P:=CURSPEC; OCTANT:=MEM[P+3].INT;PRINTLN; UNSKEW(MEM[CURSPEC+1].INT,MEM[CURSPEC+2].INT,OCTANT); PRINTTWO(CURX,CURY);PRINT(545); WHILE TRUE DO BEGIN PRINT(OCTANTDIR[OCTANT]);PRINTCHAR(39); WHILE TRUE DO BEGIN Q:=MEM[P].HH.RH;IF MEM[P].HH.B1=0 THEN GOTO 45; {397:}BEGIN PRINTNL(556);UNSKEW(MEM[P+5].INT,MEM[P+6].INT,OCTANT); PRINTTWO(CURX,CURY);PRINT(523);UNSKEW(MEM[Q+3].INT,MEM[Q+4].INT,OCTANT); PRINTTWO(CURX,CURY);PRINTNL(520); UNSKEW(MEM[Q+1].INT,MEM[Q+2].INT,OCTANT);PRINTTWO(CURX,CURY);PRINT(557); PRINTINT(MEM[Q].HH.B0-1);END{:397};P:=Q;END; 45:IF Q=CURSPEC THEN GOTO 30;P:=Q;OCTANT:=MEM[P+3].INT;PRINTNL(546);END; 30:PRINTNL(547);ENDDIAGNOSTI(TRUE);END;{:394}{398:} PROCEDURE PRINTSTRANGE(S:STRNUMBER);VAR P:HALFWORD;F:HALFWORD; Q:HALFWORD;T:INTEGER;BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(62);{399:}P:=CURSPEC;T:=256;REPEAT P:=MEM[P].HH.RH; IF MEM[P].HH.B0<>0 THEN BEGIN IF MEM[P].HH.B00 THEN BEGIN IF MEM[P].HH.B0<>T THEN BEGIN T:= MEM[P].HH.B0;PRINTCHAR(32);PRINTINT(T-1);END;IF Q<>0 THEN BEGIN{401:} IF MEM[MEM[Q].HH.RH].HH.B0=0 THEN BEGIN PRINT(558); PRINT(OCTANTDIR[MEM[Q+3].INT]);Q:=MEM[Q].HH.RH; WHILE MEM[MEM[Q].HH.RH].HH.B0=0 DO BEGIN PRINTCHAR(32); PRINT(OCTANTDIR[MEM[Q+3].INT]);Q:=MEM[Q].HH.RH;END;PRINTCHAR(41); END{:401};PRINTCHAR(32);PRINT(OCTANTDIR[MEM[Q+3].INT]);Q:=0;END; END ELSE IF Q=0 THEN Q:=P;P:=MEM[P].HH.RH;UNTIL P=F;PRINTCHAR(32); PRINTINT(MEM[P].HH.B0-1);IF Q<>0 THEN{401:} IF MEM[MEM[Q].HH.RH].HH.B0=0 THEN BEGIN PRINT(558); PRINT(OCTANTDIR[MEM[Q+3].INT]);Q:=MEM[Q].HH.RH; WHILE MEM[MEM[Q].HH.RH].HH.B0=0 DO BEGIN PRINTCHAR(32); PRINT(OCTANTDIR[MEM[Q+3].INT]);Q:=MEM[Q].HH.RH;END;PRINTCHAR(41); END{:401};BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(S);END;END;{:398}{402:}{405:} PROCEDURE REMOVECUBIC(P:HALFWORD);VAR Q:HALFWORD;BEGIN Q:=MEM[P].HH.RH; MEM[P].HH.B1:=MEM[Q].HH.B1;MEM[P].HH.RH:=MEM[Q].HH.RH; MEM[P+1].INT:=MEM[Q+1].INT;MEM[P+2].INT:=MEM[Q+2].INT; MEM[P+5].INT:=MEM[Q+5].INT;MEM[P+6].INT:=MEM[Q+6].INT;FREENODE(Q,7);END; {:405}{406:}{410:}PROCEDURE SPLITCUBIC(P:HALFWORD;T:FRACTION; XQ,YQ:SCALED);VAR V:SCALED;Q,R:HALFWORD;BEGIN Q:=MEM[P].HH.RH; R:=GETNODE(7);MEM[P].HH.RH:=R;MEM[R].HH.RH:=Q; MEM[R].HH.B0:=MEM[Q].HH.B0;MEM[R].HH.B1:=MEM[P].HH.B1; V:=MEM[P+5].INT-TAKEFRACTION(MEM[P+5].INT-MEM[Q+3].INT,T); MEM[P+5].INT:=MEM[P+1].INT-TAKEFRACTION(MEM[P+1].INT-MEM[P+5].INT,T); MEM[Q+3].INT:=MEM[Q+3].INT-TAKEFRACTION(MEM[Q+3].INT-XQ,T); MEM[R+3].INT:=MEM[P+5].INT-TAKEFRACTION(MEM[P+5].INT-V,T); MEM[R+5].INT:=V-TAKEFRACTION(V-MEM[Q+3].INT,T); MEM[R+1].INT:=MEM[R+3].INT-TAKEFRACTION(MEM[R+3].INT-MEM[R+5].INT,T); V:=MEM[P+6].INT-TAKEFRACTION(MEM[P+6].INT-MEM[Q+4].INT,T); MEM[P+6].INT:=MEM[P+2].INT-TAKEFRACTION(MEM[P+2].INT-MEM[P+6].INT,T); MEM[Q+4].INT:=MEM[Q+4].INT-TAKEFRACTION(MEM[Q+4].INT-YQ,T); MEM[R+4].INT:=MEM[P+6].INT-TAKEFRACTION(MEM[P+6].INT-V,T); MEM[R+6].INT:=V-TAKEFRACTION(V-MEM[Q+4].INT,T); MEM[R+2].INT:=MEM[R+4].INT-TAKEFRACTION(MEM[R+4].INT-MEM[R+6].INT,T); END;{:410}PROCEDURE QUADRANTSUBD;LABEL 22,10;VAR P,Q,R,S,PP,QQ:HALFWORD; FIRSTX,FIRSTY:SCALED;DEL1,DEL2,DEL3,DEL,DMAX:SCALED;T:FRACTION; DESTX,DESTY:SCALED;CONSTANTX:BOOLEAN;BEGIN P:=CURSPEC; FIRSTX:=MEM[CURSPEC+1].INT;FIRSTY:=MEM[CURSPEC+2].INT; REPEAT 22:Q:=MEM[P].HH.RH;{407:}IF Q=CURSPEC THEN BEGIN DESTX:=FIRSTX; DESTY:=FIRSTY;END ELSE BEGIN DESTX:=MEM[Q+1].INT;DESTY:=MEM[Q+2].INT; END;DEL1:=MEM[P+5].INT-MEM[P+1].INT;DEL2:=MEM[Q+3].INT-MEM[P+5].INT; DEL3:=DESTX-MEM[Q+3].INT;{408:} IF DEL1<>0 THEN DEL:=DEL1 ELSE IF DEL2<>0 THEN DEL:=DEL2 ELSE DEL:=DEL3; IF DEL<>0 THEN BEGIN DMAX:=ABS(DEL1); IF ABS(DEL2)>DMAX THEN DMAX:=ABS(DEL2); IF ABS(DEL3)>DMAX THEN DMAX:=ABS(DEL3); WHILE DMAX<134217728 DO BEGIN DMAX:=DMAX+DMAX;DEL1:=DEL1+DEL1; DEL2:=DEL2+DEL2;DEL3:=DEL3+DEL3;END;END{:408}; IF DEL=0 THEN CONSTANTX:=TRUE ELSE BEGIN CONSTANTX:=FALSE; IF DEL<0 THEN{409:}BEGIN MEM[P+1].INT:=-MEM[P+1].INT; MEM[P+5].INT:=-MEM[P+5].INT;MEM[Q+3].INT:=-MEM[Q+3].INT;DEL1:=-DEL1; DEL2:=-DEL2;DEL3:=-DEL3;DESTX:=-DESTX;MEM[P].HH.B1:=2;END{:409}; T:=CROSSINGPOIN(DEL1,DEL2,DEL3);IF T<268435456 THEN{411:} BEGIN SPLITCUBIC(P,T,DESTX,DESTY);R:=MEM[P].HH.RH; IF MEM[R].HH.B1>1 THEN MEM[R].HH.B1:=1 ELSE MEM[R].HH.B1:=2; IF MEM[R+1].INTMEM[R+1].INT THEN MEM[P+5].INT:=MEM[R+1].INT; MEM[R+1].INT:=-MEM[R+1].INT;MEM[R+5].INT:=MEM[R+1].INT; MEM[Q+3].INT:=-MEM[Q+3].INT;DESTX:=-DESTX; DEL2:=DEL2-TAKEFRACTION(DEL2-DEL3,T);IF DEL2>0 THEN DEL2:=0; T:=CROSSINGPOIN(0,-DEL2,-DEL3);IF T<268435456 THEN{412:} BEGIN SPLITCUBIC(R,T,DESTX,DESTY);S:=MEM[R].HH.RH; IF MEM[S+1].INTMEM [S+1].INT THEN MEM[Q+3].INT:=-MEM[S+1].INT ELSE MEM[Q+3].INT:=-MEM[Q+3]. INT;MEM[S+1].INT:=-MEM[S+1].INT;MEM[S+5].INT:=MEM[S+1].INT;END{:412} ELSE BEGIN IF MEM[R+1].INT>DESTX THEN BEGIN MEM[R+1].INT:=DESTX; MEM[R+3].INT:=-MEM[R+1].INT;MEM[R+5].INT:=MEM[R+1].INT;END; IF MEM[Q+3].INT>DESTX THEN MEM[Q+3].INT:=DESTX ELSE IF MEM[Q+3].INT0 THEN DEL:=DEL1 ELSE IF DEL2<>0 THEN DEL:=DEL2 ELSE DEL:=DEL3; IF DEL<>0 THEN BEGIN DMAX:=ABS(DEL1); IF ABS(DEL2)>DMAX THEN DMAX:=ABS(DEL2); IF ABS(DEL3)>DMAX THEN DMAX:=ABS(DEL3); WHILE DMAX<134217728 DO BEGIN DMAX:=DMAX+DMAX;DEL1:=DEL1+DEL1; DEL2:=DEL2+DEL2;DEL3:=DEL3+DEL3;END;END{:408}; IF DEL<>0 THEN BEGIN IF DEL<0 THEN{414:} BEGIN MEM[PP+2].INT:=-MEM[PP+2].INT;MEM[PP+6].INT:=-MEM[PP+6].INT; MEM[QQ+4].INT:=-MEM[QQ+4].INT;DEL1:=-DEL1;DEL2:=-DEL2;DEL3:=-DEL3; DESTY:=-DESTY;MEM[PP].HH.B1:=MEM[PP].HH.B1+2;END{:414}; T:=CROSSINGPOIN(DEL1,DEL2,DEL3);IF T<268435456 THEN{415:} BEGIN SPLITCUBIC(PP,T,DESTX,DESTY);R:=MEM[PP].HH.RH; IF MEM[R].HH.B1>2 THEN MEM[R].HH.B1:=MEM[R].HH.B1-2 ELSE MEM[R].HH.B1:= MEM[R].HH.B1+2; IF MEM[R+2].INTMEM[R+2].INT THEN MEM[PP+6].INT:=MEM[R+2].INT; MEM[R+2].INT:=-MEM[R+2].INT;MEM[R+6].INT:=MEM[R+2].INT; MEM[QQ+4].INT:=-MEM[QQ+4].INT;DESTY:=-DESTY; DEL2:=DEL2-TAKEFRACTION(DEL2-DEL3,T);IF DEL2>0 THEN DEL2:=0; T:=CROSSINGPOIN(0,-DEL2,-DEL3);IF T<268435456 THEN{416:} BEGIN SPLITCUBIC(R,T,DESTX,DESTY);S:=MEM[R].HH.RH; IF MEM[S+2].INT MEM[S+2].INT THEN MEM[QQ+4].INT:=-MEM[S+2].INT ELSE MEM[QQ+4].INT:=-MEM[ QQ+4].INT;MEM[S+2].INT:=-MEM[S+2].INT;MEM[S+6].INT:=MEM[S+2].INT; END{:416} ELSE BEGIN IF MEM[R+2].INT>DESTY THEN BEGIN MEM[R+2].INT:=DESTY; MEM[R+4].INT:=-MEM[R+2].INT;MEM[R+6].INT:=MEM[R+2].INT;END; IF MEM[QQ+4].INT>DESTY THEN MEM[QQ+4].INT:=DESTY ELSE IF MEM[QQ+4].INT< MEM[R+2].INT THEN MEM[QQ+4].INT:=MEM[R+2].INT;END;END{:415}; END ELSE{417:}IF CONSTANTX THEN BEGIN IF Q<>P THEN BEGIN REMOVECUBIC(P); IF CURSPEC<>Q THEN GOTO 22 ELSE BEGIN CURSPEC:=P;GOTO 10;END;END; END ELSE IF NOT ODD(MEM[PP].HH.B1)THEN{414:} BEGIN MEM[PP+2].INT:=-MEM[PP+2].INT;MEM[PP+6].INT:=-MEM[PP+6].INT; MEM[QQ+4].INT:=-MEM[QQ+4].INT;DEL1:=-DEL1;DEL2:=-DEL2;DEL3:=-DEL3; DESTY:=-DESTY;MEM[PP].HH.B1:=MEM[PP].HH.B1+2;END{:414}{:417};PP:=QQ; UNTIL PP=Q;IF CONSTANTX THEN{418:}BEGIN PP:=P;REPEAT QQ:=MEM[PP].HH.RH; IF MEM[PP].HH.B1>2 THEN BEGIN MEM[PP].HH.B1:=MEM[PP].HH.B1+1; MEM[PP+1].INT:=-MEM[PP+1].INT;MEM[PP+5].INT:=-MEM[PP+5].INT; MEM[QQ+3].INT:=-MEM[QQ+3].INT;END;PP:=QQ;UNTIL PP=Q;END{:418}{:413}; P:=Q;UNTIL P=CURSPEC;10:END;{:406}{419:}PROCEDURE OCTANTSUBDIV; VAR P,Q,R,S:HALFWORD;DEL1,DEL2,DEL3,DEL,DMAX:SCALED;T:FRACTION; DESTX,DESTY:SCALED;BEGIN P:=CURSPEC;REPEAT Q:=MEM[P].HH.RH; MEM[P+1].INT:=MEM[P+1].INT-MEM[P+2].INT; MEM[P+5].INT:=MEM[P+5].INT-MEM[P+6].INT; MEM[Q+3].INT:=MEM[Q+3].INT-MEM[Q+4].INT;{420:}{421:} IF Q=CURSPEC THEN BEGIN UNSKEW(MEM[Q+1].INT,MEM[Q+2].INT,MEM[Q].HH.B1); SKEW(CURX,CURY,MEM[P].HH.B1);DESTX:=CURX;DESTY:=CURY; END ELSE BEGIN ABNEGATE(MEM[Q+1].INT,MEM[Q+2].INT,MEM[Q].HH.B1,MEM[P].HH .B1);DESTX:=CURX-CURY;DESTY:=CURY;END;DEL1:=MEM[P+5].INT-MEM[P+1].INT; DEL2:=MEM[Q+3].INT-MEM[P+5].INT;DEL3:=DESTX-MEM[Q+3].INT{:421};{408:} IF DEL1<>0 THEN DEL:=DEL1 ELSE IF DEL2<>0 THEN DEL:=DEL2 ELSE DEL:=DEL3; IF DEL<>0 THEN BEGIN DMAX:=ABS(DEL1); IF ABS(DEL2)>DMAX THEN DMAX:=ABS(DEL2); IF ABS(DEL3)>DMAX THEN DMAX:=ABS(DEL3); WHILE DMAX<134217728 DO BEGIN DMAX:=DMAX+DMAX;DEL1:=DEL1+DEL1; DEL2:=DEL2+DEL2;DEL3:=DEL3+DEL3;END;END{:408}; IF DEL<>0 THEN BEGIN IF DEL<0 THEN{423:} BEGIN MEM[P+2].INT:=MEM[P+1].INT+MEM[P+2].INT; MEM[P+1].INT:=-MEM[P+1].INT;MEM[P+6].INT:=MEM[P+5].INT+MEM[P+6].INT; MEM[P+5].INT:=-MEM[P+5].INT;MEM[Q+4].INT:=MEM[Q+3].INT+MEM[Q+4].INT; MEM[Q+3].INT:=-MEM[Q+3].INT;DEL1:=-DEL1;DEL2:=-DEL2;DEL3:=-DEL3; DESTY:=DESTX+DESTY;DESTX:=-DESTX;MEM[P].HH.B1:=MEM[P].HH.B1+4;END{:423}; T:=CROSSINGPOIN(DEL1,DEL2,DEL3);IF T<268435456 THEN{424:} BEGIN SPLITCUBIC(P,T,DESTX,DESTY);R:=MEM[P].HH.RH; IF MEM[R].HH.B1>4 THEN MEM[R].HH.B1:=MEM[R].HH.B1-4 ELSE MEM[R].HH.B1:= MEM[R].HH.B1+4; IF MEM[P+1].INT+MEM[R+2].INT>DESTX+DESTY THEN BEGIN MEM[R+2].INT:=DESTX+ DESTY-MEM[P+1].INT; IF MEM[R+4].INT>MEM[R+2].INT THEN BEGIN MEM[R+4].INT:=MEM[R+2].INT; IF MEM[P+6].INT>MEM[R+2].INT THEN MEM[P+6].INT:=MEM[R+2].INT;END;END; IF MEM[R+1].INTDESTX+DESTY THEN MEM[R+1].INT:=DESTX+DESTY-MEM[R +2].INT;MEM[R+3].INT:=MEM[R+1].INT; IF MEM[P+5].INT>MEM[R+1].INT THEN MEM[P+5].INT:=MEM[R+1].INT; MEM[R+2].INT:=MEM[R+2].INT+MEM[R+1].INT; MEM[R+6].INT:=MEM[R+6].INT+MEM[R+1].INT;MEM[R+1].INT:=-MEM[R+1].INT; MEM[R+5].INT:=MEM[R+1].INT;MEM[Q+4].INT:=MEM[Q+4].INT+MEM[Q+3].INT; MEM[Q+3].INT:=-MEM[Q+3].INT;DESTY:=DESTY+DESTX;DESTX:=-DESTX; IF MEM[R+6].INT>DESTY THEN MEM[R+6].INT:=DESTY; IF MEM[Q+4].INT>DESTY THEN MEM[Q+4].INT:=DESTY ELSE IF MEM[Q+4].INTMEM[Q+4].INT THEN MEM[R+6].INT:=MEM[Q+4].INT; DEL2:=DEL2-TAKEFRACTION(DEL2-DEL3,T);IF DEL2>0 THEN DEL2:=0; T:=CROSSINGPOIN(0,-DEL2,-DEL3);IF T<268435456 THEN{425:} BEGIN SPLITCUBIC(R,T,DESTX,DESTY);S:=MEM[R].HH.RH; IF MEM[R+1].INT+MEM[S+2].INT>DESTX+DESTY THEN BEGIN MEM[S+2].INT:=DESTX+ DESTY-MEM[R+1].INT; IF MEM[S+4].INT>MEM[S+2].INT THEN BEGIN MEM[S+4].INT:=MEM[S+2].INT; IF MEM[R+6].INT>MEM[S+2].INT THEN MEM[R+6].INT:=MEM[S+2].INT;END;END; IF MEM[S+1].INT+MEM[S+2].INT>DESTX+DESTY THEN MEM[S+1].INT:=DESTX+DESTY- MEM[S+2].INT ELSE BEGIN IF MEM[S+1].INTMEM[S+1].INT THEN BEGIN MEM[Q+4].INT:=MEM[Q+4]. INT+MEM[S+1].INT;MEM[Q+3].INT:=-MEM[S+1].INT; END ELSE BEGIN MEM[Q+4].INT:=MEM[Q+4].INT+MEM[Q+3].INT; MEM[Q+3].INT:=-MEM[Q+3].INT;END;MEM[S+2].INT:=MEM[S+2].INT+MEM[S+1].INT; MEM[S+6].INT:=MEM[S+6].INT+MEM[S+1].INT;MEM[S+1].INT:=-MEM[S+1].INT; MEM[S+5].INT:=MEM[S+1].INT;DESTY:=DESTY+DESTX; IF MEM[S+6].INT>DESTY THEN MEM[S+6].INT:=DESTY; IF MEM[Q+4].INT>DESTY THEN MEM[Q+4].INT:=DESTY ELSE IF MEM[Q+4].INTMEM[Q+4].INT THEN MEM[S+6].INT:=MEM[Q+4].INT;END{:425} ELSE BEGIN IF MEM[R+1].INT>DESTX THEN BEGIN MEM[R+1].INT:=DESTX; MEM[R+3].INT:=-MEM[R+1].INT;MEM[R+5].INT:=MEM[R+1].INT;END; IF MEM[Q+3].INT>DESTX THEN MEM[Q+3].INT:=DESTX ELSE IF MEM[Q+3].INT=0 THEN DELTAA:=AFTER[K+1]-NEXTA ELSE DELTAA:=NEXTA-AFTER[K+1] ;NEXTA:=AFTER[K+1]; IF(DELTAA<0)OR(DELTAA>ABS(DELTAB+DELTAB))THEN BEGIN ALLSAFE:=FALSE; AFTER[K]:=BEFORE[K]; IF K=CURROUNDINGP-1 THEN AFTER[0]:=BEFORE[0]ELSE AFTER[K+1]:=BEFORE[K+1] ;END;END;UNTIL ALLSAFE;END;{:426}{429:} PROCEDURE BEFOREANDAFT(B,A:SCALED;P:HALFWORD); BEGIN IF CURROUNDINGP=MAXROUNDINGP THEN IF MAXROUNDINGP=0 THEN A:=A-(A MOD CURGRAN)-O ELSE A:=A+((-(A+1))MOD CURGRAN)- CURGRAN+1-O;IF B-AMAXALLOWED THEN IF A>0 THEN A:=MAXALLOWED ELSE A:=-MAXALLOWED; BEFOREANDAFT(B,A,Q);END{:434};P:=Q;UNTIL P=CURSPEC; IF CURROUNDINGP>0 THEN{436:}BEGIN MAKESAFE; REPEAT CURROUNDINGP:=CURROUNDINGP-1; IF(AFTER[CURROUNDINGP]<>BEFORE[CURROUNDINGP])OR(AFTER[CURROUNDINGP+1]<> BEFORE[CURROUNDINGP+1])THEN BEGIN P:=NODETOROUND[CURROUNDINGP]; IF ODD(MEM[P].HH.B1)THEN BEGIN B:=BEFORE[CURROUNDINGP]; A:=AFTER[CURROUNDINGP];END ELSE BEGIN B:=-BEFORE[CURROUNDINGP]; A:=-AFTER[CURROUNDINGP];END; IF BEFORE[CURROUNDINGP]=BEFORE[CURROUNDINGP+1]THEN ALPHA:=268435456 ELSE ALPHA:=MAKEFRACTION(AFTER[CURROUNDINGP+1]-AFTER[CURROUNDINGP],BEFORE[ CURROUNDINGP+1]-BEFORE[CURROUNDINGP]); REPEAT MEM[P+1].INT:=TAKEFRACTION(ALPHA,MEM[P+1].INT-B)+A; MEM[P+5].INT:=TAKEFRACTION(ALPHA,MEM[P+5].INT-B)+A;P:=MEM[P].HH.RH; MEM[P+3].INT:=TAKEFRACTION(ALPHA,MEM[P+3].INT-B)+A; UNTIL P=NODETOROUND[CURROUNDINGP+1];END;UNTIL CURROUNDINGP=0;END{:436}; P:=CURSPEC;CURROUNDINGP:=0;REPEAT Q:=MEM[P].HH.RH;{437:} IF(MEM[P].HH.B1>2)<>(MEM[Q].HH.B1>2)THEN BEGIN IF MEM[Q].HH.B1<=2 THEN B :=MEM[Q+2].INT ELSE B:=-MEM[Q+2].INT; IF(ABS(MEM[Q+2].INT-MEM[Q+6].INT)<655)OR(ABS(MEM[Q+2].INT+MEM[Q+4].INT)< 655)THEN{438:} BEGIN IF CURPEN=3 THEN PENEDGE:=0 ELSE IF CURPATHTYPE=0 THEN PENEDGE:= COMPROMISE(MEM[MEM[CURPEN+2].HH.RH+2].INT,MEM[MEM[CURPEN+1].HH.RH+2].INT )ELSE IF MEM[Q].HH.B1<=2 THEN PENEDGE:=MEM[MEM[CURPEN+1].HH.RH+2].INT ELSE PENEDGE:=MEM[MEM[CURPEN+2].HH.RH+2].INT;A:=GOODVAL(B,PENEDGE); END{:438}ELSE A:=B; IF ABS(A)>MAXALLOWED THEN IF A>0 THEN A:=MAXALLOWED ELSE A:=-MAXALLOWED; BEFOREANDAFT(B,A,Q);END{:437};P:=Q;UNTIL P=CURSPEC; IF CURROUNDINGP>0 THEN{439:}BEGIN MAKESAFE; REPEAT CURROUNDINGP:=CURROUNDINGP-1; IF(AFTER[CURROUNDINGP]<>BEFORE[CURROUNDINGP])OR(AFTER[CURROUNDINGP+1]<> BEFORE[CURROUNDINGP+1])THEN BEGIN P:=NODETOROUND[CURROUNDINGP]; IF MEM[P].HH.B1<=2 THEN BEGIN B:=BEFORE[CURROUNDINGP]; A:=AFTER[CURROUNDINGP];END ELSE BEGIN B:=-BEFORE[CURROUNDINGP]; A:=-AFTER[CURROUNDINGP];END; IF BEFORE[CURROUNDINGP]=BEFORE[CURROUNDINGP+1]THEN ALPHA:=268435456 ELSE ALPHA:=MAKEFRACTION(AFTER[CURROUNDINGP+1]-AFTER[CURROUNDINGP],BEFORE[ CURROUNDINGP+1]-BEFORE[CURROUNDINGP]); REPEAT MEM[P+2].INT:=TAKEFRACTION(ALPHA,MEM[P+2].INT-B)+A; MEM[P+6].INT:=TAKEFRACTION(ALPHA,MEM[P+6].INT-B)+A;P:=MEM[P].HH.RH; MEM[P+4].INT:=TAKEFRACTION(ALPHA,MEM[P+4].INT-B)+A; UNTIL P=NODETOROUND[CURROUNDINGP+1];END;UNTIL CURROUNDINGP=0;END{:439}; END;{:433}{440:}PROCEDURE DIAGROUND;VAR P,Q,PP:HALFWORD; B,A,BB,AA,D,C,DD,CC:SCALED;PENEDGE:SCALED;ALPHA,BETA:FRACTION; NEXTA:SCALED;ALLSAFE:BOOLEAN;K:0..MAXWIGGLE;FIRSTX,FIRSTY:SCALED; BEGIN P:=CURSPEC;CURROUNDINGP:=0;REPEAT Q:=MEM[P].HH.RH;{441:} IF MEM[P].HH.B1<>MEM[Q].HH.B1 THEN BEGIN IF MEM[Q].HH.B1>4 THEN B:=-MEM[ Q+1].INT ELSE B:=MEM[Q+1].INT; IF ABS(MEM[Q].HH.B1-MEM[P].HH.B1)=4 THEN IF(ABS(MEM[Q+1].INT-MEM[Q+5]. INT)<655)OR(ABS(MEM[Q+1].INT+MEM[Q+3].INT)<655)THEN{442:} BEGIN IF CURPEN=3 THEN PENEDGE:=0 ELSE IF CURPATHTYPE=0 THEN{443:} CASE MEM[Q].HH.B1 OF 1,5:PENEDGE:=COMPROMISE(MEM[MEM[MEM[CURPEN+1].HH.RH ].HH.LH+1].INT,-MEM[MEM[MEM[CURPEN+4].HH.RH].HH.LH+1].INT); 4,8:PENEDGE:=-COMPROMISE(MEM[MEM[MEM[CURPEN+1].HH.RH].HH.LH+1].INT,-MEM[ MEM[MEM[CURPEN+4].HH.RH].HH.LH+1].INT); 6,2:PENEDGE:=COMPROMISE(MEM[MEM[MEM[CURPEN+2].HH.RH].HH.LH+1].INT,-MEM[ MEM[MEM[CURPEN+3].HH.RH].HH.LH+1].INT); 7,3:PENEDGE:=-COMPROMISE(MEM[MEM[MEM[CURPEN+2].HH.RH].HH.LH+1].INT,-MEM[ MEM[MEM[CURPEN+3].HH.RH].HH.LH+1].INT);END{:443} ELSE IF MEM[Q].HH.B1<=4 THEN PENEDGE:=MEM[MEM[MEM[CURPEN+MEM[Q].HH.B1]. HH.RH].HH.LH+1].INT ELSE PENEDGE:=-MEM[MEM[MEM[CURPEN+MEM[Q].HH.B1].HH. RH].HH.LH+1].INT; IF ODD(MEM[Q].HH.B1)THEN A:=GOODVAL(B,PENEDGE+(CURGRAN)DIV 2)ELSE A:= GOODVAL(B-1,PENEDGE+(CURGRAN)DIV 2);END{:442}ELSE A:=B ELSE A:=B; BEFOREANDAFT(B,A,Q);END{:441};P:=Q;UNTIL P=CURSPEC; IF CURROUNDINGP>0 THEN{444:}BEGIN P:=NODETOROUND[0]; FIRSTX:=MEM[P+1].INT;FIRSTY:=MEM[P+2].INT;{446:} BEFORE[CURROUNDINGP]:=BEFORE[0]; NODETOROUND[CURROUNDINGP]:=NODETOROUND[0]; REPEAT AFTER[CURROUNDINGP]:=AFTER[0];ALLSAFE:=TRUE;NEXTA:=AFTER[0]; FOR K:=0 TO CURROUNDINGP-1 DO BEGIN A:=NEXTA;B:=BEFORE[K]; NEXTA:=AFTER[K+1];AA:=NEXTA;BB:=BEFORE[K+1]; IF(A<>B)OR(AA<>BB)THEN BEGIN P:=NODETOROUND[K];PP:=NODETOROUND[K+1]; {445:} IF AA=BB THEN BEGIN IF PP=NODETOROUND[0]THEN UNSKEW(FIRSTX,FIRSTY,MEM[PP ].HH.B1)ELSE UNSKEW(MEM[PP+1].INT,MEM[PP+2].INT,MEM[PP].HH.B1); SKEW(CURX,CURY,MEM[P].HH.B1);BB:=CURX;AA:=BB;DD:=CURY;CC:=DD; IF MEM[P].HH.B1>4 THEN BEGIN B:=-B;A:=-A;END; END ELSE BEGIN IF MEM[P].HH.B1>4 THEN BEGIN BB:=-BB;AA:=-AA;B:=-B;A:=-A; END;IF PP=NODETOROUND[0]THEN DD:=FIRSTY-BB ELSE DD:=MEM[PP+2].INT-BB; IF ODD(AA-BB)THEN IF MEM[P].HH.B1>4 THEN CC:=DD-(AA-BB+1)DIV 2 ELSE CC:= DD-(AA-BB-1)DIV 2 ELSE CC:=DD-(AA-BB)DIV 2;END;D:=MEM[P+2].INT; IF ODD(A-B)THEN IF MEM[P].HH.B1>4 THEN C:=D-(A-B-1)DIV 2 ELSE C:=D-(A-B +1)DIV 2 ELSE C:=D-(A-B)DIV 2{:445}; IF(AA2*(BB-B))OR(CC-C>2*(DD-D))THEN BEGIN ALLSAFE:= FALSE;AFTER[K]:=BEFORE[K]; IF K=CURROUNDINGP-1 THEN AFTER[0]:=BEFORE[0]ELSE AFTER[K+1]:=BEFORE[K+1] ;END;END;END;UNTIL ALLSAFE{:446}; FOR K:=0 TO CURROUNDINGP-1 DO BEGIN A:=AFTER[K];B:=BEFORE[K]; AA:=AFTER[K+1];BB:=BEFORE[K+1]; IF(A<>B)OR(AA<>BB)THEN BEGIN P:=NODETOROUND[K];PP:=NODETOROUND[K+1]; {445:} IF AA=BB THEN BEGIN IF PP=NODETOROUND[0]THEN UNSKEW(FIRSTX,FIRSTY,MEM[PP ].HH.B1)ELSE UNSKEW(MEM[PP+1].INT,MEM[PP+2].INT,MEM[PP].HH.B1); SKEW(CURX,CURY,MEM[P].HH.B1);BB:=CURX;AA:=BB;DD:=CURY;CC:=DD; IF MEM[P].HH.B1>4 THEN BEGIN B:=-B;A:=-A;END; END ELSE BEGIN IF MEM[P].HH.B1>4 THEN BEGIN BB:=-BB;AA:=-AA;B:=-B;A:=-A; END;IF PP=NODETOROUND[0]THEN DD:=FIRSTY-BB ELSE DD:=MEM[PP+2].INT-BB; IF ODD(AA-BB)THEN IF MEM[P].HH.B1>4 THEN CC:=DD-(AA-BB+1)DIV 2 ELSE CC:= DD-(AA-BB-1)DIV 2 ELSE CC:=DD-(AA-BB)DIV 2;END;D:=MEM[P+2].INT; IF ODD(A-B)THEN IF MEM[P].HH.B1>4 THEN C:=D-(A-B-1)DIV 2 ELSE C:=D-(A-B +1)DIV 2 ELSE C:=D-(A-B)DIV 2{:445}; IF B=BB THEN ALPHA:=268435456 ELSE ALPHA:=MAKEFRACTION(AA-A,BB-B); IF D=DD THEN BETA:=268435456 ELSE BETA:=MAKEFRACTION(CC-C,DD-D); REPEAT MEM[P+1].INT:=TAKEFRACTION(ALPHA,MEM[P+1].INT-B)+A; MEM[P+2].INT:=TAKEFRACTION(BETA,MEM[P+2].INT-D)+C; MEM[P+5].INT:=TAKEFRACTION(ALPHA,MEM[P+5].INT-B)+A; MEM[P+6].INT:=TAKEFRACTION(BETA,MEM[P+6].INT-D)+C;P:=MEM[P].HH.RH; MEM[P+3].INT:=TAKEFRACTION(ALPHA,MEM[P+3].INT-B)+A; MEM[P+4].INT:=TAKEFRACTION(BETA,MEM[P+4].INT-D)+C;UNTIL P=PP;END;END; END{:444};END;{:440}{451:}PROCEDURE NEWBOUNDARY(P:HALFWORD; OCTANT:SMALLNUMBER);VAR Q,R:HALFWORD;BEGIN Q:=MEM[P].HH.RH; R:=GETNODE(7);MEM[R].HH.RH:=Q;MEM[P].HH.RH:=R; MEM[R].HH.B0:=MEM[Q].HH.B0;MEM[R+3].INT:=MEM[Q+3].INT; MEM[R+4].INT:=MEM[Q+4].INT;MEM[R].HH.B1:=0;MEM[Q].HH.B0:=0; MEM[R+5].INT:=OCTANT;MEM[Q+3].INT:=MEM[Q].HH.B1; UNSKEW(MEM[Q+1].INT,MEM[Q+2].INT,MEM[Q].HH.B1);SKEW(CURX,CURY,OCTANT); MEM[R+1].INT:=CURX;MEM[R+2].INT:=CURY;END;{:451} FUNCTION MAKESPEC(H:HALFWORD;SAFETYMARGIN:SCALED; TRACING:INTEGER):HALFWORD;LABEL 22,30;VAR P,Q,R,S:HALFWORD;K:INTEGER; CHOPPED:BOOLEAN;{453:}O1,O2:SMALLNUMBER;CLOCKWISE:BOOLEAN; DX1,DY1,DX2,DY2:INTEGER;DMAX,DEL:INTEGER;{:453}BEGIN CURSPEC:=H; IF TRACING>0 THEN PRINTPATH(CURSPEC,559,TRUE); MAXALLOWED:=268402687-SAFETYMARGIN;{404:}P:=CURSPEC;K:=1;CHOPPED:=FALSE; REPEAT IF ABS(MEM[P+3].INT)>MAXALLOWED THEN BEGIN CHOPPED:=TRUE; IF MEM[P+3].INT>0 THEN MEM[P+3].INT:=MAXALLOWED ELSE MEM[P+3].INT:=- MAXALLOWED;END;IF ABS(MEM[P+4].INT)>MAXALLOWED THEN BEGIN CHOPPED:=TRUE; IF MEM[P+4].INT>0 THEN MEM[P+4].INT:=MAXALLOWED ELSE MEM[P+4].INT:=- MAXALLOWED;END;IF ABS(MEM[P+1].INT)>MAXALLOWED THEN BEGIN CHOPPED:=TRUE; IF MEM[P+1].INT>0 THEN MEM[P+1].INT:=MAXALLOWED ELSE MEM[P+1].INT:=- MAXALLOWED;END;IF ABS(MEM[P+2].INT)>MAXALLOWED THEN BEGIN CHOPPED:=TRUE; IF MEM[P+2].INT>0 THEN MEM[P+2].INT:=MAXALLOWED ELSE MEM[P+2].INT:=- MAXALLOWED;END;IF ABS(MEM[P+5].INT)>MAXALLOWED THEN BEGIN CHOPPED:=TRUE; IF MEM[P+5].INT>0 THEN MEM[P+5].INT:=MAXALLOWED ELSE MEM[P+5].INT:=- MAXALLOWED;END;IF ABS(MEM[P+6].INT)>MAXALLOWED THEN BEGIN CHOPPED:=TRUE; IF MEM[P+6].INT>0 THEN MEM[P+6].INT:=MAXALLOWED ELSE MEM[P+6].INT:=- MAXALLOWED;END;P:=MEM[P].HH.RH;MEM[P].HH.B0:=K; IF K<255 THEN K:=K+1 ELSE K:=1;UNTIL P=CURSPEC; IF CHOPPED THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(563);END; BEGIN HELPPTR:=4;HELPLINE[3]:=564;HELPLINE[2]:=565;HELPLINE[1]:=566; HELPLINE[0]:=567;END;PUTGETERROR;END{:404};QUADRANTSUBD; IF INTERNAL[36]>0 THEN XYROUND;OCTANTSUBDIV; IF INTERNAL[36]>65536 THEN DIAGROUND;{447:}P:=CURSPEC; REPEAT 22:Q:=MEM[P].HH.RH; IF P<>Q THEN BEGIN IF MEM[P+1].INT=MEM[P+5].INT THEN IF MEM[P+2].INT=MEM [P+6].INT THEN IF MEM[P+1].INT=MEM[Q+3].INT THEN IF MEM[P+2].INT=MEM[Q+4 ].INT THEN BEGIN UNSKEW(MEM[Q+1].INT,MEM[Q+2].INT,MEM[Q].HH.B1); SKEW(CURX,CURY,MEM[P].HH.B1); IF MEM[P+1].INT=CURX THEN IF MEM[P+2].INT=CURY THEN BEGIN REMOVECUBIC(P) ;IF Q<>CURSPEC THEN GOTO 22;CURSPEC:=P;Q:=P;END;END;END;P:=Q; UNTIL P=CURSPEC;{:447};{450:}TURNINGNUMBE:=0;P:=CURSPEC;Q:=MEM[P].HH.RH; REPEAT R:=MEM[Q].HH.RH;IF(MEM[P].HH.B1<>MEM[Q].HH.B1)OR(Q=R)THEN{452:} BEGIN NEWBOUNDARY(P,MEM[P].HH.B1);S:=MEM[P].HH.RH; O1:=OCTANTNUMBER[MEM[P].HH.B1];O2:=OCTANTNUMBER[MEM[Q].HH.B1]; CASE O2-O1 OF 1,-7,7,-1:GOTO 30;2,-6:CLOCKWISE:=FALSE; 3,-5,4,-4,5,-3:{454:}BEGIN{457:}DX1:=MEM[S+1].INT-MEM[S+3].INT; DY1:=MEM[S+2].INT-MEM[S+4].INT; IF DX1=0 THEN IF DY1=0 THEN BEGIN DX1:=MEM[S+1].INT-MEM[P+5].INT; DY1:=MEM[S+2].INT-MEM[P+6].INT; IF DX1=0 THEN IF DY1=0 THEN BEGIN DX1:=MEM[S+1].INT-MEM[P+1].INT; DY1:=MEM[S+2].INT-MEM[P+2].INT;END;END;DMAX:=ABS(DX1); IF ABS(DY1)>DMAX THEN DMAX:=ABS(DY1); WHILE DMAX<268435456 DO BEGIN DMAX:=DMAX+DMAX;DX1:=DX1+DX1;DY1:=DY1+DY1; END;DX2:=MEM[Q+5].INT-MEM[Q+1].INT;DY2:=MEM[Q+6].INT-MEM[Q+2].INT; IF DX2=0 THEN IF DY2=0 THEN BEGIN DX2:=MEM[R+3].INT-MEM[Q+1].INT; DY2:=MEM[R+4].INT-MEM[Q+2].INT; IF DX2=0 THEN IF DY2=0 THEN BEGIN IF MEM[R].HH.B1=0 THEN BEGIN CURX:=MEM [R+1].INT;CURY:=MEM[R+2].INT; END ELSE BEGIN UNSKEW(MEM[R+1].INT,MEM[R+2].INT,MEM[R].HH.B1); SKEW(CURX,CURY,MEM[Q].HH.B1);END;DX2:=CURX-MEM[Q+1].INT; DY2:=CURY-MEM[Q+2].INT;END;END;DMAX:=ABS(DX2); IF ABS(DY2)>DMAX THEN DMAX:=ABS(DY2); WHILE DMAX<268435456 DO BEGIN DMAX:=DMAX+DMAX;DX2:=DX2+DX2;DY2:=DY2+DY2; END{:457};UNSKEW(DX1,DY1,MEM[P].HH.B1);DEL:=PYTHADD(CURX,CURY); DX1:=MAKEFRACTION(CURX,DEL);DY1:=MAKEFRACTION(CURY,DEL); UNSKEW(DX2,DY2,MEM[Q].HH.B1);DEL:=PYTHADD(CURX,CURY); DX2:=MAKEFRACTION(CURX,DEL);DY2:=MAKEFRACTION(CURY,DEL); DEL:=TAKEFRACTION(DX1,DY2)-TAKEFRACTION(DX2,DY1); IF DEL>4684844 THEN CLOCKWISE:=FALSE ELSE IF DEL<-4684844 THEN CLOCKWISE :=TRUE ELSE CLOCKWISE:=REVTURNS;END{:454};6,-2:CLOCKWISE:=TRUE; 0:CLOCKWISE:=REVTURNS;END;{458:} WHILE TRUE DO BEGIN IF CLOCKWISE THEN IF O1=1 THEN O1:=8 ELSE O1:=O1-1 ELSE IF O1=8 THEN O1:=1 ELSE O1:=O1+1;IF O1=O2 THEN GOTO 30; NEWBOUNDARY(S,OCTANTCODE[O1]);S:=MEM[S].HH.RH; MEM[S+3].INT:=MEM[S+5].INT;END{:458}; 30:IF Q=R THEN BEGIN Q:=MEM[Q].HH.RH;R:=Q;P:=S;MEM[S].HH.RH:=Q; MEM[Q+3].INT:=MEM[Q+5].INT;MEM[Q].HH.B0:=0;FREENODE(CURSPEC,7); CURSPEC:=Q;END;{459:}P:=MEM[P].HH.RH;REPEAT S:=MEM[P].HH.RH; O1:=OCTANTNUMBER[MEM[P+5].INT];O2:=OCTANTNUMBER[MEM[S+3].INT]; IF ABS(O1-O2)=1 THEN BEGIN IF O20 DO CURSPEC:=MEM[CURSPEC].HH.RH; IF TRACING>0 THEN IF INTERNAL[36]<=0 THEN PRINTSPEC(560)ELSE IF INTERNAL [36]>65536 THEN PRINTSPEC(561)ELSE PRINTSPEC(562);MAKESPEC:=CURSPEC;END; {:402}{463:}PROCEDURE ENDROUND(X,Y:SCALED); BEGIN Y:=Y+32768-YCORR[OCTANT];X:=X+Y-XCORR[OCTANT];M1:=FLOORUNSCALE(X); N1:=FLOORUNSCALE(Y); IF X-65536*M1>=Y-65536*N1+ZCORR[OCTANT]THEN D1:=1 ELSE D1:=0;END;{:463} {465:}PROCEDURE FILLSPEC(H:HALFWORD);VAR P,Q,R,S:HALFWORD; BEGIN IF INTERNAL[10]>0 THEN BEGINEDGETRA;P:=H; REPEAT OCTANT:=MEM[P+3].INT;{466:}Q:=P; WHILE MEM[Q].HH.B1<>0 DO Q:=MEM[Q].HH.RH{:466};IF Q<>P THEN BEGIN{467:} ENDROUND(MEM[P+1].INT,MEM[P+2].INT);M0:=M1;N0:=N1;D0:=D1; ENDROUND(MEM[Q+1].INT,MEM[Q+2].INT){:467};{468:} IF N1-N0>=MOVESIZE THEN OVERFLOW(540,MOVESIZE);MOVE[0]:=D0;MOVEPTR:=0; R:=P;REPEAT S:=MEM[R].HH.RH; MAKEMOVES(MEM[R+1].INT,MEM[R+5].INT,MEM[S+3].INT,MEM[S+1].INT,MEM[R+2]. INT+32768,MEM[R+6].INT+32768,MEM[S+4].INT+32768,MEM[S+2].INT+32768, XYCORR[OCTANT],YCORR[OCTANT]);R:=S;UNTIL R=Q; MOVE[MOVEPTR]:=MOVE[MOVEPTR]-D1; IF INTERNAL[35]>0 THEN SMOOTHMOVES(0,MOVEPTR){:468}; MOVETOEDGES(M0,N0,M1,N1);END;P:=MEM[Q].HH.RH;UNTIL P=H;TOSSKNOTLIST(H); IF INTERNAL[10]>0 THEN ENDEDGETRACI;END;{:465}{476:} PROCEDURE DUPOFFSET(W:HALFWORD);VAR R:HALFWORD;BEGIN R:=GETNODE(3); MEM[R+1].INT:=MEM[W+1].INT;MEM[R+2].INT:=MEM[W+2].INT; MEM[R].HH.RH:=MEM[W].HH.RH;MEM[MEM[W].HH.RH].HH.LH:=R;MEM[R].HH.LH:=W; MEM[W].HH.RH:=R;END;{:476}{477:}FUNCTION MAKEPEN(H:HALFWORD):HALFWORD; LABEL 30,31,45,40;VAR O,OO,K:SMALLNUMBER;P:HALFWORD;Q,R,S,W,HH:HALFWORD; N:INTEGER;DX,DY:SCALED;MC:SCALED;BEGIN{479:}Q:=H;R:=MEM[Q].HH.RH; MC:=ABS(MEM[H+1].INT);IF Q=R THEN BEGIN HH:=H;MEM[H].HH.B1:=0; IF MC0 THEN OCTANT:=1 ELSE IF DX=0 THEN IF DY>0 THEN OCTANT:=1 ELSE OCTANT:=2 ELSE BEGIN DX:=-DX;OCTANT:=2;END;IF DY<0 THEN BEGIN DY:=-DY; OCTANT:=OCTANT+2;END ELSE IF DY=0 THEN IF OCTANT>1 THEN OCTANT:=4; IF DXOO THEN BEGIN IF HH<>0 THEN GOTO 45;HH:=Q; END;O:=OO;IF(Q=H)AND(HH<>0)THEN GOTO 30;Q:=R;R:=S;END;30:END{:479}; IF MC>=268402688 THEN GOTO 45;P:=GETNODE(10);Q:=HH;MEM[P+9].INT:=MC; MEM[P].HH.LH:=0;IF MEM[Q].HH.RH<>Q THEN MEM[P].HH.RH:=1; FOR K:=1 TO 8 DO{481:}BEGIN OCTANT:=OCTANTCODE[K];N:=0;H:=P+OCTANT; WHILE TRUE DO BEGIN R:=GETNODE(3); SKEW(MEM[Q+1].INT,MEM[Q+2].INT,OCTANT);MEM[R+1].INT:=CURX; MEM[R+2].INT:=CURY;IF N=0 THEN MEM[H].HH.RH:=R ELSE{482:} IF ODD(K)THEN BEGIN MEM[W].HH.RH:=R;MEM[R].HH.LH:=W; END ELSE BEGIN MEM[W].HH.LH:=R;MEM[R].HH.RH:=W;END{:482};W:=R; IF MEM[Q].HH.B1<>OCTANT THEN GOTO 31;Q:=MEM[Q].HH.RH;N:=N+1;END; 31:{483:}R:=MEM[H].HH.RH;IF ODD(K)THEN BEGIN MEM[W].HH.RH:=R; MEM[R].HH.LH:=W;END ELSE BEGIN MEM[W].HH.LH:=R;MEM[R].HH.RH:=W; MEM[H].HH.RH:=W;R:=W;END; IF(MEM[R+2].INT<>MEM[MEM[R].HH.RH+2].INT)OR(N=0)THEN BEGIN DUPOFFSET(R); N:=N+1;END;R:=MEM[R].HH.LH; IF MEM[R+1].INT<>MEM[MEM[R].HH.LH+1].INT THEN DUPOFFSET(R)ELSE N:=N-1{: 483};IF N>=255 THEN OVERFLOW(579,255);MEM[H].HH.LH:=N;END{:481};GOTO 40; 45:P:=3;{478:} IF MC>=268402688 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(573);END; BEGIN HELPPTR:=2;HELPLINE[1]:=574;HELPLINE[0]:=575;END; END ELSE BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(576);END;BEGIN HELPPTR:=3; HELPLINE[2]:=577;HELPLINE[1]:=578;HELPLINE[0]:=575;END;END; PUTGETERROR{:478};40:IF INTERNAL[6]>0 THEN PRINTPEN(P,572,TRUE); MAKEPEN:=P;END;{:477}{484:}{486:} FUNCTION TRIVIALKNOT(X,Y:SCALED):HALFWORD;VAR P:HALFWORD; BEGIN P:=GETNODE(7);MEM[P].HH.B0:=1;MEM[P].HH.B1:=1;MEM[P+1].INT:=X; MEM[P+3].INT:=X;MEM[P+5].INT:=X;MEM[P+2].INT:=Y;MEM[P+4].INT:=Y; MEM[P+6].INT:=Y;TRIVIALKNOT:=P;END;{:486} FUNCTION MAKEPATH(PENHEAD:HALFWORD):HALFWORD;VAR P:HALFWORD;K:1..8; H:HALFWORD;M,N:INTEGER;W,WW:HALFWORD;BEGIN P:=65533; FOR K:=1 TO 8 DO BEGIN OCTANT:=OCTANTCODE[K];H:=PENHEAD+OCTANT; N:=MEM[H].HH.LH;W:=MEM[H].HH.RH;IF NOT ODD(K)THEN W:=MEM[W].HH.LH; FOR M:=1 TO N+1 DO BEGIN IF ODD(K)THEN WW:=MEM[W].HH.RH ELSE WW:=MEM[W]. HH.LH; IF(MEM[WW+1].INT<>MEM[W+1].INT)OR(MEM[WW+2].INT<>MEM[W+2].INT)THEN{485:} BEGIN UNSKEW(MEM[WW+1].INT,MEM[WW+2].INT,OCTANT); MEM[P].HH.RH:=TRIVIALKNOT(CURX,CURY);P:=MEM[P].HH.RH;END{:485};W:=WW; END;END;IF P=65533 THEN BEGIN W:=MEM[PENHEAD+1].HH.RH; P:=TRIVIALKNOT(MEM[W+1].INT+MEM[W+2].INT,MEM[W+2].INT); MEM[65533].HH.RH:=P;END;MEM[P].HH.RH:=MEM[65533].HH.RH; MAKEPATH:=MEM[65533].HH.RH;END;{:484}{488:} PROCEDURE FINDOFFSET(X,Y:SCALED;P:HALFWORD);LABEL 30,10;VAR OCTANT:1..8; S:-1..+1;N:INTEGER;H,W,WW:HALFWORD;BEGIN{489:} IF X>0 THEN OCTANT:=1 ELSE IF X=0 THEN IF Y<=0 THEN IF Y=0 THEN BEGIN CURX:=0;CURY:=0;GOTO 10; END ELSE OCTANT:=2 ELSE OCTANT:=1 ELSE BEGIN X:=-X; IF Y=0 THEN OCTANT:=4 ELSE OCTANT:=2;END; IF Y<0 THEN BEGIN OCTANT:=OCTANT+2;Y:=-Y;END; IF X>=Y THEN X:=X-Y ELSE BEGIN OCTANT:=OCTANT+4;X:=Y-X;Y:=Y-X;END{:489}; IF ODD(OCTANTNUMBER[OCTANT])THEN S:=-1 ELSE S:=+1;H:=P+OCTANT; W:=MEM[MEM[H].HH.RH].HH.RH;WW:=MEM[W].HH.RH;N:=MEM[H].HH.LH; WHILE N>1 DO BEGIN IF ABVSCD(X,MEM[WW+2].INT-MEM[W+2].INT,Y,MEM[WW+1]. INT-MEM[W+1].INT)<>S THEN GOTO 30;W:=WW;WW:=MEM[W].HH.RH;N:=N-1;END; 30:UNSKEW(MEM[W+1].INT,MEM[W+2].INT,OCTANT);10:END;{:488}{491:}{493:} PROCEDURE SPLITFOROFFS(P:HALFWORD;T:FRACTION);VAR Q:HALFWORD;R:HALFWORD; BEGIN Q:=MEM[P].HH.RH;SPLITCUBIC(P,T,MEM[Q+1].INT,MEM[Q+2].INT); R:=MEM[P].HH.RH; IF MEM[R+2].INTMEM[Q+2].INT THEN MEM[R+2].INT:=MEM[Q+2].INT; IF MEM[R+1].INTMEM[Q+1].INT THEN MEM[R+1].INT:=MEM[Q+1].INT;END;{:493}{497:} PROCEDURE FINOFFSETPRE(P:HALFWORD;K:HALFWORD;W:HALFWORD; X0,X1,X2,Y0,Y1,Y2:INTEGER;RISING:BOOLEAN;N:INTEGER);LABEL 10; VAR WW:HALFWORD;DU,DV:SCALED;T0,T1,T2:INTEGER;T:FRACTION;S:FRACTION; V:INTEGER;BEGIN WHILE TRUE DO BEGIN MEM[P].HH.B1:=K; IF RISING THEN IF K=N THEN GOTO 10 ELSE WW:=MEM[W].HH.RH ELSE IF K=1 THEN GOTO 10 ELSE WW:=MEM[W].HH.LH;{498:}DU:=MEM[WW+1].INT-MEM[W+1].INT; DV:=MEM[WW+2].INT-MEM[W+2].INT; IF ABS(DU)>=ABS(DV)THEN BEGIN S:=MAKEFRACTION(DV,DU); T0:=TAKEFRACTION(X0,S)-Y0;T1:=TAKEFRACTION(X1,S)-Y1; T2:=TAKEFRACTION(X2,S)-Y2;END ELSE BEGIN S:=MAKEFRACTION(DU,DV); T0:=X0-TAKEFRACTION(Y0,S);T1:=X1-TAKEFRACTION(Y1,S); T2:=X2-TAKEFRACTION(Y2,S);END{:498};T:=CROSSINGPOIN(T0,T1,T2); IF T>=268435456 THEN GOTO 10;{499:}BEGIN SPLITFOROFFS(P,T); MEM[P].HH.B1:=K;P:=MEM[P].HH.RH;V:=X0-TAKEFRACTION(X0-X1,T); X1:=X1-TAKEFRACTION(X1-X2,T);X0:=V-TAKEFRACTION(V-X1,T); V:=Y0-TAKEFRACTION(Y0-Y1,T);Y1:=Y1-TAKEFRACTION(Y1-Y2,T); Y0:=V-TAKEFRACTION(V-Y1,T);T1:=T1-TAKEFRACTION(T1-T2,T); IF T1>0 THEN T1:=0;T:=CROSSINGPOIN(0,-T1,-T2); IF T<268435456 THEN BEGIN SPLITFOROFFS(P,T);MEM[MEM[P].HH.RH].HH.B1:=K; V:=X1-TAKEFRACTION(X1-X2,T);X1:=X0-TAKEFRACTION(X0-X1,T); X2:=X1-TAKEFRACTION(X1-V,T);V:=Y1-TAKEFRACTION(Y1-Y2,T); Y1:=Y0-TAKEFRACTION(Y0-Y1,T);Y2:=Y1-TAKEFRACTION(Y1-V,T);END;END{:499}; IF RISING THEN K:=K+1 ELSE K:=K-1;W:=WW;END;10:END;{:497} PROCEDURE OFFSETPREP(C,H:HALFWORD);LABEL 30,45;VAR N:HALFWORD; P,Q,R,LH,WW:HALFWORD;K:HALFWORD;W:HALFWORD;{495:} X0,X1,X2,Y0,Y1,Y2:INTEGER;T0,T1,T2:INTEGER;DU,DV,DX,DY:INTEGER; MAXCOEF:INTEGER;X0A,X1A,X2A,Y0A,Y1A,Y2A:INTEGER;T:FRACTION;S:FRACTION; {:495}BEGIN P:=C;N:=MEM[H].HH.LH;LH:=MEM[H].HH.RH; WHILE MEM[P].HH.B1<>0 DO BEGIN Q:=MEM[P].HH.RH;{494:} IF N<=1 THEN MEM[P].HH.B1:=1 ELSE BEGIN{496:} X0:=MEM[P+5].INT-MEM[P+1].INT;X2:=MEM[Q+1].INT-MEM[Q+3].INT; X1:=MEM[Q+3].INT-MEM[P+5].INT;Y0:=MEM[P+6].INT-MEM[P+2].INT; Y2:=MEM[Q+2].INT-MEM[Q+4].INT;Y1:=MEM[Q+4].INT-MEM[P+6].INT; MAXCOEF:=ABS(X0);IF ABS(X1)>MAXCOEF THEN MAXCOEF:=ABS(X1); IF ABS(X2)>MAXCOEF THEN MAXCOEF:=ABS(X2); IF ABS(Y0)>MAXCOEF THEN MAXCOEF:=ABS(Y0); IF ABS(Y1)>MAXCOEF THEN MAXCOEF:=ABS(Y1); IF ABS(Y2)>MAXCOEF THEN MAXCOEF:=ABS(Y2);IF MAXCOEF=0 THEN GOTO 45; WHILE MAXCOEF<134217728 DO BEGIN MAXCOEF:=MAXCOEF+MAXCOEF;X0:=X0+X0; X1:=X1+X1;X2:=X2+X2;Y0:=Y0+Y0;Y1:=Y1+Y1;Y2:=Y2+Y2;END{:496};{501:} DX:=X0;DY:=Y0;IF DX=0 THEN IF DY=0 THEN BEGIN DX:=X1;DY:=Y1; IF DX=0 THEN IF DY=0 THEN BEGIN DX:=X2;DY:=Y2;END;END{:501}; IF DX=0 THEN{505:} FINOFFSETPRE(P,N,MEM[MEM[LH].HH.LH].HH.LH,-X0,-X1,-X2,-Y0,-Y1,-Y2,FALSE, N){:505}ELSE BEGIN{502:}K:=1;W:=MEM[LH].HH.RH; WHILE TRUE DO BEGIN IF K=N THEN GOTO 30;WW:=MEM[W].HH.RH; IF ABVSCD(DY,ABS(MEM[WW+1].INT-MEM[W+1].INT),DX,ABS(MEM[WW+2].INT-MEM[W +2].INT))>=0 THEN BEGIN K:=K+1;W:=WW;END ELSE GOTO 30;END;30:{:502}; {503:}IF K=1 THEN T:=268435457 ELSE BEGIN WW:=MEM[W].HH.LH;{498:} DU:=MEM[WW+1].INT-MEM[W+1].INT;DV:=MEM[WW+2].INT-MEM[W+2].INT; IF ABS(DU)>=ABS(DV)THEN BEGIN S:=MAKEFRACTION(DV,DU); T0:=TAKEFRACTION(X0,S)-Y0;T1:=TAKEFRACTION(X1,S)-Y1; T2:=TAKEFRACTION(X2,S)-Y2;END ELSE BEGIN S:=MAKEFRACTION(DU,DV); T0:=X0-TAKEFRACTION(Y0,S);T1:=X1-TAKEFRACTION(Y1,S); T2:=X2-TAKEFRACTION(Y2,S);END{:498};T:=CROSSINGPOIN(-T0,-T1,-T2);END; IF T>=268435456 THEN FINOFFSETPRE(P,K,W,X0,X1,X2,Y0,Y1,Y2,TRUE,N)ELSE BEGIN SPLITFOROFFS(P,T);R:=MEM[P].HH.RH;X1A:=X0-TAKEFRACTION(X0-X1,T); X1:=X1-TAKEFRACTION(X1-X2,T);X2A:=X1A-TAKEFRACTION(X1A-X1,T); Y1A:=Y0-TAKEFRACTION(Y0-Y1,T);Y1:=Y1-TAKEFRACTION(Y1-Y2,T); Y2A:=Y1A-TAKEFRACTION(Y1A-Y1,T); FINOFFSETPRE(P,K,W,X0,X1A,X2A,Y0,Y1A,Y2A,TRUE,N);X0:=X2A;Y0:=Y2A; T1:=T1-TAKEFRACTION(T1-T2,T);IF T1<0 THEN T1:=0; T:=CROSSINGPOIN(0,T1,T2);IF T<268435456 THEN{504:} BEGIN SPLITFOROFFS(R,T);X1A:=X1-TAKEFRACTION(X1-X2,T); X1:=X0-TAKEFRACTION(X0-X1,T);X0A:=X1-TAKEFRACTION(X1-X1A,T); Y1A:=Y1-TAKEFRACTION(Y1-Y2,T);Y1:=Y0-TAKEFRACTION(Y0-Y1,T); Y0A:=Y1-TAKEFRACTION(Y1-Y1A,T); FINOFFSETPRE(MEM[R].HH.RH,K,W,X0A,X1A,X2,Y0A,Y1A,Y2,TRUE,N);X2:=X0A; Y2:=Y0A;END{:504}; FINOFFSETPRE(R,K-1,WW,-X0,-X1,-X2,-Y0,-Y1,-Y2,FALSE,N);END{:503};END; 45:END{:494};{492:}REPEAT R:=MEM[P].HH.RH; IF MEM[P+1].INT=MEM[P+5].INT THEN IF MEM[P+2].INT=MEM[P+6].INT THEN IF MEM[P+1].INT=MEM[R+3].INT THEN IF MEM[P+2].INT=MEM[R+4].INT THEN IF MEM[ P+1].INT=MEM[R+1].INT THEN IF MEM[P+2].INT=MEM[R+2].INT THEN BEGIN REMOVECUBIC(P);IF R=Q THEN Q:=P;R:=P;END;P:=R;UNTIL P=Q{:492};END;END; {:491}{506:}{510:}PROCEDURE SKEWLINEEDGE(P,W,WW:HALFWORD); VAR X0,Y0,X1,Y1:SCALED; BEGIN IF(MEM[W+1].INT<>MEM[WW+1].INT)OR(MEM[W+2].INT<>MEM[WW+2].INT)THEN BEGIN X0:=MEM[P+1].INT+MEM[W+1].INT;Y0:=MEM[P+2].INT+MEM[W+2].INT; X1:=MEM[P+1].INT+MEM[WW+1].INT;Y1:=MEM[P+2].INT+MEM[WW+2].INT; UNSKEW(X0,Y0,OCTANT);X0:=CURX;Y0:=CURY;UNSKEW(X1,Y1,OCTANT); IF INTERNAL[10]>65536 THEN BEGIN PRINTNL(584);PRINTTWO(X0,Y0); PRINT(583);PRINTTWO(CURX,CURY);PRINTNL(285);END; LINEEDGES(X0,Y0,CURX,CURY);END;END;{:510}{518:} PROCEDURE DUALMOVES(H,P,Q:HALFWORD);LABEL 30,31;VAR R,S:HALFWORD;{511:} M,N:INTEGER;MM0,MM1:INTEGER;K:INTEGER;W,WW:HALFWORD; SMOOTHBOT,SMOOTHTOP:0..MOVESIZE;XX,YY,XP,YP,DELX,DELY,TX,TY:SCALED; {:511}BEGIN{519:}K:=MEM[H].HH.LH+1;WW:=MEM[H].HH.RH;W:=MEM[WW].HH.LH; MM0:=FLOORUNSCALE(MEM[P+1].INT+MEM[W+1].INT-XYCORR[OCTANT]); MM1:=FLOORUNSCALE(MEM[Q+1].INT+MEM[WW+1].INT-XYCORR[OCTANT]); FOR N:=1 TO N1-N0+1 DO ENVMOVE[N]:=MM1;ENVMOVE[0]:=MM0;MOVEPTR:=0; M:=MM0{:519};R:=P;WHILE TRUE DO BEGIN IF R=Q THEN SMOOTHTOP:=MOVEPTR; WHILE MEM[R].HH.B1<>K DO{521:}BEGIN XX:=MEM[R+1].INT+MEM[W+1].INT; YY:=MEM[R+2].INT+MEM[W+2].INT+32768; IF INTERNAL[10]>65536 THEN BEGIN PRINTNL(585);PRINTINT(K);PRINT(586); UNSKEW(XX,YY-32768,OCTANT);PRINTTWO(CURX,CURY);END; IF MEM[R].HH.B1YY THEN{522:}BEGIN TY:=FLOORSCALED(YY-YCORR[OCTANT]);DELY:=YP-YY; YY:=YY-TY;TY:=YP-YCORR[OCTANT]-TY;IF TY>=65536 THEN BEGIN DELX:=XP-XX; YY:=65536-YY; WHILE TRUE DO BEGIN IF M0 THEN TX:=TX-1; M:=FLOORUNSCALE(XX+TX);TY:=TY-65536;MOVEPTR:=MOVEPTR+1; IF TY<65536 THEN GOTO 31;YY:=YY+65536;END; 31:IF M65536 THEN BEGIN PRINT(583);UNSKEW(XP,YP-32768,OCTANT); PRINTTWO(CURX,CURY);PRINTNL(285);END;M:=FLOORUNSCALE(XP-XYCORR[OCTANT]); MOVEPTR:=FLOORUNSCALE(YP-YCORR[OCTANT])-N0; IF MMOVEPTR{:520};R:=S;END;30:{523:} {IF(M<>MM1)OR(MOVEPTR<>N1-N0)THEN CONFUSION(50);} MOVE[0]:=D0+ENVMOVE[1]-MM0; FOR N:=1 TO MOVEPTR DO MOVE[N]:=ENVMOVE[N+1]-ENVMOVE[N]+1; MOVE[MOVEPTR]:=MOVE[MOVEPTR]-D1; IF INTERNAL[35]>0 THEN SMOOTHMOVES(SMOOTHBOT,SMOOTHTOP); MOVETOEDGES(M0,N0,M1,N1);IF MEM[Q+6].INT=1 THEN BEGIN W:=MEM[H].HH.RH; SKEWLINEEDGE(Q,W,MEM[W].HH.LH);END{:523};END;{:518} PROCEDURE FILLENVELOPE(SPECHEAD:HALFWORD);LABEL 30,31; VAR P,Q,R,S:HALFWORD;H:HALFWORD;WWW:HALFWORD;{511:}M,N:INTEGER; MM0,MM1:INTEGER;K:INTEGER;W,WW:HALFWORD;SMOOTHBOT,SMOOTHTOP:0..MOVESIZE; XX,YY,XP,YP,DELX,DELY,TX,TY:SCALED;{:511} BEGIN IF INTERNAL[10]>0 THEN BEGINEDGETRA;P:=SPECHEAD; REPEAT OCTANT:=MEM[P+3].INT;H:=CURPEN+OCTANT;{466:}Q:=P; WHILE MEM[Q].HH.B1<>0 DO Q:=MEM[Q].HH.RH{:466};{508:}W:=MEM[H].HH.RH; IF MEM[P+4].INT=1 THEN W:=MEM[W].HH.LH;IF INTERNAL[10]>65536 THEN{509:} BEGIN PRINTNL(580);PRINT(OCTANTDIR[OCTANT]);PRINT(558); PRINTINT(MEM[H].HH.LH);PRINT(581); IF MEM[H].HH.LH<>1 THEN PRINTCHAR(115);PRINT(582); UNSKEW(MEM[P+1].INT+MEM[W+1].INT,MEM[P+2].INT+MEM[W+2].INT,OCTANT); PRINTTWO(CURX,CURY);WW:=MEM[H].HH.RH; IF MEM[Q+6].INT=1 THEN WW:=MEM[WW].HH.LH;PRINT(583); UNSKEW(MEM[Q+1].INT+MEM[WW+1].INT,MEM[Q+2].INT+MEM[WW+2].INT,OCTANT); PRINTTWO(CURX,CURY);END{:509};WW:=MEM[H].HH.RH;WWW:=WW; IF ODD(OCTANTNUMBER[OCTANT])THEN WWW:=MEM[WWW].HH.LH ELSE WW:=MEM[WW].HH .LH;IF W<>WW THEN SKEWLINEEDGE(P,W,WW); ENDROUND(MEM[P+1].INT+MEM[WW+1].INT,MEM[P+2].INT+MEM[WW+2].INT);M0:=M1; N0:=N1;D0:=D1; ENDROUND(MEM[Q+1].INT+MEM[WWW+1].INT,MEM[Q+2].INT+MEM[WWW+2].INT); IF N1-N0>=MOVESIZE THEN OVERFLOW(540,MOVESIZE){:508};OFFSETPREP(P,H); {466:}Q:=P;WHILE MEM[Q].HH.B1<>0 DO Q:=MEM[Q].HH.RH{:466};{512:} IF ODD(OCTANTNUMBER[OCTANT])THEN BEGIN{513:}K:=0;W:=MEM[H].HH.RH; WW:=MEM[W].HH.LH; MM0:=FLOORUNSCALE(MEM[P+1].INT+MEM[W+1].INT-XYCORR[OCTANT]); MM1:=FLOORUNSCALE(MEM[Q+1].INT+MEM[WW+1].INT-XYCORR[OCTANT]); FOR N:=0 TO N1-N0 DO ENVMOVE[N]:=MM0;ENVMOVE[N1-N0]:=MM1;MOVEPTR:=0; M:=MM0{:513};R:=P;MEM[Q].HH.B1:=MEM[H].HH.LH+1; WHILE TRUE DO BEGIN IF R=Q THEN SMOOTHTOP:=MOVEPTR; WHILE MEM[R].HH.B1<>K DO{515:}BEGIN XX:=MEM[R+1].INT+MEM[W+1].INT; YY:=MEM[R+2].INT+MEM[W+2].INT+32768; IF INTERNAL[10]>65536 THEN BEGIN PRINTNL(585);PRINTINT(K);PRINT(586); UNSKEW(XX,YY-32768,OCTANT);PRINTTWO(CURX,CURY);END; IF MEM[R].HH.B1>K THEN BEGIN K:=K+1;W:=MEM[W].HH.RH; XP:=MEM[R+1].INT+MEM[W+1].INT;YP:=MEM[R+2].INT+MEM[W+2].INT+32768; IF YP<>YY THEN{516:}BEGIN TY:=FLOORSCALED(YY-YCORR[OCTANT]);DELY:=YP-YY; YY:=YY-TY;TY:=YP-YCORR[OCTANT]-TY;IF TY>=65536 THEN BEGIN DELX:=XP-XX; YY:=65536-YY; WHILE TRUE DO BEGIN TX:=TAKEFRACTION(DELX,MAKEFRACTION(YY,DELY)); IF ABVSCD(TX,DELY,DELX,YY)+XYCORR[OCTANT]>0 THEN TX:=TX-1; M:=FLOORUNSCALE(XX+TX);IF M>ENVMOVE[MOVEPTR]THEN ENVMOVE[MOVEPTR]:=M; TY:=TY-65536;IF TY<65536 THEN GOTO 31;YY:=YY+65536;MOVEPTR:=MOVEPTR+1; END;31:END;END{:516};END ELSE BEGIN K:=K-1;W:=MEM[W].HH.LH; XP:=MEM[R+1].INT+MEM[W+1].INT;YP:=MEM[R+2].INT+MEM[W+2].INT+32768;END; IF INTERNAL[10]>65536 THEN BEGIN PRINT(583);UNSKEW(XP,YP-32768,OCTANT); PRINTTWO(CURX,CURY);PRINTNL(285);END;M:=FLOORUNSCALE(XP-XYCORR[OCTANT]); MOVEPTR:=FLOORUNSCALE(YP-YCORR[OCTANT])-N0; IF M>ENVMOVE[MOVEPTR]THEN ENVMOVE[MOVEPTR]:=M;END{:515}; IF R=P THEN SMOOTHBOT:=MOVEPTR;IF R=Q THEN GOTO 30;MOVE[MOVEPTR]:=1; N:=MOVEPTR;S:=MEM[R].HH.RH; MAKEMOVES(MEM[R+1].INT+MEM[W+1].INT,MEM[R+5].INT+MEM[W+1].INT,MEM[S+3]. INT+MEM[W+1].INT,MEM[S+1].INT+MEM[W+1].INT,MEM[R+2].INT+MEM[W+2].INT +32768,MEM[R+6].INT+MEM[W+2].INT+32768,MEM[S+4].INT+MEM[W+2].INT+32768, MEM[S+2].INT+MEM[W+2].INT+32768,XYCORR[OCTANT],YCORR[OCTANT]);{514:} REPEAT M:=M+MOVE[N]-1;IF M>ENVMOVE[N]THEN ENVMOVE[N]:=M;N:=N+1; UNTIL N>MOVEPTR{:514};R:=S;END;30:{517:} {IF(M<>MM1)OR(MOVEPTR<>N1-N0)THEN CONFUSION(49);} MOVE[0]:=D0+ENVMOVE[0]-MM0; FOR N:=1 TO MOVEPTR DO MOVE[N]:=ENVMOVE[N]-ENVMOVE[N-1]+1; MOVE[MOVEPTR]:=MOVE[MOVEPTR]-D1; IF INTERNAL[35]>0 THEN SMOOTHMOVES(SMOOTHBOT,SMOOTHTOP); MOVETOEDGES(M0,N0,M1,N1);IF MEM[Q+6].INT=0 THEN BEGIN W:=MEM[H].HH.RH; SKEWLINEEDGE(Q,MEM[W].HH.LH,W);END{:517};END ELSE DUALMOVES(H,P,Q); MEM[Q].HH.B1:=0{:512};P:=MEM[Q].HH.RH;UNTIL P=SPECHEAD; IF INTERNAL[10]>0 THEN ENDEDGETRACI;TOSSKNOTLIST(SPECHEAD);END;{:506} {527:}FUNCTION MAKEELLIPSE(MAJORAXIS,MINORAXIS:SCALED; THETA:ANGLE):HALFWORD;LABEL 30,31,40;VAR P,Q,R,S:HALFWORD;H:HALFWORD; ALPHA,BETA,GAMMA,DELTA:INTEGER;C,D:INTEGER;U,V:INTEGER; SYMMETRIC:BOOLEAN;BEGIN{528:}{530:} IF(MAJORAXIS=MINORAXIS)OR(THETA MOD 94371840=0)THEN BEGIN SYMMETRIC:= TRUE;ALPHA:=0;IF ODD(THETA DIV 94371840)THEN BEGIN BETA:=MAJORAXIS; GAMMA:=MINORAXIS;NSIN:=268435456;NCOS:=0;END ELSE BEGIN BETA:=MINORAXIS; GAMMA:=MAJORAXIS;END;END ELSE BEGIN SYMMETRIC:=FALSE;NSINCOS(THETA); GAMMA:=TAKEFRACTION(MAJORAXIS,NSIN);DELTA:=TAKEFRACTION(MINORAXIS,NCOS); BETA:=PYTHADD(GAMMA,DELTA); ALPHA:=TAKEFRACTION(TAKEFRACTION(MAJORAXIS,MAKEFRACTION(GAMMA,BETA)), NCOS)-TAKEFRACTION(TAKEFRACTION(MINORAXIS,MAKEFRACTION(DELTA,BETA)),NSIN );ALPHA:=(ALPHA+32768)DIV 65536; GAMMA:=PYTHADD(TAKEFRACTION(MAJORAXIS,NCOS),TAKEFRACTION(MINORAXIS,NSIN) );END;BETA:=(BETA+32768)DIV 65536;GAMMA:=(GAMMA+32768)DIV 65536{:530}; P:=GETNODE(7);Q:=GETNODE(7);R:=GETNODE(7); IF SYMMETRIC THEN S:=0 ELSE S:=GETNODE(7);H:=P;MEM[P].HH.RH:=Q; MEM[Q].HH.RH:=R;MEM[R].HH.RH:=S;{529:}IF BETA=0 THEN BETA:=1; IF GAMMA=0 THEN GAMMA:=1; IF GAMMA<=ABS(ALPHA)THEN IF ALPHA>0 THEN ALPHA:=GAMMA-1 ELSE ALPHA:=1- GAMMA{:529};MEM[P+1].INT:=-ALPHA*32768;MEM[P+2].INT:=-BETA*32768; MEM[Q+1].INT:=GAMMA*32768;MEM[Q+2].INT:=MEM[P+2].INT; MEM[R+1].INT:=MEM[Q+1].INT;MEM[P+5].INT:=0;MEM[Q+3].INT:=-32768; MEM[Q+5].INT:=32768;MEM[R+3].INT:=0;MEM[R+5].INT:=0;MEM[P+6].INT:=BETA; MEM[Q+6].INT:=GAMMA;MEM[R+6].INT:=BETA;MEM[Q+4].INT:=GAMMA+ALPHA; IF SYMMETRIC THEN BEGIN MEM[R+2].INT:=0;MEM[R+4].INT:=BETA; END ELSE BEGIN MEM[R+2].INT:=-MEM[P+2].INT;MEM[R+4].INT:=BETA+BETA; MEM[S+1].INT:=-MEM[P+1].INT;MEM[S+2].INT:=MEM[R+2].INT; MEM[S+3].INT:=32768;MEM[S+4].INT:=GAMMA-ALPHA;END{:528};{531:} WHILE TRUE DO BEGIN U:=MEM[P+5].INT+MEM[Q+5].INT; V:=MEM[Q+3].INT+MEM[R+3].INT;C:=MEM[P+6].INT+MEM[Q+6].INT;{533:} DELTA:=PYTHADD(U,V); IF MAJORAXIS=MINORAXIS THEN D:=MAJORAXIS ELSE BEGIN IF THETA=0 THEN BEGIN ALPHA:=U;BETA:=V; END ELSE BEGIN ALPHA:=TAKEFRACTION(U,NCOS)+TAKEFRACTION(V,NSIN); BETA:=TAKEFRACTION(V,NCOS)-TAKEFRACTION(U,NSIN);END; ALPHA:=MAKEFRACTION(ALPHA,DELTA);BETA:=MAKEFRACTION(BETA,DELTA); D:=PYTHADD(TAKEFRACTION(MAJORAXIS,ALPHA),TAKEFRACTION(MINORAXIS,BETA)); END;ALPHA:=ABS(U);BETA:=ABS(V);IF ALPHA0 THEN D:=D-TAKEFRACTION(INTERNAL[38],MAKEFRACTION(BETA +BETA,DELTA));D:=TAKEFRACTION((D+4)DIV 8,DELTA);ALPHA:=ALPHA DIV 32768; IF D0 THEN BEGIN IF DELTA>MEM[R+4].INT THEN DELTA:=MEM[R+4].INT; IF DELTA>=MEM[Q+4].INT THEN{534:}BEGIN DELTA:=MEM[Q+4].INT; MEM[P+6].INT:=C-DELTA;MEM[P+5].INT:=U;MEM[Q+3].INT:=V; MEM[Q+1].INT:=MEM[Q+1].INT-DELTA*MEM[R+3].INT; MEM[Q+2].INT:=MEM[Q+2].INT+DELTA*MEM[Q+5].INT; MEM[R+4].INT:=MEM[R+4].INT-DELTA;END{:534}ELSE{535:}BEGIN S:=GETNODE(7); MEM[P].HH.RH:=S;MEM[S].HH.RH:=Q; MEM[S+1].INT:=MEM[Q+1].INT+DELTA*MEM[Q+3].INT; MEM[S+2].INT:=MEM[Q+2].INT-DELTA*MEM[P+5].INT; MEM[Q+1].INT:=MEM[Q+1].INT-DELTA*MEM[R+3].INT; MEM[Q+2].INT:=MEM[Q+2].INT+DELTA*MEM[Q+5].INT; MEM[S+3].INT:=MEM[Q+3].INT;MEM[S+5].INT:=U;MEM[Q+3].INT:=V; MEM[S+6].INT:=C-DELTA;MEM[S+4].INT:=MEM[Q+4].INT-DELTA; MEM[Q+4].INT:=DELTA;MEM[R+4].INT:=MEM[R+4].INT-DELTA;END{:535}; END ELSE P:=Q;{532:}WHILE TRUE DO BEGIN Q:=MEM[P].HH.RH; IF Q=0 THEN GOTO 30; IF MEM[Q+4].INT=0 THEN BEGIN MEM[P].HH.RH:=MEM[Q].HH.RH; MEM[P+6].INT:=MEM[Q+6].INT;MEM[P+5].INT:=MEM[Q+5].INT;FREENODE(Q,7); END ELSE BEGIN R:=MEM[Q].HH.RH;IF R=0 THEN GOTO 30; IF MEM[R+4].INT=0 THEN BEGIN MEM[P].HH.RH:=R;FREENODE(Q,7);P:=R; END ELSE GOTO 40;END;END;40:{:532};END;30:{:531};IF SYMMETRIC THEN{536:} BEGIN S:=0;Q:=H;WHILE TRUE DO BEGIN R:=GETNODE(7);MEM[R].HH.RH:=S;S:=R; MEM[S+1].INT:=MEM[Q+1].INT;MEM[S+2].INT:=-MEM[Q+2].INT; IF Q=P THEN GOTO 31;Q:=MEM[Q].HH.RH;IF MEM[Q+2].INT=0 THEN GOTO 31;END; 31:MEM[P].HH.RH:=S;BETA:=-MEM[H+2].INT; WHILE MEM[P+2].INT<>BETA DO P:=MEM[P].HH.RH;Q:=MEM[P].HH.RH;END{:536}; {537:}IF Q<>0 THEN BEGIN IF MEM[H+5].INT=0 THEN BEGIN P:=H; H:=MEM[H].HH.RH;FREENODE(P,7);MEM[Q+1].INT:=-MEM[H+1].INT;END;P:=Q; END ELSE Q:=P;R:=MEM[H].HH.RH;REPEAT S:=GETNODE(7);MEM[P].HH.RH:=S;P:=S; MEM[P+1].INT:=-MEM[R+1].INT;MEM[P+2].INT:=-MEM[R+2].INT;R:=MEM[R].HH.RH; UNTIL R=Q;MEM[P].HH.RH:=H{:537};MAKEELLIPSE:=H;END;{:527}{539:} FUNCTION FINDDIRECTIO(X,Y:SCALED;H:HALFWORD):SCALED;LABEL 10,40,45,30; VAR MAX:SCALED;P,Q:HALFWORD;N:SCALED;TT:SCALED;{542:} X1,X2,X3,Y1,Y2,Y3:SCALED;THETA,PHI:ANGLE;T:FRACTION;{:542}BEGIN{540:} IF ABS(X)0 THEN Y:=268435456 ELSE Y:=-268435456; END ELSE IF X=0 THEN BEGIN FINDDIRECTIO:=0;GOTO 10; END ELSE BEGIN Y:=MAKEFRACTION(Y,ABS(X)); IF X>0 THEN X:=268435456 ELSE X:=-268435456;END{:540};N:=0;P:=H; WHILE TRUE DO BEGIN IF MEM[P].HH.B1=0 THEN GOTO 45;Q:=MEM[P].HH.RH; {541:}TT:=0;{543:}X1:=MEM[P+5].INT-MEM[P+1].INT; X2:=MEM[Q+3].INT-MEM[P+5].INT;X3:=MEM[Q+1].INT-MEM[Q+3].INT; Y1:=MEM[P+6].INT-MEM[P+2].INT;Y2:=MEM[Q+4].INT-MEM[P+6].INT; Y3:=MEM[Q+2].INT-MEM[Q+4].INT;MAX:=ABS(X1); IF ABS(X2)>MAX THEN MAX:=ABS(X2);IF ABS(X3)>MAX THEN MAX:=ABS(X3); IF ABS(Y1)>MAX THEN MAX:=ABS(Y1);IF ABS(Y2)>MAX THEN MAX:=ABS(Y2); IF ABS(Y3)>MAX THEN MAX:=ABS(Y3);IF MAX=0 THEN GOTO 40; WHILE MAX<134217728 DO BEGIN MAX:=MAX+MAX;X1:=X1+X1;X2:=X2+X2;X3:=X3+X3; Y1:=Y1+Y1;Y2:=Y2+Y2;Y3:=Y3+Y3;END;T:=X1; X1:=TAKEFRACTION(X1,X)+TAKEFRACTION(Y1,Y); Y1:=TAKEFRACTION(Y1,X)-TAKEFRACTION(T,Y);T:=X2; X2:=TAKEFRACTION(X2,X)+TAKEFRACTION(Y2,Y); Y2:=TAKEFRACTION(Y2,X)-TAKEFRACTION(T,Y);T:=X3; X3:=TAKEFRACTION(X3,X)+TAKEFRACTION(Y3,Y); Y3:=TAKEFRACTION(Y3,X)-TAKEFRACTION(T,Y){:543}; IF Y1=0 THEN IF X1>=0 THEN GOTO 40;IF N>0 THEN BEGIN{544:} THETA:=NARG(X1,Y1); IF THETA>=0 THEN IF PHI<=0 THEN IF PHI>=THETA-188743680 THEN GOTO 40; IF THETA<=0 THEN IF PHI>=0 THEN IF PHI<=THETA+188743680 THEN GOTO 40{: 544};IF P=H THEN GOTO 45;END;IF(X3<>0)OR(Y3<>0)THEN PHI:=NARG(X3,Y3); {546:}IF X1<0 THEN IF X2<0 THEN IF X3<0 THEN GOTO 30; IF ABVSCD(Y1,Y3,Y2,Y2)=0 THEN{548:} BEGIN IF ABVSCD(Y1,Y2,0,0)<0 THEN BEGIN T:=MAKEFRACTION(Y1,Y1-Y2); X1:=X1-TAKEFRACTION(X1-X2,T);X2:=X2-TAKEFRACTION(X2-X3,T); IF X1-TAKEFRACTION(X1-X2,T)>=0 THEN BEGIN TT:=(T+2048)DIV 4096;GOTO 40; END;END ELSE IF Y3=0 THEN IF Y1=0 THEN{549:} BEGIN T:=CROSSINGPOIN(-X1,-X2,-X3); IF T<=268435456 THEN BEGIN TT:=(T+2048)DIV 4096;GOTO 40;END; IF ABVSCD(X1,X3,X2,X2)<=0 THEN BEGIN T:=MAKEFRACTION(X1,X1-X2); BEGIN TT:=(T+2048)DIV 4096;GOTO 40;END;END;END{:549} ELSE IF X3>=0 THEN BEGIN TT:=65536;GOTO 40;END;GOTO 30;END{:548}; IF Y1<=0 THEN IF Y1<0 THEN BEGIN Y1:=-Y1;Y2:=-Y2;Y3:=-Y3; END ELSE IF Y2>0 THEN BEGIN Y2:=-Y2;Y3:=-Y3;END;{547:} T:=CROSSINGPOIN(Y1,Y2,Y3);IF T>268435456 THEN GOTO 30; Y2:=Y2-TAKEFRACTION(Y2-Y3,T);X1:=X1-TAKEFRACTION(X1-X2,T); X2:=X2-TAKEFRACTION(X2-X3,T);X1:=X1-TAKEFRACTION(X1-X2,T); IF X1>=0 THEN BEGIN TT:=(T+2048)DIV 4096;GOTO 40;END;IF Y2>0 THEN Y2:=0; TT:=T;T:=CROSSINGPOIN(0,-Y2,-Y3);IF T>268435456 THEN GOTO 30; X1:=X1-TAKEFRACTION(X1-X2,T);X2:=X2-TAKEFRACTION(X2-X3,T); IF X1-TAKEFRACTION(X1-X2,T)>=0 THEN BEGIN T:=TT-TAKEFRACTION(TT -268435456,T);BEGIN TT:=(T+2048)DIV 4096;GOTO 40;END;END{:547};30:{:546} {:541};P:=Q;N:=N+65536;END;45:FINDDIRECTIO:=-65536;GOTO 10; 40:FINDDIRECTIO:=N+TT;10:END;{:539}{556:} PROCEDURE CUBICINTERSE(P,PP:HALFWORD);LABEL 22,45,10;VAR Q,QQ:HALFWORD; BEGIN TIMETOGO:=5000;MAXT:=2;{558:}Q:=MEM[P].HH.RH;QQ:=MEM[PP].HH.RH; BISECTPTR:=20;BISECTSTACK[BISECTPTR-5]:=MEM[P+5].INT-MEM[P+1].INT; BISECTSTACK[BISECTPTR-4]:=MEM[Q+3].INT-MEM[P+5].INT; BISECTSTACK[BISECTPTR-3]:=MEM[Q+1].INT-MEM[Q+3].INT; IF BISECTSTACK[BISECTPTR-5]<0 THEN IF BISECTSTACK[BISECTPTR-3]>=0 THEN BEGIN IF BISECTSTACK[BISECTPTR-4]<0 THEN BISECTSTACK[BISECTPTR-2]:= BISECTSTACK[BISECTPTR-5]+BISECTSTACK[BISECTPTR-4]ELSE BISECTSTACK[ BISECTPTR-2]:=BISECTSTACK[BISECTPTR-5]; BISECTSTACK[BISECTPTR-1]:=BISECTSTACK[BISECTPTR-5]+BISECTSTACK[BISECTPTR -4]+BISECTSTACK[BISECTPTR-3]; IF BISECTSTACK[BISECTPTR-1]<0 THEN BISECTSTACK[BISECTPTR-1]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-2]:=BISECTSTACK[BISECTPTR-5]+ BISECTSTACK[BISECTPTR-4]+BISECTSTACK[BISECTPTR-3]; IF BISECTSTACK[BISECTPTR-2]>BISECTSTACK[BISECTPTR-5]THEN BISECTSTACK[ BISECTPTR-2]:=BISECTSTACK[BISECTPTR-5]; BISECTSTACK[BISECTPTR-1]:=BISECTSTACK[BISECTPTR-5]+BISECTSTACK[BISECTPTR -4];IF BISECTSTACK[BISECTPTR-1]<0 THEN BISECTSTACK[BISECTPTR-1]:=0; END ELSE IF BISECTSTACK[BISECTPTR-3]<=0 THEN BEGIN IF BISECTSTACK[ BISECTPTR-4]>0 THEN BISECTSTACK[BISECTPTR-1]:=BISECTSTACK[BISECTPTR-5]+ BISECTSTACK[BISECTPTR-4]ELSE BISECTSTACK[BISECTPTR-1]:=BISECTSTACK[ BISECTPTR-5]; BISECTSTACK[BISECTPTR-2]:=BISECTSTACK[BISECTPTR-5]+BISECTSTACK[BISECTPTR -4]+BISECTSTACK[BISECTPTR-3]; IF BISECTSTACK[BISECTPTR-2]>0 THEN BISECTSTACK[BISECTPTR-2]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-1]:=BISECTSTACK[BISECTPTR-5]+ BISECTSTACK[BISECTPTR-4]+BISECTSTACK[BISECTPTR-3]; IF BISECTSTACK[BISECTPTR-1]0 THEN BISECTSTACK[BISECTPTR-2]:=0;END; BISECTSTACK[BISECTPTR-10]:=MEM[P+6].INT-MEM[P+2].INT; BISECTSTACK[BISECTPTR-9]:=MEM[Q+4].INT-MEM[P+6].INT; BISECTSTACK[BISECTPTR-8]:=MEM[Q+2].INT-MEM[Q+4].INT; IF BISECTSTACK[BISECTPTR-10]<0 THEN IF BISECTSTACK[BISECTPTR-8]>=0 THEN BEGIN IF BISECTSTACK[BISECTPTR-9]<0 THEN BISECTSTACK[BISECTPTR-7]:= BISECTSTACK[BISECTPTR-10]+BISECTSTACK[BISECTPTR-9]ELSE BISECTSTACK[ BISECTPTR-7]:=BISECTSTACK[BISECTPTR-10]; BISECTSTACK[BISECTPTR-6]:=BISECTSTACK[BISECTPTR-10]+BISECTSTACK[ BISECTPTR-9]+BISECTSTACK[BISECTPTR-8]; IF BISECTSTACK[BISECTPTR-6]<0 THEN BISECTSTACK[BISECTPTR-6]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-7]:=BISECTSTACK[BISECTPTR-10]+ BISECTSTACK[BISECTPTR-9]+BISECTSTACK[BISECTPTR-8]; IF BISECTSTACK[BISECTPTR-7]>BISECTSTACK[BISECTPTR-10]THEN BISECTSTACK[ BISECTPTR-7]:=BISECTSTACK[BISECTPTR-10]; BISECTSTACK[BISECTPTR-6]:=BISECTSTACK[BISECTPTR-10]+BISECTSTACK[ BISECTPTR-9]; IF BISECTSTACK[BISECTPTR-6]<0 THEN BISECTSTACK[BISECTPTR-6]:=0; END ELSE IF BISECTSTACK[BISECTPTR-8]<=0 THEN BEGIN IF BISECTSTACK[ BISECTPTR-9]>0 THEN BISECTSTACK[BISECTPTR-6]:=BISECTSTACK[BISECTPTR-10]+ BISECTSTACK[BISECTPTR-9]ELSE BISECTSTACK[BISECTPTR-6]:=BISECTSTACK[ BISECTPTR-10]; BISECTSTACK[BISECTPTR-7]:=BISECTSTACK[BISECTPTR-10]+BISECTSTACK[ BISECTPTR-9]+BISECTSTACK[BISECTPTR-8]; IF BISECTSTACK[BISECTPTR-7]>0 THEN BISECTSTACK[BISECTPTR-7]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-6]:=BISECTSTACK[BISECTPTR-10]+ BISECTSTACK[BISECTPTR-9]+BISECTSTACK[BISECTPTR-8]; IF BISECTSTACK[BISECTPTR-6]0 THEN BISECTSTACK[BISECTPTR-7]:=0;END; BISECTSTACK[BISECTPTR-15]:=MEM[PP+5].INT-MEM[PP+1].INT; BISECTSTACK[BISECTPTR-14]:=MEM[QQ+3].INT-MEM[PP+5].INT; BISECTSTACK[BISECTPTR-13]:=MEM[QQ+1].INT-MEM[QQ+3].INT; IF BISECTSTACK[BISECTPTR-15]<0 THEN IF BISECTSTACK[BISECTPTR-13]>=0 THEN BEGIN IF BISECTSTACK[BISECTPTR-14]<0 THEN BISECTSTACK[BISECTPTR-12]:= BISECTSTACK[BISECTPTR-15]+BISECTSTACK[BISECTPTR-14]ELSE BISECTSTACK[ BISECTPTR-12]:=BISECTSTACK[BISECTPTR-15]; BISECTSTACK[BISECTPTR-11]:=BISECTSTACK[BISECTPTR-15]+BISECTSTACK[ BISECTPTR-14]+BISECTSTACK[BISECTPTR-13]; IF BISECTSTACK[BISECTPTR-11]<0 THEN BISECTSTACK[BISECTPTR-11]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-12]:=BISECTSTACK[BISECTPTR-15]+ BISECTSTACK[BISECTPTR-14]+BISECTSTACK[BISECTPTR-13]; IF BISECTSTACK[BISECTPTR-12]>BISECTSTACK[BISECTPTR-15]THEN BISECTSTACK[ BISECTPTR-12]:=BISECTSTACK[BISECTPTR-15]; BISECTSTACK[BISECTPTR-11]:=BISECTSTACK[BISECTPTR-15]+BISECTSTACK[ BISECTPTR-14]; IF BISECTSTACK[BISECTPTR-11]<0 THEN BISECTSTACK[BISECTPTR-11]:=0; END ELSE IF BISECTSTACK[BISECTPTR-13]<=0 THEN BEGIN IF BISECTSTACK[ BISECTPTR-14]>0 THEN BISECTSTACK[BISECTPTR-11]:=BISECTSTACK[BISECTPTR-15 ]+BISECTSTACK[BISECTPTR-14]ELSE BISECTSTACK[BISECTPTR-11]:=BISECTSTACK[ BISECTPTR-15]; BISECTSTACK[BISECTPTR-12]:=BISECTSTACK[BISECTPTR-15]+BISECTSTACK[ BISECTPTR-14]+BISECTSTACK[BISECTPTR-13]; IF BISECTSTACK[BISECTPTR-12]>0 THEN BISECTSTACK[BISECTPTR-12]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-11]:=BISECTSTACK[BISECTPTR-15]+ BISECTSTACK[BISECTPTR-14]+BISECTSTACK[BISECTPTR-13]; IF BISECTSTACK[BISECTPTR-11]0 THEN BISECTSTACK[BISECTPTR-12]:=0;END; BISECTSTACK[BISECTPTR-20]:=MEM[PP+6].INT-MEM[PP+2].INT; BISECTSTACK[BISECTPTR-19]:=MEM[QQ+4].INT-MEM[PP+6].INT; BISECTSTACK[BISECTPTR-18]:=MEM[QQ+2].INT-MEM[QQ+4].INT; IF BISECTSTACK[BISECTPTR-20]<0 THEN IF BISECTSTACK[BISECTPTR-18]>=0 THEN BEGIN IF BISECTSTACK[BISECTPTR-19]<0 THEN BISECTSTACK[BISECTPTR-17]:= BISECTSTACK[BISECTPTR-20]+BISECTSTACK[BISECTPTR-19]ELSE BISECTSTACK[ BISECTPTR-17]:=BISECTSTACK[BISECTPTR-20]; BISECTSTACK[BISECTPTR-16]:=BISECTSTACK[BISECTPTR-20]+BISECTSTACK[ BISECTPTR-19]+BISECTSTACK[BISECTPTR-18]; IF BISECTSTACK[BISECTPTR-16]<0 THEN BISECTSTACK[BISECTPTR-16]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-17]:=BISECTSTACK[BISECTPTR-20]+ BISECTSTACK[BISECTPTR-19]+BISECTSTACK[BISECTPTR-18]; IF BISECTSTACK[BISECTPTR-17]>BISECTSTACK[BISECTPTR-20]THEN BISECTSTACK[ BISECTPTR-17]:=BISECTSTACK[BISECTPTR-20]; BISECTSTACK[BISECTPTR-16]:=BISECTSTACK[BISECTPTR-20]+BISECTSTACK[ BISECTPTR-19]; IF BISECTSTACK[BISECTPTR-16]<0 THEN BISECTSTACK[BISECTPTR-16]:=0; END ELSE IF BISECTSTACK[BISECTPTR-18]<=0 THEN BEGIN IF BISECTSTACK[ BISECTPTR-19]>0 THEN BISECTSTACK[BISECTPTR-16]:=BISECTSTACK[BISECTPTR-20 ]+BISECTSTACK[BISECTPTR-19]ELSE BISECTSTACK[BISECTPTR-16]:=BISECTSTACK[ BISECTPTR-20]; BISECTSTACK[BISECTPTR-17]:=BISECTSTACK[BISECTPTR-20]+BISECTSTACK[ BISECTPTR-19]+BISECTSTACK[BISECTPTR-18]; IF BISECTSTACK[BISECTPTR-17]>0 THEN BISECTSTACK[BISECTPTR-17]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-16]:=BISECTSTACK[BISECTPTR-20]+ BISECTSTACK[BISECTPTR-19]+BISECTSTACK[BISECTPTR-18]; IF BISECTSTACK[BISECTPTR-16]0 THEN BISECTSTACK[BISECTPTR-17]:=0;END; DELX:=MEM[P+1].INT-MEM[PP+1].INT;DELY:=MEM[P+2].INT-MEM[PP+2].INT; TOL:=0;UV:=BISECTPTR;XY:=BISECTPTR;THREEL:=0;CURT:=1;CURTT:=1{:558}; WHILE TRUE DO BEGIN 22:IF DELX-TOL<=BISECTSTACK[XY-11]-BISECTSTACK[UV-2] THEN IF DELX+TOL>=BISECTSTACK[XY-12]-BISECTSTACK[UV-1]THEN IF DELY-TOL<= BISECTSTACK[XY-16]-BISECTSTACK[UV-7]THEN IF DELY+TOL>=BISECTSTACK[XY-17] -BISECTSTACK[UV-6]THEN BEGIN IF CURT>=MAXT THEN BEGIN IF MAXT=131072 THEN BEGIN CURT:=(CURT+1)DIV 2;CURTT:=(CURTT+1)DIV 2;GOTO 10;END; MAXT:=MAXT+MAXT;APPRT:=CURT;APPRTT:=CURTT;END;{559:} BISECTSTACK[BISECTPTR]:=DELX;BISECTSTACK[BISECTPTR+1]:=DELY; BISECTSTACK[BISECTPTR+2]:=TOL;BISECTSTACK[BISECTPTR+3]:=UV; BISECTSTACK[BISECTPTR+4]:=XY;BISECTPTR:=BISECTPTR+45;CURT:=CURT+CURT; CURTT:=CURTT+CURTT;BISECTSTACK[BISECTPTR-25]:=BISECTSTACK[UV-5]; BISECTSTACK[BISECTPTR-3]:=BISECTSTACK[UV-3]; BISECTSTACK[BISECTPTR-24]:=(BISECTSTACK[BISECTPTR-25]+BISECTSTACK[UV-4]) DIV 2; BISECTSTACK[BISECTPTR-4]:=(BISECTSTACK[BISECTPTR-3]+BISECTSTACK[UV-4]) DIV 2;BISECTSTACK[BISECTPTR-23]:=(BISECTSTACK[BISECTPTR-24]+BISECTSTACK[ BISECTPTR-4])DIV 2;BISECTSTACK[BISECTPTR-5]:=BISECTSTACK[BISECTPTR-23]; IF BISECTSTACK[BISECTPTR-25]<0 THEN IF BISECTSTACK[BISECTPTR-23]>=0 THEN BEGIN IF BISECTSTACK[BISECTPTR-24]<0 THEN BISECTSTACK[BISECTPTR-22]:= BISECTSTACK[BISECTPTR-25]+BISECTSTACK[BISECTPTR-24]ELSE BISECTSTACK[ BISECTPTR-22]:=BISECTSTACK[BISECTPTR-25]; BISECTSTACK[BISECTPTR-21]:=BISECTSTACK[BISECTPTR-25]+BISECTSTACK[ BISECTPTR-24]+BISECTSTACK[BISECTPTR-23]; IF BISECTSTACK[BISECTPTR-21]<0 THEN BISECTSTACK[BISECTPTR-21]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-22]:=BISECTSTACK[BISECTPTR-25]+ BISECTSTACK[BISECTPTR-24]+BISECTSTACK[BISECTPTR-23]; IF BISECTSTACK[BISECTPTR-22]>BISECTSTACK[BISECTPTR-25]THEN BISECTSTACK[ BISECTPTR-22]:=BISECTSTACK[BISECTPTR-25]; BISECTSTACK[BISECTPTR-21]:=BISECTSTACK[BISECTPTR-25]+BISECTSTACK[ BISECTPTR-24]; IF BISECTSTACK[BISECTPTR-21]<0 THEN BISECTSTACK[BISECTPTR-21]:=0; END ELSE IF BISECTSTACK[BISECTPTR-23]<=0 THEN BEGIN IF BISECTSTACK[ BISECTPTR-24]>0 THEN BISECTSTACK[BISECTPTR-21]:=BISECTSTACK[BISECTPTR-25 ]+BISECTSTACK[BISECTPTR-24]ELSE BISECTSTACK[BISECTPTR-21]:=BISECTSTACK[ BISECTPTR-25]; BISECTSTACK[BISECTPTR-22]:=BISECTSTACK[BISECTPTR-25]+BISECTSTACK[ BISECTPTR-24]+BISECTSTACK[BISECTPTR-23]; IF BISECTSTACK[BISECTPTR-22]>0 THEN BISECTSTACK[BISECTPTR-22]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-21]:=BISECTSTACK[BISECTPTR-25]+ BISECTSTACK[BISECTPTR-24]+BISECTSTACK[BISECTPTR-23]; IF BISECTSTACK[BISECTPTR-21]0 THEN BISECTSTACK[BISECTPTR-22]:=0;END; IF BISECTSTACK[BISECTPTR-5]<0 THEN IF BISECTSTACK[BISECTPTR-3]>=0 THEN BEGIN IF BISECTSTACK[BISECTPTR-4]<0 THEN BISECTSTACK[BISECTPTR-2]:= BISECTSTACK[BISECTPTR-5]+BISECTSTACK[BISECTPTR-4]ELSE BISECTSTACK[ BISECTPTR-2]:=BISECTSTACK[BISECTPTR-5]; BISECTSTACK[BISECTPTR-1]:=BISECTSTACK[BISECTPTR-5]+BISECTSTACK[BISECTPTR -4]+BISECTSTACK[BISECTPTR-3]; IF BISECTSTACK[BISECTPTR-1]<0 THEN BISECTSTACK[BISECTPTR-1]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-2]:=BISECTSTACK[BISECTPTR-5]+ BISECTSTACK[BISECTPTR-4]+BISECTSTACK[BISECTPTR-3]; IF BISECTSTACK[BISECTPTR-2]>BISECTSTACK[BISECTPTR-5]THEN BISECTSTACK[ BISECTPTR-2]:=BISECTSTACK[BISECTPTR-5]; BISECTSTACK[BISECTPTR-1]:=BISECTSTACK[BISECTPTR-5]+BISECTSTACK[BISECTPTR -4];IF BISECTSTACK[BISECTPTR-1]<0 THEN BISECTSTACK[BISECTPTR-1]:=0; END ELSE IF BISECTSTACK[BISECTPTR-3]<=0 THEN BEGIN IF BISECTSTACK[ BISECTPTR-4]>0 THEN BISECTSTACK[BISECTPTR-1]:=BISECTSTACK[BISECTPTR-5]+ BISECTSTACK[BISECTPTR-4]ELSE BISECTSTACK[BISECTPTR-1]:=BISECTSTACK[ BISECTPTR-5]; BISECTSTACK[BISECTPTR-2]:=BISECTSTACK[BISECTPTR-5]+BISECTSTACK[BISECTPTR -4]+BISECTSTACK[BISECTPTR-3]; IF BISECTSTACK[BISECTPTR-2]>0 THEN BISECTSTACK[BISECTPTR-2]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-1]:=BISECTSTACK[BISECTPTR-5]+ BISECTSTACK[BISECTPTR-4]+BISECTSTACK[BISECTPTR-3]; IF BISECTSTACK[BISECTPTR-1]0 THEN BISECTSTACK[BISECTPTR-2]:=0;END; BISECTSTACK[BISECTPTR-30]:=BISECTSTACK[UV-10]; BISECTSTACK[BISECTPTR-8]:=BISECTSTACK[UV-8]; BISECTSTACK[BISECTPTR-29]:=(BISECTSTACK[BISECTPTR-30]+BISECTSTACK[UV-9]) DIV 2; BISECTSTACK[BISECTPTR-9]:=(BISECTSTACK[BISECTPTR-8]+BISECTSTACK[UV-9]) DIV 2;BISECTSTACK[BISECTPTR-28]:=(BISECTSTACK[BISECTPTR-29]+BISECTSTACK[ BISECTPTR-9])DIV 2;BISECTSTACK[BISECTPTR-10]:=BISECTSTACK[BISECTPTR-28]; IF BISECTSTACK[BISECTPTR-30]<0 THEN IF BISECTSTACK[BISECTPTR-28]>=0 THEN BEGIN IF BISECTSTACK[BISECTPTR-29]<0 THEN BISECTSTACK[BISECTPTR-27]:= BISECTSTACK[BISECTPTR-30]+BISECTSTACK[BISECTPTR-29]ELSE BISECTSTACK[ BISECTPTR-27]:=BISECTSTACK[BISECTPTR-30]; BISECTSTACK[BISECTPTR-26]:=BISECTSTACK[BISECTPTR-30]+BISECTSTACK[ BISECTPTR-29]+BISECTSTACK[BISECTPTR-28]; IF BISECTSTACK[BISECTPTR-26]<0 THEN BISECTSTACK[BISECTPTR-26]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-27]:=BISECTSTACK[BISECTPTR-30]+ BISECTSTACK[BISECTPTR-29]+BISECTSTACK[BISECTPTR-28]; IF BISECTSTACK[BISECTPTR-27]>BISECTSTACK[BISECTPTR-30]THEN BISECTSTACK[ BISECTPTR-27]:=BISECTSTACK[BISECTPTR-30]; BISECTSTACK[BISECTPTR-26]:=BISECTSTACK[BISECTPTR-30]+BISECTSTACK[ BISECTPTR-29]; IF BISECTSTACK[BISECTPTR-26]<0 THEN BISECTSTACK[BISECTPTR-26]:=0; END ELSE IF BISECTSTACK[BISECTPTR-28]<=0 THEN BEGIN IF BISECTSTACK[ BISECTPTR-29]>0 THEN BISECTSTACK[BISECTPTR-26]:=BISECTSTACK[BISECTPTR-30 ]+BISECTSTACK[BISECTPTR-29]ELSE BISECTSTACK[BISECTPTR-26]:=BISECTSTACK[ BISECTPTR-30]; BISECTSTACK[BISECTPTR-27]:=BISECTSTACK[BISECTPTR-30]+BISECTSTACK[ BISECTPTR-29]+BISECTSTACK[BISECTPTR-28]; IF BISECTSTACK[BISECTPTR-27]>0 THEN BISECTSTACK[BISECTPTR-27]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-26]:=BISECTSTACK[BISECTPTR-30]+ BISECTSTACK[BISECTPTR-29]+BISECTSTACK[BISECTPTR-28]; IF BISECTSTACK[BISECTPTR-26]0 THEN BISECTSTACK[BISECTPTR-27]:=0;END; IF BISECTSTACK[BISECTPTR-10]<0 THEN IF BISECTSTACK[BISECTPTR-8]>=0 THEN BEGIN IF BISECTSTACK[BISECTPTR-9]<0 THEN BISECTSTACK[BISECTPTR-7]:= BISECTSTACK[BISECTPTR-10]+BISECTSTACK[BISECTPTR-9]ELSE BISECTSTACK[ BISECTPTR-7]:=BISECTSTACK[BISECTPTR-10]; BISECTSTACK[BISECTPTR-6]:=BISECTSTACK[BISECTPTR-10]+BISECTSTACK[ BISECTPTR-9]+BISECTSTACK[BISECTPTR-8]; IF BISECTSTACK[BISECTPTR-6]<0 THEN BISECTSTACK[BISECTPTR-6]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-7]:=BISECTSTACK[BISECTPTR-10]+ BISECTSTACK[BISECTPTR-9]+BISECTSTACK[BISECTPTR-8]; IF BISECTSTACK[BISECTPTR-7]>BISECTSTACK[BISECTPTR-10]THEN BISECTSTACK[ BISECTPTR-7]:=BISECTSTACK[BISECTPTR-10]; BISECTSTACK[BISECTPTR-6]:=BISECTSTACK[BISECTPTR-10]+BISECTSTACK[ BISECTPTR-9]; IF BISECTSTACK[BISECTPTR-6]<0 THEN BISECTSTACK[BISECTPTR-6]:=0; END ELSE IF BISECTSTACK[BISECTPTR-8]<=0 THEN BEGIN IF BISECTSTACK[ BISECTPTR-9]>0 THEN BISECTSTACK[BISECTPTR-6]:=BISECTSTACK[BISECTPTR-10]+ BISECTSTACK[BISECTPTR-9]ELSE BISECTSTACK[BISECTPTR-6]:=BISECTSTACK[ BISECTPTR-10]; BISECTSTACK[BISECTPTR-7]:=BISECTSTACK[BISECTPTR-10]+BISECTSTACK[ BISECTPTR-9]+BISECTSTACK[BISECTPTR-8]; IF BISECTSTACK[BISECTPTR-7]>0 THEN BISECTSTACK[BISECTPTR-7]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-6]:=BISECTSTACK[BISECTPTR-10]+ BISECTSTACK[BISECTPTR-9]+BISECTSTACK[BISECTPTR-8]; IF BISECTSTACK[BISECTPTR-6]0 THEN BISECTSTACK[BISECTPTR-7]:=0;END; BISECTSTACK[BISECTPTR-35]:=BISECTSTACK[XY-15]; BISECTSTACK[BISECTPTR-13]:=BISECTSTACK[XY-13]; BISECTSTACK[BISECTPTR-34]:=(BISECTSTACK[BISECTPTR-35]+BISECTSTACK[XY-14] )DIV 2; BISECTSTACK[BISECTPTR-14]:=(BISECTSTACK[BISECTPTR-13]+BISECTSTACK[XY-14] )DIV 2; BISECTSTACK[BISECTPTR-33]:=(BISECTSTACK[BISECTPTR-34]+BISECTSTACK[ BISECTPTR-14])DIV 2; BISECTSTACK[BISECTPTR-15]:=BISECTSTACK[BISECTPTR-33]; IF BISECTSTACK[BISECTPTR-35]<0 THEN IF BISECTSTACK[BISECTPTR-33]>=0 THEN BEGIN IF BISECTSTACK[BISECTPTR-34]<0 THEN BISECTSTACK[BISECTPTR-32]:= BISECTSTACK[BISECTPTR-35]+BISECTSTACK[BISECTPTR-34]ELSE BISECTSTACK[ BISECTPTR-32]:=BISECTSTACK[BISECTPTR-35]; BISECTSTACK[BISECTPTR-31]:=BISECTSTACK[BISECTPTR-35]+BISECTSTACK[ BISECTPTR-34]+BISECTSTACK[BISECTPTR-33]; IF BISECTSTACK[BISECTPTR-31]<0 THEN BISECTSTACK[BISECTPTR-31]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-32]:=BISECTSTACK[BISECTPTR-35]+ BISECTSTACK[BISECTPTR-34]+BISECTSTACK[BISECTPTR-33]; IF BISECTSTACK[BISECTPTR-32]>BISECTSTACK[BISECTPTR-35]THEN BISECTSTACK[ BISECTPTR-32]:=BISECTSTACK[BISECTPTR-35]; BISECTSTACK[BISECTPTR-31]:=BISECTSTACK[BISECTPTR-35]+BISECTSTACK[ BISECTPTR-34]; IF BISECTSTACK[BISECTPTR-31]<0 THEN BISECTSTACK[BISECTPTR-31]:=0; END ELSE IF BISECTSTACK[BISECTPTR-33]<=0 THEN BEGIN IF BISECTSTACK[ BISECTPTR-34]>0 THEN BISECTSTACK[BISECTPTR-31]:=BISECTSTACK[BISECTPTR-35 ]+BISECTSTACK[BISECTPTR-34]ELSE BISECTSTACK[BISECTPTR-31]:=BISECTSTACK[ BISECTPTR-35]; BISECTSTACK[BISECTPTR-32]:=BISECTSTACK[BISECTPTR-35]+BISECTSTACK[ BISECTPTR-34]+BISECTSTACK[BISECTPTR-33]; IF BISECTSTACK[BISECTPTR-32]>0 THEN BISECTSTACK[BISECTPTR-32]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-31]:=BISECTSTACK[BISECTPTR-35]+ BISECTSTACK[BISECTPTR-34]+BISECTSTACK[BISECTPTR-33]; IF BISECTSTACK[BISECTPTR-31]0 THEN BISECTSTACK[BISECTPTR-32]:=0;END; IF BISECTSTACK[BISECTPTR-15]<0 THEN IF BISECTSTACK[BISECTPTR-13]>=0 THEN BEGIN IF BISECTSTACK[BISECTPTR-14]<0 THEN BISECTSTACK[BISECTPTR-12]:= BISECTSTACK[BISECTPTR-15]+BISECTSTACK[BISECTPTR-14]ELSE BISECTSTACK[ BISECTPTR-12]:=BISECTSTACK[BISECTPTR-15]; BISECTSTACK[BISECTPTR-11]:=BISECTSTACK[BISECTPTR-15]+BISECTSTACK[ BISECTPTR-14]+BISECTSTACK[BISECTPTR-13]; IF BISECTSTACK[BISECTPTR-11]<0 THEN BISECTSTACK[BISECTPTR-11]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-12]:=BISECTSTACK[BISECTPTR-15]+ BISECTSTACK[BISECTPTR-14]+BISECTSTACK[BISECTPTR-13]; IF BISECTSTACK[BISECTPTR-12]>BISECTSTACK[BISECTPTR-15]THEN BISECTSTACK[ BISECTPTR-12]:=BISECTSTACK[BISECTPTR-15]; BISECTSTACK[BISECTPTR-11]:=BISECTSTACK[BISECTPTR-15]+BISECTSTACK[ BISECTPTR-14]; IF BISECTSTACK[BISECTPTR-11]<0 THEN BISECTSTACK[BISECTPTR-11]:=0; END ELSE IF BISECTSTACK[BISECTPTR-13]<=0 THEN BEGIN IF BISECTSTACK[ BISECTPTR-14]>0 THEN BISECTSTACK[BISECTPTR-11]:=BISECTSTACK[BISECTPTR-15 ]+BISECTSTACK[BISECTPTR-14]ELSE BISECTSTACK[BISECTPTR-11]:=BISECTSTACK[ BISECTPTR-15]; BISECTSTACK[BISECTPTR-12]:=BISECTSTACK[BISECTPTR-15]+BISECTSTACK[ BISECTPTR-14]+BISECTSTACK[BISECTPTR-13]; IF BISECTSTACK[BISECTPTR-12]>0 THEN BISECTSTACK[BISECTPTR-12]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-11]:=BISECTSTACK[BISECTPTR-15]+ BISECTSTACK[BISECTPTR-14]+BISECTSTACK[BISECTPTR-13]; IF BISECTSTACK[BISECTPTR-11]0 THEN BISECTSTACK[BISECTPTR-12]:=0;END; BISECTSTACK[BISECTPTR-40]:=BISECTSTACK[XY-20]; BISECTSTACK[BISECTPTR-18]:=BISECTSTACK[XY-18]; BISECTSTACK[BISECTPTR-39]:=(BISECTSTACK[BISECTPTR-40]+BISECTSTACK[XY-19] )DIV 2; BISECTSTACK[BISECTPTR-19]:=(BISECTSTACK[BISECTPTR-18]+BISECTSTACK[XY-19] )DIV 2; BISECTSTACK[BISECTPTR-38]:=(BISECTSTACK[BISECTPTR-39]+BISECTSTACK[ BISECTPTR-19])DIV 2; BISECTSTACK[BISECTPTR-20]:=BISECTSTACK[BISECTPTR-38]; IF BISECTSTACK[BISECTPTR-40]<0 THEN IF BISECTSTACK[BISECTPTR-38]>=0 THEN BEGIN IF BISECTSTACK[BISECTPTR-39]<0 THEN BISECTSTACK[BISECTPTR-37]:= BISECTSTACK[BISECTPTR-40]+BISECTSTACK[BISECTPTR-39]ELSE BISECTSTACK[ BISECTPTR-37]:=BISECTSTACK[BISECTPTR-40]; BISECTSTACK[BISECTPTR-36]:=BISECTSTACK[BISECTPTR-40]+BISECTSTACK[ BISECTPTR-39]+BISECTSTACK[BISECTPTR-38]; IF BISECTSTACK[BISECTPTR-36]<0 THEN BISECTSTACK[BISECTPTR-36]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-37]:=BISECTSTACK[BISECTPTR-40]+ BISECTSTACK[BISECTPTR-39]+BISECTSTACK[BISECTPTR-38]; IF BISECTSTACK[BISECTPTR-37]>BISECTSTACK[BISECTPTR-40]THEN BISECTSTACK[ BISECTPTR-37]:=BISECTSTACK[BISECTPTR-40]; BISECTSTACK[BISECTPTR-36]:=BISECTSTACK[BISECTPTR-40]+BISECTSTACK[ BISECTPTR-39]; IF BISECTSTACK[BISECTPTR-36]<0 THEN BISECTSTACK[BISECTPTR-36]:=0; END ELSE IF BISECTSTACK[BISECTPTR-38]<=0 THEN BEGIN IF BISECTSTACK[ BISECTPTR-39]>0 THEN BISECTSTACK[BISECTPTR-36]:=BISECTSTACK[BISECTPTR-40 ]+BISECTSTACK[BISECTPTR-39]ELSE BISECTSTACK[BISECTPTR-36]:=BISECTSTACK[ BISECTPTR-40]; BISECTSTACK[BISECTPTR-37]:=BISECTSTACK[BISECTPTR-40]+BISECTSTACK[ BISECTPTR-39]+BISECTSTACK[BISECTPTR-38]; IF BISECTSTACK[BISECTPTR-37]>0 THEN BISECTSTACK[BISECTPTR-37]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-36]:=BISECTSTACK[BISECTPTR-40]+ BISECTSTACK[BISECTPTR-39]+BISECTSTACK[BISECTPTR-38]; IF BISECTSTACK[BISECTPTR-36]0 THEN BISECTSTACK[BISECTPTR-37]:=0;END; IF BISECTSTACK[BISECTPTR-20]<0 THEN IF BISECTSTACK[BISECTPTR-18]>=0 THEN BEGIN IF BISECTSTACK[BISECTPTR-19]<0 THEN BISECTSTACK[BISECTPTR-17]:= BISECTSTACK[BISECTPTR-20]+BISECTSTACK[BISECTPTR-19]ELSE BISECTSTACK[ BISECTPTR-17]:=BISECTSTACK[BISECTPTR-20]; BISECTSTACK[BISECTPTR-16]:=BISECTSTACK[BISECTPTR-20]+BISECTSTACK[ BISECTPTR-19]+BISECTSTACK[BISECTPTR-18]; IF BISECTSTACK[BISECTPTR-16]<0 THEN BISECTSTACK[BISECTPTR-16]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-17]:=BISECTSTACK[BISECTPTR-20]+ BISECTSTACK[BISECTPTR-19]+BISECTSTACK[BISECTPTR-18]; IF BISECTSTACK[BISECTPTR-17]>BISECTSTACK[BISECTPTR-20]THEN BISECTSTACK[ BISECTPTR-17]:=BISECTSTACK[BISECTPTR-20]; BISECTSTACK[BISECTPTR-16]:=BISECTSTACK[BISECTPTR-20]+BISECTSTACK[ BISECTPTR-19]; IF BISECTSTACK[BISECTPTR-16]<0 THEN BISECTSTACK[BISECTPTR-16]:=0; END ELSE IF BISECTSTACK[BISECTPTR-18]<=0 THEN BEGIN IF BISECTSTACK[ BISECTPTR-19]>0 THEN BISECTSTACK[BISECTPTR-16]:=BISECTSTACK[BISECTPTR-20 ]+BISECTSTACK[BISECTPTR-19]ELSE BISECTSTACK[BISECTPTR-16]:=BISECTSTACK[ BISECTPTR-20]; BISECTSTACK[BISECTPTR-17]:=BISECTSTACK[BISECTPTR-20]+BISECTSTACK[ BISECTPTR-19]+BISECTSTACK[BISECTPTR-18]; IF BISECTSTACK[BISECTPTR-17]>0 THEN BISECTSTACK[BISECTPTR-17]:=0; END ELSE BEGIN BISECTSTACK[BISECTPTR-16]:=BISECTSTACK[BISECTPTR-20]+ BISECTSTACK[BISECTPTR-19]+BISECTSTACK[BISECTPTR-18]; IF BISECTSTACK[BISECTPTR-16]0 THEN BISECTSTACK[BISECTPTR-17]:=0;END; UV:=BISECTPTR-20;XY:=BISECTPTR-20;DELX:=DELX+DELX;DELY:=DELY+DELY; TOL:=TOL-THREEL+TOLSTEP;TOL:=TOL+TOL;THREEL:=THREEL+TOLSTEP{:559}; GOTO 22;END; IF TIMETOGO>0 THEN TIMETOGO:=TIMETOGO-1 ELSE BEGIN WHILE APPRT<65536 DO BEGIN APPRT:=APPRT+APPRT;APPRTT:=APPRTT+APPRTT;END;CURT:=APPRT; CURTT:=APPRTT;GOTO 10;END;{560:} 45:IF ODD(CURTT)THEN IF ODD(CURT)THEN{561:}BEGIN CURT:=(CURT)DIV 2; CURTT:=(CURTT)DIV 2;IF CURT=0 THEN GOTO 10;BISECTPTR:=BISECTPTR-45; THREEL:=THREEL-TOLSTEP;DELX:=BISECTSTACK[BISECTPTR]; DELY:=BISECTSTACK[BISECTPTR+1];TOL:=BISECTSTACK[BISECTPTR+2]; UV:=BISECTSTACK[BISECTPTR+3];XY:=BISECTSTACK[BISECTPTR+4];GOTO 45; END{:561}ELSE BEGIN CURT:=CURT+1; DELX:=DELX+BISECTSTACK[UV-5]+BISECTSTACK[UV-4]+BISECTSTACK[UV-3]; DELY:=DELY+BISECTSTACK[UV-10]+BISECTSTACK[UV-9]+BISECTSTACK[UV-8]; UV:=UV+20;CURTT:=CURTT-1;XY:=XY-20; DELX:=DELX+BISECTSTACK[XY-15]+BISECTSTACK[XY-14]+BISECTSTACK[XY-13]; DELY:=DELY+BISECTSTACK[XY-20]+BISECTSTACK[XY-19]+BISECTSTACK[XY-18]; END ELSE BEGIN CURTT:=CURTT+1;TOL:=TOL+THREEL; DELX:=DELX-BISECTSTACK[XY-15]-BISECTSTACK[XY-14]-BISECTSTACK[XY-13]; DELY:=DELY-BISECTSTACK[XY-20]-BISECTSTACK[XY-19]-BISECTSTACK[XY-18]; XY:=XY+20;END{:560};END;10:END;{:556}{562:} PROCEDURE PATHINTERSEC(H,HH:HALFWORD);LABEL 10;VAR P,PP:HALFWORD; N,NN:INTEGER;BEGIN{563:} IF MEM[H].HH.B1=0 THEN BEGIN MEM[H+5].INT:=MEM[H+1].INT; MEM[H+3].INT:=MEM[H+1].INT;MEM[H+6].INT:=MEM[H+2].INT; MEM[H+4].INT:=MEM[H+2].INT;MEM[H].HH.B1:=1;END; IF MEM[HH].HH.B1=0 THEN BEGIN MEM[HH+5].INT:=MEM[HH+1].INT; MEM[HH+3].INT:=MEM[HH+1].INT;MEM[HH+6].INT:=MEM[HH+2].INT; MEM[HH+4].INT:=MEM[HH+2].INT;MEM[HH].HH.B1:=1;END;{:563};TOLSTEP:=0; REPEAT N:=-65536;P:=H;REPEAT IF MEM[P].HH.B1<>0 THEN BEGIN NN:=-65536; PP:=HH;REPEAT IF MEM[PP].HH.B1<>0 THEN BEGIN CUBICINTERSE(P,PP); IF CURT>0 THEN BEGIN CURT:=CURT+N;CURTT:=CURTT+NN;GOTO 10;END;END; NN:=NN+65536;PP:=MEM[PP].HH.RH;UNTIL PP=HH;END;N:=N+65536; P:=MEM[P].HH.RH;UNTIL P=H;TOLSTEP:=TOLSTEP+3;UNTIL TOLSTEP>3; CURT:=-65536;CURTT:=-65536;10:END;{:562}{566:} [external (indirect) ]PROCEDURE LIBINITSCREE( %ref XSIZE:SCREENCOL; %ref YSIZE:SCREENROW; %immed ENTRY:INTEGER);EXTERN; PROCEDURE OPENDISPLAY(VAR SCREENWIDTH:SCREENROW; VAR SCREENDEPTH:SCREENCOL);VAR INITENTRY:INTEGER; DISPLEN,INDEXLEN:FILESIZE; DISPNAME,INDEXNAME,INDEXLINE,LIBNAME,LIBAREA,LIBFN:PACKED ARRAY[1.. FILENAMESIZE]OF CHAR;FOUNDLIBNAME:BOOLEAN;J,K:INTEGER; GLIBINDEX:ALPHAFILE; BEGIN IF NOT ODD( cli$present('BATCH'))AND ODD( cli$present('DISPLAY')) THEN BEGIN DISPLAYAVAIL:=TRUE; cli$get_value('DISPLAY',DISPNAME,DISPLEN); IF DISPNAME[DISPLEN]=':'THEN BEGIN DISPNAME[DISPLEN]:=' '; DISPLEN:=DISPLEN-1;DISPLAYAVAIL:=TRANSLATE(DISPNAME,DISPLEN);END; cli$get_value('GLIB_INDEX',INDEXNAME,INDEXLEN); open(GLIBINDEX,INDEXNAME, readonly ,error:=continue); DISPLAYAVAIL:=DISPLAYAVAIL AND(STATUS(GLIBINDEX)<=0); IF DISPLAYAVAIL THEN BEGIN RESET(GLIBINDEX,error:=continue); DISPLAYAVAIL:=(STATUS(GLIBINDEX)<=0);END; IF DISPLAYAVAIL THEN BEGIN FOUNDLIBNAME:=FALSE; REPEAT READLN(GLIBINDEX,INDEXLINE); IF(INDEXLINE[1]<>'!')AND(INDEXLINE[1]<>' ')THEN BEGIN J:= index ( INDEXLINE,'*');K:= index (INDEXLINE,' ');IF J=0 THEN J:=DISPLEN+1; IF K=0 THEN K:=J;J:= min (J,K)-1;; IF substr (INDEXLINE,1,J)= substr (DISPNAME,1,J)THEN FOUNDLIBNAME:=TRUE; END;UNTIL FOUNDLIBNAME OR EOF(GLIBINDEX);DISPLAYAVAIL:=FOUNDLIBNAME;END; IF DISPLAYAVAIL THEN BEGIN K:=-1;LIBNAME:=''; FOR J:=1 TO FILENAMESIZE DO BEGIN IF K=-1 THEN IF INDEXLINE[J]=' 'THEN K :=0;IF K=0 THEN IF INDEXLINE[J]<>' 'THEN K:=J; IF K>0 THEN IF(INDEXLINE[J]=' ')AND(LIBNAME='')THEN LIBNAME:= substr ( INDEXLINE,K,J-K);END; IF LIBNAME=''THEN LIBNAME:= substr (INDEXLINE,K,FILENAMESIZE-K); J:= max ( index (LIBNAME,']'), index (LIBNAME,':')); LIBAREA:= substr (LIBNAME,1,J)+'.EXE'; LIBFN:= substr (LIBNAME,J+1, length (LIBNAME)-J);END; IF DISPLAYAVAIL THEN BEGIN lib$find_image_symbol ( %stdescr LIBFN, %stdescr 'LIBINITSC',INITENTRY, %stdescr LIBAREA); LIBINITSCREE(SCREENWIDTH,SCREENDEPTH,INITENTRY); DISPLAYAVAIL:=(SCREENWIDTH<>0);END; IF DISPLAYAVAIL THEN BEGIN lib$find_image_symbol ( %stdescr LIBFN, %stdescr 'LIBSTARTS',STARTENTRY, %stdescr LIBAREA); lib$find_image_symbol ( %stdescr LIBFN, %stdescr 'LIBBLRECT',BLANKENTRY, %stdescr LIBAREA); lib$find_image_symbol ( %stdescr LIBFN, %stdescr 'LIBDRWROW',DRAWENTRY, %stdescr LIBAREA); lib$find_image_symbol ( %stdescr LIBFN, %stdescr 'LIBUPDTSC',UPDATEENTRY , %stdescr LIBAREA); lib$find_image_symbol ( %stdescr LIBFN, %stdescr 'LIBCLOSSC',CLOSEENTRY, %stdescr LIBAREA);END;END ELSE DISPLAYAVAIL:=FALSE;END;{:566}{567:} [external (indirect) ]PROCEDURE LIBSTARTSCRE( %immed ENTRY:INTEGER); EXTERN; [external (indirect) ]PROCEDURE LIBBLANKRECT(LEFTCOL,RIGHTCOL:SCREENCOL; TOPROW,BOTROW:SCREENCOL; %immed ENTRY:INTEGER);EXTERN; [external (indirect) ]PROCEDURE LIBDRAWROW(R:SCREENROW;B:PIXELCOLOR; VAR A:TRANSSPEC;N:SCREENCOL; %immed ENTRY:INTEGER);EXTERN; [external (indirect) ]PROCEDURE LIBUPDATESCR( %immed ENTRY:INTEGER); EXTERN; [external (indirect) ]PROCEDURE LIBCLOSESCRE( %immed ENTRY:INTEGER); EXTERN;FUNCTION INITSCREEN:BOOLEAN; BEGIN IF DISPLAYAVAIL THEN BEGIN IF NOT INITFLAG THEN LIBSTARTSCRE( STARTENTRY);INITSCREEN:=TRUE;END ELSE INITSCREEN:=FALSE;END; PROCEDURE BLANKRECTANG(LEFTCOL,RIGHTCOL:SCREENCOL; TOPROW,BOTROW:SCREENROW); BEGIN IF INITFLAG THEN BEGIN IF LOGQUAL THEN WRITELN(LOGFILE); IF LOGQUAL THEN WRITELN(LOGFILE,'Calling BLANKRECTANGLE(',LEFTCOL:1,',', RIGHTCOL:1,',',TOPROW:1,',',BOTROW:1,')'); END ELSE LIBBLANKRECT(LEFTCOL,RIGHTCOL,TOPROW,BOTROW,BLANKENTRY);END; PROCEDURE PAINTROW(R:SCREENROW;B:PIXELCOLOR;VAR A:TRANSSPEC; N:SCREENCOL);VAR K:INTEGER; BEGIN IF INITFLAG THEN BEGIN IF LOGQUAL THEN WRITE(LOGFILE, 'Calling PAINTROW(',R:1,',',B:1,';'); FOR K:=0 TO N DO BEGIN IF LOGQUAL THEN WRITE(LOGFILE,A[K]:1); IF K<>N THEN IF LOGQUAL THEN WRITE(LOGFILE,',');END; IF LOGQUAL THEN WRITELN(LOGFILE,')'); END ELSE LIBDRAWROW(R,B,A,N,DRAWENTRY);END;PROCEDURE UPDATESCREEN; BEGIN IF INITFLAG THEN IF LOGQUAL THEN WRITELN(LOGFILE, 'Calling UPDATESCREEN')ELSE LIBUPDATESCR(UPDATEENTRY);END;{:567}{574:} PROCEDURE OPENAWINDOW(K:WINDOWNUMBER;R0,C0,R1,C1:SCALED;X,Y:SCALED); VAR M,N:INTEGER;BEGIN{575:}IF R0<0 THEN R0:=0 ELSE R0:=ROUNDUNSCALE(R0); R1:=ROUNDUNSCALE(R1);IF R1>SCREENDEPTH THEN R1:=SCREENDEPTH; IF R1SCREENDEPTH THEN R0:=R1 ELSE R1:=R0; IF C0<0 THEN C0:=0 ELSE C0:=ROUNDUNSCALE(C0);C1:=ROUNDUNSCALE(C1); IF C1>SCREENWIDTH THEN C1:=SCREENWIDTH; IF C1SCREENWIDTH THEN C0:=C1 ELSE C1:=C0{:575}; WINDOWOPEN[K]:=TRUE;WINDOWTIME[K]:=WINDOWTIME[K]+1;LEFTCOL[K]:=C0; RIGHTCOL[K]:=C1;TOPROW[K]:=R0;BOTROW[K]:=R1;{576:}M:=ROUNDUNSCALE(X); N:=ROUNDUNSCALE(Y)-1;MWINDOW[K]:=C0-M;NWINDOW[K]:=R0+N{:576}; BEGIN IF NOT SCREENSTARTE THEN BEGIN SCREENOK:=INITSCREEN; SCREENSTARTE:=TRUE;END;END; IF SCREENOK THEN BEGIN BLANKRECTANG(C0,C1,R0,R1);UPDATESCREEN;END;END; {:574}{577:}PROCEDURE DISPEDGES(K:WINDOWNUMBER);LABEL 30,40; VAR P,Q:HALFWORD;ALREADYTHERE:BOOLEAN;R:INTEGER;{580:}N:SCREENCOL; W,WW:INTEGER;B:PIXELCOLOR;M,MM:INTEGER;D:INTEGER;MADJUSTMENT:INTEGER; RIGHTEDGE:INTEGER;MINCOL:SCREENCOL;{:580} BEGIN IF SCREENOK THEN IF LEFTCOL[K]CUREDGES)AND(R>=TOPROW[K])DO BEGIN IF R1 THEN SORTEDGES(P)ELSE IF MEM[P+1].HH.LH=1 THEN IF ALREADYTHERE THEN GOTO 30;MEM[P+1].HH.LH:=1;{582:}N:=0;WW:=0;M:=-1; W:=0;Q:=MEM[P+1].HH.RH;ROWTRANSITIO[0]:=MINCOL; WHILE TRUE DO BEGIN IF Q=65534 THEN D:=RIGHTEDGE ELSE D:=MEM[Q].HH.LH; MM:=(D DIV 8)+MADJUSTMENT;IF MM<>M THEN BEGIN{583:} IF W<=0 THEN BEGIN IF WW>0 THEN IF M>MINCOL THEN BEGIN IF N=0 THEN IF ALREADYTHERE THEN BEGIN B:=0;N:=N+1;END ELSE B:=1 ELSE N:=N+1; ROWTRANSITIO[N]:=M;END; END ELSE IF WW<=0 THEN IF M>MINCOL THEN BEGIN IF N=0 THEN B:=1;N:=N+1; ROWTRANSITIO[N]:=M;END{:583};M:=MM;W:=WW;END; IF D>=RIGHTEDGE THEN GOTO 40;WW:=WW+(D MOD 8)-4;Q:=MEM[Q].HH.RH;END; 40:{584:} IF ALREADYTHERE OR(WW>0)THEN BEGIN IF N=0 THEN IF WW>0 THEN B:=1 ELSE B :=0;N:=N+1;ROWTRANSITIO[N]:=RIGHTCOL[K]; END ELSE IF N=0 THEN GOTO 30{:584};{:582};PAINTROW(R,B,ROWTRANSITIO,N); 30:END{:578};P:=MEM[P].HH.RH;R:=R-1;END;UPDATESCREEN; WINDOWTIME[K]:=WINDOWTIME[K]+1;MEM[CUREDGES+3].HH.RH:=K; MEM[CUREDGES+4].INT:=WINDOWTIME[K];END;END;{:577}{591:} FUNCTION MAXCOEF(P:HALFWORD):FRACTION;VAR X:FRACTION;BEGIN X:=0; WHILE MEM[P].HH.LH<>0 DO BEGIN IF ABS(MEM[P+1].INT)>X THEN X:=ABS(MEM[P +1].INT);P:=MEM[P].HH.RH;END;MAXCOEF:=X;END;{:591}{597:} FUNCTION PPLUSQ(P:HALFWORD;Q:HALFWORD;T:SMALLNUMBER):HALFWORD;LABEL 30; VAR PP,QQ:HALFWORD;R,S:HALFWORD;THRESHOLD:INTEGER;V:INTEGER; BEGIN IF T=17 THEN THRESHOLD:=2685 ELSE THRESHOLD:=8;R:=65533; PP:=MEM[P].HH.LH;QQ:=MEM[Q].HH.LH; WHILE TRUE DO IF PP=QQ THEN IF PP=0 THEN GOTO 30 ELSE{598:} BEGIN V:=MEM[P+1].INT+MEM[Q+1].INT;MEM[P+1].INT:=V;S:=P;P:=MEM[P].HH.RH; PP:=MEM[P].HH.LH; IF ABS(V)=626349397 THEN IF WATCHCOEFS THEN BEGIN MEM[QQ].HH.B0:=0;FIXNEEDED:=TRUE;END; MEM[R].HH.RH:=S;R:=S;END;Q:=MEM[Q].HH.RH;QQ:=MEM[Q].HH.LH;END{:598} ELSE IF MEM[PP+1].INTT1 THEN SCALINGDOWN:=TRUE ELSE SCALINGDOWN:=NOT VISSCALED; IF T1=17 THEN THRESHOLD:=1342 ELSE THRESHOLD:=4;R:=65533; WHILE MEM[P].HH.LH<>0 DO BEGIN IF SCALINGDOWN THEN W:=TAKEFRACTION(V,MEM [P+1].INT)ELSE W:=TAKESCALED(V,MEM[P+1].INT); IF ABS(W)<=THRESHOLD THEN BEGIN S:=MEM[P].HH.RH;FREENODE(P,2);P:=S; END ELSE BEGIN IF ABS(W)>=626349397 THEN BEGIN FIXNEEDED:=TRUE; MEM[MEM[P].HH.LH].HH.B0:=0;END;MEM[R].HH.RH:=P;R:=P;MEM[P+1].INT:=W; P:=MEM[P].HH.RH;END;END;MEM[R].HH.RH:=P; IF VISSCALED THEN MEM[P+1].INT:=TAKESCALED(MEM[P+1].INT,V)ELSE MEM[P+1]. INT:=TAKEFRACTION(MEM[P+1].INT,V);PTIMESV:=MEM[65533].HH.RH;END;{:599} {601:}FUNCTION PWITHXBECOMI(P,X,Q:HALFWORD;T:SMALLNUMBER):HALFWORD; VAR R,S:HALFWORD;V:INTEGER;SX:INTEGER;BEGIN S:=P;R:=65533; SX:=MEM[X+1].INT;WHILE MEM[MEM[S].HH.LH+1].INT>SX DO BEGIN R:=S; S:=MEM[S].HH.RH;END; IF MEM[S].HH.LH<>X THEN PWITHXBECOMI:=P ELSE BEGIN MEM[65533].HH.RH:=P; MEM[R].HH.RH:=MEM[S].HH.RH;V:=MEM[S+1].INT;FREENODE(S,2); PWITHXBECOMI:=PPLUSFQ(MEM[65533].HH.RH,V,Q,T,17);END;END;{:601}{606:} PROCEDURE NEWDEP(Q,P:HALFWORD);VAR R:HALFWORD;BEGIN MEM[Q+1].HH.RH:=P; MEM[Q+1].HH.LH:=13;R:=MEM[13].HH.RH;MEM[DEPFINAL].HH.RH:=R; MEM[R+1].HH.LH:=DEPFINAL;MEM[13].HH.RH:=Q;END;{:606}{607:} FUNCTION CONSTDEPENDE(V:SCALED):HALFWORD;BEGIN DEPFINAL:=GETNODE(2); MEM[DEPFINAL+1].INT:=V;MEM[DEPFINAL].HH.LH:=0;CONSTDEPENDE:=DEPFINAL; END;{:607}{608:}FUNCTION SINGLEDEPEND(P:HALFWORD):HALFWORD; VAR Q:HALFWORD;M:INTEGER;BEGIN M:=MEM[P+1].INT MOD 64; IF M>28 THEN SINGLEDEPEND:=CONSTDEPENDE(0)ELSE BEGIN Q:=GETNODE(2); MEM[Q+1].INT:=TWOTOTHE[28-M];MEM[Q].HH.LH:=P; MEM[Q].HH.RH:=CONSTDEPENDE(0);SINGLEDEPEND:=Q;END;END;{:608}{609:} FUNCTION COPYDEPLIST(P:HALFWORD):HALFWORD;LABEL 30;VAR Q:HALFWORD; BEGIN Q:=GETNODE(2);DEPFINAL:=Q; WHILE TRUE DO BEGIN MEM[DEPFINAL].HH.LH:=MEM[P].HH.LH; MEM[DEPFINAL+1].INT:=MEM[P+1].INT;IF MEM[DEPFINAL].HH.LH=0 THEN GOTO 30; MEM[DEPFINAL].HH.RH:=GETNODE(2);DEPFINAL:=MEM[DEPFINAL].HH.RH; P:=MEM[P].HH.RH;END;30:COPYDEPLIST:=Q;END;{:609}{610:} PROCEDURE LINEAREQ(P:HALFWORD;T:SMALLNUMBER);VAR Q,R,S:HALFWORD; X:HALFWORD;N:INTEGER;V:INTEGER;PREVR:HALFWORD;FINALNODE:HALFWORD; W:INTEGER;BEGIN{611:}Q:=P;R:=MEM[P].HH.RH;V:=MEM[Q+1].INT; WHILE MEM[R].HH.LH<>0 DO BEGIN IF ABS(MEM[R+1].INT)>ABS(V)THEN BEGIN Q:= R;V:=MEM[R+1].INT;END;R:=MEM[R].HH.RH;END{:611};X:=MEM[Q].HH.LH; N:=MEM[X+1].INT MOD 64;{612:}S:=65533;MEM[S].HH.RH:=P;R:=P; REPEAT IF R=Q THEN BEGIN MEM[S].HH.RH:=MEM[R].HH.RH;FREENODE(R,2); END ELSE BEGIN W:=MAKEFRACTION(MEM[R+1].INT,V); IF ABS(W)<=1342 THEN BEGIN MEM[S].HH.RH:=MEM[R].HH.RH;FREENODE(R,2); END ELSE BEGIN MEM[R+1].INT:=-W;S:=R;END;END;R:=MEM[S].HH.RH; UNTIL MEM[R].HH.LH=0; IF T=18 THEN MEM[R+1].INT:=-MAKESCALED(MEM[R+1].INT,V)ELSE IF V<> -268435456 THEN MEM[R+1].INT:=-MAKEFRACTION(MEM[R+1].INT,V); FINALNODE:=R;P:=MEM[65533].HH.RH{:612};IF INTERNAL[2]>0 THEN{613:} IF INTERESTING(X)THEN BEGIN BEGINDIAGNOS;PRINTNL(595);PRINTVARIABL(X); W:=N;WHILE W>0 DO BEGIN PRINT(588);W:=W-2;END;PRINTCHAR(61); PRINTDEPENDE(P,17);ENDDIAGNOSTI(FALSE);END{:613};{614:}PREVR:=13; R:=MEM[13].HH.RH;WHILE R<>13 DO BEGIN S:=MEM[R+1].HH.RH; Q:=PWITHXBECOMI(S,X,P,MEM[R].HH.B0); IF MEM[Q].HH.LH=0 THEN MAKEKNOWN(R,Q)ELSE BEGIN MEM[R+1].HH.RH:=Q; REPEAT Q:=MEM[Q].HH.RH;UNTIL MEM[Q].HH.LH=0;PREVR:=Q;END; R:=MEM[PREVR].HH.RH;END{:614};{615:}IF N>0 THEN{616:}BEGIN S:=65533; MEM[65533].HH.RH:=P;R:=P; REPEAT IF N>30 THEN W:=0 ELSE W:=MEM[R+1].INT DIV TWOTOTHE[N]; IF(ABS(W)<=1342)AND(MEM[R].HH.LH<>0)THEN BEGIN MEM[S].HH.RH:=MEM[R].HH. RH;FREENODE(R,2);END ELSE BEGIN MEM[R+1].INT:=W;S:=R;END; R:=MEM[S].HH.RH;UNTIL MEM[S].HH.LH=0;P:=MEM[65533].HH.RH;END{:616}; IF MEM[P].HH.LH=0 THEN BEGIN MEM[X].HH.B0:=16; MEM[X+1].INT:=MEM[P+1].INT; IF ABS(MEM[X+1].INT)>=268435456 THEN VALTOOBIG(MEM[X+1].INT); FREENODE(P,2); IF CUREXP=X THEN IF CURTYPE=19 THEN BEGIN CUREXP:=MEM[X+1].INT; CURTYPE:=16;FREENODE(X,2);END;END ELSE BEGIN MEM[X].HH.B0:=17; DEPFINAL:=FINALNODE;NEWDEP(X,P); IF CUREXP=X THEN IF CURTYPE=19 THEN CURTYPE:=17;END{:615}; IF FIXNEEDED THEN FIXDEPENDENC;END;{:610}{619:} FUNCTION NEWRINGENTRY(P:HALFWORD):HALFWORD;VAR Q:HALFWORD; BEGIN Q:=GETNODE(2);MEM[Q].HH.B1:=11;MEM[Q].HH.B0:=MEM[P].HH.B0; IF MEM[P+1].INT=0 THEN MEM[Q+1].INT:=P ELSE MEM[Q+1].INT:=MEM[P+1].INT; MEM[P+1].INT:=Q;NEWRINGENTRY:=Q;END;{:619}{621:} PROCEDURE NONLINEAREQ(V:INTEGER;P:HALFWORD;FLUSHP:BOOLEAN); VAR T:SMALLNUMBER;Q,R:HALFWORD;BEGIN T:=MEM[P].HH.B0-1;Q:=MEM[P+1].INT; IF FLUSHP THEN MEM[P].HH.B0:=1 ELSE P:=Q;REPEAT R:=MEM[Q+1].INT; MEM[Q].HH.B0:=T;CASE T OF 2:MEM[Q+1].INT:=V;4:BEGIN MEM[Q+1].INT:=V; BEGIN IF STRREF[V]<127 THEN STRREF[V]:=STRREF[V]+1;END;END; 6:BEGIN MEM[Q+1].INT:=V;MEM[V].HH.LH:=MEM[V].HH.LH+1;END; 9:MEM[Q+1].INT:=COPYPATH(V);11:MEM[Q+1].INT:=COPYEDGES(V);END;Q:=R; UNTIL Q=P;END;{:621}{622:}PROCEDURE RINGMERGE(P,Q:HALFWORD);LABEL 10; VAR R:HALFWORD;BEGIN R:=MEM[P+1].INT; WHILE R<>P DO BEGIN IF R=Q THEN BEGIN{623:} BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(598);END;BEGIN HELPPTR:=2; HELPLINE[1]:=599;HELPLINE[0]:=600;END;PUTGETERROR;END{:623};GOTO 10;END; R:=MEM[R+1].INT;END;R:=MEM[P+1].INT;MEM[P+1].INT:=MEM[Q+1].INT; MEM[Q+1].INT:=R;10:END;{:622}{626:}PROCEDURE SHOWCMDMOD(C,M:INTEGER); BEGIN BEGINDIAGNOS;PRINTNL(123);PRINTCMDMOD(C,M);PRINTCHAR(125); ENDDIAGNOSTI(FALSE);END;{:626}{635:}PROCEDURE SHOWCONTEXT;LABEL 30; VAR OLDSETTING:0..6;{641:}I:0..BUFSIZE;L:INTEGER;M:INTEGER; N:0..ERRORLINE;P:INTEGER;Q:INTEGER;{:641}BEGIN FILEPTR:=INPUTPTR; INPUTSTACK[FILEPTR]:=CURINPUT;{1219:} IF DIAGQUAL THEN WRITELN(DIAGFILE,'!'); IF DIAGQUAL THEN WRITELN(DIAGFILE,' start diagnostic'){:1219}; WHILE TRUE DO BEGIN CURINPUT:=INPUTSTACK[FILEPTR];{636:} IF(FILEPTR=INPUTPTR)OR(CURINPUT.INDEXFIELD<=6)OR(CURINPUT.INDEXFIELD<>10 )OR(CURINPUT.LOCFIELD<>0)THEN BEGIN TALLY:=0;OLDSETTING:=SELECTOR; IF(CURINPUT.INDEXFIELD<=6)THEN BEGIN{637:} IF CURINPUT.NAMEFIELD<=1 THEN BEGIN{1221:} IF DIAGQUAL THEN WRITE(DIAGFILE,' region/text/label="'); COPYERR:=PRINTIT;LABELSIZE:=14{:1221}; IF(CURINPUT.NAMEFIELD=0)AND(FILEPTR=0)THEN PRINTNL(602)ELSE PRINTNL(603) ;{1222:}COPYERR:=IGNOREIT;IF DIAGQUAL THEN WRITE(DIAGFILE,'" "'){:1222}; END ELSE IF CURINPUT.NAMEFIELD=2 THEN BEGIN{1221:} IF DIAGQUAL THEN WRITE(DIAGFILE,' region/text/label="'); COPYERR:=PRINTIT;LABELSIZE:=14{:1221};PRINTNL(604);{1222:} COPYERR:=IGNOREIT;IF DIAGQUAL THEN WRITE(DIAGFILE,'" "'){:1222}; END ELSE BEGIN PRINTNL(605);PRINTINT(LINE);{1223:} IF DIAGQUAL THEN WRITE(DIAGFILE,' region/file/primary '); DIAGPRINT(CURINPUT.NAMEFIELD);IF DIAGQUAL THEN WRITELN(DIAGFILE,' -'); IF DIAGQUAL THEN WRITELN(DIAGFILE,' /line=',LINE:1, '/column_range=(1,65535)'){:1223};END;PRINTCHAR(32){:637};{644:} BEGIN L:=TALLY;TALLY:=0;SELECTOR:=4;TRICKCOUNT:=1000000;END; IF CURINPUT.LIMITFIELD>0 THEN FOR I:=CURINPUT.STARTFIELD TO CURINPUT. LIMITFIELD-1 DO BEGIN IF I=CURINPUT.LOCFIELD THEN BEGIN FIRSTCOUNT:= TALLY;TRICKCOUNT:=TALLY+1+ERRORLINE-HALFERRORLIN; IF TRICKCOUNT12 THEN SHOWTOKENLIS(CURINPUT.STARTFIELD, CURINPUT.LOCFIELD,100000,0)ELSE SHOWMACRO(CURINPUT.STARTFIELD,CURINPUT. LOCFIELD,100000);{1227:}BEGIN COPYERR:=PRINTIT;LABELSIZE:=-1 END{:1227} {:645};END;SELECTOR:=OLDSETTING;{643:} IF TRICKCOUNT=1000000 THEN BEGIN FIRSTCOUNT:=TALLY; TRICKCOUNT:=TALLY+1+ERRORLINE-HALFERRORLIN; IF TRICKCOUNTERRORLINE THEN PRINT(276);{1226:} IF COPYERR=PRINTIT THEN BEGIN IF DIAGQUAL THEN WRITE(DIAGFILE, '"/line=1/column_range=(');N:=N-L; IF DIAGQUAL THEN WRITELN(DIAGFILE,N+1:1,',65535)');COPYERR:=IGNOREIT; END ELSE IF DIAGQUAL THEN WRITELN(DIAGFILE,' region/nested/column=', CURINPUT.LOCFIELD-CURINPUT.STARTFIELD+1:1){:1226}{:643};END{:636}; IF(CURINPUT.INDEXFIELD<=6)THEN IF(CURINPUT.NAMEFIELD>2)OR(FILEPTR=0)THEN GOTO 30;FILEPTR:=FILEPTR-1;END;30:CURINPUT:=INPUTSTACK[INPUTPTR];{1220:} IF DIAGQUAL THEN WRITE(DIAGFILE,' message "%MF-E-MFERROR, '); WHILE NOT EOF(TEMPFILE)DO BEGIN IF DIAGQUAL THEN WRITE(DIAGFILE,TEMPFILE ^);GET(TEMPFILE)END;IF DIAGQUAL THEN WRITELN(DIAGFILE,'"'); IF DIAGQUAL THEN WRITELN(DIAGFILE,' end diagnostic'){:1220};END;{:635} {649:}PROCEDURE BEGINTOKENLI(P:HALFWORD;T:QUARTERWORD); BEGIN BEGIN IF INPUTPTR>MAXINSTACK THEN BEGIN MAXINSTACK:=INPUTPTR; IF INPUTPTR=STACKSIZE THEN OVERFLOW(613,STACKSIZE);END; INPUTSTACK[INPUTPTR]:=CURINPUT;INPUTPTR:=INPUTPTR+1;END; CURINPUT.STARTFIELD:=P;CURINPUT.INDEXFIELD:=T; CURINPUT.LIMITFIELD:=PARAMPTR;CURINPUT.LOCFIELD:=P;END;{:649}{650:} PROCEDURE ENDTOKENLIST;LABEL 30;VAR P:HALFWORD; BEGIN IF CURINPUT.INDEXFIELD>=10 THEN IF CURINPUT.INDEXFIELD<=11 THEN BEGIN FLUSHTOKENLI(CURINPUT.STARTFIELD);GOTO 30; END ELSE DELETEMACREF(CURINPUT.STARTFIELD); WHILE PARAMPTR>CURINPUT.LIMITFIELD DO BEGIN PARAMPTR:=PARAMPTR-1; P:=PARAMSTACK[PARAMPTR]; IF P<>0 THEN IF MEM[P].HH.RH=1 THEN BEGIN RECYCLEVALUE(P);FREENODE(P,2); END ELSE FLUSHTOKENLI(P);END;30:BEGIN INPUTPTR:=INPUTPTR-1; CURINPUT:=INPUTSTACK[INPUTPTR];END; BEGIN IF INTERRUPT<>0 THEN PAUSEFORINST;END;END;{:650}{651:}{855:}{856:} PROCEDURE ENCAPSULATE(P:HALFWORD);BEGIN CUREXP:=GETNODE(2); MEM[CUREXP].HH.B0:=CURTYPE;MEM[CUREXP].HH.B1:=11;NEWDEP(CUREXP,P);END; {:856}{858:}PROCEDURE INSTALL(R,Q:HALFWORD);VAR P:HALFWORD; BEGIN IF MEM[Q].HH.B0=16 THEN BEGIN MEM[R+1].INT:=MEM[Q+1].INT; MEM[R].HH.B0:=16; END ELSE IF MEM[Q].HH.B0=19 THEN BEGIN P:=SINGLEDEPEND(Q); IF P=DEPFINAL THEN BEGIN MEM[R].HH.B0:=16;MEM[R+1].INT:=0;FREENODE(P,2); END ELSE BEGIN MEM[R].HH.B0:=17;NEWDEP(R,P);END; END ELSE BEGIN MEM[R].HH.B0:=MEM[Q].HH.B0; NEWDEP(R,COPYDEPLIST(MEM[Q+1].HH.RH));END;END;{:858} PROCEDURE MAKEEXPCOPY(P:HALFWORD);LABEL 20;VAR Q,R,T:HALFWORD; BEGIN 20:CURTYPE:=MEM[P].HH.B0; CASE CURTYPE OF 1,2,16:CUREXP:=MEM[P+1].INT; 3,5,7,12,10:CUREXP:=NEWRINGENTRY(P);4:BEGIN CUREXP:=MEM[P+1].INT; BEGIN IF STRREF[CUREXP]<127 THEN STRREF[CUREXP]:=STRREF[CUREXP]+1;END; END;6:BEGIN CUREXP:=MEM[P+1].INT;MEM[CUREXP].HH.LH:=MEM[CUREXP].HH.LH+1; END;11:CUREXP:=COPYEDGES(MEM[P+1].INT); 9,8:CUREXP:=COPYPATH(MEM[P+1].INT);13,14:{857:} BEGIN IF MEM[P+1].INT=0 THEN INITBIGNODE(P);T:=GETNODE(2); MEM[T].HH.B1:=11;MEM[T].HH.B0:=CURTYPE;INITBIGNODE(T); Q:=MEM[P+1].INT+BIGNODESIZE[CURTYPE]; R:=MEM[T+1].INT+BIGNODESIZE[CURTYPE];REPEAT Q:=Q-2;R:=R-2;INSTALL(R,Q); UNTIL Q=MEM[P+1].INT;CUREXP:=T;END{:857}; 17,18:ENCAPSULATE(COPYDEPLIST(MEM[P+1].HH.RH)); 15:BEGIN BEGIN MEM[P].HH.B0:=19;SERIALNO:=SERIALNO+64; MEM[P+1].INT:=SERIALNO;END;GOTO 20;END;19:BEGIN Q:=SINGLEDEPEND(P); IF Q=DEPFINAL THEN BEGIN CURTYPE:=16;CUREXP:=0;FREENODE(Q,2); END ELSE BEGIN CURTYPE:=17;ENCAPSULATE(Q);END;END; OTHERWISE CONFUSION(798)END;END;{:855}FUNCTION CURTOK:HALFWORD; VAR P:HALFWORD;SAVETYPE:SMALLNUMBER;SAVEEXP:INTEGER; BEGIN IF CURSYM=0 THEN IF CURCMD=38 THEN BEGIN SAVETYPE:=CURTYPE; SAVEEXP:=CUREXP;MAKEEXPCOPY(CURMOD);P:=STASHCUREXP;MEM[P].HH.RH:=0; CURTYPE:=SAVETYPE;CUREXP:=SAVEEXP;END ELSE BEGIN P:=GETNODE(2); MEM[P+1].INT:=CURMOD;MEM[P].HH.B1:=12; IF CURCMD=42 THEN MEM[P].HH.B0:=16 ELSE MEM[P].HH.B0:=4; END ELSE BEGIN BEGIN P:=AVAIL; IF P=0 THEN P:=GETAVAIL ELSE BEGIN AVAIL:=MEM[P].HH.RH;MEM[P].HH.RH:=0; DYNUSED:=DYNUSED+1;END;END;MEM[P].HH.LH:=CURSYM;END;CURTOK:=P;END;{:651} {652:}PROCEDURE BACKINPUT;VAR P:HALFWORD;BEGIN P:=CURTOK; WHILE(CURINPUT.INDEXFIELD>6)AND(CURINPUT.LOCFIELD=0)DO ENDTOKENLIST; BEGINTOKENLI(P,10);END;{:652}{653:}PROCEDURE BACKERROR; BEGIN OKTOINTERRUP:=FALSE;BACKINPUT;OKTOINTERRUP:=TRUE;ERROR;END; PROCEDURE INSERROR;BEGIN OKTOINTERRUP:=FALSE;BACKINPUT; CURINPUT.INDEXFIELD:=11;OKTOINTERRUP:=TRUE;ERROR;END;{:653}{654:} PROCEDURE BEGINFILEREA;BEGIN IF INOPEN=6 THEN OVERFLOW(614,6); IF FIRST=BUFSIZE THEN OVERFLOW(256,BUFSIZE);INOPEN:=INOPEN+1; BEGIN IF INPUTPTR>MAXINSTACK THEN BEGIN MAXINSTACK:=INPUTPTR; IF INPUTPTR=STACKSIZE THEN OVERFLOW(613,STACKSIZE);END; INPUTSTACK[INPUTPTR]:=CURINPUT;INPUTPTR:=INPUTPTR+1;END; CURINPUT.INDEXFIELD:=INOPEN;LINESTACK[CURINPUT.INDEXFIELD]:=LINE; CURINPUT.STARTFIELD:=FIRST;CURINPUT.NAMEFIELD:=0;END;{:654}{655:} PROCEDURE ENDFILEREADI;BEGIN FIRST:=CURINPUT.STARTFIELD; LINE:=LINESTACK[CURINPUT.INDEXFIELD]; IF CURINPUT.INDEXFIELD<>INOPEN THEN CONFUSION(615); IF CURINPUT.NAMEFIELD>2 THEN ACLOSE(INPUTFILE[CURINPUT.INDEXFIELD]); BEGIN INPUTPTR:=INPUTPTR-1;CURINPUT:=INPUTSTACK[INPUTPTR];END; INOPEN:=INOPEN-1;END;{:655}{656:}PROCEDURE CLEARFORERRO; BEGIN WHILE(CURINPUT.INDEXFIELD<=6)AND(CURINPUT.NAMEFIELD=0)AND(INPUTPTR >0)AND(CURINPUT.LOCFIELD=CURINPUT.LIMITFIELD)DO ENDFILEREADI;PRINTLN; INRAB^.RAB$V_PTA:=TRUE;END;{:656}{661:}FUNCTION CHECKOUTERVA:BOOLEAN; VAR P:HALFWORD; BEGIN IF SCANNERSTATU=0 THEN CHECKOUTERVA:=TRUE ELSE BEGIN DELETIONSALL :=FALSE;{662:}IF CURSYM<>0 THEN BEGIN P:=GETAVAIL;MEM[P].HH.LH:=CURSYM; BEGINTOKENLI(P,10);END{:662};IF SCANNERSTATU>1 THEN{663:}BEGIN RUNAWAY; IF CURSYM=0 THEN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(621); END ELSE BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(622);END;END;PRINT(623); BEGIN HELPPTR:=4;HELPLINE[3]:=624;HELPLINE[2]:=625;HELPLINE[1]:=626; HELPLINE[0]:=627;END;CASE SCANNERSTATU OF{664:}2:BEGIN PRINT(628); HELPLINE[3]:=629;CURSYM:=2363;END;3:BEGIN PRINT(630);HELPLINE[3]:=631; IF WARNINGINFO=0 THEN CURSYM:=2367 ELSE BEGIN CURSYM:=2359; EQTB[2359].RH:=WARNINGINFO;END;END;4,5:BEGIN PRINT(632); IF SCANNERSTATU=5 THEN PRINT(HASH[WARNINGINFO].RH)ELSE PRINTVARIABL( WARNINGINFO);CURSYM:=2365;END;6:BEGIN PRINT(633); PRINT(HASH[WARNINGINFO].RH);PRINT(634);HELPLINE[3]:=635;CURSYM:=2364; END;{:664}END;INSERROR;END{:663} ELSE BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(616);END;PRINTINT(WARNINGINFO); BEGIN HELPPTR:=3;HELPLINE[2]:=617;HELPLINE[1]:=618;HELPLINE[0]:=619;END; IF CURSYM=0 THEN HELPLINE[2]:=620;CURSYM:=2366;INSERROR;END; DELETIONSALL:=TRUE;CHECKOUTERVA:=FALSE;END;END;{:661}{666:} PROCEDURE FIRMUPTHELIN;FORWARD;{:666}{667:}PROCEDURE GETNEXT; LABEL 20,10,40,25,85,86,87,30;VAR K:0..BUFSIZE;C:ASCIICODE; CLASS:ASCIICODE;N,F:INTEGER;BEGIN 20:CURSYM:=0; IF(CURINPUT.INDEXFIELD<=6)THEN{669:} BEGIN 25:C:=BUFFER[CURINPUT.LOCFIELD]; CURINPUT.LOCFIELD:=CURINPUT.LOCFIELD+1;CLASS:=CHARCLASS[C]; CASE CLASS OF 0:GOTO 85; 1:BEGIN CLASS:=CHARCLASS[BUFFER[CURINPUT.LOCFIELD]]; IF CLASS>1 THEN GOTO 25 ELSE IF CLASS<1 THEN BEGIN N:=0;GOTO 86;END;END; 2:GOTO 25;3:BEGIN{679:}IF CURINPUT.NAMEFIELD>2 THEN{681:} BEGIN LINE:=LINE+1;FIRST:=CURINPUT.STARTFIELD; IF NOT FORCEEOF THEN BEGIN IF INPUTLN(INPUTFILE[CURINPUT.INDEXFIELD], TRUE)THEN FIRMUPTHELIN ELSE FORCEEOF:=TRUE;END; IF FORCEEOF THEN BEGIN PRINTCHAR(41);OPENPARENS:=OPENPARENS-1; IF ODD(SELECTOR)THEN WRITELN(TERMOUT);FORCEEOF:=FALSE;ENDFILEREADI; IF CHECKOUTERVA THEN GOTO 20 ELSE GOTO 20;END; BUFFER[CURINPUT.LIMITFIELD]:=37;FIRST:=CURINPUT.LIMITFIELD+1; CURINPUT.LOCFIELD:=CURINPUT.STARTFIELD;END{:681} ELSE BEGIN IF INPUTPTR>0 THEN BEGIN ENDFILEREADI;GOTO 20;END; IF SELECTOR<2 THEN OPENLOGFILE; IF INTERACTION>1 THEN BEGIN IF CURINPUT.LIMITFIELD=CURINPUT.STARTFIELD THEN PRINTNL(650);PRINTLN;FIRST:=CURINPUT.STARTFIELD;BEGIN WAKEUPTERMIN; PRINT(42);TERMINPUT;END;CURINPUT.LIMITFIELD:=LAST; BUFFER[CURINPUT.LIMITFIELD]:=37;FIRST:=CURINPUT.LIMITFIELD+1; CURINPUT.LOCFIELD:=CURINPUT.STARTFIELD;END ELSE FATALERROR(651); END{:679};BEGIN IF INTERRUPT<>0 THEN PAUSEFORINST;END;GOTO 25;END; 4:{671:} BEGIN IF BUFFER[CURINPUT.LOCFIELD]=34 THEN CURMOD:=285 ELSE BEGIN K:= CURINPUT.LOCFIELD;BUFFER[CURINPUT.LIMITFIELD+1]:=34; REPEAT CURINPUT.LOCFIELD:=CURINPUT.LOCFIELD+1; UNTIL BUFFER[CURINPUT.LOCFIELD]=34; IF CURINPUT.LOCFIELD>CURINPUT.LIMITFIELD THEN{672:} BEGIN CURINPUT.LOCFIELD:=CURINPUT.LIMITFIELD; BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT; REWRITE(TEMPFILE);PRINT(643);END;BEGIN HELPPTR:=3;HELPLINE[2]:=644; HELPLINE[1]:=645;HELPLINE[0]:=646;END;DELETIONSALL:=FALSE;ERROR; DELETIONSALL:=TRUE;GOTO 20;END{:672}; IF CURINPUT.LOCFIELD=K+1 THEN CURMOD:=BUFFER[K]ELSE BEGIN BEGIN IF POOLPTR+CURINPUT.LOCFIELD-K>MAXPOOLPTR THEN BEGIN IF POOLPTR+CURINPUT. LOCFIELD-K>POOLSIZE THEN OVERFLOW(257,POOLSIZE-INITPOOLPTR); MAXPOOLPTR:=POOLPTR+CURINPUT.LOCFIELD-K;END;END; REPEAT BEGIN STRPOOL[POOLPTR]:=BUFFER[K];POOLPTR:=POOLPTR+1;END;K:=K+1; UNTIL K=CURINPUT.LOCFIELD;CURMOD:=MAKESTRING;END;END; CURINPUT.LOCFIELD:=CURINPUT.LOCFIELD+1;CURCMD:=39;GOTO 10;END{:671}; 5,6,7,8:BEGIN K:=CURINPUT.LOCFIELD-1;GOTO 40;END;20:{670:} BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(640);END;BEGIN HELPPTR:=2; HELPLINE[1]:=641;HELPLINE[0]:=642;END;DELETIONSALL:=FALSE;ERROR; DELETIONSALL:=TRUE;GOTO 20;END{:670};OTHERWISE END; K:=CURINPUT.LOCFIELD-1; WHILE CHARCLASS[BUFFER[CURINPUT.LOCFIELD]]=CLASS DO CURINPUT.LOCFIELD:= CURINPUT.LOCFIELD+1;GOTO 40;85:{673:}N:=C-48; WHILE CHARCLASS[BUFFER[CURINPUT.LOCFIELD]]=0 DO BEGIN IF N<4096 THEN N:= 10*N+BUFFER[CURINPUT.LOCFIELD]-48; CURINPUT.LOCFIELD:=CURINPUT.LOCFIELD+1;END; IF BUFFER[CURINPUT.LOCFIELD]=46 THEN IF CHARCLASS[BUFFER[CURINPUT. LOCFIELD+1]]=0 THEN GOTO 30;F:=0;GOTO 87; 30:CURINPUT.LOCFIELD:=CURINPUT.LOCFIELD+1{:673};86:{674:}K:=0; REPEAT IF K<17 THEN BEGIN DIG[K]:=BUFFER[CURINPUT.LOCFIELD]-48;K:=K+1; END;CURINPUT.LOCFIELD:=CURINPUT.LOCFIELD+1; UNTIL CHARCLASS[BUFFER[CURINPUT.LOCFIELD]]<>0;F:=ROUNDDECIMAL(K); IF F=65536 THEN BEGIN N:=N+1;F:=0;END{:674};87:{675:} IF N<4096 THEN CURMOD:=N*65536+F ELSE BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(647); END;BEGIN HELPPTR:=2;HELPLINE[1]:=648;HELPLINE[0]:=649;END; DELETIONSALL:=FALSE;ERROR;DELETIONSALL:=TRUE;CURMOD:=268435455;END; CURCMD:=42;GOTO 10{:675};40:CURSYM:=IDLOOKUP(K,CURINPUT.LOCFIELD-K); END{:669}ELSE{676:} IF CURINPUT.LOCFIELD>=HIMEMMIN THEN BEGIN CURSYM:=MEM[CURINPUT.LOCFIELD] .HH.LH;CURINPUT.LOCFIELD:=MEM[CURINPUT.LOCFIELD].HH.RH; IF CURSYM>=2370 THEN IF CURSYM>=2520 THEN{677:} BEGIN IF CURSYM>=2670 THEN CURSYM:=CURSYM-150; BEGINTOKENLI(PARAMSTACK[CURINPUT.LIMITFIELD+CURSYM-(2520)],9);GOTO 20; END{:677}ELSE BEGIN CURCMD:=38; CURMOD:=PARAMSTACK[CURINPUT.LIMITFIELD+CURSYM-(2370)];CURSYM:=0;GOTO 10; END;END ELSE IF CURINPUT.LOCFIELD>0 THEN{678:} BEGIN IF MEM[CURINPUT.LOCFIELD].HH.B1=12 THEN BEGIN CURMOD:=MEM[CURINPUT .LOCFIELD+1].INT; IF MEM[CURINPUT.LOCFIELD].HH.B0=16 THEN CURCMD:=42 ELSE BEGIN CURCMD:=39 ;BEGIN IF STRREF[CURMOD]<127 THEN STRREF[CURMOD]:=STRREF[CURMOD]+1;END; END;END ELSE BEGIN CURMOD:=CURINPUT.LOCFIELD;CURCMD:=38;END; CURINPUT.LOCFIELD:=MEM[CURINPUT.LOCFIELD].HH.RH;GOTO 10;END{:678} ELSE BEGIN ENDTOKENLIST;GOTO 20;END{:676};{668:}CURCMD:=EQTB[CURSYM].LH; CURMOD:=EQTB[CURSYM].RH; IF CURCMD>=86 THEN IF CHECKOUTERVA THEN CURCMD:=CURCMD-86 ELSE GOTO 20{: 668};10:END;{:667}{682:}PROCEDURE FIRMUPTHELIN;VAR K:0..BUFSIZE; BEGIN CURINPUT.LIMITFIELD:=LAST; IF INTERNAL[31]>0 THEN IF INTERACTION>1 THEN BEGIN WAKEUPTERMIN;PRINTLN; IF CURINPUT.STARTFIELDFIRST THEN BEGIN FOR K:=FIRST TO LAST-1 DO BUFFER[K+CURINPUT. STARTFIELD-FIRST]:=BUFFER[K]; CURINPUT.LIMITFIELD:=CURINPUT.STARTFIELD+LAST-FIRST;END;END;END;{:682} {685:}FUNCTION SCANTOKS(TERMINATOR:COMMANDCODE; SUBSTLIST,TAILEND:HALFWORD;SUFFIXCOUNT:SMALLNUMBER):HALFWORD; LABEL 30,40;VAR P:HALFWORD;Q:HALFWORD;BALANCE:INTEGER;BEGIN P:=65532; BALANCE:=1;MEM[65532].HH.RH:=0;WHILE TRUE DO BEGIN GETNEXT; IF CURSYM>0 THEN BEGIN{686:}BEGIN Q:=SUBSTLIST; WHILE Q<>0 DO BEGIN IF MEM[Q].HH.LH=CURSYM THEN BEGIN CURSYM:=MEM[Q+1]. INT;CURCMD:=7;GOTO 40;END;Q:=MEM[Q].HH.RH;END;40:END{:686}; IF CURCMD=TERMINATOR THEN{687:} IF CURMOD>0 THEN BALANCE:=BALANCE+1 ELSE BEGIN BALANCE:=BALANCE-1; IF BALANCE=0 THEN GOTO 30;END{:687}ELSE IF CURCMD=61 THEN{690:} BEGIN IF CURMOD=0 THEN GETNEXT ELSE IF CURMOD<=SUFFIXCOUNT THEN CURSYM:= 2519+CURMOD;END{:690};END;MEM[P].HH.RH:=CURTOK;P:=MEM[P].HH.RH;END; 30:MEM[P].HH.RH:=TAILEND;FLUSHNODELIS(SUBSTLIST); SCANTOKS:=MEM[65532].HH.RH;END;{:685}{691:}PROCEDURE GETSYMBOL;LABEL 20; BEGIN 20:GETNEXT; IF(CURSYM=0)OR(CURSYM>2357)THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(664); END;BEGIN HELPPTR:=3;HELPLINE[2]:=665;HELPLINE[1]:=666;HELPLINE[0]:=667; END; IF CURSYM>0 THEN HELPLINE[2]:=668 ELSE IF CURCMD=39 THEN BEGIN IF STRREF [CURMOD]<127 THEN IF STRREF[CURMOD]>1 THEN STRREF[CURMOD]:=STRREF[CURMOD ]-1 ELSE FLUSHSTRING(CURMOD);END;CURSYM:=2357;INSERROR;GOTO 20;END;END; {:691}{692:}PROCEDURE GETCLEARSYMB;BEGIN GETSYMBOL; CLEARSYMBOL(CURSYM,FALSE);END;{:692}{693:}PROCEDURE CHECKEQUALS; BEGIN IF CURCMD<>51 THEN IF CURCMD<>77 THEN BEGIN MISSINGERR(61); BEGIN HELPPTR:=5;HELPLINE[4]:=669;HELPLINE[3]:=670;HELPLINE[2]:=671; HELPLINE[1]:=672;HELPLINE[0]:=673;END;BACKERROR;END;END;{:693}{694:} PROCEDURE MAKEOPDEF;VAR M:COMMANDCODE;P,Q,R:HALFWORD;BEGIN M:=CURMOD; GETSYMBOL;Q:=GETNODE(2);MEM[Q].HH.LH:=CURSYM;MEM[Q+1].INT:=2370; GETCLEARSYMB;WARNINGINFO:=CURSYM;GETSYMBOL;P:=GETNODE(2); MEM[P].HH.LH:=CURSYM;MEM[P+1].INT:=2371;MEM[P].HH.RH:=Q;GETNEXT; CHECKEQUALS;SCANNERSTATU:=5;Q:=GETAVAIL;MEM[Q].HH.LH:=0;R:=GETAVAIL; MEM[Q].HH.RH:=R;MEM[R].HH.LH:=0;MEM[R].HH.RH:=SCANTOKS(16,P,0,0); SCANNERSTATU:=0;EQTB[WARNINGINFO].LH:=M;EQTB[WARNINGINFO].RH:=Q; GETXNEXT;END;{:694}{697:}{1032:} PROCEDURE CHECKDELIMIT(LDELIM,RDELIM:HALFWORD);LABEL 10; BEGIN IF CURCMD=62 THEN IF CURMOD=LDELIM THEN GOTO 10; IF CURSYM<>RDELIM THEN BEGIN MISSINGERR(HASH[RDELIM].RH); BEGIN HELPPTR:=2;HELPLINE[1]:=920;HELPLINE[0]:=921;END;BACKERROR; END ELSE BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(922);END;PRINT(HASH[RDELIM].RH); PRINT(923);BEGIN HELPPTR:=3;HELPLINE[2]:=924;HELPLINE[1]:=925; HELPLINE[0]:=926;END;ERROR;END;10:END;{:1032}{1011:} FUNCTION SCANDECLARED:HALFWORD;LABEL 30;VAR X:HALFWORD;H,T:HALFWORD; L:HALFWORD;BEGIN GETSYMBOL;X:=CURSYM; IF CURCMD<>41 THEN CLEARSYMBOL(X,FALSE);H:=GETAVAIL;MEM[H].HH.LH:=X; T:=H;WHILE TRUE DO BEGIN GETXNEXT;IF CURSYM=0 THEN GOTO 30; IF CURCMD<>41 THEN IF CURCMD<>40 THEN IF CURCMD=63 THEN{1012:} BEGIN L:=CURSYM;GETXNEXT;IF CURCMD<>64 THEN BEGIN BACKINPUT;CURSYM:=L; CURCMD:=63;GOTO 30;END ELSE CURSYM:=0;END{:1012}ELSE GOTO 30; MEM[T].HH.RH:=GETAVAIL;T:=MEM[T].HH.RH;MEM[T].HH.LH:=CURSYM;END; 30:IF EQTB[X].LH<>41 THEN CLEARSYMBOL(X,FALSE); IF EQTB[X].RH=0 THEN NEWROOT(X);SCANDECLARED:=H;END;{:1011} PROCEDURE SCANDEF;VAR M:1..2;N:0..3;K:0..150;C:0..7;R:HALFWORD; Q:HALFWORD;P:HALFWORD;BASE:HALFWORD;LDELIM,RDELIM:HALFWORD; BEGIN M:=CURMOD;C:=0;MEM[65532].HH.RH:=0;Q:=GETAVAIL;MEM[Q].HH.LH:=0; R:=0;{700:}IF M=1 THEN BEGIN GETCLEARSYMB;WARNINGINFO:=CURSYM;GETNEXT; SCANNERSTATU:=5;N:=0;EQTB[WARNINGINFO].LH:=10;EQTB[WARNINGINFO].RH:=Q; END ELSE BEGIN P:=SCANDECLARED; FLUSHVARIABL(EQTB[MEM[P].HH.LH].RH,MEM[P].HH.RH,TRUE); WARNINGINFO:=FINDVARIABLE(P);FLUSHLIST(P);IF WARNINGINFO=0 THEN{701:} BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(680);END;BEGIN HELPPTR:=2; HELPLINE[1]:=681;HELPLINE[0]:=682;END;ERROR;WARNINGINFO:=21;END{:701}; SCANNERSTATU:=4;N:=2;IF CURCMD=61 THEN IF CURMOD=3 THEN BEGIN N:=3; GETNEXT;END;MEM[WARNINGINFO].HH.B0:=20+N;MEM[WARNINGINFO+1].INT:=Q; END{:700};K:=N;IF CURCMD=31 THEN{703:}REPEAT LDELIM:=CURSYM; RDELIM:=CURMOD;GETNEXT; IF(CURCMD=56)AND(CURMOD>=2370)THEN BASE:=CURMOD ELSE BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT; REWRITE(TEMPFILE);PRINT(683);END;BEGIN HELPPTR:=1;HELPLINE[0]:=684;END; BACKERROR;BASE:=2370;END;{704:}REPEAT MEM[Q].HH.RH:=GETAVAIL; Q:=MEM[Q].HH.RH;MEM[Q].HH.LH:=BASE+K;GETSYMBOL;P:=GETNODE(2); MEM[P+1].INT:=BASE+K;MEM[P].HH.LH:=CURSYM; IF K=150 THEN OVERFLOW(685,150);K:=K+1;MEM[P].HH.RH:=R;R:=P;GETNEXT; UNTIL CURCMD<>82{:704};CHECKDELIMIT(LDELIM,RDELIM);GETNEXT; UNTIL CURCMD<>31{:703};IF CURCMD=56 THEN{705:}BEGIN P:=GETNODE(2); IF CURMOD<2370 THEN BEGIN C:=CURMOD;MEM[P+1].INT:=2370+K; END ELSE BEGIN MEM[P+1].INT:=CURMOD+K; IF CURMOD=2370 THEN C:=4 ELSE IF CURMOD=2520 THEN C:=6 ELSE C:=7;END; IF K=150 THEN OVERFLOW(685,150);K:=K+1;GETSYMBOL;MEM[P].HH.LH:=CURSYM; MEM[P].HH.RH:=R;R:=P;GETNEXT;IF C=4 THEN IF CURCMD=69 THEN BEGIN C:=5; P:=GETNODE(2);IF K=150 THEN OVERFLOW(685,150);MEM[P+1].INT:=2370+K; GETSYMBOL;MEM[P].HH.LH:=CURSYM;MEM[P].HH.RH:=R;R:=P;GETNEXT;END; END{:705};CHECKEQUALS;P:=GETAVAIL;MEM[P].HH.LH:=C;MEM[Q].HH.RH:=P;{698:} IF M=1 THEN MEM[P].HH.RH:=SCANTOKS(16,R,0,N)ELSE BEGIN Q:=GETAVAIL; MEM[Q].HH.LH:=BGLOC;MEM[P].HH.RH:=Q;P:=GETAVAIL;MEM[P].HH.LH:=EGLOC; MEM[Q].HH.RH:=SCANTOKS(16,R,P,N);END; IF WARNINGINFO=21 THEN FLUSHTOKENLI(MEM[22].INT){:698};SCANNERSTATU:=0; GETXNEXT;END;{:697}{706:}PROCEDURE SCANPRIMARY;FORWARD; PROCEDURE SCANSECONDAR;FORWARD;PROCEDURE SCANTERTIARY;FORWARD; PROCEDURE SCANEXPRESSI;FORWARD;PROCEDURE SCANSUFFIX;FORWARD;{720:}{722:} PROCEDURE PRINTMACRONA(A,N:HALFWORD);VAR P,Q:HALFWORD; BEGIN IF N<>0 THEN PRINT(HASH[N].RH)ELSE BEGIN P:=MEM[A].HH.LH; IF P=0 THEN PRINT(HASH[MEM[MEM[MEM[A].HH.RH].HH.LH].HH.LH].RH)ELSE BEGIN Q:=P;WHILE MEM[Q].HH.RH<>0 DO Q:=MEM[Q].HH.RH; MEM[Q].HH.RH:=MEM[MEM[A].HH.RH].HH.LH;SHOWTOKENLIS(P,0,1000,0); MEM[Q].HH.RH:=0;END;END;END;{:722}{723:}PROCEDURE PRINTARG(Q:HALFWORD; N:INTEGER;B:HALFWORD); BEGIN IF MEM[Q].HH.RH=1 THEN PRINTNL(498)ELSE IF(B<2670)AND(B<>7)THEN PRINTNL(499)ELSE PRINTNL(500);PRINTINT(N);PRINT(701); IF MEM[Q].HH.RH=1 THEN PRINTEXP(Q,1)ELSE SHOWTOKENLIS(Q,0,1000,0);END; {:723}{730:}PROCEDURE SCANTEXTARG(LDELIM,RDELIM:HALFWORD);LABEL 30; VAR BALANCE:INTEGER;P:HALFWORD;BEGIN WARNINGINFO:=LDELIM; SCANNERSTATU:=3;P:=65532;BALANCE:=1;MEM[65532].HH.RH:=0; WHILE TRUE DO BEGIN GETNEXT;IF LDELIM=0 THEN{732:} BEGIN IF CURCMD>82 THEN BEGIN IF BALANCE=1 THEN GOTO 30 ELSE IF CURCMD= 84 THEN BALANCE:=BALANCE-1; END ELSE IF CURCMD=32 THEN BALANCE:=BALANCE+1;END{:732}ELSE{731:} BEGIN IF CURCMD=62 THEN BEGIN IF CURMOD=LDELIM THEN BEGIN BALANCE:= BALANCE-1;IF BALANCE=0 THEN GOTO 30;END; END ELSE IF CURCMD=31 THEN IF CURMOD=RDELIM THEN BALANCE:=BALANCE+1; END{:731};MEM[P].HH.RH:=CURTOK;P:=MEM[P].HH.RH;END; 30:CUREXP:=MEM[65532].HH.RH;CURTYPE:=20;SCANNERSTATU:=0;END;{:730} PROCEDURE MACROCALL(DEFREF,ARGLIST,MACRONAME:HALFWORD);LABEL 40; VAR R:HALFWORD;P,Q:HALFWORD;N:INTEGER;LDELIM,RDELIM:HALFWORD; TAIL:HALFWORD;BEGIN R:=MEM[DEFREF].HH.RH; MEM[DEFREF].HH.LH:=MEM[DEFREF].HH.LH+1;IF ARGLIST=0 THEN N:=0 ELSE{724:} BEGIN N:=1;TAIL:=ARGLIST;WHILE MEM[TAIL].HH.RH<>0 DO BEGIN N:=N+1; TAIL:=MEM[TAIL].HH.RH;END;END{:724};IF INTERNAL[9]>0 THEN{721:} BEGIN BEGINDIAGNOS;PRINTLN;PRINTMACRONA(ARGLIST,MACRONAME); IF N=3 THEN PRINT(663);SHOWMACRO(DEFREF,0,100000); IF ARGLIST<>0 THEN BEGIN N:=0;P:=ARGLIST;REPEAT Q:=MEM[P].HH.LH; PRINTARG(Q,N,0);N:=N+1;P:=MEM[P].HH.RH;UNTIL P=0;END; ENDDIAGNOSTI(FALSE);END{:721};{725:}CURCMD:=83; WHILE MEM[R].HH.LH>=2370 DO BEGIN{726:} IF CURCMD<>82 THEN BEGIN GETXNEXT; IF CURCMD<>31 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(707);END; PRINTMACRONA(ARGLIST,MACRONAME);BEGIN HELPPTR:=3;HELPLINE[2]:=708; HELPLINE[1]:=709;HELPLINE[0]:=710;END; IF MEM[R].HH.LH>=2520 THEN BEGIN CUREXP:=0;CURTYPE:=20; END ELSE BEGIN CUREXP:=0;CURTYPE:=16;END;BACKERROR;CURCMD:=62;GOTO 40; END;LDELIM:=CURSYM;RDELIM:=CURMOD;END;{729:} IF MEM[R].HH.LH>=2670 THEN SCANTEXTARG(LDELIM,RDELIM)ELSE BEGIN GETXNEXT ;IF MEM[R].HH.LH>=2520 THEN SCANSUFFIX ELSE SCANEXPRESSI;END{:729}; IF CURCMD<>82 THEN{727:} IF(CURCMD<>62)OR(CURMOD<>LDELIM)THEN IF MEM[MEM[R].HH.RH].HH.LH>=2370 THEN BEGIN MISSINGERR(44);BEGIN HELPPTR:=3;HELPLINE[2]:=711; HELPLINE[1]:=712;HELPLINE[0]:=706;END;BACKERROR;CURCMD:=82; END ELSE BEGIN MISSINGERR(HASH[RDELIM].RH);BEGIN HELPPTR:=2; HELPLINE[1]:=713;HELPLINE[0]:=706;END;BACKERROR;END{:727};40:{728:} BEGIN P:=GETAVAIL; IF CURTYPE=20 THEN MEM[P].HH.LH:=CUREXP ELSE MEM[P].HH.LH:=STASHCUREXP; IF INTERNAL[9]>0 THEN BEGIN BEGINDIAGNOS; PRINTARG(MEM[P].HH.LH,N,MEM[R].HH.LH);ENDDIAGNOSTI(FALSE);END; IF ARGLIST=0 THEN ARGLIST:=P ELSE MEM[TAIL].HH.RH:=P;TAIL:=P;N:=N+1; END{:728}{:726};R:=MEM[R].HH.RH;END; IF CURCMD=82 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(702);END; PRINTMACRONA(ARGLIST,MACRONAME);PRINTCHAR(59);PRINTNL(703); PRINT(HASH[RDELIM].RH);PRINT(300);BEGIN HELPPTR:=3;HELPLINE[2]:=704; HELPLINE[1]:=705;HELPLINE[0]:=706;END;ERROR;END; IF MEM[R].HH.LH<>0 THEN{733:} BEGIN IF MEM[R].HH.LH<7 THEN BEGIN GETXNEXT; IF MEM[R].HH.LH<>6 THEN IF(CURCMD=51)OR(CURCMD=77)THEN GETXNEXT;END; CASE MEM[R].HH.LH OF 1:SCANPRIMARY;2:SCANSECONDAR;3:SCANTERTIARY; 4:SCANEXPRESSI;5:{734:}BEGIN SCANEXPRESSI;P:=GETAVAIL; MEM[P].HH.LH:=STASHCUREXP;IF INTERNAL[9]>0 THEN BEGIN BEGINDIAGNOS; PRINTARG(MEM[P].HH.LH,N,0);ENDDIAGNOSTI(FALSE);END; IF ARGLIST=0 THEN ARGLIST:=P ELSE MEM[TAIL].HH.RH:=P;TAIL:=P;N:=N+1; IF CURCMD<>69 THEN BEGIN MISSINGERR(479);PRINT(714); PRINTMACRONA(ARGLIST,MACRONAME);BEGIN HELPPTR:=1;HELPLINE[0]:=715;END; BACKERROR;END;GETXNEXT;SCANPRIMARY;END{:734};6:{735:} BEGIN IF CURCMD<>31 THEN LDELIM:=0 ELSE BEGIN LDELIM:=CURSYM; RDELIM:=CURMOD;GETXNEXT;END;SCANSUFFIX; IF LDELIM<>0 THEN BEGIN IF(CURCMD<>62)OR(CURMOD<>LDELIM)THEN BEGIN MISSINGERR(HASH[RDELIM].RH);BEGIN HELPPTR:=2;HELPLINE[1]:=713; HELPLINE[0]:=706;END;BACKERROR;END;GETXNEXT;END;END{:735}; 7:SCANTEXTARG(0,0);END;BACKINPUT;{728:}BEGIN P:=GETAVAIL; IF CURTYPE=20 THEN MEM[P].HH.LH:=CUREXP ELSE MEM[P].HH.LH:=STASHCUREXP; IF INTERNAL[9]>0 THEN BEGIN BEGINDIAGNOS; PRINTARG(MEM[P].HH.LH,N,MEM[R].HH.LH);ENDDIAGNOSTI(FALSE);END; IF ARGLIST=0 THEN ARGLIST:=P ELSE MEM[TAIL].HH.RH:=P;TAIL:=P;N:=N+1; END{:728};END{:733};R:=MEM[R].HH.RH{:725};{736:} WHILE(CURINPUT.INDEXFIELD>6)AND(CURINPUT.LOCFIELD=0)DO ENDTOKENLIST; IF PARAMPTR+N>MAXPARAMSTAC THEN BEGIN MAXPARAMSTAC:=PARAMPTR+N; IF MAXPARAMSTAC>150 THEN OVERFLOW(685,150);END;BEGINTOKENLI(DEFREF,12); CURINPUT.NAMEFIELD:=MACRONAME;CURINPUT.LOCFIELD:=R; IF N>0 THEN BEGIN P:=ARGLIST;REPEAT PARAMSTACK[PARAMPTR]:=MEM[P].HH.LH; PARAMPTR:=PARAMPTR+1;P:=MEM[P].HH.RH;UNTIL P=0;FLUSHLIST(ARGLIST); END{:736};END;{:720}PROCEDURE GETBOOLEAN;FORWARD;PROCEDURE PASSTEXT; FORWARD;PROCEDURE CONDITIONAL;FORWARD;PROCEDURE STARTINPUT;FORWARD; PROCEDURE BEGINITERATI;FORWARD;PROCEDURE RESUMEITERAT;FORWARD; PROCEDURE STOPITERATIO;FORWARD;{:706}{707:}PROCEDURE EXPAND; VAR P:HALFWORD;K:INTEGER;J:POOLPOINTER; BEGIN IF INTERNAL[7]>65536 THEN IF CURCMD<>10 THEN SHOWCMDMOD(CURCMD, CURMOD);CASE CURCMD OF 1:CONDITIONAL;2:{751:} IF CURMOD>IFLIMIT THEN IF IFLIMIT=1 THEN BEGIN MISSINGERR(58);BACKINPUT; CURSYM:=2362;INSERROR; END ELSE BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(722);END;PRINTCMDMOD(2,CURMOD); BEGIN HELPPTR:=1;HELPLINE[0]:=723;END;ERROR; END ELSE BEGIN WHILE CURMOD<>2 DO PASSTEXT;{745:}BEGIN P:=CONDPTR; IFLINE:=MEM[P+1].INT;CURIF:=MEM[P].HH.B1;IFLIMIT:=MEM[P].HH.B0; CONDPTR:=MEM[P].HH.RH;FREENODE(P,2);END{:745};END{:751};3:{711:} IF CURMOD>0 THEN FORCEEOF:=TRUE ELSE STARTINPUT{:711}; 4:IF CURMOD=0 THEN{708:}BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(686);END; BEGIN HELPPTR:=2;HELPLINE[1]:=687;HELPLINE[0]:=688;END;ERROR;END{:708} ELSE BEGINITERATI;5:{712:} BEGIN WHILE(CURINPUT.INDEXFIELD>6)AND(CURINPUT.LOCFIELD=0)DO ENDTOKENLIST; IF LOOPPTR=0 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(690);END; BEGIN HELPPTR:=2;HELPLINE[1]:=691;HELPLINE[0]:=692;END;ERROR; END ELSE RESUMEITERAT;END{:712};6:{713:}BEGIN GETBOOLEAN; IF INTERNAL[7]>65536 THEN SHOWCMDMOD(33,CUREXP); IF CUREXP=30 THEN IF LOOPPTR=0 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(693); END;BEGIN HELPPTR:=1;HELPLINE[0]:=694;END; IF CURCMD=83 THEN ERROR ELSE BACKERROR;END ELSE{714:}BEGIN P:=0; REPEAT IF(CURINPUT.INDEXFIELD<=6)THEN ENDFILEREADI ELSE BEGIN IF CURINPUT.INDEXFIELD<=8 THEN P:=CURINPUT.STARTFIELD;ENDTOKENLIST;END; UNTIL P<>0;IF P<>MEM[LOOPPTR].HH.LH THEN FATALERROR(697);STOPITERATIO; END{:714}ELSE IF CURCMD<>83 THEN BEGIN MISSINGERR(59);BEGIN HELPPTR:=2; HELPLINE[1]:=695;HELPLINE[0]:=696;END;BACKERROR;END;END{:713};7:; 9:{715:}BEGIN GETNEXT;P:=CURTOK;GETNEXT; IF CURCMD<11 THEN EXPAND ELSE BACKINPUT;BEGINTOKENLI(P,10);END{:715}; 8:{716:}BEGIN GETXNEXT;SCANPRIMARY; IF CURTYPE<>4 THEN BEGIN DISPERR(0,698);BEGIN HELPPTR:=2; HELPLINE[1]:=699;HELPLINE[0]:=700;END;PUTGETFLUSHE(0); END ELSE BEGIN BACKINPUT; IF(STRSTART[CUREXP+1]-STRSTART[CUREXP])>0 THEN{717:}BEGIN BEGINFILEREA; CURINPUT.NAMEFIELD:=2;K:=FIRST+(STRSTART[CUREXP+1]-STRSTART[CUREXP]); IF K>=MAXBUFSTACK THEN BEGIN IF K>=BUFSIZE THEN BEGIN MAXBUFSTACK:= BUFSIZE;OVERFLOW(256,BUFSIZE);END;MAXBUFSTACK:=K+1;END; J:=STRSTART[CUREXP];CURINPUT.LIMITFIELD:=K; WHILE FIRST=11;UNSTASHCUREX(SAVEEXP);END;END;{:718}{737:} PROCEDURE STACKARGUMEN(P:HALFWORD); BEGIN IF PARAMPTR=MAXPARAMSTAC THEN BEGIN MAXPARAMSTAC:=MAXPARAMSTAC+1; IF MAXPARAMSTAC>150 THEN OVERFLOW(685,150);END;PARAMSTACK[PARAMPTR]:=P; PARAMPTR:=PARAMPTR+1;END;{:737}{742:}PROCEDURE PASSTEXT;LABEL 30; VAR L:INTEGER;BEGIN SCANNERSTATU:=1;L:=0;WARNINGINFO:=LINE; WHILE TRUE DO BEGIN GETNEXT; IF CURCMD<=2 THEN IF CURCMD<2 THEN L:=L+1 ELSE BEGIN IF L=0 THEN GOTO 30 ;IF CURMOD=2 THEN L:=L-1;END ELSE{743:} IF CURCMD=39 THEN BEGIN IF STRREF[CURMOD]<127 THEN IF STRREF[CURMOD]>1 THEN STRREF[CURMOD]:=STRREF[CURMOD]-1 ELSE FLUSHSTRING(CURMOD);END{:743} ;END;30:SCANNERSTATU:=0;END;{:742}{746:} PROCEDURE CHANGEIFLIMI(L:SMALLNUMBER;P:HALFWORD);LABEL 10; VAR Q:HALFWORD;BEGIN IF P=CONDPTR THEN IFLIMIT:=L ELSE BEGIN Q:=CONDPTR; WHILE TRUE DO BEGIN IF Q=0 THEN CONFUSION(716); IF MEM[Q].HH.RH=P THEN BEGIN MEM[Q].HH.B0:=L;GOTO 10;END; Q:=MEM[Q].HH.RH;END;END;10:END;{:746}{747:}PROCEDURE CHECKCOLON; BEGIN IF CURCMD<>81 THEN BEGIN MISSINGERR(58);BEGIN HELPPTR:=2; HELPLINE[1]:=719;HELPLINE[0]:=696;END;BACKERROR;END;END;{:747}{748:} PROCEDURE CONDITIONAL;LABEL 10,30,21,40;VAR SAVECONDPTR:HALFWORD; NEWIFLIMIT:2..4;P:HALFWORD;BEGIN{744:}BEGIN P:=GETNODE(2); MEM[P].HH.RH:=CONDPTR;MEM[P].HH.B0:=IFLIMIT;MEM[P].HH.B1:=CURIF; MEM[P+1].INT:=IFLINE;CONDPTR:=P;IFLIMIT:=1;IFLINE:=LINE;CURIF:=1; END{:744};SAVECONDPTR:=CONDPTR;21:GETBOOLEAN;NEWIFLIMIT:=4; IF INTERNAL[7]>65536 THEN{750:}BEGIN BEGINDIAGNOS; IF CUREXP=30 THEN PRINT(720)ELSE PRINT(721);ENDDIAGNOSTI(FALSE); END{:750};40:CHECKCOLON; IF CUREXP=30 THEN BEGIN CHANGEIFLIMI(NEWIFLIMIT,SAVECONDPTR);GOTO 10; END;{749:}WHILE TRUE DO BEGIN PASSTEXT; IF CONDPTR=SAVECONDPTR THEN GOTO 30 ELSE IF CURMOD=2 THEN{745:} BEGIN P:=CONDPTR;IFLINE:=MEM[P+1].INT;CURIF:=MEM[P].HH.B1; IFLIMIT:=MEM[P].HH.B0;CONDPTR:=MEM[P].HH.RH;FREENODE(P,2);END{:745}; END{:749};30:CURIF:=CURMOD;IFLINE:=LINE;IF CURMOD=2 THEN{745:} BEGIN P:=CONDPTR;IFLINE:=MEM[P+1].INT;CURIF:=MEM[P].HH.B1; IFLIMIT:=MEM[P].HH.B0;CONDPTR:=MEM[P].HH.RH;FREENODE(P,2);END{:745} ELSE IF CURMOD=4 THEN GOTO 21 ELSE BEGIN CUREXP:=30;NEWIFLIMIT:=2; GETXNEXT;GOTO 40;END;10:END;{:748}{754:}PROCEDURE BADFOR(S:STRNUMBER); BEGIN DISPERR(0,724);PRINT(S);PRINT(307);BEGIN HELPPTR:=4; HELPLINE[3]:=725;HELPLINE[2]:=726;HELPLINE[1]:=727;HELPLINE[0]:=309;END; PUTGETFLUSHE(0);END;{:754}{755:}PROCEDURE BEGINITERATI;LABEL 22,30,40; VAR M:HALFWORD;N:HALFWORD;P,Q,S,PP:HALFWORD;BEGIN M:=CURMOD;N:=CURSYM; S:=GETNODE(2);IF M=1 THEN BEGIN MEM[S+1].HH.LH:=1;P:=0;GETXNEXT;GOTO 40; END;GETSYMBOL;P:=GETNODE(2);MEM[P].HH.LH:=CURSYM;MEM[P+1].INT:=M; GETXNEXT;IF(CURCMD<>51)AND(CURCMD<>77)THEN BEGIN MISSINGERR(61); BEGIN HELPPTR:=3;HELPLINE[2]:=728;HELPLINE[1]:=671;HELPLINE[0]:=729;END; BACKERROR;END;{764:}MEM[S+1].HH.LH:=0;Q:=S+1;MEM[Q].HH.RH:=0; REPEAT GETXNEXT; IF M<>2370 THEN SCANSUFFIX ELSE BEGIN IF CURCMD>=81 THEN IF CURCMD<=82 THEN GOTO 22;SCANEXPRESSI;IF CURCMD=74 THEN IF Q=S+1 THEN{765:} BEGIN IF CURTYPE<>16 THEN BADFOR(735);PP:=GETNODE(4); MEM[PP+1].INT:=CUREXP;GETXNEXT;SCANEXPRESSI; IF CURTYPE<>16 THEN BADFOR(736);MEM[PP+2].INT:=CUREXP; IF CURCMD<>75 THEN BEGIN MISSINGERR(490);BEGIN HELPPTR:=2; HELPLINE[1]:=737;HELPLINE[0]:=738;END;BACKERROR;END;GETXNEXT; SCANEXPRESSI;IF CURTYPE<>16 THEN BADFOR(739);MEM[PP+3].INT:=CUREXP; MEM[S+1].HH.LH:=PP;GOTO 30;END{:765};CUREXP:=STASHCUREXP;END; MEM[Q].HH.RH:=GETAVAIL;Q:=MEM[Q].HH.RH;MEM[Q].HH.LH:=CUREXP;CURTYPE:=1; 22:UNTIL CURCMD<>82;30:{:764};40:{756:} IF CURCMD<>81 THEN BEGIN MISSINGERR(58);BEGIN HELPPTR:=3; HELPLINE[2]:=730;HELPLINE[1]:=731;HELPLINE[0]:=732;END;BACKERROR; END{:756};{758:}Q:=GETAVAIL;MEM[Q].HH.LH:=2358;SCANNERSTATU:=6; WARNINGINFO:=N;MEM[S].HH.LH:=SCANTOKS(4,P,Q,0);SCANNERSTATU:=0; MEM[S].HH.RH:=LOOPPTR;LOOPPTR:=S{:758};RESUMEITERAT;END;{:755}{760:} PROCEDURE RESUMEITERAT;LABEL 45,10;VAR P,Q:HALFWORD; BEGIN P:=MEM[LOOPPTR+1].HH.LH;IF P>1 THEN BEGIN CUREXP:=MEM[P+1].INT; IF{761:} ((MEM[P+2].INT>0)AND(CUREXP>MEM[P+3].INT))OR((MEM[P+2].INT<0)AND(CUREXP< MEM[P+3].INT)){:761}THEN GOTO 45;CURTYPE:=16;Q:=STASHCUREXP; MEM[P+1].INT:=CUREXP+MEM[P+2].INT; END ELSE IF P<1 THEN BEGIN P:=MEM[LOOPPTR+1].HH.RH;IF P=0 THEN GOTO 45; MEM[LOOPPTR+1].HH.RH:=MEM[P].HH.RH;Q:=MEM[P].HH.LH; BEGIN MEM[P].HH.RH:=AVAIL;AVAIL:=P;DYNUSED:=DYNUSED-1;END; END ELSE BEGIN BEGINTOKENLI(MEM[LOOPPTR].HH.LH,7);GOTO 10;END; BEGINTOKENLI(MEM[LOOPPTR].HH.LH,8);STACKARGUMEN(Q); IF INTERNAL[7]>65536 THEN{762:}BEGIN BEGINDIAGNOS;PRINTNL(734); IF(Q<>0)AND(MEM[Q].HH.RH=1)THEN PRINTEXP(Q,1)ELSE SHOWTOKENLIS(Q,0,50,0) ;PRINTCHAR(125);ENDDIAGNOSTI(FALSE);END{:762};GOTO 10;45:STOPITERATIO; 10:END;{:760}{763:}PROCEDURE STOPITERATIO;VAR P,Q:HALFWORD; BEGIN P:=MEM[LOOPPTR+1].HH.LH; IF P>1 THEN FREENODE(P,4)ELSE IF P<1 THEN BEGIN Q:=MEM[LOOPPTR+1].HH.RH; WHILE Q<>0 DO BEGIN P:=MEM[Q].HH.LH; IF P<>0 THEN IF MEM[P].HH.RH=1 THEN BEGIN RECYCLEVALUE(P);FREENODE(P,2); END ELSE FLUSHTOKENLI(P);P:=Q;Q:=MEM[Q].HH.RH;BEGIN MEM[P].HH.RH:=AVAIL; AVAIL:=P;DYNUSED:=DYNUSED-1;END;END;END;P:=LOOPPTR; LOOPPTR:=MEM[P].HH.RH;FLUSHTOKENLI(MEM[P].HH.LH);FREENODE(P,2);END; {:763}{770:}PROCEDURE BEGINNAME;BEGIN AREADELIMITE:=0;EXTDELIMITER:=0; END;{:770}{771:}FUNCTION MORENAME(C:ASCIICODE):BOOLEAN; BEGIN IF C=32 THEN MORENAME:=FALSE ELSE BEGIN IF(C=62)OR(C=93)OR(C=58) THEN BEGIN AREADELIMITE:=POOLPTR;EXTDELIMITER:=0; END ELSE IF(C=46)AND(EXTDELIMITER=0)THEN EXTDELIMITER:=POOLPTR; BEGIN IF POOLPTR+1>MAXPOOLPTR THEN BEGIN IF POOLPTR+1>POOLSIZE THEN OVERFLOW(257,POOLSIZE-INITPOOLPTR);MAXPOOLPTR:=POOLPTR+1;END;END; BEGIN STRPOOL[POOLPTR]:=C;POOLPTR:=POOLPTR+1;END;MORENAME:=TRUE;END;END; {:771}{772:}PROCEDURE ENDNAME;LABEL 20,10; VAR U:VARYING[FILENAMESIZE]OF CHAR; T:PACKED ARRAY[1..FILENAMESIZE]OF CHAR;I:POOLPOINTER;LEN:SIGNEDHALFWO; C:CHAR; BEGIN 20:IF(STRPOOL[AREADELIMITE]=58)AND(POOLPTR=AREADELIMITE+1)THEN BEGIN CURAREA:=MAKESTRING; LEN:=(STRSTART[CURAREA+1]-STRSTART[CURAREA])-1; FOR I:=1 TO LEN DO T[I]:=XCHR[STRPOOL[STRSTART[CURAREA]+I-1]]; IF NOT TRANSLATE(T,LEN)THEN BEGIN CUREXT:=285;CURNAME:=285;GOTO 10;END; FLUSHSTRING(CURAREA);BEGINNAME; FOR I:=1 TO LEN DO IF NOT MORENAME(XORD[T[I]])THEN GOTO 20;GOTO 20;END; IF STRPTR+3>MAXSTRPTR THEN BEGIN IF STRPTR+3>MAXSTRINGS THEN OVERFLOW( 258,MAXSTRINGS-INITSTRPTR);MAXSTRPTR:=STRPTR+3;END; IF AREADELIMITE=0 THEN CURAREA:=285 ELSE BEGIN CURAREA:=STRPTR; STRPTR:=STRPTR+1;STRSTART[STRPTR]:=AREADELIMITE+1;END; IF EXTDELIMITER=0 THEN BEGIN CUREXT:=285;CURNAME:=MAKESTRING; END ELSE BEGIN CURNAME:=STRPTR;STRPTR:=STRPTR+1; STRSTART[STRPTR]:=EXTDELIMITER;CUREXT:=MAKESTRING;END;10:END;{:772} {774:}PROCEDURE PACKFILENAME(N,A,E:STRNUMBER);VAR K:INTEGER;C:ASCIICODE; J:POOLPOINTER;BEGIN K:=0; FOR J:=STRSTART[A]TO STRSTART[A+1]-1 DO BEGIN C:=STRPOOL[J];K:=K+1; IF K<=FILENAMESIZE THEN NAMEOFFILE[K]:=XCHR[C];END; FOR J:=STRSTART[N]TO STRSTART[N+1]-1 DO BEGIN C:=STRPOOL[J];K:=K+1; IF K<=FILENAMESIZE THEN NAMEOFFILE[K]:=XCHR[C];END; FOR J:=STRSTART[E]TO STRSTART[E+1]-1 DO BEGIN C:=STRPOOL[J];K:=K+1; IF K<=FILENAMESIZE THEN NAMEOFFILE[K]:=XCHR[C];END; IF K<=FILENAMESIZE THEN NAMELENGTH:=K ELSE NAMELENGTH:=FILENAMESIZE; FOR K:=NAMELENGTH+1 TO FILENAMESIZE DO NAMEOFFILE[K]:=' ';END;{:774} {778:}PROCEDURE PACKBUFFERED(N:SMALLNUMBER;A,B:INTEGER);VAR K:INTEGER; C:ASCIICODE;J:INTEGER; BEGIN IF N+B-A+6>FILENAMESIZE THEN B:=A+FILENAMESIZE-N-6;K:=0; FOR J:=1 TO N DO BEGIN C:=XORD[MFBASEDEFAUL[J]];K:=K+1; IF K<=FILENAMESIZE THEN NAMEOFFILE[K]:=XCHR[C];END; FOR J:=A TO B DO BEGIN C:=BUFFER[J];K:=K+1; IF K<=FILENAMESIZE THEN NAMEOFFILE[K]:=XCHR[C];END; FOR J:=BASEDEFAULTL-4 TO BASEDEFAULTL DO BEGIN C:=XORD[MFBASEDEFAUL[J]]; K:=K+1;IF K<=FILENAMESIZE THEN NAMEOFFILE[K]:=XCHR[C];END; IF K<=FILENAMESIZE THEN NAMELENGTH:=K ELSE NAMELENGTH:=FILENAMESIZE; FOR K:=NAMELENGTH+1 TO FILENAMESIZE DO NAMEOFFILE[K]:=' ';END;{:778} {780:}FUNCTION MAKENAMESTRI:STRNUMBER;VAR K:1..FILENAMESIZE; BEGIN IF(POOLPTR+LASTLENGTH>POOLSIZE)OR(STRPTR=MAXSTRINGS)THEN MAKENAMESTRI:=63 ELSE BEGIN FOR K:=1 TO LASTLENGTH DO BEGIN STRPOOL[ POOLPTR]:=XORD[LASTNAME[K]];POOLPTR:=POOLPTR+1;END; MAKENAMESTRI:=MAKESTRING;END;END; FUNCTION AMAKENAMESTR(VAR F:ALPHAFILE):STRNUMBER; BEGIN AMAKENAMESTR:=MAKENAMESTRI;END; FUNCTION BMAKENAMESTR(VAR F:BYTEFILE):STRNUMBER; BEGIN BMAKENAMESTR:=MAKENAMESTRI;END; FUNCTION WMAKENAMESTR(VAR F:WORDFILE):STRNUMBER; BEGIN WMAKENAMESTR:=MAKENAMESTRI;END;{:780}{781:}PROCEDURE SCANFILENAME; LABEL 30;BEGIN BEGINNAME; WHILE BUFFER[CURINPUT.LOCFIELD]=32 DO CURINPUT.LOCFIELD:=CURINPUT. LOCFIELD+1; WHILE TRUE DO BEGIN IF(BUFFER[CURINPUT.LOCFIELD]=59)OR(BUFFER[CURINPUT. LOCFIELD]=37)THEN GOTO 30; IF NOT MORENAME(BUFFER[CURINPUT.LOCFIELD])THEN GOTO 30; CURINPUT.LOCFIELD:=CURINPUT.LOCFIELD+1;END;30:ENDNAME;END;{:781}{784:} PROCEDURE PACKJOBNAME(S:STRNUMBER);BEGIN CURAREA:=285;CUREXT:=S; CURNAME:=JOBNAME;PACKFILENAME(CURNAME,CURAREA,CUREXT);END; FUNCTION PACKDEFAULTN(QUAL:BOOLEAN; DFNAME:PACKED ARRAY[L1..U1:INTEGER]OF CHAR;DFLEN:FILESIZE):BOOLEAN; VAR K:INTEGER; BEGIN FOR K:=1 TO FILENAMESIZE DO DEFAULTNAME[K]:=NAMEOFFILE[K]; DEFLTLENGTH:=NAMELENGTH;IF QUAL THEN BEGIN NAMEOFFILE:=DFNAME; NAMELENGTH:=DFLEN; IF NAMELENGTH6)AND(CURINPUT.LOCFIELD=0)DO ENDTOKENLIST; IF(CURINPUT.INDEXFIELD>6)THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(755); END;BEGIN HELPPTR:=3;HELPLINE[2]:=756;HELPLINE[1]:=757;HELPLINE[0]:=758; END;ERROR;END; IF(CURINPUT.INDEXFIELD<=6)THEN SCANFILENAME ELSE BEGIN CURNAME:=285; CUREXT:=285;CURAREA:=285;END{:795};IF CUREXT=285 THEN CUREXT:=745; PACKFILENAME(CURNAME,CURAREA,CUREXT);WHILE TRUE DO BEGIN BEGINFILEREA; IF AOPENIN(INPUTFILE[CURINPUT.INDEXFIELD])THEN GOTO 30; IF CURAREA=285 THEN BEGIN PACKFILENAME(CURNAME,MFAREA,CUREXT); IF AOPENIN(INPUTFILE[CURINPUT.INDEXFIELD])THEN GOTO 30;END;ENDFILEREADI; PROMPTFILENA(741,745);END; 30:CURINPUT.NAMEFIELD:=AMAKENAMESTR(INPUTFILE[CURINPUT.INDEXFIELD]); STRREF[CURNAME]:=127;IF JOBNAME=0 THEN BEGIN JOBNAME:=CURNAME; OPENLOGFILE;END; IF TERMOFFSET+(STRSTART[CURINPUT.NAMEFIELD+1]-STRSTART[CURINPUT. NAMEFIELD])>MAXPRINTLINE-2 THEN PRINTLN ELSE IF(TERMOFFSET>0)OR( FILEOFFSET>0)THEN PRINTCHAR(32);PRINTCHAR(40);OPENPARENS:=OPENPARENS+1; PRINT(CURINPUT.NAMEFIELD);IF ODD(SELECTOR)THEN WRITELN(TERMOUT);{794:} BEGIN LINE:=1;IF INPUTLN(INPUTFILE[CURINPUT.INDEXFIELD],FALSE)THEN; FIRMUPTHELIN;BUFFER[CURINPUT.LIMITFIELD]:=37; FIRST:=CURINPUT.LIMITFIELD+1;CURINPUT.LOCFIELD:=CURINPUT.STARTFIELD; END{:794};END;{:793}{824:}PROCEDURE BADEXP(S:STRNUMBER); VAR SAVEFLAG:0..85;BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(S);END;PRINT(768); PRINTCMDMOD(CURCMD,CURMOD);PRINTCHAR(39);BEGIN HELPPTR:=4; HELPLINE[3]:=769;HELPLINE[2]:=770;HELPLINE[1]:=771;HELPLINE[0]:=772;END; BACKINPUT;CURSYM:=0;CURCMD:=42;CURMOD:=0;INSERROR;SAVEFLAG:=VARFLAG; VARFLAG:=0;GETXNEXT;VARFLAG:=SAVEFLAG;END;{:824}{827:} PROCEDURE STASHIN(P:HALFWORD);VAR Q:HALFWORD; BEGIN MEM[P].HH.B0:=CURTYPE; IF CURTYPE=16 THEN MEM[P+1].INT:=CUREXP ELSE BEGIN IF CURTYPE=19 THEN{ 829:}BEGIN Q:=SINGLEDEPEND(CUREXP); IF Q=DEPFINAL THEN BEGIN MEM[P].HH.B0:=16;MEM[P+1].INT:=0;FREENODE(Q,2); END ELSE BEGIN MEM[P].HH.B0:=17;NEWDEP(P,Q);END;RECYCLEVALUE(CUREXP); END{:829}ELSE BEGIN MEM[P+1]:=MEM[CUREXP+1]; MEM[MEM[P+1].HH.LH].HH.RH:=P;END;FREENODE(CUREXP,2);END;CURTYPE:=1;END; {:827}{848:}PROCEDURE BACKEXPR;VAR P:HALFWORD;BEGIN P:=STASHCUREXP; MEM[P].HH.RH:=0;BEGINTOKENLI(P,10);END;{:848}{849:} PROCEDURE BADSUBSCRIPT;BEGIN DISPERR(0,784);BEGIN HELPPTR:=3; HELPLINE[2]:=785;HELPLINE[1]:=786;HELPLINE[0]:=787;END;FLUSHERROR(0); END;{:849}{851:}PROCEDURE OBLITERATED(Q:HALFWORD); BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(788);END; SHOWTOKENLIS(Q,0,1000,0);PRINT(789);BEGIN HELPPTR:=5;HELPLINE[4]:=790; HELPLINE[3]:=791;HELPLINE[2]:=792;HELPLINE[1]:=793;HELPLINE[0]:=794;END; END;{:851}{863:}PROCEDURE BINARYMAC(P,C,N:HALFWORD);VAR Q,R:HALFWORD; BEGIN Q:=GETAVAIL;R:=GETAVAIL;MEM[Q].HH.RH:=R;MEM[Q].HH.LH:=P; MEM[R].HH.LH:=STASHCUREXP;MACROCALL(C,Q,N);END;{:863}{865:} PROCEDURE MATERIALIZEP;LABEL 50; VAR AMINUSB,APLUSB,MAJORAXIS,MINORAXIS:SCALED;THETA:ANGLE;P:HALFWORD; Q:HALFWORD;BEGIN Q:=CUREXP; IF MEM[Q].HH.B0=0 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(804);END; BEGIN HELPPTR:=2;HELPLINE[1]:=805;HELPLINE[0]:=575;END;PUTGETERROR; CUREXP:=3;GOTO 50;END ELSE IF MEM[Q].HH.B0=4 THEN{866:} BEGIN TX:=MEM[Q+1].INT;TY:=MEM[Q+2].INT;TXX:=MEM[Q+3].INT-TX; TYX:=MEM[Q+4].INT-TY;TXY:=MEM[Q+5].INT-TX;TYY:=MEM[Q+6].INT-TY; AMINUSB:=PYTHADD(TXX-TYY,TYX+TXY);APLUSB:=PYTHADD(TXX+TYY,TYX-TXY); MAJORAXIS:=(AMINUSB+APLUSB)DIV 2;MINORAXIS:=(ABS(APLUSB-AMINUSB))DIV 2; IF MAJORAXIS=MINORAXIS THEN THETA:=0 ELSE THETA:=(NARG(TXX-TYY,TYX+TXY)+ NARG(TXX+TYY,TYX-TXY))DIV 2;FREENODE(Q,7); Q:=MAKEELLIPSE(MAJORAXIS,MINORAXIS,THETA);IF(TX<>0)OR(TY<>0)THEN{867:} BEGIN P:=Q;REPEAT MEM[P+1].INT:=MEM[P+1].INT+TX; MEM[P+2].INT:=MEM[P+2].INT+TY;P:=MEM[P].HH.RH;UNTIL P=Q;END{:867}; END{:866};CUREXP:=MAKEPEN(Q);50:TOSSKNOTLIST(Q);CURTYPE:=6;END;{:865} {871:}{872:}PROCEDURE KNOWNPAIR;VAR P:HALFWORD; BEGIN IF CURTYPE<>14 THEN BEGIN DISPERR(0,807);BEGIN HELPPTR:=5; HELPLINE[4]:=808;HELPLINE[3]:=809;HELPLINE[2]:=810;HELPLINE[1]:=811; HELPLINE[0]:=812;END;PUTGETFLUSHE(0);CURX:=0;CURY:=0; END ELSE BEGIN P:=MEM[CUREXP+1].INT;{873:} IF MEM[P].HH.B0=16 THEN CURX:=MEM[P+1].INT ELSE BEGIN DISPERR(P,813); BEGIN HELPPTR:=5;HELPLINE[4]:=814;HELPLINE[3]:=809;HELPLINE[2]:=810; HELPLINE[1]:=811;HELPLINE[0]:=812;END;PUTGETERROR;RECYCLEVALUE(P); CURX:=0;END; IF MEM[P+2].HH.B0=16 THEN CURY:=MEM[P+3].INT ELSE BEGIN DISPERR(P+2,815) ;BEGIN HELPPTR:=5;HELPLINE[4]:=816;HELPLINE[3]:=809;HELPLINE[2]:=810; HELPLINE[1]:=811;HELPLINE[0]:=812;END;PUTGETERROR;RECYCLEVALUE(P+2); CURY:=0;END{:873};FLUSHCUREXP(0);END;END;{:872} FUNCTION NEWKNOT:HALFWORD;VAR Q:HALFWORD;BEGIN Q:=GETNODE(7); MEM[Q].HH.B0:=0;MEM[Q].HH.B1:=0;MEM[Q].HH.RH:=Q;KNOWNPAIR; MEM[Q+1].INT:=CURX;MEM[Q+2].INT:=CURY;NEWKNOT:=Q;END;{:871}{875:} FUNCTION SCANDIRECTIO:SMALLNUMBER;VAR T:2..4;X:SCALED;BEGIN GETXNEXT; IF CURCMD=60 THEN{876:}BEGIN GETXNEXT;SCANEXPRESSI; IF(CURTYPE<>16)OR(CUREXP<0)THEN BEGIN DISPERR(0,819);BEGIN HELPPTR:=1; HELPLINE[0]:=820;END;PUTGETFLUSHE(65536);END;T:=3;END{:876}ELSE{877:} BEGIN SCANEXPRESSI;IF CURTYPE>14 THEN{878:} BEGIN IF CURTYPE<>16 THEN BEGIN DISPERR(0,813);BEGIN HELPPTR:=5; HELPLINE[4]:=814;HELPLINE[3]:=809;HELPLINE[2]:=810;HELPLINE[1]:=811; HELPLINE[0]:=812;END;PUTGETFLUSHE(0);END;X:=CUREXP; IF CURCMD<>82 THEN BEGIN MISSINGERR(44);BEGIN HELPPTR:=2; HELPLINE[1]:=821;HELPLINE[0]:=822;END;BACKERROR;END;GETXNEXT; SCANEXPRESSI;IF CURTYPE<>16 THEN BEGIN DISPERR(0,815);BEGIN HELPPTR:=5; HELPLINE[4]:=816;HELPLINE[3]:=809;HELPLINE[2]:=810;HELPLINE[1]:=811; HELPLINE[0]:=812;END;PUTGETFLUSHE(0);END;CURY:=CUREXP;CURX:=X;END{:878} ELSE KNOWNPAIR;IF(CURX=0)AND(CURY=0)THEN T:=4 ELSE BEGIN T:=2; CUREXP:=NARG(CURX,CURY);END;END{:877}; IF CURCMD<>65 THEN BEGIN MISSINGERR(125);BEGIN HELPPTR:=3; HELPLINE[2]:=817;HELPLINE[1]:=818;HELPLINE[0]:=696;END;BACKERROR;END; GETXNEXT;SCANDIRECTIO:=T;END;{:875}{895:} PROCEDURE DONULLARY(C:QUARTERWORD);VAR K:INTEGER; BEGIN BEGIN IF ARITHERROR THEN CLEARARITH;END; IF INTERNAL[7]>131072 THEN SHOWCMDMOD(33,C); CASE C OF 30,31:BEGIN CURTYPE:=2;CUREXP:=C;END;32:BEGIN CURTYPE:=11; CUREXP:=GETNODE(6);INITEDGES(CUREXP);END;33:BEGIN CURTYPE:=6;CUREXP:=3; END;37:BEGIN CURTYPE:=16;CUREXP:=NORMRAND;END;36:{896:}BEGIN CURTYPE:=8; CUREXP:=GETNODE(7);MEM[CUREXP].HH.B0:=4;MEM[CUREXP].HH.B1:=4; MEM[CUREXP].HH.RH:=CUREXP;MEM[CUREXP+1].INT:=0;MEM[CUREXP+2].INT:=0; MEM[CUREXP+3].INT:=65536;MEM[CUREXP+4].INT:=0;MEM[CUREXP+5].INT:=0; MEM[CUREXP+6].INT:=65536;END{:896}; 34:BEGIN IF JOBNAME=0 THEN OPENLOGFILE;CURTYPE:=4;CUREXP:=JOBNAME;END; 35:{897:}BEGIN IF INTERACTION<=1 THEN FATALERROR(833);BEGINFILEREA; CURINPUT.NAMEFIELD:=1;BEGIN WAKEUPTERMIN;PRINT(285);TERMINPUT;END; BEGIN IF POOLPTR+LAST-CURINPUT.STARTFIELD>MAXPOOLPTR THEN BEGIN IF POOLPTR+LAST-CURINPUT.STARTFIELD>POOLSIZE THEN OVERFLOW(257,POOLSIZE- INITPOOLPTR);MAXPOOLPTR:=POOLPTR+LAST-CURINPUT.STARTFIELD;END;END; FOR K:=CURINPUT.STARTFIELD TO LAST-1 DO BEGIN STRPOOL[POOLPTR]:=BUFFER[K ];POOLPTR:=POOLPTR+1;END;ENDFILEREADI;CURTYPE:=4;CUREXP:=MAKESTRING; END{:897};END;BEGIN IF ARITHERROR THEN CLEARARITH;END;END;{:895}{898:} {899:}FUNCTION NICEPAIR(P:INTEGER;T:QUARTERWORD):BOOLEAN;LABEL 10; BEGIN IF T=14 THEN BEGIN P:=MEM[P+1].INT; IF MEM[P].HH.B0=16 THEN IF MEM[P+2].HH.B0=16 THEN BEGIN NICEPAIR:=TRUE; GOTO 10;END;END;NICEPAIR:=FALSE;10:END;{:899}{900:} PROCEDURE PRINTKNOWNOR(T:SMALLNUMBER;V:INTEGER);BEGIN PRINTCHAR(40); IF T<17 THEN IF T<>14 THEN PRINTTYPE(T)ELSE IF NICEPAIR(V,14)THEN PRINT( 337)ELSE PRINT(834)ELSE PRINT(835);PRINTCHAR(41);END;{:900}{901:} PROCEDURE BADUNARY(C:QUARTERWORD);BEGIN DISPERR(0,836);PRINTOP(C); PRINTKNOWNOR(CURTYPE,CUREXP);BEGIN HELPPTR:=3;HELPLINE[2]:=837; HELPLINE[1]:=838;HELPLINE[0]:=839;END;PUTGETERROR;END;{:901}{904:} PROCEDURE NEGATEDEPLIS(P:HALFWORD);LABEL 10; BEGIN WHILE TRUE DO BEGIN MEM[P+1].INT:=-MEM[P+1].INT; IF MEM[P].HH.LH=0 THEN GOTO 10;P:=MEM[P].HH.RH;END;10:END;{:904}{908:} PROCEDURE PAIRTOPATH;BEGIN CUREXP:=NEWKNOT;CURTYPE:=9;END;{:908}{910:} PROCEDURE TAKEPART(C:QUARTERWORD);VAR P:HALFWORD; BEGIN P:=MEM[CUREXP+1].INT;MEM[18].INT:=P;MEM[17].HH.B0:=CURTYPE; MEM[P].HH.RH:=17;FREENODE(CUREXP,2);MAKEEXPCOPY(P+2*(C-53)); RECYCLEVALUE(17);END;{:910}{913:}PROCEDURE STRTONUM(C:QUARTERWORD); VAR N:INTEGER;M:ASCIICODE;K:POOLPOINTER;B:8..16;BADCHAR:BOOLEAN; BEGIN IF C=49 THEN IF(STRSTART[CUREXP+1]-STRSTART[CUREXP])=0 THEN N:=-1 ELSE N:=STRPOOL[STRSTART[CUREXP]]ELSE BEGIN IF C=47 THEN B:=8 ELSE B:=16 ;N:=0;BADCHAR:=FALSE; FOR K:=STRSTART[CUREXP]TO STRSTART[CUREXP+1]-1 DO BEGIN M:=STRPOOL[K]; IF(M>=48)AND(M<=57)THEN M:=M-48 ELSE IF(M>=65)AND(M<=70)THEN M:=M-55 ELSE IF(M>=97)AND(M<=102)THEN M:=M-87 ELSE BEGIN BADCHAR:=TRUE;M:=0;END; IF M>=B THEN BEGIN BADCHAR:=TRUE;M:=0;END; IF N<32768 DIV B THEN N:=N*B+M ELSE N:=32767;END;{914:} IF BADCHAR THEN BEGIN DISPERR(0,841);IF C=47 THEN BEGIN HELPPTR:=1; HELPLINE[0]:=842;END ELSE BEGIN HELPPTR:=1;HELPLINE[0]:=843;END; PUTGETERROR;END; IF N>4095 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(844);END; PRINTINT(N);PRINTCHAR(41);BEGIN HELPPTR:=1;HELPLINE[0]:=845;END; PUTGETERROR;END{:914};END;FLUSHCUREXP(N*65536);END;{:913}{916:} FUNCTION PATHLENGTH:SCALED;VAR N:SCALED;P:HALFWORD;BEGIN P:=CUREXP; IF MEM[P].HH.B0=0 THEN N:=-65536 ELSE N:=0;REPEAT P:=MEM[P].HH.RH; N:=N+65536;UNTIL P=CUREXP;PATHLENGTH:=N;END;{:916}{919:} PROCEDURE TESTKNOWN(C:QUARTERWORD);LABEL 30;VAR B:30..31;P,Q:HALFWORD; BEGIN B:=31;CASE CURTYPE OF 1,2,4,6,8,9,11,16:B:=30; 13,14:BEGIN P:=MEM[CUREXP+1].INT;Q:=P+BIGNODESIZE[CURTYPE]; REPEAT Q:=Q-2;IF MEM[Q].HH.B0<>16 THEN GOTO 30;UNTIL Q=P;B:=30;30:END; OTHERWISE END;IF C=39 THEN FLUSHCUREXP(B)ELSE FLUSHCUREXP(61-B); CURTYPE:=2;END;{:919}PROCEDURE DOUNARY(C:QUARTERWORD);VAR P,Q:HALFWORD; X:INTEGER;BEGIN BEGIN IF ARITHERROR THEN CLEARARITH;END; IF INTERNAL[7]>131072 THEN{902:}BEGIN BEGINDIAGNOS;PRINTNL(123); PRINTOP(C);PRINTCHAR(40);PRINTEXP(0,0);PRINT(840);ENDDIAGNOSTI(FALSE); END{:902}; CASE C OF 69:IF CURTYPE<14 THEN IF CURTYPE<>11 THEN BADUNARY(69); 70:{903:}CASE CURTYPE OF 14,19:BEGIN Q:=CUREXP;MAKEEXPCOPY(Q); IF CURTYPE=17 THEN NEGATEDEPLIS(MEM[CUREXP+1].HH.RH)ELSE IF CURTYPE=14 THEN BEGIN P:=MEM[CUREXP+1].INT; IF MEM[P].HH.B0=16 THEN MEM[P+1].INT:=-MEM[P+1].INT ELSE NEGATEDEPLIS( MEM[P+1].HH.RH); IF MEM[P+2].HH.B0=16 THEN MEM[P+3].INT:=-MEM[P+3].INT ELSE NEGATEDEPLIS( MEM[P+3].HH.RH);END;RECYCLEVALUE(Q);FREENODE(Q,2);END; 17,18:NEGATEDEPLIS(MEM[CUREXP+1].HH.RH);16:CUREXP:=-CUREXP; 11:NEGATEEDGES(CUREXP);OTHERWISE BADUNARY(70)END{:903};{905:} 41:IF CURTYPE<>2 THEN BADUNARY(41)ELSE CUREXP:=61-CUREXP;{:905}{906:} 59,60,61,62,63,64,65,38,66:IF CURTYPE<>16 THEN BADUNARY(C)ELSE CASE C OF 59:CUREXP:=SQUARERT(CUREXP);60:CUREXP:=MEXP(CUREXP); 61:CUREXP:=MLOG(CUREXP);62,63:BEGIN NSINCOS((CUREXP MOD 23592960)*16); IF C=62 THEN CUREXP:=ROUNDFRACTIO(NSIN)ELSE CUREXP:=ROUNDFRACTIO(NCOS); END;64:CUREXP:=FLOORSCALED(CUREXP);65:CUREXP:=UNIFRAND(CUREXP); 38:BEGIN IF ODD(ROUNDUNSCALE(CUREXP))THEN CUREXP:=30 ELSE CUREXP:=31; CURTYPE:=2;END;66:{1181:}BEGIN CUREXP:=ROUNDUNSCALE(CUREXP)MOD 256; IF CUREXP<0 THEN CUREXP:=CUREXP+256; IF CHAREXISTS[CUREXP]THEN CUREXP:=30 ELSE CUREXP:=31;CURTYPE:=2; END{:1181};END;{:906}{907:} 67:IF NICEPAIR(CUREXP,CURTYPE)THEN BEGIN P:=MEM[CUREXP+1].INT; X:=NARG(MEM[P+1].INT,MEM[P+3].INT); IF X>=0 THEN FLUSHCUREXP((X+8)DIV 16)ELSE FLUSHCUREXP(-((-X+8)DIV 16)); END ELSE BADUNARY(67);{:907}{909:} 53,54:IF(CURTYPE<=14)AND(CURTYPE>=13)THEN TAKEPART(C)ELSE BADUNARY(C); 55,56,57,58:IF CURTYPE=13 THEN TAKEPART(C)ELSE BADUNARY(C);{:909}{912:} 50:IF CURTYPE<>16 THEN BADUNARY(50)ELSE BEGIN CUREXP:=ROUNDUNSCALE( CUREXP)MOD 256;CURTYPE:=4;IF CUREXP<0 THEN CUREXP:=CUREXP+256; IF(STRSTART[CUREXP+1]-STRSTART[CUREXP])<>1 THEN BEGIN BEGIN IF POOLPTR+1 >MAXPOOLPTR THEN BEGIN IF POOLPTR+1>POOLSIZE THEN OVERFLOW(257,POOLSIZE- INITPOOLPTR);MAXPOOLPTR:=POOLPTR+1;END;END; BEGIN STRPOOL[POOLPTR]:=CUREXP;POOLPTR:=POOLPTR+1;END; CUREXP:=MAKESTRING;END;END; 42:IF CURTYPE<>16 THEN BADUNARY(42)ELSE BEGIN OLDSETTING:=SELECTOR; SELECTOR:=5;PRINTSCALED(CUREXP);CUREXP:=MAKESTRING;SELECTOR:=OLDSETTING; CURTYPE:=4;END;47,48,49:IF CURTYPE<>4 THEN BADUNARY(C)ELSE STRTONUM(C); {:912}{915:} 51:IF CURTYPE=4 THEN FLUSHCUREXP((STRSTART[CUREXP+1]-STRSTART[CUREXP]) *65536)ELSE IF CURTYPE=9 THEN FLUSHCUREXP(PATHLENGTH)ELSE IF CURTYPE=16 THEN CUREXP:=ABS(CUREXP)ELSE IF NICEPAIR(CUREXP,CURTYPE)THEN FLUSHCUREXP (PYTHADD(MEM[MEM[CUREXP+1].INT+1].INT,MEM[MEM[CUREXP+1].INT+3].INT))ELSE BADUNARY(C);{:915}{917:} 52:IF CURTYPE=14 THEN FLUSHCUREXP(0)ELSE IF CURTYPE<>9 THEN BADUNARY(52) ELSE IF MEM[CUREXP].HH.B0=0 THEN FLUSHCUREXP(0)ELSE BEGIN CURPEN:=3; CURPATHTYPE:=1;CUREXP:=MAKESPEC(CUREXP,-1879080960,0); FLUSHCUREXP(TURNINGNUMBE*65536);END;{:917}{918:} 2:BEGIN IF(CURTYPE>=2)AND(CURTYPE<=3)THEN FLUSHCUREXP(30)ELSE FLUSHCUREXP(31);CURTYPE:=2;END; 4:BEGIN IF(CURTYPE>=4)AND(CURTYPE<=5)THEN FLUSHCUREXP(30)ELSE FLUSHCUREXP(31);CURTYPE:=2;END; 6:BEGIN IF(CURTYPE>=6)AND(CURTYPE<=8)THEN FLUSHCUREXP(30)ELSE FLUSHCUREXP(31);CURTYPE:=2;END; 9:BEGIN IF(CURTYPE>=9)AND(CURTYPE<=10)THEN FLUSHCUREXP(30)ELSE FLUSHCUREXP(31);CURTYPE:=2;END; 11:BEGIN IF(CURTYPE>=11)AND(CURTYPE<=12)THEN FLUSHCUREXP(30)ELSE FLUSHCUREXP(31);CURTYPE:=2;END; 13,14:BEGIN IF CURTYPE=C THEN FLUSHCUREXP(30)ELSE FLUSHCUREXP(31); CURTYPE:=2;END; 15:BEGIN IF(CURTYPE>=16)AND(CURTYPE<=19)THEN FLUSHCUREXP(30)ELSE FLUSHCUREXP(31);CURTYPE:=2;END;39,40:TESTKNOWN(C);{:918}{920:} 68:BEGIN IF CURTYPE<>9 THEN FLUSHCUREXP(31)ELSE IF MEM[CUREXP].HH.B0<>0 THEN FLUSHCUREXP(30)ELSE FLUSHCUREXP(31);CURTYPE:=2;END;{:920}{921:} 45:BEGIN IF CURTYPE=14 THEN PAIRTOPATH; IF CURTYPE=9 THEN CURTYPE:=8 ELSE BADUNARY(45);END; 44:BEGIN IF CURTYPE=8 THEN MATERIALIZEP; IF CURTYPE<>6 THEN BADUNARY(44)ELSE BEGIN FLUSHCUREXP(MAKEPATH(CUREXP)); CURTYPE:=9;END;END; 46:IF CURTYPE<>11 THEN BADUNARY(46)ELSE FLUSHCUREXP(TOTALWEIGHT(CUREXP)) ;43:IF CURTYPE=9 THEN BEGIN P:=HTAPYPOC(CUREXP); IF MEM[P].HH.B1=0 THEN P:=MEM[P].HH.RH;TOSSKNOTLIST(CUREXP);CUREXP:=P; END ELSE IF CURTYPE=14 THEN PAIRTOPATH ELSE BADUNARY(43);{:921}END; BEGIN IF ARITHERROR THEN CLEARARITH;END;END;{:898}{922:}{923:} PROCEDURE BADBINARY(P:HALFWORD;C:QUARTERWORD);BEGIN DISPERR(P,285); DISPERR(0,836);IF C>=94 THEN PRINTOP(C);PRINTKNOWNOR(MEM[P].HH.B0,P); IF C>=94 THEN PRINT(479)ELSE PRINTOP(C);PRINTKNOWNOR(CURTYPE,CUREXP); BEGIN HELPPTR:=3;HELPLINE[2]:=837;HELPLINE[1]:=846;HELPLINE[0]:=847;END; PUTGETERROR;END;{:923}{928:}FUNCTION TARNISHED(P:HALFWORD):HALFWORD; LABEL 10;VAR Q:HALFWORD;R:HALFWORD;BEGIN Q:=MEM[P+1].INT; R:=Q+BIGNODESIZE[MEM[P].HH.B0];REPEAT R:=R-2; IF MEM[R].HH.B0=19 THEN BEGIN TARNISHED:=1;GOTO 10;END;UNTIL R=Q; TARNISHED:=0;10:END;{:928}{930:}{935:}PROCEDURE DEPFINISH(V,Q:HALFWORD; T:SMALLNUMBER);VAR P:HALFWORD;VV:SCALED; BEGIN IF Q=0 THEN P:=CUREXP ELSE P:=Q;MEM[P+1].HH.RH:=V;MEM[P].HH.B0:=T; IF MEM[V].HH.LH=0 THEN BEGIN VV:=MEM[V+1].INT; IF Q=0 THEN FLUSHCUREXP(VV)ELSE BEGIN RECYCLEVALUE(P);MEM[Q].HH.B0:=16; MEM[Q+1].INT:=VV;END;END ELSE IF Q=0 THEN CURTYPE:=T; IF FIXNEEDED THEN FIXDEPENDENC;END;{:935} PROCEDURE ADDORSUBTRAC(P,Q:HALFWORD;C:QUARTERWORD);LABEL 30,10; VAR S,T:SMALLNUMBER;R:HALFWORD;V:INTEGER; BEGIN IF Q=0 THEN BEGIN T:=CURTYPE; IF T<17 THEN V:=CUREXP ELSE V:=MEM[CUREXP+1].HH.RH; END ELSE BEGIN T:=MEM[Q].HH.B0; IF T<17 THEN V:=MEM[Q+1].INT ELSE V:=MEM[Q+1].HH.RH;END; IF T=16 THEN BEGIN IF C=70 THEN V:=-V; IF MEM[P].HH.B0=16 THEN BEGIN V:=SLOWADD(MEM[P+1].INT,V); IF Q=0 THEN CUREXP:=V ELSE MEM[Q+1].INT:=V;GOTO 10;END;{931:} R:=MEM[P+1].HH.RH;WHILE MEM[R].HH.LH<>0 DO R:=MEM[R].HH.RH; MEM[R+1].INT:=SLOWADD(MEM[R+1].INT,V);IF Q=0 THEN BEGIN Q:=GETNODE(2); CUREXP:=Q;CURTYPE:=MEM[P].HH.B0;MEM[Q].HH.B1:=11;END; MEM[Q+1].HH.RH:=MEM[P+1].HH.RH;MEM[Q].HH.B0:=MEM[P].HH.B0; MEM[Q+1].HH.LH:=MEM[P+1].HH.LH;MEM[MEM[P+1].HH.LH].HH.RH:=Q; MEM[P].HH.B0:=16;{:931};END ELSE BEGIN IF C=70 THEN NEGATEDEPLIS(V); {932:}IF MEM[P].HH.B0=16 THEN{933:} BEGIN WHILE MEM[V].HH.LH<>0 DO V:=MEM[V].HH.RH; MEM[V+1].INT:=SLOWADD(MEM[P+1].INT,MEM[V+1].INT);END{:933} ELSE BEGIN S:=MEM[P].HH.B0;R:=MEM[P+1].HH.RH; IF T=17 THEN BEGIN IF S=17 THEN IF MAXCOEF(R)+MAXCOEF(V)<626349397 THEN BEGIN V:=PPLUSQ(V,R,17);GOTO 30;END;T:=18;V:=POVERV(V,65536,17,18);END; IF S=18 THEN V:=PPLUSQ(V,R,18)ELSE V:=PPLUSFQ(V,65536,R,18,17);30:{934:} IF Q<>0 THEN DEPFINISH(V,Q,T)ELSE BEGIN CURTYPE:=T;DEPFINISH(V,0,T); END{:934};END{:932};END;10:END;{:930}{943:}PROCEDURE DEPMULT(P:HALFWORD; V:INTEGER;VISSCALED:BOOLEAN);LABEL 10;VAR Q:HALFWORD;S,T:SMALLNUMBER; BEGIN IF P=0 THEN Q:=CUREXP ELSE IF MEM[P].HH.B0<>16 THEN Q:=P ELSE BEGIN IF VISSCALED THEN MEM[P+1].INT:=TAKESCALED(MEM[P+1].INT,V)ELSE MEM [P+1].INT:=TAKEFRACTION(MEM[P+1].INT,V);GOTO 10;END;T:=MEM[Q].HH.B0; Q:=MEM[Q+1].HH.RH;S:=T; IF T=17 THEN IF VISSCALED THEN IF ABVSCD(MAXCOEF(Q),ABS(V),626349396, 65536)>=0 THEN T:=18;Q:=PTIMESV(Q,V,S,T,VISSCALED);DEPFINISH(Q,P,T); 10:END;{:943}{946:}PROCEDURE HARDTIMES(P:HALFWORD);VAR Q:HALFWORD; R:HALFWORD;U,V:SCALED; BEGIN IF MEM[P].HH.B0=14 THEN BEGIN Q:=STASHCUREXP;UNSTASHCUREX(P);P:=Q; END;R:=MEM[CUREXP+1].INT;U:=MEM[R+1].INT;V:=MEM[R+3].INT;{947:} MEM[R+2].HH.B0:=MEM[P].HH.B0;NEWDEP(R+2,COPYDEPLIST(MEM[P+1].HH.RH)); MEM[R].HH.B0:=MEM[P].HH.B0;MEM[R+1]:=MEM[P+1]; MEM[MEM[P+1].HH.LH].HH.RH:=R;FREENODE(P,2){:947};DEPMULT(R,U,TRUE); DEPMULT(R+2,V,TRUE);END;{:946}{949:}PROCEDURE DEPDIV(P:HALFWORD; V:SCALED);LABEL 10;VAR Q:HALFWORD;S,T:SMALLNUMBER; BEGIN IF P=0 THEN Q:=CUREXP ELSE IF MEM[P].HH.B0<>16 THEN Q:=P ELSE BEGIN MEM[P+1].INT:=MAKESCALED(MEM[P+1].INT,V);GOTO 10;END; T:=MEM[Q].HH.B0;Q:=MEM[Q+1].HH.RH;S:=T; IF T=17 THEN IF ABVSCD(MAXCOEF(Q),65536,626349396,ABS(V))>=0 THEN T:=18; Q:=POVERV(Q,V,S,T);DEPFINISH(Q,P,T);10:END;{:949}{953:} PROCEDURE SETUPTRANS(C:QUARTERWORD);LABEL 30,10;VAR P,Q,R:HALFWORD; BEGIN IF(C<>88)OR(CURTYPE<>13)THEN{955:}BEGIN P:=STASHCUREXP; CUREXP:=IDTRANSFORM;CURTYPE:=13;Q:=MEM[CUREXP+1].INT;CASE C OF{957:} 84:IF MEM[P].HH.B0=16 THEN{958:} BEGIN NSINCOS((MEM[P+1].INT MOD 23592960)*16); MEM[Q+5].INT:=ROUNDFRACTIO(NCOS);MEM[Q+9].INT:=ROUNDFRACTIO(NSIN); MEM[Q+7].INT:=-MEM[Q+9].INT;MEM[Q+11].INT:=MEM[Q+5].INT;GOTO 30; END{:958};85:IF MEM[P].HH.B0>14 THEN BEGIN INSTALL(Q+6,P);GOTO 30;END; 86:IF MEM[P].HH.B0>14 THEN BEGIN INSTALL(Q+4,P);INSTALL(Q+10,P);GOTO 30; END;87:IF MEM[P].HH.B0=14 THEN BEGIN R:=MEM[P+1].INT;INSTALL(Q,R); INSTALL(Q+2,R+2);GOTO 30;END; 89:IF MEM[P].HH.B0>14 THEN BEGIN INSTALL(Q+4,P);GOTO 30;END; 90:IF MEM[P].HH.B0>14 THEN BEGIN INSTALL(Q+10,P);GOTO 30;END; 91:IF MEM[P].HH.B0=14 THEN{959:}BEGIN R:=MEM[P+1].INT;INSTALL(Q+4,R); INSTALL(Q+10,R);INSTALL(Q+8,R+2); IF MEM[R+2].HH.B0=16 THEN MEM[R+3].INT:=-MEM[R+3].INT ELSE NEGATEDEPLIS( MEM[R+3].HH.RH);INSTALL(Q+6,R+2);GOTO 30;END{:959};88:;{:957}END; DISPERR(P,856);BEGIN HELPPTR:=3;HELPLINE[2]:=857;HELPLINE[1]:=858; HELPLINE[0]:=538;END;PUTGETERROR;30:RECYCLEVALUE(P);FREENODE(P,2); END{:955};{956:}Q:=MEM[CUREXP+1].INT;R:=Q+12;REPEAT R:=R-2; IF MEM[R].HH.B0<>16 THEN GOTO 10;UNTIL R=Q;TXX:=MEM[Q+5].INT; TXY:=MEM[Q+7].INT;TYX:=MEM[Q+9].INT;TYY:=MEM[Q+11].INT;TX:=MEM[Q+1].INT; TY:=MEM[Q+3].INT;FLUSHCUREXP(0){:956};10:END;{:953}{960:} PROCEDURE SETUPKNOWNTR(C:QUARTERWORD);BEGIN SETUPTRANS(C); IF CURTYPE<>16 THEN BEGIN DISPERR(0,859);BEGIN HELPPTR:=3; HELPLINE[2]:=860;HELPLINE[1]:=861;HELPLINE[0]:=538;END;PUTGETFLUSHE(0); TXX:=65536;TXY:=0;TYX:=0;TYY:=65536;TX:=0;TY:=0;END;END;{:960}{961:} PROCEDURE TRANS(P,Q:HALFWORD);VAR V:SCALED; BEGIN V:=TAKESCALED(MEM[P].INT,TXX)+TAKESCALED(MEM[Q].INT,TXY)+TX; MEM[Q].INT:=TAKESCALED(MEM[P].INT,TYX)+TAKESCALED(MEM[Q].INT,TYY)+TY; MEM[P].INT:=V;END;{:961}{962:}PROCEDURE PATHTRANS(P:HALFWORD; C:QUARTERWORD);LABEL 10;VAR Q:HALFWORD;BEGIN SETUPKNOWNTR(C); UNSTASHCUREX(P); IF CURTYPE=6 THEN BEGIN IF MEM[CUREXP+9].INT=0 THEN IF TX=0 THEN IF TY=0 THEN GOTO 10;FLUSHCUREXP(MAKEPATH(CUREXP));CURTYPE:=8;END;Q:=CUREXP; REPEAT IF MEM[Q].HH.B0<>0 THEN TRANS(Q+3,Q+4);TRANS(Q+1,Q+2); IF MEM[Q].HH.B1<>0 THEN TRANS(Q+5,Q+6);Q:=MEM[Q].HH.RH;UNTIL Q=CUREXP; 10:END;{:962}{963:}PROCEDURE EDGESTRANS(P:HALFWORD;C:QUARTERWORD); LABEL 10;BEGIN SETUPKNOWNTR(C);UNSTASHCUREX(P);CUREDGES:=CUREXP; IF MEM[CUREDGES].HH.RH=CUREDGES THEN GOTO 10; IF TXX=0 THEN IF TYY=0 THEN IF TXY MOD 65536=0 THEN IF TYX MOD 65536=0 THEN BEGIN XYSWAPEDGES;TXX:=TXY;TYY:=TYX;TXY:=0;TYX:=0; IF MEM[CUREDGES].HH.RH=CUREDGES THEN GOTO 10;END; IF TXY=0 THEN IF TYX=0 THEN IF TXX MOD 65536=0 THEN IF TYY MOD 65536=0 THEN{964:}BEGIN IF(TXX=0)OR(TYY=0)THEN BEGIN TOSSEDGES(CUREDGES); CUREXP:=GETNODE(6);INITEDGES(CUREXP); END ELSE BEGIN IF TXX<0 THEN BEGIN XREFLECTEDGE;TXX:=-TXX;END; IF TYY<0 THEN BEGIN YREFLECTEDGE;TYY:=-TYY;END; IF TXX<>65536 THEN XSCALEEDGES(TXX DIV 65536); IF TYY<>65536 THEN YSCALEEDGES(TYY DIV 65536);{965:} TX:=ROUNDUNSCALE(TX);TY:=ROUNDUNSCALE(TY); IF(MEM[CUREDGES+2].HH.LH+TX<=0)OR(MEM[CUREDGES+2].HH.RH+TX>=8192)OR(MEM[ CUREDGES+1].HH.LH+TY<=0)OR(MEM[CUREDGES+1].HH.RH+TY>=8191)OR(ABS(TX)>= 4096)OR(ABS(TY)>=4096)THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(865); END;BEGIN HELPPTR:=3;HELPLINE[2]:=866;HELPLINE[1]:=537;HELPLINE[0]:=538; END;PUTGETERROR; END ELSE BEGIN IF TX<>0 THEN BEGIN IF NOT(ABS(MEM[CUREDGES+3].HH.LH-TX -4096)<4096)THEN FIXOFFSET; MEM[CUREDGES+2].HH.LH:=MEM[CUREDGES+2].HH.LH+TX; MEM[CUREDGES+2].HH.RH:=MEM[CUREDGES+2].HH.RH+TX; MEM[CUREDGES+3].HH.LH:=MEM[CUREDGES+3].HH.LH-TX;MEM[CUREDGES+4].INT:=0; END;IF TY<>0 THEN BEGIN MEM[CUREDGES+1].HH.LH:=MEM[CUREDGES+1].HH.LH+TY; MEM[CUREDGES+1].HH.RH:=MEM[CUREDGES+1].HH.RH+TY; MEM[CUREDGES+5].HH.LH:=MEM[CUREDGES+5].HH.LH+TY;MEM[CUREDGES+4].INT:=0; END;END{:965};END;GOTO 10;END{:964}; BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT; REWRITE(TEMPFILE);PRINT(862);END;BEGIN HELPPTR:=3;HELPLINE[2]:=863; HELPLINE[1]:=864;HELPLINE[0]:=538;END;PUTGETERROR;10:END;{:963}{966:} {968:}PROCEDURE BILIN1(P:HALFWORD;T:SCALED;Q:HALFWORD;U,DELTA:SCALED); VAR R:HALFWORD;BEGIN IF T<>65536 THEN DEPMULT(P,T,TRUE); IF U<>0 THEN IF MEM[Q].HH.B0=16 THEN DELTA:=DELTA+TAKESCALED(MEM[Q+1]. INT,U)ELSE BEGIN{969:} IF MEM[P].HH.B0<>18 THEN BEGIN IF MEM[P].HH.B0=16 THEN NEWDEP(P, CONSTDEPENDE(MEM[P+1].INT))ELSE MEM[P+1].HH.RH:=PTIMESV(MEM[P+1].HH.RH, 65536,17,18,TRUE);MEM[P].HH.B0:=18;END{:969}; MEM[P+1].HH.RH:=PPLUSFQ(MEM[P+1].HH.RH,U,MEM[Q+1].HH.RH,18,MEM[Q].HH.B0) ;END; IF MEM[P].HH.B0=16 THEN MEM[P+1].INT:=MEM[P+1].INT+DELTA ELSE BEGIN R:= MEM[P+1].HH.RH;WHILE MEM[R].HH.LH<>0 DO R:=MEM[R].HH.RH; DELTA:=MEM[R+1].INT+DELTA; IF R<>MEM[P+1].HH.RH THEN MEM[R+1].INT:=DELTA ELSE BEGIN RECYCLEVALUE(P) ;MEM[P].HH.B0:=16;MEM[P+1].INT:=DELTA;END;END; IF FIXNEEDED THEN FIXDEPENDENC;END;{:968}{971:} PROCEDURE ADDMULTDEP(P:HALFWORD;V:SCALED;R:HALFWORD); BEGIN IF MEM[R].HH.B0=16 THEN MEM[DEPFINAL+1].INT:=MEM[DEPFINAL+1].INT+ TAKESCALED(MEM[R+1].INT,V)ELSE BEGIN MEM[P+1].HH.RH:=PPLUSFQ(MEM[P+1].HH .RH,V,MEM[R+1].HH.RH,18,MEM[R].HH.B0);IF FIXNEEDED THEN FIXDEPENDENC; END;END;{:971}{972:}PROCEDURE BILIN2(P,T:HALFWORD;V:SCALED; U,Q:HALFWORD);VAR VV:SCALED;BEGIN VV:=MEM[P+1].INT;MEM[P].HH.B0:=18; NEWDEP(P,CONSTDEPENDE(0));IF VV<>0 THEN ADDMULTDEP(P,VV,T); IF V<>0 THEN ADDMULTDEP(P,V,U);IF Q<>0 THEN ADDMULTDEP(P,65536,Q); IF MEM[P+1].HH.RH=DEPFINAL THEN BEGIN VV:=MEM[DEPFINAL+1].INT; RECYCLEVALUE(P);MEM[P].HH.B0:=16;MEM[P+1].INT:=VV;END;END;{:972}{974:} PROCEDURE BILIN3(P:HALFWORD;T,V,U,DELTA:SCALED); BEGIN IF T<>65536 THEN DELTA:=DELTA+TAKESCALED(MEM[P+1].INT,T)ELSE DELTA :=DELTA+MEM[P+1].INT; IF U<>0 THEN MEM[P+1].INT:=DELTA+TAKESCALED(V,U)ELSE MEM[P+1].INT:=DELTA ;END;{:974}PROCEDURE BIGTRANS(P:HALFWORD;C:QUARTERWORD);LABEL 10; VAR Q,R,PP,QQ:HALFWORD;S:SMALLNUMBER;BEGIN S:=BIGNODESIZE[MEM[P].HH.B0]; Q:=MEM[P+1].INT;R:=Q+S;REPEAT R:=R-2;IF MEM[R].HH.B0<>16 THEN{967:} BEGIN SETUPKNOWNTR(C);MAKEEXPCOPY(P);R:=MEM[CUREXP+1].INT; IF CURTYPE=13 THEN BEGIN BILIN1(R+10,TYY,Q+6,TYX,0); BILIN1(R+8,TYY,Q+4,TYX,0);BILIN1(R+6,TXX,Q+10,TXY,0); BILIN1(R+4,TXX,Q+8,TXY,0);END;BILIN1(R+2,TYY,Q,TYX,TY); BILIN1(R,TXX,Q+2,TXY,TX);GOTO 10;END{:967};UNTIL R=Q;{970:} SETUPTRANS(C);IF CURTYPE=16 THEN{973:}BEGIN MAKEEXPCOPY(P); R:=MEM[CUREXP+1].INT; IF CURTYPE=13 THEN BEGIN BILIN3(R+10,TYY,MEM[Q+7].INT,TYX,0); BILIN3(R+8,TYY,MEM[Q+5].INT,TYX,0);BILIN3(R+6,TXX,MEM[Q+11].INT,TXY,0); BILIN3(R+4,TXX,MEM[Q+9].INT,TXY,0);END; BILIN3(R+2,TYY,MEM[Q+1].INT,TYX,TY);BILIN3(R,TXX,MEM[Q+3].INT,TXY,TX); END{:973}ELSE BEGIN PP:=STASHCUREXP;QQ:=MEM[PP+1].INT;MAKEEXPCOPY(P); R:=MEM[CUREXP+1].INT; IF CURTYPE=13 THEN BEGIN BILIN2(R+10,QQ+10,MEM[Q+7].INT,QQ+8,0); BILIN2(R+8,QQ+10,MEM[Q+5].INT,QQ+8,0); BILIN2(R+6,QQ+4,MEM[Q+11].INT,QQ+6,0); BILIN2(R+4,QQ+4,MEM[Q+9].INT,QQ+6,0);END; BILIN2(R+2,QQ+10,MEM[Q+1].INT,QQ+8,QQ+2); BILIN2(R,QQ+4,MEM[Q+3].INT,QQ+6,QQ);RECYCLEVALUE(PP);FREENODE(PP,2);END; {:970};10:END;{:966}{976:}PROCEDURE CAT(P:HALFWORD);VAR A,B:STRNUMBER; K:POOLPOINTER;BEGIN A:=MEM[P+1].INT;B:=CUREXP; BEGIN IF POOLPTR+(STRSTART[A+1]-STRSTART[A])+(STRSTART[B+1]-STRSTART[B]) >MAXPOOLPTR THEN BEGIN IF POOLPTR+(STRSTART[A+1]-STRSTART[A])+(STRSTART[ B+1]-STRSTART[B])>POOLSIZE THEN OVERFLOW(257,POOLSIZE-INITPOOLPTR); MAXPOOLPTR:=POOLPTR+(STRSTART[A+1]-STRSTART[A])+(STRSTART[B+1]-STRSTART[ B]);END;END; FOR K:=STRSTART[A]TO STRSTART[A+1]-1 DO BEGIN STRPOOL[POOLPTR]:=STRPOOL[ K];POOLPTR:=POOLPTR+1;END; FOR K:=STRSTART[B]TO STRSTART[B+1]-1 DO BEGIN STRPOOL[POOLPTR]:=STRPOOL[ K];POOLPTR:=POOLPTR+1;END;CUREXP:=MAKESTRING; BEGIN IF STRREF[B]<127 THEN IF STRREF[B]>1 THEN STRREF[B]:=STRREF[B]-1 ELSE FLUSHSTRING(B);END;END;{:976}{977:} PROCEDURE CHOPSTRING(P:HALFWORD);VAR A,B:INTEGER;L:INTEGER;K:INTEGER; S:STRNUMBER;REVERSED:BOOLEAN;BEGIN A:=ROUNDUNSCALE(MEM[P+1].INT); B:=ROUNDUNSCALE(MEM[P+3].INT); IF A<=B THEN REVERSED:=FALSE ELSE BEGIN REVERSED:=TRUE;K:=A;A:=B;B:=K; END;S:=CUREXP;L:=(STRSTART[S+1]-STRSTART[S]);IF A<0 THEN BEGIN A:=0; IF B<0 THEN B:=0;END;IF B>L THEN BEGIN B:=L;IF A>L THEN A:=L;END; BEGIN IF POOLPTR+B-A>MAXPOOLPTR THEN BEGIN IF POOLPTR+B-A>POOLSIZE THEN OVERFLOW(257,POOLSIZE-INITPOOLPTR);MAXPOOLPTR:=POOLPTR+B-A;END;END; IF REVERSED THEN FOR K:=STRSTART[S]+B-1 DOWNTO STRSTART[S]+A DO BEGIN STRPOOL[POOLPTR]:=STRPOOL[K];POOLPTR:=POOLPTR+1; END ELSE FOR K:=STRSTART[S]+A TO STRSTART[S]+B-1 DO BEGIN STRPOOL[ POOLPTR]:=STRPOOL[K];POOLPTR:=POOLPTR+1;END;CUREXP:=MAKESTRING; BEGIN IF STRREF[S]<127 THEN IF STRREF[S]>1 THEN STRREF[S]:=STRREF[S]-1 ELSE FLUSHSTRING(S);END;END;{:977}{978:}PROCEDURE CHOPPATH(P:HALFWORD); VAR Q:HALFWORD;PP,QQ,RR,SS:HALFWORD;A,B,K,L:SCALED;REVERSED:BOOLEAN; BEGIN L:=PATHLENGTH;A:=MEM[P+1].INT;B:=MEM[P+3].INT; IF A<=B THEN REVERSED:=FALSE ELSE BEGIN REVERSED:=TRUE;K:=A;A:=B;B:=K; END;{979:}IF A<0 THEN IF MEM[CUREXP].HH.B0=0 THEN BEGIN A:=0; IF B<0 THEN B:=0;END ELSE REPEAT A:=A+L;B:=B+L;UNTIL A>=0; IF B>L THEN IF MEM[CUREXP].HH.B0=0 THEN BEGIN B:=L;IF A>L THEN A:=L; END ELSE WHILE A>=L DO BEGIN A:=A-L;B:=B-L;END{:979};Q:=CUREXP; WHILE A>=65536 DO BEGIN Q:=MEM[Q].HH.RH;A:=A-65536;B:=B-65536;END; IF B=A THEN{981:}BEGIN IF A>0 THEN BEGIN QQ:=MEM[Q].HH.RH; SPLITCUBIC(Q,A*4096,MEM[QQ+1].INT,MEM[QQ+2].INT);Q:=MEM[Q].HH.RH;END; PP:=COPYKNOT(Q);QQ:=PP;END{:981}ELSE{980:}BEGIN PP:=COPYKNOT(Q);QQ:=PP; REPEAT Q:=MEM[Q].HH.RH;RR:=QQ;QQ:=COPYKNOT(Q);MEM[RR].HH.RH:=QQ; B:=B-65536;UNTIL B<=0;IF A>0 THEN BEGIN SS:=PP;PP:=MEM[PP].HH.RH; SPLITCUBIC(SS,A*4096,MEM[PP+1].INT,MEM[PP+2].INT);PP:=MEM[SS].HH.RH; FREENODE(SS,7);IF RR=SS THEN BEGIN B:=MAKESCALED(B,65536-A);RR:=PP;END; END; IF B<0 THEN BEGIN SPLITCUBIC(RR,(B+65536)*4096,MEM[QQ+1].INT,MEM[QQ+2]. INT);FREENODE(QQ,7);QQ:=MEM[RR].HH.RH;END;END{:980};MEM[PP].HH.B0:=0; MEM[QQ].HH.B1:=0;MEM[QQ].HH.RH:=PP;TOSSKNOTLIST(CUREXP); IF REVERSED THEN BEGIN CUREXP:=MEM[HTAPYPOC(PP)].HH.RH;TOSSKNOTLIST(PP); END ELSE CUREXP:=PP;END;{:978}{982:}PROCEDURE PAIRVALUE(X,Y:SCALED); VAR P:HALFWORD;BEGIN P:=GETNODE(2);FLUSHCUREXP(P);CURTYPE:=14; MEM[P].HH.B0:=14;MEM[P].HH.B1:=11;INITBIGNODE(P);P:=MEM[P+1].INT; MEM[P].HH.B0:=16;MEM[P+1].INT:=X;MEM[P+2].HH.B0:=16;MEM[P+3].INT:=Y;END; {:982}{984:}PROCEDURE SETUPOFFSET(P:HALFWORD); BEGIN FINDOFFSET(MEM[P+1].INT,MEM[P+3].INT,CUREXP);PAIRVALUE(CURX,CURY); END;PROCEDURE SETUPDIRECTI(P:HALFWORD); BEGIN FLUSHCUREXP(FINDDIRECTIO(MEM[P+1].INT,MEM[P+3].INT,CUREXP));END; {:984}{985:}PROCEDURE FINDPOINT(V:SCALED;C:QUARTERWORD);VAR P:HALFWORD; N:SCALED;Q:HALFWORD;BEGIN P:=CUREXP; IF MEM[P].HH.B0=0 THEN N:=-65536 ELSE N:=0;REPEAT P:=MEM[P].HH.RH; N:=N+65536;UNTIL P=CUREXP; IF N=0 THEN V:=0 ELSE IF V<0 THEN IF MEM[P].HH.B0=0 THEN V:=0 ELSE V:=N -1-((-V-1)MOD N)ELSE IF V>N THEN IF MEM[P].HH.B0=0 THEN V:=N ELSE V:=V MOD N;P:=CUREXP;WHILE V>=65536 DO BEGIN P:=MEM[P].HH.RH;V:=V-65536;END; IF V<>0 THEN{986:}BEGIN Q:=MEM[P].HH.RH; SPLITCUBIC(P,V*4096,MEM[Q+1].INT,MEM[Q+2].INT);P:=MEM[P].HH.RH;END{:986} ;{987:}CASE C OF 97:PAIRVALUE(MEM[P+1].INT,MEM[P+2].INT); 98:IF MEM[P].HH.B0=0 THEN PAIRVALUE(MEM[P+1].INT,MEM[P+2].INT)ELSE PAIRVALUE(MEM[P+3].INT,MEM[P+4].INT); 99:IF MEM[P].HH.B1=0 THEN PAIRVALUE(MEM[P+1].INT,MEM[P+2].INT)ELSE PAIRVALUE(MEM[P+5].INT,MEM[P+6].INT);END{:987};END;{:985} PROCEDURE DOBINARY(P:HALFWORD;C:QUARTERWORD);LABEL 30,31,10; VAR Q,R,RR:HALFWORD;OLDP,OLDEXP:HALFWORD;V:INTEGER; BEGIN BEGIN IF ARITHERROR THEN CLEARARITH;END; IF INTERNAL[7]>131072 THEN{924:}BEGIN BEGINDIAGNOS;PRINTNL(848); PRINTEXP(P,0);PRINTCHAR(41);PRINTOP(C);PRINTCHAR(40);PRINTEXP(0,0); PRINT(840);ENDDIAGNOSTI(FALSE);END{:924};{926:} CASE MEM[P].HH.B0 OF 13,14:OLDP:=TARNISHED(P);19:OLDP:=1; OTHERWISE OLDP:=0 END;IF OLDP<>0 THEN BEGIN Q:=STASHCUREXP;OLDP:=P; MAKEEXPCOPY(OLDP);P:=STASHCUREXP;UNSTASHCUREX(Q);END;{:926};{927:} CASE CURTYPE OF 13,14:OLDEXP:=TARNISHED(CUREXP);19:OLDEXP:=1; OTHERWISE OLDEXP:=0 END;IF OLDEXP<>0 THEN BEGIN OLDEXP:=CUREXP; MAKEEXPCOPY(OLDEXP);END{:927};CASE C OF 69,70:{929:} IF(CURTYPE<14)OR(MEM[P].HH.B0<14)THEN IF(CURTYPE=11)AND(MEM[P].HH.B0=11) THEN BEGIN IF C=70 THEN NEGATEEDGES(CUREXP);CUREDGES:=CUREXP; MERGEEDGES(MEM[P+1].INT); END ELSE BADBINARY(P,C)ELSE IF CURTYPE=14 THEN IF MEM[P].HH.B0<>14 THEN BADBINARY(P,C)ELSE BEGIN Q:=MEM[P+1].INT;R:=MEM[CUREXP+1].INT; ADDORSUBTRAC(Q,R,C);ADDORSUBTRAC(Q+2,R+2,C); END ELSE IF MEM[P].HH.B0=14 THEN BADBINARY(P,C)ELSE ADDORSUBTRAC(P,0,C){ :929};{936:} 77,78,79,80,81,82:BEGIN IF(CURTYPE>14)AND(MEM[P].HH.B0>14)THEN ADDORSUBTRAC(P,0,70)ELSE IF CURTYPE<>MEM[P].HH.B0 THEN BEGIN BADBINARY(P ,C);GOTO 30; END ELSE IF CURTYPE=4 THEN FLUSHCUREXP(STRVSSTR(MEM[P+1].INT,CUREXP)) ELSE IF(CURTYPE=5)OR(CURTYPE=3)THEN{938:}BEGIN Q:=MEM[CUREXP+1].INT; WHILE(Q<>CUREXP)AND(Q<>P)DO Q:=MEM[Q+1].INT;IF Q=P THEN FLUSHCUREXP(0); END{:938}ELSE IF(CURTYPE=14)OR(CURTYPE=13)THEN{939:} BEGIN Q:=MEM[P+1].INT;R:=MEM[CUREXP+1].INT;RR:=R+BIGNODESIZE[CURTYPE]-2; WHILE TRUE DO BEGIN ADDORSUBTRAC(Q,R,70); IF MEM[R].HH.B0<>16 THEN GOTO 31;IF MEM[R+1].INT<>0 THEN GOTO 31; IF R=RR THEN GOTO 31;Q:=Q+2;R:=R+2;END; 31:TAKEPART(53+(R-MEM[CUREXP+1].INT)DIV 2);END{:939} ELSE IF CURTYPE=2 THEN FLUSHCUREXP(CUREXP-MEM[P+1].INT)ELSE BEGIN BADBINARY(P,C);GOTO 30;END;{937:} IF CURTYPE<>16 THEN BEGIN IF CURTYPE<16 THEN BEGIN DISPERR(P,285); BEGIN HELPPTR:=1;HELPLINE[0]:=849;END END ELSE BEGIN HELPPTR:=2; HELPLINE[1]:=850;HELPLINE[0]:=851;END;DISPERR(0,852);PUTGETFLUSHE(31); END ELSE CASE C OF 77:IF CUREXP<0 THEN CUREXP:=30 ELSE CUREXP:=31; 78:IF CUREXP<=0 THEN CUREXP:=30 ELSE CUREXP:=31; 79:IF CUREXP>0 THEN CUREXP:=30 ELSE CUREXP:=31; 80:IF CUREXP>=0 THEN CUREXP:=30 ELSE CUREXP:=31; 81:IF CUREXP=0 THEN CUREXP:=30 ELSE CUREXP:=31; 82:IF CUREXP<>0 THEN CUREXP:=30 ELSE CUREXP:=31;END;CURTYPE:=2{:937}; 30:END;{:936}{940:} 76,75:IF(MEM[P].HH.B0<>2)OR(CURTYPE<>2)THEN BADBINARY(P,C)ELSE IF MEM[P +1].INT=C-45 THEN CUREXP:=MEM[P+1].INT;{:940}{941:} 71:IF(CURTYPE<14)OR(MEM[P].HH.B0<14)THEN BADBINARY(P,71)ELSE IF(CURTYPE= 16)OR(MEM[P].HH.B0=16)THEN{942:} BEGIN IF MEM[P].HH.B0=16 THEN BEGIN V:=MEM[P+1].INT;FREENODE(P,2); END ELSE BEGIN V:=CUREXP;UNSTASHCUREX(P);END; IF CURTYPE=16 THEN CUREXP:=TAKESCALED(CUREXP,V)ELSE IF CURTYPE=14 THEN BEGIN P:=MEM[CUREXP+1].INT;DEPMULT(P,V,TRUE);DEPMULT(P+2,V,TRUE); END ELSE DEPMULT(0,V,TRUE);GOTO 10;END{:942} ELSE IF(NICEPAIR(P,MEM[P].HH.B0)AND(CURTYPE>14))OR(NICEPAIR(CUREXP, CURTYPE)AND(MEM[P].HH.B0>14))THEN BEGIN HARDTIMES(P);GOTO 10; END ELSE BADBINARY(P,71);{:941}{948:} 72:IF(CURTYPE<>16)OR(MEM[P].HH.B0<14)THEN BADBINARY(P,72)ELSE BEGIN V:= CUREXP;UNSTASHCUREX(P);IF V=0 THEN{950:}BEGIN DISPERR(0,782); BEGIN HELPPTR:=2;HELPLINE[1]:=854;HELPLINE[0]:=855;END;PUTGETERROR; END{:950} ELSE BEGIN IF CURTYPE=16 THEN CUREXP:=MAKESCALED(CUREXP,V)ELSE IF CURTYPE=14 THEN BEGIN P:=MEM[CUREXP+1].INT;DEPDIV(P,V);DEPDIV(P+2,V); END ELSE DEPDIV(0,V);END;GOTO 10;END;{:948}{951:} 73,74:IF(CURTYPE=16)AND(MEM[P].HH.B0=16)THEN IF C=73 THEN CUREXP:= PYTHADD(MEM[P+1].INT,CUREXP)ELSE CUREXP:=PYTHSUB(MEM[P+1].INT,CUREXP) ELSE BADBINARY(P,C);{:951}{952:} 84,85,86,87,88,89,90,91:IF(MEM[P].HH.B0=9)OR(MEM[P].HH.B0=8)OR(MEM[P].HH .B0=6)THEN BEGIN PATHTRANS(P,C);GOTO 10; END ELSE IF(MEM[P].HH.B0=14)OR(MEM[P].HH.B0=13)THEN BIGTRANS(P,C)ELSE IF MEM[P].HH.B0=11 THEN BEGIN EDGESTRANS(P,C);GOTO 10; END ELSE BADBINARY(P,C);{:952}{975:} 83:IF(CURTYPE=4)AND(MEM[P].HH.B0=4)THEN CAT(P)ELSE BADBINARY(P,83); 94:IF NICEPAIR(P,MEM[P].HH.B0)AND(CURTYPE=4)THEN CHOPSTRING(MEM[P+1].INT )ELSE BADBINARY(P,94);95:BEGIN IF CURTYPE=14 THEN PAIRTOPATH; IF NICEPAIR(P,MEM[P].HH.B0)AND(CURTYPE=9)THEN CHOPPATH(MEM[P+1].INT)ELSE BADBINARY(P,95);END;{:975}{983:} 97,98,99:BEGIN IF CURTYPE=14 THEN PAIRTOPATH; IF(CURTYPE=9)AND(MEM[P].HH.B0=16)THEN FINDPOINT(MEM[P+1].INT,C)ELSE BADBINARY(P,C);END;100:BEGIN IF CURTYPE=8 THEN MATERIALIZEP; IF(CURTYPE=6)AND NICEPAIR(P,MEM[P].HH.B0)THEN SETUPOFFSET(MEM[P+1].INT) ELSE BADBINARY(P,100);END;96:BEGIN IF CURTYPE=14 THEN PAIRTOPATH; IF(CURTYPE=9)AND NICEPAIR(P,MEM[P].HH.B0)THEN SETUPDIRECTI(MEM[P+1].INT) ELSE BADBINARY(P,96);END;{:983}{988:} 92:BEGIN IF MEM[P].HH.B0=14 THEN BEGIN Q:=STASHCUREXP;UNSTASHCUREX(P); PAIRTOPATH;P:=STASHCUREXP;UNSTASHCUREX(Q);END; IF CURTYPE=14 THEN PAIRTOPATH; IF(CURTYPE=9)AND(MEM[P].HH.B0=9)THEN BEGIN PATHINTERSEC(MEM[P+1].INT, CUREXP);PAIRVALUE(CURT,CURTT);END ELSE BADBINARY(P,92);END;{:988}END; RECYCLEVALUE(P);FREENODE(P,2);10:BEGIN IF ARITHERROR THEN CLEARARITH; END;{925:}IF OLDP<>0 THEN BEGIN RECYCLEVALUE(OLDP);FREENODE(OLDP,2);END; IF OLDEXP<>0 THEN BEGIN RECYCLEVALUE(OLDEXP);FREENODE(OLDEXP,2); END{:925};END;{:922}{944:}PROCEDURE FRACMULT(N,D:SCALED);VAR P:HALFWORD; OLDEXP:HALFWORD;V:FRACTION;BEGIN IF INTERNAL[7]>131072 THEN{945:} BEGIN BEGINDIAGNOS;PRINTNL(848);PRINTSCALED(N);PRINTCHAR(47); PRINTSCALED(D);PRINT(853);PRINTEXP(0,0);PRINT(840);ENDDIAGNOSTI(FALSE); END{:945};CASE CURTYPE OF 13,14:OLDEXP:=TARNISHED(CUREXP);19:OLDEXP:=1; OTHERWISE OLDEXP:=0 END;IF OLDEXP<>0 THEN BEGIN OLDEXP:=CUREXP; MAKEEXPCOPY(OLDEXP);END;V:=MAKEFRACTION(N,D); IF CURTYPE=16 THEN CUREXP:=TAKEFRACTION(CUREXP,V)ELSE IF CURTYPE=14 THEN BEGIN P:=MEM[CUREXP+1].INT;DEPMULT(P,V,FALSE);DEPMULT(P+2,V,FALSE); END ELSE DEPMULT(0,V,FALSE); IF OLDEXP<>0 THEN BEGIN RECYCLEVALUE(OLDEXP);FREENODE(OLDEXP,2);END END; {:944}{989:}{1155:}PROCEDURE GFSWAP; BEGIN IF GFLIMIT=GFBUFSIZE THEN BEGIN WRITE(GFFILE,GBUFFER.L); GFLIMIT:=HALFBUF;GFOFFSET:=GFOFFSET+GFBUFSIZE;GFPTR:=0; END ELSE BEGIN WRITE(GFFILE,GBUFFER.R);GFLIMIT:=GFBUFSIZE;END;END; {:1155}{1157:}PROCEDURE GFFOUR(X:INTEGER); BEGIN IF X>=0 THEN BEGIN GBUFFER.B[GFPTR]:=X DIV 16777216; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP; END ELSE BEGIN X:=X+1073741824;X:=X+1073741824; BEGIN GBUFFER.B[GFPTR]:=(X DIV 16777216)+128;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;END;X:=X MOD 16777216; BEGIN GBUFFER.B[GFPTR]:=X DIV 65536;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;X:=X MOD 65536; BEGIN GBUFFER.B[GFPTR]:=X DIV 256;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;BEGIN GBUFFER.B[GFPTR]:=X MOD 256; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END;END;{:1157}{1158:} PROCEDURE GFTWO(X:INTEGER);BEGIN BEGIN GBUFFER.B[GFPTR]:=X DIV 256; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END; BEGIN GBUFFER.B[GFPTR]:=X MOD 256;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;END;PROCEDURE GFTHREE(X:INTEGER); BEGIN BEGIN GBUFFER.B[GFPTR]:=X DIV 65536;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END; BEGIN GBUFFER.B[GFPTR]:=(X MOD 65536)DIV 256;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;BEGIN GBUFFER.B[GFPTR]:=X MOD 256; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END;END;{:1158}{1159:} PROCEDURE GFPAINT(D:INTEGER); BEGIN IF D<64 THEN BEGIN GBUFFER.B[GFPTR]:=0+D;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP; END ELSE IF D<256 THEN BEGIN BEGIN GBUFFER.B[GFPTR]:=64;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;BEGIN GBUFFER.B[GFPTR]:=D; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END; END ELSE BEGIN BEGIN GBUFFER.B[GFPTR]:=65;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;GFTWO(D);END;END;{:1159}{1160:} PROCEDURE GFSTRING(S,T:STRNUMBER);VAR K:POOLPOINTER;L:INTEGER; BEGIN IF S<>0 THEN BEGIN L:=(STRSTART[S+1]-STRSTART[S]); IF T<>0 THEN L:=L+(STRSTART[T+1]-STRSTART[T]); IF L<=255 THEN BEGIN BEGIN GBUFFER.B[GFPTR]:=239;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;BEGIN GBUFFER.B[GFPTR]:=L; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END; END ELSE BEGIN BEGIN GBUFFER.B[GFPTR]:=241;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;GFTHREE(L);END; FOR K:=STRSTART[S]TO STRSTART[S+1]-1 DO BEGIN GBUFFER.B[GFPTR]:=STRPOOL[ K];GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END;END; IF T<>0 THEN FOR K:=STRSTART[T]TO STRSTART[T+1]-1 DO BEGIN GBUFFER.B[ GFPTR]:=STRPOOL[K];GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END;END; {:1160}{1161:}PROCEDURE GFBOC(MINM,MAXM,MINN,MAXN:INTEGER);LABEL 10; BEGIN IF MINMGFMAXN THEN GFMAXN:=MAXN; IF BOCP=-1 THEN IF BOCC>=0 THEN IF BOCC<256 THEN IF MAXM-MINM>=0 THEN IF MAXM-MINM<256 THEN IF MAXM>=0 THEN IF MAXM<256 THEN IF MAXN-MINN>=0 THEN IF MAXN-MINN<256 THEN IF MAXN>=0 THEN IF MAXN<256 THEN BEGIN BEGIN GBUFFER.B[GFPTR]:=68;GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END; BEGIN GBUFFER.B[GFPTR]:=BOCC;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;BEGIN GBUFFER.B[GFPTR]:=MAXM-MINM; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END; BEGIN GBUFFER.B[GFPTR]:=MAXM;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;BEGIN GBUFFER.B[GFPTR]:=MAXN-MINN; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END; BEGIN GBUFFER.B[GFPTR]:=MAXN;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;GOTO 10;END;BEGIN GBUFFER.B[GFPTR]:=67; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END;GFFOUR(BOCC); GFFOUR(BOCP);GFFOUR(MINM);GFFOUR(MAXM);GFFOUR(MINN);GFFOUR(MAXN);10:END; {:1161}{1163:}PROCEDURE INITGF;VAR K:EIGHTBITS;T:INTEGER; BEGIN GFMINM:=4096;GFMAXM:=-4096;GFMINN:=4096;GFMAXN:=-4096; FOR K:=0 TO 255 DO CHARPTR[K]:=-1;{1164:} IF INTERNAL[27]<=0 THEN GFEXT:=1052 ELSE BEGIN OLDSETTING:=SELECTOR; SELECTOR:=5;PRINTCHAR(46);PRINTINT(MAKESCALED(INTERNAL[27],59429463)); PRINT(1053);GFEXT:=MAKESTRING;SELECTOR:=OLDSETTING;END{:1164}; BEGIN IF JOBNAME=0 THEN OPENLOGFILE;PACKJOBNAME(GFEXT); IF PACKDEFAULTN(GFQUAL,GFFNAME,GFFLEN)THEN BEGIN WHILE NOT BOPENOUT( GFFILE)DO PROMPTFILENA(754,GFEXT);OUTPUTFILENA:=BMAKENAMESTR(GFFILE); CLEARDEFAULT;END ELSE OUTPUTFILENA:=46;END;BEGIN GBUFFER.B[GFPTR]:=247; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END; BEGIN GBUFFER.B[GFPTR]:=131;GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP; END;OLDSETTING:=SELECTOR;SELECTOR:=5;PRINT(1051); PRINTINT(ROUNDUNSCALE(INTERNAL[14]));PRINTCHAR(46); PRINTDD(ROUNDUNSCALE(INTERNAL[15]));PRINTCHAR(46); PRINTDD(ROUNDUNSCALE(INTERNAL[16]));PRINTCHAR(58); T:=ROUNDUNSCALE(INTERNAL[17]);PRINTDD(T DIV 60);PRINTDD(T MOD 60); SELECTOR:=OLDSETTING;BEGIN GBUFFER.B[GFPTR]:=(POOLPTR-STRSTART[STRPTR]); GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END; STRSTART[STRPTR+1]:=POOLPTR;GFSTRING(0,STRPTR); POOLPTR:=STRSTART[STRPTR];GFPREVPTR:=GFOFFSET+GFPTR;END;{:1163}{1165:} PROCEDURE SHIPOUT(C:EIGHTBITS);LABEL 30;VAR F:INTEGER; PREVM,M,MM:INTEGER;PREVN,N:INTEGER;P,Q:HALFWORD;PREVW,W,WW:INTEGER; D:INTEGER;DELTA:INTEGER;CURMINM:INTEGER;XOFF,YOFF:INTEGER; BEGIN IF OUTPUTFILENA=0 THEN INITGF;F:=ROUNDUNSCALE(INTERNAL[19]); XOFF:=ROUNDUNSCALE(INTERNAL[29]);YOFF:=ROUNDUNSCALE(INTERNAL[30]); IF TERMOFFSET>MAXPRINTLINE-9 THEN PRINTLN ELSE IF(TERMOFFSET>0)OR( FILEOFFSET>0)THEN PRINTCHAR(32);PRINTCHAR(91);PRINTINT(C); IF F<>0 THEN BEGIN PRINTCHAR(46);PRINTINT(F);END; IF ODD(SELECTOR)THEN WRITELN(TERMOUT);BOCC:=256*F+C;BOCP:=CHARPTR[C]; CHARPTR[C]:=GFPREVPTR;IF INTERNAL[34]>0 THEN{1166:} BEGIN IF XOFF<>0 THEN BEGIN GFSTRING(438,0);BEGIN GBUFFER.B[GFPTR]:=243; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END;GFFOUR(XOFF*65536);END; IF YOFF<>0 THEN BEGIN GFSTRING(439,0);BEGIN GBUFFER.B[GFPTR]:=243; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END;GFFOUR(YOFF*65536);END; END{:1166};{1167:}PREVN:=4096;P:=MEM[CUREDGES].HH.LH; N:=MEM[CUREDGES+1].HH.RH-4096;WHILE P<>CUREDGES DO BEGIN{1169:} IF MEM[P+1].HH.LH>1 THEN SORTEDGES(P);Q:=MEM[P+1].HH.RH;W:=0; PREVM:=-268435456;WW:=0;PREVW:=0;M:=PREVM; REPEAT IF Q=65534 THEN MM:=268435456 ELSE BEGIN D:=MEM[Q].HH.LH; MM:=D DIV 8;WW:=WW+(D MOD 8)-4;END; IF MM<>M THEN BEGIN IF PREVW<=0 THEN BEGIN IF W>0 THEN{1170:} BEGIN IF PREVM=-268435456 THEN{1172:} BEGIN IF PREVN=4096 THEN BEGIN GFBOC(MEM[CUREDGES+2].HH.LH+XOFF-4096,MEM [CUREDGES+2].HH.RH+XOFF-4096,MEM[CUREDGES+1].HH.LH+YOFF-4096,N+YOFF); CURMINM:=MEM[CUREDGES+2].HH.LH-4096+MEM[CUREDGES+3].HH.LH; END ELSE IF PREVN>N+1 THEN{1174:}BEGIN DELTA:=PREVN-N-1; IF DELTA<256 THEN BEGIN BEGIN GBUFFER.B[GFPTR]:=71;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;BEGIN GBUFFER.B[GFPTR]:=DELTA; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END; END ELSE BEGIN BEGIN GBUFFER.B[GFPTR]:=72;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;GFTWO(DELTA);END;END{:1174}ELSE{1173:} BEGIN DELTA:=M-CURMINM;IF DELTA>164 THEN BEGIN GBUFFER.B[GFPTR]:=70; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP; END ELSE BEGIN BEGIN GBUFFER.B[GFPTR]:=74+DELTA;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;GOTO 30;END;END{:1173}; GFPAINT(M-CURMINM);30:PREVN:=N;END{:1172}ELSE GFPAINT(M-PREVM);PREVM:=M; PREVW:=W;END{:1170};END ELSE IF W<=0 THEN{1171:}BEGIN GFPAINT(M-PREVM); PREVM:=M;PREVW:=W;END{:1171};M:=MM;END;W:=WW;Q:=MEM[Q].HH.RH; UNTIL MM=268435456;IF W<>0 THEN PRINTNL(1055); IF PREVM-MEM[CUREDGES+3].HH.LH+XOFF>GFMAXM THEN GFMAXM:=PREVM-MEM[ CUREDGES+3].HH.LH+XOFF{:1169};P:=MEM[P].HH.LH;N:=N-1;END; IF PREVN=4096 THEN{1168:}BEGIN GFBOC(0,0,0,0); IF GFMAXM<0 THEN GFMAXM:=0;IF GFMINN>0 THEN GFMINN:=0;END{:1168} ELSE IF PREVN+YOFF0 THEN PRINTEDGES(1054,TRUE,XOFF,YOFF);END;{:1165}{995:} {1006:}PROCEDURE TRYEQ(L,R:HALFWORD);LABEL 30,31;VAR P:HALFWORD; T:16..19;Q:HALFWORD;PP:HALFWORD;TT:17..19;COPIED:BOOLEAN;BEGIN{1007:} T:=MEM[L].HH.B0;IF T=16 THEN BEGIN T:=17;P:=CONSTDEPENDE(-MEM[L+1].INT); Q:=P;END ELSE IF T=19 THEN BEGIN T:=17;P:=SINGLEDEPEND(L); MEM[P+1].INT:=-MEM[P+1].INT;Q:=DEPFINAL; END ELSE BEGIN P:=MEM[L+1].HH.RH;Q:=P; WHILE TRUE DO BEGIN MEM[Q+1].INT:=-MEM[Q+1].INT; IF MEM[Q].HH.LH=0 THEN GOTO 30;Q:=MEM[Q].HH.RH;END; 30:MEM[MEM[L+1].HH.LH].HH.RH:=MEM[Q].HH.RH; MEM[MEM[Q].HH.RH+1].HH.LH:=MEM[L+1].HH.LH;MEM[L].HH.B0:=16;END{:1007}; {1009:} IF R=0 THEN IF CURTYPE=16 THEN BEGIN MEM[Q+1].INT:=MEM[Q+1].INT+CUREXP; GOTO 31;END ELSE BEGIN TT:=CURTYPE; IF TT=19 THEN PP:=SINGLEDEPEND(CUREXP)ELSE PP:=MEM[CUREXP+1].HH.RH; END ELSE IF MEM[R].HH.B0=16 THEN BEGIN MEM[Q+1].INT:=MEM[Q+1].INT+MEM[R +1].INT;GOTO 31;END ELSE BEGIN TT:=MEM[R].HH.B0; IF TT=19 THEN PP:=SINGLEDEPEND(R)ELSE PP:=MEM[R+1].HH.RH;END; IF TT<>19 THEN COPIED:=FALSE ELSE BEGIN COPIED:=TRUE;TT:=17;END;{1010:} WATCHCOEFS:=FALSE; IF T=TT THEN P:=PPLUSQ(P,PP,T)ELSE IF T=18 THEN P:=PPLUSFQ(P,65536,PP,18 ,17)ELSE BEGIN Q:=P; WHILE MEM[Q].HH.LH<>0 DO BEGIN MEM[Q+1].INT:=ROUNDFRACTIO(MEM[Q+1].INT); Q:=MEM[Q].HH.RH;END;T:=18;P:=PPLUSQ(P,PP,T);END;WATCHCOEFS:=TRUE;{:1010} ;IF COPIED THEN FLUSHNODELIS(PP);31:{:1009}; IF MEM[P].HH.LH=0 THEN{1008:} BEGIN IF ABS(MEM[P+1].INT)>64 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(895); END;PRINT(897);PRINTSCALED(MEM[P+1].INT);PRINTCHAR(41);BEGIN HELPPTR:=2; HELPLINE[1]:=896;HELPLINE[0]:=894;END;PUTGETERROR; END ELSE IF R=0 THEN{623:} BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(598);END;BEGIN HELPPTR:=2; HELPLINE[1]:=599;HELPLINE[0]:=600;END;PUTGETERROR;END{:623}; FREENODE(P,2);END{:1008}ELSE BEGIN LINEAREQ(P,T); IF R=0 THEN IF CURTYPE<>16 THEN IF MEM[CUREXP].HH.B0=16 THEN BEGIN PP:= CUREXP;CUREXP:=MEM[CUREXP+1].INT;CURTYPE:=16;FREENODE(PP,2);END;END;END; {:1006}{1001:}PROCEDURE MAKEEQ(LHS:HALFWORD);LABEL 20,30,45; VAR T:SMALLNUMBER;V:INTEGER;P,Q:HALFWORD;BEGIN 20:T:=MEM[LHS].HH.B0; IF T<=14 THEN V:=MEM[LHS+1].INT;CASE T OF{1003:} 2,4,6,9,11:IF CURTYPE=T+1 THEN BEGIN NONLINEAREQ(V,CUREXP,FALSE); GOTO 30;END ELSE IF CURTYPE=T THEN{1004:} BEGIN IF CURTYPE<=4 THEN BEGIN IF CURTYPE=4 THEN BEGIN IF STRVSSTR(V, CUREXP)<>0 THEN GOTO 45;END ELSE IF V<>CUREXP THEN GOTO 45;{623:} BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(598);END;BEGIN HELPPTR:=2; HELPLINE[1]:=599;HELPLINE[0]:=600;END;PUTGETERROR;END{:623};GOTO 30;END; BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT; REWRITE(TEMPFILE);PRINT(892);END;BEGIN HELPPTR:=2;HELPLINE[1]:=893; HELPLINE[0]:=894;END;PUTGETERROR;GOTO 30; 45:BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(895);END;BEGIN HELPPTR:=2; HELPLINE[1]:=896;HELPLINE[0]:=894;END;PUTGETERROR;GOTO 30;END{:1004}; 3,5,7,12,10:IF CURTYPE=T-1 THEN BEGIN NONLINEAREQ(CUREXP,LHS,TRUE); GOTO 30;END ELSE IF CURTYPE=T THEN BEGIN RINGMERGE(LHS,CUREXP);GOTO 30; END ELSE IF CURTYPE=14 THEN IF T=10 THEN BEGIN PAIRTOPATH;GOTO 20;END; 13,14:IF CURTYPE=T THEN{1005:}BEGIN P:=V+BIGNODESIZE[T]; Q:=MEM[CUREXP+1].INT+BIGNODESIZE[T];REPEAT P:=P-2;Q:=Q-2;TRYEQ(P,Q); UNTIL P=V;GOTO 30;END{:1005}; 16,17,18,19:IF CURTYPE>=16 THEN BEGIN TRYEQ(LHS,0);GOTO 30;END;1:; {:1003}END;{1002:}DISPERR(LHS,285);DISPERR(0,889); IF MEM[LHS].HH.B0<=14 THEN PRINTTYPE(MEM[LHS].HH.B0)ELSE PRINT(341); PRINTCHAR(61);IF CURTYPE<=14 THEN PRINTTYPE(CURTYPE)ELSE PRINT(341); PRINTCHAR(41);BEGIN HELPPTR:=2;HELPLINE[1]:=890;HELPLINE[0]:=891;END; PUTGETERROR{:1002};30:BEGIN IF ARITHERROR THEN CLEARARITH;END; RECYCLEVALUE(LHS);FREENODE(LHS,2);END;{:1001}PROCEDURE DOASSIGNMENT; FORWARD;PROCEDURE DOEQUATION;VAR LHS:HALFWORD;P:HALFWORD; BEGIN LHS:=STASHCUREXP;GETXNEXT;VARFLAG:=77;SCANEXPRESSI; IF CURCMD=51 THEN DOEQUATION ELSE IF CURCMD=77 THEN DOASSIGNMENT; IF INTERNAL[7]>131072 THEN{997:}BEGIN BEGINDIAGNOS;PRINTNL(848); PRINTEXP(LHS,0);PRINT(884);PRINTEXP(0,0);PRINT(840);ENDDIAGNOSTI(FALSE); END{:997}; IF CURTYPE=10 THEN IF MEM[LHS].HH.B0=14 THEN BEGIN P:=STASHCUREXP; UNSTASHCUREX(LHS);LHS:=P;END;MAKEEQ(LHS);END;{:995}{996:} PROCEDURE DOASSIGNMENT;VAR LHS:HALFWORD;P:HALFWORD;Q:HALFWORD; BEGIN IF CURTYPE<>20 THEN BEGIN DISPERR(0,881);BEGIN HELPPTR:=2; HELPLINE[1]:=882;HELPLINE[0]:=883;END;ERROR;DOEQUATION; END ELSE BEGIN LHS:=CUREXP;CURTYPE:=1;GETXNEXT;VARFLAG:=77;SCANEXPRESSI; IF CURCMD=51 THEN DOEQUATION ELSE IF CURCMD=77 THEN DOASSIGNMENT; IF INTERNAL[7]>131072 THEN{998:}BEGIN BEGINDIAGNOS;PRINTNL(123); IF MEM[LHS].HH.LH>2369 THEN PRINT(INTNAME[MEM[LHS].HH.LH-(2369)])ELSE SHOWTOKENLIS(LHS,0,1000,0);PRINT(461);PRINTEXP(0,0);PRINTCHAR(125); ENDDIAGNOSTI(FALSE);END{:998};IF MEM[LHS].HH.LH>2369 THEN{999:} IF CURTYPE=16 THEN INTERNAL[MEM[LHS].HH.LH-(2369)]:=CUREXP ELSE BEGIN DISPERR(0,885);PRINT(INTNAME[MEM[LHS].HH.LH-(2369)]);PRINT(886); BEGIN HELPPTR:=2;HELPLINE[1]:=887;HELPLINE[0]:=888;END;PUTGETERROR; END{:999}ELSE{1000:}BEGIN P:=FINDVARIABLE(LHS); IF P<>0 THEN BEGIN Q:=STASHCUREXP;CURTYPE:=UNDTYPE(P);RECYCLEVALUE(P); MEM[P].HH.B0:=CURTYPE;MEM[P+1].INT:=0;MAKEEXPCOPY(P);P:=STASHCUREXP; UNSTASHCUREX(Q);MAKEEQ(P);END ELSE BEGIN OBLITERATED(LHS);PUTGETERROR; END;END{:1000};FLUSHNODELIS(LHS);END;END;{:996}{1015:} PROCEDURE DOTYPEDECLAR;VAR T:SMALLNUMBER;P:HALFWORD;Q:HALFWORD; BEGIN IF CURMOD>=13 THEN T:=CURMOD ELSE T:=CURMOD+1; REPEAT P:=SCANDECLARED; FLUSHVARIABL(EQTB[MEM[P].HH.LH].RH,MEM[P].HH.RH,FALSE); Q:=FINDVARIABLE(P);IF Q<>0 THEN BEGIN MEM[Q].HH.B0:=T;MEM[Q+1].INT:=0; END ELSE BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(898);END;BEGIN HELPPTR:=2; HELPLINE[1]:=899;HELPLINE[0]:=900;END;PUTGETERROR;END;FLUSHLIST(P); IF CURCMD<82 THEN{1016:}BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(901);END; BEGIN HELPPTR:=5;HELPLINE[4]:=902;HELPLINE[3]:=903;HELPLINE[2]:=904; HELPLINE[1]:=905;HELPLINE[0]:=906;END; IF CURCMD=42 THEN HELPLINE[2]:=907;PUTGETERROR;SCANNERSTATU:=2; REPEAT GETNEXT;{743:} IF CURCMD=39 THEN BEGIN IF STRREF[CURMOD]<127 THEN IF STRREF[CURMOD]>1 THEN STRREF[CURMOD]:=STRREF[CURMOD]-1 ELSE FLUSHSTRING(CURMOD);END{:743} ;UNTIL CURCMD>=82;SCANNERSTATU:=0;END{:1016};UNTIL CURCMD>82;END;{:1015} {1021:}PROCEDURE DORANDOMSEED;BEGIN GETXNEXT; IF CURCMD<>77 THEN BEGIN MISSINGERR(461);BEGIN HELPPTR:=1; HELPLINE[0]:=912;END;BACKERROR;END;GETXNEXT;SCANEXPRESSI; IF CURTYPE<>16 THEN BEGIN DISPERR(0,913);BEGIN HELPPTR:=2; HELPLINE[1]:=914;HELPLINE[0]:=915;END;PUTGETFLUSHE(0);END ELSE{1022:} BEGIN INITRANDOMS(CUREXP); IF SELECTOR>=2 THEN BEGIN OLDSETTING:=SELECTOR;SELECTOR:=2;PRINTNL(916); PRINTSCALED(CUREXP);PRINTCHAR(125);PRINTNL(285);SELECTOR:=OLDSETTING; END;END{:1022};END;{:1021}{1029:}PROCEDURE DOPROTECTION;VAR M:0..1; T:HALFWORD;BEGIN M:=CURMOD;REPEAT GETSYMBOL;T:=EQTB[CURSYM].LH; IF M=0 THEN BEGIN IF T>=86 THEN EQTB[CURSYM].LH:=T-86; END ELSE IF T<86 THEN EQTB[CURSYM].LH:=T+86;GETXNEXT;UNTIL CURCMD<>82; END;{:1029}{1031:}PROCEDURE DEFDELIMS;VAR LDELIM,RDELIM:HALFWORD; BEGIN GETCLEARSYMB;LDELIM:=CURSYM;GETCLEARSYMB;RDELIM:=CURSYM; EQTB[LDELIM].LH:=31;EQTB[LDELIM].RH:=RDELIM;EQTB[RDELIM].LH:=62; EQTB[RDELIM].RH:=LDELIM;GETXNEXT;END;{:1031}{1034:} PROCEDURE DOSTATEMENT;FORWARD;PROCEDURE DOINTERIM;BEGIN GETXNEXT; IF CURCMD<>40 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(922);END; IF CURSYM=0 THEN PRINT(927)ELSE PRINT(HASH[CURSYM].RH);PRINT(928); BEGIN HELPPTR:=1;HELPLINE[0]:=929;END;BACKERROR; END ELSE BEGIN SAVEINTERNAL(CURMOD);BACKINPUT;END;DOSTATEMENT;END; {:1034}{1035:}PROCEDURE DOLET;VAR L:HALFWORD;BEGIN GETSYMBOL;L:=CURSYM; GETXNEXT;IF CURCMD<>51 THEN IF CURCMD<>77 THEN BEGIN MISSINGERR(61); BEGIN HELPPTR:=3;HELPLINE[2]:=930;HELPLINE[1]:=671;HELPLINE[0]:=931;END; BACKERROR;END;GETSYMBOL; CASE CURCMD OF 10,53,44,49:MEM[CURMOD].HH.LH:=MEM[CURMOD].HH.LH+1; OTHERWISE END;CLEARSYMBOL(L,FALSE);EQTB[L].LH:=CURCMD; IF CURCMD=41 THEN EQTB[L].RH:=0 ELSE EQTB[L].RH:=CURMOD;GETXNEXT;END; {:1035}{1036:}PROCEDURE DONEWINTERNA; BEGIN REPEAT IF INTPTR=MAXINTERNAL THEN OVERFLOW(932,MAXINTERNAL); GETCLEARSYMB;INTPTR:=INTPTR+1;EQTB[CURSYM].LH:=40; EQTB[CURSYM].RH:=INTPTR;INTNAME[INTPTR]:=HASH[CURSYM].RH; INTERNAL[INTPTR]:=0;GETXNEXT;UNTIL CURCMD<>82;END;{:1036}{1040:} PROCEDURE DOSHOW;BEGIN REPEAT GETXNEXT;SCANEXPRESSI;PRINTNL(763); PRINTEXP(0,2);FLUSHCUREXP(0);UNTIL CURCMD<>82;END;{:1040}{1041:} PROCEDURE DISPTOKEN;BEGIN PRINTNL(938);IF CURSYM=0 THEN{1042:} BEGIN IF CURCMD=42 THEN PRINTSCALED(CURMOD)ELSE IF CURCMD=38 THEN BEGIN GPOINTER:=CURMOD;PRINTCAPSULE;END ELSE BEGIN PRINTCHAR(34); PRINT(CURMOD);PRINTCHAR(34); BEGIN IF STRREF[CURMOD]<127 THEN IF STRREF[CURMOD]>1 THEN STRREF[CURMOD] :=STRREF[CURMOD]-1 ELSE FLUSHSTRING(CURMOD);END;END;END{:1042} ELSE BEGIN PRINT(HASH[CURSYM].RH);PRINTCHAR(61); IF EQTB[CURSYM].LH>=86 THEN PRINT(939);PRINTCMDMOD(CURCMD,CURMOD); IF CURCMD=10 THEN BEGIN PRINTLN;SHOWMACRO(CURMOD,0,100000);END;END;END; {:1041}{1044:}PROCEDURE DOSHOWTOKEN;BEGIN REPEAT GETNEXT;DISPTOKEN; GETXNEXT;UNTIL CURCMD<>82;END;{:1044}{1045:}PROCEDURE DOSHOWSTATS; BEGIN PRINTNL(948);PRINTINT(VARUSED);PRINTCHAR(38);PRINTINT(DYNUSED); IF FALSE THEN PRINT(358);PRINT(558);PRINTINT(HIMEMMIN-LOMEMMAX-1); PRINT(949);PRINTLN;PRINTNL(950);PRINTINT(STRPTR-INITSTRPTR); PRINTCHAR(38);PRINTINT(POOLPTR-INITPOOLPTR);PRINT(558); PRINTINT(MAXSTRINGS-MAXSTRPTR);PRINTCHAR(38); PRINTINT(POOLSIZE-MAXPOOLPTR);PRINT(949);PRINTLN;GETXNEXT;END;{:1045} {1046:}PROCEDURE DISPVAR(P:HALFWORD);VAR Q:HALFWORD;N:0..MAXPRINTLINE; BEGIN IF MEM[P].HH.B0=21 THEN{1047:}BEGIN Q:=MEM[P+1].HH.LH; REPEAT DISPVAR(Q);Q:=MEM[Q].HH.RH;UNTIL Q=17;Q:=MEM[P+1].HH.RH; WHILE MEM[Q].HH.B1=3 DO BEGIN DISPVAR(Q);Q:=MEM[Q].HH.RH;END;END{:1047} ELSE IF MEM[P].HH.B0>=22 THEN{1048:}BEGIN PRINTNL(285);PRINTVARIABL(P); IF MEM[P].HH.B0>22 THEN PRINT(663);PRINT(951); IF FILEOFFSET>=MAXPRINTLINE-20 THEN N:=5 ELSE N:=MAXPRINTLINE-FILEOFFSET -15;SHOWMACRO(MEM[P+1].INT,0,N);END{:1048} ELSE IF MEM[P].HH.B0<>0 THEN BEGIN PRINTNL(285);PRINTVARIABL(P); PRINTCHAR(61);PRINTEXP(P,0);END;END;{:1046}{1049:}PROCEDURE DOSHOWVAR; LABEL 30;BEGIN REPEAT GETNEXT; IF CURSYM>0 THEN IF CURSYM<=2369 THEN IF CURCMD=41 THEN IF CURMOD<>0 THEN BEGIN DISPVAR(CURMOD);GOTO 30;END;DISPTOKEN;30:GETXNEXT; UNTIL CURCMD<>82;END;{:1049}{1050:}PROCEDURE DOSHOWDEPEND; VAR P:HALFWORD;BEGIN P:=MEM[13].HH.RH; WHILE P<>13 DO BEGIN IF INTERESTING(P)THEN BEGIN PRINTNL(285); PRINTVARIABL(P);IF MEM[P].HH.B0=17 THEN PRINTCHAR(61)ELSE PRINT(766); PRINTDEPENDE(MEM[P+1].HH.RH,MEM[P].HH.B0);END;P:=MEM[P+1].HH.RH; WHILE MEM[P].HH.LH<>0 DO P:=MEM[P].HH.RH;P:=MEM[P].HH.RH;END;GETXNEXT; END;{:1050}{1051:}PROCEDURE DOSHOWWHATEV; BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;{1228:}COPYERR:=IGNOREIT; REWRITE(TEMPFILE);{:1228};CASE CURMOD OF 0:DOSHOWTOKEN;1:DOSHOWSTATS; 2:DOSHOW;3:DOSHOWVAR;4:DOSHOWDEPEND;END; IF INTERNAL[32]>0 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(952);END; IF INTERACTION<3 THEN BEGIN HELPPTR:=0;ERRORCOUNT:=ERRORCOUNT-1; END ELSE BEGIN HELPPTR:=1;HELPLINE[0]:=953;END; IF CURCMD=83 THEN ERROR ELSE PUTGETERROR;END;END;{:1051}{1054:} FUNCTION SCANWITH:BOOLEAN;VAR T:SMALLNUMBER;RESULT:BOOLEAN; BEGIN T:=CURMOD;CURTYPE:=1;GETXNEXT;SCANEXPRESSI;RESULT:=FALSE; IF CURTYPE<>T THEN{1055:}BEGIN DISPERR(0,961);BEGIN HELPPTR:=2; HELPLINE[1]:=962;HELPLINE[0]:=963;END;IF T=6 THEN HELPLINE[1]:=964; PUTGETFLUSHE(0);END{:1055} ELSE IF CURTYPE=6 THEN RESULT:=TRUE ELSE{1056:} BEGIN CUREXP:=ROUNDUNSCALE(CUREXP); IF(ABS(CUREXP)<4)AND(CUREXP<>0)THEN RESULT:=TRUE ELSE BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT; REWRITE(TEMPFILE);PRINT(965);END;BEGIN HELPPTR:=1;HELPLINE[0]:=963;END; PUTGETFLUSHE(0);END;END{:1056};SCANWITH:=RESULT;END;{:1054}{1057:} PROCEDURE FINDEDGESVAR(T:HALFWORD);VAR P:HALFWORD; BEGIN P:=FINDVARIABLE(T);CUREDGES:=0;IF P=0 THEN BEGIN OBLITERATED(T); PUTGETERROR; END ELSE IF MEM[P].HH.B0<>11 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(788); END;SHOWTOKENLIS(T,0,1000,0);PRINT(966);PRINTTYPE(MEM[P].HH.B0); PRINTCHAR(41);BEGIN HELPPTR:=2;HELPLINE[1]:=967;HELPLINE[0]:=968;END; PUTGETERROR;END ELSE CUREDGES:=MEM[P+1].INT;FLUSHNODELIS(T);END;{:1057} {1059:}PROCEDURE DOADDTO;LABEL 30,45;VAR LHS,RHS:HALFWORD;W:INTEGER; P:HALFWORD;Q:HALFWORD;ADDTOTYPE:0..2;BEGIN GETXNEXT;VARFLAG:=68; SCANPRIMARY;IF CURTYPE<>20 THEN{1060:}BEGIN DISPERR(0,969); BEGIN HELPPTR:=4;HELPLINE[3]:=970;HELPLINE[2]:=971;HELPLINE[1]:=972; HELPLINE[0]:=968;END;PUTGETFLUSHE(0);END{:1060}ELSE BEGIN LHS:=CUREXP; ADDTOTYPE:=CURMOD;CURTYPE:=1;GETXNEXT;SCANEXPRESSI; IF ADDTOTYPE=2 THEN{1061:}BEGIN FINDEDGESVAR(LHS); IF CUREDGES=0 THEN FLUSHCUREXP(0)ELSE IF CURTYPE<>11 THEN BEGIN DISPERR( 0,973);BEGIN HELPPTR:=2;HELPLINE[1]:=974;HELPLINE[0]:=968;END; PUTGETFLUSHE(0);END ELSE BEGIN MERGEEDGES(CUREXP);FLUSHCUREXP(0);END; END{:1061}ELSE{1062:}BEGIN IF CURTYPE=14 THEN PAIRTOPATH; IF CURTYPE<>9 THEN BEGIN DISPERR(0,973);BEGIN HELPPTR:=2; HELPLINE[1]:=975;HELPLINE[0]:=968;END;PUTGETFLUSHE(0);FLUSHTOKENLI(LHS); END ELSE BEGIN RHS:=CUREXP;W:=1;CURPEN:=3; WHILE CURCMD=66 DO IF SCANWITH THEN IF CURTYPE=16 THEN W:=CUREXP ELSE{ 1063:} BEGIN IF MEM[CURPEN].HH.LH=0 THEN TOSSPEN(CURPEN)ELSE MEM[CURPEN].HH.LH :=MEM[CURPEN].HH.LH-1;CURPEN:=CUREXP;END{:1063};{1064:} FINDEDGESVAR(LHS);IF CUREDGES=0 THEN TOSSKNOTLIST(RHS)ELSE BEGIN LHS:=0; CURPATHTYPE:=ADDTOTYPE; IF MEM[RHS].HH.B0=0 THEN IF CURPATHTYPE=0 THEN{1065:} IF MEM[RHS].HH.RH=RHS THEN{1066:}BEGIN MEM[RHS+5].INT:=MEM[RHS+1].INT; MEM[RHS+6].INT:=MEM[RHS+2].INT;MEM[RHS+3].INT:=MEM[RHS+1].INT; MEM[RHS+4].INT:=MEM[RHS+2].INT;MEM[RHS].HH.B0:=1;MEM[RHS].HH.B1:=1; END{:1066}ELSE BEGIN P:=HTAPYPOC(RHS);Q:=MEM[P].HH.RH; MEM[PATHTAIL+5].INT:=MEM[Q+5].INT;MEM[PATHTAIL+6].INT:=MEM[Q+6].INT; MEM[PATHTAIL].HH.B1:=MEM[Q].HH.B1;MEM[PATHTAIL].HH.RH:=MEM[Q].HH.RH; FREENODE(Q,7);MEM[P+5].INT:=MEM[RHS+5].INT;MEM[P+6].INT:=MEM[RHS+6].INT; MEM[P].HH.B1:=MEM[RHS].HH.B1;MEM[P].HH.RH:=MEM[RHS].HH.RH; FREENODE(RHS,7);RHS:=P;END{:1065}ELSE{1067:} BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(976);END;BEGIN HELPPTR:=2; HELPLINE[1]:=977;HELPLINE[0]:=968;END;PUTGETERROR;TOSSKNOTLIST(RHS); GOTO 45;END{:1067}ELSE IF CURPATHTYPE=0 THEN LHS:=HTAPYPOC(RHS); CURWT:=W;RHS:=MAKESPEC(RHS,MEM[CURPEN+9].INT,INTERNAL[5]);{1068:} IF TURNINGNUMBE<=0 THEN IF CURPATHTYPE<>0 THEN IF INTERNAL[39]>0 THEN IF (TURNINGNUMBE<0)AND(MEM[CURPEN].HH.RH=0)THEN CURWT:=-CURWT ELSE BEGIN IF TURNINGNUMBE=0 THEN IF(INTERNAL[39]<=65536)AND(MEM[CURPEN].HH.RH=0)THEN GOTO 30 ELSE PRINTSTRANGE(978)ELSE PRINTSTRANGE(979);BEGIN HELPPTR:=3; HELPLINE[2]:=980;HELPLINE[1]:=981;HELPLINE[0]:=982;END;PUTGETERROR;END; 30:{:1068}; IF MEM[CURPEN+9].INT=0 THEN FILLSPEC(RHS)ELSE FILLENVELOPE(RHS); IF LHS<>0 THEN BEGIN REVTURNS:=TRUE; LHS:=MAKESPEC(LHS,MEM[CURPEN+9].INT,INTERNAL[5]);REVTURNS:=FALSE; IF MEM[CURPEN+9].INT=0 THEN FILLSPEC(LHS)ELSE FILLENVELOPE(LHS);END; 45:END{:1064}; IF MEM[CURPEN].HH.LH=0 THEN TOSSPEN(CURPEN)ELSE MEM[CURPEN].HH.LH:=MEM[ CURPEN].HH.LH-1;END;END{:1062};END;END;{:1059}{1070:}{1098:} FUNCTION TFMCHECK(M:SMALLNUMBER):SCALED; BEGIN IF ABS(INTERNAL[M])>=134217728 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE); PRINT(999);END;PRINT(INTNAME[M]);PRINT(1000);BEGIN HELPPTR:=1; HELPLINE[0]:=1001;END;PUTGETERROR; IF INTERNAL[M]>0 THEN TFMCHECK:=134217727 ELSE TFMCHECK:=-134217727; END ELSE TFMCHECK:=INTERNAL[M];END;{:1098}PROCEDURE DOSHIPOUT;LABEL 10; VAR C:INTEGER;BEGIN GETXNEXT;VARFLAG:=83;SCANEXPRESSI; IF CURTYPE<>20 THEN IF CURTYPE=11 THEN CUREDGES:=CUREXP ELSE BEGIN{1060: }BEGIN DISPERR(0,969);BEGIN HELPPTR:=4;HELPLINE[3]:=970; HELPLINE[2]:=971;HELPLINE[1]:=972;HELPLINE[0]:=968;END;PUTGETFLUSHE(0); END{:1060};GOTO 10;END ELSE BEGIN FINDEDGESVAR(CUREXP);CURTYPE:=1;END; IF CUREDGES<>0 THEN BEGIN C:=ROUNDUNSCALE(INTERNAL[18])MOD 256; IF C<0 THEN C:=C+256;{1099:}IF CEC THEN EC:=C; CHAREXISTS[C]:=TRUE;GFDX[C]:=INTERNAL[24];GFDY[C]:=INTERNAL[25]; TFMWIDTH[C]:=TFMCHECK(20);TFMHEIGHT[C]:=TFMCHECK(21); TFMDEPTH[C]:=TFMCHECK(22);TFMITALCORR[C]:=TFMCHECK(23){:1099}; IF INTERNAL[34]>=0 THEN SHIPOUT(C);END;FLUSHCUREXP(0);10:END;{:1070} {1071:}PROCEDURE DODISPLAY;LABEL 45,50,10;VAR E:HALFWORD;BEGIN GETXNEXT; VARFLAG:=73;SCANPRIMARY;IF CURTYPE<>20 THEN{1060:}BEGIN DISPERR(0,969); BEGIN HELPPTR:=4;HELPLINE[3]:=970;HELPLINE[2]:=971;HELPLINE[1]:=972; HELPLINE[0]:=968;END;PUTGETFLUSHE(0);END{:1060}ELSE BEGIN E:=CUREXP; CURTYPE:=1;GETXNEXT;SCANEXPRESSI;IF CURTYPE<>16 THEN GOTO 50; CUREXP:=ROUNDUNSCALE(CUREXP);IF CUREXP<0 THEN GOTO 45; IF CUREXP>15 THEN GOTO 45;IF NOT WINDOWOPEN[CUREXP]THEN GOTO 45; FINDEDGESVAR(E);IF CUREDGES<>0 THEN DISPEDGES(CUREXP);GOTO 10; 45:CUREXP:=CUREXP*65536;50:DISPERR(0,983);BEGIN HELPPTR:=1; HELPLINE[0]:=984;END;PUTGETFLUSHE(0);FLUSHTOKENLI(E);END;10:END;{:1071} {1072:}FUNCTION GETPAIR(C:COMMANDCODE):BOOLEAN;VAR P:HALFWORD;B:BOOLEAN; BEGIN IF CURCMD<>C THEN GETPAIR:=FALSE ELSE BEGIN GETXNEXT;SCANEXPRESSI; IF NICEPAIR(CUREXP,CURTYPE)THEN BEGIN P:=MEM[CUREXP+1].INT; CURX:=MEM[P+1].INT;CURY:=MEM[P+3].INT;B:=TRUE;END ELSE B:=FALSE; FLUSHCUREXP(0);GETPAIR:=B;END;END;{:1072}{1073:}PROCEDURE DOOPENWINDOW; LABEL 45,10;VAR K:INTEGER;R0,C0,R1,C1:SCALED;BEGIN GETXNEXT; SCANEXPRESSI;IF CURTYPE<>16 THEN GOTO 45;K:=ROUNDUNSCALE(CUREXP); IF K<0 THEN GOTO 45;IF K>15 THEN GOTO 45;IF NOT GETPAIR(70)THEN GOTO 45; R0:=CURX;C0:=CURY;IF NOT GETPAIR(71)THEN GOTO 45;R1:=CURX;C1:=CURY; IF NOT GETPAIR(72)THEN GOTO 45;OPENAWINDOW(K,R0,C0,R1,C1,CURX,CURY); GOTO 10;45:BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(985);END;BEGIN HELPPTR:=2; HELPLINE[1]:=986;HELPLINE[0]:=987;END;PUTGETERROR;10:END;{:1073}{1074:} PROCEDURE DOCULL;LABEL 45,10;VAR E:HALFWORD;KEEPING:0..1; W,WIN,WOUT:INTEGER;BEGIN W:=1;GETXNEXT;VARFLAG:=67;SCANPRIMARY; IF CURTYPE<>20 THEN{1060:}BEGIN DISPERR(0,969);BEGIN HELPPTR:=4; HELPLINE[3]:=970;HELPLINE[2]:=971;HELPLINE[1]:=972;HELPLINE[0]:=968;END; PUTGETFLUSHE(0);END{:1060}ELSE BEGIN E:=CUREXP;CURTYPE:=1; KEEPING:=CURMOD;IF NOT GETPAIR(67)THEN GOTO 45; WHILE(CURCMD=66)AND(CURMOD=16)DO IF SCANWITH THEN W:=CUREXP;{1075:} IF CURX>CURY THEN GOTO 45; IF KEEPING=0 THEN BEGIN IF(CURX>0)OR(CURY<0)THEN GOTO 45;WOUT:=W;WIN:=0; END ELSE BEGIN IF(CURX<=0)AND(CURY>=0)THEN GOTO 45;WOUT:=0;WIN:=W; END{:1075};FINDEDGESVAR(E); IF CUREDGES<>0 THEN CULLEDGES(FLOORUNSCALE(CURX+65535),FLOORUNSCALE(CURY ),WOUT,WIN);GOTO 10;45:BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(988);END; BEGIN HELPPTR:=1;HELPLINE[0]:=989;END;PUTGETERROR;FLUSHTOKENLI(E);END; 10:END;{:1074}{1082:}PROCEDURE DOMESSAGE;VAR M:0..2;BEGIN M:=CURMOD; GETXNEXT;SCANEXPRESSI;IF CURTYPE<>4 THEN BEGIN DISPERR(0,698); BEGIN HELPPTR:=1;HELPLINE[0]:=993;END;PUTGETERROR; END ELSE CASE M OF 0:BEGIN PRINTNL(285);SLOWPRINT(CUREXP);END;1:{1086:} BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(285);END;SLOWPRINT(CUREXP); IF ERRHELP<>0 THEN USEERRHELP:=TRUE ELSE IF LONGHELPSEEN THEN BEGIN HELPPTR:=1;HELPLINE[0]:=994; END ELSE BEGIN IF INTERACTION<3 THEN LONGHELPSEEN:=TRUE; BEGIN HELPPTR:=4;HELPLINE[3]:=995;HELPLINE[2]:=996;HELPLINE[1]:=997; HELPLINE[0]:=998;END;END;PUTGETERROR;USEERRHELP:=FALSE;END{:1086}; 2:{1083:} BEGIN IF ERRHELP<>0 THEN BEGIN IF STRREF[ERRHELP]<127 THEN IF STRREF[ ERRHELP]>1 THEN STRREF[ERRHELP]:=STRREF[ERRHELP]-1 ELSE FLUSHSTRING( ERRHELP);END; IF(STRSTART[CUREXP+1]-STRSTART[CUREXP])=0 THEN ERRHELP:=0 ELSE BEGIN ERRHELP:=CUREXP; BEGIN IF STRREF[ERRHELP]<127 THEN STRREF[ERRHELP]:=STRREF[ERRHELP]+1; END;END;END{:1083};END;FLUSHCUREXP(0);END;{:1082}{1103:} FUNCTION GETCODE:EIGHTBITS;LABEL 40;VAR C:INTEGER;BEGIN GETXNEXT; SCANEXPRESSI;IF CURTYPE=16 THEN BEGIN C:=ROUNDUNSCALE(CUREXP); IF C>=0 THEN IF C<256 THEN GOTO 40; END ELSE IF CURTYPE=4 THEN IF(STRSTART[CUREXP+1]-STRSTART[CUREXP])=1 THEN BEGIN C:=STRPOOL[STRSTART[CUREXP]];GOTO 40;END;DISPERR(0,1007); BEGIN HELPPTR:=2;HELPLINE[1]:=1008;HELPLINE[0]:=1009;END; PUTGETFLUSHE(0);C:=0;40:GETCODE:=C;END;{:1103}{1104:} PROCEDURE SETTAG(C:HALFWORD;T:SMALLNUMBER;R:HALFWORD); BEGIN IF CHARTAG[C]=0 THEN BEGIN CHARTAG[C]:=T;CHARREMAINDE[C]:=R; IF T=1 THEN BEGIN LABELPTR:=LABELPTR+1;LABELLOC[LABELPTR]:=R; LABELCHAR[LABELPTR]:=C;END;END ELSE{1105:} BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(1010);END; IF(C>32)AND(C<127)THEN PRINT(C)ELSE IF C=256 THEN PRINT(1011)ELSE BEGIN PRINT(1012);PRINTINT(C);END;PRINT(1013);CASE CHARTAG[C]OF 1:PRINT(1014); 2:PRINT(1015);3:PRINT(1004);END;BEGIN HELPPTR:=2;HELPLINE[1]:=1016; HELPLINE[0]:=968;END;PUTGETERROR;END{:1105};END;{:1104}{1106:} PROCEDURE DOTFMCOMMAND;LABEL 22,30;VAR C,CC:0..256;K:0..MAXKERNS; J:INTEGER;BEGIN CASE CURMOD OF 0:BEGIN C:=GETCODE; WHILE CURCMD=81 DO BEGIN CC:=GETCODE;SETTAG(C,2,CC);C:=CC;END;END; 1:{1107:}BEGIN LKSTARTED:=FALSE;22:GETXNEXT; IF(CURCMD=78)AND LKSTARTED THEN{1110:}BEGIN C:=GETCODE; IF NL-SKIPTABLE[C]>128 THEN BEGIN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(1033); END;BEGIN HELPPTR:=1;HELPLINE[0]:=1034;END;ERROR;LL:=SKIPTABLE[C]; REPEAT LLL:=LIGKERN[LL].B0;LIGKERN[LL].B0:=128;LL:=LL-LLL;UNTIL LLL=0; END;SKIPTABLE[C]:=LIGTABLESIZE;END; IF SKIPTABLE[C]=LIGTABLESIZE THEN LIGKERN[NL-1].B0:=0 ELSE LIGKERN[NL-1] .B0:=NL-SKIPTABLE[C]-1;SKIPTABLE[C]:=NL-1;GOTO 30;END{:1110}; IF CURCMD=79 THEN BEGIN C:=256;CURCMD:=81;END ELSE BEGIN BACKINPUT; C:=GETCODE;END;IF(CURCMD=81)OR(CURCMD=80)THEN{1111:} BEGIN IF CURCMD=81 THEN IF C=256 THEN BCHLABEL:=NL ELSE SETTAG(C,1,NL) ELSE IF SKIPTABLE[C]128 THEN BEGIN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(1033);END; BEGIN HELPPTR:=1;HELPLINE[0]:=1034;END;ERROR;LL:=LL; REPEAT LLL:=LIGKERN[LL].B0;LIGKERN[LL].B0:=128;LL:=LL-LLL;UNTIL LLL=0; END;GOTO 22;END;LIGKERN[LL].B0:=NL-LL-1;LL:=LL-LLL;UNTIL LLL=0;END; GOTO 22;END{:1111};IF CURCMD=76 THEN{1112:}BEGIN LIGKERN[NL].B1:=C; LIGKERN[NL].B0:=0;IF CURMOD<128 THEN BEGIN LIGKERN[NL].B2:=CURMOD; LIGKERN[NL].B3:=GETCODE;END ELSE BEGIN GETXNEXT;SCANEXPRESSI; IF CURTYPE<>16 THEN BEGIN DISPERR(0,1035);BEGIN HELPPTR:=2; HELPLINE[1]:=1036;HELPLINE[0]:=309;END;PUTGETFLUSHE(0);END; KERN[NK]:=CUREXP;K:=0;WHILE KERN[K]<>CUREXP DO K:=K+1; IF K=NK THEN BEGIN IF NK=MAXKERNS THEN OVERFLOW(1032,MAXKERNS);NK:=NK+1; END;LIGKERN[NL].B2:=128+(K DIV 256);LIGKERN[NL].B3:=(K MOD 256);END; LKSTARTED:=TRUE;END{:1112} ELSE BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(1021);END;BEGIN HELPPTR:=1; HELPLINE[0]:=1022;END;BACKERROR;LIGKERN[NL].B1:=0;LIGKERN[NL].B2:=0; LIGKERN[NL].B3:=0;LIGKERN[NL].B0:=129;END; IF NL=LIGTABLESIZE THEN OVERFLOW(1023,LIGTABLESIZE);NL:=NL+1; IF CURCMD=82 THEN GOTO 22; IF LIGKERN[NL-1].B0<128 THEN LIGKERN[NL-1].B0:=128;30:END{:1107}; 2:{1113:}BEGIN IF NE=256 THEN OVERFLOW(1004,256);C:=GETCODE; SETTAG(C,3,NE);IF CURCMD<>81 THEN BEGIN MISSINGERR(58);BEGIN HELPPTR:=1; HELPLINE[0]:=1037;END;BACKERROR;END;EXTEN[NE].B0:=GETCODE; IF CURCMD<>82 THEN BEGIN MISSINGERR(44);BEGIN HELPPTR:=1; HELPLINE[0]:=1037;END;BACKERROR;END;EXTEN[NE].B1:=GETCODE; IF CURCMD<>82 THEN BEGIN MISSINGERR(44);BEGIN HELPPTR:=1; HELPLINE[0]:=1037;END;BACKERROR;END;EXTEN[NE].B2:=GETCODE; IF CURCMD<>82 THEN BEGIN MISSINGERR(44);BEGIN HELPPTR:=1; HELPLINE[0]:=1037;END;BACKERROR;END;EXTEN[NE].B3:=GETCODE;NE:=NE+1; END{:1113};3,4:BEGIN C:=CURMOD;GETXNEXT;SCANEXPRESSI; IF(CURTYPE<>16)OR(CUREXP<32768)THEN BEGIN DISPERR(0,1017); BEGIN HELPPTR:=2;HELPLINE[1]:=1018;HELPLINE[0]:=1019;END;PUTGETERROR; END ELSE BEGIN J:=ROUNDUNSCALE(CUREXP); IF CURCMD<>81 THEN BEGIN MISSINGERR(58);BEGIN HELPPTR:=1; HELPLINE[0]:=1020;END;BACKERROR;END;IF C=3 THEN{1114:} REPEAT IF J>HEADERSIZE THEN OVERFLOW(1005,HEADERSIZE); HEADERBYTE[J]:=GETCODE;J:=J+1;UNTIL CURCMD<>82{:1114}ELSE{1115:} REPEAT IF J>MAXFONTDIMEN THEN OVERFLOW(1006,MAXFONTDIMEN); WHILE J>NP DO BEGIN NP:=NP+1;PARAM[NP]:=0;END;GETXNEXT;SCANEXPRESSI; IF CURTYPE<>16 THEN BEGIN DISPERR(0,1038);BEGIN HELPPTR:=1; HELPLINE[0]:=309;END;PUTGETFLUSHE(0);END;PARAM[J]:=CUREXP;J:=J+1; UNTIL CURCMD<>82{:1115};END;END;END;END;{:1106}{1177:} PROCEDURE DOSPECIAL;VAR M:SMALLNUMBER;BEGIN M:=CURMOD;GETXNEXT; SCANEXPRESSI;IF INTERNAL[34]>=0 THEN IF CURTYPE<>M THEN{1178:} BEGIN DISPERR(0,1058);BEGIN HELPPTR:=1;HELPLINE[0]:=1059;END; PUTGETERROR;END{:1178}ELSE BEGIN IF OUTPUTFILENA=0 THEN INITGF; IF M=4 THEN GFSTRING(CUREXP,0)ELSE BEGIN BEGIN GBUFFER.B[GFPTR]:=243; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END;GFFOUR(CUREXP);END;END; FLUSHCUREXP(0);END;{:1177}{1186:}PROCEDURE STOREBASEFIL;VAR K:INTEGER; P,Q:HALFWORD;X:INTEGER;W:FOURQUARTERS;BEGIN{1200:}SELECTOR:=5; PRINT(1069);PRINT(JOBNAME);PRINTCHAR(32); PRINTINT(ROUNDUNSCALE(INTERNAL[14])MOD 100);PRINTCHAR(46); PRINTINT(ROUNDUNSCALE(INTERNAL[15]));PRINTCHAR(46); PRINTINT(ROUNDUNSCALE(INTERNAL[16]));PRINTCHAR(41); IF INTERACTION=0 THEN SELECTOR:=2 ELSE SELECTOR:=3; BEGIN IF POOLPTR+1>MAXPOOLPTR THEN BEGIN IF POOLPTR+1>POOLSIZE THEN OVERFLOW(257,POOLSIZE-INITPOOLPTR);MAXPOOLPTR:=POOLPTR+1;END;END; BASEIDENT:=MAKESTRING;STRREF[BASEIDENT]:=127;PACKJOBNAME(740); WHILE NOT WOPENOUT(BASEFILE)DO PROMPTFILENA(1070,740);PRINTNL(1071); PRINT(WMAKENAMESTR(BASEFILE));FLUSHSTRING(STRPTR-1); PRINTNL(BASEIDENT){:1200};{1190:} BEGIN BASEFILE^[BASECOUNT].INT:=531421597;BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].INT:=0; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].INT:=65534; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].INT:=2100; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].INT:=1777; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].INT:=6; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END{:1190};{1192:} BEGIN BASEFILE^[BASECOUNT].INT:=POOLPTR;BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].INT:=STRPTR; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END; FOR K:=0 TO STRPTR DO BEGIN BASEFILE^[BASECOUNT].INT:=STRSTART[K]; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;K:=0; WHILE K+40 DO BEGIN DYNUSED:=DYNUSED-1;P:=MEM[P].HH.RH;END; BEGIN BASEFILE^[BASECOUNT].INT:=VARUSED;BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].INT:=DYNUSED; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;PRINTLN;PRINTINT(X);PRINT(1067); PRINTINT(VARUSED);PRINTCHAR(38);PRINTINT(DYNUSED){:1194};{1196:} BEGIN BASEFILE^[BASECOUNT].INT:=HASHUSED;BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;STCOUNT:=2356-HASHUSED; FOR P:=1 TO HASHUSED DO IF HASH[P].RH<>0 THEN BEGIN BEGIN BASEFILE^[ BASECOUNT].INT:=P;BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].HH:=HASH[P]; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].HH:=EQTB[P]; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;STCOUNT:=STCOUNT+1;END; FOR P:=HASHUSED+1 TO 2369 DO BEGIN BEGIN BASEFILE^[BASECOUNT].HH:=HASH[P ];BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].HH:=EQTB[P]; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;END;BEGIN BASEFILE^[BASECOUNT].INT:=STCOUNT; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;PRINTLN;PRINTINT(STCOUNT);PRINT(1068){:1196}; {1198:}BEGIN BASEFILE^[BASECOUNT].INT:=INTPTR; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END; FOR K:=1 TO INTPTR DO BEGIN BEGIN BASEFILE^[BASECOUNT].INT:=INTERNAL[K]; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].INT:=INTNAME[K]; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;END;BEGIN BASEFILE^[BASECOUNT].INT:=STARTSYM; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].INT:=INTERACTION; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].INT:=BASEIDENT; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].INT:=BGLOC; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].INT:=EGLOC; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].INT:=SERIALNO; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;BEGIN BASEFILE^[BASECOUNT].INT:=69069; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;INTERNAL[12]:=0{:1198};{1201:} WHILE BASECOUNT>0 DO BEGIN BASEFILE^[BASECOUNT].INT:=0; BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN PUT(BASEFILE,error:=continue); BASECOUNT:=0;END END;END;WCLOSE(BASEFILE){:1201};END;{:1186} PROCEDURE DOSTATEMENT;BEGIN CURTYPE:=1;GETXNEXT;IF CURCMD>43 THEN{990:} BEGIN IF CURCMD<83 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(867);END; PRINTCMDMOD(CURCMD,CURMOD);PRINTCHAR(39);BEGIN HELPPTR:=5; HELPLINE[4]:=868;HELPLINE[3]:=869;HELPLINE[2]:=870;HELPLINE[1]:=871; HELPLINE[0]:=872;END;BACKERROR;GETXNEXT;END;END{:990} ELSE IF CURCMD>30 THEN{993:}BEGIN VARFLAG:=77;SCANEXPRESSI; IF CURCMD<84 THEN BEGIN IF CURCMD=51 THEN DOEQUATION ELSE IF CURCMD=77 THEN DOASSIGNMENT ELSE IF CURTYPE=4 THEN{994:} BEGIN IF INTERNAL[1]>0 THEN BEGIN PRINTNL(285);SLOWPRINT(CUREXP); IF ODD(SELECTOR)THEN WRITELN(TERMOUT);END;IF INTERNAL[34]>0 THEN{1179:} BEGIN IF OUTPUTFILENA=0 THEN INITGF;GFSTRING(1060,CUREXP);END{:1179}; END{:994}ELSE IF CURTYPE<>1 THEN BEGIN DISPERR(0,877);BEGIN HELPPTR:=3; HELPLINE[2]:=878;HELPLINE[1]:=879;HELPLINE[0]:=880;END;PUTGETERROR;END; FLUSHCUREXP(0);CURTYPE:=1;END;END{:993}ELSE{992:} BEGIN IF INTERNAL[7]>0 THEN SHOWCMDMOD(CURCMD,CURMOD); CASE CURCMD OF 30:DOTYPEDECLAR; 16:IF CURMOD>2 THEN MAKEOPDEF ELSE IF CURMOD>0 THEN SCANDEF;{1020:} 24:DORANDOMSEED;{:1020}{1023:}23:BEGIN PRINTLN;INTERACTION:=CURMOD;{70:} IF INTERACTION=0 THEN SELECTOR:=0 ELSE SELECTOR:=1{:70}; IF LOGOPENED THEN SELECTOR:=SELECTOR+2;GETXNEXT;END;{:1023}{1026:} 21:DOPROTECTION;{:1026}{1030:}27:DEFDELIMS;{:1030}{1033:} 12:REPEAT GETSYMBOL;SAVEVARIABLE(CURSYM);GETXNEXT;UNTIL CURCMD<>82; 13:DOINTERIM;14:DOLET;15:DONEWINTERNA;{:1033}{1039:}22:DOSHOWWHATEV; {:1039}{1058:}18:DOADDTO;{:1058}{1069:}17:DOSHIPOUT;11:DODISPLAY; 28:DOOPENWINDOW;19:DOCULL;{:1069}{1076:}26:BEGIN GETSYMBOL; STARTSYM:=CURSYM;GETXNEXT;END;{:1076}{1081:}25:DOMESSAGE;{:1081}{1100:} 20:DOTFMCOMMAND;{:1100}{1175:}29:DOSPECIAL;{:1175}END;CURTYPE:=1; END{:992};IF CURCMD<83 THEN{991:} BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN;PRINTNL(261); COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(873);END;BEGIN HELPPTR:=6; HELPLINE[5]:=874;HELPLINE[4]:=875;HELPLINE[3]:=876;HELPLINE[2]:=870; HELPLINE[1]:=871;HELPLINE[0]:=872;END;BACKERROR;SCANNERSTATU:=2; REPEAT GETNEXT;{743:} IF CURCMD=39 THEN BEGIN IF STRREF[CURMOD]<127 THEN IF STRREF[CURMOD]>1 THEN STRREF[CURMOD]:=STRREF[CURMOD]-1 ELSE FLUSHSTRING(CURMOD);END{:743} ;UNTIL CURCMD>82;SCANNERSTATU:=0;END{:991};ERRORCOUNT:=0;END;{:989} {1017:}PROCEDURE MAINCONTROL;BEGIN REPEAT DOSTATEMENT; IF CURCMD=84 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(908);END; BEGIN HELPPTR:=2;HELPLINE[1]:=909;HELPLINE[0]:=688;END;FLUSHERROR(0); END;UNTIL CURCMD=85;END;{:1017}{1117:} FUNCTION SORTIN(V:SCALED):HALFWORD;LABEL 40;VAR P,Q,R:HALFWORD; BEGIN P:=65533;WHILE TRUE DO BEGIN Q:=MEM[P].HH.RH; IF V<=MEM[Q+1].INT THEN GOTO 40;P:=Q;END; 40:IF V19 DO BEGIN M:=M+1;L:=MEM[P+1].INT;REPEAT P:=MEM[P].HH.RH; UNTIL MEM[P+1].INT>L+D; IF MEM[P+1].INT-LM DO D:=PERTURBATION; THRESHOLD:=D;END;END;{:1120}{1121:}FUNCTION SKIMP(M:INTEGER):INTEGER; VAR D:SCALED;P,Q,R:HALFWORD;L:SCALED;V:SCALED;BEGIN D:=THRESHOLD(M); PERTURBATION:=0;Q:=65533;M:=0;P:=MEM[65533].HH.RH; WHILE P<>19 DO BEGIN M:=M+1;L:=MEM[P+1].INT;MEM[P].HH.LH:=M; IF MEM[MEM[P].HH.RH+1].INT<=L+D THEN{1122:}BEGIN REPEAT P:=MEM[P].HH.RH; MEM[P].HH.LH:=M;EXCESS:=EXCESS-1;IF EXCESS=0 THEN D:=0; UNTIL MEM[MEM[P].HH.RH+1].INT>L+D;V:=L+(MEM[P+1].INT-L)DIV 2; IF MEM[P+1].INT-V>PERTURBATION THEN PERTURBATION:=MEM[P+1].INT-V;R:=Q; REPEAT R:=MEM[R].HH.RH;MEM[R+1].INT:=V;UNTIL R=P;MEM[Q].HH.RH:=P; END{:1122};Q:=P;P:=MEM[P].HH.RH;END;SKIMP:=M;END;{:1121}{1123:} PROCEDURE TFMWARNING(M:SMALLNUMBER);BEGIN PRINTNL(1039); PRINT(INTNAME[M]);PRINT(1040);PRINTSCALED(PERTURBATION);PRINT(1041);END; {:1123}{1128:}PROCEDURE FIXDESIGNSIZ;VAR D:SCALED;BEGIN D:=INTERNAL[26]; IF(D<65536)OR(D>=134217728)THEN BEGIN IF D<>0 THEN PRINTNL(1042); D:=8388608;INTERNAL[26]:=D;END; IF HEADERBYTE[5]<0 THEN IF HEADERBYTE[6]<0 THEN IF HEADERBYTE[7]<0 THEN IF HEADERBYTE[8]<0 THEN BEGIN HEADERBYTE[5]:=D DIV 1048576; HEADERBYTE[6]:=(D DIV 4096)MOD 256;HEADERBYTE[7]:=(D DIV 16)MOD 256; HEADERBYTE[8]:=(D MOD 16)*16;END; MAXTFMDIMEN:=16*INTERNAL[26]-INTERNAL[26]DIV 2097152; IF MAXTFMDIMEN>=134217728 THEN MAXTFMDIMEN:=134217727;END;{:1128}{1129:} FUNCTION DIMENOUT(X:SCALED):INTEGER; BEGIN IF ABS(X)>MAXTFMDIMEN THEN BEGIN TFMCHANGED:=TFMCHANGED+1; IF X>0 THEN X:=16777215 ELSE X:=-16777215; END ELSE X:=MAKESCALED(X*16,INTERNAL[26]);DIMENOUT:=X;END;{:1129}{1131:} PROCEDURE FIXCHECKSUM;LABEL 10;VAR K:EIGHTBITS;B1,B2,B3,B4:EIGHTBITS; X:INTEGER; BEGIN IF HEADERBYTE[1]<0 THEN IF HEADERBYTE[2]<0 THEN IF HEADERBYTE[3]<0 THEN IF HEADERBYTE[4]<0 THEN BEGIN{1132:}B1:=BC;B2:=EC;B3:=BC;B4:=EC; TFMCHANGED:=0; FOR K:=BC TO EC DO IF CHAREXISTS[K]THEN BEGIN X:=DIMENOUT(MEM[TFMWIDTH[K ]+1].INT)+(K+4)*4194304;B1:=(B1+B1+X)MOD 255;B2:=(B2+B2+X)MOD 253; B3:=(B3+B3+X)MOD 251;B4:=(B4+B4+X)MOD 247;END{:1132};HEADERBYTE[1]:=B1; HEADERBYTE[2]:=B2;HEADERBYTE[3]:=B3;HEADERBYTE[4]:=B4;GOTO 10;END; FOR K:=1 TO 4 DO IF HEADERBYTE[K]<0 THEN HEADERBYTE[K]:=0;10:END;{:1131} {1133:}PROCEDURE TFMTWO(X:INTEGER); BEGIN BEGIN TFMFILE^[TFMCOUNT]:=X DIV 256;TFMCOUNT:=TFMCOUNT+1; IF TFMCOUNT=VAXBLOCKLENG THEN BEGIN PUT(TFMFILE,error:=continue); TFMCOUNT:=0;END END;BEGIN TFMFILE^[TFMCOUNT]:=X MOD 256; TFMCOUNT:=TFMCOUNT+1; IF TFMCOUNT=VAXBLOCKLENG THEN BEGIN PUT(TFMFILE,error:=continue); TFMCOUNT:=0;END END;END;PROCEDURE TFMFOUR(X:INTEGER); BEGIN IF X>=0 THEN BEGIN TFMFILE^[TFMCOUNT]:=X DIV 16777216; TFMCOUNT:=TFMCOUNT+1; IF TFMCOUNT=VAXBLOCKLENG THEN BEGIN PUT(TFMFILE,error:=continue); TFMCOUNT:=0;END END ELSE BEGIN X:=X+1073741824;X:=X+1073741824; BEGIN TFMFILE^[TFMCOUNT]:=(X DIV 16777216)+128;TFMCOUNT:=TFMCOUNT+1; IF TFMCOUNT=VAXBLOCKLENG THEN BEGIN PUT(TFMFILE,error:=continue); TFMCOUNT:=0;END END;END;X:=X MOD 16777216; BEGIN TFMFILE^[TFMCOUNT]:=X DIV 65536;TFMCOUNT:=TFMCOUNT+1; IF TFMCOUNT=VAXBLOCKLENG THEN BEGIN PUT(TFMFILE,error:=continue); TFMCOUNT:=0;END END;X:=X MOD 65536;BEGIN TFMFILE^[TFMCOUNT]:=X DIV 256; TFMCOUNT:=TFMCOUNT+1; IF TFMCOUNT=VAXBLOCKLENG THEN BEGIN PUT(TFMFILE,error:=continue); TFMCOUNT:=0;END END;BEGIN TFMFILE^[TFMCOUNT]:=X MOD 256; TFMCOUNT:=TFMCOUNT+1; IF TFMCOUNT=VAXBLOCKLENG THEN BEGIN PUT(TFMFILE,error:=continue); TFMCOUNT:=0;END END;END;PROCEDURE TFMQQQQ(X:FOURQUARTERS); BEGIN BEGIN TFMFILE^[TFMCOUNT]:=X.B0;TFMCOUNT:=TFMCOUNT+1; IF TFMCOUNT=VAXBLOCKLENG THEN BEGIN PUT(TFMFILE,error:=continue); TFMCOUNT:=0;END END;BEGIN TFMFILE^[TFMCOUNT]:=X.B1;TFMCOUNT:=TFMCOUNT+1; IF TFMCOUNT=VAXBLOCKLENG THEN BEGIN PUT(TFMFILE,error:=continue); TFMCOUNT:=0;END END;BEGIN TFMFILE^[TFMCOUNT]:=X.B2;TFMCOUNT:=TFMCOUNT+1; IF TFMCOUNT=VAXBLOCKLENG THEN BEGIN PUT(TFMFILE,error:=continue); TFMCOUNT:=0;END END;BEGIN TFMFILE^[TFMCOUNT]:=X.B3;TFMCOUNT:=TFMCOUNT+1; IF TFMCOUNT=VAXBLOCKLENG THEN BEGIN PUT(TFMFILE,error:=continue); TFMCOUNT:=0;END END;END;{:1133}{1187:}{779:} FUNCTION OPENBASEFILE:BOOLEAN;LABEL 40,10;VAR J:0..BUFSIZE; BEGIN J:=CURINPUT.LOCFIELD; IF BUFFER[CURINPUT.LOCFIELD]=38 THEN BEGIN CURINPUT.LOCFIELD:=CURINPUT. LOCFIELD+1;J:=CURINPUT.LOCFIELD;BUFFER[LAST]:=32; WHILE BUFFER[J]<>32 DO J:=J+1;PACKBUFFERED(0,CURINPUT.LOCFIELD,J-1); IF WOPENIN(BASEFILE)THEN GOTO 40; PACKBUFFERED(BASEAREALENG,CURINPUT.LOCFIELD,J-1); IF WOPENIN(BASEFILE)THEN GOTO 40;WAKEUPTERMIN; WRITELN(TERMOUT,'Sorry, I can''t find that base;',' will try PLAIN.',CHR (13),CHR(10));IF ODD(SELECTOR)THEN WRITELN(TERMOUT);END; PACKBUFFERED(BASEDEFAULTL-5,1,0); IF NOT WOPENIN(BASEFILE)THEN BEGIN WAKEUPTERMIN; WRITELN(TERMOUT,'I can''t find the PLAIN base file!',CHR(13),CHR(10)); OPENBASEFILE:=FALSE;GOTO 10;END;40:CURINPUT.LOCFIELD:=J; OPENBASEFILE:=TRUE;10:END;{:779}FUNCTION LOADBASEFILE:BOOLEAN; LABEL 6666,10;VAR K:INTEGER;P,Q:HALFWORD;X:INTEGER;W:FOURQUARTERS; BEGIN{1191:}X:=BASEFILE^[BASECOUNT].INT;IF X<>531421597 THEN GOTO 6666; BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF X<>0 THEN GOTO 6666;BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF X<>65534 THEN GOTO 6666;BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF X<>2100 THEN GOTO 6666;BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF X<>1777 THEN GOTO 6666;BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF X<>6 THEN GOTO 6666{:1191};{1193:} BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF X<0 THEN GOTO 6666;IF X>POOLSIZE THEN BEGIN WAKEUPTERMIN; WRITELN(TERMOUT,'---! Must increase the ','string pool size',CHR(13),CHR (10));GOTO 6666;END ELSE POOLPTR:=X;END; BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF X<0 THEN GOTO 6666;IF X>MAXSTRINGS THEN BEGIN WAKEUPTERMIN; WRITELN(TERMOUT,'---! Must increase the ','max strings',CHR(13),CHR(10)) ;GOTO 6666;END ELSE STRPTR:=X;END; FOR K:=0 TO STRPTR DO BEGIN BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF(X<0)OR(X>POOLPTR)THEN GOTO 6666 ELSE STRSTART[K]:=X;END; STRREF[K]:=127;END;K:=0; WHILE K+465531)THEN GOTO 6666 ELSE LOMEMMAX:=X;END; BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF(X<23)OR(X>LOMEMMAX)THEN GOTO 6666 ELSE ROVER:=X;END;P:=0;Q:=ROVER; REPEAT FOR K:=P TO Q+1 DO BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;MEM[K]:=BASEFILE^[BASECOUNT];END;P:=Q+MEM[Q].HH.LH; IF(P>LOMEMMAX)OR((Q>=MEM[Q+1].HH.RH)AND(MEM[Q+1].HH.RH<>ROVER))THEN GOTO 6666;Q:=MEM[Q+1].HH.RH;UNTIL Q=ROVER; FOR K:=P TO LOMEMMAX DO BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;MEM[K]:=BASEFILE^[BASECOUNT];END; BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF(X65532)THEN GOTO 6666 ELSE HIMEMMIN:=X;END; BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF(X<0)OR(X>65534)THEN GOTO 6666 ELSE AVAIL:=X;END;MEMEND:=65534; FOR K:=HIMEMMIN TO MEMEND DO BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;MEM[K]:=BASEFILE^[BASECOUNT];END; BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;VARUSED:=BASEFILE^[BASECOUNT].INT;END; BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;DYNUSED:=BASEFILE^[BASECOUNT].INT;END{:1195}; {1197:}BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF(X<1)OR(X>2357)THEN GOTO 6666 ELSE HASHUSED:=X;END;P:=0; REPEAT BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF(XHASHUSED)THEN GOTO 6666 ELSE P:=X;END; BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;HASH[P]:=BASEFILE^[BASECOUNT].HH;END; BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;EQTB[P]:=BASEFILE^[BASECOUNT].HH;END; UNTIL P=HASHUSED; FOR P:=HASHUSED+1 TO 2369 DO BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;HASH[P]:=BASEFILE^[BASECOUNT].HH;END; BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;EQTB[P]:=BASEFILE^[BASECOUNT].HH;END;END; BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;STCOUNT:=BASEFILE^[BASECOUNT].INT;END{:1197}; {1199:}BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF(X<41)OR(X>MAXINTERNAL)THEN GOTO 6666 ELSE INTPTR:=X;END; FOR K:=1 TO INTPTR DO BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;INTERNAL[K]:=BASEFILE^[BASECOUNT].INT;END; BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF(X<0)OR(X>STRPTR)THEN GOTO 6666 ELSE INTNAME[K]:=X;END;END; BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF(X<0)OR(X>2357)THEN GOTO 6666 ELSE STARTSYM:=X;END; BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF(X<0)OR(X>3)THEN GOTO 6666 ELSE INTERACTION:=X;END; BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF(X<0)OR(X>STRPTR)THEN GOTO 6666 ELSE BASEIDENT:=X;END; BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF(X<1)OR(X>2369)THEN GOTO 6666 ELSE BGLOC:=X;END; BEGIN BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF(X<1)OR(X>2369)THEN GOTO 6666 ELSE EGLOC:=X;END; BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;SERIALNO:=BASEFILE^[BASECOUNT].INT;END; BEGIN BEGIN BASECOUNT:=BASECOUNT+1; IF BASECOUNT=VAXBLOCKLENG THEN BEGIN GET(BASEFILE,error:=continue); BASECOUNT:=0;END END;X:=BASEFILE^[BASECOUNT].INT;END; IF(X<>69069)OR EOF(BASEFILE)THEN GOTO 6666{:1199};LOADBASEFILE:=TRUE; GOTO 10;6666:WAKEUPTERMIN; WRITELN(TERMOUT,'(Fatal base file error; I''m stymied)',CHR(13),CHR(10)) ;LOADBASEFILE:=FALSE;10:END;{:1187}{1202:}{823:}PROCEDURE SCANPRIMARY; LABEL 20,30,31,32;VAR P,Q,R:HALFWORD;C:QUARTERWORD;MYVARFLAG:0..85; LDELIM,RDELIM:HALFWORD;{831:}GROUPLINE:INTEGER;{:831}{836:} NUM,DENOM:SCALED;{:836}{843:}PREHEAD,POSTHEAD,TAIL:HALFWORD; TT:SMALLNUMBER;T:HALFWORD;MACROREF:HALFWORD;{:843} BEGIN MYVARFLAG:=VARFLAG;VARFLAG:=0; 20:BEGIN IF ARITHERROR THEN CLEARARITH;END;{825:} {IF PANICKING THEN CHECKMEM(FALSE);} IF INTERRUPT<>0 THEN IF OKTOINTERRUP THEN BEGIN BACKINPUT; BEGIN IF INTERRUPT<>0 THEN PAUSEFORINST;END;GETXNEXT;END{:825}; CASE CURCMD OF 31:{826:}BEGIN LDELIM:=CURSYM;RDELIM:=CURMOD;GETXNEXT; SCANEXPRESSI;IF(CURCMD=82)AND(CURTYPE>=16)THEN{830:}BEGIN P:=GETNODE(2); MEM[P].HH.B0:=14;MEM[P].HH.B1:=11;INITBIGNODE(P);Q:=MEM[P+1].INT; STASHIN(Q);GETXNEXT;SCANEXPRESSI; IF CURTYPE<16 THEN BEGIN DISPERR(0,773);BEGIN HELPPTR:=4; HELPLINE[3]:=774;HELPLINE[2]:=775;HELPLINE[1]:=776;HELPLINE[0]:=777;END; PUTGETFLUSHE(0);END;STASHIN(Q+2);CHECKDELIMIT(LDELIM,RDELIM); CURTYPE:=14;CUREXP:=P;END{:830}ELSE CHECKDELIMIT(LDELIM,RDELIM); END{:826};32:{832:}BEGIN GROUPLINE:=LINE; IF INTERNAL[7]>0 THEN SHOWCMDMOD(CURCMD,CURMOD);BEGIN P:=GETAVAIL; MEM[P].HH.LH:=0;MEM[P].HH.RH:=SAVEPTR;SAVEPTR:=P;END;REPEAT DOSTATEMENT; UNTIL CURCMD<>83; IF CURCMD<>84 THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(778);END; PRINTINT(GROUPLINE);PRINT(779);BEGIN HELPPTR:=2;HELPLINE[1]:=780; HELPLINE[0]:=781;END;BACKERROR;CURCMD:=84;END;UNSAVE; IF INTERNAL[7]>0 THEN SHOWCMDMOD(CURCMD,CURMOD);END{:832};39:{833:} BEGIN CURTYPE:=4;CUREXP:=CURMOD;END{:833};42:{837:}BEGIN CUREXP:=CURMOD; CURTYPE:=16;GETXNEXT;IF CURCMD<>54 THEN BEGIN NUM:=0;DENOM:=0; END ELSE BEGIN GETXNEXT;IF CURCMD<>42 THEN BEGIN BACKINPUT;CURCMD:=54; CURMOD:=72;CURSYM:=2361;GOTO 30;END;NUM:=CUREXP;DENOM:=CURMOD; IF DENOM=0 THEN{838:}BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(782);END; BEGIN HELPPTR:=1;HELPLINE[0]:=783;END;ERROR;END{:838} ELSE CUREXP:=MAKESCALED(NUM,DENOM);BEGIN IF ARITHERROR THEN CLEARARITH; END;GETXNEXT;END; IF CURCMD>=30 THEN IF CURCMD<42 THEN BEGIN P:=STASHCUREXP;SCANPRIMARY; IF(ABS(NUM)>=ABS(DENOM))OR(CURTYPE<14)THEN DOBINARY(P,71)ELSE BEGIN FRACMULT(NUM,DENOM);FREENODE(P,2);END;END;GOTO 30;END{:837};33:{834:} DONULLARY(CURMOD){:834};34,30,36,43:{835:}BEGIN C:=CURMOD;GETXNEXT; SCANPRIMARY;DOUNARY(C);GOTO 30;END{:835};37:{839:}BEGIN C:=CURMOD; GETXNEXT;SCANEXPRESSI;IF CURCMD<>69 THEN BEGIN MISSINGERR(479); PRINT(714);PRINTCMDMOD(37,C);BEGIN HELPPTR:=1;HELPLINE[0]:=715;END; BACKERROR;END;P:=STASHCUREXP;GETXNEXT;SCANPRIMARY;DOBINARY(P,C);GOTO 30; END{:839};35:{840:}BEGIN GETXNEXT;SCANSUFFIX;OLDSETTING:=SELECTOR; SELECTOR:=5;SHOWTOKENLIS(CUREXP,0,100000,0);FLUSHTOKENLI(CUREXP); CUREXP:=MAKESTRING;SELECTOR:=OLDSETTING;CURTYPE:=4;GOTO 30;END{:840}; 40:{841:}BEGIN Q:=CURMOD;IF MYVARFLAG=77 THEN BEGIN GETXNEXT; IF CURCMD=77 THEN BEGIN CUREXP:=GETAVAIL;MEM[CUREXP].HH.LH:=Q+2369; CURTYPE:=20;GOTO 30;END;BACKINPUT;END;CURTYPE:=16;CUREXP:=INTERNAL[Q]; END{:841};38:MAKEEXPCOPY(CURMOD);41:{844:}BEGIN BEGIN PREHEAD:=AVAIL; IF PREHEAD=0 THEN PREHEAD:=GETAVAIL ELSE BEGIN AVAIL:=MEM[PREHEAD].HH.RH ;MEM[PREHEAD].HH.RH:=0;DYNUSED:=DYNUSED+1;END;END;TAIL:=PREHEAD; POSTHEAD:=0;TT:=1;WHILE TRUE DO BEGIN T:=CURTOK;MEM[TAIL].HH.RH:=T; IF TT<>0 THEN BEGIN{850:}BEGIN P:=MEM[PREHEAD].HH.RH;Q:=MEM[P].HH.LH; TT:=0;IF EQTB[Q].LH MOD 86=41 THEN BEGIN Q:=EQTB[Q].RH; IF Q=0 THEN GOTO 32;WHILE TRUE DO BEGIN P:=MEM[P].HH.RH; IF P=0 THEN BEGIN TT:=MEM[Q].HH.B0;GOTO 32;END; IF MEM[Q].HH.B0<>21 THEN GOTO 32;Q:=MEM[MEM[Q+1].HH.LH].HH.RH; IF P>=HIMEMMIN THEN BEGIN REPEAT Q:=MEM[Q].HH.RH; UNTIL MEM[Q+2].HH.LH>=MEM[P].HH.LH; IF MEM[Q+2].HH.LH>MEM[P].HH.LH THEN GOTO 32;END;END;END;32:END{:850}; IF TT>=22 THEN{845:}BEGIN MEM[TAIL].HH.RH:=0; IF TT>22 THEN BEGIN POSTHEAD:=GETAVAIL;TAIL:=POSTHEAD; MEM[TAIL].HH.RH:=T;TT:=0;MACROREF:=MEM[Q+1].INT; MEM[MACROREF].HH.LH:=MEM[MACROREF].HH.LH+1;END ELSE{853:} BEGIN P:=GETAVAIL;MEM[PREHEAD].HH.LH:=MEM[PREHEAD].HH.RH; MEM[PREHEAD].HH.RH:=P;MEM[P].HH.LH:=T;MACROCALL(MEM[Q+1].INT,PREHEAD,0); GETXNEXT;GOTO 20;END{:853};END{:845};END;GETXNEXT;TAIL:=T; IF CURCMD=63 THEN{846:}BEGIN GETXNEXT;SCANEXPRESSI; IF CURCMD<>64 THEN{847:}BEGIN BACKINPUT;BACKEXPR;CURCMD:=63;CURMOD:=0; CURSYM:=2360;END{:847}ELSE BEGIN IF CURTYPE<>16 THEN BADSUBSCRIPT; CURCMD:=42;CURMOD:=CUREXP;CURSYM:=0;END;END{:846}; IF CURCMD>42 THEN GOTO 31;IF CURCMD<40 THEN GOTO 31;END;31:{852:} IF POSTHEAD<>0 THEN{854:}BEGIN BACKINPUT;P:=GETAVAIL; Q:=MEM[POSTHEAD].HH.RH;MEM[PREHEAD].HH.LH:=MEM[PREHEAD].HH.RH; MEM[PREHEAD].HH.RH:=POSTHEAD;MEM[POSTHEAD].HH.LH:=Q; MEM[POSTHEAD].HH.RH:=P;MEM[P].HH.LH:=MEM[Q].HH.RH;MEM[Q].HH.RH:=0; MACROCALL(MACROREF,PREHEAD,0); MEM[MACROREF].HH.LH:=MEM[MACROREF].HH.LH-1;GETXNEXT;GOTO 20;END{:854}; Q:=MEM[PREHEAD].HH.RH;BEGIN MEM[PREHEAD].HH.RH:=AVAIL;AVAIL:=PREHEAD; DYNUSED:=DYNUSED-1;END;IF CURCMD=MYVARFLAG THEN BEGIN CURTYPE:=20; CUREXP:=Q;GOTO 30;END;P:=FINDVARIABLE(Q); IF P<>0 THEN MAKEEXPCOPY(P)ELSE BEGIN OBLITERATED(Q);HELPLINE[2]:=795; HELPLINE[1]:=796;HELPLINE[0]:=797;PUTGETFLUSHE(0);END;FLUSHNODELIS(Q); GOTO 30{:852};END{:844};OTHERWISE BEGIN BADEXP(767);GOTO 20;END END; GETXNEXT;30:IF CURCMD=63 THEN IF CURTYPE>=16 THEN{859:} BEGIN P:=STASHCUREXP;GETXNEXT;SCANEXPRESSI; IF CURCMD<>82 THEN BEGIN{847:}BEGIN BACKINPUT;BACKEXPR;CURCMD:=63; CURMOD:=0;CURSYM:=2360;END{:847};UNSTASHCUREX(P); END ELSE BEGIN Q:=STASHCUREXP;GETXNEXT;SCANEXPRESSI; IF CURCMD<>64 THEN BEGIN MISSINGERR(93);BEGIN HELPPTR:=3; HELPLINE[2]:=799;HELPLINE[1]:=800;HELPLINE[0]:=696;END;BACKERROR;END; R:=STASHCUREXP;MAKEEXPCOPY(Q);DOBINARY(R,70);DOBINARY(P,71); DOBINARY(Q,69);GETXNEXT;END;END{:859};END;{:823}{860:} PROCEDURE SCANSUFFIX;LABEL 30;VAR H,T:HALFWORD;P:HALFWORD; BEGIN H:=GETAVAIL;T:=H;WHILE TRUE DO BEGIN IF CURCMD=63 THEN{861:} BEGIN GETXNEXT;SCANEXPRESSI;IF CURTYPE<>16 THEN BADSUBSCRIPT; IF CURCMD<>64 THEN BEGIN MISSINGERR(93);BEGIN HELPPTR:=3; HELPLINE[2]:=801;HELPLINE[1]:=800;HELPLINE[0]:=696;END;BACKERROR;END; CURCMD:=42;CURMOD:=CUREXP;END{:861}; IF CURCMD=42 THEN P:=NEWNUMTOK(CURMOD)ELSE IF(CURCMD=41)OR(CURCMD=40) THEN BEGIN P:=GETAVAIL;MEM[P].HH.LH:=CURSYM;END ELSE GOTO 30; MEM[T].HH.RH:=P;T:=P;GETXNEXT;END;30:CUREXP:=MEM[H].HH.RH; BEGIN MEM[H].HH.RH:=AVAIL;AVAIL:=H;DYNUSED:=DYNUSED-1;END;CURTYPE:=20; END;{:860}{862:}PROCEDURE SCANSECONDAR;LABEL 20,22;VAR P:HALFWORD; C,D:HALFWORD;MACNAME:HALFWORD; BEGIN 20:IF(CURCMD<30)OR(CURCMD>43)THEN BADEXP(802);SCANPRIMARY; 22:IF CURCMD<=55 THEN IF CURCMD>=52 THEN BEGIN P:=STASHCUREXP;C:=CURMOD; D:=CURCMD;IF D=53 THEN BEGIN MACNAME:=CURSYM; MEM[C].HH.LH:=MEM[C].HH.LH+1;END;GETXNEXT;SCANPRIMARY; IF D<>53 THEN DOBINARY(P,C)ELSE BEGIN BACKINPUT;BINARYMAC(P,C,MACNAME); MEM[C].HH.LH:=MEM[C].HH.LH-1;GETXNEXT;GOTO 20;END;GOTO 22;END;END;{:862} {864:}PROCEDURE SCANTERTIARY;LABEL 20,22;VAR P:HALFWORD;C,D:HALFWORD; MACNAME:HALFWORD;BEGIN 20:IF(CURCMD<30)OR(CURCMD>43)THEN BADEXP(803); SCANSECONDAR;IF CURTYPE=8 THEN MATERIALIZEP; 22:IF CURCMD<=45 THEN IF CURCMD>=43 THEN BEGIN P:=STASHCUREXP;C:=CURMOD; D:=CURCMD;IF D=44 THEN BEGIN MACNAME:=CURSYM; MEM[C].HH.LH:=MEM[C].HH.LH+1;END;GETXNEXT;SCANSECONDAR; IF D<>44 THEN DOBINARY(P,C)ELSE BEGIN BACKINPUT;BINARYMAC(P,C,MACNAME); MEM[C].HH.LH:=MEM[C].HH.LH-1;GETXNEXT;GOTO 20;END;GOTO 22;END;END;{:864} {868:}PROCEDURE SCANEXPRESSI;LABEL 20,30,22,25,26,10; VAR P,Q,R,PP,QQ:HALFWORD;C,D:HALFWORD;MYVARFLAG:0..85;MACNAME:HALFWORD; CYCLEHIT:BOOLEAN;X,Y:SCALED;T:0..4;BEGIN MYVARFLAG:=VARFLAG; 20:IF(CURCMD<30)OR(CURCMD>43)THEN BADEXP(806);SCANTERTIARY; 22:IF CURCMD<=51 THEN IF CURCMD>=46 THEN IF(CURCMD<>51)OR(MYVARFLAG<>77) THEN BEGIN P:=STASHCUREXP;C:=CURMOD;D:=CURCMD; IF D=49 THEN BEGIN MACNAME:=CURSYM;MEM[C].HH.LH:=MEM[C].HH.LH+1;END; IF(D<48)OR((D=48)AND((MEM[P].HH.B0=14)OR(MEM[P].HH.B0=9)))THEN{869:} BEGIN CYCLEHIT:=FALSE;{870:}BEGIN UNSTASHCUREX(P); IF CURTYPE=14 THEN P:=NEWKNOT ELSE IF CURTYPE=9 THEN P:=CUREXP ELSE GOTO 10;Q:=P;WHILE MEM[Q].HH.RH<>P DO Q:=MEM[Q].HH.RH; IF MEM[P].HH.B0<>0 THEN BEGIN R:=COPYKNOT(P);MEM[Q].HH.RH:=R;Q:=R;END; MEM[P].HH.B0:=4;MEM[Q].HH.B1:=4;END{:870};25:{874:} IF CURCMD=46 THEN{879:}BEGIN T:=SCANDIRECTIO; IF T<>4 THEN BEGIN MEM[Q].HH.B1:=T;MEM[Q+5].INT:=CUREXP; IF MEM[Q].HH.B0=4 THEN BEGIN MEM[Q].HH.B0:=T;MEM[Q+3].INT:=CUREXP;END; END;END{:879};D:=CURCMD;IF D=47 THEN{881:}BEGIN GETXNEXT; IF CURCMD=58 THEN{882:}BEGIN GETXNEXT;Y:=CURCMD; IF CURCMD=59 THEN GETXNEXT;SCANPRIMARY;{883:} IF(CURTYPE<>16)OR(CUREXP<49152)THEN BEGIN DISPERR(0,824); BEGIN HELPPTR:=1;HELPLINE[0]:=825;END;PUTGETFLUSHE(65536);END{:883}; IF Y=59 THEN CUREXP:=-CUREXP;MEM[Q+6].INT:=CUREXP; IF CURCMD=52 THEN BEGIN GETXNEXT;Y:=CURCMD;IF CURCMD=59 THEN GETXNEXT; SCANPRIMARY;{883:} IF(CURTYPE<>16)OR(CUREXP<49152)THEN BEGIN DISPERR(0,824); BEGIN HELPPTR:=1;HELPLINE[0]:=825;END;PUTGETFLUSHE(65536);END{:883}; IF Y=59 THEN CUREXP:=-CUREXP;END;Y:=CUREXP;END{:882} ELSE IF CURCMD=57 THEN{884:}BEGIN MEM[Q].HH.B1:=1;T:=1;GETXNEXT; SCANPRIMARY;KNOWNPAIR;MEM[Q+5].INT:=CURX;MEM[Q+6].INT:=CURY; IF CURCMD<>52 THEN BEGIN X:=MEM[Q+5].INT;Y:=MEM[Q+6].INT; END ELSE BEGIN GETXNEXT;SCANPRIMARY;KNOWNPAIR;X:=CURX;Y:=CURY;END; END{:884}ELSE BEGIN MEM[Q+6].INT:=65536;Y:=65536;BACKINPUT;GOTO 30;END; IF CURCMD<>47 THEN BEGIN MISSINGERR(409);BEGIN HELPPTR:=1; HELPLINE[0]:=823;END;BACKERROR;END;30:END{:881} ELSE IF D<>48 THEN GOTO 26;GETXNEXT;IF CURCMD=46 THEN{880:} BEGIN T:=SCANDIRECTIO;IF MEM[Q].HH.B1<>1 THEN X:=CUREXP ELSE T:=1; END{:880}ELSE IF MEM[Q].HH.B1<>1 THEN BEGIN T:=4;X:=0;END{:874}; IF CURCMD=36 THEN{886:}BEGIN CYCLEHIT:=TRUE;GETXNEXT;PP:=P;QQ:=P; IF D=48 THEN IF P=Q THEN BEGIN D:=47;MEM[Q+6].INT:=65536;Y:=65536;END; END{:886}ELSE BEGIN SCANTERTIARY;{885:} BEGIN IF CURTYPE<>9 THEN PP:=NEWKNOT ELSE PP:=CUREXP;QQ:=PP; WHILE MEM[QQ].HH.RH<>PP DO QQ:=MEM[QQ].HH.RH; IF MEM[PP].HH.B0<>0 THEN BEGIN R:=COPYKNOT(PP);MEM[QQ].HH.RH:=R;QQ:=R; END;MEM[PP].HH.B0:=4;MEM[QQ].HH.B1:=4;END{:885};END;{887:} BEGIN IF D=48 THEN IF(MEM[Q+1].INT<>MEM[PP+1].INT)OR(MEM[Q+2].INT<>MEM[ PP+2].INT)THEN BEGIN BEGIN IF INTERACTION=3 THEN WAKEUPTERMIN; PRINTNL(261);COPYERR:=SAVEIT;REWRITE(TEMPFILE);PRINT(826);END; BEGIN HELPPTR:=3;HELPLINE[2]:=827;HELPLINE[1]:=828;HELPLINE[0]:=829;END; PUTGETERROR;D:=47;MEM[Q+6].INT:=65536;Y:=65536;END;{889:} IF MEM[PP].HH.B1=4 THEN IF(T=3)OR(T=2)THEN BEGIN MEM[PP].HH.B1:=T; MEM[PP+5].INT:=X;END{:889};IF D=48 THEN{890:} BEGIN IF MEM[Q].HH.B0=4 THEN IF MEM[Q].HH.B1=4 THEN BEGIN MEM[Q].HH.B0:= 3;MEM[Q+3].INT:=65536;END; IF MEM[PP].HH.B1=4 THEN IF T=4 THEN BEGIN MEM[PP].HH.B1:=3; MEM[PP+5].INT:=65536;END;MEM[Q].HH.B1:=MEM[PP].HH.B1; MEM[Q].HH.RH:=MEM[PP].HH.RH;MEM[Q+5].INT:=MEM[PP+5].INT; MEM[Q+6].INT:=MEM[PP+6].INT;FREENODE(PP,7);IF QQ=PP THEN QQ:=Q;END{:890} ELSE BEGIN{888:} IF MEM[Q].HH.B1=4 THEN IF(MEM[Q].HH.B0=3)OR(MEM[Q].HH.B0=2)THEN BEGIN MEM[Q].HH.B1:=MEM[Q].HH.B0;MEM[Q+5].INT:=MEM[Q+3].INT;END{:888}; MEM[Q].HH.RH:=PP;MEM[PP+4].INT:=Y;IF T<>4 THEN BEGIN MEM[PP+3].INT:=X; MEM[PP].HH.B0:=T;END;END;Q:=QQ;END{:887}; IF CURCMD>=46 THEN IF CURCMD<=48 THEN IF NOT CYCLEHIT THEN GOTO 25; 26:{891:}IF CYCLEHIT THEN BEGIN IF D=48 THEN P:=Q; END ELSE BEGIN MEM[P].HH.B0:=0; IF MEM[P].HH.B1=4 THEN BEGIN MEM[P].HH.B1:=3;MEM[P+5].INT:=65536;END; MEM[Q].HH.B1:=0;IF MEM[Q].HH.B0=4 THEN BEGIN MEM[Q].HH.B0:=3; MEM[Q+3].INT:=65536;END;MEM[Q].HH.RH:=P;END;MAKECHOICES(P);CURTYPE:=9; CUREXP:=P{:891};END{:869}ELSE BEGIN GETXNEXT;SCANTERTIARY; IF D<>49 THEN DOBINARY(P,C)ELSE BEGIN BACKINPUT;BINARYMAC(P,C,MACNAME); MEM[C].HH.LH:=MEM[C].HH.LH-1;GETXNEXT;GOTO 20;END;END;GOTO 22;END; 10:END;{:868}{892:}PROCEDURE GETBOOLEAN;BEGIN GETXNEXT;SCANEXPRESSI; IF CURTYPE<>2 THEN BEGIN DISPERR(0,830);BEGIN HELPPTR:=2; HELPLINE[1]:=831;HELPLINE[0]:=832;END;PUTGETFLUSHE(31);CURTYPE:=2;END; END;{:892}{224:}PROCEDURE PRINTCAPSULE;BEGIN PRINTCHAR(40); PRINTEXP(GPOINTER,0);PRINTCHAR(41);END;PROCEDURE TOKENRECYCLE; BEGIN RECYCLEVALUE(GPOINTER);END;{:224}{1205:}PROCEDURE CLOSEFILESAN; VAR K:INTEGER;LH:INTEGER;LKOFFSET:0..256;P:HALFWORD;X:SCALED; BEGIN IF INTERNAL[12]>0 THEN{1208:} IF LOGOPENED THEN BEGIN IF LOGQUAL THEN WRITELN(LOGFILE,' '); IF LOGQUAL THEN WRITELN(LOGFILE,'Here is how much of METAFONT''s memory' ,' you used:'); IF LOGQUAL THEN WRITE(LOGFILE,' ',MAXSTRPTR-INITSTRPTR:1,' string'); IF MAXSTRPTR<>INITSTRPTR+1 THEN IF LOGQUAL THEN WRITE(LOGFILE,'s'); IF LOGQUAL THEN WRITELN(LOGFILE,' out of ',MAXSTRINGS-INITSTRPTR:1); IF LOGQUAL THEN WRITELN(LOGFILE,' ',MAXPOOLPTR-INITPOOLPTR:1, ' string characters out of ',POOLSIZE-INITPOOLPTR:1); IF LOGQUAL THEN WRITELN(LOGFILE,' ',LOMEMMAX+0+MEMEND-HIMEMMIN+2:1, ' words of memory out of ',MEMEND+1:1); IF LOGQUAL THEN WRITELN(LOGFILE,' ',STCOUNT:1,' symbolic tokens out of ' ,2100:1); IF LOGQUAL THEN WRITELN(LOGFILE,' ',MAXINSTACK:1,'i,',INTPTR:1,'n,', MAXROUNDINGP:1,'r,',MAXPARAMSTAC:1,'p,',MAXBUFSTACK+1:1, 'b stack positions out of ',STACKSIZE:1,'i,',MAXINTERNAL:1,'n,', MAXWIGGLE:1,'r,',150:1,'p,',BUFSIZE:1,'b');END{:1208};WAKEUPTERMIN; {1206:}IF(GFPREVPTR>0)OR(INTERNAL[33]>0)THEN BEGIN{1207:}ROVER:=23; MEM[ROVER].HH.RH:=65535;LOMEMMAX:=HIMEMMIN-1; IF LOMEMMAX-ROVER>65535 THEN LOMEMMAX:=65535+ROVER; MEM[ROVER].HH.LH:=LOMEMMAX-ROVER;MEM[ROVER+1].HH.LH:=ROVER; MEM[ROVER+1].HH.RH:=ROVER;MEM[LOMEMMAX].HH.RH:=0; MEM[LOMEMMAX].HH.LH:=0{:1207};{1124:}MEM[65533].HH.RH:=19; FOR K:=BC TO EC DO IF CHAREXISTS[K]THEN TFMWIDTH[K]:=SORTIN(TFMWIDTH[K]) ;NW:=SKIMP(255)+1;DIMENHEAD[1]:=MEM[65533].HH.RH; IF PERTURBATION>=4096 THEN TFMWARNING(20){:1124};FIXDESIGNSIZ; FIXCHECKSUM;IF INTERNAL[33]>0 THEN BEGIN{1126:}MEM[65533].HH.RH:=19; FOR K:=BC TO EC DO IF CHAREXISTS[K]THEN IF TFMHEIGHT[K]=0 THEN TFMHEIGHT [K]:=15 ELSE TFMHEIGHT[K]:=SORTIN(TFMHEIGHT[K]);NH:=SKIMP(15)+1; DIMENHEAD[2]:=MEM[65533].HH.RH; IF PERTURBATION>=4096 THEN TFMWARNING(21);MEM[65533].HH.RH:=19; FOR K:=BC TO EC DO IF CHAREXISTS[K]THEN IF TFMDEPTH[K]=0 THEN TFMDEPTH[K ]:=15 ELSE TFMDEPTH[K]:=SORTIN(TFMDEPTH[K]);ND:=SKIMP(15)+1; DIMENHEAD[3]:=MEM[65533].HH.RH; IF PERTURBATION>=4096 THEN TFMWARNING(22);MEM[65533].HH.RH:=19; FOR K:=BC TO EC DO IF CHAREXISTS[K]THEN IF TFMITALCORR[K]=0 THEN TFMITALCORR[K]:=15 ELSE TFMITALCORR[K]:=SORTIN(TFMITALCORR[K]); NI:=SKIMP(63)+1;DIMENHEAD[4]:=MEM[65533].HH.RH; IF PERTURBATION>=4096 THEN TFMWARNING(23){:1126};INTERNAL[33]:=0;{1134:} IF JOBNAME=0 THEN OPENLOGFILE;PACKJOBNAME(1043); WHILE NOT BOPENOUT(TFMFILE)DO PROMPTFILENA(1044,1043);TFMCOUNT:=0; METRICFILENA:=BMAKENAMESTR(TFMFILE);{1135:}K:=HEADERSIZE; WHILE HEADERBYTE[K]<0 DO K:=K-1;LH:=(K+3)DIV 4;IF BC>EC THEN BC:=1; {1137:}BCHAR:=ROUNDUNSCALE(INTERNAL[41]); IF(BCHAR<0)OR(BCHAR>255)THEN BEGIN BCHAR:=-1;LKSTARTED:=FALSE; LKOFFSET:=0;END ELSE BEGIN LKSTARTED:=TRUE;LKOFFSET:=1;END;{1138:} K:=LABELPTR;IF LABELLOC[K]+LKOFFSET>255 THEN BEGIN LKOFFSET:=0; LKSTARTED:=FALSE;REPEAT CHARREMAINDE[LABELCHAR[K]]:=LKOFFSET; WHILE LABELLOC[K-1]=LABELLOC[K]DO BEGIN K:=K-1; CHARREMAINDE[LABELCHAR[K]]:=LKOFFSET;END;LKOFFSET:=LKOFFSET+1;K:=K-1; UNTIL LKOFFSET+LABELLOC[K]<256;END; IF LKOFFSET>0 THEN WHILE K>0 DO BEGIN CHARREMAINDE[LABELCHAR[K]]:= CHARREMAINDE[LABELCHAR[K]]+LKOFFSET;K:=K-1;END{:1138}; IF BCHLABEL19 DO BEGIN TFMFOUR(DIMENOUT(MEM[P+1].INT)); P:=MEM[P].HH.RH;END;END{:1136};{1139:} FOR K:=0 TO 255 DO IF SKIPTABLE[K]0 THEN TFMFOUR(2147483647)ELSE TFMFOUR(-2147483647); END ELSE TFMFOUR(DIMENOUT(PARAM[K])); IF TFMCHANGED>0 THEN BEGIN IF TFMCHANGED=1 THEN PRINTNL(1048)ELSE BEGIN PRINTNL(40);PRINTINT(TFMCHANGED);PRINT(1049);END;PRINT(1050);END{:1140}; IF INTERNAL[12]>0 THEN{1141:}BEGIN IF LOGQUAL THEN WRITELN(LOGFILE,' '); IF BCHLABEL0 DO BEGIN TFMFILE^[TFMCOUNT]:=0;TFMCOUNT:=TFMCOUNT+1; IF TFMCOUNT=VAXBLOCKLENG THEN BEGIN PUT(TFMFILE,error:=continue); TFMCOUNT:=0;END END;BCLOSE(TFMFILE){:1134};END; IF GFPREVPTR>0 THEN{1182:}BEGIN BEGIN GBUFFER.B[GFPTR]:=248; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END;GFFOUR(GFPREVPTR); GFPREVPTR:=GFOFFSET+GFPTR-5;GFFOUR(INTERNAL[26]*16); FOR K:=1 TO 4 DO BEGIN GBUFFER.B[GFPTR]:=HEADERBYTE[K];GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;GFFOUR(INTERNAL[27]); GFFOUR(INTERNAL[28]);GFFOUR(GFMINM);GFFOUR(GFMAXM);GFFOUR(GFMINN); GFFOUR(GFMAXN); FOR K:=0 TO 255 DO IF CHAREXISTS[K]THEN BEGIN X:=GFDX[K]DIV 65536; IF(GFDY[K]=0)AND(X>=0)AND(X<256)AND(GFDX[K]=X*65536)THEN BEGIN BEGIN GBUFFER.B[GFPTR]:=246;GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END; BEGIN GBUFFER.B[GFPTR]:=K;GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP; END;BEGIN GBUFFER.B[GFPTR]:=X;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END; END ELSE BEGIN BEGIN GBUFFER.B[GFPTR]:=245;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;BEGIN GBUFFER.B[GFPTR]:=K; GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP;END;GFFOUR(GFDX[K]); GFFOUR(GFDY[K]);END;X:=MEM[TFMWIDTH[K]+1].INT; IF ABS(X)>MAXTFMDIMEN THEN IF X>0 THEN X:=16777215 ELSE X:=-16777215 ELSE X:=MAKESCALED(X*16,INTERNAL[26]);GFFOUR(X);GFFOUR(CHARPTR[K]);END; BEGIN GBUFFER.B[GFPTR]:=249;GFPTR:=GFPTR+1;IF GFPTR=GFLIMIT THEN GFSWAP; END;GFFOUR(GFPREVPTR);BEGIN GBUFFER.B[GFPTR]:=131;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;K:=4+((GFBUFSIZE-GFPTR)MOD 4); WHILE K>0 DO BEGIN BEGIN GBUFFER.B[GFPTR]:=223;GFPTR:=GFPTR+1; IF GFPTR=GFLIMIT THEN GFSWAP;END;K:=K-1;END;{1156:} IF GFLIMIT=HALFBUF THEN WRITE(GFFILE,GBUFFER.R); FOR K:=GFPTR TO GFBUFSIZE DO GBUFFER.B[K]:=223; IF GFPTR>0 THEN WRITE(GFFILE,GBUFFER.L); IF GFPTR>HALFBUF THEN WRITE(GFFILE,GBUFFER.R);{:1156};PRINTNL(1061); PRINT(OUTPUTFILENA);PRINT(558);PRINTINT(TOTALCHARS);PRINT(1062); IF TOTALCHARS<>1 THEN PRINTCHAR(115);PRINT(1063); PRINTINT(GFOFFSET+GFPTR);PRINT(1064);BCLOSE(GFFILE);END{:1182}; END{:1206};IF DIAGQUAL THEN BEGIN PRINTNL(1074);PRINT(DIAGNAME); PRINTCHAR(46);IF DIAGQUAL THEN WRITELN(DIAGFILE); IF DIAGQUAL THEN WRITELN(DIAGFILE,'end module');ACLOSE(DIAGFILE);END; END;{:1205}{1209:}PROCEDURE FINALCLEANUP;LABEL 10;VAR C:SMALLNUMBER; BEGIN C:=CURMOD;IF JOBNAME=0 THEN OPENLOGFILE; WHILE OPENPARENS>0 DO BEGIN PRINT(1075);OPENPARENS:=OPENPARENS-1;END; WHILE CONDPTR<>0 DO BEGIN PRINTNL(1076);PRINTCMDMOD(2,CURIF); IF IFLINE<>0 THEN BEGIN PRINT(1077);PRINTINT(IFLINE);END;PRINT(1078); IFLINE:=MEM[CONDPTR+1].INT;CURIF:=MEM[CONDPTR].HH.B1; CONDPTR:=MEM[CONDPTR].HH.RH;END; IF HISTORY<>0 THEN IF((HISTORY=1)OR(INTERACTION<3))THEN IF SELECTOR=3 THEN BEGIN SELECTOR:=1;PRINTNL(1079);SELECTOR:=3;END; IF C=1 THEN BEGIN IF INITFLAG THEN BEGIN STOREBASEFIL;GOTO 10;END; PRINTNL(1080);GOTO 10;END;10:END;{:1209}{1210:}PROCEDURE INITPRIM; BEGIN{192:}PRIMITIVE(410,40,1);PRIMITIVE(411,40,2);PRIMITIVE(412,40,3); PRIMITIVE(413,40,4);PRIMITIVE(414,40,5);PRIMITIVE(415,40,6); PRIMITIVE(416,40,7);PRIMITIVE(417,40,8);PRIMITIVE(418,40,9); PRIMITIVE(419,40,10);PRIMITIVE(420,40,11);PRIMITIVE(421,40,12); PRIMITIVE(422,40,13);PRIMITIVE(423,40,14);PRIMITIVE(424,40,15); PRIMITIVE(425,40,16);PRIMITIVE(426,40,17);PRIMITIVE(427,40,18); PRIMITIVE(428,40,19);PRIMITIVE(429,40,20);PRIMITIVE(430,40,21); PRIMITIVE(431,40,22);PRIMITIVE(432,40,23);PRIMITIVE(433,40,24); PRIMITIVE(434,40,25);PRIMITIVE(435,40,26);PRIMITIVE(436,40,27); PRIMITIVE(437,40,28);PRIMITIVE(438,40,29);PRIMITIVE(439,40,30); PRIMITIVE(440,40,31);PRIMITIVE(441,40,32);PRIMITIVE(442,40,33); PRIMITIVE(443,40,34);PRIMITIVE(444,40,35);PRIMITIVE(445,40,36); PRIMITIVE(446,40,37);PRIMITIVE(447,40,38);PRIMITIVE(448,40,39); PRIMITIVE(449,40,40);PRIMITIVE(450,40,41);{:192}{211:} PRIMITIVE(409,47,0);PRIMITIVE(91,63,0);EQTB[2360]:=EQTB[CURSYM]; PRIMITIVE(93,64,0);PRIMITIVE(125,65,0);PRIMITIVE(123,46,0); PRIMITIVE(58,81,0);EQTB[2362]:=EQTB[CURSYM];PRIMITIVE(459,80,0); PRIMITIVE(460,79,0);PRIMITIVE(461,77,0);PRIMITIVE(44,82,0); PRIMITIVE(59,83,0);EQTB[2363]:=EQTB[CURSYM];PRIMITIVE(92,7,0); PRIMITIVE(462,18,0);PRIMITIVE(463,72,0);PRIMITIVE(464,59,0); PRIMITIVE(465,32,0);BGLOC:=CURSYM;PRIMITIVE(466,57,0); PRIMITIVE(467,19,0);PRIMITIVE(468,60,0);PRIMITIVE(469,27,0); PRIMITIVE(470,11,0);PRIMITIVE(453,84,0);EQTB[2367]:=EQTB[CURSYM]; EGLOC:=CURSYM;PRIMITIVE(471,26,0);PRIMITIVE(472,6,0);PRIMITIVE(473,9,0); PRIMITIVE(474,70,0);PRIMITIVE(475,73,0);PRIMITIVE(476,13,0); PRIMITIVE(477,14,0);PRIMITIVE(478,15,0);PRIMITIVE(479,69,0); PRIMITIVE(480,28,0);PRIMITIVE(481,24,0);PRIMITIVE(482,12,0); PRIMITIVE(483,8,0);PRIMITIVE(484,17,0);PRIMITIVE(485,78,0); PRIMITIVE(486,74,0);PRIMITIVE(487,35,0);PRIMITIVE(488,58,0); PRIMITIVE(489,71,0);PRIMITIVE(490,75,0);{:211}{683:}PRIMITIVE(653,16,1); PRIMITIVE(654,16,2);PRIMITIVE(655,16,53);PRIMITIVE(656,16,44); PRIMITIVE(657,16,49);PRIMITIVE(454,16,0);EQTB[2365]:=EQTB[CURSYM]; PRIMITIVE(658,4,2370);PRIMITIVE(659,4,2520);PRIMITIVE(660,4,1); PRIMITIVE(455,4,0);EQTB[2364]:=EQTB[CURSYM];{:683}{688:} PRIMITIVE(661,61,0);PRIMITIVE(662,61,1);PRIMITIVE(64,61,2); PRIMITIVE(663,61,3);{:688}{695:}PRIMITIVE(674,56,2370); PRIMITIVE(675,56,2520);PRIMITIVE(676,56,2670);PRIMITIVE(677,56,1); PRIMITIVE(678,56,2);PRIMITIVE(679,56,3);{:695}{709:}PRIMITIVE(689,3,0); PRIMITIVE(615,3,1);{:709}{740:}PRIMITIVE(716,1,1);PRIMITIVE(452,2,2); EQTB[2366]:=EQTB[CURSYM];PRIMITIVE(717,2,3);PRIMITIVE(718,2,4);{:740} {893:}PRIMITIVE(348,33,30);PRIMITIVE(349,33,31);PRIMITIVE(350,33,32); PRIMITIVE(351,33,33);PRIMITIVE(352,33,34);PRIMITIVE(353,33,35); PRIMITIVE(354,33,36);PRIMITIVE(355,33,37);PRIMITIVE(356,34,38); PRIMITIVE(357,34,39);PRIMITIVE(358,34,40);PRIMITIVE(359,34,41); PRIMITIVE(360,34,42);PRIMITIVE(361,34,43);PRIMITIVE(362,34,44); PRIMITIVE(363,34,45);PRIMITIVE(364,34,46);PRIMITIVE(365,34,47); PRIMITIVE(366,34,48);PRIMITIVE(367,34,49);PRIMITIVE(368,34,50); PRIMITIVE(369,34,51);PRIMITIVE(370,34,52);PRIMITIVE(371,34,53); PRIMITIVE(372,34,54);PRIMITIVE(373,34,55);PRIMITIVE(374,34,56); PRIMITIVE(375,34,57);PRIMITIVE(376,34,58);PRIMITIVE(377,34,59); PRIMITIVE(378,34,60);PRIMITIVE(379,34,61);PRIMITIVE(380,34,62); PRIMITIVE(381,34,63);PRIMITIVE(382,34,64);PRIMITIVE(383,34,65); PRIMITIVE(384,34,66);PRIMITIVE(385,34,67);PRIMITIVE(386,36,68); PRIMITIVE(43,43,69);PRIMITIVE(45,43,70);PRIMITIVE(42,55,71); PRIMITIVE(47,54,72);EQTB[2361]:=EQTB[CURSYM];PRIMITIVE(387,45,73); PRIMITIVE(311,45,74);PRIMITIVE(389,52,76);PRIMITIVE(388,45,75); PRIMITIVE(60,50,77);PRIMITIVE(390,50,78);PRIMITIVE(62,50,79); PRIMITIVE(391,50,80);PRIMITIVE(61,51,81);PRIMITIVE(392,50,82); PRIMITIVE(402,37,94);PRIMITIVE(403,37,95);PRIMITIVE(404,37,96); PRIMITIVE(405,37,97);PRIMITIVE(406,37,98);PRIMITIVE(407,37,99); PRIMITIVE(408,37,100);PRIMITIVE(38,48,83);PRIMITIVE(393,55,84); PRIMITIVE(394,55,85);PRIMITIVE(395,55,86);PRIMITIVE(396,55,87); PRIMITIVE(397,55,88);PRIMITIVE(398,55,89);PRIMITIVE(399,55,90); PRIMITIVE(400,55,91);PRIMITIVE(401,45,92);{:893}{1013:} PRIMITIVE(341,30,15);PRIMITIVE(327,30,4);PRIMITIVE(325,30,2); PRIMITIVE(332,30,9);PRIMITIVE(329,30,6);PRIMITIVE(334,30,11); PRIMITIVE(336,30,13);PRIMITIVE(337,30,14);{:1013}{1018:} PRIMITIVE(910,85,0);PRIMITIVE(911,85,1);{:1018}{1024:} PRIMITIVE(273,23,0);PRIMITIVE(274,23,1);PRIMITIVE(275,23,2); PRIMITIVE(917,23,3);{:1024}{1027:}PRIMITIVE(918,21,0); PRIMITIVE(919,21,1);{:1027}{1037:}PRIMITIVE(933,22,0); PRIMITIVE(934,22,1);PRIMITIVE(935,22,2);PRIMITIVE(936,22,3); PRIMITIVE(937,22,4);{:1037}{1052:}PRIMITIVE(954,68,1); PRIMITIVE(955,68,0);PRIMITIVE(956,68,2);PRIMITIVE(957,66,6); PRIMITIVE(958,66,16);PRIMITIVE(959,67,0);PRIMITIVE(960,67,1);{:1052} {1079:}PRIMITIVE(990,25,0);PRIMITIVE(991,25,1);PRIMITIVE(992,25,2); {:1079}{1101:}PRIMITIVE(1002,20,0);PRIMITIVE(1003,20,1); PRIMITIVE(1004,20,2);PRIMITIVE(1005,20,3);PRIMITIVE(1006,20,4);{:1101} {1108:}PRIMITIVE(1024,76,0);PRIMITIVE(1025,76,1);PRIMITIVE(1026,76,5); PRIMITIVE(1027,76,2);PRIMITIVE(1028,76,6);PRIMITIVE(1029,76,3); PRIMITIVE(1030,76,7);PRIMITIVE(1031,76,11);PRIMITIVE(1032,76,128); {:1108}{1176:}PRIMITIVE(1056,29,4);PRIMITIVE(1057,29,16);{:1176};END; PROCEDURE INITTAB;VAR K:INTEGER;BEGIN{176:}ROVER:=23; MEM[ROVER].HH.RH:=65535;MEM[ROVER].HH.LH:=1000; MEM[ROVER+1].HH.LH:=ROVER;MEM[ROVER+1].HH.RH:=ROVER; LOMEMMAX:=ROVER+1000;MEM[LOMEMMAX].HH.RH:=0;MEM[LOMEMMAX].HH.LH:=0; FOR K:=65532 TO 65534 DO MEM[K]:=MEM[LOMEMMAX];AVAIL:=0;MEMEND:=65534; HIMEMMIN:=65532;VARUSED:=23;DYNUSED:=-1;{:176}{193:}INTNAME[1]:=410; INTNAME[2]:=411;INTNAME[3]:=412;INTNAME[4]:=413;INTNAME[5]:=414; INTNAME[6]:=415;INTNAME[7]:=416;INTNAME[8]:=417;INTNAME[9]:=418; INTNAME[10]:=419;INTNAME[11]:=420;INTNAME[12]:=421;INTNAME[13]:=422; INTNAME[14]:=423;INTNAME[15]:=424;INTNAME[16]:=425;INTNAME[17]:=426; INTNAME[18]:=427;INTNAME[19]:=428;INTNAME[20]:=429;INTNAME[21]:=430; INTNAME[22]:=431;INTNAME[23]:=432;INTNAME[24]:=433;INTNAME[25]:=434; INTNAME[26]:=435;INTNAME[27]:=436;INTNAME[28]:=437;INTNAME[29]:=438; INTNAME[30]:=439;INTNAME[31]:=440;INTNAME[32]:=441;INTNAME[33]:=442; INTNAME[34]:=443;INTNAME[35]:=444;INTNAME[36]:=445;INTNAME[37]:=446; INTNAME[38]:=447;INTNAME[39]:=448;INTNAME[40]:=449;INTNAME[41]:=450; {:193}{203:}HASHUSED:=2357;STCOUNT:=0;HASH[2368].RH:=451; HASH[2366].RH:=452;HASH[2367].RH:=453;HASH[2365].RH:=454; HASH[2364].RH:=455;HASH[2363].RH:=59;HASH[2362].RH:=58; HASH[2361].RH:=47;HASH[2360].RH:=91;HASH[2359].RH:=41; HASH[2357].RH:=456;EQTB[2359].LH:=62;{:203}{229:}MEM[19].HH.LH:=2370; MEM[19].HH.RH:=0;{:229}{324:}MEM[65534].HH.LH:=65535;{:324}{475:} MEM[3].HH.LH:=0;MEM[3].HH.RH:=0;MEM[4].HH.LH:=1;MEM[4].HH.RH:=0; FOR K:=5 TO 11 DO MEM[K]:=MEM[4];MEM[12].INT:=0;MEM[0].HH.RH:=0; MEM[0].HH.LH:=0;MEM[1].INT:=0;MEM[2].INT:=0;{:475}{587:}SERIALNO:=0; MEM[13].HH.RH:=13;MEM[14].HH.LH:=13;MEM[13].HH.LH:=0;MEM[14].HH.RH:=0; {:587}{702:}MEM[21].HH.B1:=0;MEM[21].HH.RH:=2368;EQTB[2368].RH:=21; EQTB[2368].LH:=41;{:702}{759:}EQTB[2358].LH:=91;HASH[2358].RH:=733; {:759}{911:}MEM[17].HH.B1:=11;{:911}{1116:}MEM[20].INT:=1073741824; {:1116}{1127:}MEM[16].INT:=0;MEM[15].HH.LH:=0;{:1127}{1185:} BASEIDENT:=1065;{:1185}END;{:1210}{1212:}{PROCEDURE DEBUGHELP; LABEL 888,10;VAR K,L,M,N:INTEGER;BEGIN WHILE TRUE DO BEGIN WAKEUPTERMIN; PRINTNL(1081);IF ODD(SELECTOR)THEN WRITELN(TERMOUT);READ(TERMIN,M); IF M<0 THEN GOTO 10 ELSE IF M=0 THEN BEGIN GOTO 888; 888:M:=0; ['BREAKPOINT'] END ELSE BEGIN READ(TERMIN,N);CASE M OF[1213:]1:PRINTWORD(MEM[N]); 2:PRINTINT(MEM[N].HH.LH);3:PRINTINT(MEM[N].HH.RH); 4:BEGIN PRINTINT(EQTB[N].LH);PRINTCHAR(58);PRINTINT(EQTB[N].RH);END; 5:PRINTVARIABL(N);6:PRINTINT(INTERNAL[N]);7:DOSHOWDEPEND; 9:SHOWTOKENLIS(N,0,100000,0);10:PRINT(N);11:CHECKMEM(N>0); 12:SEARCHMEM(N);13:BEGIN READ(TERMIN,L);PRINTCMDMOD(N,L);END; 14:FOR K:=0 TO N DO PRINT(BUFFER[K]);15:PANICKING:=NOT PANICKING; [:1213]OTHERWISE PRINT(63)END;END;END;10:END;}{:1212}{1215:} PROCEDURE lib$set_symbol ( %immed SYMBOL:DESCRPTR; %immed VALUESTRING:DESCRPTR;TBLIND:INTEGER);EXTERNAL; PROCEDURE SYMBOLJOBNAM; VAR LJOBNAME:PACKED ARRAY[1..FILENAMESIZE]OF CHAR;LLENNAME:FILESIZE; LJOBSIZE:PACKED ARRAY[1..FILENAMESIZE]OF CHAR;LLENSIZE:FILESIZE; TMPDESCR:DESCRPTR;TMPSTR:STRNUMBER; BEGIN IF ODD( cli$present('JOBNAME_SYMBOL'))AND ODD( cli$present( 'JOBSIZE_SYMBOL'))THEN BEGIN TMPDESCR:=NIL; cli$get_value('JOBNAME_SYMBOL',LJOBNAME,LLENNAME); cli$get_value('JOBSIZE_SYMBOL',LJOBSIZE,LLENSIZE); STRTODESCR(JOBNAME,TMPDESCR); lib$set_symbol ( %stdescr LJOBNAME,TMPDESCR,2);OLDSETTING:=SELECTOR; SELECTOR:=5;PRINTINT(MAKESCALED(INTERNAL[27],59429463)); TMPSTR:=MAKESTRING;SELECTOR:=OLDSETTING;STRTODESCR(JOBNAME,TMPDESCR); lib$set_symbol ( %stdescr LJOBSIZE,TMPDESCR,2);END;END;{:1215}{1233:} PROCEDURE GETCOMMANDLI;VAR USERSCOMMAND:PACKED ARRAY[1..300]OF CHAR; LEN:SIXTEENBITS;I:INTEGER;J:0..BUFSIZE; BEGIN CMDLINEPRESE:=ODD( cli$present('COMMAND_LINE')); EDITQUAL:=ODD( cli$present('EDITOR')); IF EDITQUAL THEN cli$get_value('EDITOR',EDITNAME,EDITLEN); CONTINUEQUAL:=ODD( cli$present('CONTINUE')); BATCHQUAL:=ODD( cli$present('BATCH')); GFQUAL:=ODD( cli$present('OUTPUT')); IF GFQUAL THEN cli$get_value('OUTPUT',GFFNAME,GFFLEN); LOGQUAL:=ODD( cli$present('LOG_FILE')); IF LOGQUAL THEN cli$get_value('LOG_FILE',LOGFNAME,LOGFLEN); DIAGQUAL:=ODD( cli$present('DIAGNOSTICS')); IF DIAGQUAL THEN cli$get_value('DIAGNOSTICS',DIAGFNAME,DIAGFLEN); BASEQUAL:=ODD( cli$present('BASE')); IF BASEQUAL THEN BEGIN cli$get_value('BASE',USERSCOMMAND,LEN); CURINPUT.LOCFIELD:=0;BUFFER[0]:=XORD['&'];J:=1; FOR I:=1 TO LEN DO BEGIN BUFFER[J]:=XORD[USERSCOMMAND[I]];J:=J+1 END; BUFFER[J]:=XORD[' '];IF BASEIDENT<>0 THEN INITIALIZE; IF NOT OPENBASEFILE THEN GOTO 9999; IF NOT LOADBASEFILE THEN BEGIN WCLOSE(BASEFILE);GOTO 9999;END; WCLOSE(BASEFILE);END;END;{:1233}{1263:}FUNCTION EDITFILE; VAR EQUIVALENCE:PACKED ARRAY[1..FILENAMESIZE]OF CHAR; EQUVLEN:SIGNEDHALFWO;OLDSETTING:INTEGER;EDITSTATUS:EDITRESULT; EDITCTR:INTEGER;EDITFOUND:INTEGER;{1269:} NEWSELECTOR,FILECTR,KKK:INTEGER;CMDFILE:STRNUMBER;{:1269}{1272:} TECOCMD:[ volatile ]VARYING[FILENAMESIZE]OF CHAR; ITEMLIST:[ volatile ]ARRAY[0..1]OF VMSITEMLIST;{:1272}{1275:} NEXTCH:POOLPOINTER;HADSEMICOLON:BOOLEAN;{:1275} BEGIN OLDSETTING:=SELECTOR;SELECTOR:=2;EDITFILE:=FALSE; EDITSTATUS:=FAILED;EQUIVALENCE:=EDITNAME;EQUVLEN:=EDITLEN; IF EDITQUAL THEN IF EQUIVALENCE[EQUVLEN]=':'THEN BEGIN EQUIVALENCE[ EQUVLEN]:=' ';EQUVLEN:=EQUVLEN-1; EDITQUAL:=TRANSLATE(EQUIVALENCE,EQUVLEN);END;IF EDITQUAL THEN{1264:} BEGIN PRINTNL(1100);{1265:} FOR EDITCTR:=1 TO EQUVLEN DO IF EQUIVALENCE[EDITCTR]IN['a'..'z']THEN EQUIVALENCE[EDITCTR]:=XCHR[XORD[EQUIVALENCE[EDITCTR]]-32]{:1265};{1266:} EDITCTR:=1;EDITFOUND:=0; WHILE(EDITCTR<=4)AND(EDITFOUND=0)DO BEGIN IF index (EDITOR[EDITCTR]. LOGICAL,EQUIVALENCE)=1 THEN EDITFOUND:=EDITCTR;EDITCTR:=EDITCTR+1 END; {:1266};IF EDITFOUND<>0 THEN{1267:} WITH EDITOR[EDITFOUND]DO BEGIN REWRITE(TEMPFILE);COPYERR:=SAVEIT; PRINTNL(CMDTEXT); IF STARTQUAL THEN WITH STACKITEM DO EDITLOCATE(LINE,LOCFIELD-STARTFIELD +1);IF EDITFOUND=3 THEN{1268:}BEGIN NEWSELECTOR:=6; NAMEOFFILE:='MF_EDTINI';DEFAULTNAME:='.EDT'; IF AOPENOUT(AUXFILE)THEN BEGIN CMDFILE:=MAKENAMESTRI; EQUIVALENCE:='EDTINI';EQUVLEN:=6; IF NOT TRANSLATE(EQUIVALENCE,EQUVLEN)THEN EQUVLEN:=6;COPYERR:=IGNOREIT; SELECTOR:=NEWSELECTOR;PRINT(1101);PRINTLN;PRINT(1102);PRINTINT(LINE); PRINTCHAR(59);WITH STACKITEM DO PRINTINT(LOCFIELD-STARTFIELD); PRINT(1103);PRINTLN;PRINT(1104);PRINTLN;PRINT(1105); FOR KKK:=1 TO EQUVLEN DO PRINTCHAR(XORD[EQUIVALENCE[KKK]]); ACLOSE(AUXFILE);COPYERR:=SAVEIT;SELECTOR:=2;PRINT(1106);PRINT(CMDFILE); PRINTCHAR(32);END END{:1268};IF EDITFOUND=4 THEN{1270:} BEGIN NEWSELECTOR:=6;NAMEOFFILE:='MF_TECOINI';DEFAULTNAME:='.TEC'; IF AOPENOUT(AUXFILE)THEN BEGIN CMDFILE:=MAKENAMESTRI; EQUIVALENCE:='TEC_INIT';EQUVLEN:=8;COPYERR:=IGNOREIT; SELECTOR:=NEWSELECTOR; IF TRANSLATE(EQUIVALENCE,EQUVLEN)THEN BEGIN IF EQUIVALENCE[1]='_'THEN BEGIN PRINT(1107); FOR KKK:=2 TO EQUVLEN DO PRINTCHAR(XORD[EQUIVALENCE[KKK]]); END ELSE FOR KKK:=1 TO EQUVLEN DO PRINTCHAR(XORD[EQUIVALENCE[KKK]]); PRINTCHAR(27);PRINTLN;END;PRINT(1108);PRINTINT(LINE);PRINT(1109); WITH STACKITEM DO PRINTINT(LOCFIELD-STARTFIELD);PRINT(1110); PRINTCHAR(27);PRINTCHAR(27);PRINTLN;ACLOSE(AUXFILE);COPYERR:=SAVEIT; SELECTOR:=2;PRINT(1106);PRINT(CMDFILE);PRINTCHAR(32);{1271:} BEGIN TECOCMD:='$';KKK:=STRSTART[CMDFILE]; WHILE KKK0 THEN BEGIN WITH ITEMLIST[0] DO BEGIN BUFFERLENGTH:=EQUVLEN;ITEMCODE:= lnm$_string ; BUFFERADDR:= iaddress(EQUIVALENCE);RETLENADDR:=0;END; ITEMLIST[1].NEXTITEM:=0; $crelnm(,'LNM$PROCESS_TABLE','TEC_INIT',,ITEMLIST); END ELSE $dellnm('LNM$PROCESS_TABLE','TEC_INIT');END; delete_file(LASTNAME)END{:1273} END ELSE EDITSTATUS:=EDIT(0,0,EDITOR[EDITFOUND]);END{:1267}ELSE{1276:} BEGIN REWRITE(TEMPFILE);COPYERR:=SAVEIT;PRINTLN; FOR KKK:=1 TO EQUVLEN DO PRINT(XORD[EQUIVALENCE[KKK]]);PRINT(32); PRINT(STACKITEM.NAMEFIELD);PRINT(32);PRINTINT(LINE);PRINT(32); WITH STACKITEM DO PRINTINT(LOCFIELD-STARTFIELD+1); EDITSTATUS:=EDIT(0,0,EMPTYEDITOR);END{:1276};COPYERR:=IGNOREIT; SELECTOR:=OLDSETTING;END{:1264}; IF EDITSTATUS<>FAILED THEN BEGIN EDITFILE:=TRUE; IF EDITSTATUS=EDITED THEN{1274:}BEGIN HADSEMICOLON:=FALSE; FOR NEXTCH:=STRSTART[STACKITEM.NAMEFIELD]TO STRSTART[STACKITEM.NAMEFIELD +1]-1 DO BEGIN IF STRPOOL[NEXTCH]=59 THEN HADSEMICOLON:=TRUE; IF HADSEMICOLON THEN STRPOOL[NEXTCH]:=32 END;END{:1274}END; SELECTOR:=OLDSETTING;END;{:1263}{:1202}{1204:}BEGIN HISTORY:=3; BEGIN open(TERMOUT, 'SYS$OUTPUT' , carriage_control := none ); LINELIMIT(TERMOUT,MAXINT);REWRITE(TERMOUT);OUTFAB:= PAS$FAB(TERMOUT); OUTRAB:= PAS$RAB(TERMOUT);END;INITFLAG:=ODD( cli$present('INIT'));{14:} BAD:=0;IF(HALFERRORLIN<30)OR(HALFERRORLIN>ERRORLINE-15)THEN BAD:=1; IF MAXPRINTLINE<60 THEN BAD:=2;IF GFBUFSIZE MOD 8<>0 THEN BAD:=3; IF 1100>65534 THEN BAD:=4;IF 1777>2100 THEN BAD:=5; IF HEADERSIZE MOD 4<>0 THEN BAD:=6; IF(LIGTABLESIZE<255)OR(LIGTABLESIZE>32510)THEN BAD:=7;{:14}{154:} IF INITFLAG THEN BEGIN IF MEMMAX<>65534 THEN BAD:=10;END; IF MEMMAX<65534 THEN BAD:=10;IF(0>0)OR(255<127)THEN BAD:=11; IF(0>0)OR(65535<32767)THEN BAD:=12;IF(0<0)OR(255>65535)THEN BAD:=13; IF(0<0)OR(MEMMAX>=65535)THEN BAD:=14;IF MAXSTRINGS>65535 THEN BAD:=15; IF BUFSIZE>65535 THEN BAD:=16;IF(255<255)OR(65535<65535)THEN BAD:=17; {:154}{204:}IF 2369+MAXINTERNAL>65535 THEN BAD:=21;{:204}{214:} IF 2820>65535 THEN BAD:=22;{:214}{310:} IF 15*11>BISTACKSIZE THEN BAD:=31;{:310}{553:} IF 20+17*45>BISTACKSIZE THEN BAD:=32;{:553}{1154:} IF GFBUFSIZE<>2*VAXBLOCKLENG THEN BAD:=223;{:1154} IF BAD>0 THEN BEGIN WRITELN(TERMOUT, 'Ouch---my internal constants have been clobbered!','---case ',BAD:1,CHR (13),CHR(10));GOTO 9999;END;INITIALIZE; IF INITFLAG THEN BEGIN IF NOT GETSTRINGSST THEN GOTO 9999;INITTAB; INITPRIM;INITSTRPTR:=STRPTR;INITPOOLPTR:=POOLPTR;MAXSTRPTR:=STRPTR; MAXPOOLPTR:=POOLPTR;FIXDATEANDTI;END;READYALREADY:=314159;1:{1231:} DIAGNAME:=0;GETCOMMANDLI;IF BATCHQUAL THEN INTERACTION:=0; COPYERR:=IGNOREIT{:1231};{55:}SELECTOR:=1;TALLY:=0;TERMOFFSET:=0; FILEOFFSET:=0;{:55}{61:} WRITE(TERMOUT,'This is METAFONT, Version 2.7 [PD VMS 2.7/DECUS]'); IF BASEIDENT=0 THEN WRITELN(TERMOUT,' (no base preloaded)',CHR(13),CHR( 10))ELSE BEGIN PRINT(BASEIDENT);PRINTLN;END; IF ODD(SELECTOR)THEN WRITELN(TERMOUT);{:61}{564:} OPENDISPLAY(SCREENWIDTH,SCREENDEPTH);{:564}{783:}JOBNAME:=0; LOGOPENED:=FALSE;{:783}{792:}OUTPUTFILENA:=0;{:792};{1211:}BEGIN{657:} BEGIN INPUTPTR:=0;MAXINSTACK:=0;INOPEN:=0;OPENPARENS:=0;MAXBUFSTACK:=0; PARAMPTR:=0;MAXPARAMSTAC:=0;FIRST:=1;CURINPUT.STARTFIELD:=1; CURINPUT.INDEXFIELD:=0;LINE:=0;CURINPUT.NAMEFIELD:=0;FORCEEOF:=FALSE; IF NOT INITTERMINAL THEN GOTO 9999;CURINPUT.LIMITFIELD:=LAST; FIRST:=LAST+1;END;{:657}{660:}SCANNERSTATU:=0;{:660}; IF(BASEIDENT=0)OR(BUFFER[CURINPUT.LOCFIELD]=38)THEN BEGIN IF BASEIDENT<> 0 THEN INITIALIZE;IF NOT OPENBASEFILE THEN GOTO 9999; IF NOT LOADBASEFILE THEN BEGIN WCLOSE(BASEFILE);GOTO 9999;END; WCLOSE(BASEFILE); WHILE(CURINPUT.LOCFIELDMAXPOOLPTR THEN BEGIN IF POOLPTR+INPLEN>POOLSIZE THEN OVERFLOW(257,POOLSIZE-INITPOOLPTR);MAXPOOLPTR:=POOLPTR+INPLEN;END; END;FOR I:=1 TO INPLEN DO BEGIN STRPOOL[POOLPTR]:=XORD[INPNAME[I]]; POOLPTR:=POOLPTR+1;END;MFAREA:=MAKESTRING{:769}; IF CURINPUT.LOCFIELD92 THEN STARTINPUT;END{:1211};HISTORY:=0; IF STARTSYM>0 THEN BEGIN CURSYM:=STARTSYM;BACKINPUT;END;MAINCONTROL; FINALCLEANUP;9998:CLOSEFILESAN;9999:READYALREADY:=0; IF LOGOPENED THEN BEGIN IF LOGQUAL THEN WRITELN(LOGFILE); ACLOSE(LOGFILE);SELECTOR:=SELECTOR-2; IF SELECTOR=1 THEN BEGIN IF LOGQUAL THEN BEGIN PRINTNL(1072); PRINT(LOGNAME);PRINTCHAR(46);END ELSE PRINTNL(1073);END;END;{1214:} IF GFPREVPTR>0 THEN SYMBOLJOBNAM; CASE HISTORY OF 0:$exit( sts$k_success ); 1:$exit( sts$k_warning+sts$m_inhib_msg ); 2:$exit( sts$k_error+sts$m_inhib_msg ); 3:$exit( sts$k_severe+sts$m_inhib_msg )END{:1214};END.{:1204}