| program MF(input, output); {6:} |
| |
| {------------------------------} |
| { declarations are in mf2ps1.h } |
| {------------------------------} |
| label |
| 1, 9998, 9999; |
| {:6} {11:} |
| const |
| memmax = 30000; |
| maxinternal = 100; |
| bufsize = 500; |
| errorline = 79; |
| halferrorline = 50; |
| maxprintline = 79; |
| screenwidth = 1024; |
| screendepth = 1024; |
| stacksize = 30; |
| maxstrings = 2000; |
| stringvacancies = 8000; |
| poolsize = 32000; |
| movesize = 5000; |
| maxwiggle = 300; |
| gfbufsize = 800; |
| filenamesize = 256; |
| poolname = 'mf.pool'; |
| pathsize = 300; |
| bistacksize = 785; |
| headersize = 100; |
| ligtablesize = 300; |
| maxfontdimen = 50; {:11} {18:} |
| type |
| ASCIIcode = 0..127; {:18} |
| {24:} |
| eightbits = 0..255; |
| alphafile = text; |
| {------------------} |
| postscript = text; |
| {------------------} |
| UNIXfilename = packed array [1..filenamesize] of char; |
| bytefile = |
| record |
| stdioptr: ^ integer; |
| locptr: ^ integer; |
| filename: UNIXfilename |
| end; {:24} {37:} |
| poolpointer = 0..poolsize; |
| strnumber = 0..maxstrings; {:37} |
| {101:} |
| scaled = integer; |
| smallnumber = 0..63; {:101} {105:} |
| fraction = integer; |
| {:105} |
| {106:} |
| angle = integer; {:106} {156:} |
| quarterword = -128..127; |
| halfword = -32768..32767; |
| 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; |
| wordfile = file of memoryword; {:156} {186:} |
| commandcode = 1..82; {:186} {565:} |
| screenrow = 0..screendepth; |
| screencol = 0..screenwidth; |
| transspec = array [screencol] of screencol; |
| pixelcolor = 0..1; {:565} {571:} |
| windownumber = 0..15; {:571} {627:} |
| instaterecord = |
| record |
| indexfield: quarterword; |
| startfield, locfield, limitfield, namefield: halfword |
| end; {:627} {1151:} |
| gfindex = 0..gfbufsize; |
| gfbuftype = array [gfindex] of eightbits; {:1151} {13:} |
| var |
| bad: integer; {:13} {20:} |
| xord: array [char] of ASCIIcode; |
| xchr: array [ASCIIcode] of char; {:20} {25:} |
| nameoffile, realnameoffile: UNIXfilename; |
| namelength: 0..filenamesize; {:25} |
| {29:} |
| buffer: array [0..bufsize] of ASCIIcode; |
| first: 0..bufsize; |
| last: 0..bufsize; |
| maxbufstack: 0..bufsize; {:29} {38:} |
| strpool: packed array [poolpointer] of ASCIIcode; |
| 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; |
| {-------------------------------------------------------------} |
| psfile :postscript; { the PostScript code } |
| g :postscript; { holds the character information after re-arrange} |
| lastx0 , lasty0 :real ; { last point in sunpath } |
| lastx3 , lasty3 :real ; { make optimization on commands } |
| prevtox3 , prevtoy3 :real; |
| lastyearval , { mark entering to macros } |
| lastmonthval :integer; { STROKE , FILL , and ERASE } |
| { in MY plain.mf } |
| my_xx , my_yy :integer; { hold the values of xx & yy } |
| LineSource : integer; { Identifier for sendline source } |
| CurveSource : integer; { Identifier for makemoves source } |
| foundnew : boolean; { true while xchr[s]='[' until ']' } |
| ascval : integer; { holds the ascii of curr. letter } |
| ascii_on : boolean; { reading ascval is 'on' } |
| {-------------------------------------------------------------} |
| selector: 0..5; |
| 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:} |
| deletionsallowed: 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: integer; |
| OKtointerrupt: boolean; |
| {:91} |
| {97:} |
| aritherror: 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} {158:} |
| tempptr: halfword; {:158} {159:} |
| mem: array [-30000..memmax] of memoryword; |
| lomemmax: halfword; |
| himemmin: halfword; {:159} {160:} |
| varused, dynused: integer; |
| {:160} |
| {161:} |
| avail: halfword; |
| memend: halfword; {:161} {166:} |
| rover: halfword; |
| {:166} |
| {178:} |
| freearr: packed array [-30000..memmax] of boolean; |
| wasfree: packed array [-30000..memmax] of boolean; |
| wasmemend, waslomax, washimin: halfword; |
| panicking: boolean; {:178} {190:} |
| internal: array [1..maxinternal] of scaled; |
| intname: array [1..maxinternal] of strnumber; |
| intptr: 40..maxinternal; {:190} |
| {196:} |
| oldsetting: 0..5; {:196} {198:} |
| charclass: array [ASCIIcode] of 0..20; |
| {:198} |
| {200:} |
| hashused: halfword; |
| stcount: integer; {:200} {201:} |
| hash: array [1..2241] of twohalves; |
| eqtb: array [1..2241] 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; |
| turningnumber: integer; |
| curpen: halfword; |
| curpathtype: 0..2; |
| maxallowed: scaled; {:403} {427:} |
| before, after: array [0..maxwiggle] of scaled; |
| nodetoround: array [0..maxwiggle] of halfword; |
| curroundingptr: 0..maxwiggle; |
| maxroundingptr: 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} {566:} |
| {screenpixel:array[screenrow,screencol]of pixelcolor;} |
| {:566} |
| {569:} |
| screenstarted: 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:} |
| rowtransition: 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 instaterecord; |
| inputptr: 0..stacksize; |
| maxinstack: 0..stacksize; |
| curinput: instaterecord; {:628} {631:} |
| inopen: 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; |
| maxparamstack: integer; {:633} {634:} |
| fileptr: 0..stacksize; {:634} {659:} |
| scannerstatus: 0..6; |
| warninginfo: integer; {:659} {680:} |
| forceeof: boolean; |
| {:680} |
| {699:} |
| bgloc, egloc: 1..2241; {: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:} |
| areadelimiter: poolpointer; |
| extdelimiter: poolpointer; {:768} {775:} |
| MFbasedefault: packed array [1..10] of char; {:775} {782:} |
| jobname: strnumber; |
| logname: strnumber; {:782} {785:} |
| gfext: strnumber; {:785} {791:} |
| gffile: bytefile; |
| outputfilename: 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..82; {:821} {954:} |
| txx, txy, tyx, tyy, tx, ty: scaled; {:954} {1077:} |
| startsym: halfword; {:1077} |
| {1084:} |
| longhelpseen: boolean; {:1084} {1087:} |
| tfmfile: bytefile; |
| metricfilename: 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; |
| charremainder: array [eightbits] of eightbits; |
| headerbyte: array [1..headersize] of -1..255; |
| ligkern: array [0..ligtablesize] of fourquarters; |
| nl: 0..ligtablesize; |
| kern: array [eightbits] of scaled; |
| nk: 0..256; |
| exten: array [eightbits] of fourquarters; |
| ne: 0..256; |
| param: array [1..maxfontdimen] of scaled; |
| np: 0..maxfontdimen; |
| nw, nh, nd, ni: 0..256; {:1096} {1119:} |
| perturbation: scaled; {: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:} |
| gfbuf: gfbuftype; |
| 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; {:1203} |
| {1214:} |
| editnamestart: poolpointer; |
| editnamelength, editline: integer; {:1214} |
| |
| procedure unskew(x, y: scaled; octant: smallnumber);external; |
| |
| procedure sendcurve(x0,x1,x2,x3,y0,y1,y2,y3,octant:integer);external; |
| |
| procedure sendline(x0,y0,x1,y1,octant,LineSource:integer);external; |
| |
| procedure confusion(s: strnumber);external; |
| |
| function abvscd(a, b, c, d: integer): integer;external; |
| |
| procedure makemoves(xx0, xx1, xx2, xx3, yy0, yy1, yy2, yy3: scaled; xicorr, etacorr: smallnumber;CurveSource:integer;oc:smallnumber);external; |
| |
| procedure print_start(var f:postscript);external; |
| |
| procedure print_end(var f:postscript);external; |
| |
| procedure init_ps(var f:postscript);external; |
| |
| procedure tini_ps(var f:postscript);external; |
| |
| procedure auxslowprint(s: integer);external; |
| |
| procedure auxprintnl(s: strnumber);external; |
| |
| procedure sendascii(asc: integer);external; |
| |
| {------------------------------} |
| { $Header$ } |
| |
| { declarations for external C assist routines for MetaFont } |
| |
| procedure exit(x : integer); |
| external; |
| |
| procedure closea(var f:text); |
| external; |
| |
| procedure closew(var f:wordfile); |
| external; |
| |
| procedure dateandtime(var minutes, day, month, year : integer); |
| external; |
| |
| procedure setpaths; |
| external; |
| |
| function testaccess(var nameoffile, realnameoffile: UNIXfilename; |
| accessmode:integer; filepath:integer): boolean; |
| external; |
| |
| procedure calledit(var filename: ASCIIcode; fnlength, linenumber: integer); |
| external; |
| |
| function bopenout(var f: bytefile; var name: UNIXfilename): boolean; |
| external; |
| |
| procedure bclose(var f: bytefile); |
| external; |
| |
| procedure bgetname(var f: bytefile; var name: UNIXfilename); |
| external; |
| |
| procedure bwritebuf(var f: bytefile; var buf: gfbuftype; |
| first, last: integer); |
| external; |
| |
| procedure bwritebyte(var f: bytefile; b: integer); |
| external; |
| |
| procedure bwrite2bytes(var f: bytefile; b: integer); |
| external; |
| |
| procedure bwrite4bytes(var f: bytefile; b: integer); |
| external; |
| |
| function makefraction(p, q: integer): fraction; |
| external; |
| |
| function takefraction(q: integer; f: fraction): integer; |
| external; |
| |
| { $Header$ } |
| |
| { External procedures for UNIX MetaFont VIRMF for display graphics } |
| |
| function initscreen: boolean; |
| external; |
| |
| procedure updatescreen; |
| external; |
| |
| procedure blankrectangle(leftcol, rightcol: screencol; toprow, botrow: screenrow); |
| external; |
| |
| procedure paintrow(r: screenrow; b: pixelcolor; var a: transspec; n: screencol); |
| external; |
| |
| |
| procedure initialize; {19:} |
| var |
| i: 0..127; {:19} {130:} |
| k: integer; {:130} {21:} |
| begin |
| xchr[32] := ' '; |
| xchr[33] := '!'; |
| xchr[34] := '"'; |
| xchr[35] := '#'; |
| xchr[36] := '$'; |
| xchr[37] := '%'; |
| xchr[38] := '&'; |
| xchr[39] := ''''; |
| xchr[40] := '('; |
| xchr[41] := ')'; |
| xchr[42] := '*'; |
| xchr[43] := '+'; |
| xchr[44] := ','; |
| xchr[45] := '-'; |
| xchr[46] := '.'; |
| xchr[47] := '/'; |
| xchr[48] := '0'; |
| xchr[49] := '1'; |
| xchr[50] := '2'; |
| xchr[51] := '3'; |
| xchr[52] := '4'; |
| xchr[53] := '5'; |
| xchr[54] := '6'; |
| xchr[55] := '7'; |
| xchr[56] := '8'; |
| xchr[57] := '9'; |
| xchr[58] := ':'; |
| xchr[59] := ';'; |
| xchr[60] := '<'; |
| xchr[61] := '='; |
| xchr[62] := '>'; |
| xchr[63] := '?'; |
| xchr[64] := '@'; |
| xchr[65] := 'A'; |
| xchr[66] := 'B'; |
| xchr[67] := 'C'; |
| xchr[68] := 'D'; |
| xchr[69] := 'E'; |
| xchr[70] := 'F'; |
| xchr[71] := 'G'; |
| xchr[72] := 'H'; |
| xchr[73] := 'I'; |
| xchr[74] := 'J'; |
| xchr[75] := 'K'; |
| xchr[76] := 'L'; |
| xchr[77] := 'M'; |
| xchr[78] := 'N'; |
| xchr[79] := 'O'; |
| xchr[80] := 'P'; |
| xchr[81] := 'Q'; |
| xchr[82] := 'R'; |
| xchr[83] := 'S'; |
| xchr[84] := 'T'; |
| xchr[85] := 'U'; |
| xchr[86] := 'V'; |
| xchr[87] := 'W'; |
| xchr[88] := 'X'; |
| xchr[89] := 'Y'; |
| xchr[90] := 'Z'; |
| xchr[91] := '['; |
| xchr[92] := '\'; |
| xchr[93] := ']'; |
| xchr[94] := '^'; |
| xchr[95] := '_'; |
| xchr[96] := '`'; |
| xchr[97] := 'a'; |
| xchr[98] := 'b'; |
| xchr[99] := 'c'; |
| xchr[100] := 'd'; |
| xchr[101] := 'e'; |
| xchr[102] := 'f'; |
| xchr[103] := 'g'; |
| xchr[104] := 'h'; |
| xchr[105] := 'i'; |
| xchr[106] := 'j'; |
| xchr[107] := 'k'; |
| xchr[108] := 'l'; |
| xchr[109] := 'm'; |
| xchr[110] := 'n'; |
| xchr[111] := 'o'; |
| xchr[112] := 'p'; |
| xchr[113] := 'q'; |
| xchr[114] := 'r'; |
| xchr[115] := 's'; |
| xchr[116] := 't'; |
| xchr[117] := 'u'; |
| xchr[118] := 'v'; |
| xchr[119] := 'w'; |
| xchr[120] := 'x'; |
| xchr[121] := 'y'; |
| xchr[122] := 'z'; |
| xchr[123] := '{'; |
| xchr[124] := '|'; |
| xchr[125] := '}'; |
| xchr[126] := '~'; |
| xchr[0] := ' '; |
| xchr[127] := ' '; {:21} {22:} |
| for i := 1 to 31 do |
| xchr[i] := ' '; |
| xchr[9] := chr(9); |
| xchr[12] := chr(12); {:22} |
| {23:} |
| for i := 0 to 127 do |
| xord[chr(i)] := 127; |
| for i := 1 to 126 do |
| xord[xchr[i]] := i; {:23} {69:} |
| interaction := 3; {:69} {72:} |
| deletionsallowed := true; |
| errorcount := 0; {:72} {75:} |
| helpptr := 0; |
| useerrhelp := false; |
| errhelp := 0; {:75} {92:} |
| interrupt := 0; |
| OKtointerrupt := true; |
| {: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:=-30000;waslomax:=-30000;washimin:=memmax;panicking:=false;} |
| {:179} |
| {191:} |
| for k := 1 to 40 do |
| internal[k] := 0; |
| intptr := 40; {: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[127] := 20; |
| charclass[9] := 2; |
| charclass[12] := 2; {:199} {202:} |
| hash[1].lh := 0; |
| hash[1].rh := 0; |
| eqtb[1].lh := 41; |
| eqtb[1].rh := -30000; |
| for k := 2 to 2241 do begin |
| hash[k] := hash[1]; |
| eqtb[k] := eqtb[1] |
| end; {:202} {231:} |
| bignodesize[13] := 12; |
| bignodesize[14] := 4; |
| {:231} |
| {251:} |
| saveptr := -30000; {:251} {396:} |
| octantdir[1] := 415; |
| octantdir[5] := 416; |
| octantdir[6] := 417; |
| octantdir[2] := 418; |
| octantdir[4] := 419; |
| octantdir[8] := 420; |
| octantdir[7] := 421; |
| octantdir[3] := 422; {:396} {428:} |
| maxroundingptr := 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:} |
| screenstarted := 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 := -30000; |
| iflimit := 0; |
| curif := 0; |
| ifline := 0; {:739} {753:} |
| loopptr := -30000; {:753} {776:} |
| MFbasedefault := 'plain.base'; {: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; |
| charremainder[k] := 0 |
| end; |
| for k := 1 to headersize do |
| headerbyte[k] := -1; |
| bc := 255; |
| ec := 0; |
| nl := 0; |
| nk := 0; |
| ne := 0; |
| np := 0; {:1097} {1150:} |
| gfprevptr := 0; |
| totalchars := 0; {:1150} {1153:} |
| halfbuf := gfbufsize div 2; |
| gflimit := gfbufsize; |
| gfptr := 0; |
| gfoffset := 0; {:1153} {1184:} |
| baseident := 0; {:1184} {1215:} |
| editnamestart := 0 |
| end; {:1215} {57:} |
| |
| procedure println; |
| begin |
| case selector of |
| 3: |
| begin |
| writeln(output); |
| writeln(logfile); |
| termoffset := 0; |
| fileoffset := 0 |
| end; |
| 2: |
| begin |
| writeln(logfile); |
| fileoffset := 0 |
| end; |
| 1: |
| begin |
| writeln(output); |
| termoffset := 0 |
| end; |
| 0, 4, 5: |
| end |
| end; {:57} {58:} |
| |
| procedure printchar(s: ASCIIcode); |
| var tmp : integer; |
| begin |
| case selector of |
| 3: |
| begin |
| {----------------------------------} |
| if xchr[s] = '[' then |
| begin |
| ascii_on := true; |
| ascval := 0; |
| end |
| else if xchr[s] = ']' then |
| begin |
| ascii_on := false; |
| sendascii(ascval); |
| end |
| else if ascii_on then |
| begin |
| tmp := s - ord('0'); |
| ascval := ascval*10+tmp; |
| end; |
| {-------------------------------------} |
| write(output, xchr[s]); |
| write(logfile, xchr[s]); |
| termoffset := termoffset + 1; |
| fileoffset := fileoffset + 1; |
| if termoffset = maxprintline then begin |
| writeln(output); |
| termoffset := 0 |
| end; |
| if fileoffset = maxprintline then begin |
| writeln(logfile); |
| fileoffset := 0 |
| end |
| end; |
| 2: |
| begin |
| write(logfile, xchr[s]); |
| fileoffset := fileoffset + 1; |
| if fileoffset = maxprintline then |
| println |
| end; |
| 1: |
| begin |
| write(output, xchr[s]); |
| termoffset := termoffset + 1; |
| if termoffset = maxprintline then |
| println |
| end; |
| 0: |
| ; |
| 4: |
| if tally < trickcount then |
| trickbuf[tally mod errorline] := s; |
| 5: |
| begin |
| if poolptr < poolsize then begin |
| strpool[poolptr] := s; |
| poolptr := poolptr + 1 |
| end |
| end |
| end; |
| tally := tally + 1 |
| end; {:58} {59:} |
| |
| procedure print(s: integer); |
| var |
| j: poolpointer; |
| begin |
| if (s < 0) or (s >= strptr) then |
| s := 131; |
| j := strstart[s]; |
| while j < strstart[s + 1] do begin |
| printchar(strpool[j]); |
| j := j + 1 |
| end |
| end; {:59} |
| {60:} |
| |
| procedure slowprint(s: integer); |
| var |
| j: poolpointer; |
| begin |
| if (s < 0) or (s >= strptr) then |
| s := 131; |
| j := strstart[s]; |
| while j < strstart[s + 1] do begin |
| print(strpool[j]); |
| j := j + 1 |
| end |
| end; {:60} |
| {62:} |
| |
| procedure printnl(s: strnumber); |
| begin |
| if ((termoffset > 0) 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 |
| if t in |
| [1, 2, 3, 4, 5, 6, 7, 8, |
| 9, 10, 11, 12, 13, 14, 16, 17, |
| 18, 15, 19, 20, 21, 22, 23] then |
| case t of |
| 1: |
| print(194); |
| 2: |
| print(195); |
| 3: |
| print(196); |
| 4: |
| print(197); |
| 5: |
| print(198); |
| 6: |
| print(199); |
| 7: |
| print(200); |
| 8: |
| print(201); |
| 9: |
| print(202); |
| 10: |
| print(203); |
| 11: |
| print(204); |
| 12: |
| print(205); |
| 13: |
| print(206); |
| 14: |
| print(207); |
| 16: |
| print(208); |
| 17: |
| print(209); |
| 18: |
| print(210); |
| 15: |
| print(211); |
| 19: |
| print(212); |
| 20: |
| print(213); |
| 21: |
| print(214); |
| 22: |
| print(215); |
| 23: |
| print(216) |
| end |
| else |
| print(217) |
| end; {:187} {195:} |
| |
| procedure begindiagnostic; |
| begin |
| oldsetting := selector; |
| if (internal[13] <= 0) and (selector = 3) then begin |
| selector := selector - 1; |
| if history = 0 then |
| history := 1 |
| end |
| end; { begindiagnostic } |
| |
| procedure enddiagnostic(blankline: boolean); |
| begin |
| printnl(155); |
| if blankline then |
| println; |
| selector := oldsetting |
| end; {:195} {197:} |
| |
| procedure printdiagnostic(s, t: strnumber; nuline: boolean); |
| begin |
| begindiagnostic; |
| if nuline then |
| printnl(s) |
| else |
| print(s); |
| print(320); |
| printint(line); |
| print(t); |
| printchar(58) |
| end; {:197} {773:} |
| |
| procedure printfilename(n, a, e: integer); |
| begin |
| print(a); |
| print(n); |
| print(e) |
| end; {:773} {73:} |
| |
| procedure normalizeselector; |
| forward; |
| |
| procedure getnext; |
| forward; |
| |
| procedure terminput; |
| forward; |
| |
| procedure showcontext; |
| forward; |
| |
| procedure beginfilereading; |
| forward; |
| |
| procedure openlogfile; |
| forward; |
| |
| procedure closefilesandtermina; |
| forward; |
| |
| procedure clearforerrorprompt; |
| forward; {procedure debughelp;forward;} {43:} |
| |
| procedure flushstring(s: strnumber); |
| begin |
| if s < (strptr - 1) then |
| strref[s] := 0 |
| else |
| repeat |
| strptr := strptr - 1 |
| until strref[strptr - 1] <> 0; |
| 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); |
| showcontext; |
| if interaction = 3 then {78:} |
| while true do begin |
| 22: |
| clearforerrorprompt; |
| begin |
| print(135); |
| terminput |
| end; |
| if last = first then |
| goto 10; |
| c := buffer[first]; |
| if c >= 97 then |
| c := c - 32; {79:} |
| if c in |
| [48, 49, 50, 51, 52, 53, 54, 55, |
| 56, 57, 69, 72, 73, 81, 82, 83, |
| 88] then |
| case c of |
| 48, 49, 50, 51, 52, 53, 54, |
| 55, 56, 57: |
| if deletionsallowed then begin {83:} |
| s1 := curcmd; |
| s2 := curmod; |
| s3 := cursym; |
| OKtointerrupt := 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; |
| OKtointerrupt := true; |
| begin |
| helpptr := 2; |
| helpline[1] := 148; |
| helpline[0] := 149 |
| end; |
| showcontext; |
| goto 22 |
| end {:83}; {68:begin debughelp;goto 22;end;} |
| 69: |
| if fileptr > 0 then begin |
| editnamestart := strstart[inputstack[fileptr].namefield]; |
| editnamelength := strstart[inputstack[fileptr].namefield + 1] - strstart[inputstack[fileptr].namefield]; |
| editline := line; |
| jumpout |
| end; |
| 72: |
| begin {84:} |
| if useerrhelp then begin {85:} |
| j := strstart[errhelp]; |
| while j < strstart[errhelp + 1] do begin |
| if strpool[j] <> 37 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] := 150; |
| helpline[0] := 151 |
| end; |
| repeat |
| helpptr := helpptr - 1; |
| print(helpline[helpptr]); |
| println |
| until helpptr = 0 |
| end; |
| begin |
| helpptr := 4; |
| helpline[3] := 152; |
| helpline[2] := 151; |
| helpline[1] := 153; |
| helpline[0] := 154 |
| end; |
| goto 22 |
| end; {:84} |
| 73: |
| begin {82:} |
| beginfilereading; |
| if last > (first + 1) then begin |
| curinput.locfield := first + 1; |
| buffer[first] := 32 |
| end else begin |
| begin |
| print(147); |
| terminput |
| end; |
| curinput.locfield := first |
| end; |
| first := last + 1; |
| curinput.limitfield := last; |
| goto 10 |
| end; {:82} |
| 81, 82, 83: |
| begin {81:} |
| errorcount := 0; |
| interaction := (0 + c) - 81; |
| print(142); |
| case c of |
| 81: |
| begin |
| print(143); |
| selector := selector - 1 |
| end; |
| 82: |
| print(144); |
| 83: |
| print(145) |
| end; |
| print(146); |
| println; |
| flush(output); |
| goto 10 |
| end; {:81} |
| 88: |
| begin |
| interaction := 2; |
| jumpout |
| end |
| end |
| else |
| ; {80:} |
| begin |
| print(136); |
| printnl(137); |
| printnl(138); |
| if fileptr > 0 then |
| print(139); |
| if deletionsallowed then |
| printnl(140); |
| printnl(141) |
| end {:80} {:79} |
| end {:78}; |
| errorcount := errorcount + 1; |
| if errorcount = 100 then begin |
| printnl(134); |
| history := 3; |
| jumpout |
| end; {86:} |
| if interaction > 0 then |
| selector := selector - 1; |
| if useerrhelp then begin |
| printnl(155); {85:} |
| j := strstart[errhelp]; |
| while j < strstart[errhelp + 1] do begin |
| if strpool[j] <> 37 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; {:86} |
| println; |
| 10: |
| |
| end; {:77} |
| {88:} |
| |
| procedure fatalerror(s: strnumber); |
| begin |
| normalizeselector; |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(156) |
| end; |
| begin |
| helpptr := 1; |
| helpline[0] := s |
| end; |
| begin |
| if interaction = 3 then |
| interaction := 2; |
| error; |
| {if interaction>0 then debughelp;} |
| history := 3; |
| jumpout |
| end |
| end; {:88} {89:} |
| |
| procedure overflow(s: strnumber; n: integer); |
| begin |
| normalizeselector; |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(157) |
| end; |
| print(s); |
| printchar(61); |
| printint(n); |
| printchar(93); |
| begin |
| helpptr := 2; |
| helpline[1] := 158; |
| helpline[0] := 159 |
| end; |
| begin |
| if interaction = 3 then |
| interaction := 2; |
| error; |
| {if interaction>0 then debughelp;} |
| history := 3; |
| jumpout |
| end |
| end; {:89} {90:} |
| |
| procedure confusion; |
| begin |
| normalizeselector; |
| if history < 2 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(160) |
| end; |
| print(s); |
| printchar(41); |
| begin |
| helpptr := 1; |
| helpline[0] := 161 |
| end |
| end else begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(162) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 163; |
| helpline[0] := 164 |
| end |
| end; |
| begin |
| if interaction = 3 then |
| interaction := 2; |
| error; |
| {if interaction>0 then debughelp;} |
| history := 3; |
| jumpout |
| end |
| end; {:90} {:4} |
| |
| |
| {26:} |
| |
| function aopenin(var f: alphafile; pathspecifier: integer): boolean; |
| var |
| ok: boolean; |
| begin |
| if testaccess(nameoffile, realnameoffile, 4, pathspecifier) then begin |
| reset(f, realnameoffile); |
| ok := true |
| end else |
| ok := false; |
| aopenin := ok |
| end; { aopenin } |
| |
| function aopenout(var f: alphafile): boolean; |
| var |
| ok: boolean; |
| begin |
| if testaccess(nameoffile, realnameoffile, 2, 0) then begin |
| rewrite(f, realnameoffile); |
| ok := true |
| end else |
| ok := false; |
| aopenout := ok |
| end; { aopenout } |
| |
| function wopenin(var f: wordfile): boolean; |
| var |
| ok: boolean; |
| begin |
| if testaccess(nameoffile, realnameoffile, 4, 7) then begin |
| reset(f, realnameoffile); |
| ok := true |
| end else |
| ok := false; |
| wopenin := ok |
| end; { wopenin } |
| |
| function wopenout(var f: wordfile): boolean; |
| var |
| ok: boolean; |
| begin |
| if testaccess(nameoffile, realnameoffile, 2, 0) then begin |
| rewrite(f, nameoffile); |
| ok := true |
| end else |
| ok := false; |
| wopenout := ok |
| end; {:26} {27:} |
| |
| procedure aclose(var f: alphafile); |
| begin |
| closea(f) |
| end; { aclose } |
| |
| procedure wclose(var f: wordfile); |
| begin |
| closew(f) |
| end; {:27} {30:} |
| |
| function inputln(var f: alphafile; bypasseoln: boolean): boolean; |
| var |
| lastnonblank: 0..bufsize; |
| begin |
| if bypasseoln then |
| if not eof(f) then |
| if eoln(f) then |
| get(f); |
| last := first; |
| if eof(f) then |
| inputln := false |
| else begin |
| lastnonblank := first; |
| while not eoln(f) do begin |
| if last >= maxbufstack then begin |
| maxbufstack := last + 1; |
| if maxbufstack = bufsize then |
| overflow(128, bufsize) |
| end; |
| buffer[last] := xord[f^]; |
| get(f); |
| last := last + 1; |
| if buffer[last - 1] <> 32 then |
| lastnonblank := last |
| end; |
| last := lastnonblank; |
| inputln := true |
| end |
| end; {:30} {36:} |
| |
| function initterminal: boolean; |
| label |
| 10; |
| var |
| dummy, i, j, k: integer; |
| arg: packed array [1..100] of char; |
| begin |
| if argc > 1 then begin |
| last := first; |
| for i := 1 to argc - 1 do begin |
| argv(i, arg); |
| j := 1; |
| k := 100; |
| while (k > 1) and (arg[k] = ' ') do |
| k := k - 1; |
| while j <= k do begin |
| buffer[last] := xord[arg[j]]; |
| j := j + 1; |
| last := last + 1 |
| end; |
| if k > 1 then begin |
| buffer[last] := xord[' ']; |
| last := last + 1 |
| end |
| end; |
| if last > first then begin |
| curinput.locfield := first; |
| initterminal := true; |
| goto 10 |
| end |
| end; |
| while true do begin |
| write(output, '**'); |
| flush(output); |
| if not inputln(input, true) then begin |
| writeln(output); |
| writeln(output, '! End of file on the terminal... why?'); |
| initterminal := false; |
| goto 10 |
| end; |
| curinput.locfield := first; |
| while (curinput.locfield < last) and (buffer[curinput.locfield] = 32) do |
| curinput.locfield := curinput.locfield + 1; |
| if curinput.locfield < last then begin |
| initterminal := true; |
| goto 10 |
| end; |
| writeln(output, 'Please type the name of your input file.') |
| end; |
| 10: |
| |
| end; { initterminal } |
| {:36} |
| {44:} |
| |
| function makestring: strnumber; |
| begin |
| if strptr = maxstrptr then begin |
| if strptr = maxstrings then |
| overflow(130, maxstrings - initstrptr); |
| maxstrptr := maxstrptr + 1 |
| end; |
| strref[strptr] := 1; |
| strptr := strptr + 1; |
| strstart[strptr] := poolptr; |
| makestring := strptr - 1 |
| end; { makestring } |
| {:44} |
| {45:} |
| |
| function streqbuf(s: strnumber; k: integer): boolean; |
| label |
| 45; |
| var |
| j: poolpointer; |
| result: boolean; |
| begin |
| j := strstart[s]; |
| while j < strstart[s + 1] do begin |
| if strpool[j] <> buffer[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 getstringsstarted:boolean;label 30,10; |
| var k,l:0..127;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 127 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 begin strpool[poolptr]:=k-64;poolptr:=poolptr+1;end; |
| end else begin strpool[poolptr]:=k;poolptr:=poolptr+1;end;g:=makestring; |
| strref[g]:=127;end[:48];[51:]nameoffile:=poolname; |
| if aopenin(poolfile,8)then begin c:=false; |
| repeat[52:]begin if eof(poolfile)then begin; |
| writeln(output,'! mf.pool has no check sum.');aclose(poolfile); |
| getstringsstarted:=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; |
| writeln(output,'! mf.pool check sum doesn''t have nine digits.'); |
| aclose(poolfile);getstringsstarted:=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<>503742536 then begin; |
| writeln(output,'! mf.pool doesn''t match; tangle me again.'); |
| aclose(poolfile);getstringsstarted:=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; |
| writeln(output,'! mf.pool line doesn''t begin with two digits.'); |
| aclose(poolfile);getstringsstarted:=false;goto 10;end; |
| l:=xord[m]*10+xord[n]-48*11; |
| if poolptr+l+stringvacancies>poolsize then begin; |
| writeln(output,'! You have to increase POOLSIZE.');aclose(poolfile); |
| getstringsstarted:=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);getstringsstarted:=true;end else begin; |
| writeln(output,'! I can''t read mf.pool.');aclose(poolfile); |
| getstringsstarted:=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 |
| flush(output); |
| if not inputln(input, true) then |
| fatalerror(132); |
| 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 normalizeselector; |
| begin |
| if jobname > 0 then |
| selector := 3 |
| else |
| selector := 1; |
| if jobname = 0 then |
| openlogfile; |
| if interaction = 0 then |
| selector := selector - 1 |
| end; {:87} {93:} |
| |
| procedure pauseforinstructions; |
| begin |
| if OKtointerrupt then begin |
| interaction := 3; |
| if (selector = 2) or (selector = 0) then |
| selector := selector + 1; |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(165) |
| end; |
| begin |
| helpptr := 3; |
| helpline[2] := 166; |
| helpline[1] := 167; |
| helpline[0] := 168 |
| end; |
| deletionsallowed := false; |
| error; |
| deletionsallowed := true; |
| interrupt := 0 |
| end |
| end; {:93} {94:} |
| |
| procedure missingerr(s: strnumber); |
| begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(169) |
| end; |
| print(s); |
| print(170) |
| end; {:94} {99:} |
| |
| procedure cleararith; |
| begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(171) |
| end; |
| begin |
| helpptr := 4; |
| helpline[3] := 172; |
| helpline[2] := 173; |
| helpline[1] := 174; |
| helpline[0] := 175 |
| 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 rounddecimals(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; |
| rounddecimals := (a + 1) div 2 |
| end; {:102} {112:} |
| |
| function takescaled(q: integer; f: scaled): integer; |
| var |
| p: integer; |
| negative: boolean; |
| n: integer; |
| becareful: integer; {110:} |
| begin |
| if f >= 0 then |
| negative := false |
| else begin |
| f := -f; |
| negative := true |
| end; |
| if q < 0 then begin |
| q := -q; |
| negative := not negative |
| end; {:110} |
| if f < 65536 then |
| n := 0 |
| else begin |
| n := f div 65536; |
| f := f mod 65536; |
| if q <= (2147483647 div n) then |
| n := n * q |
| else begin |
| aritherror := true; |
| n := 2147483647 |
| end |
| end; |
| f := f + 65536; {113:} |
| p := 32768; |
| if q < 1073741824 then |
| repeat |
| if odd(f) then |
| p := (p + q) div 2 |
| else |
| p := p div 2; |
| f := f div 2 |
| until f = 1 |
| else |
| repeat |
| if odd(f) then |
| p := p + ((q - p) div 2) |
| else |
| p := p div 2; |
| f := f div 2 |
| until f = 1 {:113}; |
| becareful := n - 2147483647; |
| if (becareful + p) > 0 then begin |
| aritherror := true; |
| n := 2147483647 - p |
| end; |
| if negative then |
| takescaled := -(n + p) |
| else |
| takescaled := n + p |
| end; {:112} {114:} |
| |
| function makescaled(p, q: integer): scaled; |
| var |
| f: integer; |
| n: integer; |
| negative: boolean; |
| becareful: integer; |
| begin |
| if p >= 0 then |
| negative := false |
| else begin |
| p := -p; |
| negative := true |
| end; |
| if q <= 0 then begin {if q=0 then confusion(47);} |
| q := -q; |
| negative := not negative |
| end; |
| n := p div q; |
| p := p mod q; |
| if n >= 32768 then begin |
| aritherror := true; |
| if negative then |
| makescaled := -2147483647 |
| else |
| makescaled := 2147483647 |
| end else begin |
| n := (n - 1) * 65536; {115:} |
| f := 1; |
| repeat |
| becareful := p - q; |
| p := becareful + p; |
| if p >= 0 then |
| f := (f + f) + 1 |
| else begin |
| f := f + f; |
| p := p + q |
| end |
| until f >= 65536; |
| becareful := p - q; |
| if (becareful + p) >= 0 then |
| f := f + 1 {:115}; |
| if negative then |
| makescaled := -(f + n) |
| else |
| makescaled := f + n |
| end |
| end; {:114} |
| {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 ; |
| label |
| 10; |
| var |
| q, r: integer; {118:} |
| begin |
| 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; { floorscaled } |
| |
| function floorunscaled(x: scaled): integer; |
| var |
| becareful: integer; |
| begin |
| if x >= 0 then |
| floorunscaled := x div 65536 |
| else begin |
| becareful := x + 1; |
| floorunscaled := -(1 + ((-becareful) div 65536)) |
| end |
| end; { floorunscaled } |
| |
| function roundunscaled(x: scaled): integer; |
| var |
| becareful: integer; |
| begin |
| if x >= 32768 then |
| roundunscaled := 1 + ((x - 32768) div 65536) |
| else if x >= (-32768) then |
| roundunscaled := 0 |
| else begin |
| becareful := x + 1; |
| roundunscaled := -(1 + (((-becareful) - 32768) div 65536)) |
| end |
| end; { roundunscaled } |
| |
| function roundfraction(x: fraction): scaled; |
| var |
| becareful: integer; |
| begin |
| if x >= 2048 then |
| roundfraction := 1 + ((x - 2048) div 4096) |
| else if x >= (-2048) then |
| roundfraction := 0 |
| else begin |
| becareful := x + 1; |
| roundfraction := -(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 begin {122:} |
| if x < 0 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(176) |
| end; |
| printscaled(x); |
| print(177); |
| begin |
| helpptr := 2; |
| helpline[1] := 178; |
| helpline[0] := 179 |
| end; |
| error |
| end; |
| squarert := 0 |
| end else begin {:122} |
| 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; {123:} |
| repeat |
| 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 a < b then begin |
| r := b; |
| b := a; |
| a := r |
| end; |
| if a > 0 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 begin {128:} |
| if a < b then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(180) |
| end; |
| printscaled(a); |
| print(181); |
| printscaled(b); |
| print(177); |
| begin |
| helpptr := 2; |
| helpline[1] := 178; |
| helpline[0] := 179 |
| end; |
| error |
| end; |
| a := 0 |
| end else begin {:128} |
| if a < 1073741824 then |
| big := false |
| else begin |
| a := a div 2; |
| b := b div 2; |
| big := true |
| end; {127:} |
| 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: {:127} |
| ; |
| if big then |
| a := a + a |
| end; |
| pythsub := a |
| end; {:126} {132:} |
| |
| function mlog(x: scaled): scaled; |
| var |
| y, z: integer; |
| k: integer; |
| begin |
| if x <= 0 then begin {134:} |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(182) |
| end; |
| printscaled(x); |
| print(177); |
| begin |
| helpptr := 2; |
| helpline[1] := 183; |
| helpline[0] := 179 |
| end; |
| error; |
| mlog := 0 |
| end else begin {:134} |
| y := 1302456860; |
| z := 6581195; |
| while x < 1073741824 do begin |
| x := x + x; |
| y := y - 93032639; |
| z := z - 48782 |
| end; |
| y := y + (z div 65536); |
| k := 2; |
| while x > 1073741828 do begin {133:} |
| 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 < y then begin |
| t := y; |
| y := x; |
| x := t; |
| octant := octant + 4 |
| end; |
| if x = 0 then begin {140:} |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(184) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 185; |
| helpline[0] := 179 |
| end; |
| error; |
| narg := 0 |
| end else begin {:140} {142:} |
| while 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) < u; |
| x := makefraction(x, u); |
| l := 139548960 - mlog(u) |
| until abvscd(1024, l, x, 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 showtokenlist(p, q: integer; l, nulltally: integer); |
| label |
| 10; |
| var |
| class, c: smallnumber; |
| r, v: integer; |
| begin |
| class := 3; |
| tally := nulltally; |
| while (p <> (-30000)) and (tally < l) do begin |
| if p = q then begin {646:} |
| firstcount := tally; |
| trickcount := ((tally + 1) + errorline) - halferrorline; |
| if trickcount < errorline then |
| trickcount := errorline |
| end {:646}; {218:} |
| c := 9; |
| if (p < (-30000)) or (p > memend) then begin |
| print(360); |
| goto 10 |
| end; |
| if p < himemmin then {219:} |
| if mem[p].hh.b1 = 12 then |
| if mem[p].hh.b0 = 16 then begin {220:} |
| if class = 0 then |
| printchar(32); |
| v := mem[p + 1].int; |
| if v < 0 then begin |
| if class = 17 then |
| printchar(32); |
| printchar(91); |
| printscaled(v); |
| printchar(93); |
| c := 18 |
| end else begin |
| printscaled(v); |
| c := 0 |
| end |
| end else if mem[p].hh.b0 <> 4 then {:220} |
| print(363) |
| 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(363) |
| else begin |
| gpointer := p; |
| printcapsule; |
| c := 8 |
| end {:219} |
| else begin |
| r := mem[p].hh.lh; |
| if r >= 2242 then begin {222:} |
| if r < 2392 then begin |
| print(365); |
| r := r - 2242 |
| end else if r < 2542 then begin |
| print(366); |
| r := r - 2392 |
| end else begin |
| print(367); |
| r := r - 2542 |
| end; |
| printint(r); |
| printchar(41); |
| c := 8 |
| end else if r < 1 then {:222} |
| if r = 0 then begin {221:} |
| if class = 17 then |
| printchar(32); |
| print(364); |
| c := 18 |
| end else {:221} |
| print(361) |
| else begin |
| r := hash[r].rh; |
| if (r < 0) or (r >= strptr) then |
| print(362) {223:} |
| else begin |
| c := charclass[strpool[strstart[r]]]; |
| if c = class then |
| if c in |
| [9, 5, 6, 7, 8] then |
| case c of |
| 9: |
| printchar(46); |
| 5, 6, 7, 8: |
| end |
| else |
| printchar(32); |
| print(r) |
| end {:223} |
| end |
| end {:218}; |
| class := c; |
| p := mem[p].hh.rh |
| end; |
| if p <> (-30000) then |
| print(359); |
| 10: |
| |
| end; {:217} {665:} |
| |
| procedure runaway; |
| begin |
| if scannerstatus > 2 then begin |
| printnl(503); |
| case scannerstatus of |
| 3: |
| print(504); |
| 4, 5: |
| print(505); |
| 6: |
| print(506) |
| end; |
| println; |
| showtokenlist(mem[29998].hh.rh, -30000, errorline - 10, 0) |
| end |
| end; { runaway } |
| {:665} |
| {:162} |
| {163:} |
| |
| function getavail: halfword; |
| var |
| p: halfword; |
| begin |
| p := avail; |
| if p <> (-30000) then |
| avail := mem[avail].hh.rh |
| else if memend < memmax then begin |
| memend := memend + 1; |
| p := memend |
| end else begin |
| himemmin := himemmin - 1; |
| p := himemmin; |
| if himemmin <= lomemmax then begin |
| runaway; |
| overflow(186, memmax + 30001) |
| end |
| end; |
| mem[p].hh.rh := -30000; |
| {dynused:=dynused+1;} |
| getavail := p |
| end; {:163} {167:} |
| |
| function getnode(s: integer): halfword; |
| label |
| 40, 10, 20; |
| var |
| p: halfword; |
| q: halfword; |
| r: integer; |
| t, tt: integer; |
| begin |
| 20: |
| p := rover; {169:} |
| repeat |
| q := p + mem[p].hh.lh; |
| while mem[q].hh.rh = 32767 do begin |
| t := mem[q + 1].hh.rh; |
| tt := mem[q + 1].hh.lh; |
| if q = rover then |
| rover := t; |
| mem[t + 1].hh.lh := tt; |
| mem[tt + 1].hh.rh := t; |
| q := q + mem[q].hh.lh |
| end; |
| r := q - s; |
| if r > (p + 1) then begin {170:} |
| mem[p].hh.lh := r - p; |
| rover := p; |
| goto 40 |
| end {:170}; |
| {171 |
| :} |
| if r = p then |
| if (mem[p + 1].hh.rh <> rover) or (mem[p + 1].hh.lh <> rover) then 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 := 32767; |
| goto 10 |
| end; |
| if (lomemmax + 2) < himemmin then |
| if (lomemmax + 2) <= 2767 then begin {168:} |
| if (lomemmax + 1000) < himemmin then |
| t := lomemmax + 1000 |
| else |
| t := ((lomemmax + himemmin) + 2) div 2; |
| if t > 2767 then |
| t := 2767; |
| 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 := 32767; |
| mem[q].hh.lh := t - lomemmax; |
| lomemmax := t; |
| mem[lomemmax].hh.rh := -30000; |
| mem[lomemmax].hh.lh := -30000; |
| rover := q; |
| goto 20 |
| end {:168}; |
| overflow(186, memmax + 30001); |
| 40: |
| mem[r].hh.rh := -30000; {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 := 32767; |
| 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 |
| end; {varused:=varused-s;} {: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:=32767;oldrover:=rover; |
| while p<>oldrover do[174:]if p<rover then begin q:=p;p:=mem[q+1].hh.rh; |
| mem[q+1].hh.rh:=rover;rover:=q;end else begin q:=rover; |
| while mem[q+1].hh.rh<p do q:=mem[q+1].hh.rh;r:=mem[p+1].hh.rh; |
| mem[p+1].hh.rh:=mem[q+1].hh.rh;mem[q+1].hh.rh:=p;p:=r;end[:174]; |
| p:=rover; |
| while mem[p+1].hh.rh<>32767 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 <> 30000 then begin |
| r := p; |
| repeat |
| q := r; |
| r := mem[r].hh.rh; {dynused:=dynused-1;} |
| if r < himemmin then |
| goto 30 |
| until r = 30000; |
| 30: |
| mem[q].hh.rh := avail; |
| avail := p |
| end |
| end; { flushlist } |
| |
| procedure flushnodelist(p: halfword); |
| var |
| q: halfword; |
| begin |
| while p <> (-30000) do begin |
| q := p; |
| p := mem[p].hh.rh; |
| if q < himemmin then |
| freenode(q, 2) |
| else begin |
| mem[q].hh.rh := avail; |
| avail := q |
| end |
| {dynused:=dynused-1;} |
| end |
| end; {:177} {180:} |
| {procedure checkmem(printlocs:boolean);label 31,32;var p,q,r:halfword; |
| clobbered:boolean;begin for p:=-30000 to lomemmax do freearr[p]:=false; |
| for p:=himemmin to memend do freearr[p]:=false;[181:]p:=avail;q:=-30000; |
| clobbered:=false; |
| while p<>-30000 do begin if(p>memend)or(p<himemmin)then clobbered:=true |
| else if freearr[p]then clobbered:=true; |
| if clobbered then begin printnl(187);printint(q);goto 31;end; |
| freearr[p]:=true;q:=p;p:=mem[q].hh.rh;end;31:[:181];[182:]p:=rover; |
| q:=-30000;clobbered:=false; |
| repeat if(p>=lomemmax)or(p<-30000)then clobbered:=true else if(mem[p+1]. |
| hh.rh>=lomemmax)or(mem[p+1].hh.rh<-30000)then clobbered:=true else if |
| not((mem[p].hh.rh=32767))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(188);printint(q);goto 32;end; |
| for q:=p to p+mem[p].hh.lh-1 do begin if freearr[q]then begin printnl( |
| 189);printint(q);goto 32;end;freearr[q]:=true;end;q:=p; |
| p:=mem[p+1].hh.rh;until p=rover;32:[:182];[183:]p:=-30000; |
| while p<=lomemmax do begin if(mem[p].hh.rh=32767)then begin printnl(190) |
| ;printint(p);end;while(p<=lomemmax)and not freearr[p]do p:=p+1; |
| while(p<=lomemmax)and freearr[p]do p:=p+1;end[:183];[617:]q:=-29987; |
| p:=mem[q].hh.rh; |
| while p<>-29987 do begin if mem[p+1].hh.lh<>q then begin printnl(463); |
| printint(p);end;p:=mem[p+1].hh.rh;r:=himemmin; |
| repeat if mem[p].hh.lh>=r then begin printnl(464);printint(p);end; |
| r:=mem[p].hh.lh;q:=p;p:=mem[q].hh.rh;until r=-30000;end[:617]; |
| if printlocs then[184:]begin printnl(191); |
| for p:=-30000 to lomemmax do if not freearr[p]and((p>waslomax)or wasfree |
| [p])then begin printchar(32);printint(p);end; |
| for p:=himemmin to memend do if not freearr[p]and((p<washimin)or(p> |
| wasmemend)or wasfree[p])then begin printchar(32);printint(p);end; |
| end[:184];for p:=-30000 to lomemmax do wasfree[p]:=freearr[p]; |
| for p:=himemmin to memend do wasfree[p]:=freearr[p];wasmemend:=memend; |
| waslomax:=lomemmax;washimin:=himemmin;end;} |
| {:180} |
| {185:} |
| {procedure searchmem(p:halfword);var q:integer; |
| begin for q:=-30000 to lomemmax do begin if mem[q].hh.rh=p then begin |
| printnl(192);printint(q);printchar(41);end; |
| if mem[q].hh.lh=p then begin printnl(193);printint(q);printchar(41);end; |
| end; |
| for q:=himemmin to memend do begin if mem[q].hh.rh=p then begin printnl( |
| 192);printint(q);printchar(41);end; |
| if mem[q].hh.lh=p then begin printnl(193);printint(q);printchar(41);end; |
| end; |
| [209:]for q:=1 to 2241 do begin if eqtb[q].rh=p then begin printnl(328); |
| printint(q);printchar(41);end;end[:209];end;} |
| {:185} |
| {189:} |
| |
| procedure printop(c: quarterword); |
| begin |
| if c <= 15 then |
| printtype(c) |
| else |
| if c in |
| [30, 31, 32, 33, 34, 35, 36, 37, |
| 38, 39, 40, 41, 42, 43, 44, 45, |
| 46, 47, 48, 49, 50, 51, 52, 53, |
| 54, 55, 56, 57, 58, 59, 60, 61, |
| 62, 63, 64, 65, 66, 67, 68, 69, |
| 70, 71, 72, 73, 74, 75, 76, 77, |
| 78, 79, 80, 81, 82, 83, 84, 85, |
| 86, 87, 88, 89, 90, 91, 92, 94, |
| 95, 96, 97, 98, 99, 100] then |
| case c of |
| 30: |
| print(218); |
| 31: |
| print(219); |
| 32: |
| print(220); |
| 33: |
| print(221); |
| 34: |
| print(222); |
| 35: |
| print(223); |
| 36: |
| print(224); |
| 37: |
| print(225); |
| 38: |
| print(226); |
| 39: |
| print(227); |
| 40: |
| print(228); |
| 41: |
| print(229); |
| 42: |
| print(230); |
| 43: |
| print(231); |
| 44: |
| print(232); |
| 45: |
| print(233); |
| 46: |
| print(234); |
| 47: |
| print(235); |
| 48: |
| print(236); |
| 49: |
| print(237); |
| 50: |
| print(238); |
| 51: |
| print(239); |
| 52: |
| print(240); |
| 53: |
| print(241); |
| 54: |
| print(242); |
| 55: |
| print(243); |
| 56: |
| print(244); |
| 57: |
| print(245); |
| 58: |
| print(246); |
| 59: |
| print(247); |
| 60: |
| print(248); |
| 61: |
| print(249); |
| 62: |
| print(250); |
| 63: |
| print(251); |
| 64: |
| print(252); |
| 65: |
| print(253); |
| 66: |
| print(254); |
| 67: |
| print(255); |
| 68: |
| print(256); |
| 69: |
| printchar(43); |
| 70: |
| printchar(45); |
| 71: |
| printchar(42); |
| 72: |
| printchar(47); |
| 73: |
| print(257); |
| 74: |
| print(181); |
| 75: |
| print(258); |
| 76: |
| print(259); |
| 77: |
| printchar(60); |
| 78: |
| print(260); |
| 79: |
| printchar(62); |
| 80: |
| print(261); |
| 81: |
| printchar(61); |
| 82: |
| print(262); |
| 83: |
| print(38); |
| 84: |
| print(263); |
| 85: |
| print(264); |
| 86: |
| print(265); |
| 87: |
| print(266); |
| 88: |
| print(267); |
| 89: |
| print(268); |
| 90: |
| print(269); |
| 91: |
| print(270); |
| 92: |
| print(271); |
| 94: |
| print(272); |
| 95: |
| print(273); |
| 96: |
| print(274); |
| 97: |
| print(275); |
| 98: |
| print(276); |
| 99: |
| print(277); |
| 100: |
| print(278) |
| end |
| else |
| print(279) |
| end; { printop } |
| {:189} |
| {194:} |
| |
| procedure fixdateandtime; |
| begin |
| dateandtime(internal[17], internal[16], internal[15], internal[14]); |
| internal[17] := internal[17] * 65536; |
| internal[16] := internal[16] * 65536; |
| internal[15] := internal[15] * 65536; |
| internal[14] := internal[14] * 65536; |
| {----------------------------------} |
| lastyearval := internal[14]; |
| lastmonthval:= internal[15]; |
| {----------------------------------} |
| end; { fixdateandtime } |
| {:194} |
| {205:} |
| |
| function idlookup(j, l: integer): halfword; |
| label |
| 40; |
| var |
| h: integer; |
| p: halfword; |
| k: halfword; |
| begin |
| if l = 1 then begin {206:} |
| 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 + 129; |
| 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 begin {207:} |
| if hash[p].rh > 0 then begin |
| repeat |
| if hashused = 1 then |
| overflow(327, 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(129, 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>=128 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 flushtokenlist(p: halfword); |
| var |
| q: halfword; |
| begin |
| while p <> (-30000) do begin |
| q := p; |
| p := mem[p].hh.rh; |
| if q >= himemmin then begin |
| mem[q].hh.rh := avail; |
| avail := q |
| end else begin |
| {dynused:=dynused-1;} |
| if mem[q].hh.b0 in |
| [1, 2, 16, 4, 3, 5, 7, 12, |
| 10, 6, 9, 8, 11, 14, 13, 17, |
| 18, 19] then |
| 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 |
| end |
| else |
| confusion(358); |
| freenode(q, 2) |
| end |
| end |
| end; { flushtokenlist } |
| {:216} |
| {226:} |
| |
| procedure deletemacref(p: halfword); |
| begin |
| if mem[p].hh.lh = (-30000) then |
| flushtokenlist(p) |
| else |
| mem[p].hh.lh := mem[p].hh.lh - 1 |
| end; {:226} {227:} {625:} |
| |
| procedure printcmdmod(c, m: integer); |
| begin |
| if c in |
| [18, 77, 59, 72, 32, 78, 79, 57, |
| 19, 60, 27, 11, 81, 26, 6, 9, |
| 70, 73, 13, 46, 63, 14, 15, 69, |
| 28, 47, 24, 7, 65, 64, 12, 8, |
| 80, 17, 74, 35, 58, 71, 75, 16, |
| 4, 61, 56, 3, 1, 2, 33, 34, |
| 37, 55, 45, 50, 36, 43, 54, 48, |
| 51, 52, 30, 82, 23, 21, 22, 31, |
| 62, 41, 10, 53, 44, 49, 5, 40, |
| 68, 66, 67, 25, 20, 76, 29] then |
| case c of {212:} |
| 18: |
| print(330); |
| 77: |
| print(329); |
| 59: |
| print(332); |
| 72: |
| print(331); |
| 32: |
| print(333); |
| 78: |
| print(58); |
| 79: |
| print(44); |
| 57: |
| print(334); |
| 19: |
| print(335); |
| 60: |
| print(336); |
| 27: |
| print(337); |
| 11: |
| print(338); |
| 81: |
| print(323); |
| 26: |
| print(339); |
| 6: |
| print(340); |
| 9: |
| print(341); |
| 70: |
| print(342); |
| 73: |
| print(343); |
| 13: |
| print(344); |
| 46: |
| print(123); |
| 63: |
| print(91); |
| 14: |
| print(345); |
| 15: |
| print(346); |
| 69: |
| print(347); |
| 28: |
| print(348); |
| 47: |
| print(279); |
| 24: |
| print(349); |
| 7: |
| printchar(92); |
| 65: |
| print(125); |
| 64: |
| print(93); |
| 12: |
| print(350); |
| 8: |
| print(351); |
| 80: |
| print(59); |
| 17: |
| print(352); |
| 74: |
| print(353); |
| 35: |
| print(354); |
| 58: |
| print(355); |
| 71: |
| print(356); |
| 75: |
| print(357); {:212} {684:} |
| 16: |
| if m <= 2 then |
| if m = 1 then |
| print(520) |
| else if m < 1 then |
| print(324) |
| else |
| print(521) |
| else if m = 53 then |
| print(522) |
| else if m = 44 then |
| print(523) |
| else |
| print(524); |
| 4: |
| if m <= 1 then |
| if m = 1 then |
| print(527) |
| else |
| print(325) |
| else if m = 2242 then |
| print(525) |
| else |
| print(526); {:684} {689:} |
| 61: |
| if m in |
| [1, 2, 3] then |
| case m of |
| 1: |
| print(529); |
| 2: |
| printchar(64); |
| 3: |
| print(530) |
| end |
| else |
| print(528); {:689} {696:} |
| 56: |
| if m >= 2242 then |
| if m = 2242 then |
| print(541) |
| else if m = 2392 then |
| print(542) |
| else |
| print(543) |
| else if m < 2 then |
| print(544) |
| else if m = 2 then |
| print(545) |
| else |
| print(546); {:696} {710:} |
| 3: |
| if m = 0 then |
| print(556) |
| else |
| print(482); |
| {:710} |
| {741:} |
| 1, 2: |
| if m in |
| [1, 2, 3] then |
| case m of |
| 1: |
| print(583); |
| 2: |
| print(322); |
| 3: |
| print(584) |
| end |
| else |
| print(585); {:741} {894:} |
| 33, 34, 37, 55, 45, 50, 36, |
| 43, 54, 48, 51, 52: |
| printop(m); {:894} {1014:} |
| 30: |
| printtype(m); {:1014} {1019:} |
| 82: |
| if m = 0 then |
| print(776) |
| else |
| print(777); |
| {:1019} |
| {1025:} |
| 23: |
| if m in |
| [0, 1, 2] then |
| case m of |
| 0: |
| print(143); |
| 1: |
| print(144); |
| 2: |
| print(145) |
| end |
| else |
| print(783); {:1025} {1028:} |
| 21: |
| if m = 0 then |
| print(784) |
| else |
| print(785); {:1028} {1038:} |
| 22: |
| if m in |
| [0, 1, 2, 3] then |
| case m of |
| 0: |
| print(799); |
| 1: |
| print(800); |
| 2: |
| print(801); |
| 3: |
| print(802) |
| end |
| else |
| print(803); {:1038} {1043:} |
| 31, 62: |
| begin |
| if c = 31 then |
| print(806) |
| else |
| print(807); |
| print(808); |
| print(hash[m].rh) |
| end; |
| 41: |
| if m = (-30000) then |
| print(809) |
| else |
| print(810); |
| 10: |
| print(811); |
| 53, 44, 49: |
| begin |
| printcmdmod(16, c); |
| print(812); |
| println; |
| showtokenlist(mem[mem[m].hh.rh].hh.rh, -30000, 1000, 0) |
| end; |
| 5: |
| print(813); |
| 40: |
| print(intname[m]); {:1043} {1053:} |
| 68: |
| if m = 1 then |
| print(820) |
| else if m = 0 then |
| print(821) |
| else |
| print(822); |
| 66: |
| if m = 6 then |
| print(823) |
| else |
| print(824); |
| 67: |
| if m = 0 then |
| print(825) |
| else |
| print(826); {:1053} {1080:} |
| 25: |
| if m < 1 then |
| print(856) |
| else if m = 1 then |
| print(857) |
| else |
| print(858); |
| {:1080} |
| {1102:} |
| 20: |
| if m in |
| [0, 1, 2, 3] then |
| case m of |
| 0: |
| print(868); |
| 1: |
| print(869); |
| 2: |
| print(870); |
| 3: |
| print(871) |
| end |
| else |
| print(872); {:1102} {1110:} |
| 76: |
| if m = 0 then |
| print(889) |
| else |
| print(890); {:1110} {1180:} |
| 29: |
| if m = 16 then |
| print(913) |
| else |
| print(912) |
| end |
| else {:1180} |
| print(468) |
| 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 := -30000; |
| showtokenlist(p, -30000, 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(368); |
| 1, 2, 3: |
| begin |
| printchar(60); |
| printcmdmod(56, mem[p].hh.lh); |
| print(369) |
| end; |
| 4: |
| print(370); |
| 5: |
| print(371); |
| 6: |
| print(372); |
| 7: |
| print(373) |
| end; |
| showtokenlist(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 := -30000 |
| until s = 0; |
| mem[q].hh.rh := p; |
| mem[p + 1].int := q |
| end; { initbignode } |
| {: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 := -30000; |
| 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 printvariablename(p: halfword); |
| label |
| 40, 10; |
| var |
| q: halfword; |
| r: halfword; |
| begin |
| while mem[p].hh.b1 >= 5 do begin {237:} |
| case mem[p].hh.b1 of |
| 5: |
| printchar(120); |
| 6: |
| printchar(121); |
| 7: |
| print(376); |
| 8: |
| print(377); |
| 9: |
| print(378); |
| 10: |
| print(379); |
| 11: |
| begin |
| print(380); |
| printint(p + 30000); |
| goto 10 |
| end |
| end; |
| print(381); |
| p := mem[p - (2 * (mem[p].hh.b1 - 5))].hh.rh |
| end {:237}; |
| q := -30000; |
| while mem[p].hh.b1 > 1 do begin {236:} |
| 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(375); |
| 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(374); |
| showtokenlist(r, -30000, 2147483647, tally); |
| flushtokenlist(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 |
| if mem[p].hh.b1 in |
| [0, 3, 4] then |
| case mem[p].hh.b1 of |
| 0: |
| begin |
| q := mem[p].hh.rh; |
| r := getnode(2); |
| eqtb[q].rh := r |
| end; |
| 3: |
| begin {240:} |
| 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: |
| begin {241:} |
| 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 |
| end |
| else {:241} |
| confusion(382); |
| 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 := -29983; |
| 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 83) <> 41 then begin |
| findvariable := -30000; |
| goto 10 |
| end; |
| if eqtb[p].rh = (-30000) then |
| newroot(p); |
| p := eqtb[p].rh; |
| pp := p; |
| while t <> (-30000) do begin {243:} |
| if mem[pp].hh.b0 <> 21 then begin |
| if mem[pp].hh.b0 > 21 then begin |
| findvariable := -30000; |
| 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 < himemmin then begin {244:} |
| n := mem[t + 1].int; |
| pp := mem[mem[pp + 1].hh.lh].hh.rh; |
| q := mem[mem[p + 1].hh.lh].hh.rh; |
| saveword := mem[q + 2]; |
| mem[q + 2].int := 2147483647; |
| s := p + 1; |
| repeat |
| r := s; |
| s := mem[s].hh.rh |
| until n <= mem[s + 2].int; |
| if n = mem[s + 2].int then |
| p := s |
| else begin |
| p := getnode(3); |
| mem[r].hh.rh := p; |
| mem[p].hh.rh := s; |
| mem[p + 2].int := n; |
| mem[p].hh.b1 := 3; |
| mem[p].hh.b0 := 0 |
| end; |
| mem[q + 2] := saveword |
| end else begin {:244} {245:} |
| n := mem[t].hh.lh; |
| ss := mem[pp + 1].hh.lh; |
| repeat |
| rr := ss; |
| ss := mem[ss].hh.rh |
| until n <= mem[ss + 2].hh.lh; |
| if n < mem[ss + 2].hh.lh then begin |
| qq := getnode(3); |
| mem[rr].hh.rh := qq; |
| mem[qq].hh.rh := ss; |
| mem[qq + 2].hh.lh := n; |
| mem[qq].hh.b1 := 4; |
| mem[qq].hh.b0 := 0; |
| mem[qq + 2].hh.rh := pp; |
| ss := qq |
| end; |
| if p = pp then begin |
| p := ss; |
| pp := ss |
| end else begin |
| pp := ss; |
| s := mem[p + 1].hh.lh; |
| repeat |
| r := s; |
| s := mem[s].hh.rh |
| until n <= mem[s + 2].hh.lh; |
| if n = mem[s + 2].hh.lh then |
| p := s |
| else begin |
| q := getnode(3); |
| mem[r].hh.rh := q; |
| mem[q].hh.rh := s; |
| mem[q + 2].hh.lh := n; |
| mem[q].hh.b1 := 4; |
| mem[q].hh.b0 := 0; |
| mem[q + 2].hh.rh := p; |
| p := q |
| end |
| end |
| end {:245}; |
| t := mem[t].hh.rh |
| end; |
| if mem[pp].hh.b0 >= 21 then |
| if mem[pp].hh.b0 = 21 then |
| pp := mem[pp + 1].hh.lh |
| else begin |
| findvariable := -30000; |
| 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 := -30000 |
| end; |
| mem[p].hh.b0 := mem[pp].hh.b0; |
| mem[p + 1].int := -30000 |
| end; |
| findvariable := p; |
| 10: |
| |
| end; {:242} {246:} {257:} |
| |
| procedure printpath(h: halfword; s: strnumber; nuline: boolean); |
| label |
| 30, 31; |
| var |
| p, q: halfword; |
| begin |
| printdiagnostic(384, s, nuline); |
| println; |
| p := h; |
| repeat |
| q := mem[p].hh.rh; |
| if (p = (-30000)) or (q = (-30000)) then begin |
| printnl(131); |
| goto 30 |
| end; {258:} |
| printtwo(mem[p + 1].int, mem[p + 2].int); |
| if mem[p].hh.b1 in |
| [0, 1, 4, 3, 2] then |
| case mem[p].hh.b1 of |
| 0: |
| begin |
| if mem[p].hh.b0 = 4 then |
| print(385); |
| if (mem[q].hh.b0 <> 0) or (q <> h) then |
| q := -30000; |
| goto 31 |
| end; |
| 1: |
| begin {261:} |
| print(391); |
| printtwo(mem[p + 5].int, mem[p + 6].int); |
| print(390); |
| if mem[q].hh.b0 <> 1 then |
| print(392) |
| 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(385) {:262}; |
| 3, 2: |
| begin {263:} |
| if mem[p].hh.b0 = 4 then |
| print(392); |
| if mem[p].hh.b1 = 3 then begin |
| print(388); |
| 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 |
| end |
| else {:263} |
| print(131); |
| if mem[q].hh.b0 <= 1 then |
| print(386) |
| else if (mem[p + 6].int <> 65536) or (mem[q + 4].int <> 65536) then begin {260:} |
| print(389); |
| if mem[p + 6].int < 0 then |
| print(332); |
| printscaled(abs(mem[p + 6].int)); |
| if mem[p + 6].int <> mem[q + 4].int then begin |
| print(390); |
| if mem[q + 4].int < 0 then |
| print(332); |
| printscaled(abs(mem[q + 4].int)) |
| end |
| end {:260}; |
| 31: {:258} |
| ; |
| p := q; |
| if (p <> h) or (mem[h].hh.b0 <> 0) then begin {259:} |
| printnl(387); |
| 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(388); |
| printscaled(mem[p + 3].int); |
| printchar(125) |
| end |
| end {:259} |
| until p = h; |
| if mem[h].hh.b0 <> 0 then |
| print(256); |
| 30: |
| enddiagnostic(true) |
| end; {:257} |
| {332:} |
| {333:} |
| |
| procedure printweight(q: halfword; xoff: integer); |
| var |
| w, m: integer; |
| d: integer; |
| begin |
| d := mem[q].hh.lh + 32768; |
| 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 |
| printdiagnostic(399, 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 > (-29999)) or (r <> 30000) then begin |
| printnl(400); |
| printint(n + yoff); |
| printchar(58); |
| while q > (-29999) do begin |
| printweight(q, xoff); |
| q := mem[q].hh.rh |
| end; |
| print(401); |
| while r <> 30000 do begin |
| printweight(r, xoff); |
| r := mem[r].hh.rh |
| end |
| end; |
| p := mem[p].hh.lh; |
| n := n - 1 |
| end; |
| enddiagnostic(true) |
| end; {:332} {388:} |
| |
| {--------------------------------------------------- |
| procedure unskew(x, y: scaled; octant: smallnumber); |
| |
| moved to mf2ps1.p |
| ---------------------------------------------------} |
| |
| procedure printpen(p: halfword; s: strnumber; nuline: boolean); |
| var |
| nothingprinted: boolean; |
| k: 1..8; |
| h: halfword; |
| m, n: integer; |
| w, ww: halfword; |
| begin |
| printdiagnostic(436, s, nuline); |
| nothingprinted := 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 begin {474:} |
| if nothingprinted then |
| nothingprinted := false |
| else |
| printnl(438); |
| unskew(mem[ww + 1].int, mem[ww + 2].int, octant); |
| printtwo(curx, cury) |
| end {:474}; |
| w := ww |
| end |
| end; |
| if nothingprinted then begin |
| w := mem[p + 1].hh.rh; |
| printtwo(mem[w + 1].int + mem[w + 2].int, mem[w + 2].int) |
| end; |
| printnl(437); |
| enddiagnostic(true) |
| end; {:473} {589:} |
| |
| procedure printdependency(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 = (-30000) 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 := roundfraction(v); |
| if v <> 65536 then |
| printscaled(v) {:590}; |
| if mem[q].hh.b0 <> 19 then |
| confusion(454); |
| printvariablename(q); |
| v := mem[q + 1].int mod 64; |
| while v > 0 do begin |
| print(455); |
| 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 = (-30000)) or (verbosity > 0) then |
| printdependency(p, t) |
| else |
| print(628) |
| end; {:805} {799:} |
| |
| function stashcurexp: halfword; |
| var |
| p: halfword; |
| begin |
| if curtype in |
| [3, 5, 7, 12, 10, 13, 14, 17, |
| 18, 19] then |
| case curtype of |
| 3, 5, 7, 12, 10, 13, 14, |
| 17, 18, 19: |
| p := curexp |
| end |
| else |
| begin |
| p := getnode(2); |
| mem[p].hh.b1 := 11; |
| mem[p].hh.b0 := curtype; |
| mem[p + 1].int := curexp |
| end; |
| curtype := 1; |
| mem[p].hh.rh := -29999; |
| stashcurexp := p |
| end; {:799} {800:} |
| |
| procedure unstashcurexp(p: halfword); |
| begin |
| curtype := mem[p].hh.b0; |
| if curtype in |
| [3, 5, 7, 12, 10, 13, 14, 17, |
| 18, 19] then |
| case curtype of |
| 3, 5, 7, 12, 10, 13, 14, |
| 17, 18, 19: |
| curexp := p |
| end |
| else |
| begin |
| curexp := mem[p + 1].int; |
| freenode(p, 2) |
| end |
| end; {:800} |
| |
| procedure printexp(p: halfword; verbosity: smallnumber); |
| var |
| restorecurexp: boolean; |
| t: smallnumber; |
| v: integer; |
| q: halfword; |
| begin |
| if p <> (-30000) then |
| restorecurexp := false |
| else begin |
| p := stashcurexp; |
| restorecurexp := 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:} |
| if t in |
| [1, 2, 3, 5, 7, 12, 10, 15, |
| 4, 6, 8, 9, 11, 13, 14, 16, |
| 17, 18, 19] then |
| case t of |
| 1: |
| print(194); |
| 2: |
| if v = 30 then |
| print(218) |
| else |
| print(219); |
| 3, 5, 7, 12, 10, 15: |
| begin {806:} |
| printtype(t); |
| if v <> (-30000) then begin |
| printchar(32); |
| while (mem[v].hh.b1 = 11) and (v <> p) do |
| v := mem[v + 1].int; |
| printvariablename(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(626); |
| selector := 3 |
| end; |
| case t of |
| 6: |
| printpen(v, 155, false); |
| 8: |
| printpath(v, 627, false); |
| 9: |
| printpath(v, 155, false); |
| 11: |
| begin |
| curedges := v; |
| printedges(155, false, 0, 0) |
| end |
| end |
| end {:804}; |
| 13, 14: |
| if v = (-30000) then |
| printtype(t) {803:} |
| else 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 |
| printvariablename(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: |
| printvariablename(p) |
| end |
| else |
| confusion(625) {:802}; |
| if restorecurexp then |
| unstashcurexp(p) |
| end; {:801} {807:} |
| |
| procedure disperr(p: halfword; s: strnumber); |
| begin |
| if interaction = 3 then |
| ; |
| printnl(629); |
| printexp(p, 1); |
| if s <> 155 then begin |
| printnl(133); |
| 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 := 29999; |
| pp := mem[p].hh.lh; |
| qq := mem[q].hh.lh; |
| while true do |
| if pp = qq then |
| if pp = (-30000) then |
| goto 30 {595:} |
| else 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) < threshold then |
| freenode(s, 2) |
| else begin |
| 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 < mem[qq + 1].int then begin {596:} |
| if tt = 17 then |
| v := takefraction(f, mem[q + 1].int) |
| else |
| v := takescaled(f, mem[q + 1].int); |
| if abs(v) > (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 else begin {:596} |
| 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[29999].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 := 29999; |
| while mem[p].hh.lh <> (-30000) do begin |
| if scalingdown then |
| if abs(v) < 524288 then |
| w := makescaled(mem[p + 1].int, v * 4096) |
| else |
| w := makescaled(roundfraction(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[29999].hh.rh |
| end; { poverv } |
| {:600} |
| {602:} |
| |
| procedure valtoobig(x: scaled); |
| begin |
| if internal[40] > 0 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(456) |
| end; |
| printscaled(x); |
| printchar(41); |
| begin |
| helpptr := 4; |
| helpline[3] := 457; |
| helpline[2] := 458; |
| helpline[1] := 459; |
| helpline[0] := 460 |
| 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 |
| begindiagnostic; |
| printnl(461); |
| printvariablename(p); |
| printchar(61); |
| printscaled(mem[p + 1].int); |
| enddiagnostic(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 fixdependencies; |
| label |
| 30; |
| var |
| p, q, r, s, t: halfword; |
| x: halfword; |
| begin |
| r := mem[-29987].hh.rh; |
| s := -30000; |
| while r <> (-29987) do begin |
| t := r; |
| {605:} |
| r := t + 1; |
| while true do begin |
| q := mem[r].hh.rh; |
| x := mem[q].hh.lh; |
| if x = (-30000) 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 <> (-30000) do begin |
| p := mem[s].hh.rh; |
| x := mem[s].hh.lh; |
| begin |
| mem[s].hh.rh := avail; |
| avail := s |
| end {dynused:=dynused-1;}; |
| s := p; |
| mem[x].hh.b0 := 19; |
| mem[x + 1].int := mem[x + 1].int + 2 |
| end; |
| fixneeded := false |
| end; { fixdependencies } |
| {: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 > (-29999) 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 <> (-29997) 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 <> (-30000) 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 = (-30000) 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 <> (-30000) then begin |
| q := v + bignodesize[t]; |
| repeat |
| q := q - 2; |
| recyclevalue(q) |
| until q = v; |
| freenode(v, bignodesize[t]) |
| end {:810}; |
| 17, 18: |
| begin {811:} |
| q := mem[p + 1].hh.rh; |
| while mem[q].hh.lh <> (-30000) 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 := -30000; |
| flushnodelist(mem[p + 1].hh.rh) |
| end; {:811} |
| 19: |
| begin {812:} |
| maxc[17] := 0; |
| maxc[18] := 0; |
| maxlink[17] := -30000; |
| maxlink[18] := -30000; |
| q := mem[-29987].hh.rh; |
| while q <> (-29987) do begin |
| s := q + 1; |
| while true do begin |
| r := mem[s].hh.rh; |
| if mem[r].hh.lh = (-30000) 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 begin {814:} |
| 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 else begin {:814} |
| 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 begin {815:} |
| 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 <> (-30000) do |
| r := mem[r].hh.rh; |
| q := mem[r].hh.rh; |
| mem[r].hh.rh := -30000; |
| 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 |
| begindiagnostic; |
| printnl(631); |
| if v > 0 then |
| printchar(45); |
| if t = 17 then |
| vv := roundfraction(maxc[17]) |
| else |
| vv := maxc[18]; |
| if vv <> 65536 then |
| printscaled(vv); |
| printvariablename(p); |
| while (mem[p + 1].int mod 64) > 0 do begin |
| print(455); |
| mem[p + 1].int := mem[p + 1].int - 2 |
| end; |
| if t = 17 then |
| printchar(61) |
| else |
| print(632); |
| printdependency(s, t); |
| enddiagnostic(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 <> (-30000) 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} {819:} |
| else |
| for t := 17 to 18 do begin |
| r := maxlink[t]; |
| while r <> (-30000) 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 := roundfraction(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}; |
| flushnodelist(s); |
| if fixneeded then |
| fixdependencies; |
| begin |
| if aritherror then |
| cleararith |
| end |
| end {:815} |
| end; {:812} |
| 20, 21: |
| confusion(630); |
| 22, 23: |
| deletemacref(mem[p + 1].int) |
| end; |
| mem[p].hh.b0 := 0 |
| end; {:809} {808:} |
| |
| procedure flushcurexp(v: scaled); |
| begin |
| if curtype in |
| [3, 5, 7, 12, 10, 13, 14, 17, |
| 18, 19, 6, 4, 8, 9, 11] then |
| 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 = (-30000) 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) |
| end |
| else |
| ; |
| 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; { putgeterror } |
| |
| procedure putgetflusherror(v: scaled); |
| begin |
| putgeterror; |
| flushcurexp(v) |
| end; {:820} {247:} |
| |
| procedure flushbelowvariable(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 |
| flushbelowvariable(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 |
| flushbelowvariable(q); |
| r := q; |
| q := mem[q].hh.rh; |
| freenode(r, 3) |
| until q = (-29983); |
| mem[p].hh.b0 := 0 |
| end |
| end; {:247} |
| |
| procedure flushvariable(p, t: halfword; discardsuffixes: boolean); |
| label |
| 10; |
| var |
| q, r: halfword; |
| n: halfword; |
| begin |
| while t <> (-30000) 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 |
| flushvariable(q, t, discardsuffixes); |
| if t = (-30000) 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 discardsuffixes then |
| flushbelowvariable(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; |
| if eqtb[p].lh mod 83 in |
| [10, 53, 44, 49, 41] then |
| case eqtb[p].lh mod 83 of |
| 10, 53, 44, 49: |
| if not saving then |
| deletemacref(q); |
| 41: |
| if q <> (-30000) then |
| if saving then |
| mem[q].hh.b1 := 1 |
| else begin |
| flushbelowvariable(q); |
| freenode(q, 2) |
| end |
| end |
| else |
| ; |
| eqtb[p] := eqtb[2241] |
| end; {:249} {252:} |
| |
| procedure savevariable(q: halfword); |
| var |
| p: halfword; |
| begin |
| if saveptr <> (-30000) 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 <> (-30000)) |
| end; {:252} {253:} |
| |
| procedure saveinternal(q: halfword); |
| var |
| p: halfword; |
| begin |
| if saveptr <> (-30000) then begin |
| p := getnode(2); |
| mem[p].hh.lh := 2241 + q; |
| mem[p].hh.rh := saveptr; |
| mem[p + 1].int := internal[q]; |
| saveptr := p |
| end |
| end; { saveinternal } |
| {: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 > 2241 then begin |
| if internal[8] > 0 then begin |
| begindiagnostic; |
| printnl(383); |
| print(intname[q - 2241]); |
| printchar(61); |
| printscaled(mem[saveptr + 1].int); |
| printchar(125); |
| enddiagnostic(false) |
| end; |
| internal[q - 2241] := mem[saveptr + 1].int |
| end else begin |
| if internal[8] > 0 then begin |
| begindiagnostic; |
| printnl(383); |
| print(hash[q].rh); |
| printchar(125); |
| enddiagnostic(false) |
| end; |
| clearsymbol(q, false); |
| eqtb[q] := mem[saveptr + 1].hh; |
| if (eqtb[q].lh mod 83) = 41 then begin |
| p := eqtb[q].rh; |
| if p <> (-30000) 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 |
| end {dynused:=dynused-1;}; |
| 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; { setcontrols } |
| {:299} |
| |
| procedure solvechoices(p, q: halfword; n: halfword); |
| label |
| 40, 10; |
| var |
| k: 0..pathsize; |
| r, s, t: halfword; |
| sine, cosine: fraction; {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 begin {301:} |
| 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 else begin {:301} {293:} |
| 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 begin {302:} |
| 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 else begin {:302} {294:} |
| 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: |
| begin {287:} {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 lt < rt then begin |
| ff := makefraction(lt, rt); |
| ff := takefraction(ff, ff); |
| dd := takefraction(dd, ff) |
| end else begin |
| ff := makefraction(rt, lt); |
| ff := takefraction(ff, ff); |
| ee := takefraction(ee, ff) |
| end; |
| ff := makefraction(ee, ee + dd) {:289}; |
| uu[k] := takefraction(ff, bb); {290:} |
| acc := -takefraction(psi[k + 1], uu[k]); |
| if mem[r].hh.b1 = 3 then begin |
| ww[k] := 0; |
| vv[k] := acc - takefraction(psi[1], 268435456 - ff) |
| end else begin |
| ff := makefraction(268435456 - ff, cc); |
| acc := acc - takefraction(psi[k], ff); |
| ff := takefraction(ff, aa); |
| vv[k] := acc - takefraction(vv[k - 1], ff); |
| if ww[k - 1] = 0 then |
| ww[k] := 0 |
| else |
| ww[k] := -takefraction(ww[k - 1], ff) |
| end {:290}; |
| if mem[s].hh.b0 = 5 then begin {291:} |
| aa := 0; |
| bb := 268435456; |
| repeat |
| k := k - 1; |
| if k = 0 then |
| k := n; |
| aa := vv[k] - takefraction(aa, uu[k]); |
| bb := ww[k] - takefraction(bb, uu[k]) |
| until k = n; |
| aa := makefraction(aa, 268435456 - bb); |
| theta[n] := aa; |
| vv[0] := aa; |
| for k := 1 to n - 1 do |
| vv[k] := vv[k] + takefraction(aa, ww[k]); |
| goto 40 |
| end {:291} |
| end; {:287} |
| 3: |
| begin {295:} |
| cc := mem[s + 3].int; |
| lt := abs(mem[s + 4].int); |
| rt := abs(mem[r + 6].int); |
| if (rt = 65536) and (lt = 65536) then |
| ff := makefraction((cc + cc) + 65536, cc + 131072) |
| else |
| ff := curlratio(cc, lt, rt); |
| theta[n] := -makefraction(takefraction(vv[n - 1], ff), 268435456 - takefraction(ff, uu[n - 1])); |
| goto 40 |
| end; {:295} |
| 2: |
| begin {292:} |
| theta[n] := mem[s + 3].int - narg(deltax[n - 1], deltay[n - 1]); |
| if abs(theta[n]) > 188743680 then |
| if theta[n] > 0 then |
| theta[n] := theta[n] - 377487360 |
| else |
| theta[n] := theta[n] + 377487360; |
| goto 40 |
| end |
| end {:292}; |
| 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; |
| r, s, t: halfword; |
| delx, dely: scaled; |
| sine, cosine: fraction; {:280} |
| begin |
| begin |
| if aritherror then |
| cleararith |
| end; |
| if internal[4] > 0 then |
| printpath(knots, 393, 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; {273:} |
| repeat |
| 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(398, 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, 394, true); |
| if aritherror then begin {270:} |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(395) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 396; |
| helpline[0] := 397 |
| end; |
| putgeterror; |
| aritherror := false |
| end {:270} |
| end; {:269} {311:} |
| |
| {------------------------------------------------------------------- |
| procedure makemoves(xx0, xx1, xx2, xx3, yy0, yy1, yy2, yy3: scaled; xicorr, etacorr: smallnumber); |
| |
| moved to mf2ps3.p |
| -------------------------------------------------------------------} |
| |
| 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 <> 30000 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 > (-29999) 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 ml < mem[curedges + 2].hh.lh then |
| mem[curedges + 2].hh.lh := ml; |
| if mr > mem[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 nl < mem[curedges + 1].hh.lh then begin {330:} |
| delta := mem[curedges + 1].hh.lh - nl; |
| mem[curedges + 1].hh.lh := nl; |
| p := mem[curedges].hh.rh; |
| repeat |
| q := getnode(2); |
| mem[q + 1].hh.rh := 30000; |
| mem[q + 1].hh.lh := -29999; |
| mem[p].hh.lh := q; |
| mem[q].hh.rh := p; |
| p := q; |
| delta := delta - 1 |
| until delta = 0; |
| mem[p].hh.lh := curedges; |
| mem[curedges].hh.rh := p; |
| if mem[curedges + 5].hh.rh = curedges then |
| mem[curedges + 5].hh.lh := nl - 1 |
| end {:330}; |
| if nr > mem[curedges + 1].hh.rh then begin {331:} |
| 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 := 30000; |
| mem[q + 1].hh.lh := -29999; |
| 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 <> 30000 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 := 30000; |
| r := mem[p + 1].hh.lh; |
| rr := 29999; |
| while r > (-29999) 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[29999].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 yreflectedges; |
| 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 xreflectedges; |
| 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) - 65528; |
| mem[curedges + 3].hh.lh := 4096; |
| p := mem[curedges].hh.rh; {339:} |
| repeat |
| q := mem[p + 1].hh.rh; |
| r := 30000; |
| while q <> 30000 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 > (-29999) 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; { xreflectedges } |
| {: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 |
| ; |
| printnl(133); |
| print(402) |
| end; |
| begin |
| helpptr := 3; |
| helpline[2] := 403; |
| helpline[1] := 404; |
| helpline[0] := 405 |
| 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 <> 30000 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 := 30000; |
| r := mem[p + 1].hh.lh; |
| rr := 29999; |
| while r > (-29999) 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[29999].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 |
| ; |
| printnl(133); |
| print(402) |
| end; |
| begin |
| helpptr := 3; |
| helpline[2] := 406; |
| helpline[1] := 404; |
| helpline[0] := 405 |
| 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))) - 32768; |
| mem[curedges + 3].hh.lh := 4096; {343:} |
| q := mem[curedges].hh.rh; |
| repeat |
| p := mem[q + 1].hh.rh; |
| while p <> 30000 do begin |
| t := mem[p].hh.lh + 32768; |
| 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 > (-29999) do begin |
| t := mem[p].hh.lh + 32768; |
| 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; { xscaleedges } |
| {: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 > (-29999) do begin |
| mem[q].hh.lh := (8 - (2 * ((mem[q].hh.lh + 32768) mod 8))) + mem[q].hh.lh; |
| q := mem[q].hh.rh |
| end; |
| q := mem[p + 1].hh.rh; |
| if q <> 30000 then begin |
| repeat |
| mem[q].hh.lh := (8 - (2 * ((mem[q].hh.lh + 32768) mod 8))) + mem[q].hh.lh; |
| q := mem[q].hh.rh |
| until q = 30000; {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 = 30000 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 := 30000 {: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 := -30000; |
| p := mem[r].hh.rh; |
| mem[r].hh.rh := 30000; |
| mem[29999].hh.rh := r; |
| while p > (-29999) do begin |
| k := mem[p].hh.lh; |
| q := 29999; |
| 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[29999].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 = 30000 then |
| goto 30; |
| r := p; |
| p := s |
| end; |
| 30: {:347} |
| |
| end |
| 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 := 32767; |
| maxd := -32768; |
| minn := 32767; |
| maxn := -32768; |
| p := mem[curedges].hh.rh; |
| n := mem[curedges + 1].hh.lh; |
| while p <> curedges do begin |
| if mem[p + 1].hh.lh > (-29999) then |
| sortedges(p); |
| if mem[p + 1].hh.rh <> 30000 then begin {349:} |
| r := 29999; |
| q := mem[p + 1].hh.rh; |
| ww := 0; |
| m := 1000000; |
| prevw := 0; |
| while true do begin |
| if q = 30000 then |
| mm := 1000000 |
| else begin |
| d := mem[q].hh.lh + 32768; |
| 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) - 32764) + w) - prevw; |
| r := s; |
| prevw := w |
| end {:350}; |
| if q = 30000 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 |
| end {dynused:=dynused-1;}; |
| q := s |
| end; |
| 30: |
| mem[r].hh.rh := 30000; |
| mem[p + 1].hh.rh := mem[29999].hh.rh; |
| if r <> 29999 then begin {351:} |
| if minn = 32767 then |
| minn := n; |
| maxn := n; |
| if mind > mem[mem[29999].hh.rh].hh.lh then |
| mind := mem[mem[29999].hh.rh].hh.lh; |
| if maxd < mem[r].hh.lh then |
| maxd := mem[r].hh.lh |
| end {:351} |
| end {:349}; |
| p := mem[p].hh.rh; |
| n := n + 1 |
| end; {352:} |
| if minn > maxn then begin {353:} |
| p := mem[curedges].hh.rh; |
| while p <> curedges do begin |
| q := mem[p].hh.rh; |
| freenode(p, 2); |
| p := q |
| end; |
| initedges(curedges) |
| end else begin {:353} |
| 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 maxn < n do begin |
| p := mem[curedges].hh.lh; |
| mem[curedges].hh.lh := mem[p].hh.lh; |
| mem[mem[p].hh.lh].hh.rh := curedges; |
| freenode(p, 2); |
| n := n - 1 |
| end; |
| mem[curedges + 2].hh.lh := (((mind + 32768) div 8) - mem[curedges + 3].hh.lh) + 4096; |
| mem[curedges + 2].hh.rh := (((maxd + 32768) div 8) - mem[curedges + 3].hh.lh) + 4096 |
| end {:352}; |
| mem[curedges + 4].int := 0 |
| end; {:348} {354:} |
| |
| procedure xyswapedges; |
| label |
| 30; |
| var |
| mmagic, nmagic: integer; |
| p, q, r, s: halfword; {357:} |
| mspread: integer; |
| j, jj: 0..movesize; |
| m, mm: integer; |
| pd, rd: integer; |
| pm, rm: integer; |
| w: integer; |
| ww: integer; |
| dw: integer; {:357} {363:} |
| extras: integer; |
| xw: -3..3; |
| k: integer; {:363} {356:} |
| begin |
| mspread := mem[curedges + 2].hh.rh - mem[curedges + 2].hh.lh; |
| if mspread > movesize then |
| overflow(407, movesize); |
| for j := 0 to mspread do |
| move[j] := 30000 {:356}; {355:} |
| p := getnode(2); |
| mem[p + 1].hh.rh := 30000; |
| mem[p + 1].hh.lh := -30000; |
| mem[p].hh.lh := curedges; |
| mem[mem[curedges].hh.rh].hh.lh := p; |
| p := getnode(2); |
| mem[p + 1].hh.rh := 30000; |
| 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) - 32756 {:365}; |
| repeat |
| q := mem[p].hh.lh; |
| if mem[q + 1].hh.lh > (-29999) then |
| sortedges(q); {358:} |
| r := mem[p + 1].hh.rh; |
| freenode(p, 2); |
| p := r; |
| pd := mem[p].hh.lh + 32768; |
| pm := pd div 8; |
| r := mem[q + 1].hh.rh; |
| rd := mem[r].hh.lh + 32768; |
| rm := rd div 8; |
| w := 0; |
| while true do begin |
| if pm < rm then |
| mm := pm |
| else |
| mm := rm; |
| if w <> 0 then {362:} |
| if m <> mm then begin |
| if (mm - mmagic) >= movesize then |
| confusion(377); |
| 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 pd < rd then begin |
| dw := (pd mod 8) - 4; {360:} |
| s := mem[p].hh.rh; |
| begin |
| mem[p].hh.rh := avail; |
| avail := p |
| end {dynused:=dynused-1;}; |
| p := s; |
| pd := mem[p].hh.lh + 32768; |
| pm := pd div 8 {:360} |
| end else begin |
| if r = 30000 then |
| goto 30; |
| dw := -((rd mod 8) - 4); {359:} |
| r := mem[r].hh.rh; |
| rd := mem[r].hh.lh + 32768; |
| rm := rd div 8 {:359} |
| end; |
| m := mm; |
| w := w + dw |
| end; |
| 30: {:358} |
| ; |
| p := q; |
| nmagic := nmagic - 8 |
| until mem[p].hh.lh = curedges; |
| freenode(p, 2); {364:} |
| move[mspread] := 0; |
| j := 0; |
| while move[j] = 30000 do |
| j := j + 1; |
| if j = mspread then |
| initedges(curedges) |
| else begin |
| mm := mem[curedges + 2].hh.lh; |
| mem[curedges + 2].hh.lh := mem[curedges + 1].hh.lh; |
| mem[curedges + 2].hh.rh := mem[curedges + 1].hh.rh + 1; |
| mem[curedges + 3].hh.lh := 4096; |
| jj := mspread - 1; |
| while move[jj] = 30000 do |
| jj := jj - 1; |
| mem[curedges + 1].hh.lh := j + mm; |
| mem[curedges + 1].hh.rh := jj + mm; |
| q := curedges; |
| repeat |
| p := getnode(2); |
| mem[q].hh.rh := p; |
| mem[p].hh.lh := q; |
| mem[p + 1].hh.rh := move[j]; |
| mem[p + 1].hh.lh := -30000; |
| j := j + 1; |
| q := p |
| until j > jj; |
| 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 |
| end; {:364} |
| {: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.lh < mem[curedges + 2].hh.lh) or (mem[h + 2].hh.rh > mem[curedges + 2].hh.rh)) or (mem[h + 1].hh.lh < mem[curedges + 1].hh.lh)) or (mem[h + 1].hh.rh > mem[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 begin {367:} |
| 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 <> 30000 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 > (-29999) 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 n < mem[h + 1].hh.lh do begin |
| n := n + 1; |
| p := mem[p].hh.rh |
| end; {368:} |
| repeat |
| qq := mem[pp + 1].hh.lh; |
| if qq > (-29999) then |
| if mem[p + 1].hh.lh <= (-29999) then |
| mem[p + 1].hh.lh := qq |
| else begin |
| while mem[qq].hh.rh > (-29999) 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 := -30000; |
| qq := mem[pp + 1].hh.rh; |
| if qq <> 30000 then begin |
| if mem[p + 1].hh.lh = (-29999) then |
| mem[p + 1].hh.lh := -30000; |
| mem[pp + 1].hh.rh := 30000; |
| r := p + 1; |
| q := mem[r].hh.rh; |
| if q = 30000 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 = 30000 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 <> 30000 do begin {370:} |
| m := mem[q].hh.lh + 32768; |
| n := n - (((m mod 8) - 4) * (m div 8)); |
| q := mem[q].hh.rh |
| end {:370}; |
| q := mem[p + 1].hh.lh; |
| while q > (-29999) do begin {370:} |
| m := mem[q].hh.lh + 32768; |
| 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 beginedgetracing; |
| begin |
| printdiagnostic(408, 155, true); |
| print(409); |
| printint(curwt); |
| printchar(41); |
| tracex := -4096 |
| end; { beginedgetracing } |
| |
| procedure traceacorner; |
| begin |
| if fileoffset > (maxprintline - 13) then |
| printnl(155); |
| printchar(40); |
| printint(tracex); |
| printchar(44); |
| printint(traceyy); |
| printchar(41); |
| tracey := traceyy |
| end; |
| |
| procedure endedgetracing; |
| begin |
| if tracex = (-4096) then |
| printnl(410) |
| else begin |
| traceacorner; |
| printchar(46) |
| end; |
| enddiagnostic(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 + 32768; |
| 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(155); |
| 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 ((n0 < n1) and (tracey > traceyy)) or ((n0 > n1) and (tracey < traceyy)) then |
| traceacorner |
| end; |
| traceyy := n1 |
| end; {:373} {374:} |
| |
| procedure lineedges(x0, y0, x1, y1: scaled); |
| label |
| 30, 31; |
| var |
| m0, n0, m1, n1: integer; |
| delx, dely: scaled; |
| yt: scaled; |
| tx: scaled; |
| p, r: halfword; |
| base: integer; |
| n: integer; |
| begin |
| n0 := roundunscaled(y0); |
| n1 := roundunscaled(y1); |
| if n0 <> n1 then begin |
| m0 := roundunscaled(x0); |
| m1 := roundunscaled(x1); |
| delx := x1 - x0; |
| dely := y1 - y0; |
| yt := (n0 * 65536) - 32768; |
| y0 := y0 - yt; |
| y1 := y1 - yt; |
| if n0 < n1 then begin {375:} |
| base := ((8 * mem[curedges + 3].hh.lh) - 32764) - curwt; |
| if m0 <= m1 then |
| edgeprep(m0, m1, n0, n1) |
| else |
| edgeprep(m1, m0, n0, n1); {377:} |
| n := mem[curedges + 5].hh.lh - 4096; |
| p := mem[curedges + 5].hh.rh; |
| if n <> n0 then |
| if n < n0 then |
| repeat |
| n := n + 1; |
| p := mem[p].hh.rh |
| until n = n0 |
| else |
| repeat |
| n := n - 1; |
| p := mem[p].hh.lh |
| until n = n0 {:377}; |
| y0 := 65536 - y0; |
| while true do begin |
| r := getavail; |
| mem[r].hh.rh := mem[p + 1].hh.lh; |
| mem[p + 1].hh.lh := r; |
| tx := takefraction(delx, makefraction(y0, dely)); |
| if abvscd(delx, y0, dely, tx) < 0 then |
| tx := tx - 1; |
| mem[r].hh.lh := (8 * roundunscaled(x0 + tx)) + base; |
| y1 := y1 - 65536; |
| if internal[10] > 0 then |
| tracenewedge(r, n); |
| if y1 < 65536 then |
| goto 30; |
| p := mem[p].hh.rh; |
| y0 := y0 + 65536; |
| n := n + 1 |
| end; |
| 30: {:375} |
| |
| end else begin {376:} |
| base := ((8 * mem[curedges + 3].hh.lh) - 32764) + 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 n < n0 then |
| repeat |
| n := n + 1; |
| p := mem[p].hh.rh |
| until n = n0 |
| else |
| repeat |
| n := n - 1; |
| p := mem[p].hh.lh |
| until n = n0 {:377}; |
| while true do begin |
| r := getavail; |
| mem[r].hh.rh := mem[p + 1].hh.lh; |
| mem[p + 1].hh.lh := r; |
| tx := takefraction(delx, makefraction(y0, dely)); |
| if abvscd(delx, y0, dely, tx) < 0 then |
| tx := tx + 1; |
| mem[r].hh.lh := (8 * roundunscaled(x0 - tx)) + base; |
| y1 := y1 + 65536; |
| if internal[10] > 0 then |
| tracenewedge(r, n); |
| if y1 >= 0 then |
| goto 31; |
| p := mem[p].hh.lh; |
| y0 := y0 + 65536; |
| n := n - 1 |
| end; |
| 31: {:376} |
| |
| end; |
| 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; |
| edgeandweight: integer; |
| j: integer; |
| n: integer; {sum:integer;} |
| {sum:=move[0]; |
| for k:=1 to delta do sum:=sum+abs(move[k]); |
| if sum<>m1-m0 then confusion(48);} |
| begin |
| delta := n1 - n0; |
| {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 n < n0 then |
| repeat |
| n := n + 1; |
| p := mem[p].hh.rh |
| until n = n0 |
| else |
| repeat |
| n := n - 1; |
| p := mem[p].hh.lh |
| until n = n0 {:377}; |
| if delta > 0 then begin |
| k := 0; |
| edgeandweight := ((8 * (m0 + mem[curedges + 3].hh.lh)) - 32764) - curwt; |
| repeat |
| edgeandweight := edgeandweight + (dx * move[k]); |
| begin |
| r := avail; |
| if r = (-30000) then |
| r := getavail |
| else begin |
| avail := mem[r].hh.rh; |
| mem[r].hh.rh := -30000 |
| end {dynused:=dynused+1;} |
| end; |
| mem[r].hh.rh := mem[p + 1].hh.lh; |
| mem[r].hh.lh := edgeandweight; |
| 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 n < n0 then |
| repeat |
| n := n + 1; |
| p := mem[p].hh.rh |
| until n = n0 |
| else |
| repeat |
| n := n - 1; |
| p := mem[p].hh.lh |
| until n = n0 {:377}; |
| if delta > 0 then begin |
| k := 0; |
| edgeandweight := ((8 * (m0 + mem[curedges + 3].hh.lh)) - 32764) + curwt; |
| repeat |
| edgeandweight := edgeandweight + (dx * move[k]); |
| begin |
| r := avail; |
| if r = (-30000) then |
| r := getavail |
| else begin |
| avail := mem[r].hh.rh; |
| mem[r].hh.rh := -30000 |
| end {dynused:=dynused+1;} |
| end; |
| mem[r].hh.rh := mem[p + 1].hh.lh; |
| mem[r].hh.lh := edgeandweight; |
| 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:} |
| edgeandweight := ((8 * (n0 + mem[curedges + 3].hh.lh)) - 32764) - curwt; |
| n0 := m0; |
| k := 0; |
| {377:} |
| n := mem[curedges + 5].hh.lh - 4096; |
| p := mem[curedges + 5].hh.rh; |
| if n <> n0 then |
| if n < n0 then |
| repeat |
| n := n + 1; |
| p := mem[p].hh.rh |
| until n = n0 |
| else |
| repeat |
| n := n - 1; |
| p := mem[p].hh.lh |
| until n = n0 {:377}; |
| repeat |
| j := move[k]; |
| while j > 0 do begin |
| begin |
| r := avail; |
| if r = (-30000) then |
| r := getavail |
| else begin |
| avail := mem[r].hh.rh; |
| mem[r].hh.rh := -30000 |
| end {dynused:=dynused+1;} |
| end; |
| mem[r].hh.rh := mem[p + 1].hh.lh; |
| mem[r].hh.lh := edgeandweight; |
| 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; |
| edgeandweight := edgeandweight + dx; |
| k := k + 1 |
| until k > delta; |
| goto 30 {:383}; |
| 63: {384:} |
| edgeandweight := ((8 * (n0 + mem[curedges + 3].hh.lh)) - 32764) + 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 n < n0 then |
| repeat |
| n := n + 1; |
| p := mem[p].hh.rh |
| until n = n0 |
| else |
| repeat |
| n := n - 1; |
| p := mem[p].hh.lh |
| until n = n0 {:377}; |
| repeat |
| j := move[k]; |
| while j > 0 do begin |
| begin |
| r := avail; |
| if r = (-30000) then |
| r := getavail |
| else begin |
| avail := mem[r].hh.rh; |
| mem[r].hh.rh := -30000 |
| end {dynused:=dynused+1;} |
| end; |
| mem[r].hh.rh := mem[p + 1].hh.lh; |
| mem[r].hh.lh := edgeandweight; |
| 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; |
| edgeandweight := edgeandweight + 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) = odd(octantafter) then |
| curx := x |
| else |
| curx := -x; |
| if (octantbefore > 2) = (octantafter > 2) then |
| cury := y |
| else |
| cury := -y |
| end; {:390} |
| {391:} |
| |
| function crossingpoint(a, b, c: integer): fraction; |
| label |
| 10; |
| var |
| d: integer; |
| x, xx, x0, x1, x2: integer; |
| begin |
| if a < 0 then begin |
| crossingpoint := 0; |
| goto 10 |
| end; |
| if c >= 0 then begin |
| if b >= 0 then |
| if c > 0 then begin |
| crossingpoint := 268435457; |
| goto 10 |
| end else if (a = 0) and (b = 0) then begin |
| crossingpoint := 268435457; |
| goto 10 |
| end else begin |
| crossingpoint := 268435456; |
| goto 10 |
| end; |
| if a = 0 then begin |
| crossingpoint := 0; |
| goto 10 |
| end |
| end else if a = 0 then |
| if b <= 0 then begin |
| crossingpoint := 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 |
| crossingpoint := 268435457; |
| goto 10 |
| end; |
| x1 := x; |
| d := (d + d) + 1 |
| end |
| end |
| until d >= 268435456; |
| crossingpoint := d - 268435456 {:392}; |
| 10: |
| |
| end; {:391} {394:} |
| |
| procedure printspec(s: strnumber); |
| label |
| 45, 30; |
| var |
| p, q: halfword; |
| octant: smallnumber; |
| begin |
| printdiagnostic(411, s, true); |
| p := curspec; |
| octant := mem[p + 3].int; |
| println; |
| unskew(mem[curspec + 1].int, mem[curspec + 2].int, octant); |
| printtwo(curx, cury); |
| print(412); |
| 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(423); |
| unskew(mem[p + 5].int, mem[p + 6].int, octant); |
| printtwo(curx, cury); |
| print(390); |
| unskew(mem[q + 3].int, mem[q + 4].int, octant); |
| printtwo(curx, cury); |
| printnl(387); |
| unskew(mem[q + 1].int, mem[q + 2].int, octant); |
| printtwo(curx, cury); |
| print(424); |
| 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(413) |
| end; |
| 30: |
| printnl(414); |
| enddiagnostic(true) |
| end; {:394} {398:} |
| |
| procedure printstrange(s: strnumber); |
| var |
| p: halfword; |
| f: halfword; |
| q: halfword; |
| t: integer; |
| begin |
| if interaction = 3 then |
| ; |
| printnl(62); {399:} |
| p := curspec; |
| t := 128; |
| repeat |
| p := mem[p].hh.rh; |
| if mem[p].hh.b0 <> 0 then begin |
| if mem[p].hh.b0 < t then |
| f := p; |
| t := mem[p].hh.b0 |
| end |
| until p = curspec {:399}; {400:} |
| p := curspec; |
| q := p; |
| repeat |
| p := mem[p].hh.rh; |
| if mem[p].hh.b0 = 0 then |
| q := p |
| until p = f {:400}; |
| t := 0; |
| repeat |
| if mem[p].hh.b0 <> 0 then begin |
| if mem[p].hh.b0 <> t then begin |
| t := mem[p].hh.b0; |
| printchar(32); |
| printint(t - 1) |
| end; |
| if q <> (-30000) then begin {401:} |
| if mem[mem[q].hh.rh].hh.b0 = 0 then begin |
| print(425); |
| 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 := -30000 |
| end |
| end else if q = (-30000) then |
| q := p; |
| p := mem[p].hh.rh |
| until p = f; |
| printchar(32); |
| printint(mem[p].hh.b0 - 1); |
| if q <> (-30000) then {401:} |
| if mem[mem[q].hh.rh].hh.b0 = 0 then begin |
| print(425); |
| 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 |
| ; |
| printnl(133); |
| print(s) |
| end |
| end; { printstrange } |
| {: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 quadrantsubdivide; |
| 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 begin {409:} |
| 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 := crossingpoint(del1, del2, del3); |
| if t < 268435456 then begin {411:} |
| 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].int < mem[p + 1].int then |
| mem[r + 1].int := mem[p + 1].int; |
| mem[r + 3].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 := crossingpoint(0, -del2, -del3); |
| if t < 268435456 then begin {412:} |
| splitcubic(r, t, destx, desty); |
| s := mem[r].hh.rh; |
| if mem[s + 1].int < destx then |
| mem[s + 1].int := destx; |
| if mem[s + 1].int < mem[r + 1].int then |
| mem[s + 1].int := mem[r + 1].int; |
| mem[s].hh.b1 := mem[p].hh.b1; |
| mem[s + 3].int := mem[s + 1].int; |
| mem[s + 1].int := -mem[s + 1].int; |
| mem[s + 5].int := mem[s + 1].int; |
| mem[q + 3].int := -mem[q + 3].int |
| end else if mem[r + 1].int > destx then {:412} |
| mem[r + 1].int := destx |
| end {:411} |
| end {:407}; |
| {413:} |
| pp := p; |
| repeat |
| qq := mem[pp].hh.rh; |
| abnegate(mem[qq + 1].int, mem[qq + 2].int, mem[qq].hh.b1, mem[pp].hh.b1); |
| destx := curx; |
| desty := cury; |
| del1 := mem[pp + 6].int - mem[pp + 2].int; |
| del2 := mem[qq + 4].int - mem[pp + 6].int; |
| del3 := desty - mem[qq + 4].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 begin |
| if del < 0 then begin {414:} |
| 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 := crossingpoint(del1, del2, del3); |
| if t < 268435456 then begin {415:} |
| 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 + 1].int > destx then |
| mem[r + 1].int := destx |
| else if mem[r + 1].int < mem[pp + 1].int then |
| mem[r + 1].int := mem[pp + 1].int; |
| if mem[r + 2].int < mem[pp + 2].int then |
| mem[r + 2].int := mem[pp + 2].int; |
| mem[r + 4].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 := crossingpoint(0, -del2, -del3); |
| if t < 268435456 then begin {416:} |
| splitcubic(r, t, destx, desty); |
| s := mem[r].hh.rh; |
| if mem[s + 1].int > destx then |
| mem[s + 1].int := destx |
| else if mem[s + 1].int < mem[r + 1].int then |
| mem[s + 1].int := mem[r + 1].int; |
| if mem[s + 2].int < desty then |
| mem[s + 2].int := desty; |
| if mem[s + 2].int < mem[r + 2].int then |
| mem[s + 2].int := mem[r + 2].int; |
| mem[s].hh.b1 := mem[pp].hh.b1; |
| mem[s + 4].int := mem[s + 2].int; |
| mem[s + 2].int := -mem[s + 2].int; |
| mem[s + 6].int := mem[s + 2].int; |
| mem[qq + 4].int := -mem[qq + 4].int |
| end else if mem[r + 2].int > desty then {:416} |
| mem[r + 2].int := desty |
| end {:415} |
| end else if constantx then begin {417:} |
| 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 begin {414:} |
| 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 begin {418:} |
| 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 octantsubdivide; |
| 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 begin {423:} |
| 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 := crossingpoint(del1, del2, del3); |
| if t < 268435456 then begin {424:} |
| 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[r + 2].int > desty then |
| mem[r + 2].int := desty |
| else if mem[r + 2].int < mem[p + 2].int then |
| mem[r + 2].int := mem[p + 2].int; |
| if mem[r + 1].int < mem[p + 1].int then |
| mem[r + 1].int := mem[p + 1].int; |
| mem[r + 3].int := mem[r + 1].int; |
| mem[r + 2].int := mem[r + 2].int + mem[r + 1].int; |
| mem[r + 1].int := -mem[r + 1].int; |
| mem[r + 5].int := mem[r + 1].int; |
| mem[r + 6].int := mem[r + 6].int - mem[r + 5].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; |
| del2 := del2 - takefraction(del2 - del3, t); |
| if del2 > 0 then |
| del2 := 0; |
| t := crossingpoint(0, -del2, -del3); |
| if t < 268435456 then begin {425:} |
| splitcubic(r, t, destx, desty); |
| s := mem[r].hh.rh; |
| if mem[s + 2].int > desty then |
| mem[s + 2].int := desty |
| else if mem[s + 2].int < mem[r + 2].int then |
| mem[s + 2].int := mem[r + 2].int; |
| if mem[s + 1].int < destx then |
| mem[s + 1].int := destx; |
| if mem[s + 1].int < mem[r + 1].int then |
| mem[s + 1].int := mem[r + 1].int; |
| mem[s].hh.b1 := mem[p].hh.b1; |
| mem[s + 3].int := mem[s + 1].int; |
| mem[s + 2].int := mem[s + 2].int + mem[s + 1].int; |
| mem[s + 1].int := -mem[s + 1].int; |
| mem[s + 6].int := mem[s + 6].int - mem[s + 1].int; |
| mem[s + 5].int := mem[s + 1].int; |
| mem[q + 4].int := mem[q + 4].int + mem[q + 3].int; |
| mem[q + 3].int := -mem[q + 3].int |
| end else if mem[r + 1].int > destx then {:425} |
| mem[r + 1].int := destx {:424} |
| end |
| end {:420}; |
| p := q |
| until p = curspec |
| end; {:419} {426:} |
| |
| procedure makesafe; |
| var |
| k: 0..maxwiggle; |
| allsafe: boolean; |
| nexta: scaled; |
| deltaa, deltab: scaled; |
| begin |
| before[curroundingptr] := before[0]; |
| nodetoround[curroundingptr] := nodetoround[0]; |
| repeat |
| after[curroundingptr] := after[0]; |
| allsafe := true; |
| nexta := after[0]; |
| for k := 0 to curroundingptr - 1 do begin |
| deltab := before[k + 1] - before[k]; |
| if deltab >= 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 = (curroundingptr - 1) then |
| after[0] := before[0] |
| else |
| after[k + 1] := before[k + 1] |
| end |
| end |
| until allsafe |
| end; {:426} {429:} |
| |
| procedure beforeandafter(b, a: scaled; p: halfword); |
| begin |
| if curroundingptr = maxroundingptr then |
| if maxroundingptr < maxwiggle then |
| maxroundingptr := maxroundingptr + 1 |
| else |
| overflow(435, maxwiggle); |
| after[curroundingptr] := a; |
| before[curroundingptr] := b; |
| nodetoround[curroundingptr] := p; |
| curroundingptr := curroundingptr + 1 |
| end; { beforeandafter } |
| {:429} |
| {431:} |
| |
| function goodval(b, o: scaled): scaled; |
| var |
| a: scaled; |
| begin |
| a := b + o; |
| if a >= 0 then |
| a := (a - (a mod curgran)) - o |
| else |
| a := (((a + ((-(a + 1)) mod curgran)) - curgran) + 1) - o; |
| if (b - a) < ((a + curgran) - b) then |
| goodval := a |
| else |
| goodval := a + curgran |
| end; {:431} {432:} |
| |
| function compromise(u, v: scaled): scaled; |
| begin |
| compromise := goodval(u + u, (-u) - v) div 2 |
| end; {:432} {433:} |
| |
| procedure xyround; |
| var |
| p, q: halfword; |
| b, a: scaled; |
| penedge: scaled; |
| alpha: fraction; |
| begin |
| curgran := abs(internal[37]); |
| if curgran = 0 then |
| curgran := 65536; |
| p := curspec; |
| curroundingptr := 0; |
| repeat |
| q := mem[p].hh.rh; {434:} |
| if odd(mem[p].hh.b1) <> odd(mem[q].hh.b1) then begin |
| if odd(mem[q].hh.b1) then |
| b := mem[q + 1].int |
| else |
| b := -mem[q + 1].int; |
| if (abs(mem[q + 1].int - mem[q + 5].int) < 655) or (abs(mem[q + 1].int + mem[q + 3].int) < 655) then begin {435:} |
| if curpen = (-29997) then |
| penedge := 0 |
| else if curpathtype = 0 then |
| penedge := compromise(mem[mem[curpen + 5].hh.rh + 2].int, mem[mem[curpen + 7].hh.rh + 2].int) |
| else if odd(mem[q].hh.b1) then |
| penedge := mem[mem[curpen + 7].hh.rh + 2].int |
| else |
| penedge := mem[mem[curpen + 5].hh.rh + 2].int; |
| a := goodval(b, penedge) |
| end else {:435} |
| a := b; |
| if abs(a) > maxallowed then |
| if a > 0 then |
| a := maxallowed |
| else |
| a := -maxallowed; |
| beforeandafter(b, a, q) |
| end {:434}; |
| p := q |
| until p = curspec; |
| if curroundingptr > 0 then begin {436:} |
| makesafe; |
| repeat |
| curroundingptr := curroundingptr - 1; |
| if (after[curroundingptr] <> before[curroundingptr]) or (after[curroundingptr + 1] <> before[curroundingptr + 1]) then begin |
| p := nodetoround[curroundingptr]; |
| if odd(mem[p].hh.b1) then begin |
| b := before[curroundingptr]; |
| a := after[curroundingptr] |
| end else begin |
| b := -before[curroundingptr]; |
| a := -after[curroundingptr] |
| end; |
| if before[curroundingptr] = before[curroundingptr + 1] then |
| alpha := 268435456 |
| else |
| alpha := makefraction(after[curroundingptr + 1] - after[curroundingptr], before[curroundingptr + 1] - before[curroundingptr]); |
| 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[curroundingptr + 1] |
| end |
| until curroundingptr = 0 |
| end {:436}; |
| p := curspec; |
| curroundingptr := 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 begin {438:} |
| if curpen = (-29997) 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 else {:438} |
| a := b; |
| if abs(a) > maxallowed then |
| if a > 0 then |
| a := maxallowed |
| else |
| a := -maxallowed; |
| beforeandafter(b, a, q) |
| end {:437}; |
| p := q |
| until p = curspec; |
| if curroundingptr > 0 then begin {439:} |
| makesafe; |
| repeat |
| curroundingptr := curroundingptr - 1; |
| if (after[curroundingptr] <> before[curroundingptr]) or (after[curroundingptr + 1] <> before[curroundingptr + 1]) then begin |
| p := nodetoround[curroundingptr]; |
| if mem[p].hh.b1 <= 2 then begin |
| b := before[curroundingptr]; |
| a := after[curroundingptr] |
| end else begin |
| b := -before[curroundingptr]; |
| a := -after[curroundingptr] |
| end; |
| if before[curroundingptr] = before[curroundingptr + 1] then |
| alpha := 268435456 |
| else |
| alpha := makefraction(after[curroundingptr + 1] - after[curroundingptr], before[curroundingptr + 1] - before[curroundingptr]); |
| 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[curroundingptr + 1] |
| end |
| until curroundingptr = 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; |
| curroundingptr := 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 begin {442:} |
| if curpen = (-29997) 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 else {:442} |
| a := b |
| else |
| a := b; |
| beforeandafter(b, a, q) |
| end {:441}; |
| p := q |
| until p = curspec; |
| if curroundingptr > 0 then begin {444:} |
| p := nodetoround[0]; |
| firstx := mem[p + 1].int; |
| firsty := mem[p + 2].int; {446:} |
| before[curroundingptr] := before[0]; |
| nodetoround[curroundingptr] := nodetoround[0]; |
| repeat |
| after[curroundingptr] := after[0]; |
| allsafe := true; |
| nexta := after[0]; |
| for k := 0 to curroundingptr - 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 (((aa < a) or (cc < c)) or ((aa - a) > (2 * (bb - b)))) or ((cc - c) > (2 * (dd - d))) then begin |
| allsafe := false; |
| after[k] := before[k]; |
| if k = (curroundingptr - 1) then |
| after[0] := before[0] |
| else |
| after[k + 1] := before[k + 1] |
| end |
| end |
| end |
| until allsafe {:446}; |
| for k := 0 to curroundingptr - 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, 426, 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 < 127 then |
| k := k + 1 |
| else |
| k := 1 |
| until p = curspec; |
| if chopped then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(430) |
| end; |
| begin |
| helpptr := 4; |
| helpline[3] := 431; |
| helpline[2] := 432; |
| helpline[1] := 433; |
| helpline[0] := 434 |
| end; |
| putgeterror |
| end {:404}; |
| quadrantsubdivide; |
| if internal[36] > 0 then |
| xyround; |
| octantsubdivide; |
| 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:} |
| turningnumber := 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 begin {452:} |
| 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: |
| begin {454:} {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 o2 < o1 then |
| o2 := o1; |
| if odd(o2) then |
| mem[p + 6].int := 0 |
| else |
| mem[p + 6].int := 1 |
| end else begin |
| if o1 = 8 then |
| turningnumber := turningnumber + 1 |
| else |
| turningnumber := turningnumber - 1; |
| mem[p + 6].int := 0 |
| end; |
| mem[s + 4].int := mem[p + 6].int; |
| p := s |
| until p = q {:459} |
| end {:452}; |
| p := q; |
| q := r |
| until p = curspec; {:450} |
| while mem[curspec].hh.b0 <> 0 do |
| curspec := mem[curspec].hh.rh; |
| if tracing > 0 then |
| if internal[36] <= 0 then |
| printspec(427) |
| else if internal[36] > 65536 then |
| printspec(428) |
| else |
| printspec(429); |
| makespec := curspec |
| end; { makespec } |
| {:402} |
| {463:} |
| |
| procedure endround(x, y: scaled); |
| begin |
| y := (y + 32768) - ycorr[octant]; |
| x := (x + y) - xcorr[octant]; |
| m1 := floorunscaled(x); |
| n1 := floorunscaled(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 |
| beginedgetracing; |
| p := h; |
| {------------------------------------} |
| print_start(psfile); { Start cycle } |
| {------------------------------------} |
| 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(407, 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],465,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; |
| {------------------------------------} |
| print_end(psfile); { End cycle } |
| {------------------------------------} |
| tossknotlist(h); |
| if internal[10] > 0 then |
| endedgetracing |
| 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; {479:} |
| begin |
| 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 mc < abs(mem[h + 2].int) then |
| mc := abs(mem[h + 2].int) |
| end else begin |
| o := 0; |
| hh := -30000; |
| while true do begin |
| s := mem[r].hh.rh; |
| if mc < abs(mem[r + 1].int) then |
| mc := abs(mem[r + 1].int); |
| if mc < abs(mem[r + 2].int) then |
| mc := abs(mem[r + 2].int); |
| dx := mem[r + 1].int - mem[q + 1].int; |
| dy := mem[r + 2].int - mem[q + 2].int; |
| if dx = 0 then |
| if dy = 0 then |
| goto 45; |
| if abvscd(dx, mem[s + 2].int - mem[r + 2].int, dy, mem[s + 1].int - mem[r + 1].int) < 0 then |
| goto 45; {480:} |
| if dx > 0 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 dx < dy then |
| octant := octant + 4 {:480}; |
| mem[q].hh.b1 := octant; |
| oo := octantnumber[octant]; |
| if o > oo then begin |
| if hh <> (-30000) then |
| goto 45; |
| hh := q |
| end; |
| o := oo; |
| if (q = h) and (hh <> (-30000)) then |
| goto 30; |
| q := r; |
| r := s |
| end; |
| 30: {:479} |
| |
| end; |
| if mc >= 268402688 then |
| goto 45; |
| p := getnode(10); |
| q := hh; |
| mem[p + 9].int := mc; |
| mem[p].hh.lh := -30000; |
| if mem[q].hh.rh <> q then |
| mem[p].hh.rh := -29999; |
| for k := 1 to 8 do begin {481:} |
| 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 {482:} |
| else 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; |
| {: |
| 483} |
| if mem[r + 1].int <> mem[mem[r].hh.lh + 1].int then |
| dupoffset(r) |
| else |
| n := n - 1; |
| if n >= 127 then |
| overflow(446, 127); |
| mem[h].hh.lh := n |
| end {:481}; |
| goto 40; |
| 45: |
| p := -29997; {478:} |
| if mc >= 268402688 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(440) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 441; |
| helpline[0] := 442 |
| end |
| end else begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(443) |
| end; |
| begin |
| helpptr := 3; |
| helpline[2] := 444; |
| helpline[1] := 445; |
| helpline[0] := 442 |
| end |
| end; {:478} |
| putgeterror; |
| 40: |
| if internal[6] > 0 then |
| printpen(p, 439, 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 := 29999; |
| 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 begin {485:} |
| 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 = 29999 then begin |
| w := mem[penhead + 1].hh.rh; |
| p := trivialknot(mem[w + 1].int + mem[w + 2].int, mem[w + 2].int); |
| mem[29999].hh.rh := p |
| end; |
| mem[p].hh.rh := mem[29999].hh.rh; |
| makepath := mem[29999].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; {489:} |
| begin |
| 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 splitforoffset(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].int < mem[p + 2].int then |
| mem[r + 2].int := mem[p + 2].int |
| else if mem[r + 2].int > mem[q + 2].int then |
| mem[r + 2].int := mem[q + 2].int; |
| if mem[r + 1].int < mem[p + 1].int then |
| mem[r + 1].int := mem[p + 1].int |
| else if mem[r + 1].int > mem[q + 1].int then |
| mem[r + 1].int := mem[q + 1].int |
| end; {:493} {497:} |
| |
| procedure finoffsetprep(p: halfword; k: halfword; w: halfword; x0, x1, x2, y0, y1, y2: integer; rising: boolean; n: integer); |
| label |
| 10; |
| var |
| q, ww: halfword; |
| du, dv: scaled; |
| t0, t1, t2: integer; |
| t: fraction; |
| s: fraction; |
| v: integer; |
| begin |
| while true do begin |
| q := mem[p].hh.rh; |
| 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 := crossingpoint(t0, t1, t2); |
| if t >= 268435456 then |
| goto 10; {499:} |
| begin |
| splitforoffset(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 := crossingpoint(0, -t1, -t2); |
| if t < 268435456 then begin |
| splitforoffset(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 < 268435456 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:} |
| finoffsetprep(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 := crossingpoint(-t0, -t1, -t2) |
| end; |
| if t >= 268435456 then |
| finoffsetprep(p, k, w, x0, x1, x2, y0, y1, y2, true, n) |
| else begin |
| splitforoffset(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); |
| finoffsetprep(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 := crossingpoint(0, t1, t2); |
| if t < 268435456 then begin {504:} |
| splitforoffset(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); |
| finoffsetprep(mem[r].hh.rh, k, w, x0a, x1a, x2, y0a, y1a, y2, true, n); |
| x2 := x0a; |
| y2 := y0a |
| end {:504}; |
| finoffsetprep(r, k - 1, ww, -x0, -x1, -x2, -y0, -y1, -y2, false, n) |
| end {:503} |
| end; |
| 45: {:494} |
| |
| end; {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; { offsetprep } |
| {:491} |
| {506:} |
| {510:} |
| |
| procedure skewlineedges(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; |
| {-------------------------------------} |
| sendline(x0,y0,x1,y1,octant,510); |
| {-------------------------------------} |
| unskew(x0, y0, octant); |
| x0 := curx; |
| y0 := cury; |
| unskew(x1, y1, octant); |
| {if internal[10]>65536 then begin printnl(451);printtwo(x0,y0); |
| print(450);printtwo(curx,cury);printnl(155);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} {519:} |
| begin |
| k := mem[h].hh.lh + 1; |
| ww := mem[h].hh.rh; |
| w := mem[ww].hh.lh; |
| mm0 := floorunscaled((mem[p + 1].int + mem[w + 1].int) - xycorr[octant]); |
| mm1 := floorunscaled((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 begin {521:} |
| 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(452);printint(k);print(453); |
| unskew(xx,yy-32768,octant);printtwo(curx,cury);end;} |
| {------------} |
| my_xx := xx; |
| my_yy := yy; |
| {------------} |
| if mem[r].hh.b1 < k then 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; |
| if yp <> yy then begin {522:} |
| 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 m < envmove[moveptr] then |
| envmove[moveptr] := m; |
| tx := takefraction(delx, makefraction(yy, dely)); |
| if (abvscd(tx, dely, delx, yy) + xycorr[octant]) > 0 then |
| tx := tx - 1; |
| m := floorunscaled(xx + tx); |
| ty := ty - 65536; |
| moveptr := moveptr + 1; |
| if ty < 65536 then |
| goto 31; |
| yy := yy + 65536 |
| end; |
| 31: |
| if m < envmove[moveptr] then |
| envmove[moveptr] := m |
| end |
| end {:522} |
| end else 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; |
| end; |
| {if internal[10]>65536 then begin print(450);unskew(xp,yp-32768,octant); |
| printtwo(curx,cury);printnl(155);end;} |
| {---------------------------------------------------} |
| sendline(my_xx,my_yy-32768,xp,yp-32768,octant,521); |
| {---------------------------------------------------} |
| m := floorunscaled(xp - xycorr[octant]); |
| moveptr := floorunscaled(yp - ycorr[octant]) - n0; |
| if m < envmove[moveptr] then |
| envmove[moveptr] := m |
| end {:521}; |
| 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],518,octant); {520:} |
| repeat |
| if m < envmove[n] then |
| envmove[n] := m; |
| m := (m + move[n]) - 1; |
| n := n + 1 |
| until n > moveptr {: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; |
| skewlineedges(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 |
| beginedgetracing; |
| {------------------------------------} |
| print_start(psfile); { Start cycle } |
| {------------------------------------} |
| 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(447); |
| print(octantdir[octant]);print(425);printint(mem[h].hh.lh);print(448); |
| if mem[h].hh.lh<>1 then printchar(115);print(449); |
| 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(450); |
| 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 |
| skewlineedges(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(407, 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 := floorunscaled((mem[p + 1].int + mem[w + 1].int) - xycorr[octant]); |
| mm1 := floorunscaled((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 begin {515:} |
| 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(452);printint(k);print(453); |
| unskew(xx,yy-32768,octant);printtwo(curx,cury);end;} |
| {------------} |
| my_xx := xx; |
| my_yy := yy; |
| {------------} |
| 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 begin {516:} |
| 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 := floorunscaled(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(450);unskew(xp,yp-32768,octant); |
| printtwo(curx,cury);printnl(155);end;} |
| {---------------------------------------------------} |
| sendline(my_xx,my_yy-32768,xp,yp-32768,octant,515); |
| {---------------------------------------------------} |
| m := floorunscaled(xp - xycorr[octant]); |
| moveptr := floorunscaled(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],512,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; |
| skewlineedges(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; |
| {------------------------------------} |
| print_end(psfile); { End cycle } |
| {------------------------------------} |
| if internal[10] > 0 then |
| endedgetracing; |
| 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; {528:} |
| begin {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 := -30000 |
| 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; |
| d := takefraction(d, delta); |
| alpha := abs(u); |
| beta := abs(v); |
| if alpha < beta then begin |
| delta := alpha; |
| alpha := beta; |
| beta := delta |
| end; |
| if internal[38] <> 0 then |
| d := d - takefraction(internal[38], beta + beta); |
| d := (d + 4) div 8; |
| alpha := alpha div 32768; |
| if d < alpha then |
| d := alpha {:533}; |
| delta := c - d; |
| if delta > 0 then begin |
| if delta > mem[r + 4].int then |
| delta := mem[r + 4].int; |
| if delta >= mem[q + 4].int then begin {534:} |
| 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 else begin {:534} {535:} |
| 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 = (-30000) 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 = (-30000) 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 begin {536:} |
| s := -30000; |
| 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 <> (-30000) 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 finddirectiontime(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} {540:} |
| begin |
| if abs(x) < abs(y) then begin |
| x := makefraction(x, abs(y)); |
| if y > 0 then |
| y := 268435456 |
| else |
| y := -268435456 |
| end else if x = 0 then begin |
| finddirectiontime := 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; |
| {: |
| 544} |
| if theta <= 0 then |
| if phi >= 0 then |
| if phi <= (theta + 188743680) then |
| goto 40; |
| 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 begin {548:} |
| 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 begin {549:} |
| t := crossingpoint(-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 else if x3 >= 0 then begin {:549} |
| 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 := crossingpoint(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 := crossingpoint(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: |
| finddirectiontime := -65536; |
| goto 10; |
| 40: |
| finddirectiontime := n + tt; |
| 10: |
| |
| end; {:539} {556:} |
| |
| procedure cubicintersection(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] < bisectstack[bisectptr - 5] then |
| bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5]; |
| bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]; |
| if bisectstack[bisectptr - 2] > 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] < bisectstack[bisectptr - 10] then |
| bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10]; |
| bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]; |
| if bisectstack[bisectptr - 7] > 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] < bisectstack[bisectptr - 15] then |
| bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15]; |
| bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]; |
| if bisectstack[bisectptr - 12] > 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] < bisectstack[bisectptr - 20] then |
| bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20]; |
| bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]; |
| if bisectstack[bisectptr - 17] > 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] < bisectstack[bisectptr - 25] then |
| bisectstack[bisectptr - 21] := bisectstack[bisectptr - 25]; |
| bisectstack[bisectptr - 22] := bisectstack[bisectptr - 25] + bisectstack[bisectptr - 24]; |
| if bisectstack[bisectptr - 22] > 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] < bisectstack[bisectptr - 5] then |
| bisectstack[bisectptr - 1] := bisectstack[bisectptr - 5]; |
| bisectstack[bisectptr - 2] := bisectstack[bisectptr - 5] + bisectstack[bisectptr - 4]; |
| if bisectstack[bisectptr - 2] > 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] < bisectstack[bisectptr - 30] then |
| bisectstack[bisectptr - 26] := bisectstack[bisectptr - 30]; |
| bisectstack[bisectptr - 27] := bisectstack[bisectptr - 30] + bisectstack[bisectptr - 29]; |
| if bisectstack[bisectptr - 27] > 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] < bisectstack[bisectptr - 10] then |
| bisectstack[bisectptr - 6] := bisectstack[bisectptr - 10]; |
| bisectstack[bisectptr - 7] := bisectstack[bisectptr - 10] + bisectstack[bisectptr - 9]; |
| if bisectstack[bisectptr - 7] > 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] < bisectstack[bisectptr - 35] then |
| bisectstack[bisectptr - 31] := bisectstack[bisectptr - 35]; |
| bisectstack[bisectptr - 32] := bisectstack[bisectptr - 35] + bisectstack[bisectptr - 34]; |
| if bisectstack[bisectptr - 32] > 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] < bisectstack[bisectptr - 15] then |
| bisectstack[bisectptr - 11] := bisectstack[bisectptr - 15]; |
| bisectstack[bisectptr - 12] := bisectstack[bisectptr - 15] + bisectstack[bisectptr - 14]; |
| if bisectstack[bisectptr - 12] > 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] < bisectstack[bisectptr - 40] then |
| bisectstack[bisectptr - 36] := bisectstack[bisectptr - 40]; |
| bisectstack[bisectptr - 37] := bisectstack[bisectptr - 40] + bisectstack[bisectptr - 39]; |
| if bisectstack[bisectptr - 37] > 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] < bisectstack[bisectptr - 20] then |
| bisectstack[bisectptr - 16] := bisectstack[bisectptr - 20]; |
| bisectstack[bisectptr - 17] := bisectstack[bisectptr - 20] + bisectstack[bisectptr - 19]; |
| if bisectstack[bisectptr - 17] > 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 begin {561:} |
| 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 else begin {:561} |
| 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 pathintersection(h, hh: halfword); |
| label |
| 10; |
| var |
| p, pp: halfword; |
| n, nn: integer; {563:} |
| begin |
| 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 |
| cubicintersection(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} {574:} |
| |
| procedure openawindow(k: windownumber; r0, c0, r1, c1: scaled; x, y: scaled); |
| var |
| m, n: integer; {575:} |
| begin |
| if r0 < 0 then |
| r0 := 0 |
| else |
| r0 := roundunscaled(r0); |
| r1 := roundunscaled(r1); |
| if r1 > screendepth then |
| r1 := screendepth; |
| if r1 < r0 then |
| if r0 > screendepth then |
| r0 := r1 |
| else |
| r1 := r0; |
| if c0 < 0 then |
| c0 := 0 |
| else |
| c0 := roundunscaled(c0); |
| c1 := roundunscaled(c1); |
| if c1 > screenwidth then |
| c1 := screenwidth; |
| if c1 < c0 then |
| if c0 > screenwidth 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 := roundunscaled(x); |
| n := roundunscaled(y) - 1; |
| mwindow[k] := c0 - m; |
| nwindow[k] := r0 + n {:576}; |
| begin |
| if not screenstarted then begin |
| screenOK := initscreen; |
| screenstarted := true |
| end |
| end; |
| if screenOK then begin |
| blankrectangle(c0, c1, r0, r1); |
| updatescreen |
| end |
| end; { openawindow } |
| {: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] < rightcol[k] then |
| if toprow[k] < botrow[k] then begin |
| alreadythere := false; |
| if mem[curedges + 3].hh.rh = k then |
| if mem[curedges + 4].int = windowtime[k] then |
| alreadythere := true; |
| if not alreadythere then |
| blankrectangle(leftcol[k], rightcol[k], toprow[k], botrow[k]); {581:} |
| madjustment := mwindow[k] - mem[curedges + 3].hh.lh; |
| rightedge := 8 * (rightcol[k] - madjustment); |
| mincol := leftcol[k] {:581}; |
| p := mem[curedges].hh.rh; |
| r := nwindow[k] - (mem[curedges + 1].hh.lh - 4096); |
| while (p <> curedges) and (r >= toprow[k]) do begin |
| if r < botrow[k] then begin {578:} |
| if mem[p + 1].hh.lh > (-29999) then |
| sortedges(p) |
| else if mem[p + 1].hh.lh = (-29999) then |
| if alreadythere then |
| goto 30; |
| mem[p + 1].hh.lh := -29999; {582:} |
| n := 0; |
| ww := 0; |
| m := -1; |
| w := 0; |
| q := mem[p + 1].hh.rh; |
| rowtransition[0] := mincol; |
| while true do begin |
| if q = 30000 then |
| d := rightedge |
| else |
| d := mem[q].hh.lh + 32768; |
| 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; |
| rowtransition[n] := m |
| end |
| end else if ww <= 0 then |
| if m > mincol then begin |
| if n = 0 then |
| b := 1; |
| n := n + 1; |
| rowtransition[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; |
| rowtransition[n] := rightcol[k] |
| end else if n = 0 then |
| goto 30 {:584}; {:582} |
| paintrow(r, b, rowtransition, n); |
| 30: {:578} |
| |
| end; |
| 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 <> (-30000) 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 := 29999; |
| pp := mem[p].hh.lh; |
| qq := mem[q].hh.lh; |
| while true do |
| if pp = qq then |
| if pp = (-30000) then |
| goto 30 {598:} |
| else 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) < threshold then |
| freenode(s, 2) |
| else begin |
| 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].int < mem[qq + 1].int then begin |
| s := getnode(2); |
| mem[s].hh.lh := qq; |
| mem[s + 1].int := mem[q + 1].int; |
| q := mem[q].hh.rh; |
| qq := mem[q].hh.lh; |
| mem[r].hh.rh := s; |
| r := s |
| end else begin |
| mem[r].hh.rh := p; |
| r := p; |
| p := mem[p].hh.rh; |
| pp := mem[p].hh.lh |
| end; |
| 30: |
| mem[p + 1].int := slowadd(mem[p + 1].int, mem[q + 1].int); |
| mem[r].hh.rh := p; |
| depfinal := p; |
| pplusq := mem[29999].hh.rh |
| end; {:597} {599:} |
| |
| function ptimesv(p: halfword; v: integer; t0, t1: smallnumber; visscaled: boolean): halfword; |
| var |
| r, s: halfword; |
| w: integer; |
| threshold: integer; |
| scalingdown: boolean; |
| begin |
| if t0 <> t1 then |
| scalingdown := true |
| else |
| scalingdown := not visscaled; |
| if t1 = 17 then |
| threshold := 1342 |
| else |
| threshold := 4; |
| r := 29999; |
| while mem[p].hh.lh <> (-30000) 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[29999].hh.rh |
| end; {:599} |
| {601:} |
| |
| function pwithxbecomingq(p, x, q: halfword; t: smallnumber): halfword; |
| var |
| r, s: halfword; |
| v: integer; |
| sx: integer; |
| begin |
| s := p; |
| r := 29999; |
| 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 |
| pwithxbecomingq := p |
| else begin |
| mem[29999].hh.rh := p; |
| mem[r].hh.rh := mem[s].hh.rh; |
| v := mem[s + 1].int; |
| freenode(s, 2); |
| pwithxbecomingq := pplusfq(mem[29999].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 := -29987; |
| r := mem[-29987].hh.rh; |
| mem[depfinal].hh.rh := r; |
| mem[r + 1].hh.lh := depfinal; |
| mem[-29987].hh.rh := q |
| end; {:606} {607:} |
| |
| function constdependency(v: scaled): halfword; |
| begin |
| depfinal := getnode(2); |
| mem[depfinal + 1].int := v; |
| mem[depfinal].hh.lh := -30000; |
| constdependency := depfinal |
| end; {:607} {608:} |
| |
| function singledependency(p: halfword): halfword; |
| var |
| q: halfword; |
| m: integer; |
| begin |
| m := mem[p + 1].int mod 64; |
| if m > 28 then |
| singledependency := constdependency(0) |
| else begin |
| q := getnode(2); |
| mem[q + 1].int := twotothe[28 - m]; |
| mem[q].hh.lh := p; |
| mem[q].hh.rh := constdependency(0); |
| singledependency := 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 = (-30000) 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; {611:} |
| begin |
| q := p; |
| r := mem[p].hh.rh; |
| v := mem[q + 1].int; |
| while mem[r].hh.lh <> (-30000) 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 := 29999; |
| 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 = (-30000); |
| 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[29999].hh.rh {:612}; |
| if internal[2] > 0 then {613:} |
| if interesting(x) then begin |
| begindiagnostic; |
| printnl(462); |
| printvariablename(x); |
| w := n; |
| while w > 0 do begin |
| print(455); |
| w := w - 2 |
| end; |
| printchar(61); |
| printdependency(p, 17); |
| enddiagnostic(false) |
| end {:613}; |
| {614:} |
| prevr := -29987; |
| r := mem[-29987].hh.rh; |
| while r <> (-29987) do begin |
| s := mem[r + 1].hh.rh; |
| q := pwithxbecomingq(s, x, p, mem[r].hh.b0); |
| if mem[q].hh.lh = (-30000) then |
| makeknown(r, q) |
| else begin |
| mem[r + 1].hh.rh := q; |
| repeat |
| q := mem[q].hh.rh |
| until mem[q].hh.lh = (-30000); |
| prevr := q |
| end; |
| r := mem[prevr].hh.rh |
| end {:614}; {615:} |
| if n > 0 then begin {616:} |
| s := 29999; |
| mem[29999].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 <> (-30000)) 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 = (-30000); |
| p := mem[29999].hh.rh |
| end {:616}; |
| if mem[p].hh.lh = (-30000) 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 |
| fixdependencies |
| 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 = (-30000) 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 |
| ; |
| printnl(133); |
| print(465) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 466; |
| helpline[0] := 467 |
| 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 |
| begindiagnostic; |
| printnl(123); |
| printcmdmod(c, m); |
| printchar(125); |
| enddiagnostic(false) |
| end; {:626} {635:} |
| |
| procedure showcontext; |
| label |
| 30; |
| var |
| oldsetting: 0..5; {641:} |
| i: 0..bufsize; |
| l: integer; |
| m: integer; |
| n: 0..errorline; |
| p: integer; |
| q: integer; {:641} |
| begin |
| fileptr := inputptr; |
| inputstack[fileptr] := curinput; |
| while true do begin |
| curinput := inputstack[fileptr]; {636:} |
| if (((fileptr = inputptr) or (curinput.indexfield <= 6)) or (curinput.indexfield <> 10)) or (curinput.locfield <> (-30000)) then begin |
| tally := 0; |
| oldsetting := selector; |
| if curinput.indexfield <= 6 then begin {637:} |
| if curinput.namefield <= 1 then |
| if (curinput.namefield = 0) and (fileptr = 0) then |
| printnl(469) |
| else |
| printnl(470) |
| else if curinput.namefield = 2 then |
| printnl(471) |
| else begin |
| printnl(472); |
| printint(line) |
| 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) - halferrorline; |
| if trickcount < errorline then |
| trickcount := errorline |
| end; |
| print(buffer[i]) |
| end {:644} |
| end else begin {638:} |
| if curinput.indexfield in |
| [7, 8, 9, 10, 11, 12] then |
| case curinput.indexfield of |
| 7: |
| printnl(473); |
| 8: |
| begin {639:} |
| printnl(478); |
| p := paramstack[curinput.limitfield]; |
| if p <> (-30000) then |
| if mem[p].hh.rh = (-29999) then |
| printexp(p, 0) |
| else |
| showtokenlist(p, -30000, 20, tally); |
| print(479) |
| end; {:639} |
| 9: |
| printnl(474); |
| 10: |
| if curinput.locfield = (-30000) then |
| printnl(475) |
| else |
| printnl(476); |
| 11: |
| printnl(477); |
| 12: |
| begin |
| println; |
| if curinput.namefield <> (-30000) then |
| print(hash[curinput.namefield].rh) {640:} |
| else begin |
| p := paramstack[curinput.limitfield]; |
| if p = (-30000) then |
| showtokenlist(paramstack[curinput.limitfield + 1], -30000, 20, tally) |
| else begin |
| q := p; |
| while mem[q].hh.rh <> (-30000) do |
| q := mem[q].hh.rh; |
| mem[q].hh.rh := paramstack[curinput.limitfield + 1]; |
| showtokenlist(p, -30000, 20, tally); |
| mem[q].hh.rh := -30000 |
| end |
| end {:640}; |
| print(368) |
| end |
| end |
| else |
| printnl(63) {:638}; {645:} |
| begin |
| l := tally; |
| tally := 0; |
| selector := 4; |
| trickcount := 1000000 |
| end; |
| if curinput.indexfield <> 12 then |
| showtokenlist(curinput.startfield, curinput.locfield, 100000, 0) |
| else |
| showmacro(curinput.startfield, curinput.locfield, 100000) {:645} |
| end; |
| selector := oldsetting; {643:} |
| if trickcount = 1000000 then begin |
| firstcount := tally; |
| trickcount := ((tally + 1) + errorline) - halferrorline; |
| if trickcount < errorline then |
| trickcount := errorline |
| end; |
| if tally < trickcount then |
| m := tally - firstcount |
| else |
| m := trickcount - firstcount; |
| if (l + firstcount) <= halferrorline then begin |
| p := 0; |
| n := l + firstcount |
| end else begin |
| print(146); |
| p := ((l + firstcount) - halferrorline) + 3; |
| n := halferrorline |
| end; |
| for q := p to firstcount - 1 do |
| printchar(trickbuf[q mod errorline]); |
| println; |
| for q := 1 to n do |
| printchar(32); |
| if (m + n) <= errorline then |
| p := firstcount + m |
| else |
| p := firstcount + ((errorline - n) - 3); |
| for q := firstcount to p - 1 do |
| printchar(trickbuf[q mod errorline]); |
| if (m + n) > errorline then |
| print(146) {: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] |
| end; { showcontext } |
| {:635} |
| {649:} |
| |
| procedure begintokenlist(p: halfword; t: quarterword); |
| begin |
| begin |
| if inputptr > maxinstack then begin |
| maxinstack := inputptr; |
| if inputptr = stacksize then |
| overflow(480, 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 |
| flushtokenlist(curinput.startfield); |
| goto 30 |
| end else |
| deletemacref(curinput.startfield); |
| while paramptr > curinput.limitfield do begin |
| paramptr := paramptr - 1; |
| p := paramstack[paramptr]; |
| if p <> (-30000) then |
| if mem[p].hh.rh = (-29999) then begin |
| recyclevalue(p); |
| freenode(p, 2) |
| end else |
| flushtokenlist(p) |
| end; |
| 30: |
| begin |
| inputptr := inputptr - 1; |
| curinput := inputstack[inputptr] |
| end; |
| begin |
| if interrupt <> 0 then |
| pauseforinstructions |
| 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; { encapsulate } |
| {: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 := singledependency(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; |
| if curtype in |
| [1, 2, 16, 3, 5, 7, 12, 10, |
| 4, 6, 11, 9, 8, 13, 14, 17, |
| 18, 15, 19] then |
| 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: |
| begin {857:} |
| if mem[p + 1].int = (-30000) 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 := singledependency(p); |
| if q = depfinal then begin |
| curtype := 16; |
| curexp := 0; |
| freenode(q, 2) |
| end else begin |
| curtype := 17; |
| encapsulate(q) |
| end |
| end |
| end |
| else |
| confusion(664) |
| 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 := -30000; |
| 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 = (-30000) then |
| p := getavail |
| else begin |
| avail := mem[p].hh.rh; |
| mem[p].hh.rh := -30000 |
| end {dynused:=dynused+1;} |
| end; |
| mem[p].hh.lh := cursym |
| end; |
| curtok := p |
| end; {:651} {652:} |
| |
| procedure backinput; |
| var |
| p: halfword; |
| s: 0..150; |
| begin |
| p := curtok; |
| while (curinput.indexfield > 6) and (curinput.locfield = (-30000)) do |
| endtokenlist; |
| begintokenlist(p, 10) |
| end; {:652} {653:} |
| |
| procedure backerror; |
| begin |
| OKtointerrupt := false; |
| backinput; |
| OKtointerrupt := true; |
| error |
| end; { backerror } |
| |
| procedure inserror; |
| begin |
| OKtointerrupt := false; |
| backinput; |
| curinput.indexfield := 11; |
| OKtointerrupt := true; |
| error |
| end; {:653} {654:} |
| |
| procedure beginfilereading; |
| begin |
| if inopen = 6 then |
| overflow(481, 6); |
| if first = bufsize then |
| overflow(128, bufsize); |
| inopen := inopen + 1; |
| begin |
| if inputptr > maxinstack then begin |
| maxinstack := inputptr; |
| if inputptr = stacksize then |
| overflow(480, 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 endfilereading; |
| begin |
| first := curinput.startfield; |
| line := linestack[curinput.indexfield]; |
| if curinput.indexfield <> inopen then |
| confusion(482); |
| if curinput.namefield > 2 then |
| aclose(inputfile[curinput.indexfield]); |
| begin |
| inputptr := inputptr - 1; |
| curinput := inputstack[inputptr] |
| end; |
| inopen := inopen - 1 |
| end; {:655} {656:} |
| |
| procedure clearforerrorprompt; |
| begin |
| while (((curinput.indexfield <= 6) and (curinput.namefield = 0)) and (inputptr > 0)) and (curinput.locfield = curinput.limitfield) do |
| endfilereading; |
| println |
| end; {:656} {661:} |
| |
| function checkoutervalidity: boolean; |
| var |
| p: halfword; |
| begin |
| if scannerstatus = 0 then |
| checkoutervalidity := true |
| else begin |
| deletionsallowed := false; {662:} |
| if cursym <> 0 then begin |
| p := getavail; |
| mem[p].hh.lh := cursym; |
| begintokenlist(p, 10) |
| end {:662}; |
| if scannerstatus > 1 then begin {663:} |
| runaway; |
| if cursym = 0 then begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(488) |
| end else begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(489) |
| end |
| end; |
| print(490); |
| begin |
| helpptr := 4; |
| helpline[3] := 491; |
| helpline[2] := 492; |
| helpline[1] := 493; |
| helpline[0] := 494 |
| end; |
| case scannerstatus of {664:} |
| 2: |
| begin |
| print(495); |
| helpline[3] := 496; |
| cursym := 2235 |
| end; |
| 3: |
| begin |
| print(497); |
| helpline[3] := 498; |
| if warninginfo = 0 then |
| cursym := 2239 |
| else begin |
| cursym := 2231; |
| eqtb[2231].rh := warninginfo |
| end |
| end; |
| 4, 5: |
| begin |
| print(499); |
| if scannerstatus = 5 then |
| print(hash[warninginfo].rh) |
| else |
| printvariablename(warninginfo); |
| cursym := 2237 |
| end; |
| 6: |
| begin |
| print(500); |
| print(hash[warninginfo].rh); |
| print(501); |
| helpline[3] := 502; |
| cursym := 2236 |
| end |
| end {:664}; |
| inserror |
| end else begin {:663} |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(483) |
| end; |
| printint(warninginfo); |
| begin |
| helpptr := 3; |
| helpline[2] := 484; |
| helpline[1] := 485; |
| helpline[0] := 486 |
| end; |
| if cursym = 0 then |
| helpline[2] := 487; |
| cursym := 2238; |
| inserror |
| end; |
| deletionsallowed := true; |
| checkoutervalidity := false |
| end |
| end; {:661} {666:} |
| |
| procedure firmuptheline; |
| 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 begin {669:} |
| 25: |
| c := buffer[curinput.locfield]; |
| curinput.locfield := curinput.locfield + 1; |
| class := charclass[c]; |
| if class in |
| [0, 1, 2, 3, 4, 5, 6, 7, |
| 8, 20] then |
| 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 begin {681:} |
| line := line + 1; |
| first := curinput.startfield; |
| if not forceeof then begin |
| if inputln(inputfile[curinput.indexfield], true) then |
| firmuptheline |
| else |
| forceeof := true |
| end; |
| if forceeof then begin |
| printchar(41); |
| forceeof := false; |
| flush(output); |
| endfilereading; |
| if checkoutervalidity then |
| goto 20 |
| else |
| goto 20 |
| end; |
| buffer[curinput.limitfield] := 37; |
| first := curinput.limitfield + 1; |
| curinput.locfield := curinput.startfield |
| end else begin {:681} |
| if inputptr > 0 then begin |
| endfilereading; |
| goto 20 |
| end; |
| if selector < 2 then |
| openlogfile; |
| if interaction > 1 then begin |
| if curinput.limitfield = curinput.startfield then |
| printnl(517); |
| println; |
| first := curinput.startfield; |
| begin |
| print(42); |
| terminput |
| end; |
| curinput.limitfield := last; |
| buffer[curinput.limitfield] := 37; |
| first := curinput.limitfield + 1; |
| curinput.locfield := curinput.startfield |
| end else |
| fatalerror(518) |
| end {:679}; |
| begin |
| if interrupt <> 0 then |
| pauseforinstructions |
| end; |
| goto 25 |
| end; |
| 4: |
| begin {671:} |
| if buffer[curinput.locfield] = 34 then |
| curmod := 155 |
| 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 begin {672:} |
| curinput.locfield := curinput.limitfield; |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(510) |
| end; |
| begin |
| helpptr := 3; |
| helpline[2] := 511; |
| helpline[1] := 512; |
| helpline[0] := 513 |
| end; |
| deletionsallowed := false; |
| error; |
| deletionsallowed := 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(129, 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: |
| begin {670:} |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(507) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 508; |
| helpline[0] := 509 |
| end; |
| deletionsallowed := false; |
| error; |
| deletionsallowed := true; |
| goto 20 |
| end |
| end |
| else |
| {:670}; |
| 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 := rounddecimals(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 |
| ; |
| printnl(133); |
| print(514) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 515; |
| helpline[0] := 516 |
| end; |
| deletionsallowed := false; |
| error; |
| deletionsallowed := true; |
| curmod := 268435455 |
| end; |
| curcmd := 42; |
| goto 10 {:675}; |
| 40: |
| cursym := idlookup(k, curinput.locfield - k) |
| end else if curinput.locfield >= himemmin then begin {:669} {676:} |
| cursym := mem[curinput.locfield].hh.lh; |
| curinput.locfield := mem[curinput.locfield].hh.rh; |
| if cursym >= 2242 then |
| if cursym >= 2392 then begin {677:} |
| if cursym >= 2542 then |
| cursym := cursym - 150; |
| begintokenlist(paramstack[(curinput.limitfield + cursym) - 2392], 9); |
| goto 20 |
| end else begin {:677} |
| curcmd := 38; |
| curmod := paramstack[(curinput.limitfield + cursym) - 2242]; |
| cursym := 0; |
| goto 10 |
| end |
| end else if curinput.locfield > (-30000) then begin {678:} |
| 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 else begin {:678} |
| endtokenlist; |
| goto 20 |
| end {:676}; {668:} |
| curcmd := eqtb[cursym].lh; |
| curmod := eqtb[cursym].rh; |
| if curcmd >= 83 then |
| if checkoutervalidity then |
| curcmd := curcmd - 83 |
| else |
| goto 20 {:668}; |
| 10: |
| |
| end; {:667} {682:} |
| |
| procedure firmuptheline; |
| var |
| k: 0..bufsize; |
| begin |
| curinput.limitfield := last; |
| if internal[31] > 0 then |
| if interaction > 1 then begin |
| println; |
| if curinput.startfield < curinput.limitfield then |
| for k := curinput.startfield to curinput.limitfield - 1 do |
| print(buffer[k]); |
| first := curinput.limitfield; |
| begin |
| print(519); |
| terminput |
| end; |
| if last > first 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 := 29998; |
| balance := 1; |
| mem[29998].hh.rh := -30000; |
| while true do begin |
| getnext; |
| if cursym > 0 then begin {686:} |
| begin |
| q := substlist; |
| while q <> (-30000) 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: {:686} |
| |
| end; |
| 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 begin {690:} |
| if curmod = 0 then |
| getnext |
| else if curmod <= suffixcount then |
| cursym := 2391 + curmod |
| end {:690} |
| end; |
| mem[p].hh.rh := curtok; |
| p := mem[p].hh.rh |
| end; |
| 30: |
| mem[p].hh.rh := tailend; |
| flushnodelist(substlist); |
| scantoks := mem[29998].hh.rh |
| end; {:685} {691:} |
| |
| procedure getsymbol; |
| label |
| 20; |
| begin |
| 20: |
| getnext; |
| if (cursym = 0) or (cursym > 2229) then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(531) |
| end; |
| begin |
| helpptr := 3; |
| helpline[2] := 532; |
| helpline[1] := 533; |
| helpline[0] := 534 |
| end; |
| if cursym > 0 then |
| helpline[2] := 535 |
| 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 := 2229; |
| inserror; |
| goto 20 |
| end |
| end; { getsymbol } |
| {:691} |
| {692:} |
| |
| procedure getclearsymbol; |
| 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] := 536; |
| helpline[3] := 537; |
| helpline[2] := 538; |
| helpline[1] := 539; |
| helpline[0] := 540 |
| 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 := 2242; |
| getclearsymbol; |
| warninginfo := cursym; |
| getsymbol; |
| p := getnode(2); |
| mem[p].hh.lh := cursym; |
| mem[p + 1].int := 2243; |
| mem[p].hh.rh := q; |
| getnext; |
| checkequals; |
| scannerstatus := 5; |
| q := getavail; |
| mem[q].hh.lh := -30000; |
| r := getavail; |
| mem[q].hh.rh := r; |
| mem[r].hh.lh := 0; |
| mem[r].hh.rh := scantoks(16, p, -30000, 0); |
| scannerstatus := 0; |
| eqtb[warninginfo].lh := m; |
| eqtb[warninginfo].rh := q; |
| getxnext |
| end; {:694} |
| {697:} |
| {1032:} |
| |
| procedure checkdelimiter(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] := 786; |
| helpline[0] := 787 |
| end; |
| backerror |
| end else begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(788) |
| end; |
| print(hash[rdelim].rh); |
| print(789); |
| begin |
| helpptr := 3; |
| helpline[2] := 790; |
| helpline[1] := 791; |
| helpline[0] := 792 |
| end; |
| error |
| end; |
| 10: |
| |
| end; {:1032} {1011:} |
| |
| function scandeclaredvariable: halfword; |
| label |
| 30; |
| var |
| x: halfword; |
| h, t: halfword; |
| l: halfword; |
| begin |
| getsymbol; |
| x := cursym; |
| if curcmd <> 41 then |
| clearsymbol(x, false); |
| if eqtb[x].rh = (-30000) then |
| newroot(x); |
| 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 begin {1012:} |
| l := cursym; |
| getxnext; |
| if curcmd <> 64 then begin |
| backinput; |
| cursym := l; |
| curcmd := 63; |
| goto 30 |
| end else |
| cursym := 0 |
| end else {:1012} |
| goto 30; |
| mem[t].hh.rh := getavail; |
| t := mem[t].hh.rh; |
| mem[t].hh.lh := cursym |
| end; |
| 30: |
| scandeclaredvariable := 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[29998].hh.rh := -30000; |
| q := getavail; |
| mem[q].hh.lh := -30000; |
| r := -30000; {700:} |
| if m = 1 then begin |
| getclearsymbol; |
| warninginfo := cursym; |
| getnext; |
| scannerstatus := 5; |
| n := 0; |
| eqtb[warninginfo].lh := 10; |
| eqtb[warninginfo].rh := q |
| end else begin |
| p := scandeclaredvariable; |
| flushvariable(eqtb[mem[p].hh.lh].rh, mem[p].hh.rh, true); |
| warninginfo := findvariable(p); |
| flushlist(p); |
| if warninginfo = (-30000) then begin {701:} |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(547) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 548; |
| helpline[0] := 549 |
| end; |
| error; |
| warninginfo := -29979 |
| end {:701}; |
| scannerstatus := 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 >= 2242) then |
| base := curmod |
| else begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(550) |
| end; |
| begin |
| helpptr := 1; |
| helpline[0] := 551 |
| end; |
| backerror; |
| base := 2242 |
| 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(552, 150); |
| k := k + 1; |
| mem[p].hh.rh := r; |
| r := p; |
| getnext |
| until curcmd <> 79 {:704}; |
| checkdelimiter(ldelim, rdelim); |
| getnext |
| until curcmd <> 31 {:703}; |
| if curcmd = 56 then begin {705:} |
| p := getnode(2); |
| if curmod < 2242 then begin |
| c := curmod; |
| mem[p + 1].int := 2242 + k |
| end else begin |
| mem[p + 1].int := curmod + k; |
| if curmod = 2242 then |
| c := 4 |
| else if curmod = 2392 then |
| c := 6 |
| else |
| c := 7 |
| end; |
| if k = 150 then |
| overflow(552, 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(552, 150); |
| mem[p + 1].int := 2242 + 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, -30000, 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 = (-29979) then |
| flushtokenlist(mem[-29978].int) {:698}; |
| scannerstatus := 0; |
| getxnext |
| end; {:697} {706:} |
| |
| procedure scanprimary; |
| forward; |
| |
| procedure scansecondary; |
| forward; |
| |
| procedure scantertiary; |
| forward; |
| |
| procedure scanexpression; |
| forward; |
| |
| procedure scansuffix; |
| forward; {720:} |
| {722:} |
| |
| procedure printmacroname(a, n: halfword); |
| var |
| p, q: halfword; |
| begin |
| if n <> (-30000) then |
| print(hash[n].rh) |
| else begin |
| p := mem[a].hh.lh; |
| if p = (-30000) then |
| print(hash[mem[mem[mem[a].hh.rh].hh.lh].hh.lh].rh) |
| else begin |
| q := p; |
| while mem[q].hh.rh <> (-30000) do |
| q := mem[q].hh.rh; |
| mem[q].hh.rh := mem[mem[a].hh.rh].hh.lh; |
| showtokenlist(p, -30000, 1000, 0); |
| mem[q].hh.rh := -30000 |
| end |
| end |
| end; {:722} {723:} |
| |
| procedure printarg(q: halfword; n: integer; b: halfword); |
| begin |
| if mem[q].hh.rh = (-29999) then |
| printnl(365) |
| else if (b < 2542) and (b <> 7) then |
| printnl(366) |
| else |
| printnl(367); |
| printint(n); |
| print(568); |
| if mem[q].hh.rh = (-29999) then |
| printexp(q, 1) |
| else |
| showtokenlist(q, -30000, 1000, 0) |
| end; {:723} {730:} |
| |
| procedure scantextarg(ldelim, rdelim: halfword); |
| label |
| 30; |
| var |
| balance: integer; |
| p: halfword; |
| begin |
| warninginfo := ldelim; |
| scannerstatus := 3; |
| p := 29998; |
| balance := 1; |
| mem[29998].hh.rh := -30000; |
| while true do begin |
| getnext; |
| if ldelim = 0 then begin {732:} |
| if curcmd > 79 then begin |
| if balance = 1 then |
| goto 30 |
| else if curcmd = 81 then |
| balance := balance - 1 |
| end else if curcmd = 32 then |
| balance := balance + 1 |
| end else begin {:732} {731:} |
| 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[29998].hh.rh; |
| curtype := 20; |
| scannerstatus := 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 = (-30000) then |
| n := 0 {724:} |
| else begin |
| n := 1; |
| tail := arglist; |
| while mem[tail].hh.rh <> (-30000) do begin |
| n := n + 1; |
| tail := mem[tail].hh.rh |
| end |
| end {:724}; |
| if internal[9] > 0 then begin {721:} |
| begindiagnostic; |
| println; |
| printmacroname(arglist, macroname); |
| if n = 3 then |
| print(530); |
| showmacro(defref, -30000, 100000); |
| if arglist <> (-30000) 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 = (-30000) |
| end; |
| enddiagnostic(false) |
| end {:721}; {725:} |
| curcmd := 80; |
| while mem[r].hh.lh >= 2242 do begin {726:} |
| if curcmd <> 79 then begin |
| getxnext; |
| if curcmd <> 31 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(574) |
| end; |
| printmacroname(arglist, macroname); |
| begin |
| helpptr := 3; |
| helpline[2] := 575; |
| helpline[1] := 576; |
| helpline[0] := 577 |
| end; |
| if mem[r].hh.lh >= 2392 then begin |
| curexp := -30000; |
| 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 >= 2542 then |
| scantextarg(ldelim, rdelim) |
| else begin |
| getxnext; |
| if mem[r].hh.lh >= 2392 then |
| scansuffix |
| else |
| scanexpression |
| end {:729}; |
| if curcmd <> 79 then {727:} |
| if (curcmd <> 62) or (curmod <> ldelim) then |
| if mem[mem[r].hh.rh].hh.lh >= 2242 then begin |
| missingerr(44); |
| begin |
| helpptr := 3; |
| helpline[2] := 578; |
| helpline[1] := 579; |
| helpline[0] := 573 |
| end; |
| backerror; |
| curcmd := 79 |
| end else begin |
| missingerr(hash[rdelim].rh); |
| begin |
| helpptr := 2; |
| helpline[1] := 580; |
| helpline[0] := 573 |
| 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 |
| begindiagnostic; |
| printarg(mem[p].hh.lh, n, mem[r].hh.lh); |
| enddiagnostic(false) |
| end; |
| if arglist = (-30000) 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 = 79 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(569) |
| end; |
| printmacroname(arglist, macroname); |
| printchar(59); |
| printnl(570); |
| print(hash[rdelim].rh); |
| print(170); |
| begin |
| helpptr := 3; |
| helpline[2] := 571; |
| helpline[1] := 572; |
| helpline[0] := 573 |
| end; |
| error |
| end; |
| if mem[r].hh.lh <> 0 then begin {733:} |
| 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: |
| scansecondary; |
| 3: |
| scantertiary; |
| 4: |
| scanexpression; |
| 5: |
| begin {734:} |
| scanexpression; |
| p := getavail; |
| mem[p].hh.lh := stashcurexp; |
| if internal[9] > 0 then begin |
| begindiagnostic; |
| printarg(mem[p].hh.lh, n, 0); |
| enddiagnostic(false) |
| end; |
| if arglist = (-30000) then |
| arglist := p |
| else |
| mem[tail].hh.rh := p; |
| tail := p; |
| n := n + 1; |
| if curcmd <> 69 then begin |
| missingerr(347); |
| print(581); |
| printmacroname(arglist, macroname); |
| begin |
| helpptr := 1; |
| helpline[0] := 582 |
| end; |
| backerror |
| end; |
| getxnext; |
| scanprimary |
| end; {:734} |
| 6: |
| begin {735:} |
| if curcmd <> 31 then |
| ldelim := -30000 |
| else begin |
| ldelim := cursym; |
| rdelim := curmod; |
| getxnext |
| end; |
| scansuffix; |
| if ldelim <> (-30000) then begin |
| if (curcmd <> 62) or (curmod <> ldelim) then begin |
| missingerr(hash[rdelim].rh); |
| begin |
| helpptr := 2; |
| helpline[1] := 580; |
| helpline[0] := 573 |
| 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 |
| begindiagnostic; |
| printarg(mem[p].hh.lh, n, mem[r].hh.lh); |
| enddiagnostic(false) |
| end; |
| if arglist = (-30000) 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 = (-30000)) do |
| endtokenlist; |
| if (paramptr + n) > maxparamstack then begin |
| maxparamstack := paramptr + n; |
| if maxparamstack > 150 then |
| overflow(552, 150) |
| end; |
| begintokenlist(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 = (-30000); |
| flushlist(arglist) |
| end {:736} |
| end; {:720} |
| |
| procedure getboolean; |
| forward; |
| |
| procedure passtext; |
| forward; |
| |
| procedure conditional; |
| forward; |
| |
| procedure startinput; |
| forward; |
| |
| procedure beginiteration; |
| forward; |
| |
| procedure resumeiteration; |
| forward; |
| |
| procedure stopiteration; |
| 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 := 2234; |
| inserror |
| end else begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(589) |
| end; |
| printcmdmod(2, curmod); |
| begin |
| helpptr := 1; |
| helpline[0] := 590 |
| 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 {:711} |
| startinput; |
| 4: |
| if curmod = 0 then begin {708:} |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(553) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 554; |
| helpline[0] := 555 |
| end; |
| error |
| end else {:708} |
| beginiteration; |
| 5: |
| begin {712:} |
| while (curinput.indexfield > 6) and (curinput.locfield = (-30000)) do |
| endtokenlist; |
| if loopptr = (-30000) then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(557) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 558; |
| helpline[0] := 559 |
| end; |
| error |
| end else |
| resumeiteration |
| end; {:712} |
| 6: |
| begin {713:} |
| getboolean; |
| if internal[7] > 65536 then |
| showcmdmod(33, curexp); |
| if curexp = 30 then |
| if loopptr = (-30000) then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(560) |
| end; |
| begin |
| helpptr := 1; |
| helpline[0] := 561 |
| end; |
| if curcmd = 80 then |
| error |
| else |
| backerror |
| end else begin {714:} |
| p := -30000; |
| repeat |
| if curinput.indexfield <= 6 then |
| endfilereading |
| else begin |
| if curinput.indexfield <= 8 then |
| p := curinput.startfield; |
| endtokenlist |
| end |
| until p <> (-30000); |
| if p <> mem[loopptr].hh.lh then |
| fatalerror(564); |
| stopiteration |
| end {:714} |
| else if curcmd <> 80 then begin |
| missingerr(59); |
| begin |
| helpptr := 2; |
| helpline[1] := 562; |
| helpline[0] := 563 |
| end; |
| backerror |
| end |
| end; {:713} |
| 7: |
| ; |
| 9: |
| begin {715:} |
| getnext; |
| p := curtok; |
| getnext; |
| if curcmd < 11 then |
| expand |
| else |
| backinput; |
| begintokenlist(p, 10) |
| end; {:715} |
| 8: |
| begin {716:} |
| getxnext; |
| scanprimary; |
| if curtype <> 4 then begin |
| disperr(-30000, 565); |
| begin |
| helpptr := 2; |
| helpline[1] := 566; |
| helpline[0] := 567 |
| end; |
| putgetflusherror(0) |
| end else begin |
| backinput; |
| if (strstart[curexp + 1] - strstart[curexp]) > 0 then begin {717:} |
| beginfilereading; |
| curinput.namefield := 2; |
| k := first + (strstart[curexp + 1] - strstart[curexp]); |
| if k >= maxbufstack then begin |
| if k >= bufsize then begin |
| maxbufstack := bufsize; |
| overflow(128, bufsize) |
| end; |
| maxbufstack := k + 1 |
| end; |
| j := strstart[curexp]; |
| curinput.limitfield := k; |
| while first < curinput.limitfield do begin |
| buffer[first] := strpool[j]; |
| j := j + 1; |
| first := first + 1 |
| end; |
| buffer[curinput.limitfield] := 37; |
| first := curinput.limitfield + 1; |
| curinput.locfield := curinput.startfield; |
| flushcurexp(0) |
| end {:717} |
| end |
| end; {:716} |
| 10: |
| macrocall(curmod, -30000, cursym) |
| end |
| end; {:707} {718:} |
| |
| procedure getxnext; |
| var |
| saveexp: halfword; |
| begin |
| getnext; |
| if curcmd < 11 then begin |
| saveexp := stashcurexp; |
| repeat |
| if curcmd = 10 then |
| macrocall(curmod, -30000, cursym) |
| else |
| expand; |
| getnext |
| until curcmd >= 11; |
| unstashcurexp(saveexp) |
| end |
| end; {:718} {737:} |
| |
| procedure stackargument(p: halfword); |
| begin |
| if paramptr = maxparamstack then begin |
| maxparamstack := maxparamstack + 1; |
| if maxparamstack > 150 then |
| overflow(552, 150) |
| end; |
| paramstack[paramptr] := p; |
| paramptr := paramptr + 1 |
| end; {:737} {742:} |
| |
| procedure passtext; |
| label |
| 30; |
| var |
| l: integer; |
| begin |
| scannerstatus := 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 {743:} |
| 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 {:743} |
| end; |
| 30: |
| scannerstatus := 0 |
| end; {:742} {746:} |
| |
| procedure changeiflimit(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 = (-30000) then |
| confusion(583); |
| 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 <> 78 then begin |
| missingerr(58); |
| begin |
| helpptr := 2; |
| helpline[1] := 586; |
| helpline[0] := 563 |
| end; |
| backerror |
| end |
| end; {:747} {748:} |
| |
| procedure conditional; |
| label |
| 10, 30, 21, 40; |
| var |
| savecondptr: halfword; |
| newiflimit: 2..4; |
| p: halfword; {744:} |
| begin |
| 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 begin {750:} |
| begindiagnostic; |
| if curexp = 30 then |
| print(587) |
| else |
| print(588); |
| enddiagnostic(false) |
| end {:750}; |
| 40: |
| checkcolon; |
| if curexp = 30 then begin |
| changeiflimit(newiflimit, savecondptr); |
| goto 10 |
| end; {749:} |
| while true do begin |
| passtext; |
| if condptr = savecondptr then |
| goto 30 |
| else if curmod = 2 then begin {745:} |
| 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 begin {745:} |
| 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 else if curmod = 4 then {:745} |
| goto 21 |
| else begin |
| curexp := 30; |
| newiflimit := 2; |
| getxnext; |
| goto 40 |
| end; |
| 10: |
| |
| end; {:748} {754:} |
| |
| procedure badfor(s: strnumber); |
| begin |
| disperr(-30000, 591); |
| print(s); |
| print(177); |
| begin |
| helpptr := 4; |
| helpline[3] := 592; |
| helpline[2] := 593; |
| helpline[1] := 594; |
| helpline[0] := 179 |
| end; |
| putgetflusherror(0) |
| end; {:754} {755:} |
| |
| procedure beginiteration; |
| 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 := -29999; |
| p := -30000; |
| 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] := 595; |
| helpline[1] := 538; |
| helpline[0] := 596 |
| end; |
| backerror |
| end; |
| {764:} |
| mem[s + 1].hh.lh := -30000; |
| q := s + 1; |
| mem[q].hh.rh := -30000; |
| repeat |
| getxnext; |
| if m <> 2242 then |
| scansuffix |
| else begin |
| if curcmd >= 78 then |
| if curcmd <= 79 then |
| goto 22; |
| scanexpression; |
| if curcmd = 74 then |
| if q = (s + 1) then begin {765:} |
| if curtype <> 16 then |
| badfor(602); |
| pp := getnode(4); |
| mem[pp + 1].int := curexp; |
| getxnext; |
| scanexpression; |
| if curtype <> 16 then |
| badfor(603); |
| mem[pp + 2].int := curexp; |
| if curcmd <> 75 then begin |
| missingerr(357); |
| begin |
| helpptr := 2; |
| helpline[1] := 604; |
| helpline[0] := 605 |
| end; |
| backerror |
| end; |
| getxnext; |
| scanexpression; |
| if curtype <> 16 then |
| badfor(606); |
| 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 <> 79; |
| 30: {:764} |
| ; |
| 40: {756:} |
| if curcmd <> 78 then begin |
| missingerr(58); |
| begin |
| helpptr := 3; |
| helpline[2] := 597; |
| helpline[1] := 598; |
| helpline[0] := 599 |
| end; |
| backerror |
| end {:756}; {758:} |
| q := getavail; |
| mem[q].hh.lh := 2230; |
| scannerstatus := 6; |
| warninginfo := n; |
| mem[s].hh.lh := scantoks(4, p, q, 0); |
| scannerstatus := 0; |
| mem[s].hh.rh := loopptr; |
| loopptr := s {:758}; |
| resumeiteration |
| end; {:755} {760:} |
| |
| procedure resumeiteration; |
| label |
| 45, 10; |
| var |
| p, q: halfword; |
| begin |
| p := mem[loopptr + 1].hh.lh; |
| if p > (-29999) then begin |
| curexp := mem[p + 1].int; {761:} |
| if ((mem[p + 2].int > 0) and (curexp > mem[p + 3].int)) or ((mem[p + 2].int < 0) and (curexp < mem[p + 3].int)) then {:761} |
| goto 45; |
| curtype := 16; |
| q := stashcurexp; |
| mem[p + 1].int := curexp + mem[p + 2].int |
| end else if p < (-29999) then begin |
| p := mem[loopptr + 1].hh.rh; |
| if p = (-30000) 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 |
| end {dynused:=dynused-1;} |
| end else begin |
| begintokenlist(mem[loopptr].hh.lh, 7); |
| goto 10 |
| end; |
| begintokenlist(mem[loopptr].hh.lh, 8); |
| stackargument(q); |
| if internal[7] > 65536 then begin {762:} |
| begindiagnostic; |
| printnl(601); |
| if (q <> (-30000)) and (mem[q].hh.rh = (-29999)) then |
| printexp(q, 1) |
| else |
| showtokenlist(q, -30000, 50, 0); |
| printchar(125); |
| enddiagnostic(false) |
| end {:762}; |
| goto 10; |
| 45: |
| stopiteration; |
| 10: |
| |
| end; {:760} {763:} |
| |
| procedure stopiteration; |
| var |
| p, q: halfword; |
| begin |
| p := mem[loopptr + 1].hh.lh; |
| if p > (-29999) then |
| freenode(p, 4) |
| else if p < (-29999) then begin |
| q := mem[loopptr + 1].hh.rh; |
| while q <> (-30000) do begin |
| p := mem[q].hh.lh; |
| if p <> (-30000) then |
| if mem[p].hh.rh = (-29999) then begin |
| recyclevalue(p); |
| freenode(p, 2) |
| end else |
| flushtokenlist(p); |
| p := q; |
| q := mem[q].hh.rh; |
| begin |
| mem[p].hh.rh := avail; |
| avail := p |
| end {dynused:=dynused-1;} |
| end |
| end; |
| p := loopptr; |
| loopptr := mem[p].hh.rh; |
| flushtokenlist(mem[p].hh.lh); |
| freenode(p, 2) |
| end; {:763} {770:} |
| |
| procedure beginname; |
| begin |
| areadelimiter := 0; |
| extdelimiter := 0 |
| end; {:770} {771:} |
| |
| function morename(c: ASCIIcode): boolean; |
| begin |
| if (c = 32) or (c = 9) then |
| morename := false |
| else begin |
| if c = 47 then begin |
| areadelimiter := 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(129, poolsize - initpoolptr); |
| maxpoolptr := poolptr + 1 |
| end |
| end; |
| begin |
| strpool[poolptr] := c; |
| poolptr := poolptr + 1 |
| end; |
| morename := true |
| end |
| end; { morename } |
| {:771} |
| {772:} |
| |
| procedure endname; |
| begin |
| if (strptr + 3) > maxstrptr then begin |
| if (strptr + 3) > maxstrings then |
| overflow(130, maxstrings - initstrptr); |
| maxstrptr := strptr + 3 |
| end; |
| if areadelimiter = 0 then |
| curarea := 155 |
| else begin |
| curarea := strptr; |
| strptr := strptr + 1; |
| strstart[strptr] := areadelimiter + 1 |
| end; |
| if extdelimiter = 0 then begin |
| curext := 155; |
| curname := makestring |
| end else begin |
| curname := strptr; |
| strptr := strptr + 1; |
| strstart[strptr] := extdelimiter; |
| curext := makestring |
| end |
| 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 packbufferedname(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[MFbasedefault[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 := 6 to 10 do begin |
| c := xord[MFbasedefault[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 makenamestring: strnumber; |
| var |
| k, kstart: 1..filenamesize; |
| begin |
| k := 1; |
| while (k < filenamesize) and (xord[realnameoffile[k]] <> 32) do |
| k := k + 1; |
| namelength := k - 1; |
| if ((poolptr + namelength) > poolsize) or (strptr = maxstrings) then |
| makenamestring := 63 |
| else begin |
| if (xord[realnameoffile[1]] = 46) and (xord[realnameoffile[2]] = 47) then |
| kstart := 3 |
| else |
| kstart := 1; |
| for k := kstart to namelength do begin |
| strpool[poolptr] := xord[realnameoffile[k]]; |
| poolptr := poolptr + 1 |
| end; |
| makenamestring := makestring |
| end |
| end; |
| |
| function amakenamestring(var f: alphafile): strnumber; |
| begin |
| amakenamestring := makenamestring |
| end; { amakenamestring } |
| |
| function bmakenamestring(var f: bytefile): strnumber; |
| begin |
| bgetname(f, realnameoffile); |
| bmakenamestring := makenamestring |
| end; { bmakenamestring } |
| |
| function wmakenamestring(var f: wordfile): strnumber; |
| begin |
| wmakenamestring := makenamestring |
| end; {:780} {781:} |
| |
| procedure scanfilename; |
| label |
| 30; |
| begin |
| beginname; |
| while (buffer[curinput.locfield] = 32) or (buffer[curinput.locfield] = 9) 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 := 155; |
| curext := s; |
| curname := jobname; |
| packfilename(curname, curarea, curext) |
| end; {:784} {786:} |
| |
| procedure promptfilename(s, e: strnumber); |
| label |
| 30; |
| var |
| k: 0..bufsize; |
| begin |
| if interaction = 2 then |
| ; |
| if s = 607 then begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(608) |
| end else begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(609) |
| end; |
| printfilename(curname, curarea, curext); |
| print(610); |
| if e = 611 then |
| showcontext; |
| printnl(612); |
| print(s); |
| if interaction < 2 then |
| fatalerror(613); |
| begin |
| print(614); |
| terminput |
| end; |
| {787:} |
| begin |
| beginname; |
| k := first; |
| while ((buffer[k] = 32) or (buffer[k] = 9)) and (k < last) do |
| k := k + 1; |
| while true do begin |
| if k = last then |
| goto 30; |
| if not morename(buffer[k]) then |
| goto 30; |
| k := k + 1 |
| end; |
| 30: |
| endname |
| end {:787}; |
| if curext = 155 then |
| curext := e; |
| packfilename(curname, curarea, curext) |
| end; { promptfilename } |
| {:786} |
| {788:} |
| |
| procedure openlogfile; |
| var |
| oldsetting: 0..5; |
| k: 0..bufsize; |
| l: 0..bufsize; |
| m: integer; |
| months: packed array [1..36] of char; |
| begin |
| oldsetting := selector; |
| if jobname = 0 then |
| jobname := 615; |
| packjobname(616); |
| while not aopenout(logfile) do begin {789:} |
| if interaction < 2 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(609) |
| end; |
| printfilename(curname, curarea, curext); |
| print(610); |
| jobname := 0; |
| history := 3; |
| jumpout |
| end; |
| promptfilename(618, 616) |
| end {:789}; |
| logname := amakenamestring(logfile); |
| selector := 2; {790:} |
| begin |
| write(logfile, 'This is METAFONT, Version 1.0 for Berkeley UNIX'); |
| print(baseident); |
| print(619); |
| printint(roundunscaled(internal[16])); |
| printchar(32); |
| months := 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'; |
| m := roundunscaled(internal[15]); |
| for k := (3 * m) - 2 to 3 * m do |
| write(logfile, months[k]); |
| printchar(32); |
| printint(roundunscaled(internal[14])); |
| printchar(32); |
| m := roundunscaled(internal[17]); |
| printdd(m div 60); |
| printchar(58); |
| printdd(m mod 60) |
| end {:790}; |
| inputstack[inputptr] := curinput; |
| printnl(617); |
| l := inputstack[0].limitfield - 1; |
| for k := 1 to l do |
| print(buffer[k]); |
| println; |
| selector := oldsetting + 2 |
| end; {:788} {793:} |
| |
| procedure startinput; |
| label |
| 30; {795:} |
| begin |
| while (curinput.indexfield > 6) and (curinput.locfield = (-30000)) do |
| endtokenlist; |
| if curinput.indexfield > 6 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(621) |
| end; |
| begin |
| helpptr := 3; |
| helpline[2] := 622; |
| helpline[1] := 623; |
| helpline[0] := 624 |
| end; |
| error |
| end; |
| if curinput.indexfield <= 6 then |
| scanfilename |
| else begin |
| curname := 155; |
| curext := 155; |
| curarea := 155 |
| end {:795}; |
| if curext = 155 then |
| curext := 611; |
| packfilename(curname, curarea, curext); |
| while true do begin |
| beginfilereading; |
| if aopenin(inputfile[curinput.indexfield], 6) then |
| goto 30; |
| endfilereading; |
| promptfilename(607, 611) |
| end; |
| 30: |
| curinput.namefield := amakenamestring(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); |
| print(curinput.namefield); |
| flush(output); {794:} |
| begin |
| if not inputln(inputfile[curinput.indexfield], false) then |
| ; |
| firmuptheline; |
| buffer[curinput.limitfield] := 37; |
| first := curinput.limitfield + 1; |
| curinput.locfield := curinput.startfield; |
| line := 1 |
| end {:794} |
| end; {:793} {824:} |
| |
| procedure badexp(s: strnumber); |
| var |
| saveflag: 0..82; |
| begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(s) |
| end; |
| print(634); |
| printcmdmod(curcmd, curmod); |
| printchar(39); |
| begin |
| helpptr := 4; |
| helpline[3] := 635; |
| helpline[2] := 636; |
| helpline[1] := 637; |
| helpline[0] := 638 |
| 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; |
| { |
| 829:} |
| if curtype = 16 then |
| mem[p + 1].int := curexp |
| else begin |
| if curtype = 19 then begin |
| q := singledependency(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 else begin {:829} |
| mem[p + 1] := mem[curexp + 1]; |
| mem[mem[p + 1].hh.lh].hh.rh := p |
| end; |
| freenode(curexp, 2) |
| end; |
| curtype := 1 |
| end; { stashin } |
| {:827} |
| {848:} |
| |
| procedure backexpr; |
| var |
| p: halfword; |
| begin |
| p := stashcurexp; |
| mem[p].hh.rh := -30000; |
| begintokenlist(p, 10) |
| end; {:848} {849:} |
| |
| procedure badsubscript; |
| begin |
| disperr(-30000, 650); |
| begin |
| helpptr := 3; |
| helpline[2] := 651; |
| helpline[1] := 652; |
| helpline[0] := 653 |
| end; |
| flusherror(0) |
| end; {:849} {851:} |
| |
| procedure obliterated(q: halfword); |
| begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(654) |
| end; |
| showtokenlist(q, -30000, 1000, 0); |
| print(655); |
| begin |
| helpptr := 5; |
| helpline[4] := 656; |
| helpline[3] := 657; |
| helpline[2] := 658; |
| helpline[1] := 659; |
| helpline[0] := 660 |
| 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 materializepen; |
| 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 |
| ; |
| printnl(133); |
| print(670) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 671; |
| helpline[0] := 442 |
| end; |
| putgeterror; |
| curexp := -29997; |
| goto 50 |
| end else if mem[q].hh.b0 = 4 then begin {866:} |
| 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 begin {867:} |
| 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(-30000, 673); |
| begin |
| helpptr := 5; |
| helpline[4] := 674; |
| helpline[3] := 675; |
| helpline[2] := 676; |
| helpline[1] := 677; |
| helpline[0] := 678 |
| end; |
| putgetflusherror(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, 679); |
| begin |
| helpptr := 5; |
| helpline[4] := 680; |
| helpline[3] := 675; |
| helpline[2] := 676; |
| helpline[1] := 677; |
| helpline[0] := 678 |
| 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, 681); |
| begin |
| helpptr := 5; |
| helpline[4] := 682; |
| helpline[3] := 675; |
| helpline[2] := 676; |
| helpline[1] := 677; |
| helpline[0] := 678 |
| 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 scandirection: smallnumber; |
| var |
| t: 2..4; |
| x: scaled; |
| begin |
| getxnext; |
| if curcmd = 60 then begin {876:} |
| getxnext; |
| scanexpression; |
| if (curtype <> 16) or (curexp < 0) then begin |
| disperr(-30000, 685); |
| begin |
| helpptr := 1; |
| helpline[0] := 686 |
| end; |
| putgetflusherror(65536) |
| end; |
| t := 3 |
| end else begin {:876} {877:} |
| scanexpression; |
| if curtype > 14 then begin {878:} |
| if curtype <> 16 then begin |
| disperr(-30000, 679); |
| begin |
| helpptr := 5; |
| helpline[4] := 680; |
| helpline[3] := 675; |
| helpline[2] := 676; |
| helpline[1] := 677; |
| helpline[0] := 678 |
| end; |
| putgetflusherror(0) |
| end; |
| x := curexp; |
| if curcmd <> 79 then begin |
| missingerr(44); |
| begin |
| helpptr := 2; |
| helpline[1] := 687; |
| helpline[0] := 688 |
| end; |
| backerror |
| end; |
| getxnext; |
| scanexpression; |
| if curtype <> 16 then begin |
| disperr(-30000, 681); |
| begin |
| helpptr := 5; |
| helpline[4] := 682; |
| helpline[3] := 675; |
| helpline[2] := 676; |
| helpline[1] := 677; |
| helpline[0] := 678 |
| end; |
| putgetflusherror(0) |
| end; |
| cury := curexp; |
| curx := x |
| end else {:878} |
| 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] := 683; |
| helpline[1] := 684; |
| helpline[0] := 563 |
| end; |
| backerror |
| end; |
| getxnext; |
| scandirection := 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 := -29997 |
| end; |
| 37: |
| begin |
| curtype := 16; |
| curexp := normrand |
| end; |
| 36: |
| begin {896:} |
| 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: |
| begin {897:} |
| if interaction <= 1 then |
| fatalerror(699); |
| beginfilereading; |
| curinput.namefield := 1; |
| begin |
| print(155); |
| terminput |
| end; |
| begin |
| if ((poolptr + last) - curinput.startfield) > maxpoolptr then begin |
| if ((poolptr + last) - curinput.startfield) > poolsize then |
| overflow(129, 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; |
| endfilereading; |
| curtype := 4; |
| curexp := makestring |
| end |
| end {:897}; |
| 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 printknownorunknownt(t: smallnumber; v: integer); |
| begin |
| printchar(40); |
| if t < 17 then |
| if t <> 14 then |
| printtype(t) |
| else if nicepair(v, 14) then |
| print(207) |
| else |
| print(700) |
| else |
| print(701); |
| printchar(41) |
| end; {:900} {901:} |
| |
| procedure badunary(c: quarterword); |
| begin |
| disperr(-30000, 702); |
| printop(c); |
| printknownorunknownt(curtype, curexp); |
| begin |
| helpptr := 3; |
| helpline[2] := 703; |
| helpline[1] := 704; |
| helpline[0] := 705 |
| end; |
| putgeterror |
| end; {:901} {904:} |
| |
| procedure negatedeplist(p: halfword); |
| label |
| 10; |
| begin |
| while true do begin |
| mem[p + 1].int := -mem[p + 1].int; |
| if mem[p].hh.lh = (-30000) 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[-29982].int := p; |
| mem[-29983].hh.b0 := curtype; |
| mem[p].hh.rh := -29983; |
| freenode(curexp, 2); |
| makeexpcopy(p + (2 * (c - 53))); |
| recyclevalue(-29983) |
| 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(-30000, 707); |
| if c = 47 then begin |
| helpptr := 1; |
| helpline[0] := 708 |
| end else begin |
| helpptr := 1; |
| helpline[0] := 709 |
| end; |
| putgeterror |
| end; |
| if n > 4095 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(710) |
| end; |
| printint(n); |
| printchar(41); |
| begin |
| helpptr := 1; |
| helpline[0] := 711 |
| end; |
| putgeterror |
| end {:914} |
| end; |
| flushcurexp(n * 65536) |
| end; { strtonum } |
| {: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; { pathlength } |
| {:916} |
| {919:} |
| |
| procedure testknown(c: quarterword); |
| label |
| 30; |
| var |
| b: 30..31; |
| p, q: halfword; |
| begin |
| b := 31; |
| if curtype in |
| [1, 2, 4, 6, 8, 9, 11, 16, |
| 13, 14] then |
| 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 |
| end |
| else |
| ; |
| 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 begin {902:} |
| begindiagnostic; |
| printnl(123); |
| printop(c); |
| printchar(40); |
| printexp(-30000, 0); |
| print(706); |
| enddiagnostic(false) |
| end {:902}; |
| case c of |
| 69: |
| if curtype < 14 then |
| if curtype <> 11 then |
| badunary(69); |
| 70: {903:} |
| if curtype in |
| [14, 19, 17, 18, 16, 11] then |
| case curtype of |
| 14, 19: |
| begin |
| q := curexp; |
| makeexpcopy(q); |
| if curtype = 17 then |
| negatedeplist(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 |
| negatedeplist(mem[p + 1].hh.rh); |
| if mem[p + 2].hh.b0 = 16 then |
| mem[p + 3].int := -mem[p + 3].int |
| else |
| negatedeplist(mem[p + 3].hh.rh) |
| end; |
| recyclevalue(q); |
| freenode(q, 2) |
| end; |
| 17, 18: |
| negatedeplist(mem[curexp + 1].hh.rh); |
| 16: |
| curexp := -curexp; |
| 11: |
| negateedges(curexp) |
| end |
| else |
| badunary(70) {: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 := roundfraction(nsin) |
| else |
| curexp := roundfraction(ncos) |
| end; |
| 64: |
| curexp := floorscaled(curexp); |
| 65: |
| curexp := unifrand(curexp); |
| 38: |
| begin |
| if odd(roundunscaled(curexp)) then |
| curexp := 30 |
| else |
| curexp := 31; |
| curtype := 2 |
| end; |
| 66: |
| begin {1181:} |
| curexp := roundunscaled(curexp) mod 256; |
| if curexp < 0 then |
| curexp := curexp + 256; |
| if charexists[curexp] then |
| curexp := 30 |
| else |
| curexp := 31; |
| curtype := 2 |
| end |
| end {:1181}; {: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 := roundunscaled(curexp) mod 128; |
| curtype := 4; |
| if curexp < 0 then |
| curexp := curexp + 128; |
| if (strstart[curexp + 1] - strstart[curexp]) <> 1 then begin |
| begin |
| if (poolptr + 1) > maxpoolptr then begin |
| if (poolptr + 1) > poolsize then |
| overflow(129, 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 := -29997; |
| curpathtype := 1; |
| curexp := makespec(curexp, -1879080960, 0); |
| flushcurexp(turningnumber * 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 |
| materializepen; |
| 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) |
| end {:921}; |
| begin |
| if aritherror then |
| cleararith |
| end |
| end; {:898} {922:} {923:} |
| |
| procedure badbinary(p: halfword; c: quarterword); |
| begin |
| disperr(p, 155); |
| disperr(-30000, 702); |
| if c >= 94 then |
| printop(c); |
| printknownorunknownt(mem[p].hh.b0, p); |
| if c >= 94 then |
| print(347) |
| else |
| printop(c); |
| printknownorunknownt(curtype, curexp); |
| begin |
| helpptr := 3; |
| helpline[2] := 703; |
| helpline[1] := 712; |
| helpline[0] := 713 |
| 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 := -29999; |
| goto 10 |
| end |
| until r = q; |
| tarnished := -30000; |
| 10: |
| |
| end; {:928} {930:} {935:} |
| |
| procedure depfinish(v, q: halfword; t: smallnumber); |
| var |
| p: halfword; |
| vv: scaled; |
| begin |
| if q = (-30000) then |
| p := curexp |
| else |
| p := q; |
| mem[p + 1].hh.rh := v; |
| mem[p].hh.b0 := t; |
| if mem[v].hh.lh = (-30000) then begin |
| vv := mem[v + 1].int; |
| if q = (-30000) then |
| flushcurexp(vv) |
| else begin |
| recyclevalue(p); |
| mem[q].hh.b0 := 16; |
| mem[q + 1].int := vv |
| end |
| end else if q = (-30000) then |
| curtype := t; |
| if fixneeded then |
| fixdependencies |
| end; {:935} |
| |
| procedure addorsubtract(p, q: halfword; c: quarterword); |
| label |
| 30, 10; |
| var |
| s, t: smallnumber; |
| r: halfword; |
| v: integer; |
| begin |
| if q = (-30000) 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 = (-30000) then |
| curexp := v |
| else |
| mem[q + 1].int := v; |
| goto 10 |
| end; {931:} |
| r := mem[p + 1].hh.rh; |
| while mem[r].hh.lh <> (-30000) do |
| r := mem[r].hh.rh; |
| mem[r + 1].int := slowadd(mem[r + 1].int, v); |
| if q = (-30000) 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 |
| end else begin {:931} |
| if c = 70 then |
| negatedeplist(v); {932:} |
| if mem[p].hh.b0 = 16 then begin {933:} |
| while mem[v].hh.lh <> (-30000) do |
| v := mem[v].hh.rh; |
| mem[v + 1].int := slowadd(mem[p + 1].int, mem[v + 1].int) |
| end else begin {:933} |
| 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 <> (-30000) then |
| depfinish(v, q, t) |
| else begin |
| curtype := t; |
| depfinish(v, -30000, 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 = (-30000) 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; |
| unstashcurexp(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 = (-30000) 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 begin {955:} |
| p := stashcurexp; |
| curexp := idtransform; |
| curtype := 13; |
| q := mem[curexp + 1].int; |
| case c of {957:} |
| 84: |
| if mem[p].hh.b0 = 16 then begin {958:} |
| nsincos((mem[p + 1].int mod 23592960) * 16); |
| mem[q + 5].int := roundfraction(ncos); |
| mem[q + 9].int := roundfraction(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 begin {959:} |
| 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 |
| negatedeplist(mem[r + 3].hh.rh); |
| install(q + 6, r + 2); |
| goto 30 |
| end {:959}; |
| 88: |
| |
| end {:957}; |
| disperr(p, 722); |
| begin |
| helpptr := 3; |
| helpline[2] := 723; |
| helpline[1] := 724; |
| helpline[0] := 405 |
| 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 setupknowntrans(c: quarterword); |
| begin |
| setuptrans(c); |
| if curtype <> 16 then begin |
| disperr(-30000, 725); |
| begin |
| helpptr := 3; |
| helpline[2] := 726; |
| helpline[1] := 727; |
| helpline[0] := 405 |
| end; |
| putgetflusherror(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 |
| setupknowntrans(c); |
| unstashcurexp(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 |
| setupknowntrans(c); |
| unstashcurexp(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 (txy mod 65536) = 0 then |
| if (tyy mod 65536) = 0 then begin {964:} |
| if (txx = 0) or (tyy = 0) then begin |
| tossedges(curedges); |
| curexp := getnode(6); |
| initedges(curexp) |
| end else begin |
| if txx < 0 then begin |
| xreflectedges; |
| txx := -txx |
| end; |
| if tyy < 0 then begin |
| yreflectedges; |
| tyy := -tyy |
| end; |
| if txx <> 65536 then |
| xscaleedges(txx div 65536); |
| if tyy <> 65536 then |
| yscaleedges(tyy div 65536); {965:} |
| tx := roundunscaled(tx); |
| ty := roundunscaled(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 |
| ; |
| printnl(133); |
| print(731) |
| end; |
| begin |
| helpptr := 3; |
| helpline[2] := 732; |
| helpline[1] := 404; |
| helpline[0] := 405 |
| 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 |
| ; |
| printnl(133); |
| print(728) |
| end; |
| begin |
| helpptr := 3; |
| helpline[2] := 729; |
| helpline[1] := 730; |
| helpline[0] := 405 |
| 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, constdependency(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 <> (-30000) 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 |
| fixdependencies |
| 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 |
| fixdependencies |
| 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, constdependency(0)); |
| if vv <> 0 then |
| addmultdep(p, vv, t); |
| if v <> 0 then |
| addmultdep(p, v, u); |
| if q <> (-30000) 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 begin {967:} |
| setupknowntrans(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 begin {973:} |
| 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 else begin {:973} |
| 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, -30000); |
| bilin2(r + 8, qq + 10, mem[q + 5].int, qq + 8, -30000); |
| bilin2(r + 6, qq + 4, mem[q + 11].int, qq + 6, -30000); |
| bilin2(r + 4, qq + 4, mem[q + 9].int, qq + 6, -30000) |
| 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(129, 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 := roundunscaled(mem[p + 1].int); |
| b := roundunscaled(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(129, 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 begin {981:} |
| 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 else begin {:981} {980:} |
| 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; { pairvalue } |
| {:982} |
| {984:} |
| |
| procedure setupoffset(p: halfword); |
| begin |
| findoffset(mem[p + 1].int, mem[p + 3].int, curexp); |
| pairvalue(curx, cury) |
| end; |
| |
| procedure setupdirectiontime(p: halfword); |
| begin |
| flushcurexp(finddirectiontime(mem[p + 1].int, mem[p + 3].int, curexp)) |
| end; {:984} {985:} |
| |
| procedure findpoint(v: scaled; c: quarterword); |
| var |
| p: halfword; |
| n: scaled; |
| vv: scaled; |
| q: halfword; |
| begin |
| vv := v; |
| 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 begin {986:} |
| 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 begin {924:} |
| begindiagnostic; |
| printnl(714); |
| printexp(p, 0); |
| printchar(41); |
| printop(c); |
| printchar(40); |
| printexp(-30000, 0); |
| print(706); |
| enddiagnostic(false) |
| end {:924}; {926:} |
| if mem[p].hh.b0 in |
| [13, 14, 19] then |
| case mem[p].hh.b0 of |
| 13, 14: |
| oldp := tarnished(p); |
| 19: |
| oldp := -29999 |
| end |
| else |
| oldp := -30000; |
| if oldp <> (-30000) then begin |
| q := stashcurexp; |
| oldp := p; |
| makeexpcopy(oldp); |
| p := stashcurexp; |
| unstashcurexp(q) |
| end; {:926} |
| {927:} |
| if curtype in |
| [13, 14, 19] then |
| case curtype of |
| 13, 14: |
| oldexp := tarnished(curexp); |
| 19: |
| oldexp := -29999 |
| end |
| else |
| oldexp := -30000; |
| if oldexp <> (-30000) 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; |
| addorsubtract(q, r, c); |
| addorsubtract(q + 2, r + 2, c) |
| end |
| else if mem[p].hh.b0 = 14 then |
| badbinary(p, c) |
| else |
| addorsubtract(p, -30000, c) {:929}; {936:} |
| 77, 78, 79, 80, 81, 82: |
| begin |
| if (curtype > 14) and (mem[p].hh.b0 > 14) then |
| addorsubtract(p, -30000, 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 begin {938:} |
| q := mem[curexp + 1].int; |
| while (q <> curexp) and (q <> p) do |
| q := mem[q + 1].int; |
| if q = p then |
| flushcurexp(0) |
| end else if (curtype = 14) or (curtype = 13) then begin {:938} {939:} |
| q := mem[p + 1].int; |
| r := mem[curexp + 1].int; |
| rr := (r + bignodesize[curtype]) - 2; |
| while true do begin |
| addorsubtract(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 else if curtype = 2 then {:939} |
| 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, 155); |
| begin |
| helpptr := 1; |
| helpline[0] := 715 |
| end |
| end else begin |
| helpptr := 2; |
| helpline[1] := 716; |
| helpline[0] := 717 |
| end; |
| disperr(-30000, 718); |
| putgetflusherror(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 begin {942:} |
| if mem[p].hh.b0 = 16 then begin |
| v := mem[p + 1].int; |
| freenode(p, 2) |
| end else begin |
| v := curexp; |
| unstashcurexp(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(-30000, v, true); |
| goto 10 |
| end else if (nicepair(p, mem[p].hh.b0) and (curtype > 14)) or (nicepair(curexp, curtype) and (mem[p].hh.b0 > 14)) then begin {:942} |
| 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; |
| unstashcurexp(p); |
| if v = 0 then begin {950:} |
| disperr(-30000, 648); |
| begin |
| helpptr := 2; |
| helpline[1] := 720; |
| helpline[0] := 721 |
| end; |
| putgeterror |
| end else begin {:950} |
| 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(-30000, 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 |
| materializepen; |
| 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 |
| setupdirectiontime(mem[p + 1].int) |
| else |
| badbinary(p, 96) |
| end; {:983} {988:} |
| 92: |
| begin |
| if mem[p].hh.b0 = 14 then begin |
| q := stashcurexp; |
| unstashcurexp(p); |
| pairtopath; |
| p := stashcurexp; |
| unstashcurexp(q) |
| end; |
| if curtype = 14 then |
| pairtopath; |
| if (curtype = 9) and (mem[p].hh.b0 = 9) then begin |
| pathintersection(mem[p + 1].int, curexp); |
| pairvalue(curt, curtt) |
| end else |
| badbinary(p, 92) |
| end |
| end {:988}; |
| recyclevalue(p); |
| freenode(p, 2); |
| 10: |
| begin |
| if aritherror then |
| cleararith |
| end; {925:} |
| if oldp <> (-30000) then begin |
| recyclevalue(oldp); |
| freenode(oldp, 2) |
| end; |
| if oldexp <> (-30000) 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 begin {945:} |
| begindiagnostic; |
| printnl(714); |
| printscaled(n); |
| printchar(47); |
| printscaled(d); |
| print(719); |
| printexp(-30000, 0); |
| print(706); |
| enddiagnostic(false) |
| end {:945}; |
| if curtype in |
| [13, 14, 19] then |
| case curtype of |
| 13, 14: |
| oldexp := tarnished(curexp); |
| 19: |
| oldexp := -29999 |
| end |
| else |
| oldexp := -30000; |
| if oldexp <> (-30000) 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(-30000, v, false); |
| if oldexp <> (-30000) then begin |
| recyclevalue(oldexp); |
| freenode(oldexp, 2) |
| end |
| end; {:944} {989:} {1155:} |
| |
| procedure gfswap; |
| begin |
| if gflimit = gfbufsize then begin |
| bwritebuf(gffile, gfbuf, 0, halfbuf - 1); |
| gflimit := halfbuf; |
| gfoffset := gfoffset + gfbufsize; |
| gfptr := 0 |
| end else begin |
| bwritebuf(gffile, gfbuf, halfbuf, gfbufsize - 1); |
| gflimit := gfbufsize |
| end |
| end; {:1155} {1157:} |
| |
| procedure gffour(x: integer); |
| begin |
| if x >= 0 then begin |
| gfbuf[gfptr] := x div 16777216; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end else begin |
| x := x + 1073741824; |
| x := x + 1073741824; |
| begin |
| gfbuf[gfptr] := (x div 16777216) + 128; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end |
| end; |
| x := x mod 16777216; |
| begin |
| gfbuf[gfptr] := x div 65536; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| x := x mod 65536; |
| begin |
| gfbuf[gfptr] := x div 256; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[gfptr] := x mod 256; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end |
| end; {:1157} {1158:} |
| |
| procedure gftwo(x: integer); |
| begin |
| begin |
| gfbuf[gfptr] := x div 256; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[gfptr] := x mod 256; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end |
| end; |
| |
| procedure gfthree(x: integer); |
| begin |
| begin |
| gfbuf[gfptr] := x div 65536; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[gfptr] := (x mod 65536) div 256; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[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 |
| gfbuf[gfptr] := 0 + d; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end else if d < 256 then begin |
| begin |
| gfbuf[gfptr] := 64; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[gfptr] := d; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end |
| end else begin |
| begin |
| gfbuf[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 |
| gfbuf[gfptr] := 239; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[gfptr] := l; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end |
| end else begin |
| begin |
| gfbuf[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 |
| gfbuf[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 |
| gfbuf[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 minm < gfminm then |
| gfminm := minm; |
| if maxn > gfmaxn 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 |
| gfbuf[gfptr] := 68; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[gfptr] := bocc; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[gfptr] := maxm - minm; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[gfptr] := maxm; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[gfptr] := maxn - minn; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[gfptr] := maxn; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| goto 10 |
| end; |
| begin |
| gfbuf[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 := 908 |
| else begin |
| oldsetting := selector; |
| selector := 5; |
| printchar(46); |
| printint(makescaled(internal[27], 59429463)); |
| print(909); |
| gfext := makestring; |
| selector := oldsetting |
| end {:1164}; |
| begin |
| if jobname = 0 then |
| openlogfile; |
| packjobname(gfext); |
| while not bopenout(gffile, nameoffile) do |
| promptfilename(620, gfext); |
| outputfilename := bmakenamestring(gffile) |
| end; |
| begin |
| gfbuf[gfptr] := 247; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[gfptr] := 131; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| oldsetting := selector; |
| selector := 5; |
| print(907); |
| printint(roundunscaled(internal[14])); |
| printchar(46); |
| printdd(roundunscaled(internal[15])); |
| printchar(46); |
| printdd(roundunscaled(internal[16])); |
| printchar(58); |
| t := roundunscaled(internal[17]); |
| printdd(t div 60); |
| printdd(t mod 60); |
| selector := oldsetting; |
| begin |
| gfbuf[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 outputfilename = 0 then |
| initgf; |
| f := roundunscaled(internal[19]); |
| xoff := roundunscaled(internal[29]); |
| yoff := roundunscaled(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; |
| flush(output); |
| bocc := (256 * f) + c; |
| bocp := charptr[c]; |
| charptr[c] := gfprevptr; |
| if internal[34] > 0 then begin {1166:} |
| if xoff <> 0 then begin |
| gfstring(308, 0); |
| begin |
| gfbuf[gfptr] := 243; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| gffour(xoff * 65536) |
| end; |
| if yoff <> 0 then begin |
| gfstring(309, 0); |
| begin |
| gfbuf[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 > (-29999) then |
| sortedges(p); |
| q := mem[p + 1].hh.rh; |
| w := 0; |
| prevm := -268435456; |
| ww := 0; |
| prevw := 0; |
| m := prevm; |
| repeat |
| if q = 30000 then |
| mm := 268435456 |
| else begin |
| d := mem[q].hh.lh + 32768; |
| 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 begin {1170:} |
| if prevm = (-268435456) then begin {1172:} |
| 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 begin {1174:} |
| delta := (prevn - n) - 1; |
| if delta < 256 then |
| if delta = 0 then begin |
| gfbuf[gfptr] := 70; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end else begin |
| begin |
| gfbuf[gfptr] := 71; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[gfptr] := delta; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end |
| end |
| else begin |
| begin |
| gfbuf[gfptr] := 72; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| gftwo(delta) |
| end |
| end else begin {:1174} {1173:} |
| delta := m - curminm; |
| if delta > 164 then begin |
| gfbuf[gfptr] := 70; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end else begin |
| begin |
| gfbuf[gfptr] := 74 + delta; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| goto 30 |
| end |
| end {:1173}; |
| gfpaint(m - curminm); |
| 30: |
| prevn := n |
| end else {:1172} |
| gfpaint(m - prevm); |
| prevm := m; |
| prevw := w |
| end {:1170} |
| end else if w <= 0 then begin {1171:} |
| 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(911); |
| 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 begin {1168:} |
| gfboc(0, 0, 0, 0); |
| if gfmaxm < 0 then |
| gfmaxm := 0; |
| if gfminn > 0 then |
| gfminn := 0 |
| end else if (prevn + yoff) < gfminn then {:1168} |
| gfminn := prevn + yoff {:1167}; |
| begin |
| gfbuf[gfptr] := 69; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| gfprevptr := gfoffset + gfptr; |
| totalchars := totalchars + 1; |
| printchar(93); |
| flush(output); |
| if internal[11] > 0 then |
| printedges(910, true, xoff, yoff) |
| end; { shipout } |
| {: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; {1007:} |
| begin |
| t := mem[l].hh.b0; |
| if t = 16 then begin |
| t := 17; |
| p := constdependency(-mem[l + 1].int); |
| q := p |
| end else if t = 19 then begin |
| t := 17; |
| p := singledependency(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 = (-30000) 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 = (-30000) 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 := singledependency(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 := singledependency(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 <> (-30000) do begin |
| mem[q + 1].int := roundfraction(mem[q + 1].int); |
| q := mem[q].hh.rh |
| end; |
| t := 18; |
| p := pplusq(p, pp, t) |
| end; |
| watchcoefs := true; |
| {:1010} |
| if copied then |
| flushnodelist(pp); |
| 31: {:1009} |
| ; |
| if mem[p].hh.lh = (-30000) then begin {1008:} |
| if abs(mem[p + 1].int) > 64 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(761) |
| end; |
| print(763); |
| printscaled(mem[p + 1].int); |
| printchar(41); |
| begin |
| helpptr := 2; |
| helpline[1] := 762; |
| helpline[0] := 760 |
| end; |
| putgeterror |
| end else if r = (-30000) then begin {623:} |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(465) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 466; |
| helpline[0] := 467 |
| end; |
| putgeterror |
| end {:623}; |
| freenode(p, 2) |
| end else begin {:1008} |
| lineareq(p, t); |
| if r = (-30000) 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 begin {1004:} |
| 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 |
| ; |
| printnl(133); |
| print(465) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 466; |
| helpline[0] := 467 |
| end; |
| putgeterror |
| end {:623}; |
| goto 30 |
| end; |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(758) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 759; |
| helpline[0] := 760 |
| end; |
| putgeterror; |
| goto 30; |
| 45: |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(761) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 762; |
| helpline[0] := 760 |
| 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 begin {1005:} |
| 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, -30000); |
| goto 30 |
| end; |
| 1: |
| |
| end |
| {:1003}; {1002:} |
| disperr(lhs, 155); |
| disperr(-30000, 755); |
| if mem[lhs].hh.b0 <= 14 then |
| printtype(mem[lhs].hh.b0) |
| else |
| print(211); |
| printchar(61); |
| if curtype <= 14 then |
| printtype(curtype) |
| else |
| print(211); |
| printchar(41); |
| begin |
| helpptr := 2; |
| helpline[1] := 756; |
| helpline[0] := 757 |
| end; {:1002} |
| putgeterror; |
| 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; |
| scanexpression; |
| if curcmd = 51 then |
| doequation |
| else if curcmd = 77 then |
| doassignment; |
| if internal[7] > 131072 then begin {997:} |
| begindiagnostic; |
| printnl(714); |
| printexp(lhs, 0); |
| print(750); |
| printexp(-30000, 0); |
| print(706); |
| enddiagnostic(false) |
| end {:997}; |
| if curtype = 10 then |
| if mem[lhs].hh.b0 = 14 then begin |
| p := stashcurexp; |
| unstashcurexp(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(-30000, 747); |
| begin |
| helpptr := 2; |
| helpline[1] := 748; |
| helpline[0] := 749 |
| end; |
| error; |
| doequation |
| end else begin |
| lhs := curexp; |
| curtype := 1; |
| getxnext; |
| varflag := 77; |
| scanexpression; |
| if curcmd = 51 then |
| doequation |
| else if curcmd = 77 then |
| doassignment; |
| if internal[7] > 131072 then begin {998:} |
| begindiagnostic; |
| printnl(123); |
| if mem[lhs].hh.lh > 2241 then |
| print(intname[mem[lhs].hh.lh - 2241]) |
| else |
| showtokenlist(lhs, -30000, 1000, 0); |
| print(329); |
| printexp(-30000, 0); |
| printchar(125); |
| enddiagnostic(false) |
| end {:998}; |
| if mem[lhs].hh.lh > 2241 then {999:} |
| if curtype = 16 then |
| internal[mem[lhs].hh.lh - 2241] := curexp |
| else begin |
| disperr(-30000, 751); |
| print(intname[mem[lhs].hh.lh - 2241]); |
| print(752); |
| begin |
| helpptr := 2; |
| helpline[1] := 753; |
| helpline[0] := 754 |
| end; |
| putgeterror |
| end {:999} {1000:} |
| else begin |
| p := findvariable(lhs); |
| if p <> (-30000) then begin |
| q := stashcurexp; |
| curtype := undtype(p); |
| recyclevalue(p); |
| mem[p].hh.b0 := curtype; |
| mem[p + 1].int := -30000; |
| makeexpcopy(p); |
| p := stashcurexp; |
| unstashcurexp(q); |
| makeeq(p) |
| end else begin |
| obliterated(lhs); |
| putgeterror |
| end |
| end {:1000}; |
| flushnodelist(lhs) |
| end |
| end; {:996} {1015:} |
| |
| procedure dotypedeclaration; |
| var |
| t: smallnumber; |
| p: halfword; |
| q: halfword; |
| begin |
| if curmod >= 13 then |
| t := curmod |
| else |
| t := curmod + 1; |
| repeat |
| p := scandeclaredvariable; |
| flushvariable(eqtb[mem[p].hh.lh].rh, mem[p].hh.rh, false); |
| q := findvariable(p); |
| if q <> (-30000) then begin |
| mem[q].hh.b0 := t; |
| mem[q + 1].int := -30000 |
| end else begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(764) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 765; |
| helpline[0] := 766 |
| end; |
| putgeterror |
| end; |
| flushlist(p); |
| if curcmd < 79 then begin {1016:} |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(767) |
| end; |
| begin |
| helpptr := 5; |
| helpline[4] := 768; |
| helpline[3] := 769; |
| helpline[2] := 770; |
| helpline[1] := 771; |
| helpline[0] := 772 |
| end; |
| if curcmd = 42 then |
| helpline[2] := 773; |
| putgeterror; |
| scannerstatus := 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 >= 79; |
| scannerstatus := 0 |
| end {:1016} |
| until curcmd > 79 |
| end; { dotypedeclaration } |
| {:1015} |
| {1021:} |
| |
| procedure dorandomseed; |
| begin |
| getxnext; |
| if curcmd <> 77 then begin |
| missingerr(329); |
| begin |
| helpptr := 1; |
| helpline[0] := 778 |
| end; |
| backerror |
| end; |
| getxnext; |
| scanexpression; |
| if curtype <> 16 then begin |
| disperr(-30000, 779); |
| begin |
| helpptr := 2; |
| helpline[1] := 780; |
| helpline[0] := 781 |
| end; |
| putgetflusherror(0) |
| end else begin {1022:} |
| initrandoms(curexp); |
| if selector >= 2 then begin |
| oldsetting := selector; |
| selector := 2; |
| printnl(782); |
| printscaled(curexp); |
| printchar(125); |
| printnl(155); |
| 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 >= 83 then |
| eqtb[cursym].lh := t - 83 |
| end else if t < 83 then |
| eqtb[cursym].lh := t + 83; |
| getxnext |
| until curcmd <> 79 |
| end; {:1029} {1031:} |
| |
| procedure defdelims; |
| var |
| ldelim, rdelim: halfword; |
| begin |
| getclearsymbol; |
| ldelim := cursym; |
| getclearsymbol; |
| 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 |
| ; |
| printnl(133); |
| print(788) |
| end; |
| if cursym = 0 then |
| print(793) |
| else |
| print(hash[cursym].rh); |
| print(794); |
| begin |
| helpptr := 1; |
| helpline[0] := 795 |
| end; |
| backerror |
| end else begin |
| saveinternal(curmod); |
| backinput |
| end; |
| dostatement |
| end; { dointerim } |
| {: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] := 796; |
| helpline[1] := 538; |
| helpline[0] := 797 |
| end; |
| backerror |
| end; |
| getsymbol; |
| if curcmd in |
| [10, 53, 44, 49] then |
| case curcmd of |
| 10, 53, 44, 49: |
| mem[curmod].hh.lh := mem[curmod].hh.lh + 1 |
| end |
| else |
| ; |
| clearsymbol(l, false); |
| eqtb[l].lh := curcmd; |
| if curcmd = 41 then |
| eqtb[l].rh := -30000 |
| else |
| eqtb[l].rh := curmod; |
| getxnext |
| end; {:1035} {1036:} |
| |
| procedure donewinternal; |
| begin |
| repeat |
| if intptr = maxinternal then |
| overflow(798, maxinternal); |
| getclearsymbol; |
| intptr := intptr + 1; |
| eqtb[cursym].lh := 40; |
| eqtb[cursym].rh := intptr; |
| intname[intptr] := hash[cursym].rh; |
| internal[intptr] := 0; |
| getxnext |
| until curcmd <> 79 |
| end; {:1036} {1040:} |
| |
| procedure doshow; |
| begin |
| repeat |
| getxnext; |
| scanexpression; |
| printnl(629); |
| printexp(-30000, 2); |
| flushcurexp(0) |
| until curcmd <> 79 |
| end; {:1040} {1041:} |
| |
| procedure disptoken; |
| begin |
| printnl(804); |
| if cursym = 0 then begin {1042:} |
| 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 else begin {:1042} |
| print(hash[cursym].rh); |
| printchar(61); |
| if eqtb[cursym].lh >= 83 then |
| print(805); |
| printcmdmod(curcmd, curmod); |
| if curcmd = 10 then begin |
| println; |
| showmacro(curmod, -30000, 100000) |
| end |
| end |
| end; {:1041} {1044:} |
| |
| procedure doshowtoken; |
| begin |
| repeat |
| getnext; |
| disptoken; |
| getxnext |
| until curcmd <> 79 |
| end; {:1044} {1045:} |
| |
| procedure doshowstats; |
| {printint(varused);printchar(38);printint(dynused); |
| if false then} |
| begin |
| printnl(814); |
| print(228); |
| print(425); |
| printint((himemmin - lomemmax) - 1); |
| print(815); |
| println; |
| printnl(816); |
| printint(strptr - initstrptr); |
| printchar(38); |
| printint(poolptr - initpoolptr); |
| print(425); |
| printint(maxstrings - maxstrptr); |
| printchar(38); |
| printint(poolsize - maxpoolptr); |
| print(815); |
| println; |
| getxnext |
| end; {:1045} |
| {1046:} |
| |
| procedure dispvar(p: halfword); |
| var |
| q: halfword; |
| n: 0..maxprintline; |
| begin |
| if mem[p].hh.b0 = 21 then begin {1047:} |
| q := mem[p + 1].hh.lh; |
| repeat |
| dispvar(q); |
| q := mem[q].hh.rh |
| until q = (-29983); |
| q := mem[p + 1].hh.rh; |
| while mem[q].hh.b1 = 3 do begin |
| dispvar(q); |
| q := mem[q].hh.rh |
| end |
| end else if mem[p].hh.b0 >= 22 then begin {:1047} {1048:} |
| printnl(155); |
| printvariablename(p); |
| if mem[p].hh.b0 > 22 then |
| print(530); |
| print(817); |
| if fileoffset >= (maxprintline - 20) then |
| n := 5 |
| else |
| n := (maxprintline - fileoffset) - 15; |
| showmacro(mem[p + 1].int, -30000, n) |
| end else if mem[p].hh.b0 <> 0 then begin {:1048} |
| printnl(155); |
| printvariablename(p); |
| printchar(61); |
| printexp(p, 0) |
| end |
| end; {:1046} {1049:} |
| |
| procedure doshowvar; |
| label |
| 30; |
| begin |
| repeat |
| getnext; |
| if cursym > 0 then |
| if cursym <= 2241 then |
| if curcmd = 41 then |
| if curmod <> (-30000) then begin |
| dispvar(curmod); |
| goto 30 |
| end; |
| disptoken; |
| 30: |
| getxnext |
| until curcmd <> 79 |
| end; {:1049} {1050:} |
| |
| procedure doshowdependencies; |
| var |
| p: halfword; |
| begin |
| p := mem[-29987].hh.rh; |
| while p <> (-29987) do begin |
| if interesting(p) then begin |
| printnl(155); |
| printvariablename(p); |
| if mem[p].hh.b0 = 17 then |
| printchar(61) |
| else |
| print(632); |
| printdependency(mem[p + 1].hh.rh, mem[p].hh.b0) |
| end; |
| p := mem[p + 1].hh.rh; |
| while mem[p].hh.lh <> (-30000) do |
| p := mem[p].hh.rh; |
| p := mem[p].hh.rh |
| end; |
| getxnext |
| end; {:1050} {1051:} |
| |
| procedure doshowwhatever; |
| begin |
| if interaction = 3 then |
| ; |
| case curmod of |
| 0: |
| doshowtoken; |
| 1: |
| doshowstats; |
| 2: |
| doshow; |
| 3: |
| doshowvar; |
| 4: |
| doshowdependencies |
| end; |
| if internal[32] > 0 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(818) |
| end; |
| if interaction < 3 then begin |
| helpptr := 0; |
| errorcount := errorcount - 1 |
| end else begin |
| helpptr := 1; |
| helpline[0] := 819 |
| end; |
| if curcmd = 80 then |
| error |
| else |
| putgeterror |
| end |
| end; {:1051} {1054:} |
| |
| function scanwith: boolean; |
| var |
| t: smallnumber; |
| result: boolean; |
| begin |
| t := curmod; |
| curtype := 1; |
| getxnext; |
| scanexpression; |
| result := false; |
| if curtype <> t then begin {1055:} |
| disperr(-30000, 827); |
| begin |
| helpptr := 2; |
| helpline[1] := 828; |
| helpline[0] := 829 |
| end; |
| if t = 6 then |
| helpline[1] := 830; |
| putgetflusherror(0) |
| end else if curtype = 6 then {:1055} |
| result := true {1056:} |
| else begin |
| curexp := roundunscaled(curexp); |
| if (abs(curexp) < 4) and (curexp <> 0) then |
| result := true |
| else begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(831) |
| end; |
| begin |
| helpptr := 1; |
| helpline[0] := 829 |
| end; |
| putgetflusherror(0) |
| end |
| end {:1056}; |
| scanwith := result |
| end; {:1054} {1057:} |
| |
| procedure findedgesvar(t: halfword); |
| var |
| p: halfword; |
| begin |
| p := findvariable(t); |
| curedges := -30000; |
| if p = (-30000) then begin |
| obliterated(t); |
| putgeterror |
| end else if mem[p].hh.b0 <> 11 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(654) |
| end; |
| showtokenlist(t, -30000, 1000, 0); |
| print(832); |
| printtype(mem[p].hh.b0); |
| printchar(41); |
| begin |
| helpptr := 2; |
| helpline[1] := 833; |
| helpline[0] := 834 |
| end; |
| putgeterror |
| end else |
| curedges := mem[p + 1].int; |
| flushnodelist(t) |
| end; {:1057} {1059:} |
| |
| procedure doaddto; |
| label |
| 30, 45; |
| var |
| lhs, rhs: halfword; |
| t: smallnumber; |
| w: integer; |
| p: halfword; |
| q: halfword; |
| begin |
| getxnext; |
| varflag := 68; |
| scanprimary; |
| if curtype <> 20 then begin {1060:} |
| disperr(-30000, 835); |
| begin |
| helpptr := 4; |
| helpline[3] := 836; |
| helpline[2] := 837; |
| helpline[1] := 838; |
| helpline[0] := 834 |
| end; |
| putgetflusherror(0) |
| end else begin {:1060} |
| lhs := curexp; |
| curpathtype := curmod; |
| curtype := 1; |
| getxnext; |
| scanexpression; |
| if curpathtype = 2 then begin {1061:} |
| findedgesvar(lhs); |
| if curedges = (-30000) then |
| flushcurexp(0) |
| else if curtype <> 11 then begin |
| disperr(-30000, 839); |
| begin |
| helpptr := 2; |
| helpline[1] := 840; |
| helpline[0] := 834 |
| end; |
| putgetflusherror(0) |
| end else begin |
| mergeedges(curexp); |
| flushcurexp(0) |
| end |
| end else begin {:1061} {1062:} |
| if curtype = 14 then |
| pairtopath; |
| if curtype <> 9 then begin |
| disperr(-30000, 839); |
| begin |
| helpptr := 2; |
| helpline[1] := 841; |
| helpline[0] := 834 |
| end; |
| putgetflusherror(0); |
| flushtokenlist(lhs) |
| end else begin |
| rhs := curexp; |
| w := 1; |
| curpen := -29997; |
| { |
| 1063:} |
| while curcmd = 66 do |
| if scanwith then |
| if curtype = 16 then |
| w := curexp |
| else begin |
| if mem[curpen].hh.lh = (-30000) then |
| tosspen(curpen) |
| else |
| mem[curpen].hh.lh := mem[curpen].hh.lh - 1; |
| curpen := curexp |
| end {:1063}; {1064:} |
| findedgesvar(lhs); |
| if curedges = (-30000) then |
| tossknotlist(rhs) |
| else begin |
| lhs := -30000; |
| if mem[rhs].hh.b0 = 0 then |
| if curpathtype = 0 then {1065:} |
| if mem[rhs].hh.rh = rhs then begin {1066:} |
| 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 else begin {:1066} |
| 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} {1067:} |
| else begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(842) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 843; |
| helpline[0] := 834 |
| 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 turningnumber <= 0 then |
| if curpathtype <> 0 then |
| if internal[39] > 0 then |
| if (turningnumber < 0) and (mem[curpen].hh.rh = (-30000)) then |
| curwt := -curwt |
| else begin |
| if turningnumber = 0 then |
| if (internal[39] <= 65536) and (mem[curpen].hh.rh = (-30000)) then |
| goto 30 |
| else |
| printstrange(844) |
| else |
| printstrange(845); |
| begin |
| helpptr := 3; |
| helpline[2] := 846; |
| helpline[1] := 847; |
| helpline[0] := 848 |
| end; |
| putgeterror |
| end; |
| 30: {:1068} |
| ; |
| if mem[curpen + 9].int = 0 then |
| fillspec(rhs) |
| else |
| fillenvelope(rhs); |
| if lhs <> (-30000) 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: {:1064} |
| |
| end; |
| if mem[curpen].hh.lh = (-30000) 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 |
| ; |
| printnl(133); |
| print(865) |
| end; |
| print(intname[m]); |
| print(866); |
| begin |
| helpptr := 1; |
| helpline[0] := 867 |
| 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 := 80; |
| scanexpression; |
| {1060: |
| } |
| if curtype <> 20 then |
| if curtype = 11 then |
| curedges := curexp |
| else begin |
| begin |
| disperr(-30000, 835); |
| begin |
| helpptr := 4; |
| helpline[3] := 836; |
| helpline[2] := 837; |
| helpline[1] := 838; |
| helpline[0] := 834 |
| end; |
| putgetflusherror(0) |
| end {:1060}; |
| goto 10 |
| end |
| else begin |
| findedgesvar(curexp); |
| curtype := 1 |
| end; |
| if curedges <> (-30000) then begin |
| c := roundunscaled(internal[18]) mod 256; |
| if c < 0 then |
| c := c + 256; {1099:} |
| if c < bc then |
| bc := c; |
| if c > ec 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 begin {1060:} |
| disperr(-30000, 835); |
| begin |
| helpptr := 4; |
| helpline[3] := 836; |
| helpline[2] := 837; |
| helpline[1] := 838; |
| helpline[0] := 834 |
| end; |
| putgetflusherror(0) |
| end else begin {:1060} |
| e := curexp; |
| curtype := 1; |
| getxnext; |
| scanexpression; |
| if curtype <> 16 then |
| goto 50; |
| curexp := roundunscaled(curexp); |
| if curexp < 0 then |
| goto 45; |
| if curexp > 15 then |
| goto 45; |
| if not windowopen[curexp] then |
| goto 45; |
| findedgesvar(e); |
| if curedges <> (-30000) then |
| dispedges(curexp); |
| goto 10; |
| 45: |
| curexp := curexp * 65536; |
| 50: |
| disperr(-30000, 849); |
| begin |
| helpptr := 1; |
| helpline[0] := 850 |
| end; |
| putgetflusherror(0); |
| flushtokenlist(e) |
| end; |
| 10: |
| |
| end; { dodisplay } |
| {:1071} |
| {1072:} |
| |
| function getpair(c: commandcode): boolean; |
| var |
| p: halfword; |
| b: boolean; |
| begin |
| if curcmd <> c then |
| getpair := false |
| else begin |
| getxnext; |
| scanexpression; |
| 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; |
| scanexpression; |
| if curtype <> 16 then |
| goto 45; |
| k := roundunscaled(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 |
| ; |
| printnl(133); |
| print(851) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 852; |
| helpline[0] := 853 |
| 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 begin {1060:} |
| disperr(-30000, 835); |
| begin |
| helpptr := 4; |
| helpline[3] := 836; |
| helpline[2] := 837; |
| helpline[1] := 838; |
| helpline[0] := 834 |
| end; |
| putgetflusherror(0) |
| end else begin {:1060} |
| 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 <> (-30000) then |
| culledges(floorunscaled(curx + 65535), floorunscaled(cury), wout, win); |
| goto 10; |
| 45: |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(854) |
| end; |
| begin |
| helpptr := 1; |
| helpline[0] := 855 |
| end; |
| putgeterror; |
| flushtokenlist(e) |
| end; |
| 10: |
| |
| end; {:1074} {1082:} |
| |
| procedure domessage; |
| var |
| m: 0..2; |
| begin |
| m := curmod; |
| getxnext; |
| scanexpression; |
| if curtype <> 4 then begin |
| disperr(-30000, 565); |
| begin |
| helpptr := 1; |
| helpline[0] := 859 |
| end; |
| putgeterror |
| end else |
| case m of |
| 0: |
| begin |
| printnl(155); |
| slowprint(curexp) |
| end; |
| 1: |
| begin {1086:} |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(155) |
| end; |
| slowprint(curexp); |
| if errhelp <> 0 then |
| useerrhelp := true |
| else if longhelpseen then begin |
| helpptr := 1; |
| helpline[0] := 860 |
| end else begin |
| if interaction < 3 then |
| longhelpseen := true; |
| begin |
| helpptr := 4; |
| helpline[3] := 861; |
| helpline[2] := 862; |
| helpline[1] := 863; |
| helpline[0] := 864 |
| end |
| end; |
| putgeterror; |
| useerrhelp := false |
| end; {:1086} |
| 2: |
| begin {1083:} |
| 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 |
| end {:1083}; |
| flushcurexp(0) |
| end; {:1082} {1103:} |
| |
| function getcode: eightbits; |
| label |
| 40; |
| var |
| c: integer; |
| begin |
| getxnext; |
| scanexpression; |
| if curtype = 16 then begin |
| c := roundunscaled(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(-30000, 873); |
| begin |
| helpptr := 2; |
| helpline[1] := 874; |
| helpline[0] := 875 |
| end; |
| putgetflusherror(0); |
| c := 0; |
| 40: |
| getcode := c |
| end; {:1103} {1104:} |
| |
| procedure settag(c: eightbits; t: smallnumber; r: eightbits); |
| begin |
| if chartag[c] = 0 then begin |
| chartag[c] := t; |
| charremainder[c] := r |
| end else begin {1105:} |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(876) |
| end; |
| if (c > 32) and (c < 128) then |
| print(c) |
| else begin |
| print(877); |
| printint(c) |
| end; |
| print(878); |
| case chartag[c] of |
| 1: |
| print(879); |
| 2: |
| print(880); |
| 3: |
| print(870) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 881; |
| helpline[0] := 834 |
| end; |
| putgeterror |
| end {:1105} |
| end; {:1104} {1106:} |
| |
| procedure dotfmcommand; |
| label |
| 22; |
| var |
| c, cc: eightbits; |
| k: 0..256; |
| j: integer; |
| begin |
| case curmod of |
| 0: |
| begin {1107:} |
| c := getcode; |
| while curcmd = 78 do begin |
| cc := getcode; |
| settag(c, 2, cc); |
| c := cc |
| end |
| end; {:1107} |
| 1: |
| begin {1108:} |
| 22: |
| c := getcode; |
| if curcmd = 78 then begin {1111:} |
| if nl < 256 then |
| settag(c, 1, nl) |
| else begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(891) |
| end; |
| begin |
| helpptr := 1; |
| helpline[0] := 892 |
| end; |
| error |
| end; |
| goto 22 |
| end {:1111}; |
| if curcmd = 76 then begin {1112:} |
| ligkern[nl].b1 := c - 128; |
| ligkern[nl].b2 := curmod - 128; |
| ligkern[nl].b0 := -128; |
| if curmod = 0 then |
| ligkern[nl].b3 := getcode - 128 |
| else begin |
| getxnext; |
| scanexpression; |
| if curtype <> 16 then begin |
| disperr(-30000, 893); |
| begin |
| helpptr := 2; |
| helpline[1] := 894; |
| helpline[0] := 179 |
| end; |
| putgetflusherror(0) |
| end; |
| kern[nk] := curexp; |
| k := 0; |
| while kern[k] <> curexp do |
| k := k + 1; |
| if k = nk then begin |
| if nk = 256 then |
| overflow(890, 256); |
| nk := nk + 1 |
| end; |
| ligkern[nl].b3 := k - 128 |
| end {:1112}; |
| if nl = ligtablesize then |
| overflow(886, ligtablesize); |
| nl := nl + 1; |
| if curcmd = 79 then |
| goto 22 |
| end else begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(887) |
| end; |
| begin |
| helpptr := 1; |
| helpline[0] := 888 |
| end; |
| backerror |
| end; |
| if nl > 0 then |
| ligkern[nl - 1].b0 := 0 |
| end; {:1108} |
| 2: |
| begin {1113:} |
| if ne = 256 then |
| overflow(870, 256); |
| c := getcode; |
| settag(c, 3, ne); |
| if curcmd <> 78 then begin |
| missingerr(58); |
| begin |
| helpptr := 1; |
| helpline[0] := 895 |
| end; |
| backerror |
| end; |
| exten[ne].b0 := getcode - 128; |
| if curcmd <> 79 then begin |
| missingerr(44); |
| begin |
| helpptr := 1; |
| helpline[0] := 895 |
| end; |
| backerror |
| end; |
| exten[ne].b1 := getcode - 128; |
| if curcmd <> 79 then begin |
| missingerr(44); |
| begin |
| helpptr := 1; |
| helpline[0] := 895 |
| end; |
| backerror |
| end; |
| exten[ne].b2 := getcode - 128; |
| if curcmd <> 79 then begin |
| missingerr(44); |
| begin |
| helpptr := 1; |
| helpline[0] := 895 |
| end; |
| backerror |
| end; |
| exten[ne].b3 := getcode - 128; |
| ne := ne + 1 |
| end; {:1113} |
| 3, 4: |
| begin |
| c := curmod; |
| getxnext; |
| scanexpression; |
| if (curtype <> 16) or (curexp < 32768) then begin |
| disperr(-30000, 882); |
| begin |
| helpptr := 2; |
| helpline[1] := 883; |
| helpline[0] := 884 |
| end; |
| putgeterror |
| end else begin |
| j := roundunscaled(curexp); |
| if curcmd <> 78 then begin |
| missingerr(58); |
| begin |
| helpptr := 1; |
| helpline[0] := 885 |
| end; |
| backerror |
| end; |
| if c = 3 then {1114:} |
| repeat |
| if j > headersize then |
| overflow(871, headersize); |
| headerbyte[j] := getcode; |
| j := j + 1 |
| until curcmd <> 79 {:1114} {1115:} |
| else |
| repeat |
| if j > maxfontdimen then |
| overflow(872, maxfontdimen); |
| while j > np do begin |
| np := np + 1; |
| param[np] := 0 |
| end; |
| getxnext; |
| scanexpression; |
| if curtype <> 16 then begin |
| disperr(-30000, 896); |
| begin |
| helpptr := 1; |
| helpline[0] := 179 |
| end; |
| putgetflusherror(0) |
| end; |
| param[j] := curexp; |
| j := j + 1 |
| until curcmd <> 79 {:1115} |
| end |
| end |
| end |
| end; {:1106} {1177:} |
| |
| procedure dospecial; |
| var |
| m: smallnumber; |
| begin |
| m := curmod; |
| getxnext; |
| scanexpression; |
| if internal[34] >= 0 then |
| if curtype <> m then begin {1178:} |
| disperr(-30000, 914); |
| begin |
| helpptr := 1; |
| helpline[0] := 915 |
| end; |
| putgeterror |
| end else begin {:1178} |
| if outputfilename = 0 then |
| initgf; |
| if m = 4 then |
| gfstring(curexp, 0) |
| else begin |
| begin |
| gfbuf[gfptr] := 243; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| gffour(curexp) |
| end |
| end; |
| flushcurexp(0) |
| end; {:1177} {1186:} |
| {procedure storebasefile;var k:integer; |
| p,q:halfword;x:integer;w:fourquarters;begin[1200:]selector:=5; |
| print(925);print(jobname);printchar(32); |
| printint(roundunscaled(internal[14])mod 100);printchar(46); |
| printint(roundunscaled(internal[15]));printchar(46); |
| printint(roundunscaled(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(129,poolsize-initpoolptr);maxpoolptr:=poolptr+1;end;end; |
| baseident:=makestring;strref[baseident]:=127;packjobname(926); |
| while not wopenout(basefile)do promptfilename(927,926);printnl(928); |
| print(wmakenamestring(basefile));flushstring(strptr-1); |
| printnl(baseident)[:1200];[1190:]begin basefile^.int:=503742536; |
| put(basefile);end;begin basefile^.int:=-30000;put(basefile);end; |
| begin basefile^.int:=30000;put(basefile);end;begin basefile^.int:=2100; |
| put(basefile);end;begin basefile^.int:=1777;put(basefile);end; |
| begin basefile^.int:=6;put(basefile);end[:1190]; |
| [1192:]begin basefile^.int:=poolptr;put(basefile);end; |
| begin basefile^.int:=strptr;put(basefile);end; |
| for k:=0 to strptr do begin basefile^.int:=strstart[k];put(basefile); |
| end;k:=0;while k+4<poolptr do begin w.b0:=strpool[k];w.b1:=strpool[k+1]; |
| w.b2:=strpool[k+2];w.b3:=strpool[k+3];begin basefile^.qqqq:=w; |
| put(basefile);end;k:=k+4;end;k:=poolptr-4;w.b0:=strpool[k]; |
| w.b1:=strpool[k+1];w.b2:=strpool[k+2];w.b3:=strpool[k+3]; |
| begin basefile^.qqqq:=w;put(basefile);end;println;printint(strptr); |
| print(922);printint(poolptr)[:1192];[1194:]sortavail;varused:=0; |
| begin basefile^.int:=lomemmax;put(basefile);end; |
| begin basefile^.int:=rover;put(basefile);end;p:=-30000;q:=rover;x:=0; |
| repeat for k:=p to q+1 do begin basefile^:=mem[k];put(basefile);end; |
| x:=x+q+2-p;varused:=varused+q-p;p:=q+mem[q].hh.lh;q:=mem[q+1].hh.rh; |
| until q=rover;varused:=varused+lomemmax-p;dynused:=memend+1-himemmin; |
| for k:=p to lomemmax do begin basefile^:=mem[k];put(basefile);end; |
| x:=x+lomemmax+1-p;begin basefile^.int:=himemmin;put(basefile);end; |
| begin basefile^.int:=avail;put(basefile);end; |
| for k:=himemmin to memend do begin basefile^:=mem[k];put(basefile);end; |
| x:=x+memend+1-himemmin;p:=avail; |
| while p<>-30000 do begin dynused:=dynused-1;p:=mem[p].hh.rh;end; |
| begin basefile^.int:=varused;put(basefile);end; |
| begin basefile^.int:=dynused;put(basefile);end;println;printint(x); |
| print(923);printint(varused);printchar(38);printint(dynused)[:1194]; |
| [1196:]begin basefile^.int:=hashused;put(basefile);end; |
| stcount:=2228-hashused; |
| for p:=1 to hashused do if hash[p].rh<>0 then begin begin basefile^.int |
| :=p;put(basefile);end;begin basefile^.hh:=hash[p];put(basefile);end; |
| begin basefile^.hh:=eqtb[p];put(basefile);end;stcount:=stcount+1;end; |
| for p:=hashused+1 to 2241 do begin begin basefile^.hh:=hash[p]; |
| put(basefile);end;begin basefile^.hh:=eqtb[p];put(basefile);end;end; |
| begin basefile^.int:=stcount;put(basefile);end;println; |
| printint(stcount);print(924)[:1196];[1198:]begin basefile^.int:=intptr; |
| put(basefile);end; |
| for k:=1 to intptr do begin begin basefile^.int:=internal[k]; |
| put(basefile);end;begin basefile^.int:=intname[k];put(basefile);end;end; |
| begin basefile^.int:=startsym;put(basefile);end; |
| begin basefile^.int:=interaction;put(basefile);end; |
| begin basefile^.int:=baseident;put(basefile);end; |
| begin basefile^.int:=bgloc;put(basefile);end;begin basefile^.int:=egloc; |
| put(basefile);end;begin basefile^.int:=serialno;put(basefile);end; |
| begin basefile^.int:=69069;put(basefile);end;internal[12]:=0[:1198]; |
| [1201:]wclose(basefile)[:1201];end;} |
| {:1186} |
| |
| procedure dostatement; |
| begin |
| curtype := 1; |
| getxnext; |
| if curcmd > 43 then begin {990:} |
| if curcmd < 80 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(733) |
| end; |
| printcmdmod(curcmd, curmod); |
| printchar(39); |
| begin |
| helpptr := 5; |
| helpline[4] := 734; |
| helpline[3] := 735; |
| helpline[2] := 736; |
| helpline[1] := 737; |
| helpline[0] := 738 |
| end; |
| backerror; |
| getxnext |
| end |
| end else if curcmd > 30 then begin {:990} {993:} |
| varflag := 77; |
| scanexpression; |
| if curcmd < 81 then begin |
| if curcmd = 51 then |
| doequation |
| else if curcmd = 77 then |
| doassignment |
| else if curtype = 4 then begin {994:} |
| if internal[1] > 0 then begin |
| printnl(155); |
| slowprint(curexp); |
| {---------------------} |
| auxprintnl(155); |
| auxslowprint(curexp); |
| {---------------------} |
| flush(output) |
| end; |
| if internal[34] > 0 then begin {1179:} |
| if outputfilename = 0 then |
| initgf; |
| gfstring(916, curexp) |
| end {:1179} |
| end else if curtype <> 1 then begin {:994} |
| disperr(-30000, 743); |
| begin |
| helpptr := 3; |
| helpline[2] := 744; |
| helpline[1] := 745; |
| helpline[0] := 746 |
| end; |
| putgeterror |
| end; |
| flushcurexp(0); |
| curtype := 1 |
| end |
| end else begin {:993} {992:} |
| if internal[7] > 0 then |
| showcmdmod(curcmd, curmod); |
| case curcmd of |
| 30: |
| dotypedeclaration; |
| 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 jobname <> 0 then |
| selector := selector + 2; |
| getxnext |
| end; {:1023} {1026:} |
| 21: |
| doprotection; {:1026} {1030:} |
| 27: |
| defdelims; {:1030} {1033:} |
| 12: |
| repeat |
| getsymbol; |
| savevariable(cursym); |
| getxnext |
| until curcmd <> 79; |
| 13: |
| dointerim; |
| 14: |
| dolet; |
| 15: |
| donewinternal; {:1033} {1039:} |
| 22: |
| doshowwhatever; |
| {: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 |
| end {:1175}; |
| curtype := 1 |
| end {:992}; |
| if curcmd < 80 then begin {991:} |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(739) |
| end; |
| begin |
| helpptr := 6; |
| helpline[5] := 740; |
| helpline[4] := 741; |
| helpline[3] := 742; |
| helpline[2] := 736; |
| helpline[1] := 737; |
| helpline[0] := 738 |
| end; |
| backerror; |
| scannerstatus := 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 > 79; |
| scannerstatus := 0 |
| end {:991}; |
| errorcount := 0 |
| end; {:989} |
| {1017:} |
| |
| procedure maincontrol; |
| begin |
| repeat |
| dostatement; |
| if curcmd = 81 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(774) |
| end; |
| begin |
| helpptr := 2; |
| helpline[1] := 775; |
| helpline[0] := 555 |
| end; |
| flusherror(0) |
| end |
| until curcmd = 82 |
| end; {:1017} {1117:} |
| |
| function sortin(v: scaled): halfword; |
| label |
| 40; |
| var |
| p, q, r: halfword; |
| begin |
| p := 29999; |
| while true do begin |
| q := mem[p].hh.rh; |
| if v <= mem[q + 1].int then |
| goto 40; |
| p := q |
| end; |
| 40: |
| if v < mem[q + 1].int then begin |
| r := getnode(2); |
| mem[r + 1].int := v; |
| mem[r].hh.rh := q; |
| mem[p].hh.rh := r |
| end; |
| sortin := mem[p].hh.rh |
| end; {:1117} |
| {1118:} |
| |
| function mincover(d: scaled): integer; |
| var |
| p: halfword; |
| l: scaled; |
| m: integer; |
| begin |
| m := 0; |
| p := mem[29999].hh.rh; |
| perturbation := 2147483647; |
| while p <> (-29981) 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 - l) < perturbation then |
| perturbation := mem[p + 1].int - l |
| end; |
| mincover := m |
| end; {:1118} {1120:} |
| |
| function threshold(m: integer): scaled; |
| var |
| d: scaled; |
| begin |
| if mincover(0) <= m then |
| threshold := 0 |
| else begin |
| repeat |
| d := perturbation |
| until mincover(d + d) <= m; |
| while mincover(d) > m 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 := 29999; |
| m := 0; |
| p := mem[29999].hh.rh; |
| while p <> (-29981) 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 begin {1122:} |
| repeat |
| p := mem[p].hh.rh; |
| mem[p].hh.lh := m |
| until mem[mem[p].hh.rh + 1].int > (l + d); |
| v := (l + mem[p + 1].int) 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(897); |
| print(intname[m]); |
| print(898); |
| printscaled(perturbation); |
| print(899) |
| end; { tfmwarning } |
| {:1123} |
| {1128:} |
| |
| procedure fixdesignsize; |
| var |
| d: scaled; |
| begin |
| d := internal[26]; |
| if (d < 65536) or (d >= 134217728) then begin |
| if d <> 0 then |
| printnl(900); |
| 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 tfmqqqq(x: fourquarters); |
| begin |
| bwritebyte(tfmfile, x.b0 + 128); |
| bwritebyte(tfmfile, x.b1 + 128); |
| bwritebyte(tfmfile, x.b2 + 128); |
| bwritebyte(tfmfile, x.b3 + 128) |
| 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; |
| packbufferedname(0, curinput.locfield, j - 1); |
| if wopenin(basefile) then |
| goto 40; |
| writeln(output, 'Sorry, I can''t find that base;', ' will try PLAIN.'); |
| flush(output) |
| end; |
| packbufferedname(5, 1, 0); |
| if not wopenin(basefile) then begin |
| writeln(output, 'I can''t find the PLAIN base file!'); |
| 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; {1191:} |
| begin |
| x := basefile^.int; |
| if x <> 503742536 then |
| goto 6666; |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if x <> (-30000) then |
| goto 6666; |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if x <> 30000 then |
| goto 6666; |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if x <> 2100 then |
| goto 6666; |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if x <> 1777 then |
| goto 6666; |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if x <> 6 then |
| goto 6666 {:1191}; |
| {1193:} |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if x < 0 then |
| goto 6666; |
| if x > poolsize then begin |
| writeln(output, '---! Must increase the ', 'string pool size'); |
| goto 6666 |
| end else |
| poolptr := x |
| end; |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if x < 0 then |
| goto 6666; |
| if x > maxstrings then begin |
| writeln(output, '---! Must increase the ', 'max strings'); |
| goto 6666 |
| end else |
| strptr := x |
| end; |
| for k := 0 to strptr do begin |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x < 0) or (x > poolptr) then |
| goto 6666 |
| else |
| strstart[k] := x |
| end; |
| strref[k] := 127 |
| end; |
| k := 0; |
| while (k + 4) < poolptr do begin |
| begin |
| get(basefile); |
| w := basefile^.qqqq |
| end; |
| strpool[k] := w.b0; |
| strpool[k + 1] := w.b1; |
| strpool[k + 2] := w.b2; |
| strpool[k + 3] := w.b3; |
| k := k + 4 |
| end; |
| k := poolptr - 4; |
| begin |
| get(basefile); |
| w := basefile^.qqqq |
| end; |
| strpool[k] := w.b0; |
| strpool[k + 1] := w.b1; |
| strpool[k + 2] := w.b2; |
| strpool[k + 3] := w.b3 {:1193}; {1195:} |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x < (-28978)) or (x > 29997) then |
| goto 6666 |
| else |
| lomemmax := x |
| end; |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x < (-29977)) or (x > lomemmax) then |
| goto 6666 |
| else |
| rover := x |
| end; |
| p := -30000; |
| q := rover; |
| x := 0; |
| repeat |
| for k := p to q + 1 do begin |
| get(basefile); |
| mem[k] := basefile^ |
| 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 |
| get(basefile); |
| mem[k] := basefile^ |
| end; |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x < (lomemmax + 1)) or (x > 29998) then |
| goto 6666 |
| else |
| himemmin := x |
| end; |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x < (-30000)) or (x > 30000) then |
| goto 6666 |
| else |
| avail := x |
| end; |
| memend := 30000; |
| for k := himemmin to memend do begin |
| get(basefile); |
| mem[k] := basefile^ |
| end; |
| begin |
| get(basefile); |
| varused := basefile^.int |
| end; |
| begin |
| get(basefile); |
| dynused := basefile^.int |
| end {:1195}; {1197:} |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x < 1) or (x > 2229) then |
| goto 6666 |
| else |
| hashused := x |
| end; |
| p := 0; |
| repeat |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x < (p + 1)) or (x > hashused) then |
| goto 6666 |
| else |
| p := x |
| end; |
| begin |
| get(basefile); |
| hash[p] := basefile^.hh |
| end; |
| begin |
| get(basefile); |
| eqtb[p] := basefile^.hh |
| end |
| until p = hashused; |
| for p := hashused + 1 to 2241 do begin |
| begin |
| get(basefile); |
| hash[p] := basefile^.hh |
| end; |
| begin |
| get(basefile); |
| eqtb[p] := basefile^.hh |
| end |
| end; |
| begin |
| get(basefile); |
| stcount := basefile^.int |
| end {:1197}; {1199:} |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x < 40) or (x > maxinternal) then |
| goto 6666 |
| else |
| intptr := x |
| end; |
| for k := 1 to intptr do begin |
| begin |
| get(basefile); |
| internal[k] := basefile^.int |
| end; |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x < 0) or (x > strptr) then |
| goto 6666 |
| else |
| intname[k] := x |
| end |
| end; |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x < 0) or (x > 2229) then |
| goto 6666 |
| else |
| startsym := x |
| end; |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x < 0) or (x > 3) then |
| goto 6666 |
| else |
| interaction := x |
| end; |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x < 0) or (x > strptr) then |
| goto 6666 |
| else |
| baseident := x |
| end; |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x < 1) or (x > 2241) then |
| goto 6666 |
| else |
| bgloc := x |
| end; |
| begin |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x < 1) or (x > 2241) then |
| goto 6666 |
| else |
| egloc := x |
| end; |
| begin |
| get(basefile); |
| serialno := basefile^.int |
| end; |
| begin |
| get(basefile); |
| x := basefile^.int |
| end; |
| if (x <> 69069) or eof(basefile) then |
| goto 6666 {:1199}; |
| loadbasefile := true; |
| goto 10; |
| 6666: |
| ; |
| writeln(output, '(Fatal base file error; I''m stymied)'); |
| loadbasefile := false; |
| 10: |
| |
| end; {:1187} {1202:} {823:} |
| |
| procedure scanprimary; |
| label |
| 20, 30, 31, 32; |
| var |
| p, q, r: halfword; |
| c: quarterword; |
| myvarflag: 0..82; |
| 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 OKtointerrupt then begin |
| backinput; |
| begin |
| if interrupt <> 0 then |
| pauseforinstructions |
| end; |
| getxnext |
| end {:825}; |
| if curcmd in |
| [31, 32, 39, 42, 33, 34, 30, 36, |
| 43, 37, 35, 40, 38, 41] then |
| case curcmd of |
| 31: |
| begin {826:} |
| ldelim := cursym; |
| rdelim := curmod; |
| getxnext; |
| scanexpression; |
| if (curcmd = 79) and (curtype >= 16) then begin {830:} |
| p := getnode(2); |
| mem[p].hh.b0 := 14; |
| mem[p].hh.b1 := 11; |
| initbignode(p); |
| q := mem[p + 1].int; |
| stashin(q); |
| getxnext; |
| scanexpression; |
| if curtype < 16 then begin |
| disperr(-30000, 639); |
| begin |
| helpptr := 4; |
| helpline[3] := 640; |
| helpline[2] := 641; |
| helpline[1] := 642; |
| helpline[0] := 643 |
| end; |
| putgetflusherror(0) |
| end; |
| stashin(q + 2); |
| checkdelimiter(ldelim, rdelim); |
| curtype := 14; |
| curexp := p |
| end else {:830} |
| checkdelimiter(ldelim, rdelim) |
| end; {:826} |
| 32: |
| begin {832:} |
| 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 <> 80; |
| if curcmd <> 81 then begin |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(644) |
| end; |
| printint(groupline); |
| print(645); |
| begin |
| helpptr := 2; |
| helpline[1] := 646; |
| helpline[0] := 647 |
| end; |
| backerror; |
| curcmd := 81 |
| end; |
| unsave; |
| if internal[7] > 0 then |
| showcmdmod(curcmd, curmod) |
| end; {:832} |
| 39: |
| begin {833:} |
| curtype := 4; |
| curexp := curmod |
| end; {:833} |
| 42: |
| begin {837:} |
| 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 := 2233; |
| goto 30 |
| end; |
| num := curexp; |
| denom := curmod; |
| if denom = 0 then begin {838:} |
| begin |
| if interaction = 3 then |
| ; |
| printnl(133); |
| print(648) |
| end; |
| begin |
| helpptr := 1; |
| helpline[0] := 649 |
| end; |
| error |
| end else {:838} |
| 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: |
| begin {835:} |
| c := curmod; |
| getxnext; |
| scanprimary; |
| dounary(c); |
| goto 30 |
| end; {:835} |
| 37: |
| begin {839:} |
| c := curmod; |
| getxnext; |
| scanexpression; |
| if curcmd <> 69 then begin |
| missingerr(347); |
| print(581); |
| printcmdmod(37, c); |
| begin |
| helpptr := 1; |
| helpline[0] := 582 |
| end; |
| backerror |
| end; |
| p := stashcurexp; |
| getxnext; |
| scanprimary; |
| dobinary(p, c); |
| goto 30 |
| end; {:839} |
| 35: |
| begin {840:} |
| getxnext; |
| scansuffix; |
| oldsetting := selector; |
| selector := 5; |
| showtokenlist(curexp, -30000, 100000, 0); |
| flushtokenlist(curexp); |
| curexp := makestring; |
| selector := oldsetting; |
| curtype := 4; |
| goto 30 |
| end; {:840} |
| 40: |
| begin {841:} |
| q := curmod; |
| if myvarflag = 77 then begin |
| getxnext; |
| if curcmd = 77 then begin |
| curexp := getavail; |
| mem[curexp].hh.lh := q + 2241; |
| curtype := 20; |
| goto 30 |
| end; |
| backinput |
| end; |
| curtype := 16; |
| curexp := internal[q] |
| end; {:841} |
| 38: |
| makeexpcopy(curmod); |
| 41: |
| begin {844:} |
| begin |
| prehead := avail; |
| if prehead = (-30000) then |
| prehead := getavail |
| else begin |
| avail := mem[prehead].hh.rh; |
| mem[prehead].hh.rh := -30000 |
| end {dynused:=dynused+1;} |
| end; |
| tail := prehead; |
| posthead := -30000; |
| 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 83) = 41 then begin |
| q := eqtb[q].rh; |
| if q = (-30000) then |
| goto 32; |
| while true do begin |
| p := mem[p].hh.rh; |
| if p = (-30000) 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: {:850} |
| |
| end; |
| if tt >= 22 then begin {845:} |
| mem[tail].hh.rh := -30000; |
| 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 begin {853:} |
| 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, -30000); |
| getxnext; |
| goto 20 |
| end {:853} |
| end {:845} |
| end; |
| getxnext; |
| tail := t; |
| if curcmd = 63 then begin {846:} |
| getxnext; |
| scanexpression; |
| if curcmd <> 64 then begin {847:} |
| backinput; |
| backexpr; |
| curcmd := 63; |
| curmod := 0; |
| cursym := 2232 |
| end else begin {:847} |
| 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 <> (-30000) then begin {854:} |
| 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 := -30000; |
| macrocall(macroref, prehead, -30000); |
| 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 |
| end |
| {dynused:=dynused-1;}; |
| if curcmd = myvarflag then begin |
| curtype := 20; |
| curexp := q; |
| goto 30 |
| end; |
| p := findvariable(q); |
| if p <> (-30000) then |
| makeexpcopy(p) |
| else begin |
| obliterated(q); |
| helpline[2] := 661; |
| helpline[1] := 662; |
| helpline[0] := 663; |
| putgetflusherror(0) |
| end; |
| flushnodelist(q); |
| goto 30 {:852} |
| end |
| end |
| else |
| begin {:844} |
| badexp(633); |
| goto 20 |
| end; |
| getxnext; |
| 30: |
| if curcmd = 63 then |
| if curtype >= 16 then begin {859:} |
| p := stashcurexp; |
| getxnext; |
| scanexpression; |
| if curcmd <> 79 then begin {847:} |
| begin |
| backinput; |
| backexpr; |
| curcmd := 63; |
| curmod := 0; |
| cursym := 2232 |
| end {:847}; |
| unstashcurexp(p) |
| end else begin |
| q := stashcurexp; |
| getxnext; |
| scanexpression; |
| if curcmd <> 64 then begin |
| missingerr(93); |
| begin |
| helpptr := 3; |
| helpline[2] := 665; |
| helpline[1] := 666; |
| helpline[0] := 563 |
| 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 begin {861:} |
| getxnext; |
| scanexpression; |
| if curtype <> 16 then |
| badsubscript; |
| if curcmd <> 64 then begin |
| missingerr(93); |
| begin |
| helpptr := 3; |
| helpline[2] := 667; |
| helpline[1] := 666; |
| helpline[0] := 563 |
| 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 |
| end {dynused:=dynused-1;}; |
| curtype := 20 |
| end; {:860} {862:} |
| |
| procedure scansecondary; |
| label |
| 20, 22; |
| var |
| p, q, r: halfword; |
| c, d: halfword; |
| macname: halfword; |
| begin |
| 20: |
| if (curcmd < 30) or (curcmd > 43) then |
| badexp(668); |
| 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(669); |
| scansecondary; |
| if curtype = 8 then |
| materializepen; |
| 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; |
| scansecondary; |
| 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 scanexpression; |
| label |
| 20, 30, 22, 25, 26, 10; |
| var |
| p, q, r, pp, qq: halfword; |
| c, d: halfword; |
| myvarflag: 0..82; |
| macname: halfword; |
| cyclehit: boolean; |
| x, y: scaled; |
| t: 0..4; |
| begin |
| myvarflag := varflag; |
| 20: |
| if (curcmd < 30) or (curcmd > 43) then |
| badexp(672); |
| 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 begin {869:} |
| cyclehit := false; {870:} |
| begin |
| unstashcurexp(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 begin {879:} |
| t := scandirection; |
| 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 begin {881:} |
| getxnext; |
| if curcmd = 58 then begin {882:} |
| getxnext; |
| y := curcmd; |
| if curcmd = 59 then |
| getxnext; |
| scanprimary; {883:} |
| if (curtype <> 16) or (curexp < 49152) then begin |
| disperr(-30000, 690); |
| begin |
| helpptr := 1; |
| helpline[0] := 691 |
| end; |
| putgetflusherror(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(-30000, 690); |
| begin |
| helpptr := 1; |
| helpline[0] := 691 |
| end; |
| putgetflusherror(65536) |
| end {:883}; |
| if y = 59 then |
| curexp := -curexp |
| end; |
| y := curexp |
| end else if curcmd = 57 then begin {:882} {884:} |
| 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 else begin {:884} |
| mem[q + 6].int := 65536; |
| y := 65536; |
| backinput; |
| goto 30 |
| end; |
| if curcmd <> 47 then begin |
| missingerr(279); |
| begin |
| helpptr := 1; |
| helpline[0] := 689 |
| end; |
| backerror |
| end; |
| 30: {:881} |
| |
| end else if d <> 48 then |
| goto 26; |
| getxnext; |
| if curcmd = 46 then begin {880:} |
| t := scandirection; |
| if mem[q].hh.b1 <> 1 then |
| x := curexp |
| else |
| t := 1 |
| end else if mem[q].hh.b1 <> 1 then begin {:880} |
| t := 4; |
| x := 0 |
| end {:874}; |
| if curcmd = 36 then begin {886:} |
| 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 else begin {:886} |
| 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 |
| ; |
| printnl(133); |
| print(692) |
| end; |
| begin |
| helpptr := 3; |
| helpline[2] := 693; |
| helpline[1] := 694; |
| helpline[0] := 695 |
| 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 begin {890:} |
| 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 else begin {:890} {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 else begin {:869} |
| 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; |
| scanexpression; |
| if curtype <> 2 then begin |
| disperr(-30000, 696); |
| begin |
| helpptr := 2; |
| helpline[1] := 697; |
| helpline[0] := 698 |
| end; |
| putgetflusherror(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 closefilesandtermina; |
| var |
| k: integer; |
| lh: integer; |
| p: halfword; |
| x: scaled; |
| {if internal[12]>0 then[1208:]if jobname>0 then begin writeln( |
| logfile,' '); |
| writeln(logfile,'Here is how much of METAFONT''s memory',' you used:'); |
| write(logfile,' ',maxstrptr-initstrptr:1,' string'); |
| if maxstrptr<>initstrptr+1 then write(logfile,'s'); |
| writeln(logfile,' out of ',maxstrings-initstrptr:1); |
| writeln(logfile,' ',maxpoolptr-initpoolptr:1, |
| ' string characters out of ',poolsize-initpoolptr:1); |
| writeln(logfile,' ',lomemmax+30000+memend-himemmin+2:1, |
| ' words of memory out of ',memend+30001:1); |
| writeln(logfile,' ',stcount:1,' symbolic tokens out of ',2100:1); |
| writeln(logfile,' ',maxinstack:1,'i,',intptr:1,'n,',maxroundingptr:1, |
| 'r,',maxparamstack: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];} |
| begin |
| {1206:} |
| if (gfprevptr > 0) or (internal[33] > 0) then begin {1207:} |
| rover := -29977; |
| mem[rover].hh.rh := 32767; |
| lomemmax := himemmin - 1; |
| if (lomemmax - rover) > 32767 then |
| lomemmax := 32767 + rover; |
| mem[rover].hh.lh := lomemmax - rover; |
| mem[rover + 1].hh.lh := rover; |
| mem[rover + 1].hh.rh := rover; |
| mem[lomemmax].hh.rh := -30000; |
| mem[lomemmax].hh.lh := -30000 {:1207}; {1124:} |
| mem[29999].hh.rh := -29981; |
| for k := bc to ec do |
| if charexists[k] then |
| tfmwidth[k] := sortin(tfmwidth[k]); |
| nw := skimp(255) + 1; |
| dimenhead[1] := mem[29999].hh.rh; |
| if perturbation >= 4096 then |
| tfmwarning(20) {:1124}; |
| fixdesignsize; |
| fixchecksum; |
| if internal[33] > 0 then begin {1126:} |
| mem[29999].hh.rh := -29981; |
| for k := bc to ec do |
| if charexists[k] then |
| if tfmheight[k] = 0 then |
| tfmheight[k] := -29985 |
| else |
| tfmheight[k] := sortin(tfmheight[k]); |
| nh := skimp(15) + 1; |
| dimenhead[2] := mem[29999].hh.rh; |
| if perturbation >= 4096 then |
| tfmwarning(21); |
| mem[29999].hh.rh := -29981; |
| for k := bc to ec do |
| if charexists[k] then |
| if tfmdepth[k] = 0 then |
| tfmdepth[k] := -29985 |
| else |
| tfmdepth[k] := sortin(tfmdepth[k]); |
| nd := skimp(15) + 1; |
| dimenhead[3] := mem[29999].hh.rh; |
| if perturbation >= 4096 then |
| tfmwarning(22); |
| mem[29999].hh.rh := -29981; |
| for k := bc to ec do |
| if charexists[k] then |
| if tfmitalcorr[k] = 0 then |
| tfmitalcorr[k] := -29985 |
| else |
| tfmitalcorr[k] := sortin(tfmitalcorr[k]); |
| ni := skimp(63) + 1; |
| dimenhead[4] := mem[29999].hh.rh; |
| if perturbation >= 4096 then |
| tfmwarning(23) {:1126}; {1134:} |
| if jobname = 0 then |
| openlogfile; |
| packjobname(901); |
| while not bopenout(tfmfile, nameoffile) do |
| promptfilename(902, 901); |
| metricfilename := bmakenamestring(tfmfile); {1135:} |
| k := headersize; |
| while headerbyte[k] < 0 do |
| k := k - 1; |
| lh := (k + 3) div 4; |
| if bc > ec then |
| bc := 1; |
| bwrite2bytes(tfmfile, (((((((((6 + lh) + ((ec - bc) + 1)) + nw) + nh) + nd) + ni) + nl) + nk) + ne) + np); |
| bwrite2bytes(tfmfile, lh); |
| bwrite2bytes(tfmfile, bc); |
| bwrite2bytes(tfmfile, ec); |
| bwrite2bytes(tfmfile, nw); |
| bwrite2bytes(tfmfile, nh); |
| bwrite2bytes(tfmfile, nd); |
| bwrite2bytes(tfmfile, ni); |
| bwrite2bytes(tfmfile, nl); |
| bwrite2bytes(tfmfile, nk); |
| bwrite2bytes(tfmfile, ne); |
| bwrite2bytes(tfmfile, np); |
| for k := 1 to 4 * lh do begin |
| if headerbyte[k] < 0 then |
| headerbyte[k] := 0; |
| bwritebyte(tfmfile, headerbyte[k]) |
| end {:1135}; {1137:} |
| for k := bc to ec do |
| if not charexists[k] then |
| bwrite4bytes(tfmfile, 0) |
| else begin |
| bwritebyte(tfmfile, mem[tfmwidth[k]].hh.lh); |
| bwritebyte(tfmfile, (mem[tfmheight[k]].hh.lh * 16) + mem[tfmdepth[k]].hh.lh); |
| bwritebyte(tfmfile, (mem[tfmitalcorr[k]].hh.lh * 4) + chartag[k]); |
| bwritebyte(tfmfile, charremainder[k]) |
| end {:1137}; {1138:} |
| tfmchanged := 0; |
| for k := 1 to 4 do begin |
| bwrite4bytes(tfmfile, 0); |
| p := dimenhead[k]; |
| while p <> (-29981) do begin |
| bwrite4bytes(tfmfile, dimenout(mem[p + 1].int)); |
| p := mem[p].hh.rh |
| end |
| end {:1138}; {1139:} |
| for k := 0 to nl - 1 do |
| tfmqqqq(ligkern[k]); |
| for k := 0 to nk - 1 do |
| bwrite4bytes(tfmfile, dimenout(kern[k])) {:1139}; |
| {1140:} |
| for k := 0 to ne - 1 do |
| tfmqqqq(exten[k]) {:1140}; {1141:} |
| for k := 1 to np do |
| if k = 1 then |
| if abs(param[1]) < 134217728 then |
| bwrite4bytes(tfmfile, param[1] * 16) |
| else begin |
| tfmchanged := tfmchanged + 1; |
| if param[1] > 0 then |
| bwrite4bytes(tfmfile, 2147483647) |
| else |
| bwrite4bytes(tfmfile, -2147483647) |
| end |
| else |
| bwrite4bytes(tfmfile, dimenout(param[k])); |
| if tfmchanged > 0 then begin |
| if tfmchanged = 1 then |
| printnl(904) |
| else begin |
| printnl(40); |
| printint(tfmchanged); |
| print(905) |
| end; |
| print(906) |
| end {:1141}; |
| {if internal[12]>0 then[1136:]begin writeln(logfile,' '); |
| writeln(logfile,'(You used ',nw:1,'w,',nh:1,'h,',nd:1,'d,',ni:1,'i,',nl: |
| 1,'l,',nk:1,'k,',ne:1,'e,',np:1,'p metric file positions'); |
| writeln(logfile,' out of ','256w,16h,16d,64i,',ligtablesize:1, |
| 'l,256k,256e,',maxfontdimen:1,'p)');end[:1136];} |
| printnl(903); |
| print(metricfilename); |
| bclose(tfmfile) {:1134} |
| end; |
| if gfprevptr > 0 then begin {1182:} |
| begin |
| gfbuf[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 |
| gfbuf[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 |
| gfbuf[gfptr] := 246; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[gfptr] := k; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[gfptr] := x; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end |
| end else begin |
| begin |
| gfbuf[gfptr] := 245; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| begin |
| gfbuf[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 |
| gfbuf[gfptr] := 249; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| gffour(gfprevptr); |
| begin |
| gfbuf[gfptr] := 131; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| k := 4 + ((gfbufsize - gfptr) mod 4); |
| while k > 0 do begin |
| begin |
| gfbuf[gfptr] := 223; |
| gfptr := gfptr + 1; |
| if gfptr = gflimit then |
| gfswap |
| end; |
| k := k - 1 |
| end; {1156:} |
| if gflimit = halfbuf then |
| bwritebuf(gffile, gfbuf, halfbuf, gfbufsize - 1); |
| if gfptr > 0 then |
| bwritebuf(gffile, gfbuf, 0, gfptr - 1) {:1156}; |
| printnl(917); |
| print(outputfilename); |
| print(425); |
| printint(totalchars); |
| print(918); |
| if totalchars <> 1 then |
| printchar(115); |
| print(919); |
| printint(gfoffset + gfptr); |
| print(920); |
| bclose(gffile) |
| end {:1182} |
| end {:1206}; |
| if jobname > 0 then begin |
| writeln(logfile); |
| aclose(logfile); |
| selector := selector - 2; |
| if selector = 1 then begin |
| printnl(929); |
| print(logname); |
| printchar(46) |
| end |
| end; |
| println; |
| if (editnamestart <> 0) and (interaction > 0) then |
| calledit(strpool[editnamestart], editnamelength, editline) |
| end; {:1205} {1209:} |
| |
| procedure finalcleanup; |
| label |
| 10; |
| var |
| c: smallnumber; |
| begin |
| c := curmod; |
| if jobname = 0 then |
| openlogfile; |
| while condptr <> (-30000) do begin |
| printnl(930); |
| printcmdmod(2, curif); |
| if ifline <> 0 then begin |
| print(931); |
| printint(ifline) |
| end; |
| print(932); |
| 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(933); |
| selector := 3 |
| end; |
| if c = 1 then begin {storebasefile;goto 10;} |
| printnl(934); |
| goto 10 |
| end; |
| 10: |
| |
| end; {:1209} {1210:} |
| {procedure initprim;begin[192:]primitive(280,40,1); |
| primitive(281,40,2);primitive(282,40,3);primitive(283,40,4); |
| primitive(284,40,5);primitive(285,40,6);primitive(286,40,7); |
| primitive(287,40,8);primitive(288,40,9);primitive(289,40,10); |
| primitive(290,40,11);primitive(291,40,12);primitive(292,40,13); |
| primitive(293,40,14);primitive(294,40,15);primitive(295,40,16); |
| primitive(296,40,17);primitive(297,40,18);primitive(298,40,19); |
| primitive(299,40,20);primitive(300,40,21);primitive(301,40,22); |
| primitive(302,40,23);primitive(303,40,24);primitive(304,40,25); |
| primitive(305,40,26);primitive(306,40,27);primitive(307,40,28); |
| primitive(308,40,29);primitive(309,40,30);primitive(310,40,31); |
| primitive(311,40,32);primitive(312,40,33);primitive(313,40,34); |
| primitive(314,40,35);primitive(315,40,36);primitive(316,40,37); |
| primitive(317,40,38);primitive(318,40,39);primitive(319,40,40); |
| [:192][211:]primitive(279,47,0);primitive(91,63,0); |
| eqtb[2232]:=eqtb[cursym];primitive(93,64,0);primitive(125,65,0); |
| primitive(123,46,0);primitive(58,78,0);eqtb[2234]:=eqtb[cursym]; |
| primitive(329,77,0);primitive(44,79,0);primitive(59,80,0); |
| eqtb[2235]:=eqtb[cursym];primitive(92,7,0);primitive(330,18,0); |
| primitive(331,72,0);primitive(332,59,0);primitive(333,32,0); |
| bgloc:=cursym;primitive(334,57,0);primitive(335,19,0); |
| primitive(336,60,0);primitive(337,27,0);primitive(338,11,0); |
| primitive(323,81,0);eqtb[2239]:=eqtb[cursym];egloc:=cursym; |
| primitive(339,26,0);primitive(340,6,0);primitive(341,9,0); |
| primitive(342,70,0);primitive(343,73,0);primitive(344,13,0); |
| primitive(345,14,0);primitive(346,15,0);primitive(347,69,0); |
| primitive(348,28,0);primitive(349,24,0);primitive(350,12,0); |
| primitive(351,8,0);primitive(352,17,0);primitive(353,74,0); |
| primitive(354,35,0);primitive(355,58,0);primitive(356,71,0); |
| primitive(357,75,0);[:211][683:]primitive(520,16,1);primitive(521,16,2); |
| primitive(522,16,53);primitive(523,16,44);primitive(524,16,49); |
| primitive(324,16,0);eqtb[2237]:=eqtb[cursym];primitive(525,4,2242); |
| primitive(526,4,2392);primitive(527,4,1);primitive(325,4,0); |
| eqtb[2236]:=eqtb[cursym];[:683][688:]primitive(528,61,0); |
| primitive(529,61,1);primitive(64,61,2);primitive(530,61,3); |
| [:688][695:]primitive(541,56,2242);primitive(542,56,2392); |
| primitive(543,56,2542);primitive(544,56,1);primitive(545,56,2); |
| primitive(546,56,3);[:695][709:]primitive(556,3,0);primitive(482,3,1); |
| [:709][740:]primitive(583,1,1);primitive(322,2,2); |
| eqtb[2238]:=eqtb[cursym];primitive(584,2,3);primitive(585,2,4); |
| [:740][893:]primitive(218,33,30);primitive(219,33,31); |
| primitive(220,33,32);primitive(221,33,33);primitive(222,33,34); |
| primitive(223,33,35);primitive(224,33,36);primitive(225,33,37); |
| primitive(226,34,38);primitive(227,34,39);primitive(228,34,40); |
| primitive(229,34,41);primitive(230,34,42);primitive(231,34,43); |
| primitive(232,34,44);primitive(233,34,45);primitive(234,34,46); |
| primitive(235,34,47);primitive(236,34,48);primitive(237,34,49); |
| primitive(238,34,50);primitive(239,34,51);primitive(240,34,52); |
| primitive(241,34,53);primitive(242,34,54);primitive(243,34,55); |
| primitive(244,34,56);primitive(245,34,57);primitive(246,34,58); |
| primitive(247,34,59);primitive(248,34,60);primitive(249,34,61); |
| primitive(250,34,62);primitive(251,34,63);primitive(252,34,64); |
| primitive(253,34,65);primitive(254,34,66);primitive(255,34,67); |
| primitive(256,36,68);primitive(43,43,69);primitive(45,43,70); |
| primitive(42,55,71);primitive(47,54,72);eqtb[2233]:=eqtb[cursym]; |
| primitive(257,45,73);primitive(181,45,74);primitive(259,52,76); |
| primitive(258,45,75);primitive(60,50,77);primitive(260,50,78); |
| primitive(62,50,79);primitive(261,50,80);primitive(61,51,81); |
| primitive(262,50,82);primitive(272,37,94);primitive(273,37,95); |
| primitive(274,37,96);primitive(275,37,97);primitive(276,37,98); |
| primitive(277,37,99);primitive(278,37,100);primitive(38,48,83); |
| primitive(263,55,84);primitive(264,55,85);primitive(265,55,86); |
| primitive(266,55,87);primitive(267,55,88);primitive(268,55,89); |
| primitive(269,55,90);primitive(270,55,91);primitive(271,45,92); |
| [:893][1013:]primitive(211,30,15);primitive(197,30,4); |
| primitive(195,30,2);primitive(202,30,9);primitive(199,30,6); |
| primitive(204,30,11);primitive(206,30,13);primitive(207,30,14); |
| [:1013][1018:]primitive(776,82,0);primitive(777,82,1); |
| [:1018][1024:]primitive(143,23,0);primitive(144,23,1); |
| primitive(145,23,2);primitive(783,23,3); |
| [:1024][1027:]primitive(784,21,0);primitive(785,21,1); |
| [:1027][1037:]primitive(799,22,0);primitive(800,22,1); |
| primitive(801,22,2);primitive(802,22,3);primitive(803,22,4); |
| [:1037][1052:]primitive(820,68,1);primitive(821,68,0); |
| primitive(822,68,2);primitive(823,66,6);primitive(824,66,16); |
| primitive(825,67,0);primitive(826,67,1); |
| [:1052][1079:]primitive(856,25,0);primitive(857,25,1); |
| primitive(858,25,2);[:1079][1101:]primitive(868,20,0); |
| primitive(869,20,1);primitive(870,20,2);primitive(871,20,3); |
| primitive(872,20,4);[:1101][1109:]primitive(889,76,0); |
| primitive(890,76,128);[:1109][1176:]primitive(912,29,4); |
| primitive(913,29,16);[:1176];end;procedure inittab;var k:integer; |
| begin[176:]rover:=-29977;mem[rover].hh.rh:=32767;mem[rover].hh.lh:=1000; |
| mem[rover+1].hh.lh:=rover;mem[rover+1].hh.rh:=rover; |
| lomemmax:=rover+1000;mem[lomemmax].hh.rh:=-30000; |
| mem[lomemmax].hh.lh:=-30000; |
| for k:=29998 to 30000 do mem[k]:=mem[lomemmax];avail:=-30000; |
| memend:=30000;himemmin:=29998;varused:=23;dynused:=-1; |
| [:176][193:]intname[1]:=280;intname[2]:=281;intname[3]:=282; |
| intname[4]:=283;intname[5]:=284;intname[6]:=285;intname[7]:=286; |
| intname[8]:=287;intname[9]:=288;intname[10]:=289;intname[11]:=290; |
| intname[12]:=291;intname[13]:=292;intname[14]:=293;intname[15]:=294; |
| intname[16]:=295;intname[17]:=296;intname[18]:=297;intname[19]:=298; |
| intname[20]:=299;intname[21]:=300;intname[22]:=301;intname[23]:=302; |
| intname[24]:=303;intname[25]:=304;intname[26]:=305;intname[27]:=306; |
| intname[28]:=307;intname[29]:=308;intname[30]:=309;intname[31]:=310; |
| intname[32]:=311;intname[33]:=312;intname[34]:=313;intname[35]:=314; |
| intname[36]:=315;intname[37]:=316;intname[38]:=317;intname[39]:=318; |
| intname[40]:=319;[:193][203:]hashused:=2229;stcount:=0; |
| hash[2240].rh:=321;hash[2238].rh:=322;hash[2239].rh:=323; |
| hash[2237].rh:=324;hash[2236].rh:=325;hash[2235].rh:=59; |
| hash[2234].rh:=58;hash[2233].rh:=47;hash[2232].rh:=91;hash[2231].rh:=41; |
| hash[2229].rh:=326;eqtb[2231].lh:=62; |
| [:203][229:]mem[-29981].hh.lh:=2242;mem[-29981].hh.rh:=-30000; |
| [:229][324:]mem[30000].hh.lh:=32767; |
| [:324][475:]mem[-29997].hh.lh:=-30000;mem[-29997].hh.rh:=-30000; |
| mem[-29996].hh.lh:=1;mem[-29996].hh.rh:=-30000; |
| for k:=-29995 to-29989 do mem[k]:=mem[-29996];mem[-29988].int:=0; |
| mem[-30000].hh.rh:=-30000;mem[-30000].hh.lh:=-30000;mem[-29999].int:=0; |
| mem[-29998].int:=0;[:475][587:]serialno:=0;mem[-29987].hh.rh:=-29987; |
| mem[-29986].hh.lh:=-29987;mem[-29987].hh.lh:=-30000; |
| mem[-29986].hh.rh:=-30000;[:587][702:]mem[-29979].hh.b1:=0; |
| mem[-29979].hh.rh:=2240;eqtb[2240].rh:=-29979;eqtb[2240].lh:=41; |
| [:702][759:]eqtb[2230].lh:=88;hash[2230].rh:=600; |
| [:759][911:]mem[-29983].hh.b1:=11; |
| [:911][1116:]mem[-29980].int:=1073741824; |
| [:1116][1127:]mem[-29984].int:=0;mem[-29985].hh.lh:=0; |
| [:1127][1185:]baseident:=921;[:1185]end;} |
| {:1210} |
| {1212:} |
| {procedure debughelp;label 888,10;var k,l,m,n:integer; |
| begin while true do begin;printnl(935);flush(output);read(input,m); |
| if m<0 then goto 10 else if m=0 then begin goto 888; |
| 888:m:=0; |
| ['BREAKPOINT'] |
| end else begin read(input,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:printvariablename(n);6:printint(internal[n]);7:doshowdependencies; |
| 9:showtokenlist(n,-30000,100000,0);10:print(n);11:checkmem(n>0); |
| 12:searchmem(n);13:begin read(input,l);printcmdmod(n,l);end; |
| 14:for k:=0 to n do print(buffer[k]);15:panicking:=not panicking; |
| [:1213]others:print(63)end;end;end;10:end;} |
| {:1212} |
| {:1202} |
| {1204:} |
| |
| begin |
| {-----------------------------------} |
| init_ps(psfile); |
| {-----------------------------------} |
| history := 3; |
| setpaths; |
| if readyalready = 314159 then |
| goto 1; {14:} |
| bad := 0; |
| if (halferrorline < 30) or (halferrorline > (errorline - 15)) then |
| bad := 1; |
| if maxprintline < 60 then |
| bad := 2; |
| if (gfbufsize mod 8) <> 0 then |
| bad := 3; |
| if (-28900) > 30000 then |
| bad := 4; |
| if 1777 > 2100 then |
| bad := 5; |
| if (headersize mod 4) <> 0 then |
| bad := 6; {:14} {154:} |
| {if memmax<>30000 then bad:=10;} |
| if memmax < 30000 then |
| bad := 10; |
| if ((-128) > 0) or (127 < 127) then |
| bad := 11; |
| if ((-32768) > 0) or (32767 < 32767) then |
| bad := 12; |
| if ((-128) < (-32768)) or (127 > 32767) then |
| bad := 13; |
| if ((-30000) < (-32768)) or (memmax >= 32767) then |
| bad := 14; |
| if maxstrings > 32767 then |
| bad := 15; |
| if bufsize > 32767 then |
| bad := 16; |
| if (255 < 255) or (65535 < 65535) then |
| bad := 17; {:154} {204:} |
| if (2241 + maxinternal) > 32767 then |
| bad := 21; {:204} {214:} |
| if 2692 > 32767 then |
| bad := 22; {:214} {310:} |
| if (15 * 11) > bistacksize then |
| bad := 31; {:310} {553:} |
| if (20 + (17 * 45)) > bistacksize then |
| bad := 32; {:553} {777:} |
| if 10 > filenamesize then |
| bad := 41; {:777} |
| if bad > 0 then begin |
| writeln(output, 'Ouch---my internal constants have been clobbered!', '---case ', bad: 1); |
| {if not getstringsstarted then goto 9999; |
| inittab;initprim;} |
| goto 9999 |
| end; |
| initialize; |
| readyalready := 314159; |
| 1: {55:} |
| selector := 1; |
| tally := 0; |
| termoffset := 0; |
| fileoffset := 0; {:55} {61:} |
| write(output, 'This is METAFONT, Version 1.0 for Berkeley UNIX'); |
| {-----------------------------------------------------------------} |
| writeln(output); |
| writeln(output,'*** embedded METAFONT to PostScript Compiler ***'); |
| {-----------------------------------------------------------------} |
| if baseident = 0 then |
| writeln(output, ' (no base preloaded)') |
| else begin |
| print(baseident); |
| println |
| end; |
| flush(output); {:61} {783:} |
| jobname := 0; {:783} |
| {792:} |
| outputfilename := 0; {:792} {1211:} {657:} |
| begin |
| begin |
| inputptr := 0; |
| maxinstack := 0; |
| inopen := 0; |
| maxbufstack := 0; |
| paramptr := 0; |
| maxparamstack := 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:} |
| scannerstatus := 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.locfield < curinput.limitfield) and (buffer[curinput.locfield] = 32) do |
| curinput.locfield := curinput.locfield + 1 |
| end; |
| buffer[curinput.limitfield] := 37; |
| fixdateandtime; |
| initrandoms((internal[17] div 65536) + internal[16]); {70:} |
| if interaction = 0 then |
| selector := 0 |
| else |
| selector := 1 {:70}; |
| if curinput.locfield < curinput.limitfield then |
| if buffer[curinput.locfield] <> 92 then |
| startinput |
| end {:1211}; |
| initstrptr := strptr; |
| initpoolptr := poolptr; |
| maxstrptr := strptr; |
| maxpoolptr := poolptr; |
| history := 0; |
| if startsym > 0 then begin |
| cursym := startsym; |
| backinput |
| end; |
| maincontrol; |
| finalcleanup; |
| 9998: |
| closefilesandtermina; |
| 9999: |
| readyalready := 0; |
| {---------------------------------} |
| tini_ps(g); |
| {---------------------------------} |
| if (history <> 0) and (history <> 1) then |
| exit(1) |
| else |
| exit(0); |
| end. {:1204} |
| |
