suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Adding collects, with all the right properties (except eoln-style).

Browse Source 
svn: r3
This commit is contained in:
Eli Barzilay 2005-05-27 18:56:37 +00:00
parent f171eb4b30
commit 017d151d59
2887 changed files with 620927 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

341
collects/afm/Courier-Bold.afm Normal file
View File

@ -0,0 +1,341 @@
StartFontMetrics 2.0
Comment Copyright (c) 1984 Adobe Systems Incorporated. All Rights Reserved.
Comment Creation Date:Mon Apr 6 17:11:38 PDT 1987
FontName Courier-Bold
EncodingScheme AdobeStandardEncoding
FullName Courier Bold
FamilyName Courier
Weight Bold
ItalicAngle 0.0
IsFixedPitch true
UnderlinePosition -85
UnderlineThickness 100
Version 001.004
FontBBox -100 -350 700 855
CapHeight 633
XHeight 487
Descender -257
Ascender 674
StartCharMetrics 260
C 32 ; WX 600 ; N space ; B 500 -100 700 100 ;
C 33 ; WX 600 ; N exclam ; B 170 -65 430 689 ;
C 34 ; WX 600 ; N quotedbl ; B 66 254 534 663 ;
C 35 ; WX 600 ; N numbersign ; B 12 -142 588 725 ;
C 36 ; WX 600 ; N dollar ; B 33 -173 567 735 ;
C 37 ; WX 600 ; N percent ; B 7 -65 593 689 ;
C 38 ; WX 600 ; N ampersand ; B 25 -65 558 600 ;
C 39 ; WX 600 ; N quoteright ; B 75 244 400 674 ;
C 40 ; WX 600 ; N parenleft ; B 214 -204 538 683 ;
C 41 ; WX 600 ; N parenright ; B 67 -204 391 683 ;
C 42 ; WX 600 ; N asterisk ; B 33 150 567 674 ;
C 43 ; WX 600 ; N plus ; B -8 -48 608 610 ;
C 44 ; WX 600 ; N comma ; B 75 -215 400 215 ;
C 45 ; WX 600 ; N hyphen ; B -8 181 608 381 ;
C 46 ; WX 600 ; N period ; B 190 -50 410 150 ;
C 47 ; WX 600 ; N slash ; B 33 -163 567 746 ;
C 48 ; WX 600 ; N zero ; B 33 -65 567 689 ;
C 49 ; WX 600 ; N one ; B 33 -50 567 674 ;
C 50 ; WX 600 ; N two ; B 4 -50 558 689 ;
C 51 ; WX 600 ; N three ; B 16 -65 579 689 ;
C 52 ; WX 600 ; N four ; B 25 -50 558 674 ;
C 53 ; WX 600 ; N five ; B 16 -65 579 674 ;
C 54 ; WX 600 ; N six ; B 56 -65 590 689 ;
C 55 ; WX 600 ; N seven ; B 25 -50 558 674 ;
C 56 ; WX 600 ; N eight ; B 33 -65 567 689 ;
C 57 ; WX 600 ; N nine ; B 56 -65 590 689 ;
C 58 ; WX 600 ; N colon ; B 190 -50 410 472 ;
C 59 ; WX 600 ; N semicolon ; B 79 -176 410 472 ;
C 60 ; WX 600 ; N less ; B -8 -48 608 610 ;
C 61 ; WX 600 ; N equal ; B -29 88 629 474 ;
C 62 ; WX 600 ; N greater ; B -8 -48 608 610 ;
C 63 ; WX 600 ; N question ; B 54 -65 567 648 ;
C 64 ; WX 600 ; N at ; B 26 -142 559 705 ;
C 65 ; WX 600 ; N A ; B -71 -50 671 633 ;
C 66 ; WX 600 ; N B ; B -37 -50 621 633 ;
C 67 ; WX 600 ; N C ; B -17 -65 614 648 ;
C 68 ; WX 600 ; N D ; B -37 -50 600 633 ;
C 69 ; WX 600 ; N E ; B -37 -50 600 633 ;
C 70 ; WX 600 ; N F ; B -37 -50 600 633 ;
C 71 ; WX 600 ; N G ; B -17 -65 642 648 ;
C 72 ; WX 600 ; N H ; B -27 -50 631 633 ;
C 73 ; WX 600 ; N I ; B 33 -50 567 633 ;
C 74 ; WX 600 ; N J ; B 4 -65 663 633 ;
C 75 ; WX 600 ; N K ; B -37 -50 652 633 ;
C 76 ; WX 600 ; N L ; B -17 -50 621 633 ;
C 77 ; WX 600 ; N M ; B -69 -50 673 633 ;
C 78 ; WX 600 ; N N ; B -58 -50 642 633 ;
C 79 ; WX 600 ; N O ; B -29 -65 629 648 ;
C 80 ; WX 600 ; N P ; B -37 -50 579 633 ;
C 81 ; WX 600 ; N Q ; B -29 -196 629 648 ;
C 82 ; WX 600 ; N R ; B -37 -50 669 633 ;
C 83 ; WX 600 ; N S ; B 12 -65 588 648 ;
C 84 ; WX 600 ; N T ; B -8 -50 608 633 ;
C 85 ; WX 600 ; N U ; B -40 -65 640 633 ;
C 86 ; WX 600 ; N V ; B -71 -50 671 633 ;
C 87 ; WX 600 ; N W ; B -60 -50 660 633 ;
C 88 ; WX 600 ; N X ; B -40 -50 640 633 ;
C 89 ; WX 600 ; N Y ; B -29 -50 629 633 ;
C 90 ; WX 600 ; N Z ; B 23 -50 577 633 ;
C 91 ; WX 600 ; N bracketleft ; B 200 -204 525 674 ;
C 92 ; WX 600 ; N backslash ; B 33 -163 567 746 ;
C 93 ; WX 600 ; N bracketright ; B 75 -204 400 674 ;
C 94 ; WX 600 ; N asciicircum ; B 33 275 567 674 ;
C 95 ; WX 600 ; N underscore ; B -92 -350 692 -150 ;
C 96 ; WX 600 ; N quoteleft ; B 200 244 525 674 ;
C 97 ; WX 600 ; N a ; B -8 -65 621 502 ;
C 98 ; WX 600 ; N b ; B -58 -65 621 674 ;
C 99 ; WX 600 ; N c ; B 4 -65 615 502 ;
C 100 ; WX 600 ; N d ; B -17 -65 663 674 ;
C 101 ; WX 600 ; N e ; B -17 -65 600 502 ;
C 102 ; WX 600 ; N f ; B 25 -50 621 674 ; L i fi ; L l fl ;
C 103 ; WX 600 ; N g ; B -17 -257 642 502 ;
C 104 ; WX 600 ; N h ; B -37 -50 631 674 ;
C 105 ; WX 600 ; N i ; B 12 -50 588 725 ;
C 106 ; WX 600 ; N j ; B 67 -257 538 725 ;
C 107 ; WX 600 ; N k ; B -17 -50 621 674 ;
C 108 ; WX 600 ; N l ; B 12 -50 588 674 ;
C 109 ; WX 600 ; N m ; B -69 -50 673 502 ;
C 110 ; WX 600 ; N n ; B -27 -50 621 502 ;
C 111 ; WX 600 ; N o ; B -8 -65 608 502 ;
C 112 ; WX 600 ; N p ; B -58 -257 621 502 ;
C 113 ; WX 600 ; N q ; B -17 -257 663 502 ;
C 114 ; WX 600 ; N r ; B 4 -50 621 501 ;
C 115 ; WX 600 ; N s ; B 23 -65 577 502 ;
C 116 ; WX 600 ; N t ; B -37 -65 579 642 ;
C 117 ; WX 600 ; N u ; B -37 -65 621 487 ;
C 118 ; WX 600 ; N v ; B -50 -50 650 487 ;
C 119 ; WX 600 ; N w ; B -50 -50 650 487 ;
C 120 ; WX 600 ; N x ; B -29 -50 629 487 ;
C 121 ; WX 600 ; N y ; B -29 -257 629 487 ;
C 122 ; WX 600 ; N z ; B 35 -50 569 487 ;
C 123 ; WX 600 ; N braceleft ; B 117 -204 483 674 ;
C 124 ; WX 600 ; N bar ; B 200 -204 400 674 ;
C 125 ; WX 600 ; N braceright ; B 117 -204 483 674 ;
C 126 ; WX 600 ; N asciitilde ; B 12 129 588 433 ;
C 161 ; WX 600 ; N exclamdown ; B 170 -257 430 475 ;
C 162 ; WX 600 ; N cent ; B 33 -79 549 725 ;
C 163 ; WX 600 ; N sterling ; B -17 -50 600 648 ;
C 164 ; WX 600 ; N fraction ; B -29 60 629 552 ;
C 165 ; WX 600 ; N yen ; B -29 -50 629 633 ;
C 166 ; WX 600 ; N florin ; B 7 -173 598 689 ;
C 167 ; WX 600 ; N section ; B -14 -147 614 689 ;
C 168 ; WX 600 ; N currency ; B 23 15 577 569 ;
C 169 ; WX 600 ; N quotesingle ; B 170 244 430 674 ;
C 170 ; WX 600 ; N quotedblleft ; B 33 280 567 678 ;
C 171 ; WX 600 ; N guillemotleft ; B -17 -50 621 487 ;
C 172 ; WX 600 ; N guilsinglleft ; B -17 -50 392 487 ;
C 173 ; WX 600 ; N guilsinglright ; B 213 -50 621 487 ;
C 174 ; WX 600 ; N fi ; B -70 -50 670 725 ;
C 175 ; WX 600 ; N fl ; B -70 -50 670 674 ;
C 177 ; WX 600 ; N endash ; B -8 181 608 381 ;
C 178 ; WX 600 ; N dagger ; B 44 -142 556 674 ;
C 179 ; WX 600 ; N daggerdbl ; B 44 -142 556 674 ;
C 180 ; WX 600 ; N periodcentered ; B 190 206 410 406 ;
C 182 ; WX 600 ; N paragraph ; B -1 -147 605 689 ;
C 183 ; WX 600 ; N bullet ; B 200 206 400 406 ;
C 184 ; WX 600 ; N quotesinglbase ; B 75 -225 400 204 ;
C 185 ; WX 600 ; N quotedblbase ; B 33 -199 567 199 ;
C 186 ; WX 600 ; N quotedblright ; B 33 280 567 678 ;
C 187 ; WX 600 ; N guillemotright ; B -17 -50 621 487 ;
C 188 ; WX 600 ; N ellipsis ; B 0 -65 600 135 ;
C 189 ; WX 600 ; N perthousand ; B -50 -65 650 689 ;
C 191 ; WX 600 ; N questiondown ; B 33 -257 546 475 ;
C 193 ; WX 600 ; N grave ; B 75 390 400 689 ;
C 194 ; WX 600 ; N acute ; B 200 390 525 689 ;
C 195 ; WX 600 ; N circumflex ; B 75 390 525 674 ;
C 196 ; WX 600 ; N tilde ; B 65 381 535 640 ;
C 197 ; WX 600 ; N macron ; B 75 416 525 616 ;
C 198 ; WX 600 ; N breve ; B 75 390 525 674 ;
C 199 ; WX 600 ; N dotaccent ; B 200 431 400 631 ;
C 200 ; WX 600 ; N dieresis ; B 96 431 504 631 ;
C 202 ; WX 600 ; N ring ; B 127 353 473 694 ;
C 203 ; WX 600 ; N cedilla ; B 130 -246 457 100 ;
C 205 ; WX 600 ; N hungarumlaut ; B 75 390 525 689 ;
C 206 ; WX 600 ; N ogonek ; B 200 -225 513 100 ;
C 207 ; WX 600 ; N caron ; B 75 390 525 674 ;
C 208 ; WX 600 ; N emdash ; B -79 181 679 381 ;
C 225 ; WX 600 ; N AE ; B -70 -50 670 633 ;
C 227 ; WX 600 ; N ordfeminine ; B 68 120 539 649 ;
C 232 ; WX 600 ; N Lslash ; B -37 -50 621 633 ;
C 233 ; WX 600 ; N Oslash ; B -40 -121 640 683 ;
C 234 ; WX 600 ; N OE ; B -70 -50 670 633 ;
C 235 ; WX 600 ; N ordmasculine ; B 72 120 530 649 ;
C 241 ; WX 600 ; N ae ; B -70 -65 660 502 ;
C 245 ; WX 600 ; N dotlessi ; B 12 -50 588 487 ;
C 248 ; WX 600 ; N lslash ; B 12 -50 588 674 ;
C 249 ; WX 600 ; N oslash ; B -27 -121 623 538 ;
C 250 ; WX 600 ; N oe ; B -70 -65 660 502 ;
C 251 ; WX 600 ; N germandbls ; B -37 -65 579 674 ;
C -1 ; WX 600 ; N Aacute ; B -71 -50 671 839 ;
C -1 ; WX 600 ; N Acircumflex ; B -71 -50 671 824 ;
C -1 ; WX 600 ; N Adieresis ; B -71 -50 671 781 ;
C -1 ; WX 600 ; N Agrave ; B -71 -50 671 839 ;
C -1 ; WX 600 ; N Aring ; B -71 -50 671 855 ;
C -1 ; WX 600 ; N Atilde ; B -71 -50 671 790 ;
C -1 ; WX 600 ; N Ccedilla ; B -17 -246 614 648 ;
C -1 ; WX 600 ; N Eacute ; B -37 -50 600 839 ;
C -1 ; WX 600 ; N Ecircumflex ; B -37 -50 600 824 ;
C -1 ; WX 600 ; N Edieresis ; B -37 -50 600 781 ;
C -1 ; WX 600 ; N Egrave ; B -37 -50 600 839 ;
C -1 ; WX 600 ; N Eth ; B -37 -50 600 633 ;
C -1 ; WX 600 ; N Gcaron ; B -17 -65 642 824 ;
C -1 ; WX 600 ; N IJ ; B -70 -65 670 633 ;
C -1 ; WX 600 ; N Iacute ; B 33 -50 567 839 ;
C -1 ; WX 600 ; N Icircumflex ; B 33 -50 567 824 ;
C -1 ; WX 600 ; N Idieresis ; B 33 -50 567 781 ;
C -1 ; WX 600 ; N Idot ; B 33 -50 567 781 ;
C -1 ; WX 600 ; N Igrave ; B 33 -50 567 839 ;
C -1 ; WX 600 ; N LL ; B -80 -50 680 633 ;
C -1 ; WX 600 ; N Ntilde ; B -58 -50 642 790 ;
C -1 ; WX 600 ; N Oacute ; B -29 -65 629 839 ;
C -1 ; WX 600 ; N Ocircumflex ; B -29 -65 629 824 ;
C -1 ; WX 600 ; N Odieresis ; B -29 -65 629 781 ;
C -1 ; WX 600 ; N Ograve ; B -29 -65 629 839 ;
C -1 ; WX 600 ; N Otilde ; B -29 -65 629 790 ;
C -1 ; WX 600 ; N Scaron ; B 12 -65 588 824 ;
C -1 ; WX 600 ; N Scedilla ; B 12 -246 588 648 ;
C -1 ; WX 600 ; N Thorn ; B -37 -50 599 633 ;
C -1 ; WX 600 ; N Uacute ; B -40 -65 640 839 ;
C -1 ; WX 600 ; N Ucircumflex ; B -40 -65 640 824 ;
C -1 ; WX 600 ; N Udieresis ; B -40 -65 640 781 ;
C -1 ; WX 600 ; N Ugrave ; B -40 -65 640 839 ;
C -1 ; WX 600 ; N Yacute ; B -29 -50 629 839 ;
C -1 ; WX 600 ; N Ydieresis ; B -29 -50 629 781 ;
C -1 ; WX 600 ; N Zcaron ; B 23 -50 577 824 ;
C -1 ; WX 600 ; N aacute ; B -8 -65 621 710 ;
C -1 ; WX 600 ; N acircumflex ; B -8 -65 621 703 ;
C -1 ; WX 600 ; N adieresis ; B -8 -65 621 652 ;
C -1 ; WX 600 ; N agrave ; B -8 -65 621 710 ;
C -1 ; WX 600 ; N aring ; B -8 -65 621 746 ;
C -1 ; WX 600 ; N arrowboth ; B -100 50 700 550 ;
C -1 ; WX 600 ; N arrowdown ; B 50 -50 550 689 ;
C -1 ; WX 600 ; N arrowleft ; B -100 50 700 550 ;
C -1 ; WX 600 ; N arrowright ; B -100 50 700 550 ;
C -1 ; WX 600 ; N arrowup ; B 50 -50 550 689 ;
C -1 ; WX 600 ; N atilde ; B -8 -65 621 678 ;
C -1 ; WX 600 ; N brokenbar ; B 200 -204 400 674 ;
C -1 ; WX 600 ; N ccedilla ; B 4 -246 615 502 ;
C -1 ; WX 600 ; N center ; B -60 -50 660 684 ;
C -1 ; WX 600 ; N copyright ; B -80 -65 680 648 ;
C -1 ; WX 600 ; N dectab ; B -65 -50 665 308 ;
C -1 ; WX 600 ; N degree ; B 75 234 525 674 ;
C -1 ; WX 600 ; N divide ; B -8 -9 608 591 ;
C -1 ; WX 600 ; N down ; B 94 -50 506 502 ;
C -1 ; WX 600 ; N eacute ; B -17 -65 600 714 ;
C -1 ; WX 600 ; N ecircumflex ; B -17 -65 600 703 ;
C -1 ; WX 600 ; N edieresis ; B -17 -65 600 652 ;
C -1 ; WX 600 ; N egrave ; B -17 -65 600 714 ;
C -1 ; WX 600 ; N eth ; B -8 -65 608 689 ;
C -1 ; WX 600 ; N format ; B -75 -257 125 674 ;
C -1 ; WX 600 ; N gcaron ; B -17 -257 642 695 ;
C -1 ; WX 600 ; N graybox ; B -25 -100 625 700 ;
C -1 ; WX 600 ; N iacute ; B 12 -50 588 710 ;
C -1 ; WX 600 ; N icircumflex ; B 12 -50 588 684 ;
C -1 ; WX 600 ; N idieresis ; B 12 -50 588 652 ;
C -1 ; WX 600 ; N igrave ; B 12 -50 588 706 ;
C -1 ; WX 600 ; N ij ; B -50 -257 610 725 ;
C -1 ; WX 600 ; N indent ; B -6 0 606 412 ;
C -1 ; WX 600 ; N largebullet ; B 200 206 400 406 ;
C -1 ; WX 600 ; N left ; B -6 0 606 412 ;
C -1 ; WX 600 ; N lira ; B -17 -50 600 648 ;
C -1 ; WX 600 ; N ll ; B -60 -50 660 674 ;
C -1 ; WX 600 ; N logicalnot ; B -8 94 608 454 ;
C -1 ; WX 600 ; N merge ; B 94 -50 506 502 ;
C -1 ; WX 600 ; N minus ; B -8 181 608 381 ;
C -1 ; WX 600 ; N mu ; B -37 -257 621 487 ;
C -1 ; WX 600 ; N multiply ; B 22 -48 578 530 ;
C -1 ; WX 600 ; N notegraphic ; B 80 -65 520 689 ;
C -1 ; WX 600 ; N ntilde ; B -27 -50 621 678 ;
C -1 ; WX 600 ; N oacute ; B -8 -65 608 699 ;
C -1 ; WX 600 ; N ocircumflex ; B -8 -65 608 703 ;
C -1 ; WX 600 ; N odieresis ; B -8 -65 608 652 ;
C -1 ; WX 600 ; N ograve ; B -8 -65 608 699 ;
C -1 ; WX 600 ; N onehalf ; B -70 -65 670 674 ;
C -1 ; WX 600 ; N onequarter ; B -70 -50 670 674 ;
C -1 ; WX 600 ; N onesuperior ; B 100 140 500 674 ;
C -1 ; WX 600 ; N otilde ; B -8 -65 608 657 ;
C -1 ; WX 600 ; N overscore ; B -92 489 692 689 ;
C -1 ; WX 600 ; N plusminus ; B -8 -50 608 610 ;
C -1 ; WX 600 ; N prescription ; B -37 -50 669 633 ;
C -1 ; WX 600 ; N registered ; B -80 -65 680 648 ;
C -1 ; WX 600 ; N return ; B -84 -50 684 668 ;
C -1 ; WX 600 ; N scaron ; B 23 -65 577 695 ;
C -1 ; WX 600 ; N scedilla ; B 23 -246 577 502 ;
C -1 ; WX 600 ; N square ; B -84 -50 684 668 ;
C -1 ; WX 600 ; N stop ; B -84 -50 684 668 ;
C -1 ; WX 600 ; N tab ; B -84 -50 684 668 ;
C -1 ; WX 600 ; N thorn ; B -58 -257 621 674 ;
C -1 ; WX 600 ; N threequarters ; B -70 -50 670 689 ;
C -1 ; WX 600 ; N threesuperior ; B 95 131 512 689 ;
C -1 ; WX 600 ; N trademark ; B -80 170 680 633 ;
C -1 ; WX 600 ; N twosuperior ; B 80 140 491 689 ;
C -1 ; WX 600 ; N uacute ; B -37 -65 621 706 ;
C -1 ; WX 600 ; N ucircumflex ; B -37 -65 621 684 ;
C -1 ; WX 600 ; N udieresis ; B -37 -65 621 652 ;
C -1 ; WX 600 ; N ugrave ; B -37 -65 621 706 ;
C -1 ; WX 600 ; N up ; B 94 -50 506 502 ;
C -1 ; WX 600 ; N yacute ; B -29 -257 629 706 ;
C -1 ; WX 600 ; N ydieresis ; B -29 -257 629 631 ;
C -1 ; WX 600 ; N zcaron ; B 35 -50 569 695 ;
EndCharMetrics
StartComposites 58
CC Zcaron 2 ; PCC Z 0 0 ; PCC caron 0 146 ;
CC zcaron 2 ; PCC z 0 0 ; PCC caron 0 0 ;
CC Scaron 2 ; PCC S 0 0 ; PCC caron 0 146 ;
CC scaron 2 ; PCC s 0 0 ; PCC caron 0 0 ;
CC Ccedilla 2 ; PCC C 0 0 ; PCC cedilla 0 0 ;
CC ccedilla 2 ; PCC c 0 0 ; PCC cedilla 0 0 ;
CC Yacute 2 ; PCC Y 0 0 ; PCC acute 0 146 ;
CC yacute 2 ; PCC y 0 0 ; PCC acute 0 0 ;
CC Ydieresis 2 ; PCC Y 0 0 ; PCC dieresis 0 146 ;
CC ydieresis 2 ; PCC y 0 0 ; PCC dieresis 0 0 ;
CC Uacute 2 ; PCC U 0 0 ; PCC acute 0 146 ;
CC Ucircumflex 2 ; PCC U 0 0 ; PCC circumflex 0 146 ;
CC Udieresis 2 ; PCC U 0 0 ; PCC dieresis 0 146 ;
CC Ugrave 2 ; PCC U 0 0 ; PCC grave 0 146 ;
CC uacute 2 ; PCC u 0 0 ; PCC acute 0 0 ;
CC ucircumflex 2 ; PCC u 0 0 ; PCC circumflex 0 0 ;
CC udieresis 2 ; PCC u 0 0 ; PCC dieresis 0 0 ;
CC ugrave 2 ; PCC u 0 0 ; PCC grave 0 0 ;
CC Iacute 2 ; PCC I 0 0 ; PCC acute 0 146 ;
CC Icircumflex 2 ; PCC I 0 0 ; PCC circumflex 0 146 ;
CC Idieresis 2 ; PCC I 0 0 ; PCC dieresis 0 146 ;
CC Igrave 2 ; PCC I 0 0 ; PCC grave 0 146 ;
CC iacute 2 ; PCC dotlessi 0 0 ; PCC acute 0 0 ;
CC icircumflex 2 ; PCC dotlessi 0 0 ; PCC circumflex 0 0 ;
CC idieresis 2 ; PCC dotlessi 0 0 ; PCC dieresis 0 0 ;
CC igrave 2 ; PCC dotlessi 0 0 ; PCC grave 0 0 ;
CC Eacute 2 ; PCC E 0 0 ; PCC acute 0 146 ;
CC Ecircumflex 2 ; PCC E 0 0 ; PCC circumflex 0 146 ;
CC Edieresis 2 ; PCC E 0 0 ; PCC dieresis 0 146 ;
CC Egrave 2 ; PCC E 0 0 ; PCC grave 0 146 ;
CC eacute 2 ; PCC e 0 0 ; PCC acute 0 0 ;
CC ecircumflex 2 ; PCC e 0 0 ; PCC circumflex 0 0 ;
CC edieresis 2 ; PCC e 0 0 ; PCC dieresis 0 0 ;
CC egrave 2 ; PCC e 0 0 ; PCC grave 0 0 ;
CC Aacute 2 ; PCC A 0 0 ; PCC acute 0 146 ;
CC Acircumflex 2 ; PCC A 0 0 ; PCC circumflex 0 146 ;
CC Adieresis 2 ; PCC A 0 0 ; PCC dieresis 0 146 ;
CC Agrave 2 ; PCC A 0 0 ; PCC grave 0 146 ;
CC aacute 2 ; PCC a 0 0 ; PCC acute 0 0 ;
CC acircumflex 2 ; PCC a 0 0 ; PCC circumflex 0 0 ;
CC adieresis 2 ; PCC a 0 0 ; PCC dieresis 0 0 ;
CC agrave 2 ; PCC a 0 0 ; PCC grave 0 0 ;
CC Oacute 2 ; PCC O 0 0 ; PCC acute 0 146 ;
CC Ocircumflex 2 ; PCC O 0 0 ; PCC circumflex 0 146 ;
CC Odieresis 2 ; PCC O 0 0 ; PCC dieresis 0 146 ;
CC Ograve 2 ; PCC O 0 0 ; PCC grave 0 146 ;
CC oacute 2 ; PCC o 0 0 ; PCC acute 0 0 ;
CC ocircumflex 2 ; PCC o 0 0 ; PCC circumflex 0 0 ;
CC odieresis 2 ; PCC o 0 0 ; PCC dieresis 0 0 ;
CC ograve 2 ; PCC o 0 0 ; PCC grave 0 0 ;
CC Atilde 2 ; PCC A 0 0 ; PCC tilde 0 146 ;
CC atilde 2 ; PCC a 0 0 ; PCC tilde 0 0 ;
CC Ntilde 2 ; PCC N 0 0 ; PCC tilde 0 146 ;
CC ntilde 2 ; PCC n 0 0 ; PCC tilde 0 0 ;
CC Otilde 2 ; PCC O 0 0 ; PCC tilde 0 146 ;
CC otilde 2 ; PCC o 0 0 ; PCC tilde 0 0 ;
CC Aring 2 ; PCC A 0 0 ; PCC ring 0 146 ;
CC aring 2 ; PCC a 0 0 ; PCC ring 0 0 ;
EndComposites
EndFontMetrics

341
collects/afm/Courier-BoldOblique.afm Normal file
View File

@ -0,0 +1,341 @@
StartFontMetrics 2.0
Comment Copyright (c) 1984 Adobe Systems Incorporated. All Rights Reserved.
Comment Creation Date:Mon Apr 6 17:40:32 PDT 1987
FontName Courier-BoldOblique
EncodingScheme AdobeStandardEncoding
FullName Courier Bold Oblique
FamilyName Courier
Weight Bold
ItalicAngle -12.0
IsFixedPitch true
UnderlinePosition -85
UnderlineThickness 100
Version 001.004
FontBBox -145 -350 817 855
CapHeight 633
XHeight 487
Descender -257
Ascender 674
StartCharMetrics 260
C 32 ; WX 600 ; N space ; B 500 -100 700 100 ;
C 33 ; WX 600 ; N exclam ; B 197 -65 549 689 ;
C 34 ; WX 600 ; N quotedbl ; B 171 254 654 663 ;
C 35 ; WX 600 ; N numbersign ; B 52 -142 672 725 ;
C 36 ; WX 600 ; N dollar ; B 51 -173 659 735 ;
C 37 ; WX 600 ; N percent ; B 58 -65 671 689 ;
C 38 ; WX 600 ; N ampersand ; B 52 -65 607 600 ;
C 39 ; WX 600 ; N quoteright ; B 148 244 522 674 ;
C 40 ; WX 600 ; N parenleft ; B 255 -204 662 683 ;
C 41 ; WX 600 ; N parenright ; B 45 -204 452 683 ;
C 42 ; WX 600 ; N asterisk ; B 131 150 665 674 ;
C 43 ; WX 600 ; N plus ; B 52 -48 668 610 ;
C 44 ; WX 600 ; N comma ; B 51 -215 424 215 ;
C 45 ; WX 600 ; N hyphen ; B 52 181 668 381 ;
C 46 ; WX 600 ; N period ; B 201 -50 421 150 ;
C 47 ; WX 600 ; N slash ; B 20 -163 704 746 ;
C 48 ; WX 600 ; N zero ; B 82 -65 649 689 ;
C 49 ; WX 600 ; N one ; B 44 -50 578 674 ;
C 50 ; WX 600 ; N two ; B 15 -50 656 689 ;
C 51 ; WX 600 ; N three ; B 30 -65 659 689 ;
C 52 ; WX 600 ; N four ; B 65 -50 618 674 ;
C 53 ; WX 600 ; N five ; B 33 -65 660 674 ;
C 54 ; WX 600 ; N six ; B 108 -65 712 689 ;
C 55 ; WX 600 ; N seven ; B 136 -50 680 674 ;
C 56 ; WX 600 ; N eight ; B 64 -65 655 689 ;
C 57 ; WX 600 ; N nine ; B 67 -65 665 689 ;
C 58 ; WX 600 ; N colon ; B 201 -50 489 472 ;
C 59 ; WX 600 ; N semicolon ; B 63 -176 489 472 ;
C 60 ; WX 600 ; N less ; B 52 -48 716 610 ;
C 61 ; WX 600 ; N equal ; B 11 88 708 474 ;
C 62 ; WX 600 ; N greater ; B 3 -48 668 610 ;
C 63 ; WX 600 ; N question ; B 148 -65 657 648 ;
C 64 ; WX 600 ; N at ; B 61 -142 640 705 ;
C 65 ; WX 600 ; N A ; B -60 -50 682 633 ;
C 66 ; WX 600 ; N B ; B -26 -50 670 633 ;
C 67 ; WX 600 ; N C ; B 31 -65 713 648 ;
C 68 ; WX 600 ; N D ; B -26 -50 670 633 ;
C 69 ; WX 600 ; N E ; B -26 -50 692 633 ;
C 70 ; WX 600 ; N F ; B -26 -50 713 633 ;
C 71 ; WX 600 ; N G ; B 29 -65 713 648 ;
C 72 ; WX 600 ; N H ; B -16 -50 723 633 ;
C 73 ; WX 600 ; N I ; B 44 -50 680 633 ;
C 74 ; WX 600 ; N J ; B 22 -65 776 633 ;
C 75 ; WX 600 ; N K ; B -26 -50 744 633 ;
C 76 ; WX 600 ; N L ; B -6 -50 665 633 ;
C 77 ; WX 600 ; N M ; B -58 -50 776 633 ;
C 78 ; WX 600 ; N N ; B -26 -50 755 633 ;
C 79 ; WX 600 ; N O ; B 26 -65 696 648 ;
C 80 ; WX 600 ; N P ; B -26 -50 666 633 ;
C 81 ; WX 600 ; N Q ; B 26 -196 696 648 ;
C 82 ; WX 600 ; N R ; B -26 -50 680 633 ;
C 83 ; WX 600 ; N S ; B 23 -65 680 648 ;
C 84 ; WX 600 ; N T ; B 72 -50 721 633 ;
C 85 ; WX 600 ; N U ; B 61 -65 753 633 ;
C 86 ; WX 600 ; N V ; B 42 -50 784 633 ;
C 87 ; WX 600 ; N W ; B 50 -50 773 633 ;
C 88 ; WX 600 ; N X ; B -29 -50 742 633 ;
C 89 ; WX 600 ; N Y ; B 76 -50 742 633 ;
C 90 ; WX 600 ; N Z ; B 34 -50 669 633 ;
C 91 ; WX 600 ; N bracketleft ; B 178 -204 647 674 ;
C 92 ; WX 600 ; N backslash ; B 170 -163 554 746 ;
C 93 ; WX 600 ; N bracketright ; B 53 -204 522 674 ;
C 94 ; WX 600 ; N asciicircum ; B 113 275 647 674 ;
C 95 ; WX 600 ; N underscore ; B -145 -350 639 -150 ;
C 96 ; WX 600 ; N quoteleft ; B 322 244 598 674 ;
C 97 ; WX 600 ; N a ; B 16 -65 632 502 ;
C 98 ; WX 600 ; N b ; B -47 -65 670 674 ;
C 99 ; WX 600 ; N c ; B 44 -65 672 502 ;
C 100 ; WX 600 ; N d ; B 23 -65 701 674 ;
C 101 ; WX 600 ; N e ; B 25 -65 650 502 ;
C 102 ; WX 600 ; N f ; B 36 -50 740 674 ; L i fi ; L l fl ;
C 103 ; WX 600 ; N g ; B 25 -257 724 502 ;
C 104 ; WX 600 ; N h ; B -16 -50 642 674 ;
C 105 ; WX 600 ; N i ; B 23 -50 599 725 ;
C 106 ; WX 600 ; N j ; B 34 -257 620 725 ;
C 107 ; WX 600 ; N k ; B -6 -50 661 674 ;
C 108 ; WX 600 ; N l ; B 23 -50 599 674 ;
C 109 ; WX 600 ; N m ; B -58 -50 684 502 ;
C 110 ; WX 600 ; N n ; B -16 -50 632 502 ;
C 111 ; WX 600 ; N o ; B 34 -65 656 502 ;
C 112 ; WX 600 ; N p ; B -91 -257 671 502 ;
C 113 ; WX 600 ; N q ; B 27 -257 745 502 ;
C 114 ; WX 600 ; N r ; B 15 -50 699 501 ;
C 115 ; WX 600 ; N s ; B 34 -65 638 502 ;
C 116 ; WX 600 ; N t ; B 45 -65 599 642 ;
C 117 ; WX 600 ; N u ; B 45 -65 640 487 ;
C 118 ; WX 600 ; N v ; B 32 -50 732 487 ;
C 119 ; WX 600 ; N w ; B 32 -50 732 487 ;
C 120 ; WX 600 ; N x ; B -18 -50 690 487 ;
C 121 ; WX 600 ; N y ; B -62 -257 711 487 ;
C 122 ; WX 600 ; N z ; B 46 -50 640 487 ;
C 123 ; WX 600 ; N braceleft ; B 168 -204 605 674 ;
C 124 ; WX 600 ; N bar ; B 178 -204 522 674 ;
C 125 ; WX 600 ; N braceright ; B 95 -204 534 674 ;
C 126 ; WX 600 ; N asciitilde ; B 67 129 652 433 ;
C 161 ; WX 600 ; N exclamdown ; B 143 -257 490 475 ;
C 162 ; WX 600 ; N cent ; B 96 -79 643 725 ;
C 163 ; WX 600 ; N sterling ; B 15 -50 620 648 ;
C 164 ; WX 600 ; N fraction ; B 5 60 725 552 ;
C 165 ; WX 600 ; N yen ; B 77 -50 742 633 ;
C 166 ; WX 600 ; N florin ; B -6 -173 720 689 ;
C 167 ; WX 600 ; N section ; B 18 -147 697 689 ;
C 168 ; WX 600 ; N currency ; B 47 15 677 569 ;
C 169 ; WX 600 ; N quotesingle ; B 273 244 552 674 ;
C 170 ; WX 600 ; N quotedblleft ; B 156 280 648 678 ;
C 171 ; WX 600 ; N guillemotleft ; B 27 -50 703 487 ;
C 172 ; WX 600 ; N guilsinglleft ; B 27 -50 474 487 ;
C 173 ; WX 600 ; N guilsinglright ; B 224 -50 665 487 ;
C 174 ; WX 600 ; N fi ; B -59 -50 681 725 ;
C 175 ; WX 600 ; N fl ; B -59 -50 687 674 ;
C 177 ; WX 600 ; N endash ; B 52 181 668 381 ;
C 178 ; WX 600 ; N dagger ; B 126 -142 638 674 ;
C 179 ; WX 600 ; N daggerdbl ; B 75 -142 638 674 ;
C 180 ; WX 600 ; N periodcentered ; B 255 206 475 406 ;
C 182 ; WX 600 ; N paragraph ; B 72 -147 730 689 ;
C 183 ; WX 600 ; N bullet ; B 265 206 465 406 ;
C 184 ; WX 600 ; N quotesinglbase ; B 48 -225 422 204 ;
C 185 ; WX 600 ; N quotedblbase ; B 12 -199 588 199 ;
C 186 ; WX 600 ; N quotedblright ; B 114 280 690 678 ;
C 187 ; WX 600 ; N guillemotright ; B -6 -50 665 487 ;
C 188 ; WX 600 ; N ellipsis ; B 7 -65 607 135 ;
C 189 ; WX 600 ; N perthousand ; B 55 -65 679 689 ;
C 191 ; WX 600 ; N questiondown ; B 26 -257 533 475 ;
C 193 ; WX 600 ; N grave ; B 200 390 504 689 ;
C 194 ; WX 600 ; N acute ; B 304 390 650 689 ;
C 195 ; WX 600 ; N circumflex ; B 179 390 629 674 ;
C 196 ; WX 600 ; N tilde ; B 171 381 646 640 ;
C 197 ; WX 600 ; N macron ; B 185 416 635 616 ;
C 198 ; WX 600 ; N breve ; B 196 390 647 674 ;
C 199 ; WX 600 ; N dotaccent ; B 313 431 513 631 ;
C 200 ; WX 600 ; N dieresis ; B 209 431 617 631 ;
C 202 ; WX 600 ; N ring ; B 237 353 586 694 ;
C 203 ; WX 600 ; N cedilla ; B 103 -246 436 100 ;
C 205 ; WX 600 ; N hungarumlaut ; B 179 390 650 689 ;
C 206 ; WX 600 ; N ogonek ; B 184 -225 490 100 ;
C 207 ; WX 600 ; N caron ; B 197 390 647 674 ;
C 208 ; WX 600 ; N emdash ; B -19 181 739 381 ;
C 225 ; WX 600 ; N AE ; B -59 -50 763 633 ;
C 227 ; WX 600 ; N ordfeminine ; B 114 120 590 649 ;
C 232 ; WX 600 ; N Lslash ; B -6 -50 665 633 ;
C 233 ; WX 600 ; N Oslash ; B -44 -121 764 683 ;
C 234 ; WX 600 ; N OE ; B -16 -50 763 633 ;
C 235 ; WX 600 ; N ordmasculine ; B 118 120 623 649 ;
C 241 ; WX 600 ; N ae ; B -39 -65 711 502 ;
C 245 ; WX 600 ; N dotlessi ; B 23 -50 599 487 ;
C 248 ; WX 600 ; N lslash ; B 23 -50 604 674 ;
C 249 ; WX 600 ; N oslash ; B -31 -121 716 538 ;
C 250 ; WX 600 ; N oe ; B -30 -65 711 502 ;
C 251 ; WX 600 ; N germandbls ; B -26 -65 618 674 ;
C -1 ; WX 600 ; N Aacute ; B -60 -50 682 839 ;
C -1 ; WX 600 ; N Acircumflex ; B -60 -50 682 824 ;
C -1 ; WX 600 ; N Adieresis ; B -60 -50 682 781 ;
C -1 ; WX 600 ; N Agrave ; B -60 -50 682 839 ;
C -1 ; WX 600 ; N Aring ; B -60 -50 682 855 ;
C -1 ; WX 600 ; N Atilde ; B -60 -50 682 790 ;
C -1 ; WX 600 ; N Ccedilla ; B 31 -246 713 648 ;
C -1 ; WX 600 ; N Eacute ; B -26 -50 692 839 ;
C -1 ; WX 600 ; N Ecircumflex ; B -26 -50 692 824 ;
C -1 ; WX 600 ; N Edieresis ; B -26 -50 692 781 ;
C -1 ; WX 600 ; N Egrave ; B -26 -50 692 839 ;
C -1 ; WX 600 ; N Eth ; B -26 -50 670 633 ;
C -1 ; WX 600 ; N Gcaron ; B 29 -65 713 824 ;
C -1 ; WX 600 ; N IJ ; B -59 -65 783 633 ;
C -1 ; WX 600 ; N Iacute ; B 44 -50 680 839 ;
C -1 ; WX 600 ; N Icircumflex ; B 44 -50 680 824 ;
C -1 ; WX 600 ; N Idieresis ; B 44 -50 680 781 ;
C -1 ; WX 600 ; N Idot ; B 44 -50 680 781 ;
C -1 ; WX 600 ; N Igrave ; B 44 -50 680 839 ;
C -1 ; WX 600 ; N LL ; B -69 -50 712 633 ;
C -1 ; WX 600 ; N Ntilde ; B -26 -50 755 790 ;
C -1 ; WX 600 ; N Oacute ; B 26 -65 696 839 ;
C -1 ; WX 600 ; N Ocircumflex ; B 26 -65 696 824 ;
C -1 ; WX 600 ; N Odieresis ; B 26 -65 696 781 ;
C -1 ; WX 600 ; N Ograve ; B 26 -65 696 839 ;
C -1 ; WX 600 ; N Otilde ; B 26 -65 696 790 ;
C -1 ; WX 600 ; N Scaron ; B 23 -65 680 824 ;
C -1 ; WX 600 ; N Scedilla ; B 23 -246 680 648 ;
C -1 ; WX 600 ; N Thorn ; B -26 -50 663 633 ;
C -1 ; WX 600 ; N Uacute ; B 61 -65 753 839 ;
C -1 ; WX 600 ; N Ucircumflex ; B 61 -65 753 824 ;
C -1 ; WX 600 ; N Udieresis ; B 61 -65 753 781 ;
C -1 ; WX 600 ; N Ugrave ; B 61 -65 753 839 ;
C -1 ; WX 600 ; N Yacute ; B 76 -50 742 839 ;
C -1 ; WX 600 ; N Ydieresis ; B 76 -50 742 781 ;
C -1 ; WX 600 ; N Zcaron ; B 34 -50 679 824 ;
C -1 ; WX 600 ; N aacute ; B 16 -65 632 710 ;
C -1 ; WX 600 ; N acircumflex ; B 16 -65 635 703 ;
C -1 ; WX 600 ; N adieresis ; B 16 -65 632 652 ;
C -1 ; WX 600 ; N agrave ; B 16 -65 632 710 ;
C -1 ; WX 600 ; N aring ; B 16 -65 632 746 ;
C -1 ; WX 600 ; N arrowboth ; B -36 50 764 550 ;
C -1 ; WX 600 ; N arrowdown ; B 93 -50 593 689 ;
C -1 ; WX 600 ; N arrowleft ; B -36 50 764 550 ;
C -1 ; WX 600 ; N arrowright ; B -36 50 764 550 ;
C -1 ; WX 600 ; N arrowup ; B 143 -50 643 689 ;
C -1 ; WX 600 ; N atilde ; B 16 -65 654 678 ;
C -1 ; WX 600 ; N brokenbar ; B 178 -204 522 674 ;
C -1 ; WX 600 ; N ccedilla ; B 44 -246 672 502 ;
C -1 ; WX 600 ; N center ; B 2 -50 722 684 ;
C -1 ; WX 600 ; N copyright ; B -27 -65 743 648 ;
C -1 ; WX 600 ; N dectab ; B -54 -50 676 308 ;
C -1 ; WX 600 ; N degree ; B 171 234 624 674 ;
C -1 ; WX 600 ; N divide ; B 52 -9 668 591 ;
C -1 ; WX 600 ; N down ; B 127 -50 539 502 ;
C -1 ; WX 600 ; N eacute ; B 25 -65 650 714 ;
C -1 ; WX 600 ; N ecircumflex ; B 25 -65 650 703 ;
C -1 ; WX 600 ; N edieresis ; B 25 -65 650 652 ;
C -1 ; WX 600 ; N egrave ; B 25 -65 650 714 ;
C -1 ; WX 600 ; N eth ; B 28 -65 695 689 ;
C -1 ; WX 600 ; N format ; B -108 -257 247 674 ;
C -1 ; WX 600 ; N gcaron ; B 25 -257 724 695 ;
C -1 ; WX 600 ; N graybox ; B -25 -100 753 700 ;
C -1 ; WX 600 ; N iacute ; B 23 -50 599 710 ;
C -1 ; WX 600 ; N icircumflex ; B 23 -50 599 684 ;
C -1 ; WX 600 ; N idieresis ; B 23 -50 599 652 ;
C -1 ; WX 600 ; N igrave ; B 23 -50 599 706 ;
C -1 ; WX 600 ; N ij ; B -39 -257 692 725 ;
C -1 ; WX 600 ; N indent ; B 38 0 650 412 ;
C -1 ; WX 600 ; N largebullet ; B 265 206 465 406 ;
C -1 ; WX 600 ; N left ; B 38 0 650 412 ;
C -1 ; WX 600 ; N lira ; B 15 -50 620 648 ;
C -1 ; WX 600 ; N ll ; B -49 -50 682 674 ;
C -1 ; WX 600 ; N logicalnot ; B 67 94 683 454 ;
C -1 ; WX 600 ; N merge ; B 127 -50 569 502 ;
C -1 ; WX 600 ; N minus ; B 52 181 668 381 ;
C -1 ; WX 600 ; N mu ; B 13 -257 640 487 ;
C -1 ; WX 600 ; N multiply ; B 33 -48 669 530 ;
C -1 ; WX 600 ; N notegraphic ; B 107 -65 639 689 ;
C -1 ; WX 600 ; N ntilde ; B -16 -50 632 678 ;
C -1 ; WX 600 ; N oacute ; B 34 -65 656 699 ;
C -1 ; WX 600 ; N ocircumflex ; B 34 -65 656 703 ;
C -1 ; WX 600 ; N odieresis ; B 34 -65 656 652 ;
C -1 ; WX 600 ; N ograve ; B 34 -65 656 699 ;
C -1 ; WX 600 ; N onehalf ; B -14 -65 725 674 ;
C -1 ; WX 600 ; N onequarter ; B -14 -50 741 674 ;
C -1 ; WX 600 ; N onesuperior ; B 151 140 551 674 ;
C -1 ; WX 600 ; N otilde ; B 34 -65 656 657 ;
C -1 ; WX 600 ; N overscore ; B 33 489 817 689 ;
C -1 ; WX 600 ; N plusminus ; B 3 -50 677 610 ;
C -1 ; WX 600 ; N prescription ; B -26 -50 680 633 ;
C -1 ; WX 600 ; N registered ; B -27 -65 743 648 ;
C -1 ; WX 600 ; N return ; B -24 -50 805 668 ;
C -1 ; WX 600 ; N scaron ; B 34 -65 651 695 ;
C -1 ; WX 600 ; N scedilla ; B 34 -246 638 502 ;
C -1 ; WX 600 ; N square ; B -73 -50 805 668 ;
C -1 ; WX 600 ; N stop ; B -73 -50 805 668 ;
C -1 ; WX 600 ; N tab ; B -73 -50 744 668 ;
C -1 ; WX 600 ; N thorn ; B -91 -257 671 674 ;
C -1 ; WX 600 ; N threequarters ; B -3 -50 711 689 ;
C -1 ; WX 600 ; N threesuperior ; B 155 131 612 689 ;
C -1 ; WX 600 ; N trademark ; B 18 170 793 633 ;
C -1 ; WX 600 ; N twosuperior ; B 131 140 601 689 ;
C -1 ; WX 600 ; N uacute ; B 45 -65 640 706 ;
C -1 ; WX 600 ; N ucircumflex ; B 45 -65 640 684 ;
C -1 ; WX 600 ; N udieresis ; B 45 -65 640 652 ;
C -1 ; WX 600 ; N ugrave ; B 45 -65 640 706 ;
C -1 ; WX 600 ; N up ; B 157 -50 569 502 ;
C -1 ; WX 600 ; N yacute ; B -62 -257 711 706 ;
C -1 ; WX 600 ; N ydieresis ; B -62 -257 711 631 ;
C -1 ; WX 600 ; N zcaron ; B 46 -50 651 695 ;
EndCharMetrics
StartComposites 58
CC Zcaron 2 ; PCC Z 0 0 ; PCC caron 0 146 ;
CC zcaron 2 ; PCC z 0 0 ; PCC caron 0 0 ;
CC Scaron 2 ; PCC S 0 0 ; PCC caron 0 146 ;
CC scaron 2 ; PCC s 0 0 ; PCC caron 0 0 ;
CC Ccedilla 2 ; PCC C 0 0 ; PCC cedilla 0 0 ;
CC ccedilla 2 ; PCC c 0 0 ; PCC cedilla 0 0 ;
CC Yacute 2 ; PCC Y 0 0 ; PCC acute 0 146 ;
CC yacute 2 ; PCC y 0 0 ; PCC acute 0 0 ;
CC Ydieresis 2 ; PCC Y 0 0 ; PCC dieresis 0 146 ;
CC ydieresis 2 ; PCC y 0 0 ; PCC dieresis 0 0 ;
CC Uacute 2 ; PCC U 0 0 ; PCC acute 0 146 ;
CC Ucircumflex 2 ; PCC U 0 0 ; PCC circumflex 0 146 ;
CC Udieresis 2 ; PCC U 0 0 ; PCC dieresis 0 146 ;
CC Ugrave 2 ; PCC U 0 0 ; PCC grave 0 146 ;
CC uacute 2 ; PCC u 0 0 ; PCC acute 0 0 ;
CC ucircumflex 2 ; PCC u 0 0 ; PCC circumflex 0 0 ;
CC udieresis 2 ; PCC u 0 0 ; PCC dieresis 0 0 ;
CC ugrave 2 ; PCC u 0 0 ; PCC grave 0 0 ;
CC Iacute 2 ; PCC I 0 0 ; PCC acute 0 146 ;
CC Icircumflex 2 ; PCC I 0 0 ; PCC circumflex 0 146 ;
CC Idieresis 2 ; PCC I 0 0 ; PCC dieresis 0 146 ;
CC Igrave 2 ; PCC I 0 0 ; PCC grave 0 146 ;
CC iacute 2 ; PCC dotlessi 0 0 ; PCC acute 0 0 ;
CC icircumflex 2 ; PCC dotlessi 0 0 ; PCC circumflex 0 0 ;
CC idieresis 2 ; PCC dotlessi 0 0 ; PCC dieresis 0 0 ;
CC igrave 2 ; PCC dotlessi 0 0 ; PCC grave 0 0 ;
CC Eacute 2 ; PCC E 0 0 ; PCC acute 0 146 ;
CC Ecircumflex 2 ; PCC E 0 0 ; PCC circumflex 0 146 ;
CC Edieresis 2 ; PCC E 0 0 ; PCC dieresis 0 146 ;
CC Egrave 2 ; PCC E 0 0 ; PCC grave 0 146 ;
CC eacute 2 ; PCC e 0 0 ; PCC acute 0 0 ;
CC ecircumflex 2 ; PCC e 0 0 ; PCC circumflex 0 0 ;
CC edieresis 2 ; PCC e 0 0 ; PCC dieresis 0 0 ;
CC egrave 2 ; PCC e 0 0 ; PCC grave 0 0 ;
CC Aacute 2 ; PCC A 0 0 ; PCC acute 0 146 ;
CC Acircumflex 2 ; PCC A 0 0 ; PCC circumflex 0 146 ;
CC Adieresis 2 ; PCC A 0 0 ; PCC dieresis 0 146 ;
CC Agrave 2 ; PCC A 0 0 ; PCC grave 0 146 ;
CC aacute 2 ; PCC a 0 0 ; PCC acute 0 0 ;
CC acircumflex 2 ; PCC a 0 0 ; PCC circumflex 0 0 ;
CC adieresis 2 ; PCC a 0 0 ; PCC dieresis 0 0 ;
CC agrave 2 ; PCC a 0 0 ; PCC grave 0 0 ;
CC Oacute 2 ; PCC O 0 0 ; PCC acute 0 146 ;
CC Ocircumflex 2 ; PCC O 0 0 ; PCC circumflex 0 146 ;
CC Odieresis 2 ; PCC O 0 0 ; PCC dieresis 0 146 ;
CC Ograve 2 ; PCC O 0 0 ; PCC grave 0 146 ;
CC oacute 2 ; PCC o 0 0 ; PCC acute 0 0 ;
CC ocircumflex 2 ; PCC o 0 0 ; PCC circumflex 0 0 ;
CC odieresis 2 ; PCC o 0 0 ; PCC dieresis 0 0 ;
CC ograve 2 ; PCC o 0 0 ; PCC grave 0 0 ;
CC Atilde 2 ; PCC A 0 0 ; PCC tilde 0 146 ;
CC atilde 2 ; PCC a 0 0 ; PCC tilde 0 0 ;
CC Ntilde 2 ; PCC N 0 0 ; PCC tilde 0 146 ;
CC ntilde 2 ; PCC n 0 0 ; PCC tilde 0 0 ;
CC Otilde 2 ; PCC O 0 0 ; PCC tilde 0 146 ;
CC otilde 2 ; PCC o 0 0 ; PCC tilde 0 0 ;
CC Aring 2 ; PCC A 0 0 ; PCC ring 0 146 ;
CC aring 2 ; PCC a 0 0 ; PCC ring 0 0 ;
EndComposites
EndFontMetrics

341
collects/afm/Courier-Oblique.afm Normal file
View File

@ -0,0 +1,341 @@
StartFontMetrics 2.0
Comment Copyright (c) 1984 Adobe Systems Incorporated. All Rights Reserved.
Comment Creation Date:Mon Apr 6 17:05:22 PDT 1987
FontName Courier-Oblique
EncodingScheme AdobeStandardEncoding
FullName Courier Oblique
FamilyName Courier
Weight Medium
ItalicAngle -12.0
IsFixedPitch true
UnderlinePosition -82
UnderlineThickness 40
Version 001.004
FontBBox -85 -290 759 795
CapHeight 583
XHeight 437
Descender -207
Ascender 624
StartCharMetrics 260
C 32 ; WX 600 ; N space ; B 560 -40 640 40 ;
C 33 ; WX 600 ; N exclam ; B 257 -5 483 639 ;
C 34 ; WX 600 ; N quotedbl ; B 231 314 594 603 ;
C 35 ; WX 600 ; N numbersign ; B 116 -82 608 665 ;
C 36 ; WX 600 ; N dollar ; B 111 -113 601 675 ;
C 37 ; WX 600 ; N percent ; B 118 -35 611 639 ;
C 38 ; WX 600 ; N ampersand ; B 112 -35 547 540 ;
C 39 ; WX 600 ; N quoteright ; B 208 304 462 613 ;
C 40 ; WX 600 ; N parenleft ; B 315 -144 602 623 ;
C 41 ; WX 600 ; N parenright ; B 105 -144 392 623 ;
C 42 ; WX 600 ; N asterisk ; B 191 210 605 624 ;
C 43 ; WX 600 ; N plus ; B 112 12 608 550 ;
C 44 ; WX 600 ; N comma ; B 111 -155 364 155 ;
C 45 ; WX 600 ; N hyphen ; B 112 241 608 321 ;
C 46 ; WX 600 ; N period ; B 261 10 361 90 ;
C 47 ; WX 600 ; N slash ; B 80 -103 644 686 ;
C 48 ; WX 600 ; N zero ; B 139 -35 590 639 ;
C 49 ; WX 600 ; N one ; B 97 -20 511 624 ;
C 50 ; WX 600 ; N two ; B 68 -20 596 639 ;
C 51 ; WX 600 ; N three ; B 90 -35 599 639 ;
C 52 ; WX 600 ; N four ; B 125 -20 560 624 ;
C 53 ; WX 600 ; N five ; B 93 -35 602 624 ;
C 54 ; WX 600 ; N six ; B 167 -35 654 639 ;
C 55 ; WX 600 ; N seven ; B 196 -20 622 624 ;
C 56 ; WX 600 ; N eight ; B 124 -35 595 639 ;
C 57 ; WX 600 ; N nine ; B 120 -35 606 639 ;
C 58 ; WX 600 ; N colon ; B 261 10 425 392 ;
C 59 ; WX 600 ; N semicolon ; B 123 -116 425 392 ;
C 60 ; WX 600 ; N less ; B 112 12 656 550 ;
C 61 ; WX 600 ; N equal ; B 75 168 644 394 ;
C 62 ; WX 600 ; N greater ; B 63 12 608 550 ;
C 63 ; WX 600 ; N question ; B 211 -5 597 598 ;
C 64 ; WX 600 ; N at ; B 120 -82 580 644 ;
C 65 ; WX 600 ; N A ; B -7 -20 615 583 ;
C 66 ; WX 600 ; N B ; B 27 -20 610 583 ;
C 67 ; WX 600 ; N C ; B 91 -35 655 598 ;
C 68 ; WX 600 ; N D ; B 27 -20 610 583 ;
C 69 ; WX 600 ; N E ; B 27 -20 634 583 ;
C 70 ; WX 600 ; N F ; B 27 -20 655 583 ;
C 71 ; WX 600 ; N G ; B 89 -35 655 598 ;
C 72 ; WX 600 ; N H ; B 37 -20 665 583 ;
C 73 ; WX 600 ; N I ; B 97 -20 622 583 ;
C 74 ; WX 600 ; N J ; B 82 -35 718 583 ;
C 75 ; WX 600 ; N K ; B 27 -20 686 583 ;
C 76 ; WX 600 ; N L ; B 47 -20 605 583 ;
C 77 ; WX 600 ; N M ; B -5 -20 718 583 ;
C 78 ; WX 600 ; N N ; B 27 -20 697 583 ;
C 79 ; WX 600 ; N O ; B 83 -35 636 598 ;
C 80 ; WX 600 ; N P ; B 27 -20 606 583 ;
C 81 ; WX 600 ; N Q ; B 84 -136 636 598 ;
C 82 ; WX 600 ; N R ; B 27 -20 613 583 ;
C 83 ; WX 600 ; N S ; B 76 -35 622 598 ;
C 84 ; WX 600 ; N T ; B 129 -20 663 583 ;
C 85 ; WX 600 ; N U ; B 119 -35 695 583 ;
C 86 ; WX 600 ; N V ; B 104 -20 726 583 ;
C 87 ; WX 600 ; N W ; B 103 -20 715 583 ;
C 88 ; WX 600 ; N X ; B 24 -20 684 583 ;
C 89 ; WX 600 ; N Y ; B 129 -20 684 583 ;
C 90 ; WX 600 ; N Z ; B 87 -20 611 583 ;
C 91 ; WX 600 ; N bracketleft ; B 238 -144 589 624 ;
C 92 ; WX 600 ; N backslash ; B 230 -103 494 686 ;
C 93 ; WX 600 ; N bracketright ; B 113 -144 464 624 ;
C 94 ; WX 600 ; N asciicircum ; B 173 335 587 624 ;
C 95 ; WX 600 ; N underscore ; B -85 -290 579 -210 ;
C 96 ; WX 600 ; N quoteleft ; B 382 304 538 613 ;
C 97 ; WX 600 ; N a ; B 74 -35 565 452 ;
C 98 ; WX 600 ; N b ; B 6 -35 610 624 ;
C 99 ; WX 600 ; N c ; B 104 -35 614 452 ;
C 100 ; WX 600 ; N d ; B 83 -35 643 624 ;
C 101 ; WX 600 ; N e ; B 85 -35 590 452 ;
C 102 ; WX 600 ; N f ; B 89 -20 682 624 ; L i fi ; L l fl ;
C 103 ; WX 600 ; N g ; B 85 -207 666 452 ;
C 104 ; WX 600 ; N h ; B 37 -20 575 624 ;
C 105 ; WX 600 ; N i ; B 76 -20 532 665 ;
C 106 ; WX 600 ; N j ; B 92 -207 562 665 ;
C 107 ; WX 600 ; N k ; B 47 -20 603 624 ;
C 108 ; WX 600 ; N l ; B 76 -20 532 624 ;
C 109 ; WX 600 ; N m ; B -5 -20 621 452 ;
C 110 ; WX 600 ; N n ; B 37 -20 565 452 ;
C 111 ; WX 600 ; N o ; B 91 -35 597 452 ;
C 112 ; WX 600 ; N p ; B -33 -207 612 452 ;
C 113 ; WX 600 ; N q ; B 85 -207 687 452 ;
C 114 ; WX 600 ; N r ; B 68 -20 639 448 ;
C 115 ; WX 600 ; N s ; B 87 -35 580 452 ;
C 116 ; WX 600 ; N t ; B 107 -35 541 582 ;
C 117 ; WX 600 ; N u ; B 107 -35 582 437 ;
C 118 ; WX 600 ; N v ; B 94 -20 674 437 ;
C 119 ; WX 600 ; N w ; B 94 -20 674 437 ;
C 120 ; WX 600 ; N x ; B 35 -20 632 437 ;
C 121 ; WX 600 ; N y ; B -4 -207 653 437 ;
C 122 ; WX 600 ; N z ; B 99 -20 582 437 ;
C 123 ; WX 600 ; N braceleft ; B 228 -144 547 624 ;
C 124 ; WX 600 ; N bar ; B 238 -144 464 624 ;
C 125 ; WX 600 ; N braceright ; B 155 -144 474 624 ;
C 126 ; WX 600 ; N asciitilde ; B 127 189 592 373 ;
C 161 ; WX 600 ; N exclamdown ; B 209 -207 430 415 ;
C 162 ; WX 600 ; N cent ; B 156 -19 583 665 ;
C 163 ; WX 600 ; N sterling ; B 68 -20 560 598 ;
C 164 ; WX 600 ; N fraction ; B 65 120 665 492 ;
C 165 ; WX 600 ; N yen ; B 137 -20 684 583 ;
C 166 ; WX 600 ; N florin ; B 54 -113 663 639 ;
C 167 ; WX 600 ; N section ; B 78 -87 637 629 ;
C 168 ; WX 600 ; N currency ; B 107 75 617 509 ;
C 169 ; WX 600 ; N quotesingle ; B 333 304 492 613 ;
C 170 ; WX 600 ; N quotedblleft ; B 216 340 588 619 ;
C 171 ; WX 600 ; N guillemotleft ; B 87 -20 645 437 ;
C 172 ; WX 600 ; N guilsinglleft ; B 87 -20 416 437 ;
C 173 ; WX 600 ; N guilsinglright ; B 277 -20 605 437 ;
C 174 ; WX 600 ; N fi ; B -6 -20 628 665 ;
C 175 ; WX 600 ; N fl ; B -6 -20 629 624 ;
C 177 ; WX 600 ; N endash ; B 112 241 608 321 ;
C 178 ; WX 600 ; N dagger ; B 188 -82 580 624 ;
C 179 ; WX 600 ; N daggerdbl ; B 135 -82 580 624 ;
C 180 ; WX 600 ; N periodcentered ; B 315 266 415 346 ;
C 182 ; WX 600 ; N paragraph ; B 132 -87 670 629 ;
C 183 ; WX 600 ; N bullet ; B 325 266 405 346 ;
C 184 ; WX 600 ; N quotesinglbase ; B 108 -165 362 144 ;
C 185 ; WX 600 ; N quotedblbase ; B 72 -139 528 139 ;
C 186 ; WX 600 ; N quotedblright ; B 174 340 630 619 ;
C 187 ; WX 600 ; N guillemotright ; B 47 -20 605 437 ;
C 188 ; WX 600 ; N ellipsis ; B 67 -5 547 75 ;
C 189 ; WX 600 ; N perthousand ; B 117 -35 619 639 ;
C 191 ; WX 600 ; N questiondown ; B 85 -207 470 415 ;
C 193 ; WX 600 ; N grave ; B 262 450 444 639 ;
C 194 ; WX 600 ; N acute ; B 364 450 592 639 ;
C 195 ; WX 600 ; N circumflex ; B 239 450 569 624 ;
C 196 ; WX 600 ; N tilde ; B 231 441 586 580 ;
C 197 ; WX 600 ; N macron ; B 245 476 575 556 ;
C 198 ; WX 600 ; N breve ; B 258 450 589 624 ;
C 199 ; WX 600 ; N dotaccent ; B 373 491 453 571 ;
C 200 ; WX 600 ; N dieresis ; B 269 491 557 571 ;
C 202 ; WX 600 ; N ring ; B 297 413 526 634 ;
C 203 ; WX 600 ; N cedilla ; B 163 -186 376 40 ;
C 205 ; WX 600 ; N hungarumlaut ; B 239 450 592 639 ;
C 206 ; WX 600 ; N ogonek ; B 244 -165 430 40 ;
C 207 ; WX 600 ; N caron ; B 259 450 589 624 ;
C 208 ; WX 600 ; N emdash ; B 41 241 679 321 ;
C 225 ; WX 600 ; N AE ; B -6 -20 705 583 ;
C 227 ; WX 600 ; N ordfeminine ; B 174 179 529 598 ;
C 232 ; WX 600 ; N Lslash ; B 47 -20 605 583 ;
C 233 ; WX 600 ; N Oslash ; B 16 -61 704 623 ;
C 234 ; WX 600 ; N OE ; B 42 -20 705 583 ;
C 235 ; WX 600 ; N ordmasculine ; B 178 179 563 598 ;
C 241 ; WX 600 ; N ae ; B 19 -35 651 452 ;
C 245 ; WX 600 ; N dotlessi ; B 76 -20 532 437 ;
C 248 ; WX 600 ; N lslash ; B 76 -20 544 624 ;
C 249 ; WX 600 ; N oslash ; B 29 -61 656 478 ;
C 250 ; WX 600 ; N oe ; B 28 -35 651 452 ;
C 251 ; WX 600 ; N germandbls ; B 27 -35 558 624 ;
C -1 ; WX 600 ; N Aacute ; B -7 -20 615 789 ;
C -1 ; WX 600 ; N Acircumflex ; B -7 -20 615 774 ;
C -1 ; WX 600 ; N Adieresis ; B -7 -20 615 721 ;
C -1 ; WX 600 ; N Agrave ; B -7 -20 615 789 ;
C -1 ; WX 600 ; N Aring ; B -7 -20 615 795 ;
C -1 ; WX 600 ; N Atilde ; B -7 -20 615 730 ;
C -1 ; WX 600 ; N Ccedilla ; B 91 -186 655 598 ;
C -1 ; WX 600 ; N Eacute ; B 27 -20 634 789 ;
C -1 ; WX 600 ; N Ecircumflex ; B 27 -20 634 774 ;
C -1 ; WX 600 ; N Edieresis ; B 27 -20 634 721 ;
C -1 ; WX 600 ; N Egrave ; B 27 -20 634 789 ;
C -1 ; WX 600 ; N Eth ; B 27 -20 610 583 ;
C -1 ; WX 600 ; N Gcaron ; B 89 -35 655 774 ;
C -1 ; WX 600 ; N IJ ; B -6 -35 725 583 ;
C -1 ; WX 600 ; N Iacute ; B 97 -20 622 789 ;
C -1 ; WX 600 ; N Icircumflex ; B 97 -20 622 774 ;
C -1 ; WX 600 ; N Idieresis ; B 97 -20 622 721 ;
C -1 ; WX 600 ; N Idot ; B 97 -20 622 721 ;
C -1 ; WX 600 ; N Igrave ; B 97 -20 622 789 ;
C -1 ; WX 600 ; N LL ; B -16 -20 652 583 ;
C -1 ; WX 600 ; N Ntilde ; B 27 -20 697 730 ;
C -1 ; WX 600 ; N Oacute ; B 83 -35 636 789 ;
C -1 ; WX 600 ; N Ocircumflex ; B 83 -35 636 774 ;
C -1 ; WX 600 ; N Odieresis ; B 83 -35 636 721 ;
C -1 ; WX 600 ; N Ograve ; B 83 -35 636 789 ;
C -1 ; WX 600 ; N Otilde ; B 83 -35 636 730 ;
C -1 ; WX 600 ; N Scaron ; B 76 -35 622 774 ;
C -1 ; WX 600 ; N Scedilla ; B 76 -186 622 598 ;
C -1 ; WX 600 ; N Thorn ; B 27 -20 603 583 ;
C -1 ; WX 600 ; N Uacute ; B 119 -35 695 789 ;
C -1 ; WX 600 ; N Ucircumflex ; B 119 -35 695 774 ;
C -1 ; WX 600 ; N Udieresis ; B 119 -35 695 721 ;
C -1 ; WX 600 ; N Ugrave ; B 119 -35 695 789 ;
C -1 ; WX 600 ; N Yacute ; B 129 -20 684 789 ;
C -1 ; WX 600 ; N Ydieresis ; B 129 -20 684 721 ;
C -1 ; WX 600 ; N Zcaron ; B 87 -20 621 774 ;
C -1 ; WX 600 ; N aacute ; B 74 -35 565 660 ;
C -1 ; WX 600 ; N acircumflex ; B 74 -35 575 653 ;
C -1 ; WX 600 ; N adieresis ; B 74 -35 565 592 ;
C -1 ; WX 600 ; N agrave ; B 74 -35 565 660 ;
C -1 ; WX 600 ; N aring ; B 74 -35 565 686 ;
C -1 ; WX 600 ; N arrowboth ; B 24 110 704 490 ;
C -1 ; WX 600 ; N arrowdown ; B 146 -20 526 639 ;
C -1 ; WX 600 ; N arrowleft ; B 24 110 704 490 ;
C -1 ; WX 600 ; N arrowright ; B 24 110 704 490 ;
C -1 ; WX 600 ; N arrowup ; B 205 -20 585 639 ;
C -1 ; WX 600 ; N atilde ; B 74 -35 594 618 ;
C -1 ; WX 600 ; N brokenbar ; B 238 -144 464 624 ;
C -1 ; WX 600 ; N ccedilla ; B 104 -186 614 452 ;
C -1 ; WX 600 ; N center ; B 62 -20 662 624 ;
C -1 ; WX 600 ; N copyright ; B 33 -35 683 598 ;
C -1 ; WX 600 ; N dectab ; B -1 -20 609 248 ;
C -1 ; WX 600 ; N degree ; B 231 294 564 624 ;
C -1 ; WX 600 ; N divide ; B 112 51 608 531 ;
C -1 ; WX 600 ; N down ; B 181 -20 473 452 ;
C -1 ; WX 600 ; N eacute ; B 85 -35 590 664 ;
C -1 ; WX 600 ; N ecircumflex ; B 85 -35 590 653 ;
C -1 ; WX 600 ; N edieresis ; B 85 -35 590 592 ;
C -1 ; WX 600 ; N egrave ; B 85 -35 590 664 ;
C -1 ; WX 600 ; N eth ; B 87 -35 637 639 ;
C -1 ; WX 600 ; N format ; B -50 -207 189 624 ;
C -1 ; WX 600 ; N gcaron ; B 85 -207 666 645 ;
C -1 ; WX 600 ; N graybox ; B 35 -40 693 640 ;
C -1 ; WX 600 ; N iacute ; B 76 -20 532 660 ;
C -1 ; WX 600 ; N icircumflex ; B 76 -20 532 634 ;
C -1 ; WX 600 ; N idieresis ; B 76 -20 532 592 ;
C -1 ; WX 600 ; N igrave ; B 76 -20 532 656 ;
C -1 ; WX 600 ; N ij ; B 14 -207 634 665 ;
C -1 ; WX 600 ; N indent ; B 98 60 590 352 ;
C -1 ; WX 600 ; N largebullet ; B 325 266 405 346 ;
C -1 ; WX 600 ; N left ; B 98 60 590 352 ;
C -1 ; WX 600 ; N lira ; B 68 -20 560 598 ;
C -1 ; WX 600 ; N ll ; B 4 -20 624 624 ;
C -1 ; WX 600 ; N logicalnot ; B 127 154 623 394 ;
C -1 ; WX 600 ; N merge ; B 181 -20 511 452 ;
C -1 ; WX 600 ; N minus ; B 112 241 608 321 ;
C -1 ; WX 600 ; N mu ; B 71 -207 582 437 ;
C -1 ; WX 600 ; N multiply ; B 93 12 609 470 ;
C -1 ; WX 600 ; N notegraphic ; B 167 -5 573 639 ;
C -1 ; WX 600 ; N ntilde ; B 37 -20 569 618 ;
C -1 ; WX 600 ; N oacute ; B 91 -35 597 649 ;
C -1 ; WX 600 ; N ocircumflex ; B 91 -35 597 653 ;
C -1 ; WX 600 ; N odieresis ; B 91 -35 597 592 ;
C -1 ; WX 600 ; N ograve ; B 91 -35 597 649 ;
C -1 ; WX 600 ; N onehalf ; B 46 -20 665 624 ;
C -1 ; WX 600 ; N onequarter ; B 46 -20 681 624 ;
C -1 ; WX 600 ; N onesuperior ; B 211 200 491 624 ;
C -1 ; WX 600 ; N otilde ; B 91 -35 597 597 ;
C -1 ; WX 600 ; N overscore ; B 95 559 759 639 ;
C -1 ; WX 600 ; N plusminus ; B 56 -20 617 550 ;
C -1 ; WX 600 ; N prescription ; B 27 -20 613 583 ;
C -1 ; WX 600 ; N registered ; B 33 -35 683 598 ;
C -1 ; WX 600 ; N return ; B 36 -20 745 608 ;
C -1 ; WX 600 ; N scaron ; B 87 -35 593 645 ;
C -1 ; WX 600 ; N scedilla ; B 87 -186 580 452 ;
C -1 ; WX 600 ; N square ; B -20 -20 745 608 ;
C -1 ; WX 600 ; N stop ; B -20 -20 745 608 ;
C -1 ; WX 600 ; N tab ; B -20 -20 684 608 ;
C -1 ; WX 600 ; N thorn ; B -33 -207 612 624 ;
C -1 ; WX 600 ; N threequarters ; B 57 -20 651 639 ;
C -1 ; WX 600 ; N threesuperior ; B 215 191 552 639 ;
C -1 ; WX 600 ; N trademark ; B 78 230 735 583 ;
C -1 ; WX 600 ; N twosuperior ; B 191 200 541 639 ;
C -1 ; WX 600 ; N uacute ; B 107 -35 582 656 ;
C -1 ; WX 600 ; N ucircumflex ; B 107 -35 582 634 ;
C -1 ; WX 600 ; N udieresis ; B 107 -35 582 592 ;
C -1 ; WX 600 ; N ugrave ; B 107 -35 582 656 ;
C -1 ; WX 600 ; N up ; B 219 -20 511 452 ;
C -1 ; WX 600 ; N yacute ; B -4 -207 653 656 ;
C -1 ; WX 600 ; N ydieresis ; B -4 -207 653 571 ;
C -1 ; WX 600 ; N zcaron ; B 99 -20 593 645 ;
EndCharMetrics
StartComposites 58
CC Zcaron 2 ; PCC Z 0 0 ; PCC caron 0 146 ;
CC zcaron 2 ; PCC z 0 0 ; PCC caron 0 0 ;
CC Scaron 2 ; PCC S 0 0 ; PCC caron 0 146 ;
CC scaron 2 ; PCC s 0 0 ; PCC caron 0 0 ;
CC Ccedilla 2 ; PCC C 0 0 ; PCC cedilla 0 0 ;
CC ccedilla 2 ; PCC c 0 0 ; PCC cedilla 0 0 ;
CC Yacute 2 ; PCC Y 0 0 ; PCC acute 0 146 ;
CC yacute 2 ; PCC y 0 0 ; PCC acute 0 0 ;
CC Ydieresis 2 ; PCC Y 0 0 ; PCC dieresis 0 146 ;
CC ydieresis 2 ; PCC y 0 0 ; PCC dieresis 0 0 ;
CC Uacute 2 ; PCC U 0 0 ; PCC acute 0 146 ;
CC Ucircumflex 2 ; PCC U 0 0 ; PCC circumflex 0 146 ;
CC Udieresis 2 ; PCC U 0 0 ; PCC dieresis 0 146 ;
CC Ugrave 2 ; PCC U 0 0 ; PCC grave 0 146 ;
CC uacute 2 ; PCC u 0 0 ; PCC acute 0 0 ;
CC ucircumflex 2 ; PCC u 0 0 ; PCC circumflex 0 0 ;
CC udieresis 2 ; PCC u 0 0 ; PCC dieresis 0 0 ;
CC ugrave 2 ; PCC u 0 0 ; PCC grave 0 0 ;
CC Iacute 2 ; PCC I 0 0 ; PCC acute 0 146 ;
CC Icircumflex 2 ; PCC I 0 0 ; PCC circumflex 0 146 ;
CC Idieresis 2 ; PCC I 0 0 ; PCC dieresis 0 146 ;
CC Igrave 2 ; PCC I 0 0 ; PCC grave 0 146 ;
CC iacute 2 ; PCC dotlessi 0 0 ; PCC acute 0 0 ;
CC icircumflex 2 ; PCC dotlessi 0 0 ; PCC circumflex 0 0 ;
CC idieresis 2 ; PCC dotlessi 0 0 ; PCC dieresis 0 0 ;
CC igrave 2 ; PCC dotlessi 0 0 ; PCC grave 0 0 ;
CC Eacute 2 ; PCC E 0 0 ; PCC acute 0 146 ;
CC Ecircumflex 2 ; PCC E 0 0 ; PCC circumflex 0 146 ;
CC Edieresis 2 ; PCC E 0 0 ; PCC dieresis 0 146 ;
CC Egrave 2 ; PCC E 0 0 ; PCC grave 0 146 ;
CC eacute 2 ; PCC e 0 0 ; PCC acute 0 0 ;
CC ecircumflex 2 ; PCC e 0 0 ; PCC circumflex 0 0 ;
CC edieresis 2 ; PCC e 0 0 ; PCC dieresis 0 0 ;
CC egrave 2 ; PCC e 0 0 ; PCC grave 0 0 ;
CC Aacute 2 ; PCC A 0 0 ; PCC acute 0 146 ;
CC Acircumflex 2 ; PCC A 0 0 ; PCC circumflex 0 146 ;
CC Adieresis 2 ; PCC A 0 0 ; PCC dieresis 0 146 ;
CC Agrave 2 ; PCC A 0 0 ; PCC grave 0 146 ;
CC aacute 2 ; PCC a 0 0 ; PCC acute 0 0 ;
CC acircumflex 2 ; PCC a 0 0 ; PCC circumflex 0 0 ;
CC adieresis 2 ; PCC a 0 0 ; PCC dieresis 0 0 ;
CC agrave 2 ; PCC a 0 0 ; PCC grave 0 0 ;
CC Oacute 2 ; PCC O 0 0 ; PCC acute 0 146 ;
CC Ocircumflex 2 ; PCC O 0 0 ; PCC circumflex 0 146 ;
CC Odieresis 2 ; PCC O 0 0 ; PCC dieresis 0 146 ;
CC Ograve 2 ; PCC O 0 0 ; PCC grave 0 146 ;
CC oacute 2 ; PCC o 0 0 ; PCC acute 0 0 ;
CC ocircumflex 2 ; PCC o 0 0 ; PCC circumflex 0 0 ;
CC odieresis 2 ; PCC o 0 0 ; PCC dieresis 0 0 ;
CC ograve 2 ; PCC o 0 0 ; PCC grave 0 0 ;
CC Atilde 2 ; PCC A 0 0 ; PCC tilde 0 146 ;
CC atilde 2 ; PCC a 0 0 ; PCC tilde 0 0 ;
CC Ntilde 2 ; PCC N 0 0 ; PCC tilde 0 146 ;
CC ntilde 2 ; PCC n 0 0 ; PCC tilde 0 0 ;
CC Otilde 2 ; PCC O 0 0 ; PCC tilde 0 146 ;
CC otilde 2 ; PCC o 0 0 ; PCC tilde 0 0 ;
CC Aring 2 ; PCC A 0 0 ; PCC ring 0 146 ;
CC aring 2 ; PCC a 0 0 ; PCC ring 0 0 ;
EndComposites
EndFontMetrics

341
collects/afm/Courier.afm Normal file
View File

@ -0,0 +1,341 @@
StartFontMetrics 2.0
Comment Copyright (c) 1984 Adobe Systems Incorporated. All Rights Reserved.
Comment Creation Date:Fri Apr 3 12:03:11 PST 1987
FontName Courier
EncodingScheme AdobeStandardEncoding
FullName Courier
FamilyName Courier
Weight Medium
ItalicAngle 0.0
IsFixedPitch true
UnderlinePosition -82
UnderlineThickness 40
Version 001.004
FontBBox -40 -290 640 795
CapHeight 583
XHeight 437
Descender -207
Ascender 624
StartCharMetrics 260
C 32 ; WX 600 ; N space ; B 560 -40 640 40 ;
C 33 ; WX 600 ; N exclam ; B 240 -5 360 639 ;
C 34 ; WX 600 ; N quotedbl ; B 126 314 474 603 ;
C 35 ; WX 600 ; N numbersign ; B 72 -82 528 665 ;
C 36 ; WX 600 ; N dollar ; B 93 -113 507 675 ;
C 37 ; WX 600 ; N percent ; B 67 -35 533 639 ;
C 38 ; WX 600 ; N ampersand ; B 85 -35 498 540 ;
C 39 ; WX 600 ; N quoteright ; B 135 304 340 613 ;
C 40 ; WX 600 ; N parenleft ; B 274 -144 478 623 ;
C 41 ; WX 600 ; N parenright ; B 127 -144 331 623 ;
C 42 ; WX 600 ; N asterisk ; B 93 210 507 624 ;
C 43 ; WX 600 ; N plus ; B 52 12 548 550 ;
C 44 ; WX 600 ; N comma ; B 135 -155 340 155 ;
C 45 ; WX 600 ; N hyphen ; B 52 241 548 321 ;
C 46 ; WX 600 ; N period ; B 250 10 350 90 ;
C 47 ; WX 600 ; N slash ; B 93 -103 507 686 ;
C 48 ; WX 600 ; N zero ; B 93 -35 507 639 ;
C 49 ; WX 600 ; N one ; B 93 -20 507 624 ;
C 50 ; WX 600 ; N two ; B 64 -20 498 639 ;
C 51 ; WX 600 ; N three ; B 76 -35 519 639 ;
C 52 ; WX 600 ; N four ; B 85 -20 498 624 ;
C 53 ; WX 600 ; N five ; B 76 -35 519 624 ;
C 54 ; WX 600 ; N six ; B 116 -35 530 639 ;
C 55 ; WX 600 ; N seven ; B 85 -20 498 624 ;
C 56 ; WX 600 ; N eight ; B 93 -35 507 639 ;
C 57 ; WX 600 ; N nine ; B 116 -35 530 639 ;
C 58 ; WX 600 ; N colon ; B 250 10 350 392 ;
C 59 ; WX 600 ; N semicolon ; B 139 -116 350 392 ;
C 60 ; WX 600 ; N less ; B 52 12 548 550 ;
C 61 ; WX 600 ; N equal ; B 31 168 569 394 ;
C 62 ; WX 600 ; N greater ; B 52 12 548 550 ;
C 63 ; WX 600 ; N question ; B 114 -5 507 598 ;
C 64 ; WX 600 ; N at ; B 85 -82 498 644 ;
C 65 ; WX 600 ; N A ; B -11 -20 611 583 ;
C 66 ; WX 600 ; N B ; B 23 -20 561 583 ;
C 67 ; WX 600 ; N C ; B 43 -35 554 598 ;
C 68 ; WX 600 ; N D ; B 23 -20 540 583 ;
C 69 ; WX 600 ; N E ; B 23 -20 540 583 ;
C 70 ; WX 600 ; N F ; B 23 -20 540 583 ;
C 71 ; WX 600 ; N G ; B 43 -35 582 598 ;
C 72 ; WX 600 ; N H ; B 33 -20 571 583 ;
C 73 ; WX 600 ; N I ; B 93 -20 507 583 ;
C 74 ; WX 600 ; N J ; B 64 -35 603 583 ;
C 75 ; WX 600 ; N K ; B 23 -20 592 583 ;
C 76 ; WX 600 ; N L ; B 43 -20 561 583 ;
C 77 ; WX 600 ; N M ; B -9 -20 613 583 ;
C 78 ; WX 600 ; N N ; B 2 -20 582 583 ;
C 79 ; WX 600 ; N O ; B 31 -35 569 598 ;
C 80 ; WX 600 ; N P ; B 23 -20 519 583 ;
C 81 ; WX 600 ; N Q ; B 31 -136 569 598 ;
C 82 ; WX 600 ; N R ; B 23 -20 609 583 ;
C 83 ; WX 600 ; N S ; B 72 -35 528 598 ;
C 84 ; WX 600 ; N T ; B 52 -20 548 583 ;
C 85 ; WX 600 ; N U ; B 20 -35 580 583 ;
C 86 ; WX 600 ; N V ; B -11 -20 611 583 ;
C 87 ; WX 600 ; N W ; B 0 -20 600 583 ;
C 88 ; WX 600 ; N X ; B 20 -20 580 583 ;
C 89 ; WX 600 ; N Y ; B 31 -20 569 583 ;
C 90 ; WX 600 ; N Z ; B 83 -20 517 583 ;
C 91 ; WX 600 ; N bracketleft ; B 260 -144 465 624 ;
C 92 ; WX 600 ; N backslash ; B 93 -103 507 686 ;
C 93 ; WX 600 ; N bracketright ; B 135 -144 340 624 ;
C 94 ; WX 600 ; N asciicircum ; B 93 335 507 624 ;
C 95 ; WX 600 ; N underscore ; B -32 -290 632 -210 ;
C 96 ; WX 600 ; N quoteleft ; B 260 304 465 613 ;
C 97 ; WX 600 ; N a ; B 52 -35 561 452 ;
C 98 ; WX 600 ; N b ; B 2 -35 561 624 ;
C 99 ; WX 600 ; N c ; B 64 -35 555 452 ;
C 100 ; WX 600 ; N d ; B 43 -35 603 624 ;
C 101 ; WX 600 ; N e ; B 43 -35 540 452 ;
C 102 ; WX 600 ; N f ; B 85 -20 561 624 ; L i fi ; L l fl ;
C 103 ; WX 600 ; N g ; B 43 -207 582 452 ;
C 104 ; WX 600 ; N h ; B 23 -20 571 624 ;
C 105 ; WX 600 ; N i ; B 72 -20 528 665 ;
C 106 ; WX 600 ; N j ; B 127 -207 478 665 ;
C 107 ; WX 600 ; N k ; B 43 -20 561 624 ;
C 108 ; WX 600 ; N l ; B 72 -20 528 624 ;
C 109 ; WX 600 ; N m ; B -9 -20 613 452 ;
C 110 ; WX 600 ; N n ; B 33 -20 561 452 ;
C 111 ; WX 600 ; N o ; B 52 -35 548 452 ;
C 112 ; WX 600 ; N p ; B 2 -207 561 452 ;
C 113 ; WX 600 ; N q ; B 43 -207 603 452 ;
C 114 ; WX 600 ; N r ; B 64 -20 561 448 ;
C 115 ; WX 600 ; N s ; B 83 -35 517 452 ;
C 116 ; WX 600 ; N t ; B 23 -35 519 582 ;
C 117 ; WX 600 ; N u ; B 23 -35 561 437 ;
C 118 ; WX 600 ; N v ; B 10 -20 590 437 ;
C 119 ; WX 600 ; N w ; B 10 -20 590 437 ;
C 120 ; WX 600 ; N x ; B 31 -20 569 437 ;
C 121 ; WX 600 ; N y ; B 31 -207 569 437 ;
C 122 ; WX 600 ; N z ; B 95 -20 509 437 ;
C 123 ; WX 600 ; N braceleft ; B 177 -144 423 624 ;
C 124 ; WX 600 ; N bar ; B 260 -144 340 624 ;
C 125 ; WX 600 ; N braceright ; B 177 -144 423 624 ;
C 126 ; WX 600 ; N asciitilde ; B 72 189 528 373 ;
C 161 ; WX 600 ; N exclamdown ; B 240 -207 360 415 ;
C 162 ; WX 600 ; N cent ; B 93 -19 489 665 ;
C 163 ; WX 600 ; N sterling ; B 43 -20 540 598 ;
C 164 ; WX 600 ; N fraction ; B 31 120 569 492 ;
C 165 ; WX 600 ; N yen ; B 31 -20 569 583 ;
C 166 ; WX 600 ; N florin ; B 67 -113 538 639 ;
C 167 ; WX 600 ; N section ; B 46 -87 554 629 ;
C 168 ; WX 600 ; N currency ; B 83 75 517 509 ;
C 169 ; WX 600 ; N quotesingle ; B 230 304 370 613 ;
C 170 ; WX 600 ; N quotedblleft ; B 93 340 507 619 ;
C 171 ; WX 600 ; N guillemotleft ; B 43 -20 561 437 ;
C 172 ; WX 600 ; N guilsinglleft ; B 43 -20 332 437 ;
C 173 ; WX 600 ; N guilsinglright ; B 273 -20 561 437 ;
C 174 ; WX 600 ; N fi ; B -10 -20 610 665 ;
C 175 ; WX 600 ; N fl ; B -10 -20 610 624 ;
C 177 ; WX 600 ; N endash ; B 52 241 548 321 ;
C 178 ; WX 600 ; N dagger ; B 104 -82 496 624 ;
C 179 ; WX 600 ; N daggerdbl ; B 104 -82 496 624 ;
C 180 ; WX 600 ; N periodcentered ; B 250 266 350 346 ;
C 182 ; WX 600 ; N paragraph ; B 59 -87 545 629 ;
C 183 ; WX 600 ; N bullet ; B 260 266 340 346 ;
C 184 ; WX 600 ; N quotesinglbase ; B 135 -165 340 144 ;
C 185 ; WX 600 ; N quotedblbase ; B 93 -139 507 139 ;
C 186 ; WX 600 ; N quotedblright ; B 93 340 507 619 ;
C 187 ; WX 600 ; N guillemotright ; B 43 -20 561 437 ;
C 188 ; WX 600 ; N ellipsis ; B 60 -5 540 75 ;
C 189 ; WX 600 ; N perthousand ; B 10 -35 590 639 ;
C 191 ; WX 600 ; N questiondown ; B 93 -207 486 415 ;
C 193 ; WX 600 ; N grave ; B 135 450 340 639 ;
C 194 ; WX 600 ; N acute ; B 260 450 465 639 ;
C 195 ; WX 600 ; N circumflex ; B 135 450 465 624 ;
C 196 ; WX 600 ; N tilde ; B 125 441 475 580 ;
C 197 ; WX 600 ; N macron ; B 135 476 465 556 ;
C 198 ; WX 600 ; N breve ; B 135 450 465 624 ;
C 199 ; WX 600 ; N dotaccent ; B 260 491 340 571 ;
C 200 ; WX 600 ; N dieresis ; B 156 491 444 571 ;
C 202 ; WX 600 ; N ring ; B 187 413 413 634 ;
C 203 ; WX 600 ; N cedilla ; B 190 -186 397 40 ;
C 205 ; WX 600 ; N hungarumlaut ; B 135 450 465 639 ;
C 206 ; WX 600 ; N ogonek ; B 260 -165 453 40 ;
C 207 ; WX 600 ; N caron ; B 135 450 465 624 ;
C 208 ; WX 600 ; N emdash ; B -19 241 619 321 ;
C 225 ; WX 600 ; N AE ; B -10 -20 610 583 ;
C 227 ; WX 600 ; N ordfeminine ; B 127 179 478 598 ;
C 232 ; WX 600 ; N Lslash ; B 23 -20 561 583 ;
C 233 ; WX 600 ; N Oslash ; B 20 -61 580 623 ;
C 234 ; WX 600 ; N OE ; B -10 -20 610 583 ;
C 235 ; WX 600 ; N ordmasculine ; B 131 179 469 598 ;
C 241 ; WX 600 ; N ae ; B -10 -35 600 452 ;
C 245 ; WX 600 ; N dotlessi ; B 72 -20 528 437 ;
C 248 ; WX 600 ; N lslash ; B 72 -20 528 624 ;
C 249 ; WX 600 ; N oslash ; B 33 -61 563 478 ;
C 250 ; WX 600 ; N oe ; B -10 -35 600 452 ;
C 251 ; WX 600 ; N germandbls ; B 23 -35 519 624 ;
C -1 ; WX 600 ; N Aacute ; B -11 -20 611 789 ;
C -1 ; WX 600 ; N Acircumflex ; B -11 -20 611 774 ;
C -1 ; WX 600 ; N Adieresis ; B -11 -20 611 721 ;
C -1 ; WX 600 ; N Agrave ; B -11 -20 611 789 ;
C -1 ; WX 600 ; N Aring ; B -11 -20 611 795 ;
C -1 ; WX 600 ; N Atilde ; B -11 -20 611 730 ;
C -1 ; WX 600 ; N Ccedilla ; B 43 -186 554 598 ;
C -1 ; WX 600 ; N Eacute ; B 23 -20 540 789 ;
C -1 ; WX 600 ; N Ecircumflex ; B 23 -20 540 774 ;
C -1 ; WX 600 ; N Edieresis ; B 23 -20 540 721 ;
C -1 ; WX 600 ; N Egrave ; B 23 -20 540 789 ;
C -1 ; WX 600 ; N Eth ; B 23 -20 540 583 ;
C -1 ; WX 600 ; N Gcaron ; B 43 -35 582 774 ;
C -1 ; WX 600 ; N IJ ; B -10 -35 610 583 ;
C -1 ; WX 600 ; N Iacute ; B 93 -20 507 789 ;
C -1 ; WX 600 ; N Icircumflex ; B 93 -20 507 774 ;
C -1 ; WX 600 ; N Idieresis ; B 93 -20 507 721 ;
C -1 ; WX 600 ; N Idot ; B 93 -20 507 721 ;
C -1 ; WX 600 ; N Igrave ; B 93 -20 507 789 ;
C -1 ; WX 600 ; N LL ; B -20 -20 620 583 ;
C -1 ; WX 600 ; N Ntilde ; B 2 -20 582 730 ;
C -1 ; WX 600 ; N Oacute ; B 31 -35 569 789 ;
C -1 ; WX 600 ; N Ocircumflex ; B 31 -35 569 774 ;
C -1 ; WX 600 ; N Odieresis ; B 31 -35 569 721 ;
C -1 ; WX 600 ; N Ograve ; B 31 -35 569 789 ;
C -1 ; WX 600 ; N Otilde ; B 31 -35 569 730 ;
C -1 ; WX 600 ; N Scaron ; B 72 -35 528 774 ;
C -1 ; WX 600 ; N Scedilla ; B 72 -186 528 598 ;
C -1 ; WX 600 ; N Thorn ; B 23 -20 539 583 ;
C -1 ; WX 600 ; N Uacute ; B 20 -35 580 789 ;
C -1 ; WX 600 ; N Ucircumflex ; B 20 -35 580 774 ;
C -1 ; WX 600 ; N Udieresis ; B 20 -35 580 721 ;
C -1 ; WX 600 ; N Ugrave ; B 20 -35 580 789 ;
C -1 ; WX 600 ; N Yacute ; B 31 -20 569 789 ;
C -1 ; WX 600 ; N Ydieresis ; B 31 -20 569 721 ;
C -1 ; WX 600 ; N Zcaron ; B 83 -20 517 774 ;
C -1 ; WX 600 ; N aacute ; B 52 -35 561 660 ;
C -1 ; WX 600 ; N acircumflex ; B 52 -35 561 653 ;
C -1 ; WX 600 ; N adieresis ; B 52 -35 561 592 ;
C -1 ; WX 600 ; N agrave ; B 52 -35 561 660 ;
C -1 ; WX 600 ; N aring ; B 52 -35 561 686 ;
C -1 ; WX 600 ; N arrowboth ; B -40 110 640 490 ;
C -1 ; WX 600 ; N arrowdown ; B 110 -20 490 639 ;
C -1 ; WX 600 ; N arrowleft ; B -40 110 640 490 ;
C -1 ; WX 600 ; N arrowright ; B -40 110 640 490 ;
C -1 ; WX 600 ; N arrowup ; B 110 -20 490 639 ;
C -1 ; WX 600 ; N atilde ; B 52 -35 561 618 ;
C -1 ; WX 600 ; N brokenbar ; B 260 -144 340 624 ;
C -1 ; WX 600 ; N ccedilla ; B 64 -186 555 452 ;
C -1 ; WX 600 ; N center ; B 0 -20 600 624 ;
C -1 ; WX 600 ; N copyright ; B -20 -35 620 598 ;
C -1 ; WX 600 ; N dectab ; B -5 -20 605 248 ;
C -1 ; WX 600 ; N degree ; B 135 294 465 624 ;
C -1 ; WX 600 ; N divide ; B 52 51 548 531 ;
C -1 ; WX 600 ; N down ; B 154 -20 446 452 ;
C -1 ; WX 600 ; N eacute ; B 43 -35 540 664 ;
C -1 ; WX 600 ; N ecircumflex ; B 43 -35 540 653 ;
C -1 ; WX 600 ; N edieresis ; B 43 -35 540 592 ;
C -1 ; WX 600 ; N egrave ; B 43 -35 540 664 ;
C -1 ; WX 600 ; N eth ; B 52 -35 548 639 ;
C -1 ; WX 600 ; N format ; B -15 -207 65 624 ;
C -1 ; WX 600 ; N gcaron ; B 43 -207 582 645 ;
C -1 ; WX 600 ; N graybox ; B 35 -40 565 640 ;
C -1 ; WX 600 ; N iacute ; B 72 -20 528 660 ;
C -1 ; WX 600 ; N icircumflex ; B 72 -20 528 634 ;
C -1 ; WX 600 ; N idieresis ; B 72 -20 528 592 ;
C -1 ; WX 600 ; N igrave ; B 72 -20 528 656 ;
C -1 ; WX 600 ; N ij ; B 10 -207 550 665 ;
C -1 ; WX 600 ; N indent ; B 54 60 546 352 ;
C -1 ; WX 600 ; N largebullet ; B 260 266 340 346 ;
C -1 ; WX 600 ; N left ; B 54 60 546 352 ;
C -1 ; WX 600 ; N lira ; B 43 -20 540 598 ;
C -1 ; WX 600 ; N ll ; B 0 -20 600 624 ;
C -1 ; WX 600 ; N logicalnot ; B 52 154 548 394 ;
C -1 ; WX 600 ; N merge ; B 154 -20 446 452 ;
C -1 ; WX 600 ; N minus ; B 52 241 548 321 ;
C -1 ; WX 600 ; N mu ; B 23 -207 561 437 ;
C -1 ; WX 600 ; N multiply ; B 82 12 518 470 ;
C -1 ; WX 600 ; N notegraphic ; B 150 -5 450 639 ;
C -1 ; WX 600 ; N ntilde ; B 33 -20 561 618 ;
C -1 ; WX 600 ; N oacute ; B 52 -35 548 649 ;
C -1 ; WX 600 ; N ocircumflex ; B 52 -35 548 653 ;
C -1 ; WX 600 ; N odieresis ; B 52 -35 548 592 ;
C -1 ; WX 600 ; N ograve ; B 52 -35 548 649 ;
C -1 ; WX 600 ; N onehalf ; B -10 -20 610 624 ;
C -1 ; WX 600 ; N onequarter ; B -10 -20 610 624 ;
C -1 ; WX 600 ; N onesuperior ; B 160 200 440 624 ;
C -1 ; WX 600 ; N otilde ; B 52 -35 548 597 ;
C -1 ; WX 600 ; N overscore ; B -32 559 632 639 ;
C -1 ; WX 600 ; N plusminus ; B 52 -20 548 550 ;
C -1 ; WX 600 ; N prescription ; B 23 -20 609 583 ;
C -1 ; WX 600 ; N registered ; B -20 -35 620 598 ;
C -1 ; WX 600 ; N return ; B -24 -20 624 608 ;
C -1 ; WX 600 ; N scaron ; B 83 -35 517 645 ;
C -1 ; WX 600 ; N scedilla ; B 83 -186 517 452 ;
C -1 ; WX 600 ; N square ; B -24 -20 624 608 ;
C -1 ; WX 600 ; N stop ; B -24 -20 624 608 ;
C -1 ; WX 600 ; N tab ; B -24 -20 624 608 ;
C -1 ; WX 600 ; N thorn ; B 2 -207 561 624 ;
C -1 ; WX 600 ; N threequarters ; B -10 -20 610 639 ;
C -1 ; WX 600 ; N threesuperior ; B 155 191 452 639 ;
C -1 ; WX 600 ; N trademark ; B -20 230 620 583 ;
C -1 ; WX 600 ; N twosuperior ; B 140 200 431 639 ;
C -1 ; WX 600 ; N uacute ; B 23 -35 561 656 ;
C -1 ; WX 600 ; N ucircumflex ; B 23 -35 561 634 ;
C -1 ; WX 600 ; N udieresis ; B 23 -35 561 592 ;
C -1 ; WX 600 ; N ugrave ; B 23 -35 561 656 ;
C -1 ; WX 600 ; N up ; B 154 -20 446 452 ;
C -1 ; WX 600 ; N yacute ; B 31 -207 569 656 ;
C -1 ; WX 600 ; N ydieresis ; B 31 -207 569 571 ;
C -1 ; WX 600 ; N zcaron ; B 95 -20 509 645 ;
EndCharMetrics
StartComposites 58
CC Zcaron 2 ; PCC Z 0 0 ; PCC caron 0 146 ;
CC zcaron 2 ; PCC z 0 0 ; PCC caron 0 0 ;
CC Scaron 2 ; PCC S 0 0 ; PCC caron 0 146 ;
CC scaron 2 ; PCC s 0 0 ; PCC caron 0 0 ;
CC Ccedilla 2 ; PCC C 0 0 ; PCC cedilla 0 0 ;
CC ccedilla 2 ; PCC c 0 0 ; PCC cedilla 0 0 ;
CC Yacute 2 ; PCC Y 0 0 ; PCC acute 0 146 ;
CC yacute 2 ; PCC y 0 0 ; PCC acute 0 0 ;
CC Ydieresis 2 ; PCC Y 0 0 ; PCC dieresis 0 146 ;
CC ydieresis 2 ; PCC y 0 0 ; PCC dieresis 0 0 ;
CC Uacute 2 ; PCC U 0 0 ; PCC acute 0 146 ;
CC Ucircumflex 2 ; PCC U 0 0 ; PCC circumflex 0 146 ;
CC Udieresis 2 ; PCC U 0 0 ; PCC dieresis 0 146 ;
CC Ugrave 2 ; PCC U 0 0 ; PCC grave 0 146 ;
CC uacute 2 ; PCC u 0 0 ; PCC acute 0 0 ;
CC ucircumflex 2 ; PCC u 0 0 ; PCC circumflex 0 0 ;
CC udieresis 2 ; PCC u 0 0 ; PCC dieresis 0 0 ;
CC ugrave 2 ; PCC u 0 0 ; PCC grave 0 0 ;
CC Iacute 2 ; PCC I 0 0 ; PCC acute 0 146 ;
CC Icircumflex 2 ; PCC I 0 0 ; PCC circumflex 0 146 ;
CC Idieresis 2 ; PCC I 0 0 ; PCC dieresis 0 146 ;
CC Igrave 2 ; PCC I 0 0 ; PCC grave 0 146 ;
CC iacute 2 ; PCC dotlessi 0 0 ; PCC acute 0 0 ;
CC icircumflex 2 ; PCC dotlessi 0 0 ; PCC circumflex 0 0 ;
CC idieresis 2 ; PCC dotlessi 0 0 ; PCC dieresis 0 0 ;
CC igrave 2 ; PCC dotlessi 0 0 ; PCC grave 0 0 ;
CC Eacute 2 ; PCC E 0 0 ; PCC acute 0 146 ;
CC Ecircumflex 2 ; PCC E 0 0 ; PCC circumflex 0 146 ;
CC Edieresis 2 ; PCC E 0 0 ; PCC dieresis 0 146 ;
CC Egrave 2 ; PCC E 0 0 ; PCC grave 0 146 ;
CC eacute 2 ; PCC e 0 0 ; PCC acute 0 0 ;
CC ecircumflex 2 ; PCC e 0 0 ; PCC circumflex 0 0 ;
CC edieresis 2 ; PCC e 0 0 ; PCC dieresis 0 0 ;
CC egrave 2 ; PCC e 0 0 ; PCC grave 0 0 ;
CC Aacute 2 ; PCC A 0 0 ; PCC acute 0 146 ;
CC Acircumflex 2 ; PCC A 0 0 ; PCC circumflex 0 146 ;
CC Adieresis 2 ; PCC A 0 0 ; PCC dieresis 0 146 ;
CC Agrave 2 ; PCC A 0 0 ; PCC grave 0 146 ;
CC aacute 2 ; PCC a 0 0 ; PCC acute 0 0 ;
CC acircumflex 2 ; PCC a 0 0 ; PCC circumflex 0 0 ;
CC adieresis 2 ; PCC a 0 0 ; PCC dieresis 0 0 ;
CC agrave 2 ; PCC a 0 0 ; PCC grave 0 0 ;
CC Oacute 2 ; PCC O 0 0 ; PCC acute 0 146 ;
CC Ocircumflex 2 ; PCC O 0 0 ; PCC circumflex 0 146 ;
CC Odieresis 2 ; PCC O 0 0 ; PCC dieresis 0 146 ;
CC Ograve 2 ; PCC O 0 0 ; PCC grave 0 146 ;
CC oacute 2 ; PCC o 0 0 ; PCC acute 0 0 ;
CC ocircumflex 2 ; PCC o 0 0 ; PCC circumflex 0 0 ;
CC odieresis 2 ; PCC o 0 0 ; PCC dieresis 0 0 ;
CC ograve 2 ; PCC o 0 0 ; PCC grave 0 0 ;
CC Atilde 2 ; PCC A 0 0 ; PCC tilde 0 146 ;
CC atilde 2 ; PCC a 0 0 ; PCC tilde 0 0 ;
CC Ntilde 2 ; PCC N 0 0 ; PCC tilde 0 146 ;
CC ntilde 2 ; PCC n 0 0 ; PCC tilde 0 0 ;
CC Otilde 2 ; PCC O 0 0 ; PCC tilde 0 146 ;
CC otilde 2 ; PCC o 0 0 ; PCC tilde 0 0 ;
CC Aring 2 ; PCC A 0 0 ; PCC ring 0 146 ;
CC aring 2 ; PCC a 0 0 ; PCC ring 0 0 ;
EndComposites
EndFontMetrics

433
collects/afm/Helvetica-Bold.afm Normal file
View File

@ -0,0 +1,433 @@
StartFontMetrics 2.0
Comment Copyright (c) 1984 Adobe Systems Incorporated. All Rights Reserved.
Comment Creation Date:Sun Feb 8 19:34:17 PST 1987
FontName Helvetica-Bold
EncodingScheme AdobeStandardEncoding
FullName Helvetica Bold
FamilyName Helvetica
Weight Bold
ItalicAngle 0.0
IsFixedPitch false
UnderlinePosition -106
UnderlineThickness 73
Version 001.002
Notice Helvetica is a registered trademark of Allied Corporation.
FontBBox -173 -221 1003 936
CapHeight 729
XHeight 542
Descender -219
Ascender 729
StartCharMetrics 228
C 32 ; WX 278 ; N space ; B 0 0 0 0 ;
C 33 ; WX 333 ; N exclam ; B 112 0 262 729 ;
C 34 ; WX 474 ; N quotedbl ; B 50 470 424 729 ;
C 35 ; WX 556 ; N numbersign ; B 3 -30 553 696 ;
C 36 ; WX 556 ; N dollar ; B 22 -125 526 765 ;
C 37 ; WX 889 ; N percent ; B 22 -18 863 708 ;
C 38 ; WX 722 ; N ampersand ; B 55 -20 694 729 ;
C 39 ; WX 278 ; N quoteright ; B 66 469 201 729 ;
C 40 ; WX 333 ; N parenleft ; B 40 -202 303 729 ;
C 41 ; WX 333 ; N parenright ; B 22 -202 285 729 ;
C 42 ; WX 389 ; N asterisk ; B 23 385 356 730 ;
C 43 ; WX 584 ; N plus ; B 50 -10 534 474 ;
C 44 ; WX 278 ; N comma ; B 64 -174 214 146 ;
C 45 ; WX 333 ; N hyphen ; B 26 208 298 344 ;
C 46 ; WX 278 ; N period ; B 64 0 214 146 ;
C 47 ; WX 278 ; N slash ; B 2 -14 275 715 ;
C 48 ; WX 556 ; N zero ; B 29 -23 517 725 ;
C 49 ; WX 556 ; N one ; B 68 0 378 709 ;
C 50 ; WX 556 ; N two ; B 30 0 515 726 ;
C 51 ; WX 556 ; N three ; B 29 -23 516 726 ;
C 52 ; WX 556 ; N four ; B 24 0 522 709 ;
C 53 ; WX 556 ; N five ; B 27 -24 517 709 ;
C 54 ; WX 556 ; N six ; B 32 -23 519 727 ;
C 55 ; WX 556 ; N seven ; B 29 0 528 709 ;
C 56 ; WX 556 ; N eight ; B 22 -23 525 726 ;
C 57 ; WX 556 ; N nine ; B 28 -23 516 728 ;
C 58 ; WX 333 ; N colon ; B 113 0 263 521 ;
C 59 ; WX 333 ; N semicolon ; B 113 -174 263 521 ;
C 60 ; WX 584 ; N less ; B 40 -10 529 474 ;
C 61 ; WX 584 ; N equal ; B 50 52 534 412 ;
C 62 ; WX 584 ; N greater ; B 40 -10 529 474 ;
C 63 ; WX 611 ; N question ; B 64 0 556 744 ;
C 64 ; WX 975 ; N at ; B 27 -136 947 746 ;
C 65 ; WX 722 ; N A ; B 26 0 703 729 ;
C 66 ; WX 722 ; N B ; B 82 0 666 729 ;
C 67 ; WX 722 ; N C ; B 44 -23 685 741 ;
C 68 ; WX 722 ; N D ; B 77 0 681 729 ;
C 69 ; WX 667 ; N E ; B 79 0 624 729 ;
C 70 ; WX 611 ; N F ; B 74 0 586 729 ;
C 71 ; WX 778 ; N G ; B 42 -24 711 741 ;
C 72 ; WX 722 ; N H ; B 68 0 657 729 ;
C 73 ; WX 278 ; N I ; B 63 0 213 729 ;
C 74 ; WX 556 ; N J ; B 24 -23 486 729 ;
C 75 ; WX 722 ; N K ; B 74 0 717 729 ;
C 76 ; WX 611 ; N L ; B 80 0 579 729 ;
C 77 ; WX 833 ; N M ; B 66 0 776 729 ;
C 78 ; WX 722 ; N N ; B 68 0 661 729 ;
C 79 ; WX 778 ; N O ; B 40 -23 742 741 ;
C 80 ; WX 667 ; N P ; B 76 0 633 729 ;
C 81 ; WX 778 ; N Q ; B 43 -54 745 741 ;
C 82 ; WX 722 ; N R ; B 80 0 677 729 ;
C 83 ; WX 667 ; N S ; B 32 -23 633 741 ;
C 84 ; WX 611 ; N T ; B 14 0 598 729 ;
C 85 ; WX 722 ; N U ; B 76 -23 654 729 ;
C 86 ; WX 667 ; N V ; B 24 0 647 729 ;
C 87 ; WX 944 ; N W ; B 13 0 932 729 ;
C 88 ; WX 667 ; N X ; B 22 0 653 729 ;
C 89 ; WX 667 ; N Y ; B 27 0 650 729 ;
C 90 ; WX 611 ; N Z ; B 30 0 578 729 ;
C 91 ; WX 333 ; N bracketleft ; B 66 -202 308 729 ;
C 92 ; WX 278 ; N backslash ; B -12 -21 289 708 ;
C 93 ; WX 333 ; N bracketright ; B 18 -202 260 729 ;
C 94 ; WX 584 ; N asciicircum ; B 61 271 522 696 ;
C 95 ; WX 556 ; N underscore ; B -22 -200 578 -130 ;
C 96 ; WX 278 ; N quoteleft ; B 67 469 202 729 ;
C 97 ; WX 556 ; N a ; B 27 -24 524 551 ;
C 98 ; WX 611 ; N b ; B 59 -23 575 729 ;
C 99 ; WX 556 ; N c ; B 34 -23 522 551 ;
C 100 ; WX 611 ; N d ; B 29 -23 545 729 ;
C 101 ; WX 556 ; N e ; B 22 -23 525 551 ;
C 102 ; WX 333 ; N f ; B 14 0 313 729 ; L i fi ; L l fl ;
C 103 ; WX 611 ; N g ; B 34 -220 541 551 ;
C 104 ; WX 611 ; N h ; B 67 0 541 729 ;
C 105 ; WX 278 ; N i ; B 67 0 207 729 ;
C 106 ; WX 278 ; N j ; B 4 -219 210 729 ;
C 107 ; WX 556 ; N k ; B 59 0 548 729 ;
C 108 ; WX 278 ; N l ; B 67 0 207 729 ;
C 109 ; WX 889 ; N m ; B 60 0 824 553 ;
C 110 ; WX 611 ; N n ; B 63 0 546 551 ;
C 111 ; WX 611 ; N o ; B 35 -23 569 551 ;
C 112 ; WX 611 ; N p ; B 58 -219 574 551 ;
C 113 ; WX 611 ; N q ; B 28 -219 544 551 ;
C 114 ; WX 389 ; N r ; B 63 0 370 553 ;
C 115 ; WX 556 ; N s ; B 29 -23 520 551 ;
C 116 ; WX 333 ; N t ; B 14 -23 301 678 ;
C 117 ; WX 611 ; N u ; B 58 -23 541 542 ;
C 118 ; WX 556 ; N v ; B 14 0 536 542 ;
C 119 ; WX 778 ; N w ; B 5 0 766 542 ;
C 120 ; WX 556 ; N x ; B 16 0 535 542 ;
C 121 ; WX 556 ; N y ; B 9 -219 538 542 ;
C 122 ; WX 500 ; N z ; B 21 0 468 542 ;
C 123 ; WX 389 ; N braceleft ; B 37 -202 317 729 ;
C 124 ; WX 280 ; N bar ; B 100 -202 180 729 ;
C 125 ; WX 389 ; N braceright ; B 72 -202 352 729 ;
C 126 ; WX 584 ; N asciitilde ; B 60 144 519 322 ;
C 161 ; WX 333 ; N exclamdown ; B 66 -187 216 542 ;
C 162 ; WX 556 ; N cent ; B 37 -122 522 637 ;
C 163 ; WX 556 ; N sterling ; B 31 -20 537 717 ;
C 164 ; WX 167 ; N fraction ; B -173 -20 337 715 ;
C 165 ; WX 556 ; N yen ; B 5 0 552 705 ;
C 166 ; WX 556 ; N florin ; B 21 -221 535 745 ;
C 167 ; WX 556 ; N section ; B 33 -201 518 728 ;
C 168 ; WX 556 ; N currency ; B 26 105 530 604 ;
C 169 ; WX 238 ; N quotesingle ; B 50 469 188 729 ;
C 170 ; WX 500 ; N quotedblleft ; B 71 469 433 729 ;
C 171 ; WX 556 ; N guillemotleft ; B 88 71 468 484 ;
C 172 ; WX 333 ; N guilsinglleft ; B 83 73 250 476 ;
C 173 ; WX 333 ; N guilsinglright ; B 80 73 247 476 ;
C 174 ; WX 611 ; N fi ; B 9 0 548 729 ;
C 175 ; WX 611 ; N fl ; B 12 0 546 729 ;
C 177 ; WX 556 ; N endash ; B -9 208 557 313 ;
C 178 ; WX 556 ; N dagger ; B 31 -195 523 708 ;
C 179 ; WX 556 ; N daggerdbl ; B 28 -195 520 708 ;
C 180 ; WX 278 ; N periodcentered ; B 64 318 188 442 ;
C 182 ; WX 556 ; N paragraph ; B 20 -195 529 729 ;
C 183 ; WX 350 ; N bullet ; B 50 175 300 425 ;
C 184 ; WX 278 ; N quotesinglbase ; B 66 -135 201 125 ;
C 185 ; WX 500 ; N quotedblbase ; B 72 -164 432 141 ;
C 186 ; WX 500 ; N quotedblright ; B 73 469 440 729 ;
C 187 ; WX 556 ; N guillemotright ; B 88 71 462 482 ;
C 188 ; WX 1000 ; N ellipsis ; B 92 0 908 146 ;
C 189 ; WX 1000 ; N perthousand ; B 11 -20 990 745 ;
C 191 ; WX 611 ; N questiondown ; B 51 -192 544 542 ;
C 193 ; WX 333 ; N grave ; B 17 595 213 745 ;
C 194 ; WX 333 ; N acute ; B 121 595 317 745 ;
C 195 ; WX 333 ; N circumflex ; B 8 598 326 745 ;
C 196 ; WX 333 ; N tilde ; B -9 595 345 729 ;
C 197 ; WX 333 ; N macron ; B 16 629 315 717 ;
C 198 ; WX 333 ; N breve ; B 35 593 299 736 ;
C 199 ; WX 333 ; N dotaccent ; B 112 607 222 729 ;
C 200 ; WX 333 ; N dieresis ; B 18 609 314 731 ;
C 202 ; WX 333 ; N ring ; B 77 565 257 745 ;
C 203 ; WX 333 ; N cedilla ; B 27 -220 294 -9 ;
C 205 ; WX 333 ; N hungarumlaut ; B -44 595 340 745 ;
C 206 ; WX 333 ; N ogonek ; B 45 -195 268 38 ;
C 207 ; WX 333 ; N caron ; B 9 598 327 745 ;
C 208 ; WX 1000 ; N emdash ; B -7 208 1003 313 ;
C 225 ; WX 1000 ; N AE ; B 1 0 966 729 ;
C 227 ; WX 370 ; N ordfeminine ; B 31 277 329 746 ;
C 232 ; WX 611 ; N Lslash ; B 0 0 597 729 ;
C 233 ; WX 778 ; N Oslash ; B 31 -34 755 754 ;
C 234 ; WX 1000 ; N OE ; B 28 -20 970 741 ;
C 235 ; WX 365 ; N ordmasculine ; B 23 276 343 745 ;
C 241 ; WX 889 ; N ae ; B 27 -20 857 555 ;
C 245 ; WX 278 ; N dotlessi ; B 67 0 207 542 ;
C 248 ; WX 278 ; N lslash ; B 0 0 252 729 ;
C 249 ; WX 611 ; N oslash ; B 11 -34 598 561 ;
C 250 ; WX 944 ; N oe ; B 23 -21 920 554 ;
C 251 ; WX 611 ; N germandbls ; B 67 -16 575 730 ;
C -1 ; WX 722 ; N Aacute ; B 26 0 703 936 ;
C -1 ; WX 722 ; N Acircumflex ; B 26 0 703 936 ;
C -1 ; WX 722 ; N Adieresis ; B 26 0 703 922 ;
C -1 ; WX 722 ; N Agrave ; B 26 0 703 936 ;
C -1 ; WX 722 ; N Aring ; B 26 0 703 936 ;
C -1 ; WX 722 ; N Atilde ; B 26 0 703 920 ;
C -1 ; WX 722 ; N Ccedilla ; B 44 -220 685 741 ;
C -1 ; WX 667 ; N Eacute ; B 79 0 624 936 ;
C -1 ; WX 667 ; N Ecircumflex ; B 79 0 624 936 ;
C -1 ; WX 667 ; N Edieresis ; B 79 0 624 922 ;
C -1 ; WX 667 ; N Egrave ; B 79 0 624 936 ;
C -1 ; WX 722 ; N Eth ; B -18 0 681 729 ;
C -1 ; WX 278 ; N Iacute ; B 63 0 290 936 ;
C -1 ; WX 278 ; N Icircumflex ; B -19 0 299 936 ;
C -1 ; WX 278 ; N Idieresis ; B -9 0 287 922 ;
C -1 ; WX 278 ; N Igrave ; B -10 0 213 936 ;
C -1 ; WX 722 ; N Ntilde ; B 68 0 661 920 ;
C -1 ; WX 778 ; N Oacute ; B 40 -23 742 936 ;
C -1 ; WX 778 ; N Ocircumflex ; B 40 -23 742 936 ;
C -1 ; WX 778 ; N Odieresis ; B 40 -23 742 922 ;
C -1 ; WX 778 ; N Ograve ; B 40 -23 742 936 ;
C -1 ; WX 778 ; N Otilde ; B 40 -23 742 920 ;
C -1 ; WX 667 ; N Scaron ; B 32 -23 633 936 ;
C -1 ; WX 667 ; N Thorn ; B 76 0 633 729 ;
C -1 ; WX 722 ; N Uacute ; B 76 -23 654 936 ;
C -1 ; WX 722 ; N Ucircumflex ; B 76 -23 654 936 ;
C -1 ; WX 722 ; N Udieresis ; B 76 -23 654 922 ;
C -1 ; WX 722 ; N Ugrave ; B 76 -23 654 936 ;
C -1 ; WX 667 ; N Yacute ; B 27 0 650 932 ;
C -1 ; WX 667 ; N Ydieresis ; B 27 0 650 922 ;
C -1 ; WX 611 ; N Zcaron ; B 30 0 578 936 ;
C -1 ; WX 556 ; N aacute ; B 27 -24 524 745 ;
C -1 ; WX 556 ; N acircumflex ; B 27 -24 524 745 ;
C -1 ; WX 556 ; N adieresis ; B 27 -24 524 731 ;
C -1 ; WX 556 ; N agrave ; B 27 -24 524 745 ;
C -1 ; WX 556 ; N aring ; B 27 -24 524 745 ;
C -1 ; WX 556 ; N atilde ; B 27 -24 524 729 ;
C -1 ; WX 280 ; N brokenbar ; B 100 -202 180 729 ;
C -1 ; WX 556 ; N ccedilla ; B 34 -220 522 551 ;
C -1 ; WX 737 ; N copyright ; B -14 -20 751 745 ;
C -1 ; WX 400 ; N degree ; B 50 425 350 725 ;
C -1 ; WX 584 ; N divide ; B 50 -10 534 474 ;
C -1 ; WX 556 ; N eacute ; B 22 -23 525 745 ;
C -1 ; WX 556 ; N ecircumflex ; B 22 -23 525 745 ;
C -1 ; WX 556 ; N edieresis ; B 22 -23 525 731 ;
C -1 ; WX 556 ; N egrave ; B 22 -23 525 745 ;
C -1 ; WX 611 ; N eth ; B 35 -23 569 730 ;
C -1 ; WX 278 ; N iacute ; B 67 0 290 745 ;
C -1 ; WX 278 ; N icircumflex ; B -19 0 299 745 ;
C -1 ; WX 278 ; N idieresis ; B -9 0 287 731 ;
C -1 ; WX 278 ; N igrave ; B -10 0 207 745 ;
C -1 ; WX 584 ; N logicalnot ; B 40 121 544 412 ;
C -1 ; WX 584 ; N minus ; B 40 174 544 290 ;
C -1 ; WX 611 ; N mu ; B 58 -219 541 542 ;
C -1 ; WX 584 ; N multiply ; B 50 -10 534 474 ;
C -1 ; WX 611 ; N ntilde ; B 63 0 546 729 ;
C -1 ; WX 611 ; N oacute ; B 35 -23 569 745 ;
C -1 ; WX 611 ; N ocircumflex ; B 35 -23 569 745 ;
C -1 ; WX 611 ; N odieresis ; B 35 -23 569 731 ;
C -1 ; WX 611 ; N ograve ; B 35 -23 569 745 ;
C -1 ; WX 834 ; N onehalf ; B 30 -20 803 715 ;
C -1 ; WX 834 ; N onequarter ; B 30 -20 804 715 ;
C -1 ; WX 333 ; N onesuperior ; B 46 284 247 709 ;
C -1 ; WX 611 ; N otilde ; B 35 -23 569 729 ;
C -1 ; WX 584 ; N plusminus ; B 40 0 544 674 ;
C -1 ; WX 737 ; N registered ; B -14 -20 751 745 ;
C -1 ; WX 556 ; N scaron ; B 29 -23 520 745 ;
C -1 ; WX 611 ; N thorn ; B 58 -219 574 729 ;
C -1 ; WX 834 ; N threequarters ; B 30 -20 804 725 ;
C -1 ; WX 333 ; N threesuperior ; B 8 271 325 720 ;
C -1 ; WX 1000 ; N trademark ; B 71 341 929 745 ;
C -1 ; WX 333 ; N twosuperior ; B 9 284 324 719 ;
C -1 ; WX 611 ; N uacute ; B 58 -23 541 745 ;
C -1 ; WX 611 ; N ucircumflex ; B 58 -23 541 745 ;
C -1 ; WX 611 ; N udieresis ; B 58 -23 541 731 ;
C -1 ; WX 611 ; N ugrave ; B 58 -23 541 745 ;
C -1 ; WX 556 ; N yacute ; B 9 -219 538 745 ;
C -1 ; WX 556 ; N ydieresis ; B 9 -219 538 731 ;
C -1 ; WX 500 ; N zcaron ; B 21 0 468 745 ;
EndCharMetrics
StartKernData
StartKernPairs 101
KPX A y -37
KPX A w -18
KPX A v -37
KPX A space -37
KPX A quoteright -55
KPX A Y -92
KPX A W -55
KPX A V -74
KPX A T -74
KPX F period -111
KPX F comma -111
KPX F A -55
KPX L y -37
KPX L space -18
KPX L quoteright -55
KPX L Y -92
KPX L W -55
KPX L V -74
KPX L T -74
KPX P space -18
KPX P period -129
KPX P comma -129
KPX P A -74
KPX R Y -37
KPX R W -18
KPX R V -18
KPX T y -74
KPX T w -74
KPX T u -74
KPX T semicolon -111
KPX T s -74
KPX T r -55
KPX T period -111
KPX T o -74
KPX T i -18
KPX T hyphen -55
KPX T e -74
KPX T comma -111
KPX T colon -111
KPX T c -74
KPX T a -74
KPX T O -18
KPX T A -74
KPX V y -37
KPX V u -37
KPX V semicolon -55
KPX V r -55
KPX V period -92
KPX V o -74
KPX V i -18
KPX V hyphen -55
KPX V e -55
KPX V comma -92
KPX V colon -55
KPX V a -55
KPX V A -74
KPX W y -18
KPX W u -18
KPX W semicolon -18
KPX W r -18
KPX W period -55
KPX W o -18
KPX W i -9
KPX W hyphen -20
KPX W e -18
KPX W comma -55
KPX W colon -18
KPX W a -37
KPX W A -55
KPX Y v -55
KPX Y u -55
KPX Y space -18
KPX Y semicolon -74
KPX Y q -74
KPX Y period -111
KPX Y p -55
KPX Y o -74
KPX Y i -37
KPX Y hyphen -55
KPX Y e -55
KPX Y comma -111
KPX Y colon -74
KPX Y a -55
KPX Y A -92
KPX f quoteright 18
KPX one one -55
KPX quoteleft quoteleft -37
KPX quoteright space -55
KPX quoteright s -37
KPX quoteright quoteright -37
KPX r quoteright 37
KPX r period -55
KPX r comma -55
KPX space Y -18
KPX space A -37
KPX v period -74
KPX v comma -74
KPX w period -37
KPX w comma -37
KPX y period -74
KPX y comma -74
EndKernPairs
EndKernData
StartComposites 58
CC Zcaron 2 ; PCC Z 0 0 ; PCC caron 139 191 ;
CC zcaron 2 ; PCC z 0 0 ; PCC caron 83 0 ;
CC Scaron 2 ; PCC S 0 0 ; PCC caron 167 191 ;
CC scaron 2 ; PCC s 0 0 ; PCC caron 111 0 ;
CC Ccedilla 2 ; PCC C 0 0 ; PCC cedilla 207 0 ;
CC ccedilla 2 ; PCC c 0 0 ; PCC cedilla 117 0 ;
CC Yacute 2 ; PCC Y 0 0 ; PCC acute 167 187 ;
CC yacute 2 ; PCC y 0 0 ; PCC acute 111 0 ;
CC Ydieresis 2 ; PCC Y 0 0 ; PCC dieresis 167 191 ;
CC ydieresis 2 ; PCC y 0 0 ; PCC dieresis 111 0 ;
CC Uacute 2 ; PCC U 0 0 ; PCC acute 197 191 ;
CC Ucircumflex 2 ; PCC U 0 0 ; PCC circumflex 197 191 ;
CC Udieresis 2 ; PCC U 0 0 ; PCC dieresis 197 191 ;
CC Ugrave 2 ; PCC U 0 0 ; PCC grave 197 191 ;
CC uacute 2 ; PCC u 0 0 ; PCC acute 139 0 ;
CC ucircumflex 2 ; PCC u 0 0 ; PCC circumflex 139 0 ;
CC udieresis 2 ; PCC u 0 0 ; PCC dieresis 139 0 ;
CC ugrave 2 ; PCC u 0 0 ; PCC grave 139 0 ;
CC Iacute 2 ; PCC I 0 0 ; PCC acute -27 191 ;
CC Icircumflex 2 ; PCC I 0 0 ; PCC circumflex -27 191 ;
CC Idieresis 2 ; PCC I 0 0 ; PCC dieresis -27 191 ;
CC Igrave 2 ; PCC I 0 0 ; PCC grave -27 191 ;
CC iacute 2 ; PCC dotlessi 0 0 ; PCC acute -27 0 ;
CC icircumflex 2 ; PCC dotlessi 0 0 ; PCC circumflex -27 0 ;
CC idieresis 2 ; PCC dotlessi 0 0 ; PCC dieresis -27 0 ;
CC igrave 2 ; PCC dotlessi 0 0 ; PCC grave -27 0 ;
CC Eacute 2 ; PCC E 0 0 ; PCC acute 188 191 ;
CC Ecircumflex 2 ; PCC E 0 0 ; PCC circumflex 188 191 ;
CC Edieresis 2 ; PCC E 0 0 ; PCC dieresis 188 191 ;
CC Egrave 2 ; PCC E 0 0 ; PCC grave 188 191 ;
CC eacute 2 ; PCC e 0 0 ; PCC acute 111 0 ;
CC ecircumflex 2 ; PCC e 0 0 ; PCC circumflex 111 0 ;
CC edieresis 2 ; PCC e 0 0 ; PCC dieresis 111 0 ;
CC egrave 2 ; PCC e 0 0 ; PCC grave 111 0 ;
CC Aacute 2 ; PCC A 0 0 ; PCC acute 197 191 ;
CC Acircumflex 2 ; PCC A 0 0 ; PCC circumflex 197 191 ;
CC Adieresis 2 ; PCC A 0 0 ; PCC dieresis 197 191 ;
CC Agrave 2 ; PCC A 0 0 ; PCC grave 197 191 ;
CC aacute 2 ; PCC a 0 0 ; PCC acute 111 0 ;
CC acircumflex 2 ; PCC a 0 0 ; PCC circumflex 111 0 ;
CC adieresis 2 ; PCC a 0 0 ; PCC dieresis 111 0 ;
CC agrave 2 ; PCC a 0 0 ; PCC grave 111 0 ;
CC Oacute 2 ; PCC O 0 0 ; PCC acute 222 191 ;
CC Ocircumflex 2 ; PCC O 0 0 ; PCC circumflex 222 191 ;
CC Odieresis 2 ; PCC O 0 0 ; PCC dieresis 222 191 ;
CC Ograve 2 ; PCC O 0 0 ; PCC grave 222 191 ;
CC oacute 2 ; PCC o 0 0 ; PCC acute 139 0 ;
CC ocircumflex 2 ; PCC o 0 0 ; PCC circumflex 139 0 ;
CC odieresis 2 ; PCC o 0 0 ; PCC dieresis 139 0 ;
CC ograve 2 ; PCC o 0 0 ; PCC grave 139 0 ;
CC Atilde 2 ; PCC A 0 0 ; PCC tilde 197 191 ;
CC atilde 2 ; PCC a 0 0 ; PCC tilde 111 0 ;
CC Ntilde 2 ; PCC N 0 0 ; PCC tilde 200 191 ;
CC ntilde 2 ; PCC n 0 0 ; PCC tilde 146 0 ;
CC Otilde 2 ; PCC O 0 0 ; PCC tilde 222 191 ;
CC otilde 2 ; PCC o 0 0 ; PCC tilde 139 0 ;
CC Aring 2 ; PCC A 0 0 ; PCC ring 197 191 ;
CC aring 2 ; PCC a 0 0 ; PCC ring 111 0 ;
EndComposites
EndFontMetrics

431
collects/afm/Helvetica-BoldOblique.afm Normal file
View File

@ -0,0 +1,431 @@
StartFontMetrics 2.0
Comment Copyright (c) 1984 Adobe Systems Incorporated. All Rights Reserved.
Comment Creation Date:Sun Feb 8 20:39:16 PST 1987
FontName Helvetica-BoldOblique
EncodingScheme AdobeStandardEncoding
FullName Helvetica Bold Oblique
FamilyName Helvetica
Weight Bold
ItalicAngle -12.0
IsFixedPitch false
UnderlinePosition -106
UnderlineThickness 105
Version 001.002
Notice Helvetica is a registered trademark of Allied Corporation
FontBBox -177 -221 1107 936
CapHeight 729
XHeight 542
Descender -219
Ascender 729
StartCharMetrics 228
C 32 ; WX 278 ; N space ; B 0 0 0 0 ;
C 33 ; WX 333 ; N exclam ; B 112 0 417 729 ;
C 34 ; WX 474 ; N quotedbl ; B 177 470 579 729 ;
C 35 ; WX 556 ; N numbersign ; B 33 -30 660 696 ;
C 36 ; WX 556 ; N dollar ; B 59 -125 628 765 ;
C 37 ; WX 889 ; N percent ; B 129 -18 903 708 ;
C 38 ; WX 722 ; N ampersand ; B 89 -20 720 729 ;
C 39 ; WX 278 ; N quoteright ; B 166 469 356 729 ;
C 40 ; WX 333 ; N parenleft ; B 84 -202 458 729 ;
C 41 ; WX 333 ; N parenright ; B -21 -202 356 729 ;
C 42 ; WX 389 ; N asterisk ; B 145 385 478 730 ;
C 43 ; WX 584 ; N plus ; B 87 -10 596 474 ;
C 44 ; WX 278 ; N comma ; B 27 -174 245 146 ;
C 45 ; WX 333 ; N hyphen ; B 70 208 371 344 ;
C 46 ; WX 278 ; N period ; B 64 0 245 146 ;
C 47 ; WX 278 ; N slash ; B -1 -14 427 715 ;
C 48 ; WX 556 ; N zero ; B 81 -23 614 725 ;
C 49 ; WX 556 ; N one ; B 172 0 529 709 ;
C 50 ; WX 556 ; N two ; B 30 0 628 726 ;
C 51 ; WX 556 ; N three ; B 67 -23 613 726 ;
C 52 ; WX 556 ; N four ; B 57 0 599 709 ;
C 53 ; WX 556 ; N five ; B 59 -24 641 709 ;
C 54 ; WX 556 ; N six ; B 85 -23 625 727 ;
C 55 ; WX 556 ; N seven ; B 131 0 679 709 ;
C 56 ; WX 556 ; N eight ; B 60 -23 620 726 ;
C 57 ; WX 556 ; N nine ; B 68 -23 611 728 ;
C 58 ; WX 333 ; N colon ; B 113 0 374 521 ;
C 59 ; WX 333 ; N semicolon ; B 76 -174 374 521 ;
C 60 ; WX 584 ; N less ; B 77 -10 630 474 ;
C 61 ; WX 584 ; N equal ; B 61 52 622 412 ;
C 62 ; WX 584 ; N greater ; B 38 -10 591 474 ;
C 63 ; WX 611 ; N question ; B 168 0 672 744 ;
C 64 ; WX 975 ; N at ; B 73 -136 1032 746 ;
C 65 ; WX 722 ; N A ; B 26 0 703 729 ;
C 66 ; WX 722 ; N B ; B 82 0 762 729 ;
C 67 ; WX 722 ; N C ; B 107 -23 793 741 ;
C 68 ; WX 722 ; N D ; B 77 0 776 729 ;
C 69 ; WX 667 ; N E ; B 79 0 762 729 ;
C 70 ; WX 611 ; N F ; B 74 0 741 729 ;
C 71 ; WX 778 ; N G ; B 107 -24 819 741 ;
C 72 ; WX 722 ; N H ; B 68 0 812 729 ;
C 73 ; WX 278 ; N I ; B 63 0 368 729 ;
C 74 ; WX 556 ; N J ; B 59 -23 641 729 ;
C 75 ; WX 722 ; N K ; B 74 0 843 729 ;
C 76 ; WX 611 ; N L ; B 80 0 606 729 ;
C 77 ; WX 833 ; N M ; B 66 0 931 729 ;
C 78 ; WX 722 ; N N ; B 68 0 816 729 ;
C 79 ; WX 778 ; N O ; B 106 -23 828 741 ;
C 80 ; WX 667 ; N P ; B 76 0 747 729 ;
C 81 ; WX 778 ; N Q ; B 109 -54 831 741 ;
C 82 ; WX 722 ; N R ; B 80 0 785 729 ;
C 83 ; WX 667 ; N S ; B 76 -23 725 741 ;
C 84 ; WX 611 ; N T ; B 142 0 753 729 ;
C 85 ; WX 722 ; N U ; B 119 -23 809 729 ;
C 86 ; WX 667 ; N V ; B 179 0 802 729 ;
C 87 ; WX 944 ; N W ; B 168 0 1087 729 ;
C 88 ; WX 667 ; N X ; B 22 0 802 729 ;
C 89 ; WX 667 ; N Y ; B 182 0 805 729 ;
C 90 ; WX 611 ; N Z ; B 30 0 733 729 ;
C 91 ; WX 333 ; N bracketleft ; B 23 -202 463 729 ;
C 92 ; WX 278 ; N backslash ; B 138 -21 285 708 ;
C 93 ; WX 333 ; N bracketright ; B -25 -202 415 729 ;
C 94 ; WX 584 ; N asciicircum ; B 119 271 580 696 ;
C 95 ; WX 556 ; N underscore ; B -65 -200 550 -130 ;
C 96 ; WX 278 ; N quoteleft ; B 167 469 357 729 ;
C 97 ; WX 556 ; N a ; B 50 -24 578 551 ;
C 98 ; WX 611 ; N b ; B 59 -23 640 729 ;
C 99 ; WX 556 ; N c ; B 77 -23 597 551 ;
C 100 ; WX 611 ; N d ; B 79 -23 700 729 ;
C 101 ; WX 556 ; N e ; B 64 -23 591 551 ;
C 102 ; WX 333 ; N f ; B 90 0 464 729 ; L i fi ; L l fl ;
C 103 ; WX 611 ; N g ; B 26 -220 656 551 ;
C 104 ; WX 611 ; N h ; B 67 0 629 729 ;
C 105 ; WX 278 ; N i ; B 67 0 362 729 ;
C 106 ; WX 278 ; N j ; B -43 -219 365 729 ;
C 107 ; WX 556 ; N k ; B 59 0 651 729 ;
C 108 ; WX 278 ; N l ; B 67 0 362 729 ;
C 109 ; WX 889 ; N m ; B 60 0 911 553 ;
C 110 ; WX 611 ; N n ; B 63 0 629 551 ;
C 111 ; WX 611 ; N o ; B 82 -23 634 551 ;
C 112 ; WX 611 ; N p ; B 11 -219 637 551 ;
C 113 ; WX 611 ; N q ; B 72 -219 659 551 ;
C 114 ; WX 389 ; N r ; B 63 0 487 553 ;
C 115 ; WX 556 ; N s ; B 60 -23 589 551 ;
C 116 ; WX 333 ; N t ; B 101 -23 414 678 ;
C 117 ; WX 611 ; N u ; B 88 -23 656 542 ;
C 118 ; WX 556 ; N v ; B 129 0 651 542 ;
C 119 ; WX 778 ; N w ; B 120 0 881 542 ;
C 120 ; WX 556 ; N x ; B 16 0 648 542 ;
C 121 ; WX 556 ; N y ; B 37 -219 653 542 ;
C 122 ; WX 500 ; N z ; B 21 0 575 542 ;
C 123 ; WX 389 ; N braceleft ; B 84 -202 472 729 ;
C 124 ; WX 280 ; N bar ; B 57 -202 335 729 ;
C 125 ; WX 389 ; N braceright ; B 29 -202 419 729 ;
C 126 ; WX 584 ; N asciitilde ; B 97 144 581 322 ;
C 161 ; WX 333 ; N exclamdown ; B 26 -187 331 542 ;
C 162 ; WX 556 ; N cent ; B 79 -122 598 637 ;
C 163 ; WX 556 ; N sterling ; B 49 -20 629 717 ;
C 164 ; WX 167 ; N fraction ; B -177 -20 489 715 ;
C 165 ; WX 556 ; N yen ; B 107 0 702 705 ;
C 166 ; WX 556 ; N florin ; B -21 -221 690 745 ;
C 167 ; WX 556 ; N section ; B 56 -201 596 728 ;
C 168 ; WX 556 ; N currency ; B 66 105 644 604 ;
C 169 ; WX 238 ; N quotesingle ; B 177 469 343 729 ;
C 170 ; WX 500 ; N quotedblleft ; B 171 469 588 729 ;
C 171 ; WX 556 ; N guillemotleft ; B 135 71 571 484 ;
C 172 ; WX 333 ; N guilsinglleft ; B 128 73 351 476 ;
C 173 ; WX 333 ; N guilsinglright ; B 96 73 319 476 ;
C 174 ; WX 611 ; N fi ; B 85 0 703 729 ;
C 175 ; WX 611 ; N fl ; B 88 0 701 729 ;
C 177 ; WX 556 ; N endash ; B 35 208 624 313 ;
C 178 ; WX 556 ; N dagger ; B 109 -195 626 708 ;
C 179 ; WX 556 ; N daggerdbl ; B 35 -195 623 708 ;
C 180 ; WX 278 ; N periodcentered ; B 143 318 270 442 ;
C 182 ; WX 556 ; N paragraph ; B 121 -195 684 729 ;
C 183 ; WX 350 ; N bullet ; B 111 175 367 425 ;
C 184 ; WX 278 ; N quotesinglbase ; B 37 -135 228 125 ;
C 185 ; WX 500 ; N quotedblbase ; B 37 -164 462 141 ;
C 186 ; WX 500 ; N quotedblright ; B 173 469 595 729 ;
C 187 ; WX 556 ; N guillemotright ; B 103 71 533 482 ;
C 188 ; WX 1000 ; N ellipsis ; B 92 0 939 146 ;
C 189 ; WX 1000 ; N perthousand ; B 72 -20 1021 745 ;
C 191 ; WX 611 ; N questiondown ; B 52 -192 556 542 ;
C 193 ; WX 333 ; N grave ; B 175 595 339 745 ;
C 194 ; WX 333 ; N acute ; B 247 595 475 745 ;
C 195 ; WX 333 ; N circumflex ; B 135 598 453 745 ;
C 196 ; WX 333 ; N tilde ; B 117 595 500 729 ;
C 197 ; WX 333 ; N macron ; B 150 629 467 717 ;
C 198 ; WX 333 ; N breve ; B 188 593 455 736 ;
C 199 ; WX 333 ; N dotaccent ; B 241 607 377 729 ;
C 200 ; WX 333 ; N dieresis ; B 147 609 469 731 ;
C 202 ; WX 333 ; N ring ; B 214 565 398 745 ;
C 203 ; WX 333 ; N cedilla ; B -13 -220 270 -9 ;
C 205 ; WX 333 ; N hungarumlaut ; B 82 595 498 745 ;
C 206 ; WX 333 ; N ogonek ; B 23 -195 248 38 ;
C 207 ; WX 333 ; N caron ; B 167 598 485 745 ;
C 208 ; WX 1000 ; N emdash ; B 37 208 1070 313 ;
C 225 ; WX 1000 ; N AE ; B 1 0 1104 729 ;
C 227 ; WX 370 ; N ordfeminine ; B 96 277 451 746 ;
C 232 ; WX 611 ; N Lslash ; B 54 0 624 729 ;
C 233 ; WX 778 ; N Oslash ; B 34 -34 906 754 ;
C 234 ; WX 1000 ; N OE ; B 90 -20 1107 741 ;
C 235 ; WX 365 ; N ordmasculine ; B 92 276 471 745 ;
C 241 ; WX 889 ; N ae ; B 54 -20 927 555 ;
C 245 ; WX 278 ; N dotlessi ; B 67 0 322 542 ;
C 248 ; WX 278 ; N lslash ; B 50 0 372 729 ;
C 249 ; WX 611 ; N oslash ; B 12 -34 709 561 ;
C 250 ; WX 944 ; N oe ; B 71 -21 986 554 ;
C 251 ; WX 611 ; N germandbls ; B 67 -16 654 730 ;
C -1 ; WX 722 ; N Aacute ; B 26 0 714 936 ;
C -1 ; WX 722 ; N Acircumflex ; B 26 0 703 936 ;
C -1 ; WX 722 ; N Adieresis ; B 26 0 708 922 ;
C -1 ; WX 722 ; N Agrave ; B 26 0 703 936 ;
C -1 ; WX 722 ; N Aring ; B 26 0 703 936 ;
C -1 ; WX 722 ; N Atilde ; B 26 0 739 920 ;
C -1 ; WX 722 ; N Ccedilla ; B 107 -220 793 741 ;
C -1 ; WX 667 ; N Eacute ; B 79 0 762 936 ;
C -1 ; WX 667 ; N Ecircumflex ; B 79 0 762 936 ;
C -1 ; WX 667 ; N Edieresis ; B 79 0 762 922 ;
C -1 ; WX 667 ; N Egrave ; B 79 0 762 936 ;
C -1 ; WX 722 ; N Eth ; B 53 0 776 729 ;
C -1 ; WX 278 ; N Iacute ; B 63 0 489 936 ;
C -1 ; WX 278 ; N Icircumflex ; B 63 0 467 936 ;
C -1 ; WX 278 ; N Idieresis ; B 63 0 483 922 ;
C -1 ; WX 278 ; N Igrave ; B 63 0 368 936 ;
C -1 ; WX 722 ; N Ntilde ; B 68 0 816 920 ;
C -1 ; WX 778 ; N Oacute ; B 106 -23 828 936 ;
C -1 ; WX 778 ; N Ocircumflex ; B 106 -23 828 936 ;
C -1 ; WX 778 ; N Odieresis ; B 106 -23 828 922 ;
C -1 ; WX 778 ; N Ograve ; B 106 -23 828 936 ;
C -1 ; WX 778 ; N Otilde ; B 106 -23 828 920 ;
C -1 ; WX 667 ; N Scaron ; B 76 -23 725 936 ;
C -1 ; WX 667 ; N Thorn ; B 76 0 730 729 ;
C -1 ; WX 722 ; N Uacute ; B 119 -23 809 936 ;
C -1 ; WX 722 ; N Ucircumflex ; B 119 -23 809 936 ;
C -1 ; WX 722 ; N Udieresis ; B 119 -23 809 922 ;
C -1 ; WX 722 ; N Ugrave ; B 119 -23 809 936 ;
C -1 ; WX 667 ; N Yacute ; B 182 0 805 932 ;
C -1 ; WX 667 ; N Ydieresis ; B 182 0 805 922 ;
C -1 ; WX 611 ; N Zcaron ; B 30 0 733 936 ;
C -1 ; WX 556 ; N aacute ; B 50 -24 587 745 ;
C -1 ; WX 556 ; N acircumflex ; B 50 -24 578 745 ;
C -1 ; WX 556 ; N adieresis ; B 50 -24 581 731 ;
C -1 ; WX 556 ; N agrave ; B 50 -24 578 745 ;
C -1 ; WX 556 ; N aring ; B 50 -24 578 745 ;
C -1 ; WX 556 ; N atilde ; B 50 -24 612 729 ;
C -1 ; WX 280 ; N brokenbar ; B 57 -202 335 729 ;
C -1 ; WX 556 ; N ccedilla ; B 77 -220 597 551 ;
C -1 ; WX 737 ; N copyright ; B 54 -20 837 745 ;
C -1 ; WX 400 ; N degree ; B 169 425 476 725 ;
C -1 ; WX 584 ; N divide ; B 87 -10 596 474 ;
C -1 ; WX 556 ; N eacute ; B 64 -23 591 745 ;
C -1 ; WX 556 ; N ecircumflex ; B 64 -23 591 745 ;
C -1 ; WX 556 ; N edieresis ; B 64 -23 591 731 ;
C -1 ; WX 556 ; N egrave ; B 64 -23 591 745 ;
C -1 ; WX 611 ; N eth ; B 82 -23 633 730 ;
C -1 ; WX 278 ; N iacute ; B 67 0 448 745 ;
C -1 ; WX 278 ; N icircumflex ; B 67 0 426 745 ;
C -1 ; WX 278 ; N idieresis ; B 67 0 442 731 ;
C -1 ; WX 278 ; N igrave ; B 67 0 322 745 ;
C -1 ; WX 584 ; N logicalnot ; B 103 121 632 412 ;
C -1 ; WX 584 ; N minus ; B 77 174 606 290 ;
C -1 ; WX 611 ; N mu ; B 11 -219 656 542 ;
C -1 ; WX 584 ; N multiply ; B 66 -10 617 474 ;
C -1 ; WX 611 ; N ntilde ; B 63 0 646 729 ;
C -1 ; WX 611 ; N oacute ; B 82 -23 634 745 ;
C -1 ; WX 611 ; N ocircumflex ; B 82 -23 634 745 ;
C -1 ; WX 611 ; N odieresis ; B 82 -23 634 731 ;
C -1 ; WX 611 ; N ograve ; B 82 -23 634 745 ;
C -1 ; WX 834 ; N onehalf ; B 120 -20 871 715 ;
C -1 ; WX 834 ; N onequarter ; B 151 -20 846 715 ;
C -1 ; WX 333 ; N onesuperior ; B 169 284 398 709 ;
C -1 ; WX 611 ; N otilde ; B 82 -23 639 729 ;
C -1 ; WX 584 ; N plusminus ; B 40 0 639 674 ;
C -1 ; WX 737 ; N registered ; B 55 -20 837 745 ;
C -1 ; WX 556 ; N scaron ; B 60 -23 597 745 ;
C -1 ; WX 611 ; N thorn ; B 11 -219 641 729 ;
C -1 ; WX 834 ; N threequarters ; B 116 -20 863 725 ;
C -1 ; WX 333 ; N threesuperior ; B 92 271 442 720 ;
C -1 ; WX 1000 ; N trademark ; B 213 341 1087 745 ;
C -1 ; WX 333 ; N twosuperior ; B 69 284 452 719 ;
C -1 ; WX 611 ; N uacute ; B 88 -23 656 745 ;
C -1 ; WX 611 ; N ucircumflex ; B 88 -23 656 745 ;
C -1 ; WX 611 ; N udieresis ; B 88 -23 656 731 ;
C -1 ; WX 611 ; N ugrave ; B 88 -23 656 745 ;
C -1 ; WX 556 ; N yacute ; B 37 -219 653 745 ;
C -1 ; WX 556 ; N ydieresis ; B 37 -219 653 731 ;
C -1 ; WX 500 ; N zcaron ; B 21 0 575 745 ;
EndCharMetrics
StartKernData
StartKernPairs 99
KPX A space -37
KPX A quoteright -55
KPX A Y -74
KPX A W -55
KPX A V -74
KPX A T -74
KPX F period -111
KPX F comma -111
KPX F A -55
KPX L space -18
KPX L quoteright -74
KPX L Y -74
KPX L W -55
KPX L V -55
KPX L T -74
KPX P space -37
KPX P period -129
KPX P comma -129
KPX P A -74
KPX R Y -18
KPX R W -18
KPX R T -18
KPX T y -37
KPX T w -37
KPX T u -18
KPX T semicolon -74
KPX T s -37
KPX T r -18
KPX T period -74
KPX T o -37
KPX T i -18
KPX T hyphen -55
KPX T e -37
KPX T comma -74
KPX T colon -74
KPX T c -37
KPX T a -37
KPX T O -18
KPX T A -74
KPX V y -18
KPX V u -18
KPX V semicolon -37
KPX V r -18
KPX V period -92
KPX V o -37
KPX V i -37
KPX V hyphen -37
KPX V e -37
KPX V comma -92
KPX V colon -37
KPX V a -37
KPX V A -74
KPX W y -18
KPX W u -18
KPX W semicolon -37
KPX W r -18
KPX W period -74
KPX W o -18
KPX W i -9
KPX W hyphen -37
KPX W e -18
KPX W comma -74
KPX W colon -37
KPX W a -18
KPX W A -55
KPX Y v -37
KPX Y u -37
KPX Y space -18
KPX Y semicolon -55
KPX Y q -37
KPX Y period -92
KPX Y p -37
KPX Y i -37
KPX Y o -37
KPX Y hyphen -74
KPX Y e -37
KPX Y comma -92
KPX Y colon -55
KPX Y a -37
KPX Y A -74
KPX f quoteright 18
KPX f f -18
KPX one one -74
KPX quoteleft quoteleft -37
KPX quoteright t 18
KPX quoteright space -37
KPX quoteright s -18
KPX quoteright quoteright -37
KPX r quoteright 37
KPX r period -55
KPX r comma -55
KPX space Y -18
KPX space A -37
KPX v period -55
KPX v comma -55
KPX w period -37
KPX w comma -37
KPX y period -37
KPX y comma -37
EndKernPairs
EndKernData
StartComposites 58
CC Zcaron 2 ; PCC Z 0 0 ; PCC caron 139 187 ;
CC zcaron 2 ; PCC z 0 0 ; PCC caron 83 0 ;
CC Scaron 2 ; PCC S 0 0 ; PCC caron 167 187 ;
CC scaron 2 ; PCC s 0 0 ; PCC caron 111 0 ;
CC Ccedilla 2 ; PCC C 0 0 ; PCC cedilla 194 0 ;
CC ccedilla 2 ; PCC c 0 0 ; PCC cedilla 111 0 ;
CC Yacute 2 ; PCC Y 0 0 ; PCC acute 167 187 ;
CC yacute 2 ; PCC y 0 0 ; PCC acute 111 0 ;
CC Ydieresis 2 ; PCC Y 0 0 ; PCC dieresis 167 187 ;
CC ydieresis 2 ; PCC y 0 0 ; PCC dieresis 111 0 ;
CC Uacute 2 ; PCC U 0 0 ; PCC acute 194 187 ;
CC Ucircumflex 2 ; PCC U 0 0 ; PCC circumflex 194 187 ;
CC Udieresis 2 ; PCC U 0 0 ; PCC dieresis 194 187 ;
CC Ugrave 2 ; PCC U 0 0 ; PCC grave 194 187 ;
CC uacute 2 ; PCC u 0 0 ; PCC acute 139 0 ;
CC ucircumflex 2 ; PCC u 0 0 ; PCC circumflex 139 0 ;
CC udieresis 2 ; PCC u 0 0 ; PCC dieresis 139 0 ;
CC ugrave 2 ; PCC u 0 0 ; PCC grave 139 0 ;
CC Iacute 2 ; PCC I 0 0 ; PCC acute -27 187 ;
CC Icircumflex 2 ; PCC I 0 0 ; PCC circumflex -27 187 ;
CC Idieresis 2 ; PCC I 0 0 ; PCC dieresis -27 187 ;
CC Igrave 2 ; PCC I 0 0 ; PCC grave -27 187 ;
CC iacute 2 ; PCC dotlessi 0 0 ; PCC acute -27 0 ;
CC icircumflex 2 ; PCC dotlessi 0 0 ; PCC circumflex -27 0 ;
CC idieresis 2 ; PCC dotlessi 0 0 ; PCC dieresis -27 0 ;
CC igrave 2 ; PCC dotlessi 0 0 ; PCC grave -27 0 ;
CC Eacute 2 ; PCC E 0 0 ; PCC acute 167 187 ;
CC Ecircumflex 2 ; PCC E 0 0 ; PCC circumflex 167 187 ;
CC Edieresis 2 ; PCC E 0 0 ; PCC dieresis 167 187 ;
CC Egrave 2 ; PCC E 0 0 ; PCC grave 167 187 ;
CC eacute 2 ; PCC e 0 0 ; PCC acute 111 0 ;
CC ecircumflex 2 ; PCC e 0 0 ; PCC circumflex 111 0 ;
CC edieresis 2 ; PCC e 0 0 ; PCC dieresis 111 0 ;
CC egrave 2 ; PCC e 0 0 ; PCC grave 111 0 ;
CC Aacute 2 ; PCC A 0 0 ; PCC acute 194 187 ;
CC Acircumflex 2 ; PCC A 0 0 ; PCC circumflex 194 187 ;
CC Adieresis 2 ; PCC A 0 0 ; PCC dieresis 194 187 ;
CC Agrave 2 ; PCC A 0 0 ; PCC grave 194 187 ;
CC aacute 2 ; PCC a 0 0 ; PCC acute 111 0 ;
CC acircumflex 2 ; PCC a 0 0 ; PCC circumflex 111 0 ;
CC adieresis 2 ; PCC a 0 0 ; PCC dieresis 111 0 ;
CC agrave 2 ; PCC a 0 0 ; PCC grave 111 0 ;
CC Oacute 2 ; PCC O 0 0 ; PCC acute 222 187 ;
CC Ocircumflex 2 ; PCC O 0 0 ; PCC circumflex 222 187 ;
CC Odieresis 2 ; PCC O 0 0 ; PCC dieresis 222 187 ;
CC Ograve 2 ; PCC O 0 0 ; PCC grave 222 187 ;
CC oacute 2 ; PCC o 0 0 ; PCC acute 139 0 ;
CC ocircumflex 2 ; PCC o 0 0 ; PCC circumflex 139 0 ;
CC odieresis 2 ; PCC o 0 0 ; PCC dieresis 139 0 ;
CC ograve 2 ; PCC o 0 0 ; PCC grave 139 0 ;
CC Atilde 2 ; PCC A 0 0 ; PCC tilde 194 187 ;
CC atilde 2 ; PCC a 0 0 ; PCC tilde 111 0 ;
CC Ntilde 2 ; PCC N 0 0 ; PCC tilde 194 187 ;
CC ntilde 2 ; PCC n 0 0 ; PCC tilde 139 0 ;
CC Otilde 2 ; PCC O 0 0 ; PCC tilde 222 187 ;
CC otilde 2 ; PCC o 0 0 ; PCC tilde 139 0 ;
CC Aring 2 ; PCC A 0 0 ; PCC ring 194 187 ;
CC aring 2 ; PCC a 0 0 ; PCC ring 111 0 ;
EndComposites
EndFontMetrics

430
collects/afm/Helvetica-Oblique.afm Normal file
View File

@ -0,0 +1,430 @@
StartFontMetrics 2.0
Comment Copyright (c) 1984 Adobe Systems Incorporated. All Rights Reserved.
Comment Creation Date:Sun Feb 8 20:00:37 PST 1987
FontName Helvetica-Oblique
EncodingScheme AdobeStandardEncoding
FullName Helvetica Oblique
FamilyName Helvetica
Weight Medium
ItalicAngle -12.0
IsFixedPitch false
UnderlinePosition -106
UnderlineThickness 73
Version 001.002
Notice Helvetica is a registered trademark of Allied Corporation.
FontBBox -178 -220 1108 944
CapHeight 729
XHeight 525
Descender -219
Ascender 729
StartCharMetrics 228
C 32 ; WX 278 ; N space ; B 0 0 0 0 ;
C 33 ; WX 278 ; N exclam ; B 124 0 363 729 ;
C 34 ; WX 355 ; N quotedbl ; B 177 462 455 708 ;
C 35 ; WX 556 ; N numbersign ; B 54 -20 649 698 ;
C 36 ; WX 556 ; N dollar ; B 69 -125 613 770 ;
C 37 ; WX 889 ; N percent ; B 134 -20 895 708 ;
C 38 ; WX 667 ; N ampersand ; B 83 -23 644 710 ;
C 39 ; WX 222 ; N quoteright ; B 165 476 308 708 ;
C 40 ; WX 333 ; N parenleft ; B 113 -213 446 729 ;
C 41 ; WX 333 ; N parenright ; B -7 -213 325 729 ;
C 42 ; WX 389 ; N asterisk ; B 169 452 471 740 ;
C 43 ; WX 584 ; N plus ; B 92 -10 591 474 ;
C 44 ; WX 278 ; N comma ; B 55 -150 214 104 ;
C 45 ; WX 333 ; N hyphen ; B 97 240 351 313 ;
C 46 ; WX 278 ; N period ; B 87 0 213 104 ;
C 47 ; WX 278 ; N slash ; B -12 -21 434 708 ;
C 48 ; WX 556 ; N zero ; B 98 -23 598 709 ;
C 49 ; WX 556 ; N one ; B 208 0 498 709 ;
C 50 ; WX 556 ; N two ; B 34 0 620 710 ;
C 51 ; WX 556 ; N three ; B 71 -23 599 709 ;
C 52 ; WX 556 ; N four ; B 63 0 573 709 ;
C 53 ; WX 556 ; N five ; B 70 -23 629 709 ;
C 54 ; WX 556 ; N six ; B 93 -23 611 709 ;
C 55 ; WX 556 ; N seven ; B 137 0 671 709 ;
C 56 ; WX 556 ; N eight ; B 74 -23 604 709 ;
C 57 ; WX 556 ; N nine ; B 83 -23 599 709 ;
C 58 ; WX 278 ; N colon ; B 110 0 326 525 ;
C 59 ; WX 278 ; N semicolon ; B 78 -150 325 516 ;
C 60 ; WX 584 ; N less ; B 87 -10 635 474 ;
C 61 ; WX 584 ; N equal ; B 74 112 609 352 ;
C 62 ; WX 584 ; N greater ; B 48 -10 596 474 ;
C 63 ; WX 556 ; N question ; B 184 0 630 738 ;
C 64 ; WX 1015 ; N at ; B 80 -146 1036 737 ;
C 65 ; WX 667 ; N A ; B 17 0 653 729 ;
C 66 ; WX 667 ; N B ; B 79 0 711 729 ;
C 67 ; WX 722 ; N C ; B 112 -23 770 741 ;
C 68 ; WX 722 ; N D ; B 89 0 759 729 ;
C 69 ; WX 667 ; N E ; B 90 0 751 729 ;
C 70 ; WX 611 ; N F ; B 90 0 734 729 ;
C 71 ; WX 778 ; N G ; B 109 -23 809 741 ;
C 72 ; WX 722 ; N H ; B 83 0 799 729 ;
C 73 ; WX 278 ; N I ; B 100 0 349 729 ;
C 74 ; WX 500 ; N J ; B 47 -26 581 729 ;
C 75 ; WX 667 ; N K ; B 79 0 813 729 ;
C 76 ; WX 556 ; N L ; B 80 0 551 729 ;
C 77 ; WX 833 ; N M ; B 75 0 916 729 ;
C 78 ; WX 722 ; N N ; B 76 0 801 729 ;
C 79 ; WX 778 ; N O ; B 104 -23 828 741 ;
C 80 ; WX 667 ; N P ; B 91 0 733 730 ;
C 81 ; WX 778 ; N Q ; B 104 -59 828 741 ;
C 82 ; WX 722 ; N R ; B 93 0 770 729 ;
C 83 ; WX 667 ; N S ; B 89 -23 714 741 ;
C 84 ; WX 611 ; N T ; B 158 0 748 729 ;
C 85 ; WX 722 ; N U ; B 124 -23 800 729 ;
C 86 ; WX 667 ; N V ; B 185 0 800 729 ;
C 87 ; WX 944 ; N W ; B 177 0 1084 729 ;
C 88 ; WX 667 ; N X ; B 22 0 794 729 ;
C 89 ; WX 667 ; N Y ; B 168 0 816 729 ;
C 90 ; WX 611 ; N Z ; B 28 0 737 729 ;
C 91 ; WX 278 ; N bracketleft ; B 19 -214 405 729 ;
C 92 ; WX 278 ; N backslash ; B 147 -20 280 729 ;
C 93 ; WX 278 ; N bracketright ; B -23 -215 364 729 ;
C 94 ; WX 469 ; N asciicircum ; B 115 333 496 713 ;
C 95 ; WX 556 ; N underscore ; B -59 -175 551 -125 ;
C 96 ; WX 222 ; N quoteleft ; B 163 459 308 708 ;
C 97 ; WX 556 ; N a ; B 65 -23 568 540 ;
C 98 ; WX 556 ; N b ; B 54 -23 588 729 ;
C 99 ; WX 500 ; N c ; B 76 -23 554 540 ;
C 100 ; WX 556 ; N d ; B 73 -23 650 729 ;
C 101 ; WX 556 ; N e ; B 84 -23 580 541 ;
C 102 ; WX 278 ; N f ; B 89 0 413 733 ; L i fi ; L l fl ;
C 103 ; WX 556 ; N g ; B 32 -220 601 540 ;
C 104 ; WX 556 ; N h ; B 70 0 574 729 ;
C 105 ; WX 222 ; N i ; B 66 0 305 729 ;
C 106 ; WX 222 ; N j ; B -65 -220 308 729 ;
C 107 ; WX 500 ; N k ; B 58 0 584 729 ;
C 108 ; WX 222 ; N l ; B 68 0 307 729 ;
C 109 ; WX 833 ; N m ; B 71 0 852 540 ;
C 110 ; WX 556 ; N n ; B 70 0 574 540 ;
C 111 ; WX 556 ; N o ; B 80 -23 576 540 ;
C 112 ; WX 556 ; N p ; B 7 -219 586 540 ;
C 113 ; WX 556 ; N q ; B 71 -219 607 540 ;
C 114 ; WX 333 ; N r ; B 69 0 436 540 ;
C 115 ; WX 500 ; N s ; B 61 -24 520 540 ;
C 116 ; WX 278 ; N t ; B 97 -24 366 667 ;
C 117 ; WX 556 ; N u ; B 88 -23 594 525 ;
C 118 ; WX 500 ; N v ; B 122 0 598 525 ;
C 119 ; WX 722 ; N w ; B 118 0 820 525 ;
C 120 ; WX 500 ; N x ; B 17 0 583 525 ;
C 121 ; WX 500 ; N y ; B 8 -219 590 525 ;
C 122 ; WX 500 ; N z ; B 31 0 557 525 ;
C 123 ; WX 334 ; N braceleft ; B 91 -214 431 731 ;
C 124 ; WX 260 ; N bar ; B 54 -215 315 729 ;
C 125 ; WX 334 ; N braceright ; B -16 -214 324 731 ;
C 126 ; WX 584 ; N asciitilde ; B 137 267 594 438 ;
C 161 ; WX 333 ; N exclamdown ; B 76 -214 317 525 ;
C 162 ; WX 556 ; N cent ; B 96 -120 585 628 ;
C 163 ; WX 556 ; N sterling ; B 44 -21 628 726 ;
C 164 ; WX 167 ; N fraction ; B -178 -21 486 708 ;
C 165 ; WX 556 ; N yen ; B 100 0 696 710 ;
C 166 ; WX 556 ; N florin ; B -32 -214 696 742 ;
C 167 ; WX 556 ; N section ; B 63 -215 589 729 ;
C 168 ; WX 556 ; N currency ; B 110 126 593 554 ;
C 169 ; WX 191 ; N quotesingle ; B 173 462 292 708 ;
C 170 ; WX 333 ; N quotedblleft ; B 146 459 449 708 ;
C 171 ; WX 556 ; N guillemotleft ; B 147 106 548 438 ;
C 172 ; WX 333 ; N guilsinglleft ; B 140 112 336 436 ;
C 173 ; WX 333 ; N guilsinglright ; B 109 112 307 436 ;
C 174 ; WX 500 ; N fi ; B 83 0 591 733 ;
C 175 ; WX 500 ; N fl ; B 88 0 585 733 ;
C 177 ; WX 556 ; N endash ; B 46 240 628 313 ;
C 178 ; WX 556 ; N dagger ; B 127 -178 620 710 ;
C 179 ; WX 556 ; N daggerdbl ; B 51 -178 620 710 ;
C 180 ; WX 278 ; N periodcentered ; B 166 318 293 442 ;
C 182 ; WX 537 ; N paragraph ; B 145 -178 677 729 ;
C 183 ; WX 350 ; N bullet ; B 120 220 376 470 ;
C 184 ; WX 222 ; N quotesinglbase ; B 37 -129 180 103 ;
C 185 ; WX 333 ; N quotedblbase ; B 20 -129 322 103 ;
C 186 ; WX 333 ; N quotedblright ; B 150 476 452 708 ;
C 187 ; WX 556 ; N guillemotright ; B 121 106 518 438 ;
C 188 ; WX 1000 ; N ellipsis ; B 115 0 907 104 ;
C 189 ; WX 1000 ; N perthousand ; B 93 -20 1024 740 ;
C 191 ; WX 611 ; N questiondown ; B 86 -213 531 525 ;
C 193 ; WX 333 ; N grave ; B 179 592 357 740 ;
C 194 ; WX 333 ; N acute ; B 218 592 458 740 ;
C 195 ; WX 333 ; N circumflex ; B 146 591 433 741 ;
C 196 ; WX 333 ; N tilde ; B 130 589 471 716 ;
C 197 ; WX 333 ; N macron ; B 160 621 450 694 ;
C 198 ; WX 333 ; N breve ; B 165 594 471 729 ;
C 199 ; WX 333 ; N dotaccent ; B 244 605 370 709 ;
C 200 ; WX 333 ; N dieresis ; B 159 605 446 708 ;
C 202 ; WX 333 ; N ring ; B 216 566 396 741 ;
C 203 ; WX 333 ; N cedilla ; B 1 -214 264 0 ;
C 205 ; WX 333 ; N hungarumlaut ; B 91 592 505 740 ;
C 206 ; WX 333 ; N ogonek ; B 35 -189 246 15 ;
C 207 ; WX 333 ; N caron ; B 176 590 463 740 ;
C 208 ; WX 1000 ; N emdash ; B 42 240 1068 313 ;
C 225 ; WX 1000 ; N AE ; B 11 0 1087 729 ;
C 227 ; WX 370 ; N ordfeminine ; B 107 301 441 740 ;
C 232 ; WX 556 ; N Lslash ; B 61 0 570 729 ;
C 233 ; WX 778 ; N Oslash ; B 32 -23 867 742 ;
C 234 ; WX 1000 ; N OE ; B 101 -20 1108 739 ;
C 235 ; WX 365 ; N ordmasculine ; B 114 301 452 741 ;
C 241 ; WX 889 ; N ae ; B 59 -20 915 546 ;
C 245 ; WX 278 ; N dotlessi ; B 94 0 290 525 ;
C 248 ; WX 222 ; N lslash ; B 62 0 312 729 ;
C 249 ; WX 611 ; N oslash ; B 19 -27 639 548 ;
C 250 ; WX 944 ; N oe ; B 85 -22 966 540 ;
C 251 ; WX 611 ; N germandbls ; B 126 -20 655 729 ;
C -1 ; WX 667 ; N Aacute ; B 17 0 667 939 ;
C -1 ; WX 667 ; N Acircumflex ; B 17 0 653 940 ;
C -1 ; WX 667 ; N Adieresis ; B 17 0 655 907 ;
C -1 ; WX 667 ; N Agrave ; B 17 0 653 939 ;
C -1 ; WX 667 ; N Aring ; B 17 0 653 940 ;
C -1 ; WX 667 ; N Atilde ; B 17 0 680 915 ;
C -1 ; WX 722 ; N Ccedilla ; B 112 -214 770 741 ;
C -1 ; WX 667 ; N Eacute ; B 90 0 751 939 ;
C -1 ; WX 667 ; N Ecircumflex ; B 90 0 751 940 ;
C -1 ; WX 667 ; N Edieresis ; B 90 0 751 907 ;
C -1 ; WX 667 ; N Egrave ; B 90 0 751 939 ;
C -1 ; WX 722 ; N Eth ; B 73 0 759 729 ;
C -1 ; WX 278 ; N Iacute ; B 100 0 479 939 ;
C -1 ; WX 278 ; N Icircumflex ; B 100 0 454 940 ;
C -1 ; WX 278 ; N Idieresis ; B 100 0 467 907 ;
C -1 ; WX 278 ; N Igrave ; B 100 0 378 939 ;
C -1 ; WX 722 ; N Ntilde ; B 76 0 801 915 ;
C -1 ; WX 778 ; N Oacute ; B 104 -23 828 939 ;
C -1 ; WX 778 ; N Ocircumflex ; B 104 -23 828 940 ;
C -1 ; WX 778 ; N Odieresis ; B 104 -23 828 907 ;
C -1 ; WX 778 ; N Ograve ; B 104 -23 828 939 ;
C -1 ; WX 778 ; N Otilde ; B 104 -23 828 915 ;
C -1 ; WX 667 ; N Scaron ; B 89 -23 714 939 ;
C -1 ; WX 667 ; N Thorn ; B 91 0 707 729 ;
C -1 ; WX 722 ; N Uacute ; B 124 -23 800 939 ;
C -1 ; WX 722 ; N Ucircumflex ; B 124 -23 800 940 ;
C -1 ; WX 722 ; N Udieresis ; B 124 -23 800 907 ;
C -1 ; WX 722 ; N Ugrave ; B 124 -23 800 939 ;
C -1 ; WX 667 ; N Yacute ; B 168 0 816 944 ;
C -1 ; WX 667 ; N Ydieresis ; B 168 0 816 907 ;
C -1 ; WX 611 ; N Zcaron ; B 28 0 737 939 ;
C -1 ; WX 556 ; N aacute ; B 65 -23 570 740 ;
C -1 ; WX 556 ; N acircumflex ; B 65 -23 568 741 ;
C -1 ; WX 556 ; N adieresis ; B 65 -23 568 708 ;
C -1 ; WX 556 ; N agrave ; B 65 -23 568 740 ;
C -1 ; WX 556 ; N aring ; B 65 -23 568 741 ;
C -1 ; WX 556 ; N atilde ; B 65 -23 583 716 ;
C -1 ; WX 260 ; N brokenbar ; B 54 -215 315 729 ;
C -1 ; WX 500 ; N ccedilla ; B 76 -214 554 540 ;
C -1 ; WX 737 ; N copyright ; B 55 -23 836 741 ;
C -1 ; WX 400 ; N degree ; B 165 409 472 709 ;
C -1 ; WX 584 ; N divide ; B 92 -10 591 474 ;
C -1 ; WX 556 ; N eacute ; B 84 -23 580 740 ;
C -1 ; WX 556 ; N ecircumflex ; B 84 -23 580 741 ;
C -1 ; WX 556 ; N edieresis ; B 84 -23 580 708 ;
C -1 ; WX 556 ; N egrave ; B 84 -23 580 740 ;
C -1 ; WX 556 ; N eth ; B 80 -23 572 729 ;
C -1 ; WX 278 ; N iacute ; B 94 0 431 740 ;
C -1 ; WX 278 ; N icircumflex ; B 94 0 406 741 ;
C -1 ; WX 278 ; N idieresis ; B 94 0 419 708 ;
C -1 ; WX 278 ; N igrave ; B 94 0 330 740 ;
C -1 ; WX 584 ; N logicalnot ; B 99 82 619 352 ;
C -1 ; WX 584 ; N minus ; B 81 194 601 270 ;
C -1 ; WX 556 ; N mu ; B 18 -219 594 525 ;
C -1 ; WX 584 ; N multiply ; B 59 -10 625 476 ;
C -1 ; WX 556 ; N ntilde ; B 70 0 589 716 ;
C -1 ; WX 556 ; N oacute ; B 80 -23 576 740 ;
C -1 ; WX 556 ; N ocircumflex ; B 80 -23 576 741 ;
C -1 ; WX 556 ; N odieresis ; B 80 -23 576 708 ;
C -1 ; WX 556 ; N ograve ; B 80 -23 576 740 ;
C -1 ; WX 834 ; N onehalf ; B 116 -21 869 709 ;
C -1 ; WX 834 ; N onequarter ; B 147 -21 836 709 ;
C -1 ; WX 333 ; N onesuperior ; B 184 284 370 709 ;
C -1 ; WX 556 ; N otilde ; B 80 -23 583 716 ;
C -1 ; WX 584 ; N plusminus ; B 40 0 621 618 ;
C -1 ; WX 737 ; N registered ; B 55 -23 836 741 ;
C -1 ; WX 500 ; N scaron ; B 61 -24 547 740 ;
C -1 ; WX 556 ; N thorn ; B 7 -219 588 729 ;
C -1 ; WX 834 ; N threequarters ; B 114 -21 868 709 ;
C -1 ; WX 333 ; N threesuperior ; B 96 270 435 709 ;
C -1 ; WX 1000 ; N trademark ; B 208 320 1096 741 ;
C -1 ; WX 333 ; N twosuperior ; B 71 284 447 710 ;
C -1 ; WX 556 ; N uacute ; B 88 -23 594 740 ;
C -1 ; WX 556 ; N ucircumflex ; B 88 -23 594 741 ;
C -1 ; WX 556 ; N udieresis ; B 88 -23 594 708 ;
C -1 ; WX 556 ; N ugrave ; B 88 -23 594 740 ;
C -1 ; WX 500 ; N yacute ; B 8 -219 590 740 ;
C -1 ; WX 500 ; N ydieresis ; B 8 -219 590 708 ;
C -1 ; WX 500 ; N zcaron ; B 31 0 557 740 ;
EndCharMetrics
StartKernData
StartKernPairs 98
KPX A y -9
KPX A w -18
KPX A v -18
KPX A space -37
KPX A quoteright -37
KPX A Y -74
KPX A W -18
KPX A V -55
KPX A T -74
KPX F space -18
KPX F period -129
KPX F comma -129
KPX F A -74
KPX L y -18
KPX L space -18
KPX L quoteright -55
KPX L Y -92
KPX L W -37
KPX L V -55
KPX L T -74
KPX P space -37
KPX P period -129
KPX P comma -129
KPX P A -74
KPX R Y -37
KPX R W -18
KPX R V -18
KPX R T -18
KPX T y -74
KPX T w -74
KPX T u -74
KPX T semicolon -74
KPX T s -92
KPX T r -74
KPX T period -92
KPX T o -92
KPX T i -9
KPX T hyphen -92
KPX T e -92
KPX T comma -92
KPX T colon -74
KPX T c -92
KPX T a -92
KPX T O -18
KPX T A -74
KPX V y -18
KPX V u -18
KPX V semicolon -18
KPX V r -18
KPX V period -74
KPX V o -37
KPX V i -18
KPX V hyphen -37
KPX V e -37
KPX V comma -74
KPX V colon -18
KPX V a -37
KPX V A -55
KPX W period -37
KPX W i -9
KPX W hyphen -18
KPX W e -18
KPX W comma -37
KPX W a -18
KPX W A -18
KPX Y v -37
KPX Y u -37
KPX Y space -18
KPX Y semicolon -37
KPX Y q -55
KPX Y period -92
KPX Y p -55
KPX Y o -55
KPX Y i -18
KPX Y hyphen -74
KPX Y e -55
KPX Y comma -92
KPX Y colon -37
KPX Y a -74
KPX Y A -55
KPX f quoteright 37
KPX one one -74
KPX quoteleft quoteleft -37
KPX quoteright space -55
KPX quoteright s -18
KPX quoteright quoteright -37
KPX r quoteright 37
KPX r period -37
KPX r hyphen -18
KPX r comma -55
KPX space Y -18
KPX space A -37
KPX v period -74
KPX v comma -74
KPX w period -55
KPX w comma -55
KPX y period -74
KPX y comma -74
EndKernPairs
EndKernData
StartComposites 58
CC Zcaron 2 ; PCC Z 0 0 ; PCC caron 139 204 ;
CC zcaron 2 ; PCC z 0 0 ; PCC caron 83 0 ;
CC Scaron 2 ; PCC S 0 0 ; PCC caron 167 204 ;
CC scaron 2 ; PCC s 0 0 ; PCC caron 83 0 ;
CC Ccedilla 2 ; PCC C 0 0 ; PCC cedilla 194 0 ;
CC ccedilla 2 ; PCC c 0 0 ; PCC cedilla 83 0 ;
CC Yacute 2 ; PCC Y 0 0 ; PCC acute 167 204 ;
CC yacute 2 ; PCC y 0 0 ; PCC acute 83 0 ;
CC Ydieresis 2 ; PCC Y 0 0 ; PCC dieresis 167 204 ;
CC ydieresis 2 ; PCC y 0 0 ; PCC dieresis 83 0 ;
CC Uacute 2 ; PCC U 0 0 ; PCC acute 194 204 ;
CC Ucircumflex 2 ; PCC U 0 0 ; PCC circumflex 194 204 ;
CC Udieresis 2 ; PCC U 0 0 ; PCC dieresis 194 204 ;
CC Ugrave 2 ; PCC U 0 0 ; PCC grave 194 204 ;
CC uacute 2 ; PCC u 0 0 ; PCC acute 111 0 ;
CC ucircumflex 2 ; PCC u 0 0 ; PCC circumflex 111 0 ;
CC udieresis 2 ; PCC u 0 0 ; PCC dieresis 111 0 ;
CC ugrave 2 ; PCC u 0 0 ; PCC grave 111 0 ;
CC Iacute 2 ; PCC I 0 0 ; PCC acute -27 204 ;
CC Icircumflex 2 ; PCC I 0 0 ; PCC circumflex -27 204 ;
CC Idieresis 2 ; PCC I 0 0 ; PCC dieresis -27 204 ;
CC Igrave 2 ; PCC I 0 0 ; PCC grave -27 204 ;
CC iacute 2 ; PCC dotlessi 0 0 ; PCC acute -27 0 ;
CC icircumflex 2 ; PCC dotlessi 0 0 ; PCC circumflex -27 0 ;
CC idieresis 2 ; PCC dotlessi 0 0 ; PCC dieresis -27 0 ;
CC igrave 2 ; PCC dotlessi 0 0 ; PCC grave -27 0 ;
CC Eacute 2 ; PCC E 0 0 ; PCC acute 167 204 ;
CC Ecircumflex 2 ; PCC E 0 0 ; PCC circumflex 167 204 ;
CC Edieresis 2 ; PCC E 0 0 ; PCC dieresis 167 204 ;
CC Egrave 2 ; PCC E 0 0 ; PCC grave 167 204 ;
CC eacute 2 ; PCC e 0 0 ; PCC acute 111 0 ;
CC ecircumflex 2 ; PCC e 0 0 ; PCC circumflex 111 0 ;
CC edieresis 2 ; PCC e 0 0 ; PCC dieresis 111 0 ;
CC egrave 2 ; PCC e 0 0 ; PCC grave 111 0 ;
CC Aacute 2 ; PCC A 0 0 ; PCC acute 167 204 ;
CC Acircumflex 2 ; PCC A 0 0 ; PCC circumflex 167 204 ;
CC Adieresis 2 ; PCC A 0 0 ; PCC dieresis 167 204 ;
CC Agrave 2 ; PCC A 0 0 ; PCC grave 167 204 ;
CC aacute 2 ; PCC a 0 0 ; PCC acute 111 0 ;
CC acircumflex 2 ; PCC a 0 0 ; PCC circumflex 111 0 ;
CC adieresis 2 ; PCC a 0 0 ; PCC dieresis 111 0 ;
CC agrave 2 ; PCC a 0 0 ; PCC grave 111 0 ;
CC Oacute 2 ; PCC O 0 0 ; PCC acute 222 204 ;
CC Ocircumflex 2 ; PCC O 0 0 ; PCC circumflex 222 204 ;
CC Odieresis 2 ; PCC O 0 0 ; PCC dieresis 222 204 ;
CC Ograve 2 ; PCC O 0 0 ; PCC grave 222 204 ;
CC oacute 2 ; PCC o 0 0 ; PCC acute 111 0 ;
CC ocircumflex 2 ; PCC o 0 0 ; PCC circumflex 111 0 ;
CC odieresis 2 ; PCC o 0 0 ; PCC dieresis 111 0 ;
CC ograve 2 ; PCC o 0 0 ; PCC grave 111 0 ;
CC Atilde 2 ; PCC A 0 0 ; PCC tilde 167 204 ;
CC atilde 2 ; PCC a 0 0 ; PCC tilde 111 0 ;
CC Ntilde 2 ; PCC N 0 0 ; PCC tilde 194 204 ;
CC ntilde 2 ; PCC n 0 0 ; PCC tilde 111 0 ;
CC Otilde 2 ; PCC O 0 0 ; PCC tilde 222 204 ;
CC otilde 2 ; PCC o 0 0 ; PCC tilde 111 0 ;
CC Aring 2 ; PCC A 0 0 ; PCC ring 167 204 ;
CC aring 2 ; PCC a 0 0 ; PCC ring 111 0 ;
EndComposites
EndFontMetrics

437
collects/afm/Helvetica.afm Normal file
View File

@ -0,0 +1,437 @@
StartFontMetrics 2.0
Comment Copyright (c) 1984 Adobe Systems Incorporated. All Rights Reserved.
Comment Creation Date:Sun Feb 8 18:48:01 PST 1987
FontName Helvetica
EncodingScheme AdobeStandardEncoding
FullName Helvetica
FamilyName Helvetica
Weight Medium
ItalicAngle 0.0
IsFixedPitch false
UnderlinePosition -97
UnderlineThickness 73
Version 001.002
Notice Helvetica is a registered trademark of Allied Corporation.
FontBBox -174 -220 1001 944
CapHeight 729
XHeight 525
Descender -219
Ascender 729
StartCharMetrics 228
C 32 ; WX 278 ; N space ; B 0 0 0 0 ;
C 33 ; WX 278 ; N exclam ; B 124 0 208 729 ;
C 34 ; WX 355 ; N quotedbl ; B 52 462 305 708 ;
C 35 ; WX 556 ; N numbersign ; B 14 -20 542 698 ;
C 36 ; WX 556 ; N dollar ; B 33 -125 518 770 ;
C 37 ; WX 889 ; N percent ; B 29 -20 859 708 ;
C 38 ; WX 667 ; N ampersand ; B 52 -23 637 710 ;
C 39 ; WX 222 ; N quoteright ; B 64 476 158 708 ;
C 40 ; WX 333 ; N parenleft ; B 73 -213 291 729 ;
C 41 ; WX 333 ; N parenright ; B 38 -213 256 729 ;
C 42 ; WX 389 ; N asterisk ; B 40 452 343 740 ;
C 43 ; WX 584 ; N plus ; B 50 -10 534 474 ;
C 44 ; WX 278 ; N comma ; B 87 -150 192 104 ;
C 45 ; WX 333 ; N hyphen ; B 46 240 284 313 ;
C 46 ; WX 278 ; N period ; B 87 0 191 104 ;
C 47 ; WX 278 ; N slash ; B -8 -21 284 708 ;
C 48 ; WX 556 ; N zero ; B 43 -23 507 709 ;
C 49 ; WX 556 ; N one ; B 102 0 347 709 ;
C 50 ; WX 556 ; N two ; B 34 0 511 710 ;
C 51 ; WX 556 ; N three ; B 32 -23 506 709 ;
C 52 ; WX 556 ; N four ; B 28 0 520 709 ;
C 53 ; WX 556 ; N five ; B 35 -23 513 709 ;
C 54 ; WX 556 ; N six ; B 43 -23 513 709 ;
C 55 ; WX 556 ; N seven ; B 46 0 520 709 ;
C 56 ; WX 556 ; N eight ; B 37 -23 513 709 ;
C 57 ; WX 556 ; N nine ; B 38 -23 509 709 ;
C 58 ; WX 278 ; N colon ; B 110 0 214 525 ;
C 59 ; WX 278 ; N semicolon ; B 110 -150 215 516 ;
C 60 ; WX 584 ; N less ; B 45 -10 534 474 ;
C 61 ; WX 584 ; N equal ; B 50 112 534 352 ;
C 62 ; WX 584 ; N greater ; B 50 -10 539 474 ;
C 63 ; WX 556 ; N question ; B 77 0 509 738 ;
C 64 ; WX 1015 ; N at ; B 34 -146 951 737 ;
C 65 ; WX 667 ; N A ; B 17 0 653 729 ;
C 66 ; WX 667 ; N B ; B 79 0 623 729 ;
C 67 ; WX 722 ; N C ; B 48 -23 677 741 ;
C 68 ; WX 722 ; N D ; B 89 0 667 729 ;
C 69 ; WX 667 ; N E ; B 90 0 613 729 ;
C 70 ; WX 611 ; N F ; B 90 0 579 729 ;
C 71 ; WX 778 ; N G ; B 44 -23 709 741 ;
C 72 ; WX 722 ; N H ; B 83 0 644 729 ;
C 73 ; WX 278 ; N I ; B 100 0 194 729 ;
C 74 ; WX 500 ; N J ; B 17 -26 426 729 ;
C 75 ; WX 667 ; N K ; B 79 0 658 729 ;
C 76 ; WX 556 ; N L ; B 80 0 533 729 ;
C 77 ; WX 833 ; N M ; B 75 0 761 729 ;
C 78 ; WX 722 ; N N ; B 76 0 646 729 ;
C 79 ; WX 778 ; N O ; B 38 -23 742 741 ;
C 80 ; WX 667 ; N P ; B 91 0 617 730 ;
C 81 ; WX 778 ; N Q ; B 38 -59 742 741 ;
C 82 ; WX 722 ; N R ; B 93 0 679 729 ;
C 83 ; WX 667 ; N S ; B 48 -23 621 741 ;
C 84 ; WX 611 ; N T ; B 21 0 593 729 ;
C 85 ; WX 722 ; N U ; B 85 -23 645 729 ;
C 86 ; WX 667 ; N V ; B 30 0 645 729 ;
C 87 ; WX 944 ; N W ; B 22 0 929 729 ;
C 88 ; WX 667 ; N X ; B 22 0 649 729 ;
C 89 ; WX 667 ; N Y ; B 13 0 661 729 ;
C 90 ; WX 611 ; N Z ; B 28 0 583 729 ;
C 91 ; WX 278 ; N bracketleft ; B 64 -214 250 729 ;
C 92 ; WX 278 ; N backslash ; B -8 -20 284 729 ;
C 93 ; WX 278 ; N bracketright ; B 23 -215 209 729 ;
C 94 ; WX 469 ; N asciicircum ; B 44 333 425 713 ;
C 95 ; WX 556 ; N underscore ; B -22 -175 578 -125 ;
C 96 ; WX 222 ; N quoteleft ; B 65 459 158 708 ;
C 97 ; WX 556 ; N a ; B 42 -23 535 540 ;
C 98 ; WX 556 ; N b ; B 54 -23 523 729 ;
C 99 ; WX 500 ; N c ; B 31 -23 477 540 ;
C 100 ; WX 556 ; N d ; B 26 -23 495 729 ;
C 101 ; WX 556 ; N e ; B 40 -23 513 541 ;
C 102 ; WX 278 ; N f ; B 18 0 258 733 ; L i fi ; L l fl ;
C 103 ; WX 556 ; N g ; B 29 -220 489 540 ;
C 104 ; WX 556 ; N h ; B 70 0 486 729 ;
C 105 ; WX 222 ; N i ; B 66 0 150 729 ;
C 106 ; WX 222 ; N j ; B -18 -220 153 729 ;
C 107 ; WX 500 ; N k ; B 58 0 502 729 ;
C 108 ; WX 222 ; N l ; B 68 0 152 729 ;
C 109 ; WX 833 ; N m ; B 71 0 763 540 ;
C 110 ; WX 556 ; N n ; B 70 0 487 540 ;
C 111 ; WX 556 ; N o ; B 36 -23 510 540 ;
C 112 ; WX 556 ; N p ; B 54 -219 523 540 ;
C 113 ; WX 556 ; N q ; B 26 -219 495 540 ;
C 114 ; WX 333 ; N r ; B 69 0 321 540 ;
C 115 ; WX 500 ; N s ; B 34 -24 459 540 ;
C 116 ; WX 278 ; N t ; B 14 -24 254 667 ;
C 117 ; WX 556 ; N u ; B 65 -23 482 525 ;
C 118 ; WX 500 ; N v ; B 10 0 486 525 ;
C 119 ; WX 722 ; N w ; B 6 0 708 525 ;
C 120 ; WX 500 ; N x ; B 17 0 473 525 ;
C 121 ; WX 500 ; N y ; B 20 -219 478 525 ;
C 122 ; WX 500 ; N z ; B 31 0 457 525 ;
C 123 ; WX 334 ; N braceleft ; B 43 -214 276 731 ;
C 124 ; WX 260 ; N bar ; B 100 -215 160 729 ;
C 125 ; WX 334 ; N braceright ; B 29 -214 262 731 ;
C 126 ; WX 584 ; N asciitilde ; B 75 267 508 438 ;
C 161 ; WX 333 ; N exclamdown ; B 121 -214 205 525 ;
C 162 ; WX 556 ; N cent ; B 52 -120 510 628 ;
C 163 ; WX 556 ; N sterling ; B 26 -21 535 726 ;
C 164 ; WX 167 ; N fraction ; B -174 -21 336 708 ;
C 165 ; WX 556 ; N yen ; B 11 0 545 710 ;
C 166 ; WX 556 ; N florin ; B 11 -214 542 742 ;
C 167 ; WX 556 ; N section ; B 44 -215 506 729 ;
C 168 ; WX 556 ; N currency ; B 67 126 489 554 ;
C 169 ; WX 191 ; N quotesingle ; B 48 462 142 708 ;
C 170 ; WX 333 ; N quotedblleft ; B 48 459 299 708 ;
C 171 ; WX 556 ; N guillemotleft ; B 98 106 455 438 ;
C 172 ; WX 333 ; N guilsinglleft ; B 91 112 243 436 ;
C 173 ; WX 333 ; N guilsinglright ; B 85 112 239 436 ;
C 174 ; WX 500 ; N fi ; B 12 0 436 733 ;
C 175 ; WX 500 ; N fl ; B 17 0 430 733 ;
C 177 ; WX 556 ; N endash ; B -5 240 561 313 ;
C 178 ; WX 556 ; N dagger ; B 38 -178 513 710 ;
C 179 ; WX 556 ; N daggerdbl ; B 38 -178 513 710 ;
C 180 ; WX 278 ; N periodcentered ; B 87 318 211 442 ;
C 182 ; WX 537 ; N paragraph ; B 48 -178 522 729 ;
C 183 ; WX 350 ; N bullet ; B 50 220 300 470 ;
C 184 ; WX 222 ; N quotesinglbase ; B 64 -129 158 103 ;
C 185 ; WX 333 ; N quotedblbase ; B 47 -129 300 103 ;
C 186 ; WX 333 ; N quotedblright ; B 49 476 302 708 ;
C 187 ; WX 556 ; N guillemotright ; B 98 106 451 438 ;
C 188 ; WX 1000 ; N ellipsis ; B 115 0 885 104 ;
C 189 ; WX 1000 ; N perthousand ; B 9 -20 993 740 ;
C 191 ; WX 611 ; N questiondown ; B 95 -213 528 525 ;
C 193 ; WX 333 ; N grave ; B 22 592 231 740 ;
C 194 ; WX 333 ; N acute ; B 92 592 301 740 ;
C 195 ; WX 333 ; N circumflex ; B 20 591 307 741 ;
C 196 ; WX 333 ; N tilde ; B 5 589 319 716 ;
C 197 ; WX 333 ; N macron ; B 28 621 302 694 ;
C 198 ; WX 333 ; N breve ; B 15 594 316 729 ;
C 199 ; WX 333 ; N dotaccent ; B 115 605 219 709 ;
C 200 ; WX 333 ; N dieresis ; B 30 605 296 708 ;
C 202 ; WX 333 ; N ring ; B 79 566 255 741 ;
C 203 ; WX 333 ; N cedilla ; B 39 -214 287 0 ;
C 205 ; WX 333 ; N hungarumlaut ; B -35 592 348 740 ;
C 206 ; WX 333 ; N ogonek ; B 57 -189 265 15 ;
C 207 ; WX 333 ; N caron ; B 19 590 306 740 ;
C 208 ; WX 1000 ; N emdash ; B -9 240 1001 313 ;
C 225 ; WX 1000 ; N AE ; B 11 0 950 729 ;
C 227 ; WX 370 ; N ordfeminine ; B 37 301 333 740 ;
C 232 ; WX 556 ; N Lslash ; B 0 0 552 729 ;
C 233 ; WX 778 ; N Oslash ; B 30 -23 744 742 ;
C 234 ; WX 1000 ; N OE ; B 43 -20 959 739 ;
C 235 ; WX 365 ; N ordmasculine ; B 40 301 324 741 ;
C 241 ; WX 889 ; N ae ; B 34 -20 845 546 ;
C 245 ; WX 278 ; N dotlessi ; B 94 0 178 525 ;
C 248 ; WX 222 ; N lslash ; B 0 0 212 729 ;
C 249 ; WX 611 ; N oslash ; B 18 -27 529 548 ;
C 250 ; WX 944 ; N oe ; B 40 -22 899 540 ;
C 251 ; WX 611 ; N germandbls ; B 126 -20 566 729 ;
C -1 ; WX 667 ; N Aacute ; B 17 0 653 939 ;
C -1 ; WX 667 ; N Acircumflex ; B 17 0 653 940 ;
C -1 ; WX 667 ; N Adieresis ; B 17 0 653 907 ;
C -1 ; WX 667 ; N Agrave ; B 17 0 653 939 ;
C -1 ; WX 667 ; N Aring ; B 17 0 653 940 ;
C -1 ; WX 667 ; N Atilde ; B 17 0 653 915 ;
C -1 ; WX 722 ; N Ccedilla ; B 48 -214 677 741 ;
C -1 ; WX 667 ; N Eacute ; B 90 0 613 939 ;
C -1 ; WX 667 ; N Ecircumflex ; B 90 0 613 940 ;
C -1 ; WX 667 ; N Edieresis ; B 90 0 613 907 ;
C -1 ; WX 667 ; N Egrave ; B 90 0 613 939 ;
C -1 ; WX 722 ; N Eth ; B 0 0 667 729 ;
C -1 ; WX 278 ; N Iacute ; B 71 0 280 939 ;
C -1 ; WX 278 ; N Icircumflex ; B -1 0 286 940 ;
C -1 ; WX 278 ; N Idieresis ; B 9 0 275 907 ;
C -1 ; WX 278 ; N Igrave ; B 1 0 210 939 ;
C -1 ; WX 722 ; N Ntilde ; B 76 0 646 915 ;
C -1 ; WX 778 ; N Oacute ; B 38 -23 742 939 ;
C -1 ; WX 778 ; N Ocircumflex ; B 38 -23 742 940 ;
C -1 ; WX 778 ; N Odieresis ; B 38 -23 742 907 ;
C -1 ; WX 778 ; N Ograve ; B 38 -23 742 939 ;
C -1 ; WX 778 ; N Otilde ; B 38 -23 742 915 ;
C -1 ; WX 667 ; N Scaron ; B 48 -23 621 939 ;
C -1 ; WX 667 ; N Thorn ; B 91 0 617 729 ;
C -1 ; WX 722 ; N Uacute ; B 85 -23 645 939 ;
C -1 ; WX 722 ; N Ucircumflex ; B 85 -23 645 940 ;
C -1 ; WX 722 ; N Udieresis ; B 85 -23 645 907 ;
C -1 ; WX 722 ; N Ugrave ; B 85 -23 645 939 ;
C -1 ; WX 667 ; N Yacute ; B 13 0 661 944 ;
C -1 ; WX 667 ; N Ydieresis ; B 13 0 661 907 ;
C -1 ; WX 611 ; N Zcaron ; B 28 0 583 939 ;
C -1 ; WX 556 ; N aacute ; B 42 -23 535 740 ;
C -1 ; WX 556 ; N acircumflex ; B 42 -23 535 741 ;
C -1 ; WX 556 ; N adieresis ; B 42 -23 535 708 ;
C -1 ; WX 556 ; N agrave ; B 42 -23 535 740 ;
C -1 ; WX 556 ; N aring ; B 42 -23 535 741 ;
C -1 ; WX 556 ; N atilde ; B 42 -23 535 716 ;
C -1 ; WX 260 ; N brokenbar ; B 100 -215 160 729 ;
C -1 ; WX 500 ; N ccedilla ; B 31 -214 477 540 ;
C -1 ; WX 737 ; N copyright ; B -13 -23 751 741 ;
C -1 ; WX 400 ; N degree ; B 50 409 350 709 ;
C -1 ; WX 584 ; N divide ; B 50 -10 534 474 ;
C -1 ; WX 556 ; N eacute ; B 40 -23 513 740 ;
C -1 ; WX 556 ; N ecircumflex ; B 40 -23 513 741 ;
C -1 ; WX 556 ; N edieresis ; B 40 -23 513 708 ;
C -1 ; WX 556 ; N egrave ; B 40 -23 513 740 ;
C -1 ; WX 556 ; N eth ; B 36 -23 510 729 ;
C -1 ; WX 278 ; N iacute ; B 65 0 274 740 ;
C -1 ; WX 278 ; N icircumflex ; B -7 0 280 741 ;
C -1 ; WX 278 ; N idieresis ; B 3 0 269 708 ;
C -1 ; WX 278 ; N igrave ; B -5 0 204 740 ;
C -1 ; WX 584 ; N logicalnot ; B 40 82 544 352 ;
C -1 ; WX 584 ; N minus ; B 40 194 544 270 ;
C -1 ; WX 556 ; N mu ; B 65 -219 482 525 ;
C -1 ; WX 584 ; N multiply ; B 50 -10 534 476 ;
C -1 ; WX 556 ; N ntilde ; B 70 0 487 716 ;
C -1 ; WX 556 ; N oacute ; B 36 -23 510 740 ;
C -1 ; WX 556 ; N ocircumflex ; B 36 -23 510 741 ;
C -1 ; WX 556 ; N odieresis ; B 36 -23 510 708 ;
C -1 ; WX 556 ; N ograve ; B 36 -23 510 740 ;
C -1 ; WX 834 ; N onehalf ; B 30 -21 804 709 ;
C -1 ; WX 834 ; N onequarter ; B 30 -21 804 709 ;
C -1 ; WX 333 ; N onesuperior ; B 60 284 219 709 ;
C -1 ; WX 556 ; N otilde ; B 36 -23 510 716 ;
C -1 ; WX 584 ; N plusminus ; B 40 0 544 618 ;
C -1 ; WX 737 ; N registered ; B -13 -23 751 741 ;
C -1 ; WX 500 ; N scaron ; B 34 -24 459 740 ;
C -1 ; WX 556 ; N thorn ; B 54 -219 523 729 ;
C -1 ; WX 834 ; N threequarters ; B 30 -21 804 709 ;
C -1 ; WX 333 ; N threesuperior ; B 12 270 320 709 ;
C -1 ; WX 1000 ; N trademark ; B 63 320 938 741 ;
C -1 ; WX 333 ; N twosuperior ; B 11 284 321 710 ;
C -1 ; WX 556 ; N uacute ; B 65 -23 482 740 ;
C -1 ; WX 556 ; N ucircumflex ; B 65 -23 482 741 ;
C -1 ; WX 556 ; N udieresis ; B 65 -23 482 708 ;
C -1 ; WX 556 ; N ugrave ; B 65 -23 482 740 ;
C -1 ; WX 500 ; N yacute ; B 20 -219 478 740 ;
C -1 ; WX 500 ; N ydieresis ; B 20 -219 478 708 ;
C -1 ; WX 500 ; N zcaron ; B 31 0 457 740 ;
EndCharMetrics
StartKernData
StartKernPairs 105
KPX A y -18
KPX A w -18
KPX A v -18
KPX A space -55
KPX A quoteright -74
KPX A Y -74
KPX A W -37
KPX A V -74
KPX A T -74
KPX F period -111
KPX F comma -111
KPX F A -55
KPX L y -37
KPX L space -37
KPX L quoteright -55
KPX L Y -74
KPX L W -74
KPX L V -74
KPX L T -74
KPX P space -18
KPX P period -129
KPX P comma -129
KPX P A -74
KPX R Y -18
KPX R W -18
KPX R V -18
KPX R T -18
KPX T y -55
KPX T w -55
KPX T u -37
KPX T space -18
KPX T semicolon -111
KPX T s -111
KPX T r -37
KPX T period -111
KPX T o -111
KPX T i -37
KPX T hyphen -55
KPX T e -111
KPX T comma -111
KPX T colon -111
KPX T c -111
KPX T a -111
KPX T O -18
KPX T A -74
KPX V y -37
KPX V u -37
KPX V semicolon -37
KPX V r -37
KPX V period -92
KPX V o -55
KPX V i -18
KPX V hyphen -55
KPX V e -55
KPX V comma -92
KPX V colon -37
KPX V a -74
KPX V A -74
KPX W y -9
KPX W u -18
KPX W semicolon -18
KPX W r -18
KPX W period -55
KPX W o -18
KPX W i 0
KPX W hyphen -18
KPX W e -18
KPX W comma -55
KPX W colon -18
KPX W a -37
KPX W A -37
KPX Y v -55
KPX Y u -55
KPX Y space -18
KPX Y semicolon -65
KPX Y q -92
KPX Y period -129
KPX Y p -74
KPX Y o -92
KPX Y i -37
KPX Y hyphen -92
KPX Y e -92
KPX Y comma -129
KPX Y colon -55
KPX Y a -74
KPX Y A -74
KPX f quoteright 18
KPX f f -18
KPX one one -74
KPX quoteleft quoteleft -18
KPX quoteright space -37
KPX quoteright s -18
KPX quoteright quoteright -18
KPX r quoteright 37
KPX r period -55
KPX r comma -55
KPX space Y -18
KPX space T -18
KPX space A -55
KPX v period -74
KPX v comma -74
KPX w period -55
KPX w comma -55
KPX y period -74
KPX y comma -74
EndKernPairs
EndKernData
StartComposites 58
CC Zcaron 2 ; PCC Z 0 0 ; PCC caron 139 199 ;
CC zcaron 2 ; PCC z 0 0 ; PCC caron 83 0 ;
CC Scaron 2 ; PCC S 0 0 ; PCC caron 167 199 ;
CC scaron 2 ; PCC s 0 0 ; PCC caron 83 0 ;
CC Ccedilla 2 ; PCC C 0 0 ; PCC cedilla 207 0 ;
CC ccedilla 2 ; PCC c 0 0 ; PCC cedilla 96 0 ;
CC Yacute 2 ; PCC Y 0 0 ; PCC acute 167 204 ;
CC yacute 2 ; PCC y 0 0 ; PCC acute 83 0 ;
CC Ydieresis 2 ; PCC Y 0 0 ; PCC dieresis 167 199 ;
CC ydieresis 2 ; PCC y 0 0 ; PCC dieresis 83 0 ;
CC Uacute 2 ; PCC U 0 0 ; PCC acute 194 199 ;
CC Ucircumflex 2 ; PCC U 0 0 ; PCC circumflex 194 199 ;
CC Udieresis 2 ; PCC U 0 0 ; PCC dieresis 194 199 ;
CC Ugrave 2 ; PCC U 0 0 ; PCC grave 194 199 ;
CC uacute 2 ; PCC u 0 0 ; PCC acute 111 0 ;
CC ucircumflex 2 ; PCC u 0 0 ; PCC circumflex 111 0 ;
CC udieresis 2 ; PCC u 0 0 ; PCC dieresis 111 0 ;
CC ugrave 2 ; PCC u 0 0 ; PCC grave 111 0 ;
CC Iacute 2 ; PCC I 0 0 ; PCC acute -21 199 ;
CC Icircumflex 2 ; PCC I 0 0 ; PCC circumflex -21 199 ;
CC Idieresis 2 ; PCC I 0 0 ; PCC dieresis -21 199 ;
CC Igrave 2 ; PCC I 0 0 ; PCC grave -21 199 ;
CC iacute 2 ; PCC dotlessi 0 0 ; PCC acute -27 0 ;
CC icircumflex 2 ; PCC dotlessi 0 0 ; PCC circumflex -27 0 ;
CC idieresis 2 ; PCC dotlessi 0 0 ; PCC dieresis -27 0 ;
CC igrave 2 ; PCC dotlessi 0 0 ; PCC grave -27 0 ;
CC Eacute 2 ; PCC E 0 0 ; PCC acute 188 199 ;
CC Ecircumflex 2 ; PCC E 0 0 ; PCC circumflex 188 199 ;
CC Edieresis 2 ; PCC E 0 0 ; PCC dieresis 188 199 ;
CC Egrave 2 ; PCC E 0 0 ; PCC grave 188 199 ;
CC eacute 2 ; PCC e 0 0 ; PCC acute 117 0 ;
CC ecircumflex 2 ; PCC e 0 0 ; PCC circumflex 117 0 ;
CC edieresis 2 ; PCC e 0 0 ; PCC dieresis 117 0 ;
CC egrave 2 ; PCC e 0 0 ; PCC grave 117 0 ;
CC Aacute 2 ; PCC A 0 0 ; PCC acute 167 199 ;
CC Acircumflex 2 ; PCC A 0 0 ; PCC circumflex 167 199 ;
CC Adieresis 2 ; PCC A 0 0 ; PCC dieresis 167 199 ;
CC Agrave 2 ; PCC A 0 0 ; PCC grave 167 199 ;
CC aacute 2 ; PCC a 0 0 ; PCC acute 111 0 ;
CC acircumflex 2 ; PCC a 0 0 ; PCC circumflex 111 0 ;
CC adieresis 2 ; PCC a 0 0 ; PCC dieresis 111 0 ;
CC agrave 2 ; PCC a 0 0 ; PCC grave 111 0 ;
CC Oacute 2 ; PCC O 0 0 ; PCC acute 222 199 ;
CC Ocircumflex 2 ; PCC O 0 0 ; PCC circumflex 222 199 ;
CC Odieresis 2 ; PCC O 0 0 ; PCC dieresis 222 199 ;
CC Ograve 2 ; PCC O 0 0 ; PCC grave 222 199 ;
CC oacute 2 ; PCC o 0 0 ; PCC acute 111 0 ;
CC ocircumflex 2 ; PCC o 0 0 ; PCC circumflex 111 0 ;
CC odieresis 2 ; PCC o 0 0 ; PCC dieresis 111 0 ;
CC ograve 2 ; PCC o 0 0 ; PCC grave 111 0 ;
CC Atilde 2 ; PCC A 0 0 ; PCC tilde 167 199 ;
CC atilde 2 ; PCC a 0 0 ; PCC tilde 111 0 ;
CC Ntilde 2 ; PCC N 0 0 ; PCC tilde 200 199 ;
CC ntilde 2 ; PCC n 0 0 ; PCC tilde 117 0 ;
CC Otilde 2 ; PCC O 0 0 ; PCC tilde 222 199 ;
CC otilde 2 ; PCC o 0 0 ; PCC tilde 111 0 ;
CC Aring 2 ; PCC A 0 0 ; PCC ring 167 199 ;
CC aring 2 ; PCC a 0 0 ; PCC ring 111 0 ;
EndComposites
EndFontMetrics

211
collects/afm/Symbol.afm Normal file
View File

@ -0,0 +1,211 @@
StartFontMetrics 2.0
Comment Matthew added a "mugreek" mapping (Nov 2004)
Comment Copyright (c) 1985, 1987, 1989, 1990 Adobe Systems Incorporated. All rights reserved.
Comment Creation Date: Wed Jan 17 21:48:26 1990
Comment UniqueID 27004
Comment VMusage 28489 37622
FontName Symbol
FullName Symbol
FamilyName Symbol
Weight Medium
ItalicAngle 0
IsFixedPitch false
FontBBox -180 -293 1090 1010
UnderlinePosition -98
UnderlineThickness 54
Version 001.007
Notice Copyright (c) 1985, 1987, 1989, 1990 Adobe Systems Incorporated. All rights reserved.
EncodingScheme FontSpecific
StartCharMetrics 189
C 32 ; WX 250 ; N space ; B 0 0 0 0 ;
C 33 ; WX 333 ; N exclam ; B 128 -17 240 672 ;
C 34 ; WX 713 ; N universal ; B 31 0 681 705 ;
C 35 ; WX 500 ; N numbersign ; B 20 -16 481 673 ;
C 36 ; WX 549 ; N existential ; B 25 0 478 707 ;
C 37 ; WX 833 ; N percent ; B 63 -36 771 655 ;
C 38 ; WX 778 ; N ampersand ; B 41 -18 750 661 ;
C 39 ; WX 439 ; N suchthat ; B 48 -17 414 500 ;
C 40 ; WX 333 ; N parenleft ; B 53 -191 300 673 ;
C 41 ; WX 333 ; N parenright ; B 30 -191 277 673 ;
C 42 ; WX 500 ; N asteriskmath ; B 65 134 427 551 ;
C 43 ; WX 549 ; N plus ; B 10 0 539 533 ;
C 44 ; WX 250 ; N comma ; B 56 -152 194 104 ;
C 45 ; WX 549 ; N minus ; B 11 233 535 288 ;
C 46 ; WX 250 ; N period ; B 69 -17 181 95 ;
C 47 ; WX 278 ; N slash ; B 0 -18 254 646 ;
C 48 ; WX 500 ; N zero ; B 23 -17 471 685 ;
C 49 ; WX 500 ; N one ; B 117 0 390 673 ;
C 50 ; WX 500 ; N two ; B 25 0 475 686 ;
C 51 ; WX 500 ; N three ; B 39 -17 435 685 ;
C 52 ; WX 500 ; N four ; B 16 0 469 685 ;
C 53 ; WX 500 ; N five ; B 29 -17 443 685 ;
C 54 ; WX 500 ; N six ; B 36 -17 467 685 ;
C 55 ; WX 500 ; N seven ; B 24 -16 448 673 ;
C 56 ; WX 500 ; N eight ; B 54 -18 440 685 ;
C 57 ; WX 500 ; N nine ; B 31 -18 460 685 ;
C 58 ; WX 278 ; N colon ; B 81 -17 193 460 ;
C 59 ; WX 278 ; N semicolon ; B 83 -152 221 460 ;
C 60 ; WX 549 ; N less ; B 26 0 523 522 ;
C 61 ; WX 549 ; N equal ; B 11 141 537 390 ;
C 62 ; WX 549 ; N greater ; B 26 0 523 522 ;
C 63 ; WX 444 ; N question ; B 70 -17 412 686 ;
C 64 ; WX 549 ; N congruent ; B 11 0 537 475 ;
C 65 ; WX 722 ; N Alpha ; B 4 0 684 673 ;
C 66 ; WX 667 ; N Beta ; B 29 0 592 673 ;
C 67 ; WX 722 ; N Chi ; B -9 0 704 673 ;
C 68 ; WX 612 ; N Delta ; B 6 0 608 688 ;
C 69 ; WX 611 ; N Epsilon ; B 32 0 617 673 ;
C 70 ; WX 763 ; N Phi ; B 26 0 741 673 ;
C 71 ; WX 603 ; N Gamma ; B 24 0 609 673 ;
C 72 ; WX 722 ; N Eta ; B 39 0 729 673 ;
C 73 ; WX 333 ; N Iota ; B 32 0 316 673 ;
C 74 ; WX 631 ; N theta1 ; B 18 -18 623 689 ;
C 75 ; WX 722 ; N Kappa ; B 35 0 722 673 ;
C 76 ; WX 686 ; N Lambda ; B 6 0 680 688 ;
C 77 ; WX 889 ; N Mu ; B 28 0 887 673 ;
C 78 ; WX 722 ; N Nu ; B 29 -8 720 673 ;
C 79 ; WX 722 ; N Omicron ; B 41 -17 715 685 ;
C 80 ; WX 768 ; N Pi ; B 25 0 745 673 ;
C 81 ; WX 741 ; N Theta ; B 41 -17 715 685 ;
C 82 ; WX 556 ; N Rho ; B 28 0 563 673 ;
C 83 ; WX 592 ; N Sigma ; B 5 0 589 673 ;
C 84 ; WX 611 ; N Tau ; B 33 0 607 673 ;
C 85 ; WX 690 ; N Upsilon ; B -8 0 694 673 ;
C 86 ; WX 439 ; N sigma1 ; B 40 -233 436 500 ;
C 87 ; WX 768 ; N Omega ; B 34 0 736 688 ;
C 88 ; WX 645 ; N Xi ; B 40 0 599 673 ;
C 89 ; WX 795 ; N Psi ; B 15 0 781 684 ;
C 90 ; WX 611 ; N Zeta ; B 44 0 636 673 ;
C 91 ; WX 333 ; N bracketleft ; B 86 -155 299 674 ;
C 92 ; WX 863 ; N therefore ; B 163 0 701 478 ;
C 93 ; WX 333 ; N bracketright ; B 33 -155 246 674 ;
C 94 ; WX 658 ; N perpendicular ; B 15 0 652 674 ;
C 95 ; WX 500 ; N underscore ; B -2 -252 502 -206 ;
C 96 ; WX 500 ; N radicalex ; B 480 881 1090 917 ;
C 97 ; WX 631 ; N alpha ; B 41 -18 622 500 ;
C 98 ; WX 549 ; N beta ; B 61 -223 515 741 ;
C 99 ; WX 549 ; N chi ; B 12 -231 522 499 ;
C 100 ; WX 494 ; N delta ; B 40 -19 481 740 ;
C 101 ; WX 439 ; N epsilon ; B 22 -19 427 502 ;
C 102 ; WX 521 ; N phi ; B 27 -224 490 671 ;
C 103 ; WX 411 ; N gamma ; B 5 -225 484 499 ;
C 104 ; WX 603 ; N eta ; B 0 -202 527 514 ;
C 105 ; WX 329 ; N iota ; B 0 -17 301 503 ;
C 106 ; WX 603 ; N phi1 ; B 36 -224 587 499 ;
C 107 ; WX 549 ; N kappa ; B 33 0 558 501 ;
C 108 ; WX 549 ; N lambda ; B 24 -17 548 739 ;
C 109 ; WX 576 ; N mu ; B 33 -223 567 500 ;
C 109 ; WX 576 ; N mugreek ; B 33 -223 567 500 ;
C 110 ; WX 521 ; N nu ; B -9 -16 475 507 ;
C 111 ; WX 549 ; N omicron ; B 35 -19 501 499 ;
C 112 ; WX 549 ; N pi ; B 10 -19 530 487 ;
C 113 ; WX 521 ; N theta ; B 43 -17 485 690 ;
C 114 ; WX 549 ; N rho ; B 50 -230 490 499 ;
C 115 ; WX 603 ; N sigma ; B 30 -21 588 500 ;
C 116 ; WX 439 ; N tau ; B 10 -19 418 500 ;
C 117 ; WX 576 ; N upsilon ; B 7 -18 535 507 ;
C 118 ; WX 713 ; N omega1 ; B 12 -18 671 583 ;
C 119 ; WX 686 ; N omega ; B 42 -17 684 500 ;
C 120 ; WX 493 ; N xi ; B 27 -224 469 766 ;
C 121 ; WX 686 ; N psi ; B 12 -228 701 500 ;
C 122 ; WX 494 ; N zeta ; B 60 -225 467 756 ;
C 123 ; WX 480 ; N braceleft ; B 58 -183 397 673 ;
C 124 ; WX 200 ; N bar ; B 65 -177 135 673 ;
C 125 ; WX 480 ; N braceright ; B 79 -183 418 673 ;
C 126 ; WX 549 ; N similar ; B 17 203 529 307 ;
C 161 ; WX 620 ; N Upsilon1 ; B -2 0 610 685 ;
C 162 ; WX 247 ; N minute ; B 27 459 228 735 ;
C 163 ; WX 549 ; N lessequal ; B 29 0 526 639 ;
C 164 ; WX 167 ; N fraction ; B -180 -12 340 677 ;
C 165 ; WX 713 ; N infinity ; B 26 124 688 404 ;
C 166 ; WX 500 ; N florin ; B 2 -193 494 686 ;
C 167 ; WX 753 ; N club ; B 86 -26 660 533 ;
C 168 ; WX 753 ; N diamond ; B 142 -36 600 550 ;
C 169 ; WX 753 ; N heart ; B 117 -33 631 532 ;
C 170 ; WX 753 ; N spade ; B 113 -36 629 548 ;
C 171 ; WX 1042 ; N arrowboth ; B 24 -15 1024 511 ;
C 172 ; WX 987 ; N arrowleft ; B 32 -15 942 511 ;
C 173 ; WX 603 ; N arrowup ; B 45 0 571 910 ;
C 174 ; WX 987 ; N arrowright ; B 49 -15 959 511 ;
C 175 ; WX 603 ; N arrowdown ; B 45 -22 571 888 ;
C 176 ; WX 400 ; N degree ; B 50 385 350 685 ;
C 177 ; WX 549 ; N plusminus ; B 10 0 539 645 ;
C 178 ; WX 411 ; N second ; B 20 459 413 737 ;
C 179 ; WX 549 ; N greaterequal ; B 29 0 526 639 ;
C 180 ; WX 549 ; N multiply ; B 17 8 533 524 ;
C 181 ; WX 713 ; N proportional ; B 27 123 639 404 ;
C 182 ; WX 494 ; N partialdiff ; B 26 -20 462 746 ;
C 183 ; WX 460 ; N bullet ; B 50 113 410 473 ;
C 184 ; WX 549 ; N divide ; B 10 71 536 456 ;
C 185 ; WX 549 ; N notequal ; B 15 -25 540 549 ;
C 186 ; WX 549 ; N equivalence ; B 14 82 538 443 ;
C 187 ; WX 549 ; N approxequal ; B 14 135 527 394 ;
C 188 ; WX 1000 ; N ellipsis ; B 111 -17 889 95 ;
C 189 ; WX 603 ; N arrowvertex ; B 280 -120 336 1010 ;
C 190 ; WX 1000 ; N arrowhorizex ; B -60 220 1050 276 ;
C 191 ; WX 658 ; N carriagereturn ; B 15 -16 602 629 ;
C 192 ; WX 823 ; N aleph ; B 175 -18 661 658 ;
C 193 ; WX 686 ; N Ifraktur ; B 10 -53 578 740 ;
C 194 ; WX 795 ; N Rfraktur ; B 26 -15 759 734 ;
C 195 ; WX 987 ; N weierstrass ; B 159 -211 870 573 ;
C 196 ; WX 768 ; N circlemultiply ; B 43 -17 733 673 ;
C 197 ; WX 768 ; N circleplus ; B 43 -15 733 675 ;
C 198 ; WX 823 ; N emptyset ; B 39 -24 781 719 ;
C 199 ; WX 768 ; N intersection ; B 40 0 732 509 ;
C 200 ; WX 768 ; N union ; B 40 -17 732 492 ;
C 201 ; WX 713 ; N propersuperset ; B 20 0 673 470 ;
C 202 ; WX 713 ; N reflexsuperset ; B 20 -125 673 470 ;
C 203 ; WX 713 ; N notsubset ; B 36 -70 690 540 ;
C 204 ; WX 713 ; N propersubset ; B 37 0 690 470 ;
C 205 ; WX 713 ; N reflexsubset ; B 37 -125 690 470 ;
C 206 ; WX 713 ; N element ; B 45 0 505 468 ;
C 207 ; WX 713 ; N notelement ; B 45 -58 505 555 ;
C 208 ; WX 768 ; N angle ; B 26 0 738 673 ;
C 209 ; WX 713 ; N gradient ; B 36 -19 681 718 ;
C 210 ; WX 790 ; N registerserif ; B 50 -17 740 673 ;
C 211 ; WX 790 ; N copyrightserif ; B 51 -15 741 675 ;
C 212 ; WX 890 ; N trademarkserif ; B 18 293 855 673 ;
C 213 ; WX 823 ; N product ; B 25 -101 803 751 ;
C 214 ; WX 549 ; N radical ; B 10 -38 515 917 ;
C 215 ; WX 250 ; N dotmath ; B 69 210 169 310 ;
C 216 ; WX 713 ; N logicalnot ; B 15 0 680 288 ;
C 217 ; WX 603 ; N logicaland ; B 23 0 583 454 ;
C 218 ; WX 603 ; N logicalor ; B 30 0 578 477 ;
C 219 ; WX 1042 ; N arrowdblboth ; B 27 -20 1023 510 ;
C 220 ; WX 987 ; N arrowdblleft ; B 30 -15 939 513 ;
C 221 ; WX 603 ; N arrowdblup ; B 39 2 567 911 ;
C 222 ; WX 987 ; N arrowdblright ; B 45 -20 954 508 ;
C 223 ; WX 603 ; N arrowdbldown ; B 44 -19 572 890 ;
C 224 ; WX 494 ; N lozenge ; B 18 0 466 745 ;
C 225 ; WX 329 ; N angleleft ; B 25 -198 306 746 ;
C 226 ; WX 790 ; N registersans ; B 50 -20 740 670 ;
C 227 ; WX 790 ; N copyrightsans ; B 49 -15 739 675 ;
C 228 ; WX 786 ; N trademarksans ; B 5 293 725 673 ;
C 229 ; WX 713 ; N summation ; B 14 -108 695 752 ;
C 230 ; WX 384 ; N parenlefttp ; B 40 -293 436 926 ;
C 231 ; WX 384 ; N parenleftex ; B 40 -85 92 925 ;
C 232 ; WX 384 ; N parenleftbt ; B 40 -293 436 926 ;
C 233 ; WX 384 ; N bracketlefttp ; B 0 -80 341 926 ;
C 234 ; WX 384 ; N bracketleftex ; B 0 -79 55 925 ;
C 235 ; WX 384 ; N bracketleftbt ; B 0 -80 340 926 ;
C 236 ; WX 494 ; N bracelefttp ; B 201 -75 439 926 ;
C 237 ; WX 494 ; N braceleftmid ; B 14 -85 255 935 ;
C 238 ; WX 494 ; N braceleftbt ; B 201 -70 439 926 ;
C 239 ; WX 494 ; N braceex ; B 201 -80 255 935 ;
C 241 ; WX 329 ; N angleright ; B 21 -198 302 746 ;
C 242 ; WX 274 ; N integral ; B 2 -107 291 916 ;
C 243 ; WX 686 ; N integraltp ; B 332 -83 715 921 ;
C 244 ; WX 686 ; N integralex ; B 332 -88 415 975 ;
C 245 ; WX 686 ; N integralbt ; B 39 -81 415 921 ;
C 246 ; WX 384 ; N parenrighttp ; B 54 -293 450 926 ;
C 247 ; WX 384 ; N parenrightex ; B 398 -85 450 925 ;
C 248 ; WX 384 ; N parenrightbt ; B 54 -293 450 926 ;
C 249 ; WX 384 ; N bracketrighttp ; B 22 -80 360 926 ;
C 250 ; WX 384 ; N bracketrightex ; B 305 -79 360 925 ;
C 251 ; WX 384 ; N bracketrightbt ; B 20 -80 360 926 ;
C 252 ; WX 494 ; N bracerighttp ; B 17 -75 255 926 ;
C 253 ; WX 494 ; N bracerightmid ; B 201 -85 442 935 ;
C 254 ; WX 494 ; N bracerightbt ; B 17 -70 255 926 ;
C -1 ; WX 790 ; N apple ; B 56 -3 733 808 ;
EndCharMetrics
EndFontMetrics

456
collects/afm/Times-Bold.afm Normal file
View File

@ -0,0 +1,456 @@
StartFontMetrics 2.0
Comment Copyright (c) 1984 Adobe Systems Incorporated. All Rights Reserved.
Comment Creation Date:Sun Feb 8 02:56:11 PST 1987
FontName Times-Bold
EncodingScheme AdobeStandardEncoding
FullName Times Bold
FamilyName Times
Weight Bold
ItalicAngle 0.0
IsFixedPitch false
UnderlinePosition -99
UnderlineThickness 95
Version 001.002
Notice Times is a trademark of Allied Corporation.
FontBBox -172 -256 1008 965
CapHeight 681
XHeight 460
Descender -210
Ascender 670
StartCharMetrics 228
C 32 ; WX 250 ; N space ; B 0 0 0 0 ;
C 33 ; WX 333 ; N exclam ; B 84 -18 248 690 ;
C 34 ; WX 555 ; N quotedbl ; B 67 371 425 690 ;
C 35 ; WX 500 ; N numbersign ; B -13 -17 514 684 ;
C 36 ; WX 500 ; N dollar ; B 28 -116 474 732 ;
C 37 ; WX 1000 ; N percent ; B 122 -11 881 692 ;
C 38 ; WX 833 ; N ampersand ; B 54 -17 773 690 ;
C 39 ; WX 333 ; N quoteright ; B 77 347 257 680 ;
C 40 ; WX 333 ; N parenleft ; B 49 -169 301 699 ;
C 41 ; WX 333 ; N parenright ; B 26 -169 278 699 ;
C 42 ; WX 500 ; N asterisk ; B 57 262 445 690 ;
C 43 ; WX 570 ; N plus ; B 50 -10 520 460 ;
C 44 ; WX 250 ; N comma ; B 37 -181 214 157 ;
C 45 ; WX 333 ; N hyphen ; B 48 170 283 285 ;
C 46 ; WX 250 ; N period ; B 43 -19 207 145 ;
C 47 ; WX 278 ; N slash ; B 1 -17 279 750 ;
C 48 ; WX 500 ; N zero ; B 26 -18 472 690 ;
C 49 ; WX 500 ; N one ; B 61 0 448 690 ;
C 50 ; WX 500 ; N two ; B 18 0 473 683 ;
C 51 ; WX 500 ; N three ; B 17 -19 463 683 ;
C 52 ; WX 500 ; N four ; B 23 0 472 681 ;
C 53 ; WX 500 ; N five ; B 23 -17 465 681 ;
C 54 ; WX 500 ; N six ; B 30 -18 470 684 ;
C 55 ; WX 500 ; N seven ; B 23 0 468 679 ;
C 56 ; WX 500 ; N eight ; B 22 -17 470 685 ;
C 57 ; WX 500 ; N nine ; B 26 -18 468 684 ;
C 58 ; WX 333 ; N colon ; B 83 -18 247 473 ;
C 59 ; WX 333 ; N semicolon ; B 85 -181 262 472 ;
C 60 ; WX 570 ; N less ; B 45 -10 520 460 ;
C 61 ; WX 570 ; N equal ; B 50 91 520 375 ;
C 62 ; WX 570 ; N greater ; B 50 -10 525 460 ;
C 63 ; WX 500 ; N question ; B 57 -17 438 681 ;
C 64 ; WX 930 ; N at ; B 50 -147 889 677 ;
C 65 ; WX 722 ; N A ; B 22 0 696 681 ;
C 66 ; WX 667 ; N B ; B 24 0 609 681 ;
C 67 ; WX 722 ; N C ; B 42 -17 669 690 ;
C 68 ; WX 722 ; N D ; B 22 0 684 681 ;
C 69 ; WX 667 ; N E ; B 21 0 637 681 ;
C 70 ; WX 611 ; N F ; B 17 0 582 681 ;
C 71 ; WX 778 ; N G ; B 41 -17 748 690 ;
C 72 ; WX 778 ; N H ; B 26 0 748 681 ;
C 73 ; WX 389 ; N I ; B 17 0 366 680 ;
C 74 ; WX 500 ; N J ; B 9 -89 475 681 ;
C 75 ; WX 778 ; N K ; B 29 0 761 681 ;
C 76 ; WX 667 ; N L ; B 21 0 633 681 ;
C 77 ; WX 944 ; N M ; B 21 0 914 681 ;
C 78 ; WX 722 ; N N ; B 20 -10 697 681 ;
C 79 ; WX 778 ; N O ; B 43 -18 733 690 ;
C 80 ; WX 611 ; N P ; B 24 0 593 681 ;
C 81 ; WX 778 ; N Q ; B 24 -182 751 690 ;
C 82 ; WX 722 ; N R ; B 26 0 695 681 ;
C 83 ; WX 556 ; N S ; B 43 -19 506 690 ;
C 84 ; WX 667 ; N T ; B 30 0 629 681 ;
C 85 ; WX 722 ; N U ; B 20 -19 700 681 ;
C 86 ; WX 722 ; N V ; B 22 -18 696 681 ;
C 87 ; WX 1000 ; N W ; B 19 -18 979 680 ;
C 88 ; WX 722 ; N X ; B 23 0 695 681 ;
C 89 ; WX 722 ; N Y ; B 19 0 697 680 ;
C 90 ; WX 667 ; N Z ; B 37 0 624 681 ;
C 91 ; WX 333 ; N bracketleft ; B 73 -142 296 674 ;
C 92 ; WX 278 ; N backslash ; B 1 -17 279 750 ;
C 93 ; WX 333 ; N bracketright ; B 38 -142 261 674 ;
C 94 ; WX 581 ; N asciicircum ; B 102 290 486 690 ;
C 95 ; WX 500 ; N underscore ; B -2 -256 502 -182 ;
C 96 ; WX 333 ; N quoteleft ; B 72 357 252 691 ;
C 97 ; WX 500 ; N a ; B 25 -19 484 472 ;
C 98 ; WX 556 ; N b ; B 29 -18 512 670 ;
C 99 ; WX 444 ; N c ; B 24 -17 423 472 ;
C 100 ; WX 556 ; N d ; B 31 -17 523 670 ;
C 101 ; WX 444 ; N e ; B 25 -18 415 474 ;
C 102 ; WX 333 ; N f ; B 20 0 386 690 ; L i fi ; L l fl ;
C 103 ; WX 500 ; N g ; B 25 -210 474 472 ;
C 104 ; WX 556 ; N h ; B 29 0 523 670 ;
C 105 ; WX 278 ; N i ; B 27 0 249 690 ;
C 106 ; WX 333 ; N j ; B -57 -212 256 690 ;
C 107 ; WX 556 ; N k ; B 24 0 528 670 ;
C 108 ; WX 278 ; N l ; B 25 0 247 670 ;
C 109 ; WX 833 ; N m ; B 28 0 804 471 ;
C 110 ; WX 556 ; N n ; B 28 0 523 473 ;
C 111 ; WX 500 ; N o ; B 25 -18 473 472 ;
C 112 ; WX 556 ; N p ; B 30 -210 513 473 ;
C 113 ; WX 556 ; N q ; B 32 -210 535 472 ;
C 114 ; WX 444 ; N r ; B 29 0 417 473 ;
C 115 ; WX 389 ; N s ; B 29 -17 359 472 ;
C 116 ; WX 333 ; N t ; B 22 -19 320 627 ;
C 117 ; WX 556 ; N u ; B 23 -17 524 460 ;
C 118 ; WX 500 ; N v ; B 20 -14 479 460 ;
C 119 ; WX 722 ; N w ; B 10 -14 709 460 ;
C 120 ; WX 500 ; N x ; B 11 0 488 460 ;
C 121 ; WX 500 ; N y ; B 19 -212 475 460 ;
C 122 ; WX 444 ; N z ; B 25 0 414 460 ;
C 123 ; WX 394 ; N braceleft ; B 44 -142 342 674 ;
C 124 ; WX 220 ; N bar ; B 77 -195 151 720 ;
C 125 ; WX 394 ; N braceright ; B 38 -142 336 674 ;
C 126 ; WX 520 ; N asciitilde ; B 19 237 493 461 ;
C 161 ; WX 333 ; N exclamdown ; B 85 -210 249 498 ;
C 162 ; WX 500 ; N cent ; B 44 -148 460 586 ;
C 163 ; WX 500 ; N sterling ; B 25 -17 471 682 ;
C 164 ; WX 167 ; N fraction ; B -172 -17 335 690 ;
C 165 ; WX 500 ; N yen ; B -20 0 521 681 ;
C 166 ; WX 500 ; N florin ; B 2 -157 496 713 ;
C 167 ; WX 500 ; N section ; B 63 -148 438 677 ;
C 168 ; WX 500 ; N currency ; B 3 105 498 604 ;
C 169 ; WX 278 ; N quotesingle ; B 69 371 205 690 ;
C 170 ; WX 500 ; N quotedblleft ; B 33 346 479 679 ;
C 171 ; WX 500 ; N guillemotleft ; B 25 44 471 436 ;
C 172 ; WX 333 ; N guilsinglleft ; B 51 44 302 436 ;
C 173 ; WX 333 ; N guilsinglright ; B 26 44 277 436 ;
C 174 ; WX 556 ; N fi ; B 24 0 532 690 ;
C 175 ; WX 556 ; N fl ; B 25 0 529 691 ;
C 177 ; WX 500 ; N endash ; B -4 179 500 270 ;
C 178 ; WX 500 ; N dagger ; B 52 -141 446 690 ;
C 179 ; WX 500 ; N daggerdbl ; B 57 -138 451 681 ;
C 180 ; WX 250 ; N periodcentered ; B 43 270 167 394 ;
C 182 ; WX 540 ; N paragraph ; B 30 -190 533 681 ;
C 183 ; WX 350 ; N bullet ; B 50 175 300 425 ;
C 184 ; WX 333 ; N quotesinglbase ; B 77 -179 257 154 ;
C 185 ; WX 500 ; N quotedblbase ; B 31 -179 477 154 ;
C 186 ; WX 500 ; N quotedblright ; B 31 347 477 680 ;
C 187 ; WX 500 ; N guillemotright ; B 24 44 470 436 ;
C 188 ; WX 1000 ; N ellipsis ; B 85 -18 915 146 ;
C 189 ; WX 1000 ; N perthousand ; B 1 -55 993 718 ;
C 191 ; WX 500 ; N questiondown ; B 56 -210 437 488 ;
C 193 ; WX 333 ; N grave ; B 26 523 242 695 ;
C 194 ; WX 333 ; N acute ; B 83 523 299 695 ;
C 195 ; WX 333 ; N circumflex ; B 28 520 304 690 ;
C 196 ; WX 333 ; N tilde ; B 34 559 298 671 ;
C 197 ; WX 333 ; N macron ; B 34 543 297 600 ;
C 198 ; WX 333 ; N breve ; B 32 529 300 667 ;
C 199 ; WX 333 ; N dotaccent ; B 112 515 222 625 ;
C 200 ; WX 333 ; N dieresis ; B 33 556 297 652 ;
C 202 ; WX 333 ; N ring ; B 55 522 279 746 ;
C 203 ; WX 333 ; N cedilla ; B 42 -211 293 -10 ;
C 205 ; WX 333 ; N hungarumlaut ; B 32 539 320 753 ;
C 206 ; WX 333 ; N ogonek ; B 60 -179 277 70 ;
C 207 ; WX 333 ; N caron ; B 32 520 298 690 ;
C 208 ; WX 1000 ; N emdash ; B -2 185 1008 280 ;
C 225 ; WX 1000 ; N AE ; B 19 0 954 681 ;
C 227 ; WX 300 ; N ordfeminine ; B 12 286 288 685 ;
C 232 ; WX 667 ; N Lslash ; B 0 0 612 681 ;
C 233 ; WX 778 ; N Oslash ; B 45 -75 735 740 ;
C 234 ; WX 1000 ; N OE ; B 24 -7 979 683 ;
C 235 ; WX 330 ; N ordmasculine ; B 31 286 299 685 ;
C 241 ; WX 722 ; N ae ; B 30 -17 691 474 ;
C 245 ; WX 278 ; N dotlessi ; B 28 0 250 460 ;
C 248 ; WX 278 ; N lslash ; B 0 0 326 670 ;
C 249 ; WX 500 ; N oslash ; B 27 -95 474 550 ;
C 250 ; WX 722 ; N oe ; B 26 -17 689 473 ;
C 251 ; WX 556 ; N germandbls ; B 22 -18 513 689 ;
C -1 ; WX 722 ; N Aacute ; B 22 0 696 914 ;
C -1 ; WX 722 ; N Acircumflex ; B 22 0 696 909 ;
C -1 ; WX 722 ; N Adieresis ; B 22 0 696 871 ;
C -1 ; WX 722 ; N Agrave ; B 22 0 696 914 ;
C -1 ; WX 722 ; N Aring ; B 22 0 696 965 ;
C -1 ; WX 722 ; N Atilde ; B 22 0 696 890 ;
C -1 ; WX 722 ; N Ccedilla ; B 42 -211 669 690 ;
C -1 ; WX 667 ; N Eacute ; B 21 0 637 914 ;
C -1 ; WX 667 ; N Ecircumflex ; B 21 0 637 909 ;
C -1 ; WX 667 ; N Edieresis ; B 21 0 637 871 ;
C -1 ; WX 667 ; N Egrave ; B 21 0 637 914 ;
C -1 ; WX 722 ; N Eth ; B 22 0 685 681 ;
C -1 ; WX 389 ; N Iacute ; B 17 0 366 914 ;
C -1 ; WX 389 ; N Icircumflex ; B 17 0 366 909 ;
C -1 ; WX 389 ; N Idieresis ; B 17 0 366 871 ;
C -1 ; WX 389 ; N Igrave ; B 17 0 366 914 ;
C -1 ; WX 722 ; N Ntilde ; B 20 -10 697 890 ;
C -1 ; WX 778 ; N Oacute ; B 43 -18 733 914 ;
C -1 ; WX 778 ; N Ocircumflex ; B 43 -18 733 909 ;
C -1 ; WX 778 ; N Odieresis ; B 43 -18 733 871 ;
C -1 ; WX 778 ; N Ograve ; B 43 -18 733 914 ;
C -1 ; WX 778 ; N Otilde ; B 43 -18 733 890 ;
C -1 ; WX 556 ; N Scaron ; B 43 -19 506 909 ;
C -1 ; WX 611 ; N Thorn ; B 24 0 594 681 ;
C -1 ; WX 722 ; N Uacute ; B 20 -19 700 914 ;
C -1 ; WX 722 ; N Ucircumflex ; B 20 -19 700 909 ;
C -1 ; WX 722 ; N Udieresis ; B 20 -19 700 871 ;
C -1 ; WX 722 ; N Ugrave ; B 20 -19 700 914 ;
C -1 ; WX 722 ; N Yacute ; B 19 0 697 916 ;
C -1 ; WX 722 ; N Ydieresis ; B 19 0 697 871 ;
C -1 ; WX 667 ; N Zcaron ; B 37 0 624 909 ;
C -1 ; WX 500 ; N aacute ; B 25 -19 484 695 ;
C -1 ; WX 500 ; N acircumflex ; B 25 -19 484 690 ;
C -1 ; WX 500 ; N adieresis ; B 25 -19 484 652 ;
C -1 ; WX 500 ; N agrave ; B 25 -19 484 695 ;
C -1 ; WX 500 ; N aring ; B 25 -19 484 746 ;
C -1 ; WX 500 ; N atilde ; B 25 -19 484 671 ;
C -1 ; WX 220 ; N brokenbar ; B 77 -195 151 720 ;
C -1 ; WX 444 ; N ccedilla ; B 24 -211 423 472 ;
C -1 ; WX 747 ; N copyright ; B 16 -17 730 690 ;
C -1 ; WX 400 ; N degree ; B 50 390 350 690 ;
C -1 ; WX 570 ; N divide ; B 50 -10 520 460 ;
C -1 ; WX 444 ; N eacute ; B 25 -18 415 695 ;
C -1 ; WX 444 ; N ecircumflex ; B 25 -18 415 690 ;
C -1 ; WX 444 ; N edieresis ; B 25 -18 415 652 ;
C -1 ; WX 444 ; N egrave ; B 25 -18 415 695 ;
C -1 ; WX 500 ; N eth ; B 26 -17 474 670 ;
C -1 ; WX 278 ; N iacute ; B 28 0 265 695 ;
C -1 ; WX 278 ; N icircumflex ; B -6 0 270 690 ;
C -1 ; WX 278 ; N idieresis ; B -1 0 263 652 ;
C -1 ; WX 278 ; N igrave ; B -8 0 250 695 ;
C -1 ; WX 570 ; N logicalnot ; B 50 94 520 375 ;
C -1 ; WX 570 ; N minus ; B 50 188 520 262 ;
C -1 ; WX 556 ; N mu ; B 23 -210 524 460 ;
C -1 ; WX 570 ; N multiply ; B 50 -10 520 460 ;
C -1 ; WX 556 ; N ntilde ; B 28 0 523 671 ;
C -1 ; WX 500 ; N oacute ; B 25 -18 473 695 ;
C -1 ; WX 500 ; N ocircumflex ; B 25 -18 473 690 ;
C -1 ; WX 500 ; N odieresis ; B 25 -18 473 652 ;
C -1 ; WX 500 ; N ograve ; B 25 -18 473 695 ;
C -1 ; WX 750 ; N onehalf ; B 30 -18 720 690 ;
C -1 ; WX 750 ; N onequarter ; B 30 -18 720 690 ;
C -1 ; WX 300 ; N onesuperior ; B 24 276 275 690 ;
C -1 ; WX 500 ; N otilde ; B 25 -18 473 671 ;
C -1 ; WX 570 ; N plusminus ; B 50 0 520 600 ;
C -1 ; WX 747 ; N registered ; B 16 -17 730 690 ;
C -1 ; WX 389 ; N scaron ; B 29 -17 359 690 ;
C -1 ; WX 556 ; N thorn ; B 30 -210 513 670 ;
C -1 ; WX 750 ; N threequarters ; B 30 -18 720 690 ;
C -1 ; WX 300 ; N threesuperior ; B 5 269 294 690 ;
C -1 ; WX 1000 ; N trademark ; B 30 277 970 681 ;
C -1 ; WX 300 ; N twosuperior ; B 2 276 298 686 ;
C -1 ; WX 556 ; N uacute ; B 23 -17 524 695 ;
C -1 ; WX 556 ; N ucircumflex ; B 23 -17 524 690 ;
C -1 ; WX 556 ; N udieresis ; B 23 -17 524 652 ;
C -1 ; WX 556 ; N ugrave ; B 23 -17 524 695 ;
C -1 ; WX 500 ; N yacute ; B 19 -212 475 695 ;
C -1 ; WX 500 ; N ydieresis ; B 19 -212 475 652 ;
C -1 ; WX 444 ; N zcaron ; B 25 0 414 690 ;
EndCharMetrics
StartKernData
StartKernPairs 124
KPX A y -74
KPX A w -74
KPX A v -74
KPX A space -55
KPX A quoteright -74
KPX A Y -92
KPX A W -111
KPX A V -129
KPX A T -74
KPX F space -37
KPX F period -92
KPX F comma -92
KPX F A -74
KPX L y -55
KPX L space -55
KPX L quoteright -92
KPX L Y -92
KPX L W -92
KPX L V -92
KPX L T -92
KPX P space -55
KPX P period -92
KPX P comma -92
KPX P A -74
KPX R y -35
KPX R Y -35
KPX R W -35
KPX R V -35
KPX R T -35
KPX T y -74
KPX T w -74
KPX T u -92
KPX T space -18
KPX T semicolon -74
KPX T s -92
KPX T r -74
KPX T period -74
KPX T o -92
KPX T i -18
KPX T hyphen -92
KPX T e -92
KPX T comma -74
KPX T colon -74
KPX T c -92
KPX T a -92
KPX T O -18
KPX T A -74
KPX V y -92
KPX V u -92
KPX V space -18
KPX V semicolon -92
KPX V r -74
KPX V period -129
KPX V o -92
KPX V i -37
KPX V hyphen -74
KPX V e -92
KPX V comma -129
KPX V colon -92
KPX V a -92
KPX V O -20
KPX V A -129
KPX W y -37
KPX W u -18
KPX W space -18
KPX W semicolon -55
KPX W r -18
KPX W period -92
KPX W o -55
KPX W i -18
KPX W hyphen -37
KPX W e -55
KPX W comma -92
KPX W colon -55
KPX W a -55
KPX W A -111
KPX Y v -111
KPX Y u -92
KPX Y space -37
KPX Y semicolon -92
KPX Y q -111
KPX Y period -92
KPX Y p -92
KPX Y o -111
KPX Y i -37
KPX Y hyphen -92
KPX Y e -111
KPX Y comma -92
KPX Y colon -92
KPX Y a -111
KPX Y A -92
KPX f quoteright 55
KPX f f 0
KPX one one -55
KPX quoteleft quoteleft -74
KPX quoteright space -74
KPX quoteright s -37
KPX quoteright quoteright -74
KPX r z 0
KPX r y 0
KPX r x 0
KPX r w 0
KPX r t 0
KPX r space -18
KPX r quoteright 18
KPX r q -18
KPX r period -92
KPX r o -18
KPX r hyphen -37
KPX r h 0
KPX r e -18
KPX r comma -92
KPX r c -18
KPX space Y -37
KPX space W -18
KPX space V -18
KPX space T -18
KPX space A -55
KPX v period -55
KPX v comma -55
KPX w period -55
KPX w comma -55
KPX y period -55
KPX y comma -55
EndKernPairs
EndKernData
StartComposites 58
CC Zcaron 2 ; PCC Z 0 0 ; PCC caron 167 219 ;
CC zcaron 2 ; PCC z 0 0 ; PCC caron 55 0 ;
CC Scaron 2 ; PCC S 0 0 ; PCC caron 111 219 ;
CC scaron 2 ; PCC s 0 0 ; PCC caron 28 0 ;
CC Ccedilla 2 ; PCC C 0 0 ; PCC cedilla 207 0 ;
CC ccedilla 2 ; PCC c 0 0 ; PCC cedilla 68 0 ;
CC Yacute 2 ; PCC Y 0 0 ; PCC acute 194 221 ;
CC yacute 2 ; PCC y 0 0 ; PCC acute 83 0 ;
CC Ydieresis 2 ; PCC Y 0 0 ; PCC dieresis 194 219 ;
CC ydieresis 2 ; PCC y 0 0 ; PCC dieresis 83 0 ;
CC Uacute 2 ; PCC U 0 0 ; PCC acute 221 219 ;
CC Ucircumflex 2 ; PCC U 0 0 ; PCC circumflex 221 219 ;
CC Udieresis 2 ; PCC U 0 0 ; PCC dieresis 221 219 ;
CC Ugrave 2 ; PCC U 0 0 ; PCC grave 221 219 ;
CC uacute 2 ; PCC u 0 0 ; PCC acute 104 0 ;
CC ucircumflex 2 ; PCC u 0 0 ; PCC circumflex 104 0 ;
CC udieresis 2 ; PCC u 0 0 ; PCC dieresis 104 0 ;
CC ugrave 2 ; PCC u 0 0 ; PCC grave 104 0 ;
CC Iacute 2 ; PCC I 0 0 ; PCC acute 28 219 ;
CC Icircumflex 2 ; PCC I 0 0 ; PCC circumflex 28 219 ;
CC Idieresis 2 ; PCC I 0 0 ; PCC dieresis 28 219 ;
CC Igrave 2 ; PCC I 0 0 ; PCC grave 28 219 ;
CC iacute 2 ; PCC dotlessi 0 0 ; PCC acute -34 0 ;
CC icircumflex 2 ; PCC dotlessi 0 0 ; PCC circumflex -34 0 ;
CC idieresis 2 ; PCC dotlessi 0 0 ; PCC dieresis -34 0 ;
CC igrave 2 ; PCC dotlessi 0 0 ; PCC grave -34 0 ;
CC Eacute 2 ; PCC E 0 0 ; PCC acute 174 219 ;
CC Ecircumflex 2 ; PCC E 0 0 ; PCC circumflex 174 219 ;
CC Edieresis 2 ; PCC E 0 0 ; PCC dieresis 174 219 ;
CC Egrave 2 ; PCC E 0 0 ; PCC grave 174 219 ;
CC eacute 2 ; PCC e 0 0 ; PCC acute 61 0 ;
CC ecircumflex 2 ; PCC e 0 0 ; PCC circumflex 61 0 ;
CC edieresis 2 ; PCC e 0 0 ; PCC dieresis 61 0 ;
CC egrave 2 ; PCC e 0 0 ; PCC grave 61 0 ;
CC Aacute 2 ; PCC A 0 0 ; PCC acute 187 219 ;
CC Acircumflex 2 ; PCC A 0 0 ; PCC circumflex 187 219 ;
CC Adieresis 2 ; PCC A 0 0 ; PCC dieresis 187 219 ;
CC Agrave 2 ; PCC A 0 0 ; PCC grave 187 219 ;
CC aacute 2 ; PCC a 0 0 ; PCC acute 76 0 ;
CC acircumflex 2 ; PCC a 0 0 ; PCC circumflex 76 0 ;
CC adieresis 2 ; PCC a 0 0 ; PCC dieresis 76 0 ;
CC agrave 2 ; PCC a 0 0 ; PCC grave 76 0 ;
CC Oacute 2 ; PCC O 0 0 ; PCC acute 222 219 ;
CC Ocircumflex 2 ; PCC O 0 0 ; PCC circumflex 222 219 ;
CC Odieresis 2 ; PCC O 0 0 ; PCC dieresis 222 219 ;
CC Ograve 2 ; PCC O 0 0 ; PCC grave 222 219 ;
CC oacute 2 ; PCC o 0 0 ; PCC acute 83 0 ;
CC ocircumflex 2 ; PCC o 0 0 ; PCC circumflex 83 0 ;
CC odieresis 2 ; PCC o 0 0 ; PCC dieresis 83 0 ;
CC ograve 2 ; PCC o 0 0 ; PCC grave 83 0 ;
CC Atilde 2 ; PCC A 0 0 ; PCC tilde 187 219 ;
CC atilde 2 ; PCC a 0 0 ; PCC tilde 76 0 ;
CC Ntilde 2 ; PCC N 0 0 ; PCC tilde 194 219 ;
CC ntilde 2 ; PCC n 0 0 ; PCC tilde 111 0 ;
CC Otilde 2 ; PCC O 0 0 ; PCC tilde 222 219 ;
CC otilde 2 ; PCC o 0 0 ; PCC tilde 83 0 ;
CC Aring 2 ; PCC A 0 0 ; PCC ring 187 219 ;
CC aring 2 ; PCC a 0 0 ; PCC ring 76 0 ;
EndComposites
EndFontMetrics

440
collects/afm/Times-BoldItalic.afm Normal file
View File

@ -0,0 +1,440 @@
StartFontMetrics 2.0
Comment Copyright (c) 1984 Adobe Systems Incorporated. All Rights Reserved.
Comment Creation Date:Wed Apr 15 14:01:19 PST 1987
FontName Times-BoldItalic
EncodingScheme AdobeStandardEncoding
FullName Times Bold Italic
FamilyName Bold Italic
Weight Bold
ItalicAngle -15.0
IsFixedPitch false
UnderlinePosition -98
UnderlineThickness 54
Version 001.003
Notice Times is a trademark of Allied Corporation.
FontBBox -168 -232 1014 894
CapHeight 662
XHeight 458
Descender -203
Ascender 682
StartCharMetrics 228
C 32 ; WX 250 ; N space ; B 0 0 0 0 ;
C 33 ; WX 389 ; N exclam ; B 66 -13 367 676 ;
C 34 ; WX 555 ; N quotedbl ; B 142 367 549 693 ;
C 35 ; WX 500 ; N numbersign ; B 4 0 496 662 ;
C 36 ; WX 500 ; N dollar ; B -20 -101 492 723 ;
C 37 ; WX 833 ; N percent ; B 39 -8 784 685 ;
C 38 ; WX 778 ; N ampersand ; B 41 -19 727 676 ;
C 39 ; WX 333 ; N quoteright ; B 80 362 282 675 ;
C 40 ; WX 333 ; N parenleft ; B 28 -179 340 676 ;
C 41 ; WX 333 ; N parenright ; B -44 -179 268 676 ;
C 42 ; WX 500 ; N asterisk ; B 56 244 445 676 ;
C 43 ; WX 570 ; N plus ; B 33 0 537 505 ;
C 44 ; WX 250 ; N comma ; B -10 -181 192 132 ;
C 45 ; WX 333 ; N hyphen ; B 33 167 299 282 ;
C 46 ; WX 250 ; N period ; B 23 -13 170 133 ;
C 47 ; WX 278 ; N slash ; B -11 -18 289 682 ;
C 48 ; WX 500 ; N zero ; B 17 -13 472 676 ;
C 49 ; WX 500 ; N one ; B 5 0 415 676 ;
C 50 ; WX 500 ; N two ; B -27 0 441 676 ;
C 51 ; WX 500 ; N three ; B -15 -13 445 676 ;
C 52 ; WX 500 ; N four ; B -15 0 498 676 ;
C 53 ; WX 500 ; N five ; B -11 -13 482 662 ;
C 54 ; WX 500 ; N six ; B 23 -13 504 676 ;
C 55 ; WX 500 ; N seven ; B 51 0 519 662 ;
C 56 ; WX 500 ; N eight ; B 3 -13 471 676 ;
C 57 ; WX 500 ; N nine ; B -12 -13 470 676 ;
C 58 ; WX 333 ; N colon ; B 52 -13 291 458 ;
C 59 ; WX 333 ; N semicolon ; B 13 -181 291 458 ;
C 60 ; WX 570 ; N less ; B 31 -14 540 524 ;
C 61 ; WX 570 ; N equal ; B 33 116 537 401 ;
C 62 ; WX 570 ; N greater ; B 31 -14 540 524 ;
C 63 ; WX 500 ; N question ; B 78 -13 465 676 ;
C 64 ; WX 832 ; N at ; B -9 -150 838 691 ;
C 65 ; WX 667 ; N A ; B -51 0 602 676 ;
C 66 ; WX 667 ; N B ; B -24 0 618 662 ;
C 67 ; WX 667 ; N C ; B 22 -18 660 677 ;
C 68 ; WX 722 ; N D ; B -31 0 693 662 ;
C 69 ; WX 667 ; N E ; B -27 0 646 662 ;
C 70 ; WX 667 ; N F ; B -20 0 646 662 ;
C 71 ; WX 722 ; N G ; B 21 -18 699 676 ;
C 72 ; WX 778 ; N H ; B -24 0 791 662 ;
C 73 ; WX 389 ; N I ; B -22 0 412 662 ;
C 74 ; WX 500 ; N J ; B -45 -98 519 662 ;
C 75 ; WX 667 ; N K ; B -31 0 685 662 ;
C 76 ; WX 611 ; N L ; B -22 0 584 662 ;
C 77 ; WX 889 ; N M ; B -29 -12 907 662 ;
C 78 ; WX 722 ; N N ; B -27 -18 740 662 ;
C 79 ; WX 722 ; N O ; B 27 -18 684 676 ;
C 80 ; WX 611 ; N P ; B -27 0 608 662 ;
C 81 ; WX 722 ; N Q ; B 27 -203 684 676 ;
C 82 ; WX 667 ; N R ; B -29 0 616 662 ;
C 83 ; WX 556 ; N S ; B 6 -18 524 676 ;
C 84 ; WX 611 ; N T ; B 39 0 632 662 ;
C 85 ; WX 722 ; N U ; B 66 -18 736 662 ;
C 86 ; WX 667 ; N V ; B 48 -18 692 662 ;
C 87 ; WX 889 ; N W ; B 48 -18 914 662 ;
C 88 ; WX 667 ; N X ; B -24 0 687 662 ;
C 89 ; WX 611 ; N Y ; B 46 0 625 662 ;
C 90 ; WX 611 ; N Z ; B -1 0 594 662 ;
C 91 ; WX 333 ; N bracketleft ; B -7 -157 388 682 ;
C 92 ; WX 278 ; N backslash ; B 1 0 465 682 ;
C 93 ; WX 333 ; N bracketright ; B -65 -157 330 682 ;
C 94 ; WX 570 ; N asciicircum ; B 34 259 536 662 ;
C 95 ; WX 500 ; N underscore ; B 0 -127 500 -89 ;
C 96 ; WX 333 ; N quoteleft ; B 117 363 319 676 ;
C 97 ; WX 500 ; N a ; B 9 -14 480 458 ;
C 98 ; WX 500 ; N b ; B 21 -13 474 682 ;
C 99 ; WX 444 ; N c ; B 25 -13 418 458 ;
C 100 ; WX 500 ; N d ; B 9 -13 541 682 ;
C 101 ; WX 444 ; N e ; B 25 -13 413 458 ;
C 102 ; WX 333 ; N f ; B -146 -203 460 682 ; L i fi ; L l fl ;
C 103 ; WX 500 ; N g ; B -27 -203 498 458 ;
C 104 ; WX 556 ; N h ; B 12 -13 518 682 ;
C 105 ; WX 278 ; N i ; B 25 -13 284 676 ;
C 106 ; WX 278 ; N j ; B -152 -203 311 676 ;
C 107 ; WX 500 ; N k ; B 10 -13 511 682 ;
C 108 ; WX 278 ; N l ; B 31 -13 312 682 ;
C 109 ; WX 778 ; N m ; B 16 -13 744 458 ;
C 110 ; WX 556 ; N n ; B 24 -13 518 458 ;
C 111 ; WX 500 ; N o ; B 27 -13 467 458 ;
C 112 ; WX 500 ; N p ; B -79 -203 481 458 ;
C 113 ; WX 500 ; N q ; B 21 -203 486 459 ;
C 114 ; WX 389 ; N r ; B 9 0 415 458 ;
C 115 ; WX 389 ; N s ; B 16 -13 364 459 ;
C 116 ; WX 278 ; N t ; B 16 -14 305 592 ;
C 117 ; WX 556 ; N u ; B 48 -13 521 458 ;
C 118 ; WX 444 ; N v ; B 50 -13 432 458 ;
C 119 ; WX 667 ; N w ; B 50 -13 642 458 ;
C 120 ; WX 500 ; N x ; B -5 -13 498 458 ;
C 121 ; WX 444 ; N y ; B -60 -203 423 458 ;
C 122 ; WX 389 ; N z ; B -24 -58 394 448 ;
C 123 ; WX 348 ; N braceleft ; B 31 -154 381 686 ;
C 124 ; WX 220 ; N bar ; B 70 0 151 682 ;
C 125 ; WX 348 ; N braceright ; B -31 -161 319 679 ;
C 126 ; WX 570 ; N asciitilde ; B 33 158 537 353 ;
C 161 ; WX 389 ; N exclamdown ; B 21 -232 321 458 ;
C 162 ; WX 500 ; N cent ; B 50 -142 443 570 ;
C 163 ; WX 500 ; N sterling ; B -32 -13 505 676 ;
C 164 ; WX 167 ; N fraction ; B -161 0 327 662 ;
C 165 ; WX 500 ; N yen ; B -15 0 565 662 ;
C 166 ; WX 500 ; N florin ; B -86 -154 530 682 ;
C 167 ; WX 500 ; N section ; B 36 -143 454 676 ;
C 168 ; WX 500 ; N currency ; B -3 110 503 612 ;
C 169 ; WX 278 ; N quotesingle ; B 126 367 295 693 ;
C 170 ; WX 500 ; N quotedblleft ; B 57 363 513 676 ;
C 171 ; WX 500 ; N guillemotleft ; B 21 33 474 416 ;
C 172 ; WX 333 ; N guilsinglleft ; B 42 33 310 416 ;
C 173 ; WX 333 ; N guilsinglright ; B 23 38 291 421 ;
C 174 ; WX 556 ; N fi ; B -157 -203 538 682 ;
C 175 ; WX 556 ; N fl ; B -149 -203 577 682 ;
C 177 ; WX 500 ; N endash ; B -11 176 511 266 ;
C 178 ; WX 500 ; N dagger ; B 90 -146 489 676 ;
C 179 ; WX 500 ; N daggerdbl ; B 11 -143 487 675 ;
C 180 ; WX 250 ; N periodcentered ; B 51 179 200 328 ;
C 182 ; WX 500 ; N paragraph ; B 61 -189 592 682 ;
C 183 ; WX 350 ; N bullet ; B 50 175 300 425 ;
C 184 ; WX 333 ; N quotesinglbase ; B 66 -181 268 132 ;
C 185 ; WX 500 ; N quotedblbase ; B -57 -181 398 132 ;
C 186 ; WX 500 ; N quotedblright ; B 56 362 509 675 ;
C 187 ; WX 500 ; N guillemotright ; B 21 38 474 421 ;
C 188 ; WX 1000 ; N ellipsis ; B 93 -13 906 133 ;
C 189 ; WX 1000 ; N perthousand ; B 7 -49 985 699 ;
C 191 ; WX 500 ; N questiondown ; B 30 -203 417 487 ;
C 193 ; WX 333 ; N grave ; B 115 511 325 690 ;
C 194 ; WX 333 ; N acute ; B 168 511 405 690 ;
C 195 ; WX 333 ; N circumflex ; B 70 510 394 682 ;
C 196 ; WX 333 ; N tilde ; B 69 530 424 648 ;
C 197 ; WX 333 ; N macron ; B 81 547 420 616 ;
C 198 ; WX 333 ; N breve ; B 99 511 414 671 ;
C 199 ; WX 333 ; N dotaccent ; B 180 519 308 648 ;
C 200 ; WX 333 ; N dieresis ; B 85 519 424 648 ;
C 202 ; WX 333 ; N ring ; B 141 466 352 676 ;
C 203 ; WX 333 ; N cedilla ; B 32 -216 264 5 ;
C 205 ; WX 333 ; N hungarumlaut ; B 28 538 339 750 ;
C 206 ; WX 333 ; N ogonek ; B -37 -173 192 44 ;
C 207 ; WX 333 ; N caron ; B 109 511 437 683 ;
C 208 ; WX 1000 ; N emdash ; B -14 176 1014 266 ;
C 225 ; WX 944 ; N AE ; B -41 0 931 662 ;
C 227 ; WX 266 ; N ordfeminine ; B -24 286 291 676 ;
C 232 ; WX 611 ; N Lslash ; B -22 0 584 662 ;
C 233 ; WX 722 ; N Oslash ; B 27 -124 684 754 ;
C 234 ; WX 944 ; N OE ; B 23 -8 936 670 ;
C 235 ; WX 300 ; N ordmasculine ; B 1 286 300 676 ;
C 241 ; WX 722 ; N ae ; B 15 -13 685 458 ;
C 245 ; WX 278 ; N dotlessi ; B 27 -13 260 458 ;
C 248 ; WX 278 ; N lslash ; B 12 -13 326 682 ;
C 249 ; WX 500 ; N oslash ; B 27 -118 467 556 ;
C 250 ; WX 722 ; N oe ; B 26 -13 687 458 ;
C 251 ; WX 500 ; N germandbls ; B -168 -203 497 682 ;
C -1 ; WX 667 ; N Aacute ; B -51 0 602 894 ;
C -1 ; WX 667 ; N Acircumflex ; B -51 0 602 886 ;
C -1 ; WX 667 ; N Adieresis ; B -51 0 602 852 ;
C -1 ; WX 667 ; N Agrave ; B -51 0 602 894 ;
C -1 ; WX 667 ; N Aring ; B -51 0 602 880 ;
C -1 ; WX 667 ; N Atilde ; B -51 0 602 852 ;
C -1 ; WX 667 ; N Ccedilla ; B 22 -216 660 677 ;
C -1 ; WX 667 ; N Eacute ; B -27 0 646 894 ;
C -1 ; WX 667 ; N Ecircumflex ; B -27 0 646 886 ;
C -1 ; WX 667 ; N Edieresis ; B -27 0 646 852 ;
C -1 ; WX 667 ; N Egrave ; B -27 0 646 894 ;
C -1 ; WX 722 ; N Eth ; B -31 0 693 662 ;
C -1 ; WX 389 ; N Iacute ; B -22 0 433 894 ;
C -1 ; WX 389 ; N Icircumflex ; B -22 0 422 886 ;
C -1 ; WX 389 ; N Idieresis ; B -22 0 452 852 ;
C -1 ; WX 389 ; N Igrave ; B -22 0 412 894 ;
C -1 ; WX 722 ; N Ntilde ; B -27 -18 740 852 ;
C -1 ; WX 722 ; N Oacute ; B 27 -18 684 894 ;
C -1 ; WX 722 ; N Ocircumflex ; B 27 -18 684 886 ;
C -1 ; WX 722 ; N Odieresis ; B 27 -18 684 852 ;
C -1 ; WX 722 ; N Ograve ; B 27 -18 684 894 ;
C -1 ; WX 722 ; N Otilde ; B 27 -18 684 852 ;
C -1 ; WX 556 ; N Scaron ; B 6 -18 549 887 ;
C -1 ; WX 611 ; N Thorn ; B -27 0 572 662 ;
C -1 ; WX 722 ; N Uacute ; B 66 -18 736 894 ;
C -1 ; WX 722 ; N Ucircumflex ; B 66 -18 736 886 ;
C -1 ; WX 722 ; N Udieresis ; B 66 -18 736 852 ;
C -1 ; WX 722 ; N Ugrave ; B 66 -18 736 894 ;
C -1 ; WX 611 ; N Yacute ; B 46 0 625 894 ;
C -1 ; WX 611 ; N Ydieresis ; B 46 0 625 852 ;
C -1 ; WX 611 ; N Zcaron ; B -1 0 594 887 ;
C -1 ; WX 500 ; N aacute ; B 9 -14 489 690 ;
C -1 ; WX 500 ; N acircumflex ; B 9 -14 480 682 ;
C -1 ; WX 500 ; N adieresis ; B 9 -14 508 648 ;
C -1 ; WX 500 ; N agrave ; B 9 -14 480 690 ;
C -1 ; WX 500 ; N aring ; B 9 -14 480 676 ;
C -1 ; WX 500 ; N atilde ; B 9 -14 508 648 ;
C -1 ; WX 220 ; N brokenbar ; B 70 0 151 682 ;
C -1 ; WX 444 ; N ccedilla ; B 25 -216 418 458 ;
C -1 ; WX 747 ; N copyright ; B 23 -18 723 676 ;
C -1 ; WX 400 ; N degree ; B 70 376 370 676 ;
C -1 ; WX 570 ; N divide ; B 33 0 537 505 ;
C -1 ; WX 444 ; N eacute ; B 25 -13 461 690 ;
C -1 ; WX 444 ; N ecircumflex ; B 25 -13 450 682 ;
C -1 ; WX 444 ; N edieresis ; B 25 -13 480 648 ;
C -1 ; WX 444 ; N egrave ; B 25 -13 413 690 ;
C -1 ; WX 500 ; N eth ; B 27 -13 498 682 ;
C -1 ; WX 278 ; N iacute ; B 27 -13 378 690 ;
C -1 ; WX 278 ; N icircumflex ; B 27 -13 367 682 ;
C -1 ; WX 278 ; N idieresis ; B 27 -13 397 648 ;
C -1 ; WX 278 ; N igrave ; B 27 -13 298 690 ;
C -1 ; WX 606 ; N logicalnot ; B 51 120 555 401 ;
C -1 ; WX 606 ; N minus ; B 51 210 555 300 ;
C -1 ; WX 576 ; N mu ; B -63 -210 521 458 ;
C -1 ; WX 570 ; N multiply ; B 33 0 537 504 ;
C -1 ; WX 556 ; N ntilde ; B 24 -13 536 648 ;
C -1 ; WX 500 ; N oacute ; B 27 -13 489 690 ;
C -1 ; WX 500 ; N ocircumflex ; B 27 -13 478 682 ;
C -1 ; WX 500 ; N odieresis ; B 27 -13 508 648 ;
C -1 ; WX 500 ; N ograve ; B 27 -13 467 690 ;
C -1 ; WX 750 ; N onehalf ; B 30 0 720 676 ;
C -1 ; WX 750 ; N onequarter ; B 30 0 720 676 ;
C -1 ; WX 300 ; N onesuperior ; B 17 270 283 676 ;
C -1 ; WX 500 ; N otilde ; B 27 -13 508 648 ;
C -1 ; WX 570 ; N plusminus ; B 33 0 537 665 ;
C -1 ; WX 747 ; N registered ; B 23 -18 723 676 ;
C -1 ; WX 389 ; N scaron ; B 16 -13 465 683 ;
C -1 ; WX 500 ; N thorn ; B -79 -203 474 682 ;
C -1 ; WX 750 ; N threequarters ; B 30 0 720 676 ;
C -1 ; WX 300 ; N threesuperior ; B 0 263 299 676 ;
C -1 ; WX 1000 ; N trademark ; B 40 272 980 676 ;
C -1 ; WX 300 ; N twosuperior ; B -2 270 302 676 ;
C -1 ; WX 556 ; N uacute ; B 48 -13 521 690 ;
C -1 ; WX 556 ; N ucircumflex ; B 48 -13 521 682 ;
C -1 ; WX 556 ; N udieresis ; B 48 -13 536 648 ;
C -1 ; WX 556 ; N ugrave ; B 48 -13 521 690 ;
C -1 ; WX 444 ; N yacute ; B -60 -203 461 690 ;
C -1 ; WX 444 ; N ydieresis ; B -60 -203 480 648 ;
C -1 ; WX 389 ; N zcaron ; B -24 -58 465 683 ;
EndCharMetrics
StartKernData
StartKernPairs 108
KPX A y -74
KPX A w -74
KPX A v -74
KPX A space -55
KPX A quoteright -74
KPX A Y -55
KPX A W -92
KPX A V -74
KPX A T -55
KPX F space -18
KPX F period -129
KPX F comma -129
KPX F A -92
KPX L y -37
KPX L space -37
KPX L quoteright -55
KPX L Y -37
KPX L W -37
KPX L V -37
KPX L T -18
KPX P space -37
KPX P period -129
KPX P comma -129
KPX P A -74
KPX R y -18
KPX R Y -18
KPX R W -18
KPX R V -18
KPX T y -37
KPX T w -37
KPX T u -37
KPX T semicolon -74
KPX T s -92
KPX T r -37
KPX T period -92
KPX T o -92
KPX T i -37
KPX T hyphen -92
KPX T e -92
KPX T comma -92
KPX T colon -74
KPX T c -92
KPX T a -92
KPX T O -18
KPX T A -55
KPX V y -74
KPX V u -55
KPX V space -18
KPX V semicolon -74
KPX V r -55
KPX V period -129
KPX V o -111
KPX V i -55
KPX V hyphen -55
KPX V e -111
KPX V comma -129
KPX V colon -74
KPX V a -111
KPX V A -74
KPX W y -55
KPX W u -55
KPX W space -18
KPX W semicolon -55
KPX W r -74
KPX W period -74
KPX W o -74
KPX W i -37
KPX W hyphen -37
KPX W e -74
KPX W comma -74
KPX W colon -55
KPX W a -74
KPX W A -74
KPX Y v -92
KPX Y u -92
KPX Y space -37
KPX Y semicolon -92
KPX Y q -111
KPX Y period -74
KPX Y p -74
KPX Y o -111
KPX Y i -55
KPX Y hyphen -92
KPX Y e -111
KPX Y comma -92
KPX Y colon -92
KPX Y a -92
KPX Y A -74
KPX f quoteright 55
KPX f f -18
KPX one one -55
KPX quoteleft quoteleft -74
KPX quoteright t -37
KPX quoteright space -74
KPX quoteright s -74
KPX quoteright quoteright -74
KPX r quoteright 37
KPX r period -55
KPX r comma -55
KPX space Y -18
KPX space W -18
KPX space A -37
KPX v period -37
KPX v comma -37
KPX w period -37
KPX w comma -37
KPX y period -37
KPX y comma -37
EndKernPairs
EndKernData
StartComposites 58
CC Zcaron 2 ; PCC Z 0 0 ; PCC caron 139 204 ;
CC zcaron 2 ; PCC z 0 0 ; PCC caron 28 0 ;
CC Scaron 2 ; PCC S 0 0 ; PCC caron 111 204 ;
CC scaron 2 ; PCC s 0 0 ; PCC caron 28 0 ;
CC Ccedilla 2 ; PCC C 0 0 ; PCC cedilla 167 0 ;
CC ccedilla 2 ; PCC c 0 0 ; PCC cedilla 55 0 ;
CC Yacute 2 ; PCC Y 0 0 ; PCC acute 139 204 ;
CC yacute 2 ; PCC y 0 0 ; PCC acute 55 0 ;
CC Ydieresis 2 ; PCC Y 0 0 ; PCC dieresis 139 204 ;
CC ydieresis 2 ; PCC y 0 0 ; PCC dieresis 55 0 ;
CC Uacute 2 ; PCC U 0 0 ; PCC acute 194 204 ;
CC Ucircumflex 2 ; PCC U 0 0 ; PCC circumflex 194 204 ;
CC Udieresis 2 ; PCC U 0 0 ; PCC dieresis 194 204 ;
CC Ugrave 2 ; PCC U 0 0 ; PCC grave 194 204 ;
CC uacute 2 ; PCC u 0 0 ; PCC acute 111 0 ;
CC ucircumflex 2 ; PCC u 0 0 ; PCC circumflex 111 0 ;
CC udieresis 2 ; PCC u 0 0 ; PCC dieresis 111 0 ;
CC ugrave 2 ; PCC u 0 0 ; PCC grave 111 0 ;
CC Iacute 2 ; PCC I 0 0 ; PCC acute 28 204 ;
CC Icircumflex 2 ; PCC I 0 0 ; PCC circumflex 28 204 ;
CC Idieresis 2 ; PCC I 0 0 ; PCC dieresis 28 204 ;
CC Igrave 2 ; PCC I 0 0 ; PCC grave 28 204 ;
CC iacute 2 ; PCC dotlessi 0 0 ; PCC acute -27 0 ;
CC icircumflex 2 ; PCC dotlessi 0 0 ; PCC circumflex -27 0 ;
CC idieresis 2 ; PCC dotlessi 0 0 ; PCC dieresis -27 0 ;
CC igrave 2 ; PCC dotlessi 0 0 ; PCC grave -27 0 ;
CC Eacute 2 ; PCC E 0 0 ; PCC acute 167 204 ;
CC Ecircumflex 2 ; PCC E 0 0 ; PCC circumflex 167 204 ;
CC Edieresis 2 ; PCC E 0 0 ; PCC dieresis 167 204 ;
CC Egrave 2 ; PCC E 0 0 ; PCC grave 167 204 ;
CC eacute 2 ; PCC e 0 0 ; PCC acute 55 0 ;
CC ecircumflex 2 ; PCC e 0 0 ; PCC circumflex 55 0 ;
CC edieresis 2 ; PCC e 0 0 ; PCC dieresis 55 0 ;
CC egrave 2 ; PCC e 0 0 ; PCC grave 55 0 ;
CC Aacute 2 ; PCC A 0 0 ; PCC acute 167 204 ;
CC Acircumflex 2 ; PCC A 0 0 ; PCC circumflex 167 204 ;
CC Adieresis 2 ; PCC A 0 0 ; PCC dieresis 167 204 ;
CC Agrave 2 ; PCC A 0 0 ; PCC grave 167 204 ;
CC aacute 2 ; PCC a 0 0 ; PCC acute 83 0 ;
CC acircumflex 2 ; PCC a 0 0 ; PCC circumflex 83 0 ;
CC adieresis 2 ; PCC a 0 0 ; PCC dieresis 83 0 ;
CC agrave 2 ; PCC a 0 0 ; PCC grave 83 0 ;
CC Oacute 2 ; PCC O 0 0 ; PCC acute 194 204 ;
CC Ocircumflex 2 ; PCC O 0 0 ; PCC circumflex 194 204 ;
CC Odieresis 2 ; PCC O 0 0 ; PCC dieresis 194 204 ;
CC Ograve 2 ; PCC O 0 0 ; PCC grave 194 204 ;
CC oacute 2 ; PCC o 0 0 ; PCC acute 83 0 ;
CC ocircumflex 2 ; PCC o 0 0 ; PCC circumflex 83 0 ;
CC odieresis 2 ; PCC o 0 0 ; PCC dieresis 83 0 ;
CC ograve 2 ; PCC o 0 0 ; PCC grave 83 0 ;
CC Atilde 2 ; PCC A 0 0 ; PCC tilde 167 204 ;
CC atilde 2 ; PCC a 0 0 ; PCC tilde 83 0 ;
CC Ntilde 2 ; PCC N 0 0 ; PCC tilde 194 204 ;
CC ntilde 2 ; PCC n 0 0 ; PCC tilde 111 0 ;
CC Otilde 2 ; PCC O 0 0 ; PCC tilde 194 204 ;
CC otilde 2 ; PCC o 0 0 ; PCC tilde 83 0 ;
CC Aring 2 ; PCC A 0 0 ; PCC ring 167 204 ;
CC aring 2 ; PCC a 0 0 ; PCC ring 83 0 ;
EndComposites
EndFontMetrics

452
collects/afm/Times-Italic.afm Normal file
View File

@ -0,0 +1,452 @@
StartFontMetrics 2.0
Comment Copyright (c) 1984 Adobe Systems Incorporated. All Rights Reserved.
Comment Creation Date:Sun Feb 8 03:54:53 PST 1987
FontName Times-Italic
EncodingScheme AdobeStandardEncoding
FullName Times Italic
FamilyName Times
Weight Medium
ItalicAngle -15.5
IsFixedPitch false
UnderlinePosition -96
UnderlineThickness 48
Version 001.002
Notice Times is a trademark of Allied Corporation.
FontBBox -176 -252 990 930
CapHeight 660
XHeight 446
Descender -206
Ascender 684
StartCharMetrics 228
C 32 ; WX 250 ; N space ; B 0 0 0 0 ;
C 33 ; WX 333 ; N exclam ; B 46 -10 296 670 ;
C 34 ; WX 420 ; N quotedbl ; B 107 442 402 673 ;
C 35 ; WX 500 ; N numbersign ; B -7 -6 508 683 ;
C 36 ; WX 500 ; N dollar ; B 13 -102 481 735 ;
C 37 ; WX 833 ; N percent ; B 63 -14 770 682 ;
C 38 ; WX 778 ; N ampersand ; B 60 -22 698 673 ;
C 39 ; WX 333 ; N quoteright ; B 69 458 206 678 ;
C 40 ; WX 333 ; N parenleft ; B 41 -180 312 662 ;
C 41 ; WX 333 ; N parenright ; B 19 -178 286 664 ;
C 42 ; WX 500 ; N asterisk ; B 60 268 434 684 ;
C 43 ; WX 675 ; N plus ; B 85 0 589 505 ;
C 44 ; WX 250 ; N comma ; B 57 -126 194 94 ;
C 45 ; WX 333 ; N hyphen ; B 55 192 276 254 ;
C 46 ; WX 250 ; N period ; B 75 -10 175 90 ;
C 47 ; WX 278 ; N slash ; B 2 -14 252 641 ;
C 48 ; WX 500 ; N zero ; B 19 -9 470 683 ;
C 49 ; WX 500 ; N one ; B 31 0 390 684 ;
C 50 ; WX 500 ; N two ; B -7 0 429 682 ;
C 51 ; WX 500 ; N three ; B -7 -12 443 682 ;
C 52 ; WX 500 ; N four ; B -8 0 454 681 ;
C 53 ; WX 500 ; N five ; B -12 -15 462 666 ;
C 54 ; WX 500 ; N six ; B 24 -8 497 685 ;
C 55 ; WX 500 ; N seven ; B 56 -12 512 666 ;
C 56 ; WX 500 ; N eight ; B 12 -7 475 681 ;
C 57 ; WX 500 ; N nine ; B 10 -18 470 684 ;
C 58 ; WX 333 ; N colon ; B 86 -10 284 444 ;
C 59 ; WX 333 ; N semicolon ; B 63 -124 292 441 ;
C 60 ; WX 675 ; N less ; B 83 -7 592 515 ;
C 61 ; WX 675 ; N equal ; B 85 125 589 383 ;
C 62 ; WX 675 ; N greater ; B 82 -7 591 515 ;
C 63 ; WX 500 ; N question ; B 105 -10 439 670 ;
C 64 ; WX 920 ; N at ; B 39 -191 866 648 ;
C 65 ; WX 611 ; N A ; B -45 0 564 672 ;
C 66 ; WX 611 ; N B ; B -28 0 562 660 ;
C 67 ; WX 667 ; N C ; B 33 -23 653 672 ;
C 68 ; WX 722 ; N D ; B -27 0 671 660 ;
C 69 ; WX 611 ; N E ; B -17 0 609 660 ;
C 70 ; WX 611 ; N F ; B -17 0 609 660 ;
C 71 ; WX 722 ; N G ; B 31 -23 701 672 ;
C 72 ; WX 722 ; N H ; B -26 0 742 660 ;
C 73 ; WX 333 ; N I ; B -26 0 357 660 ;
C 74 ; WX 444 ; N J ; B -36 -22 479 660 ;
C 75 ; WX 667 ; N K ; B -15 0 702 660 ;
C 76 ; WX 556 ; N L ; B -32 0 535 660 ;
C 77 ; WX 833 ; N M ; B -24 0 850 660 ;
C 78 ; WX 667 ; N N ; B -36 -12 698 660 ;
C 79 ; WX 722 ; N O ; B 42 -23 676 671 ;
C 80 ; WX 611 ; N P ; B -16 0 582 660 ;
C 81 ; WX 722 ; N Q ; B 41 -186 681 671 ;
C 82 ; WX 611 ; N R ; B -32 0 566 660 ;
C 83 ; WX 500 ; N S ; B 9 -22 483 674 ;
C 84 ; WX 556 ; N T ; B 32 0 602 660 ;
C 85 ; WX 722 ; N U ; B 77 -21 747 660 ;
C 86 ; WX 611 ; N V ; B 44 -20 659 660 ;
C 87 ; WX 833 ; N W ; B 35 -20 875 660 ;
C 88 ; WX 611 ; N X ; B -45 0 633 660 ;
C 89 ; WX 556 ; N Y ; B 44 0 600 660 ;
C 90 ; WX 556 ; N Z ; B -19 0 581 660 ;
C 91 ; WX 389 ; N bracketleft ; B 22 -170 391 654 ;
C 92 ; WX 278 ; N backslash ; B 2 -12 252 651 ;
C 93 ; WX 389 ; N bracketright ; B -31 -170 341 654 ;
C 94 ; WX 422 ; N asciicircum ; B 0 254 503 660 ;
C 95 ; WX 500 ; N underscore ; B -9 -252 510 -206 ;
C 96 ; WX 333 ; N quoteleft ; B 149 457 286 677 ;
C 97 ; WX 500 ; N a ; B 15 -11 474 446 ;
C 98 ; WX 500 ; N b ; B 24 -12 475 682 ;
C 99 ; WX 444 ; N c ; B 32 -11 420 446 ;
C 100 ; WX 500 ; N d ; B 15 -11 521 684 ;
C 101 ; WX 444 ; N e ; B 34 -13 412 446 ;
C 102 ; WX 278 ; N f ; B -148 -207 415 684 ; L i fi ; L l fl ;
C 103 ; WX 500 ; N g ; B 10 -209 471 445 ;
C 104 ; WX 500 ; N h ; B 23 -10 473 684 ;
C 105 ; WX 278 ; N i ; B 43 -10 263 660 ;
C 106 ; WX 278 ; N j ; B -109 -207 287 660 ;
C 107 ; WX 444 ; N k ; B 16 -12 460 685 ;
C 108 ; WX 278 ; N l ; B 41 -10 276 685 ;
C 109 ; WX 722 ; N m ; B 11 -10 698 447 ;
C 110 ; WX 500 ; N n ; B 23 -10 471 447 ;
C 111 ; WX 500 ; N o ; B 27 -13 467 448 ;
C 112 ; WX 500 ; N p ; B -75 -206 465 446 ;
C 113 ; WX 500 ; N q ; B 20 -206 483 445 ;
C 114 ; WX 389 ; N r ; B 24 0 392 446 ;
C 115 ; WX 389 ; N s ; B 16 -14 367 446 ;
C 116 ; WX 278 ; N t ; B 38 -10 288 548 ;
C 117 ; WX 500 ; N u ; B 42 -11 472 447 ;
C 118 ; WX 444 ; N v ; B 24 -11 423 444 ;
C 119 ; WX 667 ; N w ; B 14 -10 650 447 ;
C 120 ; WX 444 ; N x ; B -31 -10 450 446 ;
C 121 ; WX 444 ; N y ; B -27 -209 420 445 ;
C 122 ; WX 389 ; N z ; B 2 0 380 434 ;
C 123 ; WX 400 ; N braceleft ; B 65 -179 411 675 ;
C 124 ; WX 275 ; N bar ; B -22 -188 251 670 ;
C 125 ; WX 400 ; N braceright ; B -66 -179 300 675 ;
C 126 ; WX 541 ; N asciitilde ; B 18 169 522 340 ;
C 161 ; WX 389 ; N exclamdown ; B 59 -213 317 468 ;
C 162 ; WX 500 ; N cent ; B 62 -146 449 564 ;
C 163 ; WX 500 ; N sterling ; B -5 -9 498 672 ;
C 164 ; WX 167 ; N fraction ; B -176 -15 338 672 ;
C 165 ; WX 500 ; N yen ; B 13 0 609 684 ;
C 166 ; WX 500 ; N florin ; B 3 -189 492 688 ;
C 167 ; WX 500 ; N section ; B 42 -96 455 743 ;
C 168 ; WX 500 ; N currency ; B 3 105 498 604 ;
C 169 ; WX 214 ; N quotesingle ; B 99 453 247 678 ;
C 170 ; WX 556 ; N quotedblleft ; B 166 457 510 677 ;
C 171 ; WX 500 ; N guillemotleft ; B 54 39 444 400 ;
C 172 ; WX 333 ; N guilsinglleft ; B 60 39 285 400 ;
C 173 ; WX 333 ; N guilsinglright ; B 49 34 269 406 ;
C 174 ; WX 500 ; N fi ; B -136 -207 468 684 ;
C 175 ; WX 500 ; N fl ; B -140 -207 509 684 ;
C 177 ; WX 500 ; N endash ; B -3 194 501 242 ;
C 178 ; WX 500 ; N dagger ; B 92 -93 480 734 ;
C 179 ; WX 500 ; N daggerdbl ; B 20 -93 482 743 ;
C 180 ; WX 250 ; N periodcentered ; B 75 192 199 316 ;
C 182 ; WX 523 ; N paragraph ; B 87 -196 533 675 ;
C 183 ; WX 350 ; N bullet ; B 50 175 300 425 ;
C 184 ; WX 333 ; N quotesinglbase ; B 83 -126 220 94 ;
C 185 ; WX 556 ; N quotedblbase ; B 63 -126 407 94 ;
C 186 ; WX 556 ; N quotedblright ; B 68 458 412 678 ;
C 187 ; WX 500 ; N guillemotright ; B 59 34 442 406 ;
C 188 ; WX 889 ; N ellipsis ; B 62 -10 828 90 ;
C 189 ; WX 1000 ; N perthousand ; B 9 -65 990 690 ;
C 191 ; WX 500 ; N questiondown ; B 55 -215 395 462 ;
C 193 ; WX 333 ; N grave ; B 160 491 333 659 ;
C 194 ; WX 333 ; N acute ; B 154 501 375 680 ;
C 195 ; WX 333 ; N circumflex ; B 96 495 374 669 ;
C 196 ; WX 333 ; N tilde ; B 114 518 386 639 ;
C 197 ; WX 333 ; N macron ; B 120 543 380 603 ;
C 198 ; WX 333 ; N breve ; B 140 512 401 645 ;
C 199 ; WX 333 ; N dotaccent ; B 112 515 222 625 ;
C 200 ; WX 333 ; N dieresis ; B 117 534 389 634 ;
C 202 ; WX 333 ; N ring ; B 239 509 433 703 ;
C 203 ; WX 333 ; N cedilla ; B -30 -206 214 0 ;
C 205 ; WX 333 ; N hungarumlaut ; B 62 532 348 749 ;
C 206 ; WX 333 ; N ogonek ; B -44 -159 169 40 ;
C 207 ; WX 333 ; N caron ; B 138 495 422 669 ;
C 208 ; WX 889 ; N emdash ; B -65 194 945 242 ;
C 225 ; WX 889 ; N AE ; B -46 0 889 660 ;
C 227 ; WX 276 ; N ordfeminine ; B 32 300 310 677 ;
C 232 ; WX 556 ; N Lslash ; B 0 0 567 660 ;
C 233 ; WX 722 ; N Oslash ; B 40 -110 683 738 ;
C 234 ; WX 944 ; N OE ; B 30 -10 943 668 ;
C 235 ; WX 310 ; N ordmasculine ; B 45 301 310 679 ;
C 241 ; WX 667 ; N ae ; B 24 -12 638 448 ;
C 245 ; WX 278 ; N dotlessi ; B 47 -10 226 447 ;
C 248 ; WX 278 ; N lslash ; B 0 -10 264 685 ;
C 249 ; WX 500 ; N oslash ; B 28 -132 468 560 ;
C 250 ; WX 667 ; N oe ; B 26 -15 643 445 ;
C 251 ; WX 500 ; N germandbls ; B -167 -209 492 684 ;
C -1 ; WX 611 ; N Aacute ; B -45 0 564 907 ;
C -1 ; WX 611 ; N Acircumflex ; B -45 0 564 896 ;
C -1 ; WX 611 ; N Adieresis ; B -45 0 564 861 ;
C -1 ; WX 611 ; N Agrave ; B -45 0 564 886 ;
C -1 ; WX 611 ; N Aring ; B -45 0 564 930 ;
C -1 ; WX 611 ; N Atilde ; B -45 0 564 866 ;
C -1 ; WX 667 ; N Ccedilla ; B 33 -206 653 672 ;
C -1 ; WX 611 ; N Eacute ; B -17 0 609 907 ;
C -1 ; WX 611 ; N Ecircumflex ; B -17 0 609 896 ;
C -1 ; WX 611 ; N Edieresis ; B -17 0 609 861 ;
C -1 ; WX 611 ; N Egrave ; B -17 0 609 886 ;
C -1 ; WX 722 ; N Eth ; B -27 0 671 660 ;
C -1 ; WX 333 ; N Iacute ; B -26 0 389 907 ;
C -1 ; WX 333 ; N Icircumflex ; B -26 0 388 896 ;
C -1 ; WX 333 ; N Idieresis ; B -26 0 403 861 ;
C -1 ; WX 333 ; N Igrave ; B -26 0 357 886 ;
C -1 ; WX 667 ; N Ntilde ; B -36 -12 698 866 ;
C -1 ; WX 722 ; N Oacute ; B 42 -23 676 907 ;
C -1 ; WX 722 ; N Ocircumflex ; B 42 -23 676 896 ;
C -1 ; WX 722 ; N Odieresis ; B 42 -23 676 861 ;
C -1 ; WX 722 ; N Ograve ; B 42 -23 676 886 ;
C -1 ; WX 722 ; N Otilde ; B 42 -23 676 866 ;
C -1 ; WX 500 ; N Scaron ; B 9 -22 506 896 ;
C -1 ; WX 611 ; N Thorn ; B -16 0 547 660 ;
C -1 ; WX 722 ; N Uacute ; B 77 -21 747 907 ;
C -1 ; WX 722 ; N Ucircumflex ; B 77 -21 747 896 ;
C -1 ; WX 722 ; N Udieresis ; B 77 -21 747 861 ;
C -1 ; WX 722 ; N Ugrave ; B 77 -21 747 886 ;
C -1 ; WX 556 ; N Yacute ; B 44 0 600 894 ;
C -1 ; WX 556 ; N Ydieresis ; B 44 0 600 861 ;
C -1 ; WX 556 ; N Zcaron ; B -19 0 581 896 ;
C -1 ; WX 500 ; N aacute ; B 15 -11 474 680 ;
C -1 ; WX 500 ; N acircumflex ; B 15 -11 474 669 ;
C -1 ; WX 500 ; N adieresis ; B 15 -11 479 634 ;
C -1 ; WX 500 ; N agrave ; B 15 -11 474 659 ;
C -1 ; WX 500 ; N aring ; B 15 -11 474 703 ;
C -1 ; WX 500 ; N atilde ; B 15 -11 476 639 ;
C -1 ; WX 275 ; N brokenbar ; B -22 -188 251 670 ;
C -1 ; WX 444 ; N ccedilla ; B 32 -206 420 446 ;
C -1 ; WX 760 ; N copyright ; B 40 -22 719 672 ;
C -1 ; WX 400 ; N degree ; B 70 384 370 684 ;
C -1 ; WX 675 ; N divide ; B 85 0 589 505 ;
C -1 ; WX 444 ; N eacute ; B 34 -13 444 680 ;
C -1 ; WX 444 ; N ecircumflex ; B 34 -13 443 669 ;
C -1 ; WX 444 ; N edieresis ; B 34 -13 458 634 ;
C -1 ; WX 444 ; N egrave ; B 34 -13 412 659 ;
C -1 ; WX 500 ; N eth ; B 27 -13 487 682 ;
C -1 ; WX 278 ; N iacute ; B 47 -10 341 680 ;
C -1 ; WX 278 ; N icircumflex ; B 47 -10 340 669 ;
C -1 ; WX 278 ; N idieresis ; B 47 -10 355 634 ;
C -1 ; WX 278 ; N igrave ; B 47 -10 299 659 ;
C -1 ; WX 675 ; N logicalnot ; B 85 113 589 383 ;
C -1 ; WX 675 ; N minus ; B 85 222 589 286 ;
C -1 ; WX 500 ; N mu ; B -60 -206 472 446 ;
C -1 ; WX 675 ; N multiply ; B 85 0 589 504 ;
C -1 ; WX 500 ; N ntilde ; B 23 -10 471 639 ;
C -1 ; WX 500 ; N oacute ; B 27 -13 467 680 ;
C -1 ; WX 500 ; N ocircumflex ; B 27 -13 467 669 ;
C -1 ; WX 500 ; N odieresis ; B 27 -13 479 634 ;
C -1 ; WX 500 ; N ograve ; B 27 -13 467 659 ;
C -1 ; WX 750 ; N onehalf ; B 30 -15 720 684 ;
C -1 ; WX 750 ; N onequarter ; B 30 -15 720 684 ;
C -1 ; WX 300 ; N onesuperior ; B 43 274 277 683 ;
C -1 ; WX 500 ; N otilde ; B 27 -13 476 639 ;
C -1 ; WX 675 ; N plusminus ; B 85 0 589 645 ;
C -1 ; WX 760 ; N registered ; B 40 -22 719 672 ;
C -1 ; WX 389 ; N scaron ; B 16 -14 450 669 ;
C -1 ; WX 500 ; N thorn ; B -75 -206 465 682 ;
C -1 ; WX 750 ; N threequarters ; B 30 -15 720 684 ;
C -1 ; WX 300 ; N threesuperior ; B 13 267 306 684 ;
C -1 ; WX 980 ; N trademark ; B 35 268 945 672 ;
C -1 ; WX 300 ; N twosuperior ; B 8 274 292 684 ;
C -1 ; WX 500 ; N uacute ; B 42 -11 472 680 ;
C -1 ; WX 500 ; N ucircumflex ; B 42 -11 472 669 ;
C -1 ; WX 500 ; N udieresis ; B 42 -11 473 634 ;
C -1 ; WX 500 ; N ugrave ; B 42 -11 472 659 ;
C -1 ; WX 444 ; N yacute ; B -27 -209 431 680 ;
C -1 ; WX 444 ; N ydieresis ; B -27 -209 445 634 ;
C -1 ; WX 389 ; N zcaron ; B 2 0 450 669 ;
EndCharMetrics
StartKernData
StartKernPairs 120
KPX A y -55
KPX A w -55
KPX A v -55
KPX A space -18
KPX A quoteright -37
KPX A Y -55
KPX A W -37
KPX A V -50
KPX A T -37
KPX F period -129
KPX F comma -129
KPX F A -129
KPX L y -30
KPX L space -18
KPX L quoteright -37
KPX L Y -20
KPX L W -37
KPX L V -37
KPX L T -20
KPX P space -18
KPX P period -129
KPX P comma -129
KPX P A -129
KPX R y -18
KPX R Y -18
KPX R W -18
KPX R V -18
KPX R T 0
KPX T y -74
KPX T w -74
KPX T u -55
KPX T space -18
KPX T semicolon -65
KPX T s -92
KPX T r -55
KPX T period -74
KPX T o -92
KPX T i -55
KPX T hyphen -74
KPX T e -92
KPX T comma -74
KPX T colon -55
KPX T c -92
KPX T a -92
KPX T O -18
KPX T A -74
KPX V y -92
KPX V u -74
KPX V space -18
KPX V semicolon -74
KPX V r -74
KPX V period -129
KPX V o -111
KPX V i -74
KPX V hyphen -55
KPX V e -111
KPX V comma -129
KPX V colon -65
KPX V a -111
KPX V O -30
KPX V A -74
KPX W y -92
KPX W u -55
KPX W semicolon -65
KPX W r -55
KPX W period -92
KPX W o -92
KPX W i -55
KPX W hyphen -37
KPX W e -92
KPX W comma -92
KPX W colon -65
KPX W a -92
KPX W A -70
KPX Y v -92
KPX Y u -92
KPX Y semicolon -65
KPX Y q -111
KPX Y period -92
KPX Y p -92
KPX Y o -92
KPX Y i -74
KPX Y hyphen -74
KPX Y e -92
KPX Y comma -92
KPX Y colon -65
KPX Y a -92
KPX Y A -70
KPX f quoteright 92
KPX one one -74
KPX quoteleft quoteleft -111
KPX quoteright t -111
KPX quoteright space -111
KPX quoteright s -129
KPX quoteright quoteright -111
KPX r y 0
KPX r x 0
KPX r w 0
KPX r v 0
KPX r u 0
KPX r t 0
KPX r r 0
KPX r quoteright 37
KPX r q -37
KPX r period -111
KPX r o -37
KPX r hyphen -20
KPX r h -18
KPX r g -37
KPX r e -37
KPX r d -37
KPX r comma -111
KPX r c -37
KPX space A -18
KPX v period -74
KPX v comma -74
KPX w period -74
KPX w comma -74
KPX y period -55
KPX y comma -55
EndKernPairs
EndKernData
StartComposites 58
CC Zcaron 2 ; PCC Z 0 0 ; PCC caron 111 227 ;
CC zcaron 2 ; PCC z 0 0 ; PCC caron 28 0 ;
CC Scaron 2 ; PCC S 0 0 ; PCC caron 83 227 ;
CC scaron 2 ; PCC s 0 0 ; PCC caron 28 0 ;
CC Ccedilla 2 ; PCC C 0 0 ; PCC cedilla 188 0 ;
CC ccedilla 2 ; PCC c 0 0 ; PCC cedilla 61 0 ;
CC Yacute 2 ; PCC Y 0 0 ; PCC acute 111 214 ;
CC yacute 2 ; PCC y 0 0 ; PCC acute 55 0 ;
CC Ydieresis 2 ; PCC Y 0 0 ; PCC dieresis 111 227 ;
CC ydieresis 2 ; PCC y 0 0 ; PCC dieresis 55 0 ;
CC Uacute 2 ; PCC U 0 0 ; PCC acute 228 227 ;
CC Ucircumflex 2 ; PCC U 0 0 ; PCC circumflex 228 227 ;
CC Udieresis 2 ; PCC U 0 0 ; PCC dieresis 228 227 ;
CC Ugrave 2 ; PCC U 0 0 ; PCC grave 228 227 ;
CC uacute 2 ; PCC u 0 0 ; PCC acute 83 0 ;
CC ucircumflex 2 ; PCC u 0 0 ; PCC circumflex 83 0 ;
CC udieresis 2 ; PCC u 0 0 ; PCC dieresis 83 0 ;
CC ugrave 2 ; PCC u 0 0 ; PCC grave 83 0 ;
CC Iacute 2 ; PCC I 0 0 ; PCC acute 14 227 ;
CC Icircumflex 2 ; PCC I 0 0 ; PCC circumflex 14 227 ;
CC Idieresis 2 ; PCC I 0 0 ; PCC dieresis 14 227 ;
CC Igrave 2 ; PCC I 0 0 ; PCC grave 14 227 ;
CC iacute 2 ; PCC dotlessi 0 0 ; PCC acute -34 0 ;
CC icircumflex 2 ; PCC dotlessi 0 0 ; PCC circumflex -34 0 ;
CC idieresis 2 ; PCC dotlessi 0 0 ; PCC dieresis -34 0 ;
CC igrave 2 ; PCC dotlessi 0 0 ; PCC grave -34 0 ;
CC Eacute 2 ; PCC E 0 0 ; PCC acute 160 227 ;
CC Ecircumflex 2 ; PCC E 0 0 ; PCC circumflex 160 227 ;
CC Edieresis 2 ; PCC E 0 0 ; PCC dieresis 160 227 ;
CC Egrave 2 ; PCC E 0 0 ; PCC grave 160 227 ;
CC eacute 2 ; PCC e 0 0 ; PCC acute 68 0 ;
CC ecircumflex 2 ; PCC e 0 0 ; PCC circumflex 68 0 ;
CC edieresis 2 ; PCC e 0 0 ; PCC dieresis 68 0 ;
CC egrave 2 ; PCC e 0 0 ; PCC grave 68 0 ;
CC Aacute 2 ; PCC A 0 0 ; PCC acute 146 227 ;
CC Acircumflex 2 ; PCC A 0 0 ; PCC circumflex 146 227 ;
CC Adieresis 2 ; PCC A 0 0 ; PCC dieresis 146 227 ;
CC Agrave 2 ; PCC A 0 0 ; PCC grave 146 227 ;
CC aacute 2 ; PCC a 0 0 ; PCC acute 89 0 ;
CC acircumflex 2 ; PCC a 0 0 ; PCC circumflex 89 0 ;
CC adieresis 2 ; PCC a 0 0 ; PCC dieresis 89 0 ;
CC agrave 2 ; PCC a 0 0 ; PCC grave 89 0 ;
CC Oacute 2 ; PCC O 0 0 ; PCC acute 221 227 ;
CC Ocircumflex 2 ; PCC O 0 0 ; PCC circumflex 221 227 ;
CC Odieresis 2 ; PCC O 0 0 ; PCC dieresis 221 227 ;
CC Ograve 2 ; PCC O 0 0 ; PCC grave 221 227 ;
CC oacute 2 ; PCC o 0 0 ; PCC acute 89 0 ;
CC ocircumflex 2 ; PCC o 0 0 ; PCC circumflex 89 0 ;
CC odieresis 2 ; PCC o 0 0 ; PCC dieresis 89 0 ;
CC ograve 2 ; PCC o 0 0 ; PCC grave 89 0 ;
CC Atilde 2 ; PCC A 0 0 ; PCC tilde 146 227 ;
CC atilde 2 ; PCC a 0 0 ; PCC tilde 89 0 ;
CC Ntilde 2 ; PCC N 0 0 ; PCC tilde 181 227 ;
CC ntilde 2 ; PCC n 0 0 ; PCC tilde 76 0 ;
CC Otilde 2 ; PCC O 0 0 ; PCC tilde 221 227 ;
CC otilde 2 ; PCC o 0 0 ; PCC tilde 89 0 ;
CC Aring 2 ; PCC A 0 0 ; PCC ring 80 227 ;
CC aring 2 ; PCC a 0 0 ; PCC ring 29 0 ;
EndComposites
EndFontMetrics

445
collects/afm/Times-Roman.afm Normal file
View File

@ -0,0 +1,445 @@
StartFontMetrics 2.0
Comment Copyright (c) 1984 Adobe Systems Incorporated. All Rights Reserved.
Comment Creation Date:Sun Feb 8 01:48:39 PST 1987
FontName Times-Roman
EncodingScheme AdobeStandardEncoding
FullName Times Roman
FamilyName Times
Weight Roman
ItalicAngle 0.0
IsFixedPitch false
UnderlinePosition -109
UnderlineThickness 49
Version 001.002
Notice Times Roman is a trademark of Allied Corporation.
FontBBox -170 -223 1024 896
CapHeight 662
XHeight 448
Descender -217
Ascender 682
StartCharMetrics 228
C 32 ; WX 250 ; N space ; B 0 0 0 0 ;
C 33 ; WX 333 ; N exclam ; B 109 -14 224 676 ;
C 34 ; WX 408 ; N quotedbl ; B 70 445 337 685 ;
C 35 ; WX 500 ; N numbersign ; B 4 0 495 662 ;
C 36 ; WX 500 ; N dollar ; B 44 -87 456 727 ;
C 37 ; WX 833 ; N percent ; B 61 -14 772 676 ;
C 38 ; WX 778 ; N ampersand ; B 42 -14 750 676 ;
C 39 ; WX 333 ; N quoteright ; B 103 432 242 676 ;
C 40 ; WX 333 ; N parenleft ; B 49 -177 304 676 ;
C 41 ; WX 333 ; N parenright ; B 29 -177 284 676 ;
C 42 ; WX 500 ; N asterisk ; B 64 265 437 683 ;
C 43 ; WX 564 ; N plus ; B 30 7 534 512 ;
C 44 ; WX 250 ; N comma ; B 63 -143 202 101 ;
C 45 ; WX 333 ; N hyphen ; B 43 194 289 257 ;
C 46 ; WX 250 ; N period ; B 68 -14 183 101 ;
C 47 ; WX 278 ; N slash ; B -12 -108 302 682 ;
C 48 ; WX 500 ; N zero ; B 24 -14 476 676 ;
C 49 ; WX 500 ; N one ; B 111 0 394 676 ;
C 50 ; WX 500 ; N two ; B 30 0 475 676 ;
C 51 ; WX 500 ; N three ; B 44 -14 431 676 ;
C 52 ; WX 500 ; N four ; B 12 0 472 676 ;
C 53 ; WX 500 ; N five ; B 32 -14 438 688 ;
C 54 ; WX 500 ; N six ; B 35 -14 468 682 ;
C 55 ; WX 500 ; N seven ; B 20 -14 449 662 ;
C 56 ; WX 500 ; N eight ; B 53 -14 442 676 ;
C 57 ; WX 500 ; N nine ; B 30 -22 460 676 ;
C 58 ; WX 278 ; N colon ; B 81 -14 196 458 ;
C 59 ; WX 278 ; N semicolon ; B 63 -143 202 458 ;
C 60 ; WX 564 ; N less ; B 27 0 536 522 ;
C 61 ; WX 564 ; N equal ; B 30 132 534 390 ;
C 62 ; WX 564 ; N greater ; B 27 0 536 522 ;
C 63 ; WX 444 ; N question ; B 49 -14 395 676 ;
C 64 ; WX 921 ; N at ; B 0 -155 819 675 ;
C 65 ; WX 722 ; N A ; B 15 0 706 676 ;
C 66 ; WX 667 ; N B ; B 20 0 596 662 ;
C 67 ; WX 667 ; N C ; B 33 -14 637 676 ;
C 68 ; WX 722 ; N D ; B 20 0 689 662 ;
C 69 ; WX 611 ; N E ; B 12 0 597 662 ;
C 70 ; WX 556 ; N F ; B 12 0 544 662 ;
C 71 ; WX 722 ; N G ; B 27 -14 704 676 ;
C 72 ; WX 722 ; N H ; B 20 0 703 662 ;
C 73 ; WX 333 ; N I ; B 18 0 316 662 ;
C 74 ; WX 389 ; N J ; B 10 -14 376 662 ;
C 75 ; WX 722 ; N K ; B 20 0 709 662 ;
C 76 ; WX 611 ; N L ; B 12 0 598 662 ;
C 77 ; WX 889 ; N M ; B 19 0 871 662 ;
C 78 ; WX 722 ; N N ; B 12 -14 709 662 ;
C 79 ; WX 722 ; N O ; B 33 -14 688 676 ;
C 80 ; WX 556 ; N P ; B 11 0 542 662 ;
C 81 ; WX 722 ; N Q ; B 33 -177 701 676 ;
C 82 ; WX 667 ; N R ; B 12 0 654 662 ;
C 83 ; WX 556 ; N S ; B 42 -14 491 676 ;
C 84 ; WX 611 ; N T ; B 18 0 594 662 ;
C 85 ; WX 722 ; N U ; B 16 -14 705 662 ;
C 86 ; WX 722 ; N V ; B 20 -14 701 662 ;
C 87 ; WX 944 ; N W ; B 9 -14 936 662 ;
C 88 ; WX 722 ; N X ; B 12 0 706 662 ;
C 89 ; WX 722 ; N Y ; B 22 0 703 662 ;
C 90 ; WX 611 ; N Z ; B 7 0 597 662 ;
C 91 ; WX 333 ; N bracketleft ; B 88 -156 299 662 ;
C 92 ; WX 278 ; N backslash ; B -83 0 361 682 ;
C 93 ; WX 333 ; N bracketright ; B 34 -156 245 662 ;
C 94 ; WX 469 ; N asciicircum ; B 13 256 456 662 ;
C 95 ; WX 500 ; N underscore ; B 0 -133 500 -84 ;
C 96 ; WX 333 ; N quoteleft ; B 91 432 230 676 ;
C 97 ; WX 444 ; N a ; B 37 -10 442 458 ;
C 98 ; WX 500 ; N b ; B 9 -10 474 682 ;
C 99 ; WX 444 ; N c ; B 25 -10 412 458 ;
C 100 ; WX 500 ; N d ; B 26 -13 491 682 ;
C 101 ; WX 444 ; N e ; B 22 -10 421 458 ;
C 102 ; WX 333 ; N f ; B 20 0 383 682 ; L i fi ; L l fl ;
C 103 ; WX 500 ; N g ; B 27 -217 470 458 ;
C 104 ; WX 500 ; N h ; B 9 0 490 682 ;
C 105 ; WX 278 ; N i ; B 22 0 259 682 ;
C 106 ; WX 278 ; N j ; B -54 -217 212 682 ;
C 107 ; WX 500 ; N k ; B 1 0 500 682 ;
C 108 ; WX 278 ; N l ; B 20 0 259 682 ;
C 109 ; WX 778 ; N m ; B 13 0 764 458 ;
C 110 ; WX 500 ; N n ; B 9 0 490 458 ;
C 111 ; WX 500 ; N o ; B 30 -10 470 458 ;
C 112 ; WX 500 ; N p ; B 2 -217 470 458 ;
C 113 ; WX 500 ; N q ; B 24 -217 498 459 ;
C 114 ; WX 333 ; N r ; B 4 0 335 458 ;
C 115 ; WX 389 ; N s ; B 51 -10 348 458 ;
C 116 ; WX 278 ; N t ; B 13 -10 279 580 ;
C 117 ; WX 500 ; N u ; B 9 -10 479 448 ;
C 118 ; WX 500 ; N v ; B 10 -10 468 448 ;
C 119 ; WX 722 ; N w ; B 21 -10 694 448 ;
C 120 ; WX 500 ; N x ; B 17 0 479 448 ;
C 121 ; WX 500 ; N y ; B 15 -217 476 448 ;
C 122 ; WX 444 ; N z ; B 25 0 418 448 ;
C 123 ; WX 480 ; N braceleft ; B 110 -165 341 682 ;
C 124 ; WX 200 ; N bar ; B 68 0 132 682 ;
C 125 ; WX 480 ; N braceright ; B 139 -165 370 682 ;
C 126 ; WX 541 ; N asciitilde ; B 18 176 522 347 ;
C 161 ; WX 333 ; N exclamdown ; B 109 -217 224 458 ;
C 162 ; WX 500 ; N cent ; B 53 -138 448 579 ;
C 163 ; WX 500 ; N sterling ; B 11 -14 491 676 ;
C 164 ; WX 167 ; N fraction ; B -170 -14 346 676 ;
C 165 ; WX 500 ; N yen ; B -43 0 502 662 ;
C 166 ; WX 500 ; N florin ; B 6 -185 490 676 ;
C 167 ; WX 500 ; N section ; B 72 -148 426 676 ;
C 168 ; WX 500 ; N currency ; B -2 99 503 600 ;
C 169 ; WX 180 ; N quotesingle ; B 47 445 133 685 ;
C 170 ; WX 444 ; N quotedblleft ; B 27 432 399 676 ;
C 171 ; WX 500 ; N guillemotleft ; B 32 35 449 422 ;
C 172 ; WX 333 ; N guilsinglleft ; B 45 35 271 422 ;
C 173 ; WX 333 ; N guilsinglright ; B 62 36 288 423 ;
C 174 ; WX 556 ; N fi ; B 33 0 521 678 ;
C 175 ; WX 556 ; N fl ; B 29 0 521 682 ;
C 177 ; WX 500 ; N endash ; B -7 201 507 250 ;
C 178 ; WX 500 ; N dagger ; B 54 -149 440 676 ;
C 179 ; WX 500 ; N daggerdbl ; B 54 -153 439 676 ;
C 180 ; WX 250 ; N periodcentered ; B 68 204 183 319 ;
C 182 ; WX 453 ; N paragraph ; B 0 -207 373 662 ;
C 183 ; WX 350 ; N bullet ; B 50 175 300 425 ;
C 184 ; WX 333 ; N quotesinglbase ; B 103 -143 242 101 ;
C 185 ; WX 444 ; N quotedblbase ; B 45 -143 417 101 ;
C 186 ; WX 444 ; N quotedblright ; B 45 432 417 676 ;
C 187 ; WX 500 ; N guillemotright ; B 51 35 468 422 ;
C 188 ; WX 1000 ; N ellipsis ; B 110 -14 891 101 ;
C 189 ; WX 1000 ; N perthousand ; B 3 -14 1024 676 ;
C 191 ; WX 444 ; N questiondown ; B 49 -217 395 458 ;
C 193 ; WX 333 ; N grave ; B 16 507 243 678 ;
C 194 ; WX 333 ; N acute ; B 93 507 317 678 ;
C 195 ; WX 333 ; N circumflex ; B 11 507 323 674 ;
C 196 ; WX 333 ; N tilde ; B 1 532 332 638 ;
C 197 ; WX 333 ; N macron ; B 11 547 323 601 ;
C 198 ; WX 333 ; N breve ; B 26 507 308 664 ;
C 199 ; WX 333 ; N dotaccent ; B 116 523 216 623 ;
C 200 ; WX 333 ; N dieresis ; B 18 523 316 623 ;
C 202 ; WX 333 ; N ring ; B 67 483 266 682 ;
C 203 ; WX 333 ; N cedilla ; B 53 -215 262 0 ;
C 205 ; WX 333 ; N hungarumlaut ; B 8 528 372 700 ;
C 206 ; WX 333 ; N ogonek ; B 68 -155 245 -10 ;
C 207 ; WX 333 ; N caron ; B 11 507 323 674 ;
C 208 ; WX 1000 ; N emdash ; B -8 201 1007 250 ;
C 225 ; WX 889 ; N AE ; B 5 0 869 662 ;
C 227 ; WX 276 ; N ordfeminine ; B 15 307 278 676 ;
C 232 ; WX 611 ; N Lslash ; B 12 0 598 662 ;
C 233 ; WX 722 ; N Oslash ; B 33 -80 688 734 ;
C 234 ; WX 889 ; N OE ; B 21 -7 877 669 ;
C 235 ; WX 310 ; N ordmasculine ; B 15 307 301 676 ;
C 241 ; WX 667 ; N ae ; B 38 -10 634 458 ;
C 245 ; WX 278 ; N dotlessi ; B 22 0 259 458 ;
C 248 ; WX 278 ; N lslash ; B 20 0 259 682 ;
C 249 ; WX 500 ; N oslash ; B 30 -108 470 549 ;
C 250 ; WX 722 ; N oe ; B 30 -10 690 458 ;
C 251 ; WX 500 ; N germandbls ; B 12 -10 468 682 ;
C -1 ; WX 722 ; N Aacute ; B 15 0 706 892 ;
C -1 ; WX 722 ; N Acircumflex ; B 15 0 706 888 ;
C -1 ; WX 722 ; N Adieresis ; B 15 0 706 837 ;
C -1 ; WX 722 ; N Agrave ; B 15 0 706 892 ;
C -1 ; WX 722 ; N Aring ; B 15 0 706 896 ;
C -1 ; WX 722 ; N Atilde ; B 15 0 706 852 ;
C -1 ; WX 667 ; N Ccedilla ; B 33 -215 637 676 ;
C -1 ; WX 611 ; N Eacute ; B 12 0 597 892 ;
C -1 ; WX 611 ; N Ecircumflex ; B 12 0 597 888 ;
C -1 ; WX 611 ; N Edieresis ; B 12 0 597 837 ;
C -1 ; WX 611 ; N Egrave ; B 12 0 597 892 ;
C -1 ; WX 722 ; N Eth ; B 20 0 689 662 ;
C -1 ; WX 333 ; N Iacute ; B 18 0 317 892 ;
C -1 ; WX 333 ; N Icircumflex ; B 11 0 323 888 ;
C -1 ; WX 333 ; N Idieresis ; B 18 0 316 837 ;
C -1 ; WX 333 ; N Igrave ; B 16 0 316 892 ;
C -1 ; WX 722 ; N Ntilde ; B 12 -14 709 852 ;
C -1 ; WX 722 ; N Oacute ; B 33 -14 688 892 ;
C -1 ; WX 722 ; N Ocircumflex ; B 33 -14 688 888 ;
C -1 ; WX 722 ; N Odieresis ; B 33 -14 688 837 ;
C -1 ; WX 722 ; N Ograve ; B 33 -14 688 892 ;
C -1 ; WX 722 ; N Otilde ; B 33 -14 688 852 ;
C -1 ; WX 556 ; N Scaron ; B 42 -14 491 888 ;
C -1 ; WX 556 ; N Thorn ; B 11 0 542 662 ;
C -1 ; WX 722 ; N Uacute ; B 16 -14 705 892 ;
C -1 ; WX 722 ; N Ucircumflex ; B 16 -14 705 888 ;
C -1 ; WX 722 ; N Udieresis ; B 16 -14 705 837 ;
C -1 ; WX 722 ; N Ugrave ; B 16 -14 705 892 ;
C -1 ; WX 722 ; N Yacute ; B 22 0 703 892 ;
C -1 ; WX 722 ; N Ydieresis ; B 22 0 703 837 ;
C -1 ; WX 611 ; N Zcaron ; B 7 0 597 888 ;
C -1 ; WX 444 ; N aacute ; B 37 -10 442 678 ;
C -1 ; WX 444 ; N acircumflex ; B 37 -10 442 674 ;
C -1 ; WX 444 ; N adieresis ; B 37 -10 442 623 ;
C -1 ; WX 444 ; N agrave ; B 37 -10 442 678 ;
C -1 ; WX 444 ; N aring ; B 37 -10 442 682 ;
C -1 ; WX 444 ; N atilde ; B 37 -10 442 638 ;
C -1 ; WX 200 ; N brokenbar ; B 68 0 132 682 ;
C -1 ; WX 444 ; N ccedilla ; B 25 -215 412 458 ;
C -1 ; WX 760 ; N copyright ; B 42 -14 717 676 ;
C -1 ; WX 400 ; N degree ; B 50 376 350 676 ;
C -1 ; WX 564 ; N divide ; B 30 10 534 512 ;
C -1 ; WX 444 ; N eacute ; B 22 -10 421 678 ;
C -1 ; WX 444 ; N ecircumflex ; B 22 -10 421 674 ;
C -1 ; WX 444 ; N edieresis ; B 22 -10 421 623 ;
C -1 ; WX 444 ; N egrave ; B 22 -10 421 678 ;
C -1 ; WX 500 ; N eth ; B 30 -10 470 682 ;
C -1 ; WX 278 ; N iacute ; B 22 0 290 678 ;
C -1 ; WX 278 ; N icircumflex ; B -16 0 296 674 ;
C -1 ; WX 278 ; N idieresis ; B -9 0 289 623 ;
C -1 ; WX 278 ; N igrave ; B -11 0 259 678 ;
C -1 ; WX 564 ; N logicalnot ; B 30 120 534 390 ;
C -1 ; WX 564 ; N minus ; B 30 229 534 293 ;
C -1 ; WX 500 ; N mu ; B 9 -223 479 448 ;
C -1 ; WX 564 ; N multiply ; B 30 8 534 512 ;
C -1 ; WX 500 ; N ntilde ; B 9 0 490 638 ;
C -1 ; WX 500 ; N oacute ; B 30 -10 470 678 ;
C -1 ; WX 500 ; N ocircumflex ; B 30 -10 470 674 ;
C -1 ; WX 500 ; N odieresis ; B 30 -10 470 623 ;
C -1 ; WX 500 ; N ograve ; B 30 -10 470 678 ;
C -1 ; WX 750 ; N onehalf ; B 30 -14 720 676 ;
C -1 ; WX 750 ; N onequarter ; B 30 -14 720 676 ;
C -1 ; WX 300 ; N onesuperior ; B 58 270 242 676 ;
C -1 ; WX 500 ; N otilde ; B 30 -10 470 638 ;
C -1 ; WX 564 ; N plusminus ; B 30 0 534 612 ;
C -1 ; WX 760 ; N registered ; B 43 -14 718 676 ;
C -1 ; WX 389 ; N scaron ; B 39 -10 351 674 ;
C -1 ; WX 500 ; N thorn ; B 2 -217 470 682 ;
C -1 ; WX 750 ; N threequarters ; B 30 -14 720 676 ;
C -1 ; WX 300 ; N threesuperior ; B 24 262 275 676 ;
C -1 ; WX 980 ; N trademark ; B 35 258 945 662 ;
C -1 ; WX 300 ; N twosuperior ; B 5 270 294 676 ;
C -1 ; WX 500 ; N uacute ; B 9 -10 479 678 ;
C -1 ; WX 500 ; N ucircumflex ; B 9 -10 479 674 ;
C -1 ; WX 500 ; N udieresis ; B 9 -10 479 623 ;
C -1 ; WX 500 ; N ugrave ; B 9 -10 479 678 ;
C -1 ; WX 500 ; N yacute ; B 15 -217 476 678 ;
C -1 ; WX 500 ; N ydieresis ; B 15 -217 476 623 ;
C -1 ; WX 444 ; N zcaron ; B 25 0 418 674 ;
EndCharMetrics
StartKernData
StartKernPairs 113
KPX A y -92
KPX A w -92
KPX A v -74
KPX A space -55
KPX A quoteright -111
KPX A Y -92
KPX A W -80
KPX A V -129
KPX A T -111
KPX F period -80
KPX F comma -80
KPX F A -74
KPX L y -55
KPX L space -37
KPX L quoteright -92
KPX L Y -100
KPX L W -74
KPX L V -92
KPX L T -92
KPX P space -37
KPX P period -111
KPX P comma -111
KPX P A -92
KPX R y -40
KPX R Y -55
KPX R W -55
KPX R V -80
KPX R T -60
KPX T y -70
KPX T w -70
KPX T u -35
KPX T space -18
KPX T semicolon -55
KPX T s -70
KPX T r -35
KPX T period -74
KPX T o -70
KPX T i -35
KPX T hyphen -92
KPX T e -70
KPX T comma -74
KPX T colon -50
KPX T c -70
KPX T a -70
KPX T O -18
KPX T A -80
KPX V y -111
KPX V u -60
KPX V space -18
KPX V semicolon -74
KPX V r -60
KPX V period -129
KPX V o -129
KPX V i -60
KPX V hyphen -92
KPX V e -111
KPX V comma -129
KPX V colon -74
KPX V a -111
KPX V A -129
KPX W y -60
KPX W u -40
KPX W space -18
KPX W semicolon -37
KPX W r -40
KPX W period -92
KPX W o -80
KPX W i -40
KPX W hyphen -55
KPX W e -80
KPX W comma -92
KPX W colon -37
KPX W a -80
KPX W A -111
KPX Y v -100
KPX Y u -111
KPX Y space -37
KPX Y semicolon -92
KPX Y q -111
KPX Y period -129
KPX Y p -92
KPX Y o -100
KPX Y i -55
KPX Y hyphen -111
KPX Y e -100
KPX Y comma -129
KPX Y colon -92
KPX Y a -100
KPX Y A -111
KPX f quoteright 55
KPX f f -18
KPX one one -37
KPX quoteleft quoteleft -74
KPX quoteright t -18
KPX quoteright space -74
KPX quoteright s -55
KPX quoteright quoteright -74
KPX r quoteright 37
KPX r period -55
KPX r hyphen -20
KPX r g -18
KPX r comma -40
KPX space Y -37
KPX space W -18
KPX space V -18
KPX space T -18
KPX space A -55
KPX v period -65
KPX v comma -65
KPX w period -65
KPX w comma -65
KPX y period -65
KPX y comma -65
EndKernPairs
EndKernData
StartComposites 58
CC Zcaron 2 ; PCC Z 0 0 ; PCC caron 139 214 ;
CC zcaron 2 ; PCC z 0 0 ; PCC caron 55 0 ;
CC Scaron 2 ; PCC S 0 0 ; PCC caron 111 214 ;
CC scaron 2 ; PCC s 0 0 ; PCC caron 28 0 ;
CC Ccedilla 2 ; PCC C 0 0 ; PCC cedilla 167 0 ;
CC ccedilla 2 ; PCC c 0 0 ; PCC cedilla 55 0 ;
CC Yacute 2 ; PCC Y 0 0 ; PCC acute 194 214 ;
CC yacute 2 ; PCC y 0 0 ; PCC acute 83 0 ;
CC Ydieresis 2 ; PCC Y 0 0 ; PCC dieresis 194 214 ;
CC ydieresis 2 ; PCC y 0 0 ; PCC dieresis 83 0 ;
CC Uacute 2 ; PCC U 0 0 ; PCC acute 194 214 ;
CC Ucircumflex 2 ; PCC U 0 0 ; PCC circumflex 194 214 ;
CC Udieresis 2 ; PCC U 0 0 ; PCC dieresis 194 214 ;
CC Ugrave 2 ; PCC U 0 0 ; PCC grave 194 214 ;
CC uacute 2 ; PCC u 0 0 ; PCC acute 83 0 ;
CC ucircumflex 2 ; PCC u 0 0 ; PCC circumflex 83 0 ;
CC udieresis 2 ; PCC u 0 0 ; PCC dieresis 83 0 ;
CC ugrave 2 ; PCC u 0 0 ; PCC grave 83 0 ;
CC Iacute 2 ; PCC I 0 0 ; PCC acute 0 214 ;
CC Icircumflex 2 ; PCC I 0 0 ; PCC circumflex 0 214 ;
CC Idieresis 2 ; PCC I 0 0 ; PCC dieresis 0 214 ;
CC Igrave 2 ; PCC I 0 0 ; PCC grave 0 214 ;
CC iacute 2 ; PCC dotlessi 0 0 ; PCC acute -27 0 ;
CC icircumflex 2 ; PCC dotlessi 0 0 ; PCC circumflex -27 0 ;
CC idieresis 2 ; PCC dotlessi 0 0 ; PCC dieresis -27 0 ;
CC igrave 2 ; PCC dotlessi 0 0 ; PCC grave -27 0 ;
CC Eacute 2 ; PCC E 0 0 ; PCC acute 139 214 ;
CC Ecircumflex 2 ; PCC E 0 0 ; PCC circumflex 139 214 ;
CC Edieresis 2 ; PCC E 0 0 ; PCC dieresis 139 214 ;
CC Egrave 2 ; PCC E 0 0 ; PCC grave 139 214 ;
CC eacute 2 ; PCC e 0 0 ; PCC acute 55 0 ;
CC ecircumflex 2 ; PCC e 0 0 ; PCC circumflex 55 0 ;
CC edieresis 2 ; PCC e 0 0 ; PCC dieresis 55 0 ;
CC egrave 2 ; PCC e 0 0 ; PCC grave 55 0 ;
CC Aacute 2 ; PCC A 0 0 ; PCC acute 194 214 ;
CC Acircumflex 2 ; PCC A 0 0 ; PCC circumflex 194 214 ;
CC Adieresis 2 ; PCC A 0 0 ; PCC dieresis 194 214 ;
CC Agrave 2 ; PCC A 0 0 ; PCC grave 194 214 ;
CC aacute 2 ; PCC a 0 0 ; PCC acute 55 0 ;
CC acircumflex 2 ; PCC a 0 0 ; PCC circumflex 55 0 ;
CC adieresis 2 ; PCC a 0 0 ; PCC dieresis 55 0 ;
CC agrave 2 ; PCC a 0 0 ; PCC grave 55 0 ;
CC Oacute 2 ; PCC O 0 0 ; PCC acute 194 214 ;
CC Ocircumflex 2 ; PCC O 0 0 ; PCC circumflex 194 214 ;
CC Odieresis 2 ; PCC O 0 0 ; PCC dieresis 194 214 ;
CC Ograve 2 ; PCC O 0 0 ; PCC grave 194 214 ;
CC oacute 2 ; PCC o 0 0 ; PCC acute 83 0 ;
CC ocircumflex 2 ; PCC o 0 0 ; PCC circumflex 83 0 ;
CC odieresis 2 ; PCC o 0 0 ; PCC dieresis 83 0 ;
CC ograve 2 ; PCC o 0 0 ; PCC grave 83 0 ;
CC Atilde 2 ; PCC A 0 0 ; PCC tilde 194 214 ;
CC atilde 2 ; PCC a 0 0 ; PCC tilde 55 0 ;
CC Ntilde 2 ; PCC N 0 0 ; PCC tilde 194 214 ;
CC ntilde 2 ; PCC n 0 0 ; PCC tilde 83 0 ;
CC Otilde 2 ; PCC O 0 0 ; PCC tilde 194 214 ;
CC otilde 2 ; PCC o 0 0 ; PCC tilde 83 0 ;
CC Aring 2 ; PCC A 0 0 ; PCC ring 194 214 ;
CC aring 2 ; PCC a 0 0 ; PCC ring 55 0 ;
EndComposites
EndFontMetrics

437
collects/afm/ZapfChancery-MediumItalic.afm Normal file
View File

@ -0,0 +1,437 @@
StartFontMetrics 2.0
Comment Copyright (c) 1984 Adobe Systems Incorporated. All Rights Reserved.
Comment Creation Date:Tue Apr 21 09:12:34 PST 1987
FontName ZapfChancery-MediumItalic
EncodingScheme AdobeStandardEncoding
FullName ITC Zapf Chancery Medium Italic
FamilyName ITC Zapf Chancery
Weight Medium
ItalicAngle -14.0
IsFixedPitch false
UnderlinePosition -120
UnderlineThickness 50
Version 001.003
Notice ITC Zapf Chancery is a registered trademark of International Typeface Corporation.
FontBBox -133 -257 1078 811
CapHeight 587
XHeight 408
Descender -248
Ascender 678
StartCharMetrics 228
C 32 ; WX 220 ; N space ; B 0 0 0 0 ;
C 33 ; WX 280 ; N exclam ; B 109 -9 347 588 ;
C 34 ; WX 220 ; N quotedbl ; B 170 494 333 681 ;
C 35 ; WX 440 ; N numbersign ; B 63 -1 596 575 ;
C 36 ; WX 440 ; N dollar ; B 60 -145 461 675 ;
C 37 ; WX 680 ; N percent ; B 162 -7 701 585 ;
C 38 ; WX 780 ; N ampersand ; B 121 -15 855 558 ;
C 39 ; WX 240 ; N quoteright ; B 228 455 358 675 ;
C 40 ; WX 260 ; N parenleft ; B 116 -165 412 667 ;
C 41 ; WX 220 ; N parenright ; B 17 -164 313 668 ;
C 42 ; WX 420 ; N asterisk ; B 220 376 512 676 ;
C 43 ; WX 520 ; N plus ; B 103 0 513 410 ;
C 44 ; WX 220 ; N comma ; B 30 -98 215 171 ;
C 45 ; WX 280 ; N hyphen ; B 115 173 300 236 ;
C 46 ; WX 220 ; N period ; B 107 -9 228 127 ;
C 47 ; WX 340 ; N slash ; B -6 -168 535 677 ;
C 48 ; WX 440 ; N zero ; B 94 -7 489 576 ;
C 49 ; WX 440 ; N one ; B 82 1 434 584 ;
C 50 ; WX 440 ; N two ; B 47 -17 469 572 ;
C 51 ; WX 440 ; N three ; B 36 -6 457 576 ;
C 52 ; WX 440 ; N four ; B 69 -26 455 585 ;
C 53 ; WX 440 ; N five ; B 67 -8 565 641 ;
C 54 ; WX 440 ; N six ; B 95 -8 532 585 ;
C 55 ; WX 440 ; N seven ; B 165 -18 541 612 ;
C 56 ; WX 440 ; N eight ; B 75 -9 494 573 ;
C 57 ; WX 440 ; N nine ; B 42 -8 480 576 ;
C 58 ; WX 260 ; N colon ; B 98 -9 289 408 ;
C 59 ; WX 240 ; N semicolon ; B 29 -98 277 408 ;
C 60 ; WX 520 ; N less ; B 120 -17 557 429 ;
C 61 ; WX 520 ; N equal ; B 108 113 518 297 ;
C 62 ; WX 520 ; N greater ; B 119 -17 556 429 ;
C 63 ; WX 380 ; N question ; B 130 -9 497 583 ;
C 64 ; WX 700 ; N at ; B 102 -15 765 690 ;
C 65 ; WX 620 ; N A ; B 23 -16 687 593 ;
C 66 ; WX 600 ; N B ; B 75 0 642 618 ;
C 67 ; WX 520 ; N C ; B 88 -73 635 592 ;
C 68 ; WX 700 ; N D ; B 86 0 759 618 ;
C 69 ; WX 620 ; N E ; B 76 -8 668 587 ;
C 70 ; WX 580 ; N F ; B 60 -114 733 621 ;
C 71 ; WX 620 ; N G ; B 118 -236 670 592 ;
C 72 ; WX 680 ; N H ; B 33 -7 908 681 ;
C 73 ; WX 380 ; N I ; B 81 0 481 573 ;
C 74 ; WX 400 ; N J ; B 1 -122 491 573 ;
C 75 ; WX 660 ; N K ; B 88 -143 851 578 ;
C 76 ; WX 580 ; N L ; B 33 -6 631 577 ;
C 77 ; WX 840 ; N M ; B 58 -9 1009 671 ;
C 78 ; WX 700 ; N N ; B 40 -158 915 682 ;
C 79 ; WX 600 ; N O ; B 104 -13 652 589 ;
C 80 ; WX 540 ; N P ; B 37 2 645 602 ;
C 81 ; WX 600 ; N Q ; B 104 -189 851 589 ;
C 82 ; WX 600 ; N R ; B 38 -147 826 615 ;
C 83 ; WX 460 ; N S ; B 0 -67 517 590 ;
C 84 ; WX 500 ; N T ; B 58 0 718 650 ;
C 85 ; WX 740 ; N U ; B 116 -10 778 581 ;
C 86 ; WX 640 ; N V ; B 104 -8 809 689 ;
C 87 ; WX 880 ; N W ; B 104 -17 1035 677 ;
C 88 ; WX 560 ; N X ; B 0 -13 671 580 ;
C 89 ; WX 560 ; N Y ; B 31 -152 763 608 ;
C 90 ; WX 620 ; N Z ; B 62 -18 675 598 ;
C 91 ; WX 240 ; N bracketleft ; B 47 -164 404 667 ;
C 92 ; WX 480 ; N backslash ; B 185 0 484 578 ;
C 93 ; WX 320 ; N bracketright ; B 23 -164 381 667 ;
C 94 ; WX 520 ; N asciicircum ; B 212 447 472 681 ;
C 95 ; WX 500 ; N underscore ; B 0 -145 500 -95 ;
C 96 ; WX 240 ; N quoteleft ; B 229 435 384 675 ;
C 97 ; WX 420 ; N a ; B 87 -11 492 415 ;
C 98 ; WX 420 ; N b ; B 87 -17 466 678 ;
C 99 ; WX 340 ; N c ; B 87 -13 383 411 ;
C 100 ; WX 440 ; N d ; B 87 -12 629 678 ;
C 101 ; WX 340 ; N e ; B 87 -12 380 412 ;
C 102 ; WX 320 ; N f ; B -99 -247 541 680 ; L i fi ; L l fl ;
C 103 ; WX 400 ; N g ; B -78 -248 481 409 ;
C 104 ; WX 440 ; N h ; B 75 -15 506 679 ;
C 105 ; WX 240 ; N i ; B 81 -12 311 617 ;
C 106 ; WX 220 ; N j ; B -133 -247 303 617 ;
C 107 ; WX 440 ; N k ; B 87 -148 655 675 ;
C 108 ; WX 240 ; N l ; B 87 -11 434 681 ;
C 109 ; WX 620 ; N m ; B 81 -10 693 413 ;
C 110 ; WX 460 ; N n ; B 81 -15 520 411 ;
C 111 ; WX 400 ; N o ; B 87 -13 449 411 ;
C 112 ; WX 440 ; N p ; B -8 -248 482 411 ;
C 113 ; WX 400 ; N q ; B 87 -250 485 480 ;
C 114 ; WX 300 ; N r ; B 81 -10 409 411 ;
C 115 ; WX 320 ; N s ; B 41 -15 377 410 ;
C 116 ; WX 320 ; N t ; B 96 -12 392 504 ;
C 117 ; WX 460 ; N u ; B 82 -12 518 416 ;
C 118 ; WX 440 ; N v ; B 87 -13 510 438 ;
C 119 ; WX 680 ; N w ; B 87 -13 757 445 ;
C 120 ; WX 420 ; N x ; B 70 -159 583 408 ;
C 121 ; WX 400 ; N y ; B 11 -249 473 415 ;
C 122 ; WX 440 ; N z ; B 46 -12 475 426 ;
C 123 ; WX 240 ; N braceleft ; B 105 -164 405 668 ;
C 124 ; WX 520 ; N bar ; B 314 0 363 578 ;
C 125 ; WX 240 ; N braceright ; B 10 -164 307 668 ;
C 126 ; WX 520 ; N asciitilde ; B 86 146 526 261 ;
C 161 ; WX 280 ; N exclamdown ; B 57 -187 295 410 ;
C 162 ; WX 440 ; N cent ; B 127 -76 453 647 ;
C 163 ; WX 440 ; N sterling ; B 4 -54 436 578 ;
C 164 ; WX 60 ; N fraction ; B -115 -4 280 585 ;
C 165 ; WX 440 ; N yen ; B -11 0 623 578 ;
C 166 ; WX 440 ; N florin ; B -49 -247 587 682 ;
C 167 ; WX 420 ; N section ; B 63 -165 464 576 ;
C 168 ; WX 440 ; N currency ; B 50 106 480 532 ;
C 169 ; WX 160 ; N quotesingle ; B 170 494 259 681 ;
C 170 ; WX 340 ; N quotedblleft ; B 229 435 500 675 ;
C 171 ; WX 340 ; N guillemotleft ; B 98 -9 404 414 ;
C 172 ; WX 240 ; N guilsinglleft ; B 98 -9 285 415 ;
C 173 ; WX 260 ; N guilsinglright ; B 86 -2 284 424 ;
C 174 ; WX 520 ; N fi ; B -104 -248 606 681 ;
C 175 ; WX 520 ; N fl ; B -105 -247 710 690 ;
C 177 ; WX 500 ; N endash ; B 31 173 578 236 ;
C 178 ; WX 460 ; N dagger ; B 98 -138 529 607 ;
C 179 ; WX 480 ; N daggerdbl ; B 98 -138 529 608 ;
C 180 ; WX 220 ; N periodcentered ; B 108 147 229 283 ;
C 182 ; WX 500 ; N paragraph ; B 29 -247 650 585 ;
C 183 ; WX 600 ; N bullet ; B 228 117 568 458 ;
C 184 ; WX 180 ; N quotesinglbase ; B 40 -109 170 111 ;
C 185 ; WX 280 ; N quotedblbase ; B 41 -109 286 111 ;
C 186 ; WX 360 ; N quotedblright ; B 228 455 473 675 ;
C 187 ; WX 380 ; N guillemotright ; B 87 -2 407 424 ;
C 188 ; WX 1000 ; N ellipsis ; B 106 -9 893 127 ;
C 189 ; WX 960 ; N perthousand ; B 162 -7 975 585 ;
C 191 ; WX 400 ; N questiondown ; B 57 -181 425 410 ;
C 193 ; WX 220 ; N grave ; B 173 444 281 639 ;
C 194 ; WX 300 ; N acute ; B 205 444 388 639 ;
C 195 ; WX 340 ; N circumflex ; B 183 442 397 640 ;
C 196 ; WX 440 ; N tilde ; B 183 481 513 602 ;
C 197 ; WX 440 ; N macron ; B 183 513 515 569 ;
C 198 ; WX 440 ; N breve ; B 183 486 516 597 ;
C 199 ; WX 220 ; N dotaccent ; B 206 480 309 602 ;
C 200 ; WX 360 ; N dieresis ; B 183 480 419 602 ;
C 202 ; WX 300 ; N ring ; B 228 452 409 631 ;
C 203 ; WX 300 ; N cedilla ; B 41 -189 216 6 ;
C 205 ; WX 400 ; N hungarumlaut ; B 183 444 463 639 ;
C 206 ; WX 280 ; N ogonek ; B 58 -193 216 -41 ;
C 207 ; WX 340 ; N caron ; B 234 442 447 640 ;
C 208 ; WX 1000 ; N emdash ; B 31 173 1078 236 ;
C 225 ; WX 740 ; N AE ; B 32 -5 798 571 ;
C 227 ; WX 260 ; N ordfeminine ; B 81 253 324 576 ;
C 232 ; WX 580 ; N Lslash ; B 33 -6 631 577 ;
C 233 ; WX 660 ; N Oslash ; B 110 -128 707 687 ;
C 234 ; WX 820 ; N OE ; B 104 -12 870 588 ;
C 235 ; WX 260 ; N ordmasculine ; B 98 253 323 576 ;
C 241 ; WX 540 ; N ae ; B 87 -13 588 441 ;
C 245 ; WX 240 ; N dotlessi ; B 81 -11 311 412 ;
C 248 ; WX 300 ; N lslash ; B 87 -11 491 681 ;
C 249 ; WX 440 ; N oslash ; B 92 -147 467 545 ;
C 250 ; WX 560 ; N oe ; B 88 -13 602 409 ;
C 251 ; WX 420 ; N germandbls ; B -127 -248 506 681 ;
C -1 ; WX 620 ; N Aacute ; B 23 -16 687 810 ;
C -1 ; WX 620 ; N Acircumflex ; B 23 -16 687 811 ;
C -1 ; WX 620 ; N Adieresis ; B 23 -16 699 773 ;
C -1 ; WX 620 ; N Agrave ; B 23 -16 687 810 ;
C -1 ; WX 620 ; N Aring ; B 23 -16 687 802 ;
C -1 ; WX 620 ; N Atilde ; B 23 -16 753 773 ;
C -1 ; WX 520 ; N Ccedilla ; B 88 -257 635 592 ;
C -1 ; WX 620 ; N Eacute ; B 76 -8 668 810 ;
C -1 ; WX 620 ; N Ecircumflex ; B 76 -8 668 811 ;
C -1 ; WX 620 ; N Edieresis ; B 76 -8 668 773 ;
C -1 ; WX 620 ; N Egrave ; B 76 -8 668 810 ;
C -1 ; WX 700 ; N Eth ; B 86 0 759 618 ;
C -1 ; WX 380 ; N Iacute ; B 81 0 528 810 ;
C -1 ; WX 380 ; N Icircumflex ; B 81 0 487 811 ;
C -1 ; WX 380 ; N Idieresis ; B 81 0 481 773 ;
C -1 ; WX 380 ; N Igrave ; B 81 0 481 810 ;
C -1 ; WX 700 ; N Ntilde ; B 40 -158 915 773 ;
C -1 ; WX 600 ; N Oacute ; B 104 -13 652 810 ;
C -1 ; WX 600 ; N Ocircumflex ; B 104 -13 652 811 ;
C -1 ; WX 600 ; N Odieresis ; B 104 -13 652 773 ;
C -1 ; WX 600 ; N Ograve ; B 104 -13 652 810 ;
C -1 ; WX 600 ; N Otilde ; B 104 -13 678 773 ;
C -1 ; WX 460 ; N Scaron ; B 0 -67 607 811 ;
C -1 ; WX 540 ; N Thorn ; B 37 2 619 573 ;
C -1 ; WX 740 ; N Uacute ; B 116 -10 778 810 ;
C -1 ; WX 740 ; N Ucircumflex ; B 116 -10 778 811 ;
C -1 ; WX 740 ; N Udieresis ; B 116 -10 778 773 ;
C -1 ; WX 740 ; N Ugrave ; B 116 -10 778 810 ;
C -1 ; WX 560 ; N Yacute ; B 31 -152 763 810 ;
C -1 ; WX 560 ; N Ydieresis ; B 31 -152 763 773 ;
C -1 ; WX 620 ; N Zcaron ; B 62 -18 675 811 ;
C -1 ; WX 420 ; N aacute ; B 87 -11 492 639 ;
C -1 ; WX 420 ; N acircumflex ; B 87 -11 492 640 ;
C -1 ; WX 420 ; N adieresis ; B 87 -11 492 602 ;
C -1 ; WX 420 ; N agrave ; B 87 -11 492 639 ;
C -1 ; WX 420 ; N aring ; B 87 -11 492 631 ;
C -1 ; WX 420 ; N atilde ; B 87 -11 503 602 ;
C -1 ; WX 520 ; N brokenbar ; B 314 0 363 578 ;
C -1 ; WX 340 ; N ccedilla ; B 61 -189 383 411 ;
C -1 ; WX 740 ; N copyright ; B 136 -10 830 683 ;
C -1 ; WX 400 ; N degree ; B 190 336 430 576 ;
C -1 ; WX 520 ; N divide ; B 103 0 513 410 ;
C -1 ; WX 340 ; N eacute ; B 87 -12 408 639 ;
C -1 ; WX 340 ; N ecircumflex ; B 87 -12 397 640 ;
C -1 ; WX 340 ; N edieresis ; B 87 -12 409 602 ;
C -1 ; WX 340 ; N egrave ; B 87 -12 380 639 ;
C -1 ; WX 400 ; N eth ; B 87 -13 557 681 ;
C -1 ; WX 240 ; N iacute ; B 81 -11 358 639 ;
C -1 ; WX 240 ; N icircumflex ; B 81 -11 347 640 ;
C -1 ; WX 240 ; N idieresis ; B 81 -11 359 602 ;
C -1 ; WX 240 ; N igrave ; B 81 -11 311 639 ;
C -1 ; WX 520 ; N logicalnot ; B 55 33 559 297 ;
C -1 ; WX 520 ; N minus ; B 55 180 559 230 ;
C -1 ; WX 460 ; N mu ; B 15 -249 518 416 ;
C -1 ; WX 520 ; N multiply ; B 103 0 513 410 ;
C -1 ; WX 460 ; N ntilde ; B 81 -15 523 602 ;
C -1 ; WX 400 ; N oacute ; B 87 -13 449 639 ;
C -1 ; WX 400 ; N ocircumflex ; B 87 -13 449 640 ;
C -1 ; WX 400 ; N odieresis ; B 87 -13 449 602 ;
C -1 ; WX 400 ; N ograve ; B 87 -13 449 639 ;
C -1 ; WX 660 ; N onehalf ; B 96 -9 659 585 ;
C -1 ; WX 660 ; N onequarter ; B 96 -16 653 585 ;
C -1 ; WX 264 ; N onesuperior ; B 86 230 314 579 ;
C -1 ; WX 400 ; N otilde ; B 87 -13 493 602 ;
C -1 ; WX 520 ; N plusminus ; B 103 0 513 410 ;
C -1 ; WX 740 ; N registered ; B 135 -10 828 683 ;
C -1 ; WX 320 ; N scaron ; B 41 -15 437 640 ;
C -1 ; WX 440 ; N thorn ; B -8 -248 482 678 ;
C -1 ; WX 660 ; N threequarters ; B 79 -16 663 585 ;
C -1 ; WX 264 ; N threesuperior ; B 69 224 343 573 ;
C -1 ; WX 1000 ; N trademark ; B 165 269 1050 673 ;
C -1 ; WX 264 ; N twosuperior ; B 80 219 354 572 ;
C -1 ; WX 460 ; N uacute ; B 82 -12 518 639 ;
C -1 ; WX 460 ; N ucircumflex ; B 82 -12 518 640 ;
C -1 ; WX 460 ; N udieresis ; B 82 -12 518 602 ;
C -1 ; WX 460 ; N ugrave ; B 82 -12 518 639 ;
C -1 ; WX 400 ; N yacute ; B 11 -249 473 639 ;
C -1 ; WX 400 ; N ydieresis ; B 11 -249 473 602 ;
C -1 ; WX 440 ; N zcaron ; B 46 -12 497 640 ;
EndCharMetrics
StartKernData
StartKernPairs 104
KPX A y 3
KPX A w -12
KPX A v -10
KPX A Y 19
KPX A W -21
KPX A V -20
KPX A T 25
KPX F period -137
KPX F comma -63
KPX F A -64
KPX L y 0
KPX L Y -20
KPX L W -40
KPX L V -40
KPX L T -20
KPX P period -66
KPX P comma -69
KPX P A 16
KPX R y 32
KPX R Y 70
KPX R W 6
KPX R V 6
KPX R T 51
KPX S t -20
KPX S p -10
KPX T y 2
KPX T w 0
KPX T u -1
KPX T semicolon 50
KPX T s 0
KPX T r -2
KPX T period -2
KPX T o -19
KPX T i 40
KPX T hyphen -10
KPX T e -15
KPX T comma 29
KPX T colon 34
KPX T c -6
KPX T a -8
KPX T A 15
KPX V y 0
KPX V u 0
KPX V r 0
KPX V o -50
KPX V i 21
KPX V e -50
KPX V a -50
KPX V semicolon 27
KPX V period -72
KPX V hyphen -10
KPX V comma -16
KPX V colon -11
KPX V A -14
KPX W y 15
KPX W u 15
KPX W semicolon 4
KPX W r 15
KPX W period -96
KPX W o -25
KPX W i 15
KPX W hyphen -10
KPX W e -25
KPX W comma -38
KPX W colon -24
KPX W a -25
KPX W A -7
KPX Y v -22
KPX Y u -8
KPX Y semicolon 25
KPX Y q -64
KPX Y period -65
KPX Y p -4
KPX Y o -65
KPX Y i 40
KPX Y hyphen -10
KPX Y e -60
KPX Y comma 0
KPX Y colon -4
KPX Y a -63
KPX Y A -24
KPX a t -10
KPX d t -10
KPX f f -57
KPX g g 20
KPX o t -20
KPX r r 20
KPX r q 0
KPX r period -45
KPX r o -8
KPX r n 45
KPX r m 45
KPX r l 10
KPX r hyphen 10
KPX r h 3
KPX r g -30
KPX r f 11
KPX r e -12
KPX r d -25
KPX r comma -40
KPX r c -16
KPX s t -20
KPX v y 20
KPX w e 20
EndKernPairs
EndKernData
StartComposites 58
CC Zcaron 2 ; PCC Z 0 0 ; PCC caron 195 172 ;
CC zcaron 2 ; PCC z 0 0 ; PCC caron 50 0 ;
CC Scaron 2 ; PCC S 0 0 ; PCC caron 160 172 ;
CC scaron 2 ; PCC s 0 0 ; PCC caron -10 0 ;
CC Ccedilla 2 ; PCC C 0 0 ; PCC cedilla 137 -68 ;
CC ccedilla 2 ; PCC c 0 0 ; PCC cedilla 20 0 ;
CC Yacute 2 ; PCC Y 0 0 ; PCC acute 130 172 ;
CC yacute 2 ; PCC y 0 0 ; PCC acute 50 0 ;
CC Ydieresis 2 ; PCC Y 0 0 ; PCC dieresis 250 172 ;
CC ydieresis 2 ; PCC y 0 0 ; PCC dieresis 20 0 ;
CC Uacute 2 ; PCC U 0 0 ; PCC acute 320 172 ;
CC Ucircumflex 2 ; PCC U 0 0 ; PCC circumflex 300 172 ;
CC Udieresis 2 ; PCC U 0 0 ; PCC dieresis 320 172 ;
CC Ugrave 2 ; PCC U 0 0 ; PCC grave 330 172 ;
CC uacute 2 ; PCC u 0 0 ; PCC acute 80 0 ;
CC ucircumflex 2 ; PCC u 0 0 ; PCC circumflex 60 0 ;
CC udieresis 2 ; PCC u 0 0 ; PCC dieresis 50 0 ;
CC ugrave 2 ; PCC u 0 0 ; PCC grave 120 0 ;
CC Iacute 2 ; PCC I 0 0 ; PCC acute 140 172 ;
CC Icircumflex 2 ; PCC I 0 0 ; PCC circumflex 90 172 ;
CC Idieresis 2 ; PCC I 0 0 ; PCC dieresis 60 172 ;
CC Igrave 2 ; PCC I 0 0 ; PCC grave 120 172 ;
CC iacute 2 ; PCC dotlessi 0 0 ; PCC acute -30 0 ;
CC icircumflex 2 ; PCC dotlessi 0 0 ; PCC circumflex -50 0 ;
CC idieresis 2 ; PCC dotlessi 0 0 ; PCC dieresis -60 0 ;
CC igrave 2 ; PCC dotlessi 0 0 ; PCC grave 10 0 ;
CC Eacute 2 ; PCC E 0 0 ; PCC acute 260 172 ;
CC Ecircumflex 2 ; PCC E 0 0 ; PCC circumflex 210 172 ;
CC Edieresis 2 ; PCC E 0 0 ; PCC dieresis 205 172 ;
CC Egrave 2 ; PCC E 0 0 ; PCC grave 255 172 ;
CC eacute 2 ; PCC e 0 0 ; PCC acute 20 0 ;
CC ecircumflex 2 ; PCC e 0 0 ; PCC circumflex 0 0 ;
CC edieresis 2 ; PCC e 0 0 ; PCC dieresis -10 0 ;
CC egrave 2 ; PCC e 0 0 ; PCC grave 60 0 ;
CC Aacute 2 ; PCC A 0 0 ; PCC acute 260 172 ;
CC Acircumflex 2 ; PCC A 0 0 ; PCC circumflex 255 172 ;
CC Adieresis 2 ; PCC A 0 0 ; PCC dieresis 280 172 ;
CC Agrave 2 ; PCC A 0 0 ; PCC grave 300 172 ;
CC aacute 2 ; PCC a 0 0 ; PCC acute 60 0 ;
CC acircumflex 2 ; PCC a 0 0 ; PCC circumflex 40 0 ;
CC adieresis 2 ; PCC a 0 0 ; PCC dieresis 30 0 ;
CC agrave 2 ; PCC a 0 0 ; PCC grave 100 0 ;
CC Oacute 2 ; PCC O 0 0 ; PCC acute 250 172 ;
CC Ocircumflex 2 ; PCC O 0 0 ; PCC circumflex 200 172 ;
CC Odieresis 2 ; PCC O 0 0 ; PCC dieresis 225 172 ;
CC Ograve 2 ; PCC O 0 0 ; PCC grave 245 172 ;
CC oacute 2 ; PCC o 0 0 ; PCC acute 50 0 ;
CC ocircumflex 2 ; PCC o 0 0 ; PCC circumflex 30 0 ;
CC odieresis 2 ; PCC o 0 0 ; PCC dieresis 20 0 ;
CC ograve 2 ; PCC o 0 0 ; PCC grave 90 0 ;
CC Atilde 2 ; PCC A 0 0 ; PCC tilde 240 172 ;
CC atilde 2 ; PCC a 0 0 ; PCC tilde -10 0 ;
CC Ntilde 2 ; PCC N 0 0 ; PCC tilde 280 172 ;
CC ntilde 2 ; PCC n 0 0 ; PCC tilde 10 0 ;
CC Otilde 2 ; PCC O 0 0 ; PCC tilde 165 172 ;
CC otilde 2 ; PCC o 0 0 ; PCC tilde -20 0 ;
CC Aring 2 ; PCC A 0 0 ; PCC ring 275 172 ;
CC aring 2 ; PCC a 0 0 ; PCC ring 60 0 ;
EndComposites
EndFontMetrics

4291
collects/afm/glyphlist.txt Normal file
View File

File diff suppressed because it is too large Load Diff

406
collects/afm/glyphshortlist.txt Normal file
View File

@ -0,0 +1,406 @@
# Like glyphlist.txt, but includes only
# those names used in the .afm fonts
# distirbuted with PLT Scheme. Extra
# entries in this file map to FFFF
# to avoid triggering the use fo glyphlist.txt
# for names that won't be there, either.
space;0020
exclam;0021
quotedbl;0022
numbersign;0023
dollar;0024
percent;0025
ampersand;0026
quoteright;2019
parenleft;0028
parenright;0029
asterisk;002A
plus;002B
comma;002C
hyphen;002D
period;002E
slash;002F
zero;0030
one;0031
two;0032
three;0033
four;0034
five;0035
six;0036
seven;0037
eight;0038
nine;0039
colon;003A
semicolon;003B
less;003C
equal;003D
greater;003E
question;003F
at;0040
A;0041
B;0042
C;0043
D;0044
E;0045
F;0046
G;0047
H;0048
I;0049
J;004A
K;004B
L;004C
M;004D
N;004E
O;004F
P;0050
Q;0051
R;0052
S;0053
T;0054
U;0055
V;0056
W;0057
X;0058
Y;0059
Z;005A
bracketleft;005B
backslash;005C
bracketright;005D
asciicircum;005E
underscore;005F
quoteleft;2018
a;0061
b;0062
c;0063
d;0064
e;0065
f;0066
g;0067
h;0068
i;0069
j;006A
k;006B
l;006C
m;006D
n;006E
o;006F
p;0070
q;0071
r;0072
s;0073
t;0074
u;0075
v;0076
w;0077
x;0078
y;0079
z;007A
braceleft;007B
bar;007C
braceright;007D
asciitilde;007E
exclamdown;00A1
cent;00A2
sterling;00A3
fraction;2044
yen;00A5
florin;0192
section;00A7
currency;00A4
quotesingle;0027
quotedblleft;201C
guillemotleft;00AB
guilsinglleft;2039
guilsinglright;203A
fi;FB01
fl;FB02
endash;2013
dagger;2020
daggerdbl;2021
periodcentered;00B7
paragraph;00B6
bullet;2022
quotesinglbase;201A
quotedblbase;201E
quotedblright;201D
guillemotright;00BB
ellipsis;2026
perthousand;2030
questiondown;00BF
grave;0060
acute;00B4
circumflex;02C6
tilde;02DC
macron;00AF
breve;02D8
dotaccent;02D9
dieresis;00A8
ring;02DA
cedilla;00B8
hungarumlaut;02DD
ogonek;02DB
caron;02C7
emdash;2014
AE;00C6
ordfeminine;00AA
Lslash;0141
Oslash;00D8
OE;0152
ordmasculine;00BA
ae;00E6
dotlessi;0131
lslash;0142
oslash;00F8
oe;0153
germandbls;00DF
Aacute;00C1
Acircumflex;00C2
Adieresis;00C4
Agrave;00C0
Aring;00C5
Atilde;00C3
Ccedilla;00C7
Eacute;00C9
Ecircumflex;00CA
Edieresis;00CB
Egrave;00C8
Eth;00D0
Gcaron;01E6
IJ;0132
Iacute;00CD
Icircumflex;00CE
Idieresis;00CF
Idot;0130
Igrave;00CC
LL;F6BF
Ntilde;00D1
Oacute;00D3
Ocircumflex;00D4
Odieresis;00D6
Ograve;00D2
Otilde;00D5
Scaron;0160
Scedilla;015E
Thorn;00DE
Uacute;00DA
Ucircumflex;00DB
Udieresis;00DC
Ugrave;00D9
Yacute;00DD
Ydieresis;0178
Zcaron;017D
aacute;00E1
acircumflex;00E2
adieresis;00E4
agrave;00E0
aring;00E5
arrowboth;2194
arrowdown;2193
arrowleft;2190
arrowright;2192
arrowup;2191
atilde;00E3
brokenbar;00A6
ccedilla;00E7
center;FFFF
copyright;00A9
dectab;FFFF
degree;00B0
divide;00F7
down;FFFF
eacute;00E9
ecircumflex;00EA
edieresis;00EB
egrave;00E8
eth;00F0
format;FFFF
gcaron;01E7
graybox;FFFF
iacute;00ED
icircumflex;00EE
idieresis;00EF
igrave;00EC
ij;0133
indent;FFFF
largebullet;FFFF
left;FFFF
lira;20A4
ll;F6C0
logicalnot;00AC
merge;FFFF
minus;2212
mu;00B5
multiply;00D7
notegraphic;FFFF
ntilde;00F1
oacute;00F3
ocircumflex;00F4
odieresis;00F6
ograve;00F2
onehalf;00BD
onequarter;00BC
onesuperior;00B9
otilde;00F5
overscore;00AF
plusminus;00B1
prescription;211E
registered;00AE
return;FFFF
scaron;0161
scedilla;015F
square;FFFF
stop;FFFF
tab;FFFF
thorn;00FE
threequarters;00BE
threesuperior;00B3
trademark;2122
twosuperior;00B2
uacute;00FA
ucircumflex;00FB
udieresis;00FC
ugrave;00F9
up;FFFF
yacute;00FD
ydieresis;00FF
zcaron;017E
universal;2200
existential;2203
suchthat;220B
asteriskmath;2217
congruent;2245
Alpha;0391
Beta;0392
Chi;03A7
Delta;2206
Epsilon;0395
Phi;03A6
Gamma;0393
Eta;0397
Iota;0399
theta1;03D1
Kappa;039A
Lambda;039B
Mu;039C
Nu;039D
Omicron;039F
Pi;03A0
Theta;0398
Rho;03A1
Sigma;03A3
Tau;03A4
Upsilon;03A5
sigma1;03C2
Omega;2126
Xi;039E
Psi;03A8
Zeta;0396
therefore;2234
perpendicular;22A5
radicalex;F8E5
alpha;03B1
beta;03B2
chi;03C7
delta;03B4
epsilon;03B5
phi;03C6
gamma;03B3
eta;03B7
iota;03B9
phi1;03D5
kappa;03BA
lambda;03BB
nu;03BD
omicron;03BF
pi;03C0
theta;03B8
rho;03C1
sigma;03C3
tau;03C4
upsilon;03C5
omega1;03D6
omega;03C9
xi;03BE
psi;03C8
zeta;03B6
similar;223C
Upsilon1;03D2
minute;2032
lessequal;2264
infinity;221E
club;2663
diamond;2666
heart;2665
spade;2660
second;2033
greaterequal;2265
proportional;221D
partialdiff;2202
notequal;2260
equivalence;2261
approxequal;2248
arrowvertex;F8E6
arrowhorizex;F8E7
carriagereturn;21B5
aleph;2135
Ifraktur;2111
Rfraktur;211C
weierstrass;2118
circlemultiply;2297
circleplus;2295
emptyset;2205
intersection;2229
union;222A
propersuperset;2283
reflexsuperset;2287
notsubset;2284
propersubset;2282
reflexsubset;2286
element;2208
notelement;2209
angle;2220
gradient;2207
registerserif;F6DA
copyrightserif;F6D9
trademarkserif;F6DB
product;220F
radical;221A
dotmath;22C5
logicaland;2227
logicalor;2228
arrowdblboth;21D4
arrowdblleft;21D0
arrowdblup;21D1
arrowdblright;21D2
arrowdbldown;21D3
lozenge;25CA
angleleft;2329
registersans;F8E8
copyrightsans;F8E9
trademarksans;F8EA
summation;2211
parenlefttp;F8EB
parenleftex;F8EC
parenleftbt;F8ED
bracketlefttp;F8EE
bracketleftex;F8EF
bracketleftbt;F8F0
bracelefttp;F8F1
braceleftmid;F8F2
braceleftbt;F8F3
braceex;F8F4
angleright;232A
integral;222B
integraltp;2320
integralex;F8F5
integralbt;2321
parenrighttp;F8F6
parenrightex;F8F7
parenrightbt;F8F8
bracketrighttp;F8F9
bracketrightex;F8FA
bracketrightbt;F8FB
bracerighttp;F8FC
bracerightmid;F8FD
bracerightbt;F8FE
apple;F8FF

38
collects/algol60/algol60.ss Normal file
View File

@ -0,0 +1,38 @@
#cs(module algol60 mzscheme
(require-for-syntax "parse.ss"
;; Parses to generate an AST. Identifiers in the AST
;; are represented as syntax objects with source location.
"simplify.ss"
;; Desugars the AST, transforming `for' to `if'+`goto',
;; and flattening `if' statements so they are always
;; of the for `if <exp> then goto <label> else goto <label>'
"compile.ss"
;; Compiles a simplified AST to Scheme.
(lib "file.ss"))
;; By using #'here for the context of identifiers
;; introduced by compilation, the identifiers can
;; refer to runtime functions and primitives, as
;; well as mzscheme:
(require "runtime.ss" "prims.ss")
(provide include-algol)
(define-syntax (include-algol stx)
(syntax-case stx ()
[(_ str)
(string? (syntax-e (syntax str)))
(compile-simplified
(simplify
(parse-a60-file
(normalize-path (syntax-e (syntax str))
(or
(current-load-relative-directory)
(current-directory))))
#'here)
#'here)])))

7
collects/algol60/base.ss Normal file
View File

@ -0,0 +1,7 @@
(module base mzscheme
(require "prims.ss"
"runtime.ss")
(provide (all-from mzscheme)
(all-from "prims.ss")
(all-from "runtime.ss")))

22
collects/algol60/bd-tool.ss Normal file
View File

@ -0,0 +1,22 @@
(module bd-tool mzscheme
(require (lib "encode-decode.ss" "framework" "private"))
(decode 6d54db8e9b3010fd95291512aeea248d7a9156ea457dea733f60251b
4fc05b63b3b649367fdfb18140225e12983973e676864a62a32d541e
5f07ed112aa325149d47b50ba1189f0a36996b234248f6d930581d83
6ed6a6e89c1943950f758b1d168c7c0a4fda227827e5954b25ae3f09
8f11aa4a4115b0765605fe43894825d483f768239fcc8c25026109f8
9d8808c23b67630b8ac137b6188934998e237e4a2875c3653786df25
efc43fe44ebe601d09143bd19750c9411bc57b41e455ed8c21a77676
3414c234ce7c3d50a78554bb97be29ee32191da3c1ed64d4e9076a35
f936f3eed30c2868aab6c1c82f5ac596c167b6e96d51376d4cee5c41
bdc5cb555d82ec3222c7132c506ca8854138ec8e5ff2cfcaabbcb8f0
31784e7680c343f8e47f7f623379efdd592b84b4fa5fcb40f22b5449
237b1209cc7a784a0e8e6fbdf3313c43a5bbf474ef7e5e68fa5604fc
0467a7d583f1f8601c6760f1c2534e7ef2a2c312c2d0a32f0995d53b
bd5256dba2d7314f530e31e6355b34a9db04e1da86286cd459926b45
65702258fca3ad4c277013c106b1111d0922c92c53e039b2d515ac37
a8b430ae29a1f823fafe0abfb58f2d49e923fc4db27a57a4f1a79ad6
311d86201aea785a9d7af0cf453e70de28d5aa40c0dbd621b4ee92f3
41f53ab8340de9bc42bf12d68489e34184782581cd6085d4212ac616
fcc66cea56d80679ddd201d2f12fa5a4b9d16720cc733713d1a525d4
dd91dd0444ec7b7c8b94e969fc5be901363592a7c9d87f))

BIN
collects/algol60/bd.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

531
collects/algol60/compile.ss Normal file
View File

@ -0,0 +1,531 @@
#cs(module compile mzscheme
(require "parse.ss"
(lib "match.ss")
(lib "list.ss"))
(provide compile-simplified)
;; The compiler generates references to prim.ss and
;; runtime.ss exports, as well as MzScheme forms
;; and functions. The `ctx' argument provides
;; an appropriate context for those bindings (in
;; the form of a syntax object to use with d->s-o).
(define (compile-simplified stmt ctx)
(datum->syntax-object
ctx
(parameterize ([current-compile-context ctx])
(compile-a60 stmt 'void (empty-context) #t))))
(define current-compile-context (make-parameter #f))
(define (compile-a60 stmt next-label context add-to-top-level?)
(match stmt
[($ a60:block decls statements)
(compile-block decls statements next-label context add-to-top-level?)]
[else
(compile-statement stmt next-label context)]))
(define (compile-block decls statements next-label context add-to-top-level?)
(let* ([labels-with-numbers (map car statements)]
[labels (map (lambda (l)
(if (stx-number? l)
(datum->syntax-object
l
(string->symbol (format "~a" (syntax-e l)))
l
l)
l))
labels-with-numbers)]
;; Build environment by adding labels, then decls:
[context (foldl (lambda (decl context)
(match decl
[($ a60:proc-decl result-type var arg-vars by-value-vars arg-specs body)
(add-procedure context var result-type arg-vars by-value-vars arg-specs)]
[($ a60:type-decl type ids)
(add-atoms context ids type)]
[($ a60:array-decl type arrays)
(add-arrays context
(map car arrays) ; names
(map cdr arrays) ; dimensions
type)]
[($ a60:switch-decl name exprs)
(add-switch context name)]))
(add-labels
context
labels)
decls)])
;; Generate bindings and initialization for all decls,
;; plus all statements (thunked):
(let ([bindings
(append
(apply
append
;; Decls:
(map (lambda (decl)
(match decl
[($ a60:proc-decl result-type var arg-vars by-value-vars arg-specs body)
(let ([code
`(lambda (kont . ,arg-vars)
;; Extract by-value variables
(let ,(map (lambda (var)
`[,var (get-value ,var)])
by-value-vars)
;; Set up the result variable and done continuation:
,(let ([result-var (gensym 'prec-result)]
[done (gensym 'done)])
`(let* ([,result-var undefined]
[,done (lambda () (kont ,result-var))])
;; Include the compiled body:
,(compile-a60 body done
(add-settable-procedure
(add-bindings
context
arg-vars
by-value-vars
arg-specs)
var
result-type
result-var)
#f)))))])
(if add-to-top-level?
`([,var
(let ([tmp ,code])
(namespace-set-variable-value! ',var tmp)
tmp)])
`([,var
,code])))]
[($ a60:type-decl type ids)
(map (lambda (id) `[,id undefined]) ids)]
[($ a60:array-decl type arrays)
(map (lambda (array)
`[,(car array) (make-array
,@(apply
append
(map
(lambda (bp)
(list
(compile-expression (car bp) context 'num)
(compile-expression (cdr bp) context 'num)))
(cdr array))))])
arrays)]
[($ a60:switch-decl name exprs)
`([,name (make-switch ,@(map (lambda (e) `(lambda () ,(compile-expression e context 'des)))
exprs))])]
[else (error "can't compile decl")]))
decls))
;; Statements: most of the work is in `compile-statement', but
;; we provide the continuation label:
(cdr
(foldr (lambda (stmt label next-label+compiled)
(cons label
(cons
`[,label
(lambda ()
,(compile-statement (cdr stmt)
(car next-label+compiled)
context))]
(cdr next-label+compiled))))
(cons next-label null)
statements
labels)))])
;; Check for duplicate bindings:
(let ([dup (check-duplicate-identifier (filter identifier? (map car bindings)))])
(when dup
(raise-syntax-error
#f
"name defined twice"
dup)))
;; Generate code; body of leterec jumps to the first statement label.
`(letrec ,bindings
(,(caar statements))))))
(define (compile-statement statement next-label context)
(match statement
[($ a60:block decls statements)
(compile-block decls statements next-label context #f)]
[($ a60:branch test ($ a60:goto then) ($ a60:goto else))
`(if (check-boolean ,(compile-expression test context 'bool))
(goto ,(check-label then context))
(goto ,(check-label else context)))]
[($ a60:goto label)
(at (expression-location label)
`(goto ,(compile-expression label context 'des)))]
[($ a60:dummy)
`(,next-label)]
[($ a60:call proc args)
(at (expression-location proc)
`(,(compile-expression proc context 'func)
(lambda (val)
(,next-label))
,@(map (lambda (arg) (compile-argument arg context))
args)))]
[($ a60:assign vars val)
;; >>>>>>>>>>>>>>> Start clean-up here <<<<<<<<<<<<<<<<<
;; Lift out the spec-finding part, and use it to generate
;; an expected type that is passed to `compile-expression':
`(begin
(let ([val ,(compile-expression val context 'numbool)])
,@(map (lambda (avar)
(let ([var (a60:variable-name avar)])
(at var
(cond
[(null? (a60:variable-indices avar))
(cond
[(call-by-name-variable? var context)
=> (lambda (spec)
`(set-target! ,var ',var (coerce ',(spec-coerce-target spec) val)))]
[(procedure-result-variable? var context)
`(set! ,(procedure-result-variable-name var context)
(coerce ',(spec-coerce-target (procedure-result-spec var context)) val))]
[(or (settable-variable? var context)
(array-element? var context))
=> (lambda (spec)
`(,(if (own-variable? var context) 'set-box! 'set!)
,var
(coerce ',(spec-coerce-target spec) val)))]
[else (raise-syntax-error #f "confused by assignment" (expression-location var))])]
[else
(let ([spec (or (array-element? var context)
(call-by-name-variable? var context))])
`(array-set! ,(compile-expression (make-a60:variable var null) context 'numbool)
(coerce ',(spec-coerce-target spec) val)
,@(map (lambda (e) (compile-expression e context 'num))
(a60:variable-indices avar))))]))))
vars))
(,next-label))]
[else (error "can't compile statement")]))
(define (compile-expression expr context type)
(match expr
[(? (lambda (x) (and (syntax? x) (number? (syntax-e x)))) n)
(if (eq? type 'des)
;; Need a label:
(check-label (datum->syntax-object expr
(string->symbol (number->string (syntax-e expr)))
expr
expr)
context)
;; Normal use of a number:
(begin
(check-type 'num type expr)
(as-builtin n)))]
[(? (lambda (x) (and (syntax? x) (boolean? (syntax-e x)))) n) (check-type 'bool type expr) (as-builtin n)]
[(? (lambda (x) (and (syntax? x) (string? (syntax-e x)))) n) (check-type 'string type expr) (as-builtin n)]
[(? identifier? i) (compile-expression (make-a60:variable i null) context type)]
[(? symbol? i) ; either a generated label or 'val:
(unless (eq? expr 'val)
(check-type 'des type expr))
(datum->syntax-object #f i)]
[($ a60:subscript array index)
;; Maybe a switch index, or maybe an array reference
(at array
(cond
[(array-element? array context)
`(array-ref ,array ,(compile-expression index context 'num))]
[(switch-variable? array context)
`(switch-ref ,array ,(compile-expression index context 'num))]
[else (raise-syntax-error
#f
"confused by variable"
array)]))]
[($ a60:binary t argt op e1 e2)
(check-type t type expr)
(at op
`(,(as-builtin op) ,(compile-expression e1 context argt) ,(compile-expression e2 context argt)))]
[($ a60:unary t argt op e1)
(check-type t type expr)
(at op
`(,(as-builtin op) ,(compile-expression e1 context argt)))]
[($ a60:variable var subscripts)
(let ([sub (lambda (wrap v)
(wrap
(if (null? subscripts)
v
`(array-ref ,v ,@(map (lambda (e) (compile-expression e context 'num)) subscripts)))))])
(cond
[(call-by-name-variable? var context)
=> (lambda (spec)
(check-spec-type spec type var)
(sub (lambda (val) `(coerce ',(spec-coerce-target spec) ,val)) `(get-value ,var)))]
[(primitive-variable? var context)
=> (lambda (name)
(sub values
(datum->syntax-object
(current-compile-context)
name
var
var)))]
[(and (procedure-result-variable? var context)
(not (eq? type 'func)))
(unless (null? subscripts)
(raise-syntax-error "confused by subscripts" var))
(let ([spec (procedure-result-spec var context)])
(check-spec-type spec type var)
(at var
`(coerce
',(spec-coerce-target spec)
,(procedure-result-variable-name var context))))]
[(or (procedure-result-variable? var context)
(procedure-variable? var context)
(label-variable? var context)
(settable-variable? var context)
(array-element? var context))
=> (lambda (spec)
(let ([spec (if (or (procedure-result-variable? var context)
(procedure-variable? var context)
(and (array-element? var context)
(null? subscripts)))
#f ;; need just the proc or array...
spec)])
(check-spec-type spec type var)
(let ([target (spec-coerce-target spec)])
(sub (if target
(lambda (v) `(coerce ',target ,v))
values)
(if (own-variable? var context)
`(unbox ,var)
var)))))]
[else (raise-syntax-error
#f
"confused by expression"
(expression-location var))]))]
[($ a60:app func args)
(at (expression-location func)
`(,(compile-expression func context 'func)
values
,@(map (lambda (e) (compile-argument e context))
args)))]
[($ a60:if test then else)
`(if (check-boolean ,(compile-expression test context 'bool))
,(compile-expression then context type)
,(compile-expression else context type))]
[else (error 'compile-expression "can't compile expression ~a" expr)]))
(define (expression-location expr)
(if (syntax? expr)
expr
(match expr
[($ a60:subscript array index) (expression-location array)]
[($ a60:binary type argtype op e1 e2) op]
[($ a60:unary type argtype op e1) op]
[($ a60:variable var subscripts) (expression-location var)]
[($ a60:app func args)
(expression-location func)]
[else #f])))
(define (compile-argument arg context)
(cond
[(and (a60:variable? arg)
(not (let ([v (a60:variable-name arg)])
(or (procedure-variable? v context)
(label-variable? v context)
(primitive-variable? v context)))))
`(case-lambda
[() ,(compile-expression arg context 'any)]
[(val) ,(compile-statement (make-a60:assign (list arg) 'val) 'void context)])]
[(identifier? arg)
(compile-argument (make-a60:variable arg null) context)]
[else `(lambda () ,(compile-expression arg context 'any))]))
(define (check-type got expected expr)
(or (eq? expected 'any)
(case got
[(num) (memq expected '(num numbool))]
[(bool) (memq expected '(bool numbool))]
[(des) (memq expected '(des))]
[(func) (memq expected '(func))]
[else #f])
(raise-syntax-error #f
(format "type mismatch (~a != ~a)" got expected)
expr)))
(define (check-spec-type spec type expr)
(let ([target (spec-coerce-target spec)])
(when target
(case (syntax-e target)
[(integer real) (check-type 'num type expr)]
[(boolean) (check-type 'bool type expr)]
[(procedure) (check-type 'func type expr)]))))
(define (check-label l context)
(if (or (symbol? l)
(label-variable? l context))
l
(raise-syntax-error
#f
"undefined label"
l)))
(define (at stx expr)
(if (syntax? stx)
(datum->syntax-object (current-compile-context) expr stx)
expr))
(define (as-builtin stx)
;; Preserve source loc, but change to reference to
;; a builtin operation by changing the context:
(datum->syntax-object
(current-compile-context)
(syntax-e stx)
stx
stx))
;; --------------------
(define (empty-context)
`(((sign prim sign)
(entier prim entier)
(sin prim a60:sin)
(cos prim a60:cos)
(acrtan prim a60:arctan)
(sqrt prim a60:sqrt)
(abs prim a60:abs)
(ln prim a60:ln)
(exp prim a60:exp)
(prints prim prints)
(printn prim printn)
(printsln prim printsln)
(printnln prim printnln))))
(define (add-labels context l)
(cons (map (lambda (lbl) (cons (if (symbol? lbl)
(datum->syntax-object #f lbl)
lbl)
'label)) l)
context))
(define (add-procedure context var result-type arg-vars by-value-vars arg-specs)
(cons (list (cons var 'procedure))
context))
(define (add-settable-procedure context var result-type result-var)
(cons (list (cons var `(settable-procedure ,result-var ,result-type)))
context))
(define (add-atoms context ids type)
(cons (map (lambda (id) (cons id type)) ids)
context))
(define (add-arrays context names dimensionses type)
(cons (map (lambda (name dimensions)
(cons name `(array ,type ,(length dimensions))))
names dimensionses)
context))
(define (add-switch context name)
(cons (list (cons name 'switch))
context))
(define (add-bindings context arg-vars by-value-vars arg-specs)
(cons (map (lambda (var)
(let ([spec (or (ormap (lambda (spec)
(and (ormap (lambda (x) (bound-identifier=? var x))
(cdr spec))
(car spec)))
arg-specs)
#'unknown)])
(cons var
(if (ormap (lambda (x) (bound-identifier=? var x)) by-value-vars)
spec
(list 'by-name spec)))))
arg-vars)
context))
;; var-binding : syntax context -> symbol
;; returns an identifier indicating where the var is
;; bound, or 'free if it isn't. The compiler inserts
;; top-level procedure definitions into the namespace; if
;; the variable is bound there, it is a procedure.
(define (var-binding var context)
(cond
[(null? context)
(let/ec k
(namespace-variable-value (syntax-e var)
#t
(lambda () (k 'free)))
'procedure)]
[else
(let ([m (var-in-rib var (car context))])
(or m (var-binding var (cdr context))))]))
(define (var-in-rib var rib)
(ormap (lambda (b)
(if (symbol? (car b))
;; primitives:
(and (eq? (syntax-e var) (car b))
(cdr b))
;; everything else:
(and (bound-identifier=? var (car b))
(cdr b))))
rib))
(define (primitive-variable? var context)
(let ([v (var-binding var context)])
(and (pair? v)
(eq? (car v) 'prim)
(cadr v))))
(define (call-by-name-variable? var context)
(let ([v (var-binding var context)])
(and (pair? v)
(eq? (car v) 'by-name)
(cadr v))))
(define (procedure-variable? var context)
(let ([v (var-binding var context)])
(eq? v 'procedure)))
(define (procedure-result-variable? var context)
(let ([v (var-binding var context)])
(and (pair? v)
(eq? (car v) 'settable-procedure)
(cdr v))))
(define (procedure-result-variable-name var context)
(let ([v (procedure-result-variable? var context)])
(car v)))
(define (procedure-result-spec var context)
(let ([v (procedure-result-variable? var context)])
(cadr v)))
(define (label-variable? var context)
(let ([v (var-binding var context)])
(eq? v 'label)))
(define (switch-variable? var context)
(let ([v (var-binding var context)])
(eq? v 'switch)))
(define (settable-variable? var context)
(let ([v (var-binding var context)])
(or (box? v)
(and (syntax? v)
(memq (syntax-e v) '(integer real boolean))
v))))
(define (own-variable? var context)
(let ([v (var-binding var context)])
(box? v)))
(define (array-element? var context)
(let ([v (var-binding var context)])
(and (pair? v)
(eq? (car v) 'array)
(or (cadr v)
#'unknown))))
(define (spec-coerce-target spec)
(cond
[(and (syntax? spec) (memq (syntax-e spec) '(string label switch real integer boolean unknown))) spec]
[(and (syntax? spec) (memq (syntax-e spec) '(unknown))) #f]
[(or (not spec) (not (pair? spec))) #f]
[(eq? (car spec) 'array) (cadr spec)]
[(eq? (car spec) 'procedure) #'procedure]
[else #f]))
(define (stx-number? a) (and (syntax? a) (number? (syntax-e a)))))

61
collects/algol60/doc.txt Normal file
View File

@ -0,0 +1,61 @@
_Algol 60_
The "Algol 60" language for DrScheme implements the language define by
the "Revised Report on the Algorithmic Language Algol 60", edited by
Peter Naur.
The "algol60.ss" library provides an `include-algol' form for including
an Algol 60 program as an expression in a Scheme program:
> (include-algol file-path-string)
The included Algol 60 program is closed (i.e., it doesn't see any
bindings in the included context), and the result is always void.
Language
--------
The DrScheme/`include-algol' implementation departs from the
specification in the following minor ways:
* strings are not permitted to contain nested quotes;
* identifiers cannot contain whitespace;
* argument separators are constrained to be identifiers (i.e., they
cannot be keywords, and they cannot consistnt of multiple
identifiers separated by whitespace); and
* numbers containing exponents (using the "10" subscript) are not
supported.
Identifiers and keywords are case-sensitive. The boldface/underlined
keywords of the report are represented by the obvious character
sequence, as are most operators. A few operators do not fit into
ASCII, and they are mapped as follows:
times *
quotient div
exponential ^
less or equal <=
greater or equal >=
not equal !=
equivalence ==
implication =>
and &
or |
negation !
In addition to the standard functions, the following output functions
are supported:
prints(E) prints the string E
printsln(E) prints the string E followed by a newline
printn(E) prints the number E
printnln(E) prints the number E followed by a newline
A prompt in DrScheme's Interactions window accepts whole programs only
for the Algol 60 language.

33
collects/algol60/examples/euler.a60 Normal file
View File

@ -0,0 +1,33 @@
begin
procedure euler (fct,sum,eps,tim); value eps,tim; integer tim;
real procedure fct; real sum,eps;
comment euler computes the sum of fct(i) for i from zero up to
infinity by means of a suitably refined euler transformation. The
summation is stopped as soon as tim times in succession the absolute
value of the terms of the transformed series are found to be less than
eps. Hence, one should provide a function fct with one integer argument,
an upper bound eps, and an integer tim. The output is the sum sum. euler
is particularly efficient in the case of a slowly convergent or
divergent alternating series;
begin integer i,k,n,t; array m[0:15]; real mn,mp,ds;
i:=n:=t:=0; m[0]:=fct(0); sum:=m[0]/2;
nextterm: i:=i+1; mn:=fct(i);
for k:=0 step 1 until n do
begin mp:=(mn+m[k])/2; m[k]:=mn;
mn:=mp end;
if (abs(mn)<abs(m[n])) & (n<15) then
begin ds:=mn/2; n:=n+1; m[n]:=mn end
else ds:=mn;
sum:=sum+ds;
if abs(ds)<eps then t:=t+1 else t:=0;
if t<tim then goto nextterm
end;
procedure inv(v) ; inv := 1.0/((v+1)^2);
real result;
euler(inv, result, 0.00005, 10);
printnln(result);
end

14
collects/algol60/examples/jensen.a60 Normal file
View File

@ -0,0 +1,14 @@
begin
integer procedure SIGMA(x, i, n);
value n;
integer x, i, n;
begin
integer sum;
sum:=0;
for i:=1 step 1 until n do
sum:=sum+x;
SIGMA:=sum;
end;
integer q;
printnln(SIGMA(q*2-1, q, 7));
end

124
collects/algol60/examples/nqueen.a60 Normal file
View File

@ -0,0 +1,124 @@
begin
comment
-- From the NASE A60 distribution --
Find a solution for the `N queen problem.
(got the algorithm from a Modula program from
Martin Neitzel).
;
integer N, MAXN;
MAXN := 9; comment maximum size;
N := 2; comment current size;
tryNextN:
begin
integer array column [1 : N];
Boolean array empcol [1 : N];
Boolean array empup [-N+1 : N-1];
Boolean array empdo [2 : 2*N];
integer i;
procedure print;
comment
print the current solution in a chessboard alike
picture ;
begin
integer i, j;
procedure outframe;
begin
integer i;
for i := 1 step 1 until N do
prints (`+---');
printsln (`+')
end;
for j := 1 step 1 until N do begin
outframe;
prints (`|');
for i := 1 step 1 until N do begin
if N + 1 - j = column [i] then
prints (` Q |')
else
prints (` |')
end;
printsln (`')
end;
outframe;
end;
procedure set (x);
value x;
integer x;
begin
integer y;
for y := 1 step 1 until N do
begin
if empcol [ y ] & empup [ x-y ]
& empdo [ x+y ] then
begin
column [ y ] := x ;
empcol [ y ] := false ;
empup [ x-y ] := false ;
empdo [ x+y ] := false ;
if x = N then
goto gotone
else
set ( x + 1 ) ;
empdo [ x+y ] := true ;
empup [ x-y ] := true ;
empcol [ y ] := true ;
column [ y ] := 0
end
end
end;
comment
main program start
;
prints (`looking onto a ');
printn (N);
prints (` x ');
printn (N);
printsln (` chessboard...');
for i := 1 step 1 until N do
begin
column [ i ] := 0 ;
empcol [ i ] := true
end;
for i := -N+1 step 1 until N-1 do
empup [ i ] := true ;
for i := 2 step 1 until 2*N do
empdo [ i ] := true ;
set ( 1 ) ;
printsln (`NO SOLUTION.');
goto contN;
gotone:
printsln(`SOLVED');
print;
contN:
if N < MAXN then begin
N := N + 1;
goto tryNextN
end;
printsln (`done.')
end
end

67
collects/algol60/examples/primes.a60 Normal file
View File

@ -0,0 +1,67 @@
begin
comment
-- From the NASE A60 distribution --
calculation of the prime numbers between 2 and 200
;
integer NN;
NN := 200;
begin
comment first algorithm (check division in a loop) ;
Boolean procedure isprime (n);
value n;
integer n;
begin
Boolean procedure even (n);
value n; integer n;
even := entier (n / 2) * 2 = n;
integer i;
isprime := false;
if even (n) & n != 2 then
goto ret;
for i := 3 step 2 until n div 2 do
if entier (n / i) * i = n then
goto ret;
isprime := true;
ret:
end;
integer i;
printsln (`first:');
for i := 2 step 1 until NN do
if isprime (i) then
printnln (i);
printsln (`done.')
end;
begin
comment second algorithm (sieve) ;
Boolean array arr [2 : NN];
integer i, j;
printsln (`second:');
for i := 2 step 1 until NN do
arr [i] := true;
for i := 2 step 1 until NN div 2 do
for j := 2 * i step i until NN do
arr [j] := false;
for i := 2 step 1 until NN do
if arr [i] then
printnln (i);
printsln (`done.')
end
end

3
collects/algol60/get-base.ss Normal file
View File

@ -0,0 +1,3 @@
(module get-base (lib "base.ss" "algol60")
(provide base-importing-stx)
(define base-importing-stx #'here))

4
collects/algol60/info.ss Normal file
View File

@ -0,0 +1,4 @@
(module info (lib "infotab.ss" "setup")
(define name "Algol 60")
(define doc.txt "doc.txt")
(define tools (list (list "tool.ss"))))

413
collects/algol60/parse.ss Normal file
View File

@ -0,0 +1,413 @@
#cs(module parse mzscheme
(require (lib "lex.ss" "parser-tools")
(prefix : (lib "lex-sre.ss" "parser-tools"))
(lib "yacc.ss" "parser-tools")
(lib "readerr.ss" "syntax")
"prims.ss")
(define-lex-abbrevs [lex:letter (:or (:/ #\a #\z) (:/ #\A #\Z))]
[lex:digit (:/ #\0 #\9)]
[lex:whitespace (:or #\newline #\return #\tab #\space #\vtab)]
[lex:comment (:: (:* lex:whitespace) "comment" (:* (:~ #\;)) #\;)])
(define-tokens non-terminals (<logical-value>
<type> <identifier>
<unsigned-integer> <unsigned-float> <string>
GOTO IF THEN ELSE FOR DO STEP UNTIL WHILE
OWN ARRAY STRING PROCEDURE SWITCH LABEL VALUE
BEGIN END
POWER PLUS MINUS TIMES SLASH DIVIDE
LESS LESS-OR-EQUAL EQUAL GREATER-OR-EQUAL GREATER NOT-EQUAL ASSIGN
NEGATE AND OR IMPLIES EQUIV
COMMA COLON SEMICOLON
OPEN CLOSE OPENSQ CLOSESQ
EOF
UNPARSEABLE))
(define stx-for-original-property (read-syntax #f (open-input-string "original")))
(define-syntax (token stx)
(syntax-case stx ()
[(_ name val)
(identifier? (syntax name))
(let ([name (syntax name)])
(with-syntax ([token-name (datum->syntax-object
name
(string->symbol
(format "token-~a" (syntax-e name))))]
[source-name (datum->syntax-object name 'source-name)]
[start-pos (datum->syntax-object name 'start-pos)]
[end-pos (datum->syntax-object name 'end-pos)])
(syntax
(token-name
(datum->syntax-object #f val
(list
source-name
(position-line start-pos)
(position-col start-pos)
(position-offset start-pos)
(- (position-offset end-pos)
(position-offset start-pos)))
stx-for-original-property)))))]))
(define-syntax (ttoken stx)
(syntax-case stx ()
[(_ name)
(identifier? (syntax name))
(syntax (token name 'name))]))
(define (lex source-name)
(lexer
[(:+ lex:whitespace) (void)]
["true" (token <logical-value> #t)]
["false" (token <logical-value> #f)]
["real" (token <type> 'real)]
["integer" (token <type> 'integer)]
["Boolean" (token <type> 'boolean)]
["goto" (ttoken GOTO)]
["if" (ttoken IF)]
["then" (ttoken THEN)]
["else" (ttoken ELSE)]
["for" (ttoken FOR)]
["do" (ttoken DO)]
["step" (ttoken STEP)]
["until" (ttoken UNTIL)]
["while" (ttoken WHILE)]
["own" (ttoken OWN)]
["array" (ttoken ARRAY)]
["string" (ttoken STRING)]
["procedure" (ttoken PROCEDURE)]
["switch" (ttoken SWITCH)]
["label" (ttoken LABEL)]
["value" (ttoken VALUE)]
[(:: "begin" lex:comment) (ttoken BEGIN)]
["begin" (ttoken BEGIN)]
[(:: "end" lex:comment) (ttoken BEGIN)]
["end" (ttoken END)]
["^" (token POWER 'expt)]
["+" (token PLUS '+)]
["-" (token MINUS '-)]
["*" (token TIMES '*)]
["/" (token SLASH '/)]
["div" (token DIVIDE 'quotient)]
["<" (token LESS '<)]
["<=" (token LESS-OR-EQUAL '<=)]
["=" (token EQUAL '=)]
[">" (token GREATER '>)]
[">=" (token GREATER-OR-EQUAL '>=)]
["!=" (token NOT-EQUAL '!=)]
["!" (token NEGATE '!)]
["&" (token AND '&)]
["|" (token OR '\|)]
["=>" (token IMPLIES '=>)]
["==" (token EQUIV '==)]
[":=" (ttoken ASSIGN)]
["," (ttoken COMMA)]
[":" (ttoken COLON)]
[(:: ";" lex:comment) (ttoken SEMICOLON)]
[";" (ttoken SEMICOLON)]
["(" (ttoken OPEN)]
[")" (ttoken CLOSE)]
["[" (ttoken OPENSQ)]
["]" (ttoken CLOSESQ)]
[(:: lex:letter (:* (:or lex:letter lex:digit))) (token <identifier> (string->symbol lexeme))]
[(:+ lex:digit) (token <unsigned-integer> (string->number lexeme))]
[(:or (:: (:+ lex:digit) #\. (:* lex:digit))
(:: (:* lex:digit) #\. (:+ lex:digit))) (token <unsigned-float> (string->number lexeme))]
[(:: #\` (:* (:~ #\' #\`)) #\') (let ([s lexeme])
(token <string> (substring s 1 (sub1 (string-length s)))))]
[(eof) (ttoken EOF)]
[any-char (token UNPARSEABLE (string->symbol lexeme))]))
(define parse
(parser
(tokens non-terminals)
(start <program>)
(end EOF)
(error (lambda (a b stx)
(raise-read-error (format "parse error near ~a" (syntax-e stx))
(syntax-source stx)
(syntax-line stx)
(syntax-column stx)
(syntax-position stx)
(syntax-span stx))))
(suppress)
(grammar
;; ==================== Expressions ====================
(<expression> [(<arithmetic-expression>) $1]
[(<Boolean-expression>) $1]
[(<designational-expression>) $1])
;; -------------------- Numbers --------------------
(<arithmetic-expression> [(<simple-arithmetic-expression>) $1]
[(IF <Boolean-expression>
THEN <simple-arithmetic-expression>
ELSE <arithmetic-expression>)
(make-a60:if $2 $4 $6)])
(<simple-arithmetic-expression> [(<term>) $1]
[(<adding-operator> <term>) (make-a60:unary 'num 'num $1 $2)]
[(<simple-arithmetic-expression> <adding-operator> <term>)
(make-a60:binary 'num 'num $2 $1 $3)])
(<term> [(<factor>) $1]
[(<term> <multiplying-operator> <factor>) (make-a60:binary 'num 'num $2 $1 $3)])
(<factor> [(<primary>) $1]
[(<factor> POWER <primary>) (make-a60:binary 'num 'num $2 $1 $3)])
(<adding-operator> [(PLUS) $1]
[(MINUS) $1])
(<multiplying-operator> [(TIMES) $1]
[(SLASH) $1]
[(DIVIDE) $1])
(<primary> [(<unsigned-integer>) $1]
[(<unsigned-float>) $1]
[(<variable>) $1]
[(<function-designator>) $1]
[(OPEN <arithmetic-expression> CLOSE) $2])
;; -------------------- Booleans --------------------
(<relational-operator> [(LESS) $1]
[(LESS-OR-EQUAL) $1]
[(EQUAL) $1]
[(GREATER-OR-EQUAL) $1]
[(GREATER) $1]
[(NOT-EQUAL) $1])
(<relation> [(<simple-arithmetic-expression> <relational-operator> <simple-arithmetic-expression>)
(make-a60:binary 'bool 'num $2 $1 $3)])
(<Boolean-primary> [(<logical-value>) $1]
[(<variable>) $1]
[(<function-designator>) $1]
[(<relation>) $1]
[(OPEN <Boolean-expression> CLOSE) $2])
(<Boolean-secondary> [(<Boolean-primary>) $1]
[(NEGATE <Boolean-primary>) (make-a60:unary 'bool 'bool $1 $2)])
(<Boolean-factor> [(<Boolean-secondary>) $1]
[(<Boolean-factor> AND <Boolean-secondary>) (make-a60:binary 'bool 'bool $2 $1 $3)])
(<Boolean-term> [(<Boolean-factor>) $1]
[(<Boolean-term> OR <Boolean-factor>) (make-a60:binary 'bool 'bool $2 $1 $3)])
(<implication> [(<Boolean-term>) $1]
[(<implication> IMPLIES <Boolean-term>) (make-a60:binary 'bool 'bool $2 $1 $3)])
(<simple-Boolean> [(<implication>) $1]
[(<simple-Boolean> EQUIV <implication>) (make-a60:binary 'bool 'bool $2 $1 $3)])
(<Boolean-expression> [(<simple-Boolean>) $1]
[(IF <Boolean-expression>
THEN <simple-Boolean>
ELSE <Boolean-expression>)
(make-a60:if $2 $4 $6)])
;; -------------------- Designationals --------------------
(<label> [(<identifier>) $1]
[(<unsigned-integer>) $1])
(<switch-identifier> [(<identifier>) $1])
(<switch-designator> [(<switch-identifier> OPENSQ <arithmetic-expression> CLOSESQ)
(make-a60:subscript $1 $3)])
(<simple-designational-expression> [(<label>) $1]
[(<switch-designator>) $1]
[(OPEN <designational-expression> CLOSE) $2])
(<designational-expression> [(<simple-designational-expression>) $1]
[(IF <Boolean-expression>
THEN <simple-designational-expression>
ELSE <designational-expression>)
(make-a60:if $2 $4 $6)])
;; -------------------- Variables --------------------
(<subscript-list> [(<arithmetic-expression>) (list $1)]
[(<subscript-list> COMMA <arithmetic-expression>) (append $1 (list $3))])
(<subscripted-variable> [(<identifier> OPENSQ <subscript-list> CLOSESQ) (make-a60:variable $1 $3)])
(<variable> [(<identifier>) (make-a60:variable $1 null)]
[(<subscripted-variable>) $1])
;; -------------------- Function calls --------------------
(<function-designator> [(<identifier> <actual-parameter-part>) (make-a60:app $1 $2)])
;; ==================== Statements ====================
;; - - - - - - - - - - non-empty - - - - - - - - - -
(<unlabelled-basic-nonempty-statement> [(<assignment-statement>) $1]
[(<go-to-statement>) $1]
[(<procedure-statement>) $1])
(<basic-nonempty-statement> [(<unlabelled-basic-nonempty-statement>) $1]
[(<label> COLON <basic-statement>) (make-a60:label $1 $3)])
(<unconditional-nonempty-statement> [(<basic-nonempty-statement>) $1]
[(<compound-statement>) $1]
[(<block>) $1])
(<nonempty-statement> [(<unconditional-nonempty-statement>) $1]
[(<conditional-statement>) $1]
[(<for-statement>) $1])
;; - - - - - - - - - - possibly empty - - - - - - - - - -
(<unlabelled-basic-statement> [(<unlabelled-basic-nonempty-statement>) $1]
[(<dummy-statement>) $1])
(<basic-statement> [(<unlabelled-basic-statement>) $1]
[(<label> COLON <basic-statement>) (make-a60:label $1 $3)])
(<unconditional-statement> [(<basic-statement>) $1]
[(<unconditional-nonempty-statement>) $1])
(<statement> [(<unconditional-statement>) $1]
[(<nonempty-statement>) $1])
;; -------------------- block and compound --------------------
(<compound-tail> [(<statement> END) (list $1)]
[(<statement> SEMICOLON <compound-tail>) (cons $1 $3)])
(<block-head> [(BEGIN <declaration>) (list $2)]
[(<block-head> SEMICOLON <declaration>) (append $1 (list $3))])
(<unlabelled-block> [(<block-head> SEMICOLON <compound-tail>) (make-a60:block $1 $3)])
(<unlabelled-compound> [(BEGIN <compound-tail>) (make-a60:compound $2)])
(<compound-statement> [(<unlabelled-compound>) $1]
[(<label> COLON <compound-statement>) (make-a60:label $1 $3)])
(<block> [(<unlabelled-block>) $1]
[(<label> COLON <block>) (make-a60:label $1 $3)])
;; -------------------- assignment --------------------
(<left-part> [(<variable> ASSIGN) $1])
(<left-part-list> [(<left-part>) (list $1)]
[(<left-part-list> <left-part>) (append $1 (list $2))])
(<assignment-statement> [(<left-part-list> <arithmetic-expression>) (make-a60:assign $1 $2)]
[(<left-part-list> <Boolean-expression>) (make-a60:assign $1 $2)])
;; -------------------- goto --------------------
(<go-to-statement> [(GOTO <designational-expression>) (make-a60:goto $2)])
;; -------------------- dummy --------------------
(<dummy-statement> [() (make-a60:compound null)])
;; -------------------- conditional --------------------
(<conditional-statement> [(IF <Boolean-expression> THEN <unconditional-statement>)
(make-a60:branch $2 $4 (make-a60:compound null))]
[(IF <Boolean-expression> THEN <unconditional-statement> ELSE <statement>)
(make-a60:branch $2 $4 $6)]
[(IF <Boolean-expression> THEN <for-statement>)
(make-a60:branch $2 $4 (make-a60:compound null))]
[(<label> COLON <conditional-statement>) (make-a60:label $1 $3)])
;; -------------------- for --------------------
(<for-list-element> [(<arithmetic-expression>) (make-a60:for-number $1)]
[(<arithmetic-expression> STEP <arithmetic-expression> UNTIL <arithmetic-expression>)
(make-a60:for-step $1 $3 $5)]
[(<arithmetic-expression> WHILE <Boolean-expression>) (make-a60:for-while $1 $3)])
(<for-list> [(<for-list-element>) (list $1)]
[(<for-list> COMMA <for-list-element>) (append $1 (list $3))])
(<for-statement> [(FOR <variable> ASSIGN <for-list> DO <statement>)
(make-a60:for $2 $4 $6)]
[(<label> COLON <for-statement>) (make-a60:label $1 $3)])
;; -------------------- procedure statement --------------------
(<actual-parameter> [(<string>) $1]
[(<expression>) $1]
; [(<identifier>) $1] ; switch, array, or procedure
)
(<parameter-delimiter> [(COMMA) (void)]
[(CLOSE <identifier> COLON OPEN) (void)]) ;; <identifier> was <letter-string>!
(<actual-parameter-list> [(<actual-parameter>) (list $1)]
[(<actual-parameter-list> <parameter-delimiter> <actual-parameter>)
(append $1 (list $3))])
(<actual-parameter-part> [() null]
[(OPEN <actual-parameter-list> CLOSE) $2])
(<procedure-statement> [(<identifier> <actual-parameter-part>) (make-a60:call $1 $2)])
;; ==================== Declarations ====================
(<declaration> [(<type-declaration>) $1]
[(<array-declaration>) $1]
[(<switch-declaration>) $1]
[(<procedure-declaration>) $1])
;; -------------------- Simple --------------------
(<type-list> [(<identifier>) (list $1)]
[(<identifier> COMMA <type-list>) (cons $1 $3)])
(<local-or-own-type> [(<type>) $1]
[(OWN <type>) (box $2)]) ; box => own
(<type-declaration> [(<local-or-own-type> <type-list>) (make-a60:type-decl $1 $2)])
;; -------------------- Arrays --------------------
(<bound-pair> [(<arithmetic-expression> COLON <arithmetic-expression>) (cons $1 $3)])
(<bound-pair-list> [(<bound-pair>) (list $1)]
[(<bound-pair-list> COMMA <bound-pair>) (append $1 (list $3))])
(<array-segment> [(<identifier> OPENSQ <bound-pair-list> CLOSESQ) (list (cons $1 $3))]
[(<identifier> COMMA <array-segment>) (cons (cons $1 (cdar $3)) $3)])
(<array-list> [(<array-segment>) $1]
[(<array-list> COMMA <array-segment>) (append $1 $3)])
(<array-declaration> [(ARRAY <array-list>) (make-a60:array-decl #'unknown $2)]
[(<local-or-own-type> ARRAY <array-list>) (make-a60:array-decl $1 $3)])
;; -------------------- Switches --------------------
(<switch-list> [(<designational-expression>) (list $1)]
[(<switch-list> COMMA <designational-expression>) (append $1 (list $3))])
(<switch-declaration> [(SWITCH <switch-identifier> ASSIGN <switch-list>) (make-a60:switch-decl $2 $4)])
;; -------------------- Procedures --------------------
(<formal-parameter> [(<identifier>) $1])
(<formal-parameter-list> [(<formal-parameter>) (list $1)]
[(<formal-parameter-list> <parameter-delimiter> <formal-parameter>)
(append $1 (list $3))])
(<formal-parameter-part> [() null]
[(OPEN <formal-parameter-list> CLOSE) $2])
(<identifier-list> [(<identifier>) (list $1)]
[(<identifier-list> COMMA <identifier>) (append $1 (list $3))])
(<value-part> [(VALUE <identifier-list> SEMICOLON) $2]
[() null])
(<specifier> [(STRING) 'string]
[(<type>) $1]
[(ARRAY) '(array #'unknown)]
[(<type> ARRAY) `(array ,$1)]
[(LABEL) 'label]
[(SWITCH) 'switch]
[(PROCEDURE) '(procedure #'unknown)]
[(<type> PROCEDURE) `(procedure ,$1)])
(<nonempty-specification-part> [(<specifier> <identifier-list> SEMICOLON) (list (cons $1 $2))]
[(<nonempty-specification-part> <specifier> <identifier-list> SEMICOLON)
(append $1 (list (cons $2 $3)))])
(<specification-part> [() null]
[(<nonempty-specification-part>) $1])
(<procedure-heading> [(<identifier> <formal-parameter-part> SEMICOLON <value-part> <specification-part>)
(list $1 $2 $4 $5)])
(<procedure-body> [(<nonempty-statement>) $1])
(<procedure-declaration> [(PROCEDURE <procedure-heading> <procedure-body>)
(make-a60:proc-decl #'unknown (car $2) (cadr $2) (caddr $2) (cadddr $2) $3)]
[(<type> PROCEDURE <procedure-heading> <procedure-body>)
(make-a60:proc-decl $1 (car $3) (cadr $3) (caddr $3) (cadddr $3) $4)])
;; ==================== Program ====================
(<program> [(<block>) $1]
[(<compound-statement>) $1]))))
(define-syntax (define-a60-structs stx)
(syntax-case stx ()
[(_ (struct-name (field ...)) ...)
(with-syntax ([(a60:struct ...) (map (lambda (id)
(datum->syntax-object
id
(string->symbol
(format "a60:~a" (syntax-e id)))))
(syntax->list (syntax (struct-name ...))))])
(syntax (begin (define-struct a60:struct (field ...)) ...
(provide (struct a60:struct (field ...)) ...))))]))
(define-a60-structs
;; Expressions
(if (test then else))
(unary (type argtype op arg))
(binary (type argtype op arg1 arg2))
(subscript (array index))
(variable (name indices))
(app (func args))
;; plus numbers, strings, and booleans
;; Statements
(block (decls statements))
(compound (statements))
(assign (variables rhs))
(goto (target))
(branch (test then else))
(call (proc args))
(for (variable values body))
(dummy ())
(label (name statement))
;; for values
(for-number (value))
(for-step (start step end))
(for-while (value test))
;; declarations
(type-decl (type vars))
(array-decl (type vars))
(switch-decl (var cases))
(proc-decl (result-type var arg-vars by-value-vars arg-specs body)))
(define (parse-a60-port port file)
(let ([lexer (lex file)])
(port-count-lines! port)
(parse
(lambda ()
(let loop ()
(let ([v (lexer port)])
(if (void? v)
(loop)
v)))))))
(define (parse-a60-file file)
(with-input-from-file file
(lambda ()
(parse-a60-port (current-input-port)
(path->complete-path file)))))
(provide parse-a60-file parse-a60-port))

106
collects/algol60/prims.ss Normal file
View File

@ -0,0 +1,106 @@
(module prims mzscheme
(provide != ! & \|
=> ==
sign entier
a60:sin
a60:cos
a60:arctan
a60:sqrt
a60:abs
a60:ln
a60:exp
prints printn
printsln printnln)
(define (!= a b)
(not (= a b)))
(define (! a)
(unless (boolean? a)
(raise-type-error '! "boolean" a))
(not a))
(define (& a b)
(unless (boolean? a)
(raise-type-error '& "boolean" 0 a b))
(unless (boolean? b)
(raise-type-error '& "boolean" 1 a b))
(and a b))
(define (\| a b)
(unless (boolean? a)
(raise-type-error '\| "boolean" 0 a b))
(unless (boolean? b)
(raise-type-error '\| "boolean" 1 a b))
(or a b))
(define (=> a b)
(unless (boolean? a)
(raise-type-error '=> "boolean" 0 a b))
(unless (boolean? b)
(raise-type-error '=> "boolean" 1 a b))
(or (not a) b))
(define (== a b)
(unless (boolean? a)
(raise-type-error '== "boolean" 0 a b))
(unless (boolean? b)
(raise-type-error '== "boolean" 1 a b))
(eq? a b))
(define (get-number who v)
(let ([v (v)])
(unless (number? v)
(raise-type-error who "number" v))
v))
(define (get-string who v)
(let ([v (v)])
(unless (string? v)
(raise-type-error who "string" v))
v))
(define (sign k v)
(k (let ([v (get-number 'sign v)])
(cond
[(< v 0) -1]
[(> v 0) 1]
[else 0]))))
(define (entier k v)
(k (inexact->exact (floor (get-number 'entier v)))))
(define (a60:abs k v)
(k (abs (get-number 'abs v))))
(define (a60:sqrt k v)
(k (sqrt (get-number 'sqrt v))))
(define (a60:sin k v)
(k (sin (get-number 'sin v))))
(define (a60:cos k v)
(k (cos (get-number 'cos v))))
(define (a60:exp k v)
(k (exp (get-number 'exp v))))
(define (a60:arctan k v)
(k (atan (get-number 'arctan v))))
(define (a60:ln k v)
(k (log (get-number 'ln v))))
(define (printsln k v)
(k (printf "~a~n" (get-string 'printsln v))))
(define (printnln k v)
(k (printf "~a~n" (get-number 'printnln v))))
(define (prints k v)
(k (printf "~a" (get-string 'prints v))))
(define (printn k v)
(k (printf "~a" (get-number 'printn v)))))

108
collects/algol60/runtime.ss Normal file
View File

@ -0,0 +1,108 @@
(module runtime mzscheme
(provide (struct a60:array (vec dimens))
(struct a60:switch (choices))
undefined
check-boolean
goto
get-value
set-target!
make-array
array-ref
array-set!
make-switch
switch-ref
coerce)
(define-struct a60:array (vec dimens))
(define-struct a60:switch (choices))
(define undefined (letrec ([x x]) x))
(define (check-boolean b) b)
(define (goto f) (f))
(define (get-value v) (v))
(define (set-target! t name v)
(unless (procedure-arity-includes? t 1)
(error 'assignment "formal-argument variable ~a is assigned, but actual argument was not assignable"
name))
(t v))
(define (bad what v)
(error '|bad value| "expected a ~a, got ~e" what v))
(define (coerce type v)
(cond
[(eq? type 'integer)
(if (number? v)
(inexact->exact (floor v))
(bad 'number v))]
[(eq? type 'real)
(if (number? v)
(exact->inexact v)
(bad 'number v))]
[(eq? type 'boolean)
(if (boolean? v)
v
(bad 'boolean v))]
[else v]))
(define (make-array . dimens)
(make-a60:array
((let loop ([dimens dimens])
(if (null? dimens)
(lambda () undefined)
(let ([start (car dimens)]
[end (cadr dimens)])
(let ([build (loop (cddr dimens))])
(lambda ()
(let ([len (add1 (- end start))])
(let ([v (make-vector len)])
(let loop ([len len])
(unless (zero? len)
(vector-set! v (sub1 len) (build))
(loop (sub1 len))))
v))))))))
dimens))
(define (check-array a is who)
(unless (a60:array? a)
(error who "not an array: ~e" a))
(unless (= (length is) (/ (length (a60:array-dimens a)) 2))
(error who "array dimension ~a doesn't match the number of provided indices ~a"
(length is) (/ (length (a60:array-dimens a)) 2))))
(define (check-index who dimens indices)
(unless (and (number? (car indices))
(exact? (car indices))
(integer? (car indices)))
(error who "index is not an integer: ~e"
(car indices)))
(unless (<= (car dimens) (car indices) (cadr dimens))
(error who "index ~a out of range ~a:~a"
(car indices) (car dimens) (cadr dimens))))
(define (array-ref a . indices)
(check-array a indices 'array-reference)
(let loop ([v (a60:array-vec a)][indices indices][dimens (a60:array-dimens a)])
(check-index 'array-reference dimens indices)
(let ([i (vector-ref v (- (car indices) (car dimens)))])
(if (null? (cdr indices))
i
(loop i (cdr indices) (cddr dimens))))))
(define (array-set! a val . indices)
(check-array a indices 'array-assignment)
(let loop ([v (a60:array-vec a)][indices indices][dimens (a60:array-dimens a)])
(check-index 'array-assignment dimens indices)
(if (null? (cdr indices))
(vector-set! v (- (car indices) (car dimens)) val)
(loop (vector-ref v (- (car indices) (car dimens))) (cdr indices) (cddr dimens)))))
(define (make-switch . choices)
(make-a60:switch (list->vector choices)))
(define (switch-ref sw index)
(unless (and (number? index)
(integer? index)
(exact? index)
(<= 1 index (vector-length (a60:switch-choices sw))))
(error "bad switch index: " index))
((vector-ref (a60:switch-choices sw) (sub1 index)))))

170
collects/algol60/simplify.ss Normal file
View File

@ -0,0 +1,170 @@
#cs(module simplify mzscheme
(require "parse.ss"
"prims.ss"
(lib "match.ss"))
(provide simplify)
;; flatten/label-block : list-of-decl list-of-stmt -> block-stmt
;; Desugars `for', converts `if' so that it's always of the form
;; `if <test> then goto <label> else goto <label>', flattens
;; compound statements into the enclosing block, and gives every
;; statement exactly one label. The result usually has lots of
;; "dummy" statements that could easily be eliminated by merging
;; labels.
(define (flatten/label-block decls statements ->stx)
(define extra-decls null)
(define new-statements
(let loop ([l statements])
(if (null? l)
null
(match (car l)
[($ a60:block decls statements)
(cons (cons (gensym 'block) (flatten/label-block decls statements ->stx))
(loop (cdr l)))]
[($ a60:compound statements)
(loop (append statements (cdr l)))]
[($ a60:branch test then else)
(if (and (a60:goto? then) (a60:goto? else))
(cons (cons (gensym 'branch) (car l))
(loop (cdr l)))
(let ([then-label (gensym 'then)]
[else-label (gensym 'else)]
[cont-label (gensym 'if-cont)])
(loop
(list*
(make-a60:branch test (make-a60:goto then-label) (make-a60:goto else-label))
(make-a60:label then-label then)
(make-a60:goto cont-label)
(make-a60:label else-label else)
(make-a60:label cont-label (make-a60:dummy))
(cdr l)))))]
[($ a60:for variable val-exprs body)
(let ([body-label (gensym 'for-body)]
[cont-label (gensym 'for-cont)])
(letrec ([make-init+test+increment+loop
(lambda (value)
(match value
[($ a60:for-number value)
(values (make-a60:assign (list variable) (make-a60:binary 'num 'num
(->stx '+)
(->stx '0)
value)) ; +0 => number
(->stx #t)
(make-a60:dummy)
#f)]
[($ a60:for-step start step end)
(values (make-a60:assign (list variable) start)
(make-a60:binary 'bool 'num
(->stx '<=)
(make-a60:binary 'num 'num
(->stx '*)
(make-a60:binary 'num 'num (->stx '-) variable end)
(make-a60:app (->stx 'sign) (list step)))
(->stx '0))
(make-a60:assign (list variable) (make-a60:binary 'num 'num (->stx '+) variable step))
#t)]
[($ a60:for-while value test)
(values (make-a60:assign (list variable) value)
test
(make-a60:assign (list variable) value)
#t)]))])
(if (= 1 (length val-exprs))
(let-values ([(init test inc loop?) (make-init+test+increment+loop (car val-exprs))])
(loop (list*
init
(make-a60:label body-label (make-a60:dummy))
(make-a60:branch test
(make-a60:compound
(list
body
inc
(if loop?
(make-a60:goto body-label)
(make-a60:dummy))))
(make-a60:dummy))
(cdr l))))
(let* ([stage-name (datum->syntax-object #f (gensym 'stage-number))]
[switch-name (datum->syntax-object #f (gensym 'stage-switch))]
[end-switch-name (datum->syntax-object #f (gensym 'stage-switch))]
[stage-var (make-a60:variable stage-name null)]
[start-labels (map (lambda (x) (gensym 'stage)) (append val-exprs (list 'extra)))]
[end-labels (map (lambda (x) (gensym 'stage)) val-exprs)])
(set! extra-decls (list* stage-name
(cons switch-name start-labels)
(cons end-switch-name end-labels)
extra-decls))
(loop
(append
(list (make-a60:assign (list stage-var) (->stx '0)))
(let loop ([start-labels start-labels][end-labels end-labels][val-exprs val-exprs])
(if (null? val-exprs)
(list (make-a60:label (car start-labels) (make-a60:dummy)))
(let-values ([(init test inc loop?) (make-init+test+increment+loop (car val-exprs))])
(list*
(make-a60:label (car start-labels) (make-a60:dummy))
init
(make-a60:branch test
(make-a60:goto body-label)
(make-a60:compound
(list
(make-a60:assign (list stage-var) (make-a60:binary 'num 'num
(->stx '+)
(->stx '1)
stage-var))
(make-a60:goto (make-a60:subscript switch-name stage-var)))))
(make-a60:label (car end-labels) (make-a60:dummy))
inc
(if loop?
(make-a60:goto (car start-labels))
(make-a60:goto (cadr start-labels)))
(loop (cdr start-labels)
(cdr end-labels)
(cdr val-exprs))))))
(list
(make-a60:goto cont-label)
(make-a60:label body-label (make-a60:dummy))
body
(make-a60:goto (make-a60:subscript end-switch-name stage-var))
(make-a60:label cont-label (make-a60:dummy)))
(cdr l)))))))]
[($ a60:label name statement)
(cons (cons name (make-a60:dummy))
(loop (cons statement (cdr l))))]
[else
(cons (cons (gensym 'other) (car l))
(loop (cdr l)))]))))
(make-a60:block
(append
(map (lambda (decl)
(match decl
[($ a60:proc-decl result-type var arg-vars by-value-vars arg-specs body)
(make-a60:proc-decl result-type var arg-vars by-value-vars arg-specs
(simplify-statement body ->stx))]
[else decl]))
decls)
(map (lambda (extra)
(if (identifier? extra)
(make-a60:type-decl (->stx 'integer) (list extra))
(make-a60:switch-decl (car extra) (map (lambda (x)
(make-a60:variable (datum->syntax-object #f x) null))
(cdr extra)))))
extra-decls))
(if (null? new-statements)
(list (cons (gensym 'other) (make-a60:dummy)))
new-statements)))
(define (simplify stmt ctx)
(simplify-statement stmt (lambda (x)
(datum->syntax-object
ctx
x))))
(define (simplify-statement stmt ->stx)
(match stmt
[($ a60:block decls statements)
(flatten/label-block decls statements ->stx)]
[($ a60:compound statements)
(flatten/label-block null statements ->stx)]
[else stmt])))

116
collects/algol60/tool.ss Normal file
View File

@ -0,0 +1,116 @@
(module tool mzscheme
(require (lib "tool.ss" "drscheme")
(lib "mred.ss" "mred")
(lib "unitsig.ss")
(lib "class.ss")
"parse.ss"
"simplify.ss"
"compile.ss"
"get-base.ss"
(lib "embed.ss" "compiler")
(lib "string-constant.ss" "string-constants")
(prefix bd: "bd-tool.ss"))
(provide tool@)
(define tool@
(unit/sig drscheme:tool-exports^
(import drscheme:tool^)
(define-values/invoke-unit/sig drscheme:tool-exports^
bd:tool@
bd
drscheme:tool^)
(define (phase1) (bd:phase1))
(define (phase2)
(bd:phase2)
(drscheme:language-configuration:add-language
(make-object (override-mrflow-methods
((drscheme:language:get-default-mixin)
lang%)))))
(define (override-mrflow-methods %)
(if (method-in-interface? 'render-value-set (class->interface %))
(class %
(inherit [super-render-value-set render-value-set]
[super-get-mrflow-primitives-filename get-mrflow-primitives-filename])
(define/override (render-value-set . x)
;; needs to be filled in!
(super-render-value-set . x))
(define/override (get-mrflow-primitives-filename)
(build-path (collection-path "mrflow")
"primitives"
"algol60.ss"))
(super-instantiate ()))
%))
(define lang%
(class* object% (drscheme:language:language<%>)
(define/public (config-panel parent)
(case-lambda
[() null]
[(x) (void)]))
(define/public (get-comment-character) (values "'COMMENT'" #\*))
(define/public (default-settings) null)
(define/public (default-settings? x) #t)
(define/private (front-end port settings)
(let ([name (object-name port)])
(lambda ()
(if (eof-object? (peek-char port))
eof
(compile-simplified
(simplify (parse-a60-port port name) base-importing-stx)
base-importing-stx)))))
(define/public (front-end/complete-program port settings teachpack-cache) (front-end port settings))
(define/public (front-end/interaction port settings teachpack-cache) (front-end port settings))
(define/public (get-style-delta) #f)
(define/public (get-language-position)
(list (string-constant experimental-languages)
"Algol 60"))
(define/public (order-manuals x)
(values
(list #"drscheme" #"tour" #"help")
#f))
(define/public (get-language-name) "Algol 60")
(define/public (get-language-url) #f)
(define/public (get-language-numbers) (list 1000 10))
(define/public (get-teachpack-names) null)
(define/public (marshall-settings x) x)
(define/public (on-execute settings run-in-user-thread)
(dynamic-require '(lib "base.ss" "algol60") #f)
(let ([path ((current-module-name-resolver) '(lib "base.ss" "algol60") #f #f)]
[n (current-namespace)])
(run-in-user-thread
(lambda ()
(error-display-handler
(drscheme:debug:make-debug-error-display-handler (error-display-handler)))
(current-eval
(drscheme:debug:make-debug-eval-handler (current-eval)))
(with-handlers ([void (lambda (x)
(printf "~a~n"
(exn-message x)))])
(namespace-attach-module n path)
(namespace-require path))))))
(define/public (render-value value settings port) (write value port))
(define/public (render-value/format value settings port width) (write value port))
(define/public (unmarshall-settings x) x)
(define/public (create-executable settings parent src-file teachpacks)
(let ([dst-file (drscheme:language:put-executable
parent src-file #f #f
(string-constant save-a-mzscheme-stand-alone-executable))])
(when dst-file
(let ([code (compile-simplified (simplify (parse-a60-file src-file)
base-importing-stx)
base-importing-stx)])
(make-embedding-executable dst-file
#f #f
'((#f (lib "base.ss" "algol60")))
null
(compile
`(module m (lib "base.ss" "algol60")
,code))
(list "-mvqe" "(require m)"))))))
(define/public (get-one-line-summary) "Algol 60 (not Scheme at all!)")
(super-instantiate ()))))))

11
collects/browser/browser-sig.ss Normal file
View File

@ -0,0 +1,11 @@
(module browser-sig mzscheme
(require (lib "unitsig.ss")
"private/sig.ss")
(provide browser^)
(define-signature browser^
((open hyper^)
(open html-export^)
(open bullet-export^))))

44
collects/browser/browser-unit.ss Normal file
View File

@ -0,0 +1,44 @@
(module browser-unit mzscheme
(require (lib "unitsig.ss")
(lib "mred-sig.ss" "mred")
(lib "plt-installer-sig.ss" "setup")
(lib "tcp-sig.ss" "net")
(lib "url-sig.ss" "net")
(lib "url-unit.ss" "net")
"browser-sig.ss"
"private/bullet.ss"
"private/html.ss"
"private/hyper.ss"
"private/sig.ss")
(provide browser@)
(define pre-browser@
(compound-unit/sig
(import (plt-installer : setup:plt-installer^)
(mred : mred^)
(tcp : net:tcp^)
(url : net:url^))
(link [html : html^ (html@ mred url)]
[hyper : hyper^ (hyper@ html mred plt-installer url)]
[bullet-size : bullet-export^ ((unit/sig bullet-export^
(import)
(rename (html:bullet-size bullet-size))
(define html:bullet-size bullet-size)))])
(export (open hyper)
(open bullet-size)
(open (html : html-export^)))))
;; this extra layer of wrapper here is only to
;; ensure that the browser^ signature actually matches
;; the export of the pre-browser@ unit.
;; (it didn't before, so now we check.)
(define browser@
(compound-unit/sig
(import (plt-installer : setup:plt-installer^)
(mred : mred^)
(tcp : net:tcp^)
(url : net:url^))
(link [pre-browser : browser^ (pre-browser@ plt-installer mred tcp url)])
(export (open pre-browser)))))

19
collects/browser/browser.ss Normal file
View File

@ -0,0 +1,19 @@
(module browser mzscheme
(require (lib "unitsig.ss")
(lib "mred.ss" "mred")
(lib "mred-sig.ss" "mred")
(lib "plt-installer-sig.ss" "setup")
(lib "plt-installer.ss" "setup")
(lib "tcp-sig.ss" "net")
(lib "url-sig.ss" "net")
(lib "url.ss" "net")
"browser-sig.ss"
"browser-unit.ss")
(provide-signature-elements browser^)
(define-values/invoke-unit/sig browser^ browser@ #f
setup:plt-installer^
mred^
net:tcp^
net:url^))

3
collects/browser/bullet-snip.ss Normal file
View File

@ -0,0 +1,3 @@
(module bullet-snip mzscheme
(require "private/bullet.ss")
(provide (rename bullet-snip-class snip-class)))

449
collects/browser/doc.txt Normal file
View File

@ -0,0 +1,449 @@
The _browser.ss_ library in the "browser" collection provides the
following procedures and classes for parsing and viewing _HTML_ files.
The "htmltext.ss" library (described further below) provides a
simplified interface for rendering to a subclass of the MrEd text%
class. The "external.ss" library (described even further below)
provides utilities for launching an external browser (such as
Mozilla).
The browser (and htmltext) supports basic HTML commands, plus special
Scheme hyperlinks of the form <A MZSCHEME=sexpr>...</A>. When the user
clicks on such a link, the string `sexpr' is parsed as a Scheme
program and evaluated. Since `sexpr' is likely to contain Scheme
strings, and since escape characters are difficult for people to read,
a vertical bar (|) character in sexpr is converted to a double-quote
(") character before it is parsed. Thus,
<A MZSCHEME="|This goes nowhere.|">Nowhere</A>
creates a "Nowhere" hyperlink, which executes the Scheme program
"This goes nowhere."
The value of that program is a string. When a Scheme hyperlink returns
a string, it is parsed as a new HTML document. Thus, where the use
clicks on "Nowhere", the result is a new page that says "This goes
nowhere."
The browser also treats comment forms containing MZSCHEME=sexpr
specially. Whereas the <A MZSCHEME=sexpr>...</A> form executes the
expression when the user clicks, the MZSCHEME expression in a comment
is executed immediately during HTML rendering. If the result is a
string, the comment is replaced in the input HTML stream with the
content of the string. Thus,
<!-- MZSCHEME="(format |<B>Here</B>: ~a| (current-directory))" -->
inserts the path of the current working directory into the containing
document (and "Here" is boldfaced). If the result is a snip instead of
a string, it replaces the comment in the document. Other types of
return values are ignored.
If the html file is being accessed as a "file:" url, the
current-load-relative-directory parameter is set to the directory
during the evaluation of the mzscheme code (in both examples). The
Scheme code is executed through `eval'.
The MZSCHEME forms are disabled unless the web page is a
file: url that points into the `doc' collection.
----------------------------------------
> (open-url url) - Opens the given url
(either a string, url record, or port)
in a vanilla browser frame and returns
the frame. The frame is an instance of
hyper-frame%.
-----------------------------------------
The html-img-ok parameter controls image rendering for the browser.
> (html-img-ok on?) - Sets the value of the parameter to on?
> (html-img-ok) - Returns the current value of the parameter
The html-eval-ok parameter controls the evaluation of
`MZSCHEME=' tags. If the parameter is #f, they are disabled.
> (html-eval-ok on?) - Sets the value of the parameter to on?
> (html-eval-ok) - Returns the current value of the parameter
------------------------------------------------------------
> (hyper-frame-mixin frame%) - Extends the given frame% class.
The result of this mixin takes one argument, a url
string. During the initialization of objects created from
this mixin, the code shows the frame and visits the url.
> get-hyper-panel% :: (send hyper-frame get-hyper-panel%)
returns the class that is instantiated with the frame is created.
Must be a panel with hyper-panel-mixin mixed in. Defaults to
just returning hyper-panel%.
> get-hyper-panel :: (send hyper-frame get-hyper-panel) - returns the hyper panel
in this frame
----------------------------------------
> hyper-frame% = (hyper-frame-mixin frame%)
------------------------------------------------------------
> (hyper-no-show-frame-mixin frame%) - Extends the given frame% class.
This is the same as the hyper-frame-mixin, except that it
doesn't show the frame and the initialization arguments
are unchanged.
----------------------------------------
> hyper-no-show-frame% = (hyper-frame-no-show-mixin frame%)
----------------------------------------
> (hyper-text-mixin text%) - Extends the given text% class. The
initializtion arguments are extended with a four new first
arguments: a url or a port to be loaded into the text% object, a
top-level-window or #f to use as a parent for status dialogs, a
progress procedure used as for `get-url', and either #f or a post
string to be sent to a web server (technically changing the GET to
a POST).
Sets the autowrap-bitmap to #f.
An instance of a (hyper-text-mixin text%) class should be displayed
only in an instance of a class created with `hyper-canvas-mixin'
(described below).
The mixin adds the following methods:
> map-shift-style :: (send o map-shift-style start end shift-style)
Maps the given style over the given range
> make-link-style :: (send o make-link-style start end)
Changes the style for the given range to the link style
> get-url :: (send o get-url)
Returns the URL displayed by the editor, or #f if there
is none.
> get-title :: (send o get-title)
> set-title :: (send o set-title string)
Gets or sets the page's title
> hyper-delta
A style-delta% object; override it to set the link style
> add-tag ::(send o add-tag name-string pos)
Installs a tag.
> find-tag :: (send o find-tag name-string/number)
Finds the location of a tag in the buffer (where tags are
installed in HTML with <A NAME="name">) and returns its
position. If `name' is a number, the number is returned (assumed
to be an offset rather than a tag). Otherwise, if the tag is not
found, #f is returned.
> remove-tag :: (send o remove-tag name)
Removes a tag.
> post-url :: (send o post-url string[url] post-data-bytes)
Follows the link in the string. post-data-bytes defaults to #f
> add-link :: (send o add-link start end url-string)
Installs a hyperlink.
> add-scheme-callback :: (send o add-scheme-callback start end scheme-string)
Installs a Scheme evaluation hyperlink.
> add-scheme-callback :: (send o add-thunk-callback start end thunk)
Installs a thunk-based hyperlink.
> eval-scheme-string :: (send o eval-scheme-string string)
Called to handle the <A MZSCHEME="expr">...</A> tag and <!
MZSCHEME="expr"> comments (see above). Evaluates the string; if
the result is a string, it is opened as an HTML page.
> reload :: (send o reload)
Reloads the current page.
> remap-url :: (send o remap-url url) -> url or string or #f
When visiting a new page, this method is called to remap
the url. The remapped url is used in place of the
original url. If this method returns #f, the page doesn't
go anywhere.
This method may be killed (if the user clicks the
``stop'' button)
----------------------------------------
> hyper-text% = (hyper-text-mixin text:keymap%)
This is an extension of the keymap class, to support standard keybindings
in the browser window. It adds the following method:
> get-hyper-keymap :: (send o get-hyper-keymap) -> keymap% object
Returns a keymap suitable for frame-level handling of events to
redirect page-up, etc. to the browser canvas.
----------------------------------------
> (hyper-canvas-mixin editor-canvas%) - Extends the given
editor-canvas% class. The intialization arguments are unchanged.
The canvas's parent should be an instance of a class derived with
`hyper-panel-mixin' (described below).
The mixin adds the following methods:
> get-editor% :: (send o get-editor%)
Returns the class used to implement the editor in the browser
window. It should be derived from hyper-text% and should pass on the
initialization arguments to hyper-text%
The dynamic extent of the initialization of this
editor is called on a thread that may be killed (via a
custodian shutdown)
In that case, the editor in the browser's
editor-canvas may not be an instance of this class.
> current-page :: (send o current-page)
Returns a reprsentation of the currently displayed page, which
includes a particular editor and a visible range within the
editor.
> goto-url :: (send o goto-url url relative-to-url [progress-proc] [post-data-bytes #f])
Changes to the given url, loading it by calling the `make-editor'
method. If `relative-to-url' is not #f, it must be a URL for
resolving `url' as a relative URL. `url' may also be a port, in
which case, `relative-to-url' must be #f.
The `progress-proc' procedure is called with a boolean at the
point where the URL has been resolved and enough progress has
been made to dismiss any message that the URL is being
resolved. The procedure is called with #t if the URL will be
loaded into a browser window, #f otherwise (e.g., the user will
save the URL content to a file).
If `post-data-bytes' is a byte string instead of false, the URL
GET is changed to a POST with the given data.
> set-page :: (send o set-page page notify?)
Changes to the given page. If `notify?' is not #f, the canvas's
parent is notified about the change by calling its `leaving-page'
method.
> after-set-page :: (send o after-set-page)
Called during `set-page'. Defaultly does nothing.
----------------------------------------
> hyper-canvas% = (hyper-canvas-mixin editor-canvas%)
----------------------------------------
> (hyper-panel-mixin area-container%) - Extends the given area
container class. The initialization arguments are unchanged, but
initialization creates controls and a hyper text canvas. The
controls permit a user to move back and forth in the hypertext
history.
The mixin adds a initialization argument, info-line?, which is a
boolean indicating whether the browser should contain a line to
display special "DOCNOTE" tags in a page. Such tags are used
primarily by the PLT documentation.
The mixin adds the following instance variables:
> make-canvas :: (send o make-canvas container)
Creates the panel's hypertext canvas, an instance of a class
derived using `hyper-canvas-mixin' (described above). This
method is called during initialization.
> get-canvas% :: (send o get-canvas%)
Returns the class instantiated by make-canvas. It must be derived from
hyper-canvas%
> make-control-bar-panel :: (send o make-control-bar-panel container)
Create's the panel's sub-container for the control bar containing
the navigation buttons. If #f is returned, the panel will have no
control bar. The default method instantiates horizontal-panel%.
> rewind :: (send o rewind)
Goes back one page, if possible.
> forward :: (send o forward)
Goes forward one page, if possible.
> get-canvas :: (send o get-canvas)
Gets the hypertext canvas.
> on-navigate :: (send o on-navigate)
Callback that is invoked any time the displayed hypertext page
changes (either by clicking on a link in the canvas or by
`rewind' or `forward' calls).
> leaving-page :: (send o leaving-page page new-page)
This method is called by the hypertext canvas to notify the
panel that the hypertext page changed. The `page' is #f
if `new-page' is the first page for the canvas. See also
`page->editor' (decsribed below).
> filter-notes :: (send o filter-notes list-of-strings)
Given the notes from a page as a list of strings (where
each string is a note), returns a single string to print
above the page.
> reload :: (send o reload)
Reloads the currently visible page by calling the reload method of
the currently displayed hyper-text.
----------------------------------------
> hyper-panel% = (hyper-panel-mixin vertical-panel%)
----------------------------------------
> (editor->page editor) - Creates a page record for the given editor,
suitable for use with the `set-page' method of hyper-canvas-mixin.
> (page->editor page) - Extracts the editor from a page record.
> (on-installer-run [proc]) - Parameter for a procedure to be invoked
after the installer is run on a .plt file
> (bullet-size [n]) - Parameter controlling the point size of a
bullet
-----------------------------------------
> image-map-snip% extends image-snip%
init: html-text : (is-a?/c html-text<%>)
Instances of this class behave like image-snip% objects,
except they have a <map> ... </map> associated with them and
when clicking on them (in the map) they will cause their
init arg text to follow the corresponding link.
> (send an-image-map-snip set-key key-string)
Sets the key for the image map (eg, "#key").
> (send an-image-map-snip get-key)
Returns the current key.
> (send an-image-map-snip add-area shape-string list-of-numbers href-string)
Registers the shape named by the shape-string whose
coordinates are specified by the list-of-numbers to go to
the href named href-string when that region of the image
is clicked on.
-----------------------------------------
The _browser-unit.ss_ library in the "browser" collection is a
unitized version of the code documented above. It imports unit
matching thefollowing signatures:
setup:plt-installer^
mred^
net:tcp^ (see "tcp-sig.ss" in the "net" collection)
net:url^ (see "url-sig.ss" in the "url" collection)
It exports the browser^ signature.
-----------------------------------------
The _browser-sig.ss_ library in the "browser" collection defines
the browser^ signature with all of the names listed above.
========================================
_htmltext.ss_
========================================
> html-text<%>
An interface that extends text% with the following methods:
> get-url :: (send t get-url) --- returns a base URL used for building
relative URLs, or #f if no base is available
> set-title :: (send t set-title str) --- registers the title `str'
for the rendered page
> add-link :: (send t add-link start-pos end-pos url-string) ---
registers a hyperlink for the given region in rendered page
> add-tag :: (send t label pos) --- registers a tag at the given
position in the rendered page
> make-link-style :: (send t make-link-style start-pos end-pos) ---
modifies the style of the rendered page from start-pos to end-pos to
look like a hyperlink
> add-scheme-callback :: (send t add-scheme-callback pos endpos code-string)
--- registers a code-evaluating hyperlink for the given region
> add-thunk-callback :: (send t add-scheme-callback pos endpos thunk)
--- registers a thunk-invoking hyperlink for the given region
> post-url :: (send t post-url url post-data-bytes)
--- performs a post to the given `url' with the given post data
----------------------------------------
> (html-text-mixin text%-subclass) -> html-text<%> implementation
Extends the given text% class with implementations of the html-text<%>
methods. Hyperlinks are attched to clickbacks that use `send-url'
(from the "sendurl.ss" library of the "net" collection).
> (render-html-to-text input-port html-text<%>-obj load-img? eval-mz?)
Reads HTML from `input-port' and renders it to `html-text<%>-obj'. If
`load-img?' is false, then images are rendered as Xed-out boxes. If
`eval-mz?' is false, then MZSCHEME hyperlink expressions and comments
are not evaluated.
========================================
_external.ss_
========================================
> (send-url str [separate-window? #t])
Like 'send-url' in (lib "sendurl.ss" "net"), but under Unix,
the user is prompted for a browser to use if none is recorded
in the preferences file.
> (browser-preference? v)
Returns #t if v is a valid browser preference
> (update-browser-preference url-or-#f)
Under Unix, prompts the user for a browser preference and records
the user choice as a framework preference (even if one is already
recorded). If `url-or-#f' is not #f, it is used in the dialog to
explain which URL is to be opened; if it is #f, the 'internal will
be one of the options for the user.
> (install-help-browser-preference-panel)
Installs a framework preference panel for "Browser" options.
> (add-to-browser-prefs-panel proc)
The `proc' must be a procedure that takes a panel% argument. It
will be called when the "Browser" panel is constructed for
preferences. The supplied argument is the panel, so `proc' can add
additional option controls. If the panel is already created, `proc'
is called immediately.
> tool@
A unit that implements a DrScheme tool to add the "Browser"
preference panel.

315
collects/browser/external.ss Normal file
View File

@ -0,0 +1,315 @@
(module external mzscheme
(require (lib "string-constant.ss" "string-constants")
(lib "mred.ss" "mred")
(lib "class.ss")
(lib "file.ss")
(lib "list.ss")
(lib "match.ss")
(prefix raw: (lib "sendurl.ss" "net"))
(lib "url.ss" "net")
(prefix fw: (lib "framework.ss" "framework")))
(provide send-url
(rename raw:browser-preference? browser-preference?)
update-browser-preference
install-help-browser-preference-panel
add-to-browser-prefs-panel)
; : -> bool
(define (unix-browser?)
(and (eq? (system-type) 'unix)
(not (equal? "ppc-darwin" (system-library-subpath)))))
(fw:preferences:set-default
'external-browser
(get-preference 'external-browser (lambda () #f))
raw:browser-preference?)
(define http-proxy-preference 'plt:http-proxy)
;; proxy-pref? : any -> boolean
;; determines if the input is a valid setting for the
;; http-proxy-preference pref
(define (proxy-pref? x)
(match x
[#f #t]
[`("http" ,(? string?) ,(? number?)) #t]
[else #f]))
;; sync-current-proxy-servers : proxy-pref -> void
;; syncs current-proxy-servers parameter with the proxy-pref-val
(define (sync-current-proxy-servers pref-val)
(let* ([ops (current-proxy-servers)]
[removed (remove-all-proxies "http" ops)])
(current-proxy-servers
(if pref-val
(cons pref-val removed)
removed))))
(define (remove-all-proxies scheme proxies)
(filter (lambda (x)
(and (pair? x)
(not (equal? (car x) scheme))))
proxies))
(fw:preferences:set-default http-proxy-preference #f proxy-pref?)
(sync-current-proxy-servers (fw:preferences:get http-proxy-preference))
(fw:preferences:add-callback http-proxy-preference (lambda (p v) (sync-current-proxy-servers v)))
(define send-url
(if (unix-browser?)
(lambda (url . args)
(when (or (get-preference 'external-browser (lambda () #f))
;; either the preference doesn't exist or is #f
(update-browser-preference url))
(apply raw:send-url url args)))
raw:send-url))
; : str -> void
; to prompt the user for a browser preference and update the preference
(define (update-browser-preference url)
(or (not (unix-browser?))
(choose-browser url)))
; : (U symbol #f) -> void
; to set the default browser
(define (set-browser! browser)
(fw:preferences:set 'external-browser browser))
;; Tries to put low-level prefs three times, sleeping a bit in
;; between, then gives up.
(define (try-put-preferences names vals)
(let loop ([tries 0])
(unless (= tries 3)
(put-preferences names vals
(lambda (lock-file)
(sleep 0.2)
(loop (add1 tries)))))))
(define unix-browser-names
(map (lambda (s)
(let ([l (string->list (symbol->string s))])
(list->string (cons (char-upcase (car l)) (cdr l)))))
raw:unix-browser-list))
;; : (U str #f) -> (U symbol #f)
;; to prompt the user for a browser preference
;; #f for the URL indicates a pre-emptive request by Help Desk,
;; and in that case, the user can choose to use the internal
;; broswer.
(define (choose-browser url)
(let* ([title (string-constant choose-browser)]
[d (make-object dialog% title)]
[main-pane (make-object vertical-pane% d)]
[internal-ok? (not url)]
[ok? #f]
[orig-external (fw:preferences:get 'external-browser)])
(make-object message% title main-pane)
(when url
(make-object message% (format "URL: ~a" url) main-pane))
(let-values ([(panel callbacks) (make-help-browser-preference-panel internal-ok? #f (lambda (f) (f main-pane)))])
(let*-values ([(button-pane) (instantiate horizontal-panel% (main-pane)
(alignment '(right center)))]
[(ok-button cancel-button)
(fw:gui-utils:ok/cancel-buttons
button-pane
(lambda (b e) (set! ok? #t) (send d show #f))
(lambda (b e)
(fw:preferences:set 'external-browser orig-external)
(send d show #f)))]
[(enable-button) (lambda (_n _v)
(queue-callback
(lambda ()
(send ok-button enable (fw:preferences:get 'external-browser)))))])
(send ok-button enable #f)
(set! callbacks
(cons
(fw:preferences:add-callback 'external-browser enable-button)
callbacks)))
(send d show #t)
(map (lambda (f) (f)) callbacks)
ok?)))
(define panel-installed? #f)
(define prefs-panel #f)
(define synchronized? #f)
(define additions null)
(define (install-help-browser-preference-panel)
(unless panel-installed?
(set! panel-installed? #t)
(make-help-browser-preference-panel
#t #t
(lambda (f) (fw:preferences:add-panel
(string-constant browser)
(lambda (parent)
(let-values ([(panel cbs) (f parent)])
(set! prefs-panel panel)
(map (lambda (f) (f panel)) additions)
(set! additions null)
panel)))))))
(define (add-to-browser-prefs-panel proc)
(if prefs-panel
(proc prefs-panel)
(set! additions (append additions (list proc)))))
(define (make-help-browser-preference-panel set-help? ask-later? mk)
(mk
(lambda (parent)
(define callbacks null)
(let ([pref-panel (instantiate vertical-panel% ()
(parent parent) (alignment '(left center)))])
;; -------------------- external browser for Unix --------------------
(when (unix-browser?)
(unless synchronized?
;; Keep 'external-browser in sync
(fw:preferences:add-callback 'external-browser
(lambda (name browser)
(try-put-preferences (list 'external-browser) (list browser)))))
(letrec ([v-panel (instantiate group-box-panel% ()
(parent pref-panel)
(alignment '(right center))
(stretchable-height #f)
(label (string-constant external-browser-choice-title)))]
[h-panel (instantiate horizontal-panel% ()
(parent v-panel)
(alignment '(center bottom)))]
[none-index (length raw:unix-browser-list)]
[custom-index (add1 none-index)]
[r (instantiate radio-box% ()
(label #f)
(choices (append unix-browser-names
(list (string-constant no-browser)
(string-constant browser-command-line-label))))
(parent h-panel)
(callback
(lambda (radio event)
(let ([n (send radio get-selection)])
(set-browser!
(cond
[(= n none-index) #f]
[(= n custom-index) (get-custom)]
[else (list-ref raw:unix-browser-list n)]))))))]
[select-custom
(lambda (_ __)
(send r set-selection custom-index)
(set-browser! (get-custom)))]
[get-custom
(lambda () (cons (send pre get-value) (send post get-value)))]
[template-panel (instantiate horizontal-panel% (h-panel)
(spacing 0)
(stretchable-height #f))]
[pre (instantiate text-field% ()
(label #f) (parent template-panel) (callback select-custom)
(horiz-margin 0))]
[mess (instantiate message% () (label "<URL>") (parent template-panel)
(horiz-margin 0))]
[post (instantiate text-field% ()
(label #f) (parent template-panel) (callback select-custom)
(horiz-margin 0))]
[note1 (instantiate message% ((string-constant browser-cmdline-expl-line-1)
v-panel))]
[note2 (instantiate message% ((string-constant browser-cmdline-expl-line-2)
v-panel))]
[refresh-controls (lambda (pref)
(if (pair? pref)
(begin
(send r set-selection custom-index)
(send pre set-value (car pref))
(send post set-value (cdr pref)))
(let init ([x raw:unix-browser-list] [n 0])
(cond
[(null? x) (send r set-selection n)]
[else (if (eq? pref (car x))
(send r set-selection n)
(init (cdr x) (add1 n)))]))))])
(unless ask-later?
(send r enable none-index #f))
(refresh-controls (fw:preferences:get 'external-browser))
(set! callbacks
(cons
(fw:preferences:add-callback 'external-browser
(lambda (name browser)
(refresh-controls browser)))
callbacks))
(let disable ([x raw:unix-browser-list] [n 0])
(cond
[(null? x) (void)]
[else (unless (find-executable-path (symbol->string (car x)) #f)
(send r enable n #f))
(disable (cdr x) (add1 n))]))))
;; -------------------- proxy for doc downloads --------------------
(when set-help?
(letrec ([p (instantiate group-box-panel% ()
(label (string-constant http-proxy))
(parent pref-panel)
(stretchable-height #f)
(alignment '(left top)))]
[rb (make-object radio-box%
#f (list (string-constant proxy-direct-connection)
(string-constant proxy-use-proxy))
p
(lambda (r e)
(let ([proxy? (= 1 (send r get-selection))])
(send proxy-spec enable proxy?)
(if proxy?
(update-proxy)
(fw:preferences:set http-proxy-preference #f)))))]
[proxy-spec (instantiate horizontal-panel% (p)
[stretchable-width #f]
[stretchable-height #f]
[alignment '(left center)])]
[update-proxy (lambda ()
(let ([host (send host get-value)]
[port (send port get-value)])
(let ([ok? (and (regexp-match "^[-0-9a-zA-Z.]+$" host)
(regexp-match "^[0-9]+$" port)
(string->number port)
(<= 1 (string->number port) 65535))])
(when ok?
(fw:preferences:set
http-proxy-preference
(list "http" host (string->number port))))
(send bad-host show (not ok?)))))]
[host (make-object text-field%
(string-constant proxy-host)
proxy-spec (lambda (x y) (update-proxy))
"www.someplacethatisaproxy.domain.comm")]
[port (make-object text-field%
(string-constant proxy-port)
proxy-spec (lambda (x y) (update-proxy)) "65535")]
[bad-host (make-object message%
(string-constant proxy-bad-host)
p)]
[update-gui
(lambda (proxy-val)
(send bad-host show #f)
(if proxy-val
(begin
(send rb set-selection 1)
(send proxy-spec enable #t)
(unless (string=? (cadr proxy-val) (send host get-value))
(send host set-value (cadr proxy-val)))
(unless (equal? (caddr proxy-val) (string->number (send port get-value)))
(send port set-value (number->string (caddr proxy-val)))))
(begin
(send rb set-selection 0)
(send proxy-spec enable #f)
(send host set-value "")
(send port set-value ""))))])
(fw:preferences:add-callback http-proxy-preference
(lambda (name val)
(update-gui val)))
(update-gui (fw:preferences:get http-proxy-preference))
(send bad-host show #f)))
(set! synchronized? #t)
(values pref-panel callbacks))))))

77
collects/browser/htmltext.ss Normal file
View File

@ -0,0 +1,77 @@
(module htmltext mzscheme
(require (lib "unitsig.ss")
(lib "class.ss")
"private/sig.ss"
"private/html.ss"
"private/bullet.ss"
(lib "url.ss" "net")
(lib "url-sig.ss" "net")
(lib "mred.ss" "mred")
(lib "mred-sig.ss" "mred")
(lib "external.ss" "browser"))
(define-values/invoke-unit/sig
html^
(compound-unit/sig
(import (MRED : mred^) (URL : net:url^))
(link [HTML : html^ (html@ MRED URL)])
(export (open HTML)))
#f
mred^
net:url^)
(define html-text<%>
(interface ((class->interface text%))
get-url
set-title
add-link
add-tag
make-link-style
add-scheme-callback
add-thunk-callback
post-url))
(define url-delta (make-object style-delta% 'change-underline #t))
(send url-delta set-delta-foreground "blue")
(define html-text-mixin
(mixin ((class->interface text%)) (html-text<%>)
(inherit change-style set-clickback)
(define/public (get-url) #f)
(define/public (set-title s) (void))
(define/public (add-link pos end-pos url-string)
(set-clickback pos end-pos (lambda (e start-pos eou-pos)
(send-url url-string))))
(define/public (add-tag label pos) (void))
(define/public (make-link-style pos endpos)
(change-style url-delta pos endpos))
(define/public (add-scheme-callback pos endpos scheme) (void))
(define/public (add-thunk-callback pos endpos thunk)
(set-clickback pos endpos (lambda (e start-pos eou-pos)
(thunk))))
(define/public (post-url url post-data)
(message-box "HTML"
(format "Cannot perform post: ~e"
post-data)
#f
'(stop ok)))
(super-new)))
(define (render-html-to-text port text%-obj img-ok? eval-ok?)
(unless (input-port? port)
(raise-type-error 'render-html-to-text "input port" 0 (list port text%-obj)))
(unless (text%-obj . is-a? . html-text<%>)
(raise-type-error 'render-html-to-text "html-text<%> object" 0 (list port text%-obj)))
(parameterize ([html-eval-ok eval-ok?]
[html-img-ok img-ok?])
(dynamic-wind
(lambda () (send text%-obj begin-edit-sequence #f))
(lambda () (html-convert port text%-obj))
(lambda () (send text%-obj end-edit-sequence)))))
(provide html-text<%>
html-text-mixin
render-html-to-text))

6
collects/browser/info.ss Normal file
View File

@ -0,0 +1,6 @@
(module info (lib "infotab.ss" "setup")
(define name "Browser")
(define doc.txt "doc.txt")
(define tools (list (list "tool.ss")))
(define tool-names (list "Browser")))

225
collects/browser/private/btree.ss Normal file
View File

@ -0,0 +1,225 @@
(module btree mzscheme
(require "sig.ss"
(lib "unitsig.ss"))
(provide btree@)
;; Implements a red-black tree with relative indexing along right
;; splines. This allows the usual O(log(n)) operations, plus a
;; O(log(n)) shift operation.
;; (This is the same data structure as used for lines by MrEd's text%
;; class, but that one is implemented in C++.)
(define btree@
(unit/sig relative-btree^
(import)
(rename (create-btree make-btree))
(define-struct btree (root))
(define-struct node (pos data parent left right color))
(define (adjust-offsets n new-child)
(when new-child
(set-node-pos! new-child (- (node-pos new-child)
(node-pos n)))))
(define (deadjust-offsets n old-child)
(when old-child
(set-node-pos! old-child (+ (node-pos old-child)
(node-pos n)))))
(define (rotate-left n btree)
(let ([old-right (node-right n)])
(deadjust-offsets n old-right)
(let ([r (node-left old-right)])
(set-node-right! n r)
(when r
(set-node-parent! r n)))
(let ([p (node-parent n)])
(set-node-parent! old-right p)
(cond
[(not p) (set-btree-root! btree old-right)]
[(eq? n (node-left p)) (set-node-left! p old-right)]
[else (set-node-right! p old-right)]))
(set-node-left! old-right n)
(set-node-parent! n old-right)))
(define (rotate-right n btree)
(let ([old-left (node-left n)])
(adjust-offsets old-left n)
(let ([l (node-right old-left)])
(set-node-left! n l)
(when l
(set-node-parent! l n)))
(let ([p (node-parent n)])
(set-node-parent! old-left p)
(cond
[(not p) (set-btree-root! btree old-left)]
[(eq? n (node-left p)) (set-node-left! p old-left)]
[else (set-node-right! p old-left)]))
(set-node-right! old-left n)
(set-node-parent! n old-left)))
(define (insert before? n btree pos data)
(let ([new (make-node pos data #f #f #f 'black)])
(if (not (btree-root btree))
(set-btree-root! btree new)
(begin
(set-node-color! new 'red)
; Insert into tree
(if before?
(if (not (node-left n))
(begin
(set-node-left! n new)
(set-node-parent! new n))
(let loop ([node (node-left n)])
(if (node-right node)
(loop (node-right node))
(begin
(set-node-right! node new)
(set-node-parent! new node)))))
(if (not (node-right n))
(begin
(set-node-right! n new)
(set-node-parent! new n))
(let loop ([node (node-right n)])
(if (node-left node)
(loop (node-left node))
(begin
(set-node-left! node new)
(set-node-parent! new node))))))
; Make value in new node relative to right-hand parents
(let loop ([node new])
(let ([p (node-parent node)])
(when p
(when (eq? node (node-right p))
(adjust-offsets p new))
(loop p))))
; Balance tree
(let loop ([node new])
(let ([p (node-parent node)])
(when (and (not (eq? node (btree-root btree)))
(eq? 'red (node-color p)))
(let* ([recolor-k
(lambda (y)
(set-node-color! p 'black)
(set-node-color! y 'black)
(let ([pp (node-parent p)])
(set-node-color! pp 'red)
(loop pp)))]
[rotate-k
(lambda (rotate node)
(let ([p (node-parent node)])
(set-node-color! p 'black)
(let ([pp (node-parent p)])
(set-node-color! pp 'red)
(rotate pp btree)
(loop pp))))]
[k
(lambda (node-y long-rotate always-rotate)
(let ([y (node-y (node-parent p))])
(if (and y (eq? 'red (node-color y)))
(recolor-k y)
(let ([k (lambda (node)
(rotate-k always-rotate node))])
(if (eq? node (node-y p))
(begin
(long-rotate p btree)
(k p))
(k node))))))])
(if (eq? p (node-left (node-parent p)))
(k node-right rotate-left rotate-right)
(k node-left rotate-right rotate-left))))))
(set-node-color! (btree-root btree) 'black)))))
(define (find-following-node btree pos)
(let ([root (btree-root btree)])
(let loop ([n root]
[so-far root]
[so-far-pos (and root (node-pos root))]
[v 0])
(if (not n)
(values so-far so-far-pos)
(let ([npos (+ (node-pos n) v)])
(cond
[(<= pos npos)
(loop (node-left n) n npos v)]
[(or (not so-far-pos)
(> npos so-far-pos))
(loop (node-right n) n npos npos)]
[else
(loop (node-right n) so-far so-far-pos npos)]))))))
(define (create-btree)
(make-btree #f))
(define (btree-get btree pos)
(let-values ([(n npos) (find-following-node btree pos)])
(and n
(= npos pos)
(node-data n))))
(define (btree-put! btree pos data)
(let-values ([(n npos) (find-following-node btree pos)])
(if (and n (= npos pos))
(set-node-data! n data)
(insert (and n (< pos npos))
n btree pos data))))
(define (btree-shift! btree start delta)
(let loop ([n (btree-root btree)]
[v 0])
(when n
(let ([npos (node-pos n)])
(cond
[(< start (+ v npos))
(set-node-pos! n (+ npos delta))
(loop (node-left n) v)]
[else
(loop (node-right n) (+ v npos))])))))
(define (btree-for-each btree f)
(when (btree-root btree)
(let loop ([n (btree-root btree)]
[v 0])
(when (node-left n)
(loop (node-left n) v))
(f (+ v (node-pos n)) (node-data n))
(when (node-right n)
(loop (node-right n)
(+ v (node-pos n)))))))
(define (btree-map btree f)
(let ([start (cons #f null)])
(let loop ([n (btree-root btree)]
[l start]
[v 0])
(if (not n)
l
(let ([pre (loop (node-left n) l v)]
[here (cons (f (+ v (node-pos n))
(node-data n))
null)])
(set-cdr! pre here)
(loop (node-right n)
here
(+ v (node-pos n))))))
(cdr start))))))

96
collects/browser/private/bullet.ss Normal file
View File

@ -0,0 +1,96 @@
(module bullet mzscheme
(require (lib "unitsig.ss")
(lib "mred.ss" "mred")
"sig.ss"
(lib "class.ss"))
(provide bullet-snip%
get-bullet-width
bullet-size
bullet-snip-class)
(define snip-class-name "(lib \"bullet-snip.ss\" \"browser\")")
(define bullet-size
(make-parameter
(let ([s (send (send (send (make-object text%) get-style-list) basic-style)
get-size)])
(max 7 (quotient s 2)))))
(define (get-bullet-width)
(* 2 (bullet-size)))
(define transparent-brush (send the-brush-list find-or-create-brush "WHITE" 'transparent))
(define bullet-snip%
(class snip%
(init-field depth)
(inherit set-snipclass set-count get-style)
(define bsize (bullet-size))
(define/private (zero b) (when b (set-box! b 0)))
[define/private get-height
(lambda (dc)
(let ([s (get-style)])
(max bsize (- (send s get-text-height dc)
(send s get-text-descent dc)))))]
[define/override get-extent
(lambda (dc x y wbox hbox descentbox spacebox
lspacebox rspacebox)
(when hbox
(set-box! hbox (get-height dc)))
(when wbox
(set-box! wbox (* 2 bsize)))
(zero descentbox)
(zero spacebox)
(zero rspacebox)
(zero lspacebox))]
[define/override draw
(lambda (dc x y . other)
(let ([y (+ y (ceiling (/ (- (get-height dc) bsize) 2)))])
(let-values ([(draw solid?)
(case depth
[(0) (values (lambda (x y w h) (send dc draw-ellipse x y w h)) #t)]
[(1) (values (lambda (x y w h) (send dc draw-ellipse x y w h)) #f)]
[else (values (lambda (x y w h) (send dc draw-rectangle x y w h)) #f)])])
(let ([b (send dc get-brush)])
(send dc set-brush
(if solid?
(send the-brush-list
find-or-create-brush
(send (send dc get-pen) get-color)
'solid)
transparent-brush))
(draw x y bsize bsize)
(send dc set-brush b)))))]
[define/override copy
(lambda ()
(make-object bullet-snip% depth))]
[define/override write
(lambda (stream)
(send stream put depth))]
[define/override get-text
(lambda (offset num flattened?)
(if (< num 1)
""
(if flattened?
"* "
"*")))]
(super-new)
(set-snipclass bullet-snip-class)
(set-count 1)))
(define bullet-snip-class
(make-object
(class snip-class%
(inherit set-classname)
[define/override read
(lambda (stream)
(let ([d-box (box 0)])
(send stream get d-box)
(make-object bullet-snip% (unbox d-box))))]
(super-new)
(set-classname snip-class-name))))
(send (get-the-snip-class-list) add bullet-snip-class))

261
collects/browser/private/entity-names.ss Normal file
View File

@ -0,0 +1,261 @@
(module entity-names mzscheme
(provide entity-name->integer)
(define table
#cs#hasheq((nbsp . 160)
(iexcl . 161)
(cent . 162)
(pound . 163)
(curren . 164)
(yen . 165)
(brvbar . 166)
(sect . 167)
(uml . 168)
(copy . 169)
(ordf . 170)
(laquo . 171)
(not . 172)
(shy . 173)
(reg . 174)
(macr . 175)
(deg . 176)
(plusmn . 177)
(sup2 . 178)
(sup3 . 179)
(acute . 180)
(micro . 181)
(para . 182)
(middot . 183)
(cedil . 184)
(sup1 . 185)
(ordm . 186)
(raquo . 187)
(frac14 . 188)
(frac12 . 189)
(frac34 . 190)
(iquest . 191)
(Agrave . 192)
(Aacute . 193)
(Acirc . 194)
(Atilde . 195)
(Auml . 196)
(Aring . 197)
(AElig . 198)
(Ccedil . 199)
(Egrave . 200)
(Eacute . 201)
(Ecirc . 202)
(Euml . 203)
(Igrave . 204)
(Iacute . 205)
(Icirc . 206)
(Iuml . 207)
(ETH . 208)
(Ntilde . 209)
(Ograve . 210)
(Oacute . 211)
(Ocirc . 212)
(Otilde . 213)
(Ouml . 214)
(times . 215)
(Oslash . 216)
(Ugrave . 217)
(Uacute . 218)
(Ucirc . 219)
(Uuml . 220)
(Yacute . 221)
(THORN . 222)
(szlig . 223)
(agrave . 224)
(aacute . 225)
(acirc . 226)
(atilde . 227)
(auml . 228)
(aring . 229)
(aelig . 230)
(ccedil . 231)
(egrave . 232)
(eacute . 233)
(ecirc . 234)
(euml . 235)
(igrave . 236)
(iacute . 237)
(icirc . 238)
(iuml . 239)
(eth . 240)
(ntilde . 241)
(ograve . 242)
(oacute . 243)
(ocirc . 244)
(otilde . 245)
(ouml . 246)
(divide . 247)
(oslash . 248)
(ugrave . 249)
(uacute . 250)
(ucirc . 251)
(uuml . 252)
(yacute . 253)
(thorn . 254)
(yuml . 255)
(fnof . 402)
(Alpha . 913)
(Beta . 914)
(Gamma . 915)
(Delta . 916)
(Epsilon . 917)
(Zeta . 918)
(Eta . 919)
(Theta . 920)
(Iota . 921)
(Kappa . 922)
(Lambda . 923)
(Mu . 924)
(Nu . 925)
(Xi . 926)
(Omicron . 927)
(Pi . 928)
(Rho . 929)
(Sigma . 931)
(Tau . 932)
(Upsilon . 933)
(Phi . 934)
(Chi . 935)
(Psi . 936)
(Omega . 937)
(alpha . 945)
(beta . 946)
(gamma . 947)
(delta . 948)
(epsilon . 949)
(zeta . 950)
(eta . 951)
(theta . 952)
(iota . 953)
(kappa . 954)
(lambda . 955)
(mu . 956)
(nu . 957)
(xi . 958)
(omicron . 959)
(pi . 960)
(rho . 961)
(sigmaf . 962)
(sigma . 963)
(tau . 964)
(upsilon . 965)
(phi . 966)
(chi . 967)
(psi . 968)
(omega . 969)
(thetasym . 977)
(upsih . 978)
(piv . 982)
(bull . 8226)
(hellip . 8230)
(prime . 8242)
(Prime . 8243)
(oline . 8254)
(frasl . 8260)
(weierp . 8472)
(image . 8465)
(real . 8476)
(trade . 8482)
(alefsym . 8501)
(larr . 8592)
(uarr . 8593)
(rarr . 8594)
(darr . 8595)
(harr . 8596)
(crarr . 8629)
(lArr . 8656)
(uArr . 8657)
(rArr . 8658)
(dArr . 8659)
(hArr . 8660)
(forall . 8704)
(part . 8706)
(exist . 8707)
(empty . 8709)
(nabla . 8711)
(isin . 8712)
(notin . 8713)
(ni . 8715)
(prod . 8719)
(sum . 8721)
(minus . 8722)
(lowast . 8727)
(radic . 8730)
(prop . 8733)
(infin . 8734)
(ang . 8736)
(and . 8743)
(or . 8744)
(cap . 8745)
(cup . 8746)
(int . 8747)
(there4 . 8756)
(sim . 8764)
(cong . 8773)
(asymp . 8776)
(ne . 8800)
(equiv . 8801)
(le . 8804)
(ge . 8805)
(sub . 8834)
(sup . 8835)
(nsub . 8836)
(sube . 8838)
(supe . 8839)
(oplus . 8853)
(otimes . 8855)
(perp . 8869)
(sdot . 8901)
(lceil . 8968)
(rceil . 8969)
(lfloor . 8970)
(rfloor . 8971)
(lang . 9001)
(rang . 9002)
(loz . 9674)
(spades . 9824)
(clubs . 9827)
(hearts . 9829)
(diams . 9830)
(quot . 34)
(amp . 38)
(lt . 60)
(gt . 62)
(OElig . 338)
(oelig . 339)
(Scaron . 352)
(scaron . 353)
(Yuml . 376)
(circ . 710)
(tilde . 732)
(ensp . 8194)
(emsp . 8195)
(thinsp . 8201)
(zwnj . 8204)
(zwj . 8205)
(lrm . 8206)
(rlm . 8207)
(ndash . 8211)
(mdash . 8212)
(lsquo . 8216)
(rsquo . 8217)
(sbquo . 8218)
(ldquo . 8220)
(rdquo . 8221)
(bdquo . 8222)
(dagger . 8224)
(Dagger . 8225)
(permil . 8240)
(lsaquo . 8249)
(rsaquo . 8250)
(euro . 8364)))
(define (entity-name->integer s)
(hash-table-get table s (lambda () #f))))

1259
collects/browser/private/html.ss Normal file
View File

File diff suppressed because it is too large Load Diff

1083
collects/browser/private/hyper.ss Normal file
View File

File diff suppressed because it is too large Load Diff

2
collects/browser/private/info.ss Normal file
View File

@ -0,0 +1,2 @@
(module info (lib "infotab.ss" "setup")
(define name "Browser private"))

201
collects/browser/private/option-snip.ss Normal file
View File

@ -0,0 +1,201 @@
(module option-snip mzscheme
(require (lib "mred.ss" "mred")
(lib "class.ss")
(lib "string.ss"))
(provide option-snip%
checkbox-snip%)
(define inset 2)
(define arrow-sep 5)
(define arrow-height 5)
(define arrow (list (make-object point% 0 0)
(make-object point% arrow-height arrow-height)
(make-object point% (* 2 arrow-height) 0)))
(define arrow-cursor (make-object cursor% 'arrow))
(define option-snip%
(class snip%
(inherit get-admin set-snipclass set-count get-style get-flags set-flags)
(init-field [options null])
(define w #f)
(define h #f)
(define d #f)
(define current-option #f)
(define look-for-option #f) ; a box when we're looking (in case we're looking for #f)
(define/public (add-option o v)
(set! options (append options (list (cons o v))))
(when (and look-for-option
(equal? v (unbox look-for-option)))
(set! current-option (cons o v)))
(set! w #f)
(set! h #f)
(let ([a (get-admin)])
(when a
(send a resized this #t))))
(define/public (get-value)
(with-handlers ([exn:fail? (lambda (x) #f)])
(cdr (or current-option
(car options)))))
(define/public (set-value v)
(let ([o (ormap (lambda (o) (and (equal? v (cdr o)) o)) options)])
(if o
(set! current-option o)
(set! look-for-option (box v)))))
(override*
[get-extent ; called by an editor to get the snip's size
(lambda (dc x y wbox hbox descentbox spacebox lspacebox rspacebox)
(unless w
(let ([font (send (get-style) get-font)])
(let ([w+h+ds
(map (lambda (o)
(let-values ([(tw th td ta) (send dc get-text-extent (car o) font)])
(list tw th td)))
options)])
(if (null? w+h+ds)
(begin
(set! w 10)
(set! h 10)
(set! d 2))
(begin
(set! w (+ (* 2 inset) arrow-sep 2 (* 2 arrow-height) (apply max (map car w+h+ds))))
(set! h (+ (* 2 inset) 1 (apply max arrow-height (map cadr w+h+ds))))
(set! d (+ inset 1 (apply max (map caddr w+h+ds)))))))))
(when hbox
(set-box! hbox h))
(when wbox
(set-box! wbox w))
(when descentbox
(set-box! descentbox d))
(when spacebox
(set-box! spacebox 0))
(when rspacebox
(set-box! rspacebox 0))
(when lspacebox
(set-box! lspacebox 0)))]
[draw ; called by an editor to draw the snip
(lambda (dc x y . other)
(unless w
(get-extent dc x y #f #f #f #f #f #f))
(send dc draw-rectangle x y (sub1 w) (sub1 h))
(send dc draw-line (+ x 1) (+ y h -1) (+ x w -1) (+ y h -1))
(send dc draw-line (+ x w -1) (+ y 1) (+ x w -1) (+ y h -1))
(let ([pen (send dc get-pen)]
[brush (send dc get-brush)])
(send dc set-brush (send the-brush-list find-or-create-brush (send pen get-color) 'solid))
(send dc draw-polygon arrow
(+ x (- w 2 inset (* 2 arrow-height)))
(+ y (/ (- h arrow-height) 2)))
(send dc set-brush brush))
(unless (null? options)
(send dc draw-text (car (or current-option (car options))) (+ x inset) (+ y inset))))]
[copy
(lambda ()
(make-object option-snip% options))]
[size-cache-invalid
(lambda () (set! w #f) (set! h #f))]
[on-event (lambda (dc x y editorx editory event)
(when (send event button-down?)
(let ([popup (make-object popup-menu%)])
(for-each (lambda (o)
(make-object menu-item% (car o) popup
(lambda (i e)
(set! current-option o)
(let ([a (get-admin)])
(when a
(send a needs-update this 0 0 w h))))))
options)
(let ([a (get-admin)])
(when a
(send a popup-menu popup this 0 0))))))]
[adjust-cursor (lambda (dc x y editorx editory event)
arrow-cursor)])
(super-instantiate ())
(set-flags (cons 'handles-events (get-flags)))
(set-count 1)))
(define cb-width 12)
(define cb-height 12)
(define checkbox-snip%
(class snip%
(inherit get-admin set-snipclass set-count get-style get-flags set-flags)
(init-field [checked? #f])
(define tracking? #f)
(define hit? #f)
(define w cb-width)
(define h cb-height)
(define/public (get-value) checked?)
(override*
[get-extent ; called by an editor to get the snip's size
(lambda (dc x y wbox hbox descentbox spacebox lspacebox rspacebox)
(when hbox
(set-box! hbox h))
(when wbox
(set-box! wbox w))
(when descentbox
(set-box! descentbox 0))
(when spacebox
(set-box! spacebox 0))
(when rspacebox
(set-box! rspacebox 0))
(when lspacebox
(set-box! lspacebox 0)))]
[draw ; called by an editor to draw the snip
(lambda (dc x y . other)
(send dc draw-rectangle x y w h)
(when tracking?
(send dc draw-rectangle (+ x 1) (+ y 1) (- w 2) (- h 2)))
(when (or (and (not hit?) checked?)
(and hit? (not checked?)))
(send dc draw-line x y (+ x w -1) (+ y h -1))
(send dc draw-line x (+ y h -1) (+ x w -1) y)))]
[copy
(lambda ()
(make-object checkbox-snip% checked?))]
[on-event (lambda (dc x y editorx editory event)
(when (send event button-down?)
(set! tracking? #t)
(refresh)
(set! hit? #f))
(if (or (send event button-down?)
(and tracking? (send event dragging?))
(and tracking? (send event button-up?)))
(if (and (<= 0 (- (send event get-x) x))
(<= 0 (- (send event get-y) y)))
(when (not hit?)
(set! hit? #t)
(refresh))
(when hit?
(set! hit? #f)
(refresh)))
(when tracking?
(set! tracking? #f)
(set! hit? #f)
(refresh)))
(when (and tracking?
(and tracking? (send event button-up?)))
(set! tracking? #f)
(when hit?
(set! hit? #f)
(set! checked? (not checked?)))
(refresh)))]
[adjust-cursor (lambda (dc x y editorx editory event)
arrow-cursor)])
(define/private (refresh)
(let ([a (get-admin)])
(when a
(send a needs-update this 0 0 w h))))
(super-instantiate ())
(set-flags (cons 'handles-events (get-flags)))
(set-count 1))))

58
collects/browser/private/sig.ss Normal file
View File

@ -0,0 +1,58 @@
(module sig mzscheme
(require (lib "unitsig.ss"))
(provide relative-btree^
bullet-export^
hyper^
html-export^
html^)
(define-signature html-export^
(html-img-ok
html-eval-ok
image-map-snip%))
(define-signature html^
(html-convert
html-status-handler
(open html-export^)))
(define-signature bullet-export^
(bullet-size))
(define-signature hyper^
(open-url
(struct exn:file-saved-instead (pathname))
(struct exn:cancelled ())
hyper-text<%>
hyper-text-mixin
hyper-text%
hyper-canvas-mixin
hyper-canvas%
hyper-panel<%>
hyper-panel-mixin
hyper-panel%
hyper-frame<%>
hyper-frame-mixin
hyper-frame%
hyper-no-show-frame-mixin
hyper-no-show-frame%
editor->page
page->editor))
(define-signature relative-btree^
(make-btree
btree-get
btree-put!
btree-shift!
btree-for-each
btree-map)))

15
collects/browser/tool.ss Normal file
View File

@ -0,0 +1,15 @@
(module tool mzscheme
(require (lib "external.ss" "browser")
(lib "unitsig.ss")
(lib "tool.ss" "drscheme"))
(provide tool@)
;; to add a preference pannel to drscheme that sets the browser preference
(define tool@
(unit/sig drscheme:tool-exports^
(import drscheme:tool^)
(define phase1 void)
(define phase2 void)
(install-help-browser-preference-panel))))

324
collects/compiler/cffi.ss Normal file
View File

@ -0,0 +1,324 @@
;; Implements the c-lambda and c-declare forms for interfacing to C.
;; The macros communicate information to mzc using a 'mzc-cffi
;; property. When this property information is ignored, the result is
;; an expression that (eventually) produces an error. The mzc compiler
;; notices the information, however, and substitutes a different kind
;; of expression.
(module cffi mzscheme
(require (lib "stx.ss" "syntax"))
(require-for-syntax (lib "name.ss" "syntax")
(lib "path-spec.ss" "syntax"))
(define-syntax c-lambda
(let ([re:fname (regexp "^[a-zA-Z_0-9]+$")]
[parse-type
(lambda (t stx for-return?)
(let ([literals (syntax-e
(quote-syntax
(bool
char unsigned-char signed-char
int unsigned-int
short unsigned-short
long unsigned-long
float double
scheme-object
char-string nonnull-char-string)))])
(let ([v (and (identifier? t)
(ormap (lambda (i)
(and (module-identifier=? i t) i))
literals))])
(cond
[v (syntax-e v)]
[(and for-return?
;; FIXME: void is not lexically scoped
(eq? (syntax-e t) 'void))
'void]
[(let ([l (syntax->list t)])
(and l (= 2 (length l))
(identifier? (car l))
(string? (syntax-e (cadr l)))
(module-identifier=? (car l) (quote-syntax pointer))
l))
=> (lambda (l)
`(pointer , (syntax-e (cadr l))))]
[else
(raise-syntax-error
'c-lambda
"bad type"
stx
t)]))))]
[make-declaration (lambda (type name)
(if (pair? type)
(format " ~a* ~a;\n"
(cadr type)
name)
(format " ~a ~a;\n"
(cadr (assq type
'((bool "int")
(char "char")
(unsigned-char "unsigned char")
(signed-char "signed char")
(int "int")
(unsigned-int "unsigned int")
(short "short")
(unsigned-short "unsigned short")
(long "long")
(unsigned-long "unsigned long")
(float "float")
(double "double")
(scheme-object "Scheme_Object*")
(char-string "char*")
(nonnull-char-string "char*"))))
name)))]
[extract-c-value (lambda (type c-var scheme-var pos proc-name)
(cond
[(eq? type 'bool)
(format " ~a = SCHEME_TRUEP(~a);\n" c-var scheme-var)]
[(eq? type 'scheme-object)
(format " ~a = ~a;\n" c-var scheme-var)]
[else
(let-values ([(setup tester unwrapper type-name done)
(if (pair? type)
(values #f
(format "(SCHEME_FALSEP(~~a) ~
|| (SCHEME_CPTRP(~a) && SCHEME_BYTE_STRINGP(SCHEME_CPTR_TYPE(~a)) ~
&& !strcmp(SCHEME_BYTE_STR_VAL(SCHEME_CPTR_TYPE(~a)), ~s)))"
scheme-var scheme-var scheme-var (cadr type))
(format "(SCHEME_TRUEP(~~a) ? SCHEME_CPTR_VAL(~a) : NULL)"
scheme-var)
(format "cpointer of type ~s or #f"
(cadr type))
#f)
(case type
[(char unsigned-char signed-char)
(values #f
"SCHEME_CHARP(~a)"
"SCHEME_CHAR_VAL(~a)"
"character"
#f)]
[(int long)
(values " { long tmp;\n"
"scheme_get_int_val(~a, &tmp)"
"tmp /* ~a */"
(format "exact integer between (expt 2 -31) ~
and (sub1 (expr 2 31)) inclusive")
" }\n")]
[(unsigned-int unsigned-long)
(values " { unsigned long tmp;\n"
"scheme_get_unsigned_int_val(~a, &tmp)"
"tmp /* ~a */"
"exact integer between 0 and (sub1 (expr 2 32)) inclusive"
" }\n")]
[(short)
(values #f
"(SCHEME_INTP(~a) \
&& (long)((short)SCHEME_INT_VAL(~a)) == SCHEME_iNT_VAL(~a))"
"SCHEME_INT_VAL(~a)"
(format "exact integer between (expt 2 -15) ~
and (sub1 (expr 2 15)) inclusive")
#f)]
[(unsigned-short)
(values #f
"(SCHEME_INTP(~a) ~
&& (long)((unsigned short)SCHEME_INT_VAL(~a)) ~
== SCHEME_iNT_VAL(~a))"
"SCHEME_INT_VAL(~a)"
"exact integer between 0 and (sub1 (expr 2 16)) inclusive"
#f)]
[(float double)
(values #f
"SCHEME_REALP(~a)"
"scheme_real_to_double(~a)"
"real number"
#f)]
[(char-string)
(values #f
(format "SCHEME_FALSEP(~~a) || SCHEME_BYTE_STRINGP(~a)"
scheme-var)
(format "(SCHEME_FALSEP(~~a) ? NULL : SCHEME_BYTE_STR_VAL(~a))"
scheme-var)
"byte string or #f"
#f)]
[(nonnull-char-string)
(values #f
"SCHEME_BYTE_STRINGP(~a)"
"SCHEME_BYTE_STR_VAL(~a)"
"byte string"
#f)]
[else (error 'cffi "bad type for arg: ~a" type)]))])
(string-append
(or setup "")
(format " if (~a) {\n" (format tester scheme-var))
(format " ~a = ~a;\n" c-var (format unwrapper scheme-var))
(format " } else {\n")
(format " scheme_wrong_type(~s, ~s, ~a, argc, argv);\n return NULL;\n"
(symbol->string proc-name) type-name pos)
(format " }\n")
(or done "")))]))]
[build-scheme-value (lambda (type scheme-var c-var)
(let ([builder
(if (pair? type)
(format "(~a ? scheme_make_cptr(~~a, scheme_make_byte_string(~s)) : scheme_false)"
c-var
(cadr type))
(case type
[(bool) "(~a ? scheme_true : scheme_false)"]
[(char unsigned-char signed-char)
"scheme_make_character((unsigned char)~a)"]
[(int long)
"scheme_make_integer_value(~a)"]
[(unsigned-int unsigned-long)
"scheme_make_integer_value_from_unsigned(~a)"]
[(char-string)
(format "(~~a ? scheme_make_byte_string(~a) : scheme_false)"
c-var)]
[(float double)
"scheme_make_double(~a)"]
[(nonnull-char-string)
"scheme_make_byte_string(~a)"]
[(scheme-object) "~a"]
[else (error 'cffi "bad type for result: ~a" type)]))])
(format " ~a = ~a;\n"
scheme-var
(format builder c-var))))]
[ffi-index 0])
(lambda (stx)
(syntax-case stx ()
[(_ (arg-type ...) result-type code)
(let ([arg-types (map
(lambda (t)
(parse-type t stx #f))
(syntax->list (syntax (arg-type ...))))]
[result-type (parse-type (syntax result-type) stx #t)]
[code (syntax code)]
[proc-name (or (let ([s (syntax-local-infer-name stx)])
(if (syntax? s)
(syntax-e s)
s))
'c-lambda-procedure)])
(unless (string? (syntax-e code))
(raise-syntax-error
'c-lambda
"not a code or function-name string"
stx
code))
;; Generate the function body
(let ([fname (format "mzc_cffi_~a" ffi-index)]
[code (apply
string-append
(append
(let loop ([n 1][arg-types arg-types])
(if (null? arg-types)
null
(cons
(make-declaration (car arg-types) (format "___arg~a" n))
(loop (add1 n) (cdr arg-types)))))
(if (eq? 'void result-type)
null
(list (make-declaration result-type "___result")
" Scheme_Object *converted_result;\n"))
(let loop ([n 1][arg-types arg-types])
(if (null? arg-types)
null
(cons
(extract-c-value (car arg-types)
(format "___arg~a" n)
(format "argv[~a]" (sub1 n))
(sub1 n)
proc-name)
(loop (add1 n) (cdr arg-types)))))
(list " {\n")
(list
(if (regexp-match re:fname (syntax-e code))
;; Generate function call
(string-append
(if (eq? result-type 'void)
" "
" ___result = ")
(syntax-e code)
"("
(let loop ([n 1][arg-types arg-types])
(if (null? arg-types)
""
(string-append
(format "___arg~a~a"
n
(if (pair? (cdr arg-types))
", "
""))
(loop (add1 n) (cdr arg-types)))))
");\n")
;; Use literal code
(string-append (syntax-e code) "\n")))
(if (eq? result-type 'void)
null
(list
(build-scheme-value result-type "converted_result" "___result")))
(list
"#ifdef ___AT_END\n"
" ___AT_END\n"
"#undef ___AT_END\n"
"#endif\n")
(list " }\n")
(list
(if (eq? result-type 'void)
" return scheme_void;\n"
" return converted_result;\n"))))])
(set! ffi-index (add1 ffi-index))
(with-syntax ([fname fname]
[code code]
[arity (length arg-types)]
[proc-name proc-name]
[args (generate-temporaries arg-types)])
(let ([stx-out (syntax
(lambda args
(error 'proc-name "c-lambda expression not compiled by mzc")
'(fname
proc-name
arity
code)))])
(syntax-property stx-out 'mzc-cffi 'c-lambda)))))]))))
(define-syntax (c-declare stx)
(unless (memq (syntax-local-context) '(top-level module))
(raise-syntax-error #f "only allowed at the top-level or a module top-level" stx))
(syntax-case stx ()
[(_ str)
(let ([decl (syntax str)])
(unless (string? (syntax-e decl))
(raise-syntax-error 'c-declare "declaration is not a string" stx decl))
(let ([stx-out (syntax
(error 'c-declare
"declaration not compiled by mzc: ~e"
str))])
(syntax-property stx-out 'mzc-cffi 'c-declare)))]))
(define-syntax (c-include stx)
(unless (memq (syntax-local-context) '(top-level module))
(raise-syntax-error #f "only allowed at the top-level or a module top-level" stx))
(syntax-case stx ()
[(_ path)
(let ([pathname (resolve-path-spec #'path #'path stx #'build-path)])
(let ([str
(with-handlers ([exn:fail?
(lambda (x)
(raise-syntax-error
#f
(format "error reading file ~e: ~a"
pathname
(if (exn? x)
(exn-message x)
x))))])
(with-input-from-file pathname
(lambda () (read-string (file-size pathname)))))])
(quasisyntax/loc stx (c-declare #,str))))]))
(provide c-lambda
c-declare
c-include))

7
collects/compiler/comp-unit.ss Normal file
View File

@ -0,0 +1,7 @@
(module comp-unit mzscheme
(require "private/base.ss")
(define comp@ base@)
(provide comp@))

278
collects/compiler/compiler-unit.ss Normal file
View File

@ -0,0 +1,278 @@
;; Main compilation procedures
;; (c) 1997-2001 PLT
;; The various procedures provided by this library are implemented
;; by dynamically linking to code supplied by the MzLib, dynext, and
;; compiler collections.
;; The Scheme->C compiler is loaded as either sploadr.ss (link in
;; real MrSpidey) or loadr.ss (link in trivial MrSpidey stubs).
(module compiler-unit mzscheme
(require (lib "unitsig.ss"))
(require "sig.ss")
(require (lib "file-sig.ss" "dynext")
(lib "link-sig.ss" "dynext")
(lib "compile-sig.ss" "dynext")
(lib "make-sig.ss" "make")
(lib "collection-sig.ss" "make")
(lib "toplevel.ss" "syntax")
(lib "moddep.ss" "syntax"))
(require (lib "list.ss")
(lib "file.ss")
(lib "compile.ss") ; gets compile-file
(lib "cm.ss")
(lib "getinfo.ss" "setup"))
(provide compiler@)
(define orig-namespace (current-namespace))
;; ;;;;;;;; ----- The main compiler unit ------ ;;;;;;;;;;
(define compiler@
(unit/sig compiler^
(import compiler:option^
dynext:compile^
dynext:link^
dynext:file^)
(define compile-notify-handler
(make-parameter void))
(define current-compiler-dynamic-require-wrapper
(make-parameter (lambda (thunk)
(parameterize ([current-namespace orig-namespace])
(thunk)))))
(define (c-dynamic-require path id)
((current-compiler-dynamic-require-wrapper)
(lambda ()
(dynamic-require path id))))
(define (c-get-info cp)
((current-compiler-dynamic-require-wrapper)
(lambda ()
(get-info cp))))
(define (make-extension-compiler mode prefix)
(let ([u (c-dynamic-require `(lib "base.ss" "compiler" "private")
'base@)]
[init (unit/sig ()
(import compiler:inner^)
(eval-compile-prefix prefix)
(case mode
[(compile-extension) compile-extension]
[(compile-extension-to-c) compile-extension-to-c]
[(compile-c-extension) compile-c-extension]
[(compile-extension-part) compile-extension-part]
[(compile-extension-part-to-c) compile-extension-part-to-c]
[(compile-c-extension-part) compile-c-extension-part]))])
(invoke-unit/sig
(compound-unit/sig
(import (COMPILE : dynext:compile^)
(LINK : dynext:link^)
(DFILE : dynext:file^)
(OPTION : compiler:option^))
(link [COMPILER : compiler:inner^ (u COMPILE
LINK
DFILE
OPTION)]
[INIT : () (init COMPILER)])
(export))
dynext:compile^
dynext:link^
dynext:file^
compiler:option^)))
(define (make-compiler mode)
(lambda (prefix)
(let ([c (make-extension-compiler mode prefix)])
(lambda (source-files destination-directory)
(map
(lambda (source-file)
(c source-file (or destination-directory 'same)))
source-files)))))
(define (make-unprefixed-compiler mode)
(let ([f #f])
(lambda (source-files destination-directory)
(unless f
(set! f ((make-compiler mode) '(void))))
(f source-files destination-directory))))
(define compile-extensions
(make-compiler 'compile-extension))
(define compile-extensions-to-c
(make-compiler 'compile-extension-to-c))
(define compile-c-extensions
(make-unprefixed-compiler 'compile-c-extension))
(define compile-extension-parts
(make-compiler 'compile-extension-part))
(define compile-extension-parts-to-c
(make-compiler 'compile-extension-part-to-c))
(define compile-c-extension-parts
(make-unprefixed-compiler 'compile-c-extension-part))
(define (link/glue-extension-parts link? source-files destination-directory)
(let ([u (c-dynamic-require '(lib "ld-unit.ss" "compiler") 'ld@)]
[init (unit/sig ()
(import compiler:linker^)
(if link?
link-extension
glue-extension))])
(let ([f (invoke-unit/sig
(compound-unit/sig
(import (COMPILE : dynext:compile^)
(LINK : dynext:link^)
(DFILE : dynext:file^)
(OPTION : compiler:option^))
(link [LINKER : compiler:linker^ (u COMPILE
LINK
DFILE
OPTION)]
[INIT : () (init LINKER)])
(export))
dynext:compile^
dynext:link^
dynext:file^
compiler:option^)])
(f source-files destination-directory))))
(define (link-extension-parts source-files destination-directory)
(link/glue-extension-parts #t source-files destination-directory))
(define (glue-extension-parts source-files destination-directory)
(link/glue-extension-parts #f source-files destination-directory))
(define (compile-to-zo src dest namespace eval?)
((if eval? (lambda (t) (t)) with-module-reading-parameterization)
(lambda ()
(parameterize ([current-namespace namespace])
(compile-file src dest
(if eval?
(lambda (expr)
(expand-syntax-top-level-with-compile-time-evals expr))
values)))))
(printf " [output to \"~a\"]~n" dest))
(define (compile-zos prefix)
(let ([n (if prefix (make-namespace) (current-namespace))])
(when prefix
(eval prefix n))
(lambda (source-files destination-directory)
(let ([file-bases (map
(lambda (file)
(let ([f (extract-base-filename/ss file 'mzc)])
(if destination-directory
(let-values ([(base file dir?) (split-path f)])
(build-path (if (eq? destination-directory 'auto)
(let ([d (build-path (if (eq? base 'relative)
'same
base)
"compiled")])
(unless (directory-exists? d)
(make-directory* d))
d)
destination-directory)
file))
f)))
source-files)])
(for-each
(lambda (f b)
(let ([zo (append-zo-suffix b)])
(compile-to-zo f zo n prefix)))
source-files file-bases)))))
(define (compile-directory dir info zos?)
(let ([make (c-dynamic-require '(lib "make-unit.ss" "make") 'make@)]
[coll (c-dynamic-require '(lib "collection-unit.ss" "make") 'make:collection@)]
[init (unit/sig ()
(import make^ make:collection^)
(values make-collection make-notify-handler))])
(let-values ([(make-collection make-notify-handler)
(invoke-unit/sig
(compound-unit/sig
(import (DFILE : dynext:file^)
(OPTION : compiler:option^)
(COMPILER : compiler^))
(link [MAKE : make^ (make)]
[COLL : make:collection^ (coll MAKE
DFILE
OPTION
COMPILER)]
[INIT : () (init MAKE COLL)])
(export))
dynext:file^
compiler:option^
compiler^)])
(let ([orig (current-directory)])
(dynamic-wind
(lambda () (current-directory dir))
(lambda ()
(parameterize ([current-load-relative-directory dir])
;; Compile the collection files via make-collection
(let ([sses (filter
extract-base-filename/ss
(directory-list))])
(let ([filtered-sses
(remove*
(map string->path
(info
(if zos?
'compile-zo-omit-files
'compile-extension-omit-files)
(lambda () null)))
(remove*
(map string->path
(info 'compile-omit-files (lambda () null)))
sses))])
(if zos?
;; Verbose compilation manager:
(parameterize ([manager-trace-handler (lambda (s) (printf "~a~n" s))]
[manager-compile-notify-handler (lambda (path)
((compile-notify-handler) path))])
(map (make-caching-managed-compile-zo) filtered-sses))
;; Old collection compiler:
(parameterize ([make-notify-handler (lambda (path)
((compile-notify-handler) path))])
(make-collection
((or info (lambda (a f) (f)))
'name
(lambda () (error 'compile-collection "info did not provide a name in ~e"
dir)))
filtered-sses
(if zos? #("zo") #()))))))))
(lambda () (current-directory orig)))
(when (compile-subcollections)
(for-each
;; bug! planet files will do the wrong thing here
(lambda (s)
(unless (and (pair? s) (list? s) (andmap string? s))
(error 'compile-collection "bad sub-collection path: ~a" s))
(let ((p (apply build-path dir s)))
(compile-directory p (get-info/full p) zos?)))
(info 'compile-subcollections (lambda () null))))))))
(define (compile-collection cp zos?)
(let ([dir (apply collection-path cp)]
[info (c-get-info cp)])
(compile-directory dir info zos?)))
(define (compile-collection-extension collection . cp)
(compile-collection (cons collection cp) #f))
(define (compile-collection-zos collection . cp)
(compile-collection (cons collection cp) #t))
(define (compile-directory-extension dir info)
(compile-directory dir info #f))
(define (compile-directory-zos dir info)
(compile-directory dir info #t))
)))

28
collects/compiler/compiler.ss Normal file
View File

@ -0,0 +1,28 @@
(module compiler mzscheme
(require (lib "unitsig.ss"))
(require "sig.ss")
(require (lib "compile-sig.ss" "dynext"))
(require (lib "link-sig.ss" "dynext"))
(require (lib "file-sig.ss" "dynext"))
;;
(require (lib "compile.ss" "dynext"))
(require (lib "link.ss" "dynext"))
(require (lib "file.ss" "dynext"))
(require "option.ss")
(require "compiler-unit.ss")
(define-values/invoke-unit/sig compiler^
compiler@
#f
compiler:option^
dynext:compile^
dynext:link^
dynext:file^)
(provide-signature-elements compiler^))

534
collects/compiler/doc.txt Normal file
View File

@ -0,0 +1,534 @@
The Compiler
============
To use the compiler within a Scheme program, require _compiler.ss_:
(require (lib "compiler.ss" "compiler"))
The _compiler.ss_ library defines the following functions (plus a few
signatures). Options that control the compiler are documented in the
next section.
Single-file extension compilation
---------------------------------
> ((compile-extensions expr) scheme-file-list dest-dir)
`(compile-extensions expr)' returns a compiler that is
initialized with the elaboration-time expression `expr', as
described below.
The compiler takes a list of Scheme files and compiles each of
them to an extension, placing the resulting extensions in the
directory specified by `dest-dir'. If `dest-dir' is #f, each
extension is placed in the same directory as its source file.
If `dest-dir' is 'auto, each extension file is placed in a
"compiled/native/<PLATFORM>" subdirectory relative to the source
file, where <PLATFORM> is the result of
`system-library-subpath'. (The directory is created if
necessary.)
`expr' effect:
If `expr' is anything other than #f, then a namespace is
created for compiling the files that are supplied later; `expr'
is evaluated to initialize the created namespace. For example,
`expr' might load a set of macros. In addition, the
expansion-time part of each expression later compiled is
evaluated in the namespace before being compiled, so that the
effects are visible when compiling later expressions.
If `expr' is #f, then no compilation namespace is created, and
expressions in the files are assumed to compile independently
(so there's no need to evaluate the expansion-time part of an
expression to compile).
Typically, `expr' is #f for compiling `module' files and
`(void)' for compiling files with top-level definitions and
expressions.
> ((compile-extensions-to-c expr) scheme-file-list dest-dir)
Like `compile-extensions', but only .c files are produced, not
extensions.
> (compile-c-extensions c-file-list dest-dir)
Compiles each .c file (usually produced with `compile-extensions-to-c')
in c-file-list to an extension. `dest-dir' is handled as in
`compile-extensions'.
Multi-file extension compilation
---------------------------------
> ((compile-extension-parts expr) scheme-file-list dest-dir)
`(compile-extension-parts expr)' returns a compiler that is
initialized with the elaboration-time expression `expr'.
See `compile-extension' above for information about the effect
of `expr'.
The compiler takes a list of Scheme files and compiles each of
them to a linkable object and a .kp (constant pool) file,
placing the resulting objects and .kp files in the directory
specified by `dest-dir'. If `dest-dir' is #f, each object and
.kp file is placed in the same directory as its source file. If
`dest-dir' is 'auto, each .kp file is placed in a
"compiled/native" subdirectory relative to the source file, and
each object file is placed in "compiled/native/<PLATFORM>",
where <PLATFORM> is the result of `system-library-subpath'. (The
directory is created if necessary.)
> ((compile-extension-parts-to-c expr) scheme-file-list dest-dir)
Like `compile-extension-parts', but only .c and .kp files are
produced, not compiled objects. If `dest-dir' is 'auto, each
output file is placed in a "compiled/native" subdirectory
relative to the source file.
> (compile-c-extension-parts c-file-list dest-dir)
Compiles each .c file (produced with `compile-extension-parts-to-c')
in c-file-list to an extension.
> (link-extension-parts obj-and-kp-file-list dest-dir)
Links objects for a multi-object extension together, using .kp
files to generate and link pooled constants. The objects and
.kp files in `obj-and-kp-file' can be in any order. The resulting
extension "_loader" is placed in the directory specified by `dest-dir'.
> (glue-extension-parts obj-and-kp-file-list dest-dir)
Like `link-extension-parts', but only a "_loader" object file
is generated; this object file is linked with all the other
object files to produce the "_loader" extension.
zo compilation
--------------
> ((compile-zos expr) scheme-file-list dest-dir)
`(compile-zos expr)' returns a compiler that is initialized with
the elaboration-time expression `expr'.
See `compile-extensions' above for information about the effect
of `expr'.
The returned compiler takes a list of Scheme files and compiles
each of them to a .zo file, placing the resulting .zo files in
the directory specified by `dest-dir'. If `dest-dir' is #f,
each .zo file is placed in the same directory as its source
file. If `dest-dir' is 'auto, each .zo file is placed in a
"compiled" subdirectory relative to the source file. (The
directory is created if necessary.)
Collection compilation
----------------------
> (compile-collection-extension collection sub-collection ...)
Compiles the specified (sub-)collection to an extension
"_loader", putting intermediate .c and .kp files in the
collection's "compiled/native" directory, and object files and
the resulting "_loader" extension in the collection's
"compiled/native/PLATFORM" directory (where `PLATFORM' is the
system name for the current platform).
The collection compiler reads the collection's _info.ss_ file
(see the mzc manual for information about info.ss) to obtain
information about compiling the collection. The following
fields are used:
> name - the name of the collection as a string.
> compile-omit-files - a list of filenames (without paths); all
Scheme files in the collection are compiled except for the
files in this list. If a file contains elaboration time
expressions (e.g., macros, signatures) that are not intended
to be local to the file, then the file should be included in
this list.
> compile-extension-omit-files - a list of filenames to extend
the list returned for `compile-omit-files'. Unlike the list
returned for `compile-omit-files', this extension is not used
when compiling .zo files.
> compile-subcollections - a list of collection paths, where each
path is a list of strings. `compile-collection-extension' is
applied to each of the collections.
Only the `name' field is required from info.ss.(Note: Setup PLT
uses this field as an indication that the collection should be
compiled.)
The compilation process is driven by the 'make-collection'
function in the "collection.ss" library of the "make"
collection.
> (compile-directory-extension path info-function)
Like `compile-collection-extension', but compiles the given
directory rather than a collection. Also takes an info
function (the result of `get-info' or `get-info/full'; see
the setup collection's documentation for more information)
that will be used to guide compilation instead of looking for
an info.ss file in the directory.
> (compile-collection-zos collection sub-collection ...)
Compiles the specified (sub-)collection files to .zo files.
The .zo files are placed into the collection's "compiled"
directory.
The _info.ss_ file is used as in `compile-collection-extension',
except for `compile-extension-omit-files'. In addition, the
following two fields are used:
> compile-zo-omit-files - a list of filenames to extend the
list returned for 'compile-omit-files.
The compilation process is driven by the `managed-compile-zo'
function in the "cm.ss" library of the "mzlib" collection.
> (compile-directory-zos path info-function)
Like `compile-collection-zos', but compiles the given directory
rather than a collection. Also takes an info function (the
result of `get-info' or `get-info/full'; see the setup
collection's documentation for more information) that will be
used to guide compilation instead of looking for an info.ss file
in the directory.
Loading compiler support
------------------------
The compiler unit loads certain tools on demand via `dynamic-require'
and `get-info'. If the namespace used during compilation is different
from the namespace used to load the compiler, or if other load-related
parameters are set, then the following parameter can be used to
restore settings for `dyanmic-require'.
> current-compiler-dynamic-require-wrapper
A parameter whose value is a procedure that takes a thunk to
apply. The default wrapper sets the current namespace (via
`parameterize') before calling the thunk; it sets it to the
namespace that was current at the time that the "compiler-unit.ss"
module was evaluated.
---------------------------------------------------------------------------
Options for the Compiler
========================
To set options for the _compile.ss_ extension compiler, use the
_option.ss_ module. Options are set by the following parameters:
> verbose - #t causes the compiler to print
verbose messages about its operations. Default = #f.
> setup-prefix - a string to embed in public names.
This is used mainly for compiling extensions with the collection
name so that cross-extension conflicts are less likely in
architectures that expose the public names of loaded extensions.
Note that `compile-collection' handles prefixing automatically
(by setting this option). Default = "".
> clean-intermediate-files - #t keeps intermediate
.c/.o files. Default = #f.
> compile-subcollections - #t uses info.ss's
'compile-subcollections' for compiling collections. Default = #t.
> compile-for-embedded - #t creates .c files and
object files to be linked directly with an embedded MzScheme
run-time system, instead of .c files and object files to
be dynamically loaded into MzScheme as an extension.
Default = #f.
> propagate-constants - #t improves the code by
propogating constants. Default = #t.
> assume-primitives - #t equates X with #%X when
#%X exists. This is useful only with non-unitized code.
Default = #f.
> stupid - Allow obvious non-syntactic errors; e.g.:
((lambda () 0) 1 2 3). Default = #f.
> vehicles - Controls how closures are compiled. The
possible values are: 'vehicles:automatic - auto-groups
'vehicles:functions - groups by procedue
'vechicles:units - groups by unit
'vehicles:monolithic - groups randomly
Default = 'vehicles:automatic.
> vehicles:monoliths - Sets the number of random
groups for 'vehicles:monolithic.
> seed - Sets the randomizer seed for
'vehicles:monolithic.
> max-exprs-per-top-level-set - Sets the number of
top-level Scheme expressions crammed into one C function. Default
= 25.
> unpack-environments - #f might help for
register-poor architectures. Default = #t.
> debug - #t creates debug.txt debugging file. Default
= #f.
> test - #t ignores top-level expressions with syntax
errors. Default = #f.
More options are defined by the compile.ss and link.ss libraries in
the `dynext' collection . Those options control the actual C compiler
and linker that are used. See doc.txt in the `dynext' collection for
more information about those options.
The _option-unit.ss_ library is a unit/sig matching the signature
> compiler:option^
which contains these options. The _sig.ss_ library defines the
`compiler:option^' signature.
---------------------------------------------------------------------------
The Compiler as a Unit
======================
The _compiler-unit.ss_ library provides a unit/sig
> compiler@
matching the signature
> compiler^
which provides the compiler.ss functions. This signature and all
auxilliary signatures needed by compiler@ are defined by the
_sig.ss_ library.
The signed unit requires the following imports:
compiler:option^ - From sig.ss, impl by _option-unit.ss_ or _option.ss_
dynext:compile^ - From the `dynext' collection
dynext:link^
dynext:file^
---------------------------------------------------------------------------
Low-level Extension Compiler and Linker
=======================================
The high-level compiler.ss interface relies on low-level
implementations of the extension compiler and linker.
The _comp-unit.ss_ and _ld-unit.ss_ libraries define unit/sigs for the
low-level extension compiler and multi-file linker,
> ld@
and
> comp@
respectively.
The low-level compiler functions from comp@ are:
> (eval-compile-prefix expr) - Evaluates an elaboration-time
S-expression `expr'. Future calls to mzc:compile-XXX will see the
effects of the elaboration expression.
> (compile-extension scheme-source dest-dir) - Compiles a
single Scheme file to an extension.
> (compile-extension-to-c scheme-source dest-dir) - Compiles
a single Scheme file to a .c file.
> (compile-c-extension c-source dest-dir) - Compiles a single .c
file to an extension.
> (compile-extension-part scheme-source dest-dir) - Compiles a
single Scheme file to a compiled object and .kp file toward a
multi-file extension.
> (compile-extension-part-to-c scheme-source dest-dir) - Compiles
a single Scheme file to .c and .kp files towards a multi-file
extension.
> (compile-c-extension-part c-source dest-dir) - Compiles a single
.c file to a compiled object towards a multi-file extension.
The low-level linker functions from ld@ are:
> (link-extension object-and-kp-file-list dest-dir) - Links
compiled object and .kp files into a multi-file extension.
Both unit/sigs requires the following imports:
dynext:compile^ - From the `dynext' collection
dynext:link^
dynext:file^
compiler:option^ - From sig.ss, impl by _option-unit.ss_ or _option.ss_
---------------------------------------------------------------------------
Embedding Scheme Code to Create a Stand-alone Executable
========================================================
The _embed.ss_ library provides a function to embed Scheme code into a
copy of MzScheme or MrEd, thus creating a _stand-alone_ Scheme
executable.
Embedding walks the module dependency graph to find all modules needed
by some initial set of top-level modules, compiling them if needed,
and combining them into a "module bundle". In addition to the module
code, the bundle extends the module name resolver, so that modules can
be `require'd with their original names, and they will be retrieved
from the bundle instead of the filesystem.
The `make-embedding-executable' function combines the bundle with an
executable (MzScheme or MrEd). The `write-module-bundle' function
prints the bundle to the current output port, instead; this stream can
be `load'ed directly by a running program, as long as the
`read-accept-compiled' parameter is true.
The _embedr-unit.ss_ library provides a signed unit, _compiler:embed@_
that imports nothing and exports the functions below. The
_embedr-sig.ss_ library provides the signature, _compiler:embed^_.
> (make-embedding-executable dest mred? verbose? mod-list literal-file-list literal-sexpr cmdline-list [aux launcher? variant])
- Copies the MzScheme (if `mred?' is #f) or MrEd (otherwise) binary,
embedding code into the copied executable to be loaded on startup.
The source executable is located relative to the "mzlib" collection.
See the mzc documentation for a simpler interface that is
well-suited to programs defined with `module'.
The embeddeding executable is written to `dest', which is
overwritten if it exists already (as a file or directory).
The embedded code consists of module declaratons followed by
additional (arbitrary) code. When a module is embedded, every module
that it imports is also embedded. Library modules are embedded so
that they are accessible via their `lib' paths in the initial
namespace' except as specified in `mod-list', other modules
(accessed via local paths and absolte paths) are embedded with a
generated prefix, so that they are not directly accessible.
The `mod-list' argument designates modules to be embedded, as
described below. The `literal-file-list' and `literal-sexp'
arguments specifiy literal code to be copied into the executable:
the content of each file in `literal-file-list' is copied in order
(with no intervening space), followed by `literal-sexp'. The
`literal-file-list' files or `literal-sexp' can contain compiled
bytecode, and it's possible that the content of the
`literal-file-list' files only parse when concatenated; the files
and expression are not compiled or inspected in any way during the
embedding process. If `literal-sexp' is #f, no literal expression is
included in the executable.
The `cmdline-list' argument contains command-line strings that are
prefixed onto any actual command-line arguments that are provided to
the embedding executable. A command-line argument that evaluates an
expression or loads a file will be executed after the embedded code
is loaded.
Each element of the `mod-list' argument is a 2-item list, where the
first item is a prefix for the module name, and the second item is a
module path datum (that's in the format understood by the default
module name resolver). The prefix can be a symbol, #f to indicate no
prefix, or #t to indicate an auto-generated prefix. For example,
'((#f "m.ss"))
embeds the module `m' from the file "m.ss", without prefixing the
name of the module; the `literal-sexpr' argument to go with the
above might be '(require m).
All modules are compiled before they are embedded into the target
executable.
When embedding into a copy of MrEd, a "-Z" flag should usually be
included in the list of command-line flags, so that the target
executable has a chance to see an embedded declaration of (lib
"mred.ss" "mred"). Then, if the literal code expect to have MrEd and
the class library required into the top-level namespace, literal
`require's for thoselibraries should be included at the start.
The optional `aux' argument is an association list for
platform-specific options (i.e., it is a list of pairs where the
first element of the pair is a key symbol and the second element is
the value for that key). The currently supported keys are as
follows:
_'icns_ (Mac OS X) - an icon file path (suffix ".icns") to
use for the executable's desktop icon
_'ico_ (Windows) - an icon file path (suffix ".ico") to
use for the executable's desktop icon; the executable
will have 16x16, 32x32, and 48x48 icons at 4-bit,
8-bit, and 32-bit (RBBA) depths; the icons are
copied and generated from any 16x16, 32x32, and 48x48
icons in the ".ico" file
_'creator_ (Mac OS X) - provides a 4-character string to use as
the application signature.
_'file-types_ (Mac OS X) - provides a list of association lists,
one for each type of file handled by the application;
each association is a 2-element list, where the first (key)
element is a string recognized by Finder, and the second
element is a plist value (see doc.tx in the "xml" collection);
see plt/collects/drscheme/drscheme.filetypes for an example.
-'resource-files_ (Mac OS X) - extra files to copy into the
"Resources" directory of the generated executable
_'forget-exe?_ (Windows, Mac OS X) - a boolean; #t for a launcher
(see `launcher?' below) does not preserve the original
executable name for `(find-system-path 'exec-file)'; the
main consequence is that library collections will be
found relative to the launcher instead of the original
executable
See also `build-aux-from-path' in the "launcher" collection. The
default `aux' is `null'.
If `launcher?' is #t, then no `modules' should be null,
`literal-file-list' should be null, `literal-sexp' should be #f,
and the platform should be Windows or Mac OS X. The embedding
executable is created in such a way that `(find-system-path
'exec-file)' produces the source MzScheme or MrEd path instead of
the embedding executable.
The `variant' argument indicates which variant of the original
binary to use for embedding. The default is 'normal, and typically
the only other possibility is '3m. See `current-launcher-variant'
in the "launcher" collection for more information.
> (write-module-bundle verbose? mod-list literal-file-list literal-sexpr)
- Like `make-embedding-executable', but the module bundle is written
to the current output port instead of being embedded into an
executable. The output of this function can be `read' to load and
instantiate `mod-list' and its dependencies, adjust the module name
resolver to find the newly loaded modules, evaluate the forms
included from `literal-file-list', and finally evaluate
`literal-sexpr'. The `read-accept-compiled' parameter must be true
to read the stream.
> (embedding-executable-is-directory? mred?) - Returns #t if
Mzscheme/MrEd executables for the current platform correspond to
directories (as on Mac OS X).
> (embedding-executable-put-file-extension+style+filters mred?) -
Returns three values suitable for use as the `extension', `style',
and `filters' arguments to `put-file', respectively. If
MzScheme/MrEd launchers for this platform are directories, the
`style' result is suitable for use with `get-directory', and the
`extension' result may be a string indicating a required extension
for the directory name (e.g., ".app" for Mac OS X).
> (embedding-executable-add-suffix path mred?) - Returns a path with a
suitable executable suffix added, if it's not present already.

11
collects/compiler/embed-sig.ss Normal file
View File

@ -0,0 +1,11 @@
(module embed-sig mzscheme
(require (lib "unitsig.ss"))
(provide compiler:embed^)
(define-signature compiler:embed^
(make-embedding-executable
write-module-bundle
embedding-executable-is-directory?
embedding-executable-put-file-extension+style+filters
embedding-executable-add-suffix)))

563
collects/compiler/embed-unit.ss Normal file
View File

@ -0,0 +1,563 @@
(module embed-unit mzscheme
(require (lib "unitsig.ss")
(lib "file.ss")
(lib "list.ss")
(lib "etc.ss")
(lib "port.ss")
(lib "moddep.ss" "syntax")
(lib "plist.ss" "xml")
"embed-sig.ss"
"private/winicon.ss")
(provide compiler:embed@)
(define compiler:embed@
(unit/sig compiler:embed^
(import)
(define (embedding-executable-is-directory? mred?)
(eq? 'macosx (system-type)))
(define (embedding-executable-put-file-extension+style+filters mred?)
(case (system-type)
[(windows) (values ".exe" null '(("Executable" "*.exe")))]
[(macosx) (values ".app" '(enter-packages) #f)]
[else (values #f null null)]))
(define (embedding-executable-add-suffix path mred?)
(let* ([path (if (string? path)
(string->path path)
path)]
[fixup (lambda (re sfx)
(if (regexp-match re (path->bytes path))
path
(path-replace-suffix path sfx)))])
(case (system-type)
[(windows) (fixup #rx#"[.][eE][xX][eE]$" #".exe")]
[(macosx) (if mred?
(fixup #rx#"[.][aA][pP][pP]$" #".app")
path)]
[else path])))
;; Find executable relative to the "mzlib"
;; collection.
(define (find-exe mred? variant)
(let* ([c-path (collection-path "mzlib")]
[base (build-path c-path 'up 'up)]
[fail
(lambda ()
(error 'make-embedding-executable
"can't find ~a executable"
(if mred? "MrEd" "MzScheme")))]
[variant-suffix (case variant
[(normal) ""]
[(3m) "3m"])])
(let ([exe (build-path
base
(case (system-type)
[(macosx)
(cond
[(not mred?)
;; Need MzScheme:
(build-path "bin" (string-append
"mzscheme"
variant-suffix))]
[mred?
;; Need MrEd:
(build-path (format "MrEd~a.app" variant-suffix)
"Contents" "MacOS"
(format "MrEd~a" variant-suffix))])]
[(windows)
(format "~a~a.exe" (if mred?
"mred"
"mzscheme")
variant-suffix)]
[(unix)
(build-path "bin"
(format "~a~a" (if mred?
"mred"
"mzscheme")
variant-suffix))]
[(macos)
(format "~a~a" (if mred?
"MrEd"
"MzScheme")
variant-suffix)]))])
(unless (or (file-exists? exe)
(directory-exists? exe))
(fail))
exe)))
;; Find the magic point in the binary:
(define (find-cmdline)
(let ([m (regexp-match-positions #"\\[Replace me for EXE hack" (current-input-port))])
(if m
(caar m)
(error
'make-embedding-executable
(format
"can't find cmdline position in executable")))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (prepare-macosx-mred exec-name dest aux variant)
(let* ([name (let-values ([(base name dir?) (split-path dest)])
(path-replace-suffix name #""))]
[variant-suffix (case variant
[(normal) ""]
[(3m) "3m"])]
[src (build-path (collection-path "launcher")
(format "Starter~a.app" variant-suffix))]
[creator (let ([c (assq 'creator aux)])
(or (and c
(cdr c))
"MrSt"))]
[file-types (let ([m (assq 'file-types aux)])
(and m
(pair? (cdr m))
(cdr m)))]
[resource-files (let ([m (assq 'resource-files aux)])
(and m
(cdr m)))])
(when creator
(unless (and (string? creator) (= 4 (string-length creator)))
(error 'make-executable "creator is not a 4-character string: ~e" creator)))
(when file-types
(unless (and (list? file-types)
(andmap list? file-types)
(andmap (lambda (spec)
(andmap (lambda (p)
(and (list? p)
(= 2 (length p))
(string? (car p))))
spec))
file-types))
(error 'make-executable "bad file-types spec: ~e" file-types)))
(when resource-files
(unless (and (list? resource-files)
(andmap path-string?
resource-files))
(error 'make-executable "resource-files is not a list of paths: ~e" resource-files)))
(when (or (directory-exists? dest)
(file-exists? dest)
(link-exists? dest))
(delete-directory/files dest))
(make-directory* (build-path dest "Contents" "Resources"))
(make-directory* (build-path dest "Contents" "MacOS"))
(copy-file exec-name (build-path dest "Contents" "MacOS" name))
(copy-file (build-path src "Contents" "PkgInfo")
(build-path dest "Contents" "PkgInfo"))
(let ([icon (or (let ([icon (assq 'icns aux)])
(and icon
(cdr icon)))
(build-path src "Contents" "Resources"
(format "Starter~a.icns" variant-suffix)))])
(copy-file icon
(build-path dest "Contents" "Resources"
(format "Starter~a.icns" variant-suffix))))
(let ([orig-plist (call-with-input-file (build-path src
"Contents"
"Info.plist")
read-plist)]
[plist-replace (lambda (plist . l)
(let loop ([plist plist][l l])
(if (null? l)
plist
(let ([key (car l)]
[val (cadr l)])
(loop `(dict
,@(let loop ([c (cdr plist)])
(cond
[(null? c) (list (list 'assoc-pair key val))]
[(string=? (cadar c) key)
(cons (list 'assoc-pair key val)
(cdr c))]
[else
(cons (car c)
(loop (cdr c)))])))
(cddr l))))))])
(let* ([new-plist (plist-replace
orig-plist
"CFBundleExecutable"
(path->string name)
"CFBundleSignature"
creator
"CFBundleIdentifier"
(format "org.plt-scheme.~a" (path->string name)))]
[new-plist (if file-types
(plist-replace
new-plist
"CFBundleDocumentTypes"
(cons 'array
(map (lambda (spec)
(cons
'dict
(map (lambda (p)
(list
'assoc-pair
(car p)
(cadr p)))
spec)))
file-types)))
new-plist)])
(call-with-output-file (build-path dest
"Contents"
"Info.plist")
(lambda (port)
(write-plist new-plist port))
'truncate)))
(call-with-output-file (build-path dest
"Contents"
"PkgInfo")
(lambda (port)
(fprintf port "APPL~a" creator))
'truncate)
(when resource-files
(for-each (lambda (p)
(let-values ([(base name dir?) (split-path p)])
(copy-file p (build-path dest
"Contents"
"Resources"
name))))
resource-files))
(build-path dest "Contents" "MacOS" name)))
(define (finish-osx-mred dest flags exec-name keep-exe?)
(call-with-output-file (build-path dest
"Contents"
"Resources"
"starter-info")
(lambda (port)
(write-plist
`(dict ,@(if keep-exe?
`((assoc-pair "executable name"
,(path->string exec-name)))
null)
(assoc-pair "stored arguments"
(array ,@flags)))
port))
'truncate))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Represent modules with lists starting with the filename, so we
;; can use assoc:
(define (make-mod normal-file-path normal-module-path code name prefix full-name relative-mappings)
(list normal-file-path normal-module-path code
name prefix full-name relative-mappings))
(define (mod-file m) (car m))
(define (mod-mod-path m) (cadr m))
(define (mod-code m) (caddr m))
(define (mod-name m) (list-ref m 3))
(define (mod-prefix m) (list-ref m 4))
(define (mod-full-name m) (list-ref m 5))
(define (mod-mappings m) (list-ref m 6))
(define (generate-prefix)
(format "#%embedded:~a:" (gensym)))
(define (normalize filename)
(simplify-path (expand-path filename)))
;; Loads module code, using .zo if there, compiling from .scm if not
(define (get-code filename module-path codes prefixes verbose?)
(when verbose?
(fprintf (current-error-port) "Getting ~s~n" filename))
(let ([a (assoc filename (unbox codes))])
(if a
;; Already have this module. Make sure that library-referenced
;; modules are consistently referenced through library paths:
(let ([found-lib? (and (pair? (mod-mod-path a))
(eq? 'lib (car (mod-mod-path a))))]
[look-lib? (and (pair? module-path)
(eq? 'lib (car module-path)))])
(cond
[(and found-lib? look-lib?)
'ok]
[(or found-lib? look-lib?)
(error 'find-module
"module referenced both as a library and through a path: ~a"
filename)]
[else 'ok]))
;; First use of the module. Get code and then get code for imports.
(let ([code (get-module-code filename)])
(let-values ([(imports fs-imports ft-imports) (module-compiled-imports code)])
(let ([name (let-values ([(base name dir?) (split-path filename)])
(path->string (path-replace-suffix name #"")))]
[prefix (let ([a (assoc filename prefixes)])
(if a
(cdr a)
(generate-prefix)))]
[all-file-imports (filter (lambda (x) (not (symbol? x)))
(append imports fs-imports ft-imports))])
(let ([sub-files (map (lambda (i) (normalize (resolve-module-path-index i filename)))
all-file-imports)]
[sub-paths (map (lambda (i) (collapse-module-path-index i module-path))
all-file-imports)])
;; Get code for imports:
(for-each (lambda (sub-filename sub-path)
(get-code sub-filename
sub-path
codes
prefixes
verbose?))
sub-files sub-paths)
;; Build up relative module resolutions, relative to this one,
;; that will be requested at run-time.
(let ([mappings (map (lambda (sub-i sub-filename)
(let-values ([(path base) (module-path-index-split sub-i)])
;; Assert: base should refer to this module:
(let-values ([(path2 base2) (module-path-index-split base)])
(when (or path2 base2)
(error 'embed "unexpected nested module path index")))
(let ([m (assoc sub-filename (unbox codes))])
(cons path (mod-full-name m)))))
all-file-imports sub-files)])
;; Record the module
(set-box! codes
(cons (make-mod filename module-path code
name prefix (string->symbol
(format "~a~a" prefix name))
mappings)
(unbox codes)))))))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (make-module-name-resolver code-l)
`(let ([orig (current-module-name-resolver)]
[ns (current-namespace)]
[mapping-table (quote
,(map
(lambda (m)
`(,(mod-full-name m)
,(mod-mappings m)))
code-l))]
[library-table (quote
,(filter values
(map (lambda (m)
(let ([path (mod-mod-path m)])
(if (and (pair? path)
(eq? 'lib (car path)))
(cons path (mod-full-name m))
#f)))
code-l)))])
(current-module-name-resolver
(lambda (name rel-to stx)
(if (or (not name)
(not (eq? (current-namespace) ns)))
;; a notification,or wrong namespace
(orig name rel-to stx)
;; Have a relative mapping?
(let ([a (assoc rel-to mapping-table)])
(if a
(let ([a2 (assoc name (cadr a))])
(if a2
(cdr a2)
(error 'embedding-module-name-resolver
"unexpected relative mapping request: ~e in ~e"
name rel-to)))
;; A library mapping that we have?
(let ([a3 (and (pair? name)
(eq? (car name) 'lib)
(ormap (lambda (lib-entry)
(with-handlers ([exn:fail? (lambda (x) #f)])
;; To check equality of library references,
;; we have to consider relative paths in the
;; filename part of the name.
(let loop ([a (build-path
(apply build-path
'same
(cddar lib-entry))
(cadar lib-entry))]
[b (build-path
(apply build-path
'same
(let ([d (cddr name)])
(if (null? d)
'("mzlib")
d)))
(cadr name))])
(if (equal? a b)
lib-entry
(let-values ([(abase aname d?) (split-path a)])
(if (eq? aname 'same)
(loop abase b)
(let-values ([(bbase bname a?) (split-path b)])
(if (eq? bname 'same)
(loop a bbase)
(if (equal? aname bname)
(loop abase bbase)
#f)))))))))
library-table))])
(if a3
;; Have it:
(cdr a3)
;; Let default handler try:
(orig name rel-to stx))))))))))
;; Write a module bundle that can be loaded with 'load' (do not embed it
;; into an executable). The bundle is written to the current output port.
(define (write-module-bundle verbose? modules literal-files literal-expression)
(let* ([module-paths (map cadr modules)]
[files (map
(lambda (mp)
(let ([f (resolve-module-path mp #f)])
(unless f
(error 'write-module-bundle "bad module path: ~e" mp))
(normalize f)))
module-paths)]
[collapsed-mps (map
(lambda (mp)
(collapse-module-path mp "."))
module-paths)]
[prefix-mapping (map (lambda (f m)
(cons f (let ([p (car m)])
(cond
[(symbol? p) (symbol->string p)]
[(eq? p #t) (generate-prefix)]
[(not p) ""]
[else (error
'write-module-bundle
"bad prefix: ~e"
p)]))))
files modules)]
;; Each element is created with `make-mod'.
;; As we descend the module tree, we append to the front after
;; loasing imports, so the list in the right order.
[codes (box null)])
(for-each (lambda (f mp) (get-code f mp codes prefix-mapping verbose?))
files
collapsed-mps)
;; Install a module name resolver that redirects
;; to the embedded modules
(write (make-module-name-resolver (unbox codes)))
(let ([l (unbox codes)])
(for-each
(lambda (nc)
(when verbose?
(fprintf (current-error-port) "Writing module from ~s~n" (mod-file nc)))
(write `(current-module-name-prefix ',(string->symbol (mod-prefix nc))))
(write (mod-code nc)))
l))
(write '(current-module-name-prefix #f))
(newline)
(for-each (lambda (f)
(when verbose?
(fprintf (current-error-port) "Copying from ~s~n" f))
(call-with-input-file*
f
(lambda (i)
(copy-port i (current-output-port)))))
literal-files)
(when literal-expression
(write literal-expression))))
;; Use `write-module-bundle', but figure out how to put it into an executable
(define make-embedding-executable
(opt-lambda (dest mred? verbose?
modules
literal-files literal-expression
cmdline
[aux null]
[launcher? #f]
[variant 'normal])
(define keep-exe? (and launcher?
(let ([m (assq 'forget-exe? aux)])
(or (not m)
(not (cdr m))))))
(define long-cmdline? (or (eq? (system-type) 'windows)
(and mred? (eq? 'macosx (system-type)))))
(unless (or long-cmdline?
((apply + (length cmdline) (map (lambda (s)
(bytes-length (string->bytes/utf-8 s)))
cmdline)) . < . 50))
(error 'make-embedding-executable "command line too long"))
(let ([exe (find-exe mred? variant)])
(when verbose?
(fprintf (current-error-port) "Copying to ~s~n" dest))
(let-values ([(dest-exe osx?)
(if (and mred? (eq? 'macosx (system-type)))
(values (prepare-macosx-mred exe dest aux variant) #t)
(begin
(when (or (file-exists? dest)
(directory-exists? dest)
(link-exists? dest))
;; Delete-file isn't enough if the target
;; is supposed to be a directory. But
;; currently, that happens only for MrEd
;; on Mac OS X, which is handles above.
(delete-file dest))
(copy-file exe dest)
(values dest #f)))])
(with-handlers ([void (lambda (x)
(if osx?
(when (directory-exists? dest)
(delete-directory/files dest))
(when (file-exists? dest)
(delete-file dest)))
(raise x))])
(let ([start (file-size dest-exe)])
(with-output-to-file dest-exe
(lambda ()
(write-module-bundle verbose? modules literal-files literal-expression))
'append)
(let ([end (file-size dest-exe)])
(when verbose?
(fprintf (current-error-port) "Setting command line~n"))
(let ([start-s (number->string start)]
[end-s (number->string end)])
(let ([full-cmdline (append
(if launcher?
(if (and (eq? 'windows (system-type))
keep-exe?)
(list (path->string exe)) ; argv[0]
null)
(list "-k" start-s end-s))
cmdline)])
(if osx?
(finish-osx-mred dest full-cmdline exe keep-exe?)
(let ([cmdpos (with-input-from-file dest-exe find-cmdline)]
[out (open-output-file dest-exe 'update)])
(dynamic-wind
void
(lambda ()
(if long-cmdline?
;; write cmdline at end:
(file-position out end)
(begin
;; write (short) cmdline in the normal position:
(file-position out cmdpos)
(display "!" out)))
(for-each
(lambda (s)
(fprintf out "~a~a~c"
(integer->integer-bytes
(add1 (bytes-length (string->bytes/utf-8 s)) )
4 #t #f)
s
#\000))
full-cmdline)
(display "\0\0\0\0" out)
(when long-cmdline?
;; cmdline written at the end;
;; now put forwarding information at the normal cmdline pos
(let ([new-end (file-position out)])
(file-position out cmdpos)
(fprintf out "~a...~a~a"
(if keep-exe? "*" "?")
(integer->integer-bytes end 4 #t #f)
(integer->integer-bytes (- new-end end) 4 #t #f)))))
(lambda ()
(close-output-port out)))
(let ([m (and (eq? 'windows (system-type))
(assq 'ico aux))])
(when m
(install-icon dest-exe (cdr m))))))))))))))))))

31
collects/compiler/embed.ss Normal file
View File

@ -0,0 +1,31 @@
(module embed mzscheme
(require (lib "unitsig.ss")
(lib "contract.ss"))
(require "sig.ss")
(require "embed-unit.ss"
"embed-sig.ss")
(define-values/invoke-unit/sig compiler:embed^
compiler:embed@
#f)
(provide/contract [make-embedding-executable
(opt-> (path-string?
any/c
any/c
(listof (list/c (union boolean? symbol?) any/c))
(listof path-string?)
any/c
(listof string?))
((listof (cons/c symbol? any/c))
any/c
symbol?)
void?)])
(provide write-module-bundle
embedding-executable-is-directory?
embedding-executable-put-file-extension+style+filters
embedding-executable-add-suffix))

12
collects/compiler/info.ss Normal file
View File

@ -0,0 +1,12 @@
(module info (lib "infotab.ss" "setup")
(define doc.txt "doc.txt")
(define name "mzc")
(define mzscheme-launcher-libraries (list "start.ss"))
(define mzscheme-launcher-names (list "mzc"))
(define mred-launcher-libraries (list "start.ss"))
(define mred-launcher-names (list "gmzc"))
(define compile-omit-files
'("mrspidey.ss" "mrspideyf.ss" "mrspideyi.ss" "embedr.ss")))

304
collects/compiler/ld-unit.ss Normal file
View File

@ -0,0 +1,304 @@
(module ld-unit mzscheme
(require (lib "unitsig.ss")
(lib "list.ss"))
(require "sig.ss")
(require (lib "file-sig.ss" "dynext")
(lib "link-sig.ss" "dynext")
(lib "compile-sig.ss" "dynext"))
(provide ld@)
(define ld@
(unit/sig compiler:linker^
(import dynext:compile^
dynext:link^
dynext:file^
(compiler:option : compiler:option^))
(rename (link-extension* link-extension))
;; Copied from library.ss; please fix me!
(define compiler:bad-chars
(string->list "#+-.*/<=>!?:$%_&~^@;^()[]{}|\\,~\"`' "))
(define (compiler:clean-string s)
(let* ((str (string->list s)))
(list->string
(map (lambda (c) (if (member c compiler:bad-chars)
#\_
c))
str))))
(define (link-extension*
files
dest-dir)
(do-link-extension #t files dest-dir))
(define (glue-extension
files
dest-dir)
(do-link-extension #f files dest-dir))
(define (do-link-extension
link?
files
dest-dir)
(define _loader.c (append-c-suffix "_loader"))
(define _loader.o (append-object-suffix "_loader"))
(define _loader.so (append-extension-suffix "_loader"))
(define __ (printf "\"~a\":~n" (build-path dest-dir _loader.c)))
(define all-names
(map
(lambda (file)
(let*-values ([(base name dir?) (split-path file)])
(let ([o (extract-base-filename/o name)]
[kp (extract-base-filename/kp name)])
(cond
[o (list 'o file o)]
[kp (cons 'kp file)]
[else (error 'mzld "file is not a compiled object for constant pool file: ~a"
file)]))))
files))
(define-values (o-files ; just .o files
names ; just .o names
kps) ; just .kp files
(let loop ([l all-names][ofs null][os null][kps null])
(if (null? l)
(values (reverse ofs)
(map path->string (reverse os))
(reverse kps))
(if (eq? (caar l) 'o)
(loop (cdr l) (cons (cadar l) ofs) (cons (caddar l) os) kps)
(loop (cdr l) ofs os (cons (cdar l) kps))))))
(define linker-prefix (compiler:option:setup-prefix))
(define suffixes
(let ([linker-prefix (compiler:clean-string linker-prefix)])
(map
(lambda (name)
(string-append linker-prefix "_" (compiler:clean-string name)))
names)))
(define symbol-table (make-hash-table))
(define (add-symbol s spos pos uninterned?)
(let ([v (hash-table-get symbol-table s (lambda () null))])
(hash-table-put! symbol-table s
(cons (list spos pos) v))))
;; Read in symbol info
(define kp-suffixes/counts
(let loop ([kps kps][kpos 0])
(if (null? kps)
null
(let-values ([(suffix count)
(call-with-input-file (car kps)
(lambda (in)
(let ([info (read in)])
(let ([suffix (car info)]
[symbols (cdadr info)])
(let loop ([l symbols][p 0])
(unless (null? l)
(let ([s (car l)])
;; s might be a list containing a symbol to
;; indicate that it's uninterned
(add-symbol (if (string? s)
(string->symbol s)
(string->uninterned-symbol (car s)))
kpos p
(pair? s)))
(loop (cdr l) (add1 p))))
(values suffix (length symbols))))))])
(let ([rest (loop (cdr kps)
(if (zero? count)
kpos
(add1 kpos)))])
(if (zero? count)
rest
(cons (cons suffix count) rest)))))))
;; Compile content of symbol table into dispatching information
(define symbols (hash-table-map symbol-table (lambda (key info) key)))
(define symbol-dispatches
(apply
append
(hash-table-map
symbol-table
(lambda (key info)
(cons (length info)
(apply append info))))))
(with-output-to-file
(build-path dest-dir _loader.c)
(lambda ()
(printf "#include \"~ascheme.h\"~n"
(if (compiler:option:compile-for-embedded)
""
"e"))
(printf "#include \"mzclink.h\"~n~n")
(for-each
(lambda (suffix)
(printf "extern Scheme_Object * scheme_setup~a(Scheme_Env *e);~n" suffix)
(printf "extern Scheme_Object * scheme_reload~a(Scheme_Env *e);~n" suffix))
suffixes)
(for-each
(lambda (kp-suffix/count)
(let ([suffix (car kp-suffix/count)]
[count (cdr kp-suffix/count)])
(printf "extern Scheme_Object * SYMBOLS~a[~a];~n"
suffix count)))
kp-suffixes/counts)
(printf "~nstatic struct {~n")
(for-each
(lambda (suffix)
(printf " Scheme_Object * ~a_symbol;~n" suffix))
suffixes)
(printf "} syms;~n~n")
(unless (null? symbols)
(printf "static const char *SYMBOL_STRS[~a] = {~n" (length symbols))
(for-each
(lambda (s)
(printf " ~s,~n" (symbol->string s)))
symbols)
(printf "}; /* end of SYMBOL_STRS */~n~n")
(printf "static long SYMBOL_LENS[~a] = {~n" (length symbols))
(for-each
(lambda (s)
(printf " ~s,~n" (string-length (symbol->string s))))
symbols)
(printf "}; /* end of SYMBOL_LENS */~n~n")
(printf "static char SYMBOL_INTERNS[~a] = {~n" (length symbols))
(for-each
(lambda (s)
(printf " ~s,~n" (if (eq? s (string->symbol (symbol->string s))) 1 0)))
symbols)
(printf "}; /* end of SYMBOL_INTERNS */~n~n")
(printf "static const int SYMBOL_DISPATCHES[~a] = {~n " (length symbol-dispatches))
(let loop ([l symbol-dispatches][line 0])
(unless (null? l)
(if (= line 20)
(begin
(printf "~n ")
(loop l 0))
(begin
(printf "~a, " (car l))
(loop (cdr l) (add1 line))))))
(printf "~n}; /* end of SYMBOL_DISPATCHES */~n~n")
(printf "static setup_pooled_symbols(void) {~n Scheme_Object * * symbol_tables[~a];~n int i, j;~n"
(length kp-suffixes/counts))
(let loop ([l kp-suffixes/counts][p 0])
(unless (null? l)
(printf " symbol_tables[~a] = SYMBOLS~a;~n scheme_register_extension_global(&SYMBOLS~a, sizeof(SYMBOLS~a));~n"
p (caar l)
(caar l) (caar l))
(loop (cdr l) (add1 p))))
(printf " for (i = j = 0; i < ~a; i++) {~n" (length symbols))
(printf " Scheme_Object * s;~n")
(printf " int c, k;~n")
(printf " if (SYMBOL_INTERNS[i])~n")
(printf " s = scheme_intern_exact_symbol(SYMBOL_STRS[i], SYMBOL_LENS[i]);~n")
(printf " else~n")
(printf " s = scheme_make_exact_symbol(SYMBOL_STRS[i], SYMBOL_LENS[i]);~n")
(printf " c = SYMBOL_DISPATCHES[j++];~n")
(printf " for (k = c; k--; j += 2)~n")
(printf " symbol_tables[SYMBOL_DISPATCHES[j]][SYMBOL_DISPATCHES[j+1]] = s;~n")
(printf " }~n")
(printf "}~n~n"))
(printf "static Scheme_Object * loader_dispatch(void *v, int argc, Scheme_Object * * argv) {~n")
(printf " Scheme_Env * env = scheme_get_env(scheme_current_config());~n")
(printf " return ((Scheme_Object *(*)(Scheme_Env *))v)(env);~n}~n~n")
(printf "static Scheme_Object * loader_dispatch_all(int argc, Scheme_Object * * argv) {~n")
(printf " Scheme_Env * env = scheme_get_env(scheme_current_config());~n")
(printf " Scheme_Object * v = scheme_void;~n")
(for-each
(lambda (suffix)
(printf " v = LOCAL_PROC(scheme_reload~a)(env);~n"
suffix))
suffixes)
(printf " return v;~n}~n~n")
(printf "static Scheme_Object * loader(int argc, Scheme_Object * * argv) {~n")
(printf " Scheme_Object *a[2];~n")
(printf " Scheme_Object * name = argv[0];~n")
(printf " if (name == scheme_true) {~n")
(printf " a[0] = scheme_make_prim_w_arity(loader_dispatch_all, \"_loader-dispatch-all\", 0, 0);~n")
(printf " a[1] = scheme_false;~n")
(printf " }~n")
(for-each
(lambda (suffix)
(printf " else if (name == syms.~a_symbol) {~n" suffix)
(printf " a[0] = scheme_make_closed_prim_w_arity(loader_dispatch, LOCAL_PROC(scheme_reload~a), \"_loader-dispatch\", 0, 0);~n" suffix)
(printf " a[1] = ~ascheme_module_name();~n" suffix)
(printf " }~n"))
suffixes)
(printf " else {~n")
(printf " a[0] = scheme_false;~n")
(printf " a[1] = scheme_false;~n")
(printf " }~n")
(printf " return scheme_values(2, a);~n}~n~n")
(printf "Scheme_Object * scheme_reload(Scheme_Env * env) {~n")
(printf " return scheme_make_prim_w_arity(loader, \"_loader\", 1, 1);~n}~n~n")
(printf "Scheme_Object * scheme_initialize(Scheme_Env * env) {~n")
(unless (null? symbols)
(printf " setup_pooled_symbols();~n"))
(for-each
(lambda (suffix)
;; (printf " printf(\"~a is %lx\\n\", scheme_setup~a);~n" suffix suffix)
(printf " LOCAL_PROC(scheme_setup~a)(env);~n" suffix))
suffixes)
(printf " scheme_register_extension_global(&syms, sizeof(syms));~n")
(for-each
(lambda (suffix name)
(printf " syms.~a_symbol = scheme_intern_exact_symbol(~s, ~a);~n" suffix name (string-length name)))
suffixes names)
(printf " return scheme_reload(env);~n}~n")
(printf "Scheme_Object * scheme_module_name() { return NULL; }~n"))
'truncate)
(let ([tmp-dir (let ([d (getenv "PLTLDTMPDIR")])
(and d (directory-exists? d) d))])
(compile-extension (not (compiler:option:verbose))
(build-path dest-dir _loader.c)
(build-path dest-dir _loader.o)
(list (collection-path "compiler")))
(when (compiler:option:clean-intermediate-files)
(delete-file (build-path dest-dir _loader.c)))
(if link?
(begin
(link-extension (not (compiler:option:verbose))
(cons (build-path dest-dir _loader.o) o-files)
(build-path (if tmp-dir
tmp-dir
dest-dir)
_loader.so))
(when tmp-dir
(copy-file (build-path tmp-dir _loader.so)
(build-path dest-dir _loader.so))
(delete-file (build-path tmp-dir _loader.so)))
(when (compiler:option:clean-intermediate-files)
(delete-file (build-path dest-dir _loader.o)))
(printf " [output to \"~a\"]~n" (build-path dest-dir _loader.so)))
(printf " [output to \"~a\"]~n" (build-path dest-dir _loader.o))))))))

273
collects/compiler/mzc.h Normal file
View File

@ -0,0 +1,273 @@
#include <stdlib.h>
#include <stdarg.h>
#define GLOBAL_VARREF(x) ((x)->val ? (Scheme_Object *)(x)->val : \
(scheme_unbound_global(x), (Scheme_Object *)NULL))
#define CHECK_GLOBAL_BOUND(x) \
if (!(x)->val) scheme_raise_exn(MZEXN_UNIT, \
"invoke-unit: cannot link to undefined identifier: %S", \
(Scheme_Object*)(x)->key);
#define DO_FUEL_POLL ((scheme_fuel_counter-- <= 0) ? (scheme_process_block(0), 0) : 0)
#define _scheme_direct_apply_primitive_multi_poll(prim, argc, argv) \
(DO_FUEL_POLL, _scheme_direct_apply_primitive_multi(prim, argc, argv))
#define _scheme_direct_apply_primitive_poll(prim, argc, argv) \
(DO_FUEL_POLL, _scheme_direct_apply_primitive(prim, argc, argv))
#define _scheme_direct_apply_closed_primitive_multi_poll(prim, argc, argv) \
(DO_FUEL_POLL, _scheme_direct_apply_closed_primitive_multi(prim, argc, argv))
#define _scheme_direct_apply_closed_primitive_poll(prim, argc, argv) \
(DO_FUEL_POLL, _scheme_direct_apply_closed_primitive(prim, argc, argv))
#ifdef KEEP_CLOSURE_COUNT
static int closure_alloc_cnt;
static void print_closures()
{
printf("closures allocated in " MZC_SRC_FILE ": %d\n", closure_alloc_cnt);
}
# define CLOSURE_ALLOC_PP closure_alloc_inc(),
static void closure_alloc_inc()
{
if (!closure_alloc_cnt)
atexit(print_closures);
closure_alloc_cnt++;
}
#else
# define CLOSURE_ALLOC_PP /**/
#endif
#define _scheme_make_c_proc_closure(cfunc, rec, name, amin, amax, flags) \
(CLOSURE_ALLOC_PP (Scheme_Object *)_scheme_fill_prim_closure(&rec->prim, cfunc, &rec->data, name, amin, amax, flags))
#define _scheme_make_c_proc_closure_empty(cfunc, rec, name, amin, amax, flags) \
(CLOSURE_ALLOC_PP (Scheme_Object *)_scheme_fill_prim_closure(&rec->prim, cfunc, NULL, name, amin, amax, flags))
#define _scheme_make_c_case_proc_closure(cfunc, rec, name, ccnt, cses, flags) \
(CLOSURE_ALLOC_PP (Scheme_Object *)_scheme_fill_prim_case_closure(&rec->prim, cfunc, &rec->data, name, ccnt, cses, flags))
#define _scheme_make_c_case_proc_closure_empty(cfunc, rec, name, ccnt, cses, flags) \
(CLOSURE_ALLOC_PP (Scheme_Object *)_scheme_fill_prim_case_closure(&rec->prim, cfunc, NULL, name, ccnt, cses, flags))
#define NO_MULTIPLE_VALUES(res) \
if (res == SCHEME_MULTIPLE_VALUES) \
scheme_wrong_return_arity(NULL, 1, scheme_multiple_count, scheme_multiple_array, NULL);
#define CHECK_MULTIPLE_VALUES(res, expected) \
if (res != SCHEME_MULTIPLE_VALUES || scheme_multiple_count != expected) \
scheme_wrong_return_arity(NULL, expected, \
(res == SCHEME_MULTIPLE_VALUES ? scheme_multiple_count : 1), \
(res == SCHEME_MULTIPLE_VALUES ? scheme_multiple_array : (Scheme_Object**)res), \
NULL);
#define SCHEME_DETATCH_MV_BUFFER(mv, pr) if (SAME_OBJ(mv, pr->values_buffer)) pr->values_buffer = NULL
#define SCHEME_CURRENT_ENV(pr) scheme_get_env(NULL)
typedef struct {
Scheme_Object * val;
Scheme_Object ** array;
int count;
} _Scheme_Begin0_Rec;
typedef struct {
Scheme_Cont_Frame_Data cf;
Scheme_Object *val;
} _Scheme_WCM_Rec;
#define _scheme_apply_ckp(f, argc, argv) (SCHEME_CLSD_PRIMP(f) ? _scheme_apply_closed_prim(f, argc, argv) : _scheme_apply(f, argc, argv))
#define _scheme_apply_multi_ckp(f, argc, argv) (SCHEME_CLSD_PRIMP(f) ? _scheme_apply_closed_prim_multi(f, argc, argv) : _scheme_apply_multi(f, argc, argv))
#define MZC_EQP(ltp, av, bv) (SAME_OBJ(av, bv))
#define MZC_EQVP(ltp, av, bv) (SAME_OBJ(av, bv) || scheme_eqv(av, bv))
#define MZC_EQUALP(ltp, av, bv) scheme_equal(av, bv)
#define MZC_NOTP(p, av) (SCHEME_FALSEP(av))
#define MZC_NULLP(p, av) (SCHEME_NULLP(av))
#define MZC_PAIRP(p, av) (SCHEME_PAIRP(av))
#define MZC_SYMBOLP(p, av) (SCHEME_SYMBOLP(av))
#define MZC_STRINGP(p, av) (SCHEME_CHAR_STRINGP(av))
#define MZC_BYTESP(p, av) (SCHEME_BYTE_STRINGP(av))
#define MZC_VECTORP(p, av) (SCHEME_VECTORP(av))
#define MZC_NUMBERP(p, av) (SCHEME_NUMBERP(av))
#define MZC_PROCEDUREP(p, av) (SCHEME_PROCP(av))
#define MZC_EOFP(p, av) (SCHEME_EOFP(av))
#define MZC_CHARP(p, av) (SCHEME_CHARP(av))
#define MZC_CONS(p, av, bv) scheme_make_pair(av, bv)
#define MZC_LIST1(p, av) scheme_make_pair(av, scheme_null)
#define MZC_LIST2(p, av, bv) scheme_make_pair(av, scheme_make_pair(bv, scheme_null))
#define MZC_APPEND(p, av, bv) scheme_append(av, bv)
#define MZC_FOR_SYNTAX_IN_ENV(ignored, proc) scheme_apply_for_syntax_in_env(proc, env)
#if MZC_UNSAFE
/* Unsafe versions */
#define MZC_CAR(p, av) SCHEME_CAR(av)
#define MZC_CDR(p, av) SCHEME_CDR(av)
#define MZC_CADR(p, av) SCHEME_CAR(SCHEME_CDR(av))
#define MZC_CDDR(p, av) SCHEME_CDR(SCHEME_CDR(av))
#define MZC_CDAR(p, av) SCHEME_CDR(SCHEME_CAR(av))
#define MZC_CAAR(p, av) SCHEME_CAR(SCHEME_CAR(av))
#define MZC_CADDR(p, av) SCHEME_CADR(SCHEME_CDR(av))
#define MZC_SET_CAR(p, av, bv) (SCHEME_CAR(av)=bv, scheme_void)
#define MZC_SET_CDR(p, av, bv) (SCHEME_CDR(av)=bv, scheme_void)
# define MZC_VECTOR_REF(p, v, i) SCHEME_VEC_ELS(v)[SCHEME_INT_VAL(i)]
# define MZC_VECTOR_SET(p, v, i, x) (SCHEME_VEC_ELS(v)[SCHEME_INT_VAL(i)] = x, scheme_void)
# define MZC_STRING_REF(p, v, i) scheme_make_character(SCHEME_CHAR_STR_VAL(v)[SCHEME_INT_VAL(i)])
# define MZC_STRING_SET(p, v, i, x) (SCHEME_CHAR_STR_VAL(v)[SCHEME_INT_VAL(i)] = SCHEME_CHAR_VAL(x), scheme_void)
# define MZC_BYTES_REF(p, v, i) scheme_make_integer(SCHEME_BYTE_STR_VAL(v)[SCHEME_INT_VAL(i)])
# define MZC_BYTES_SET(p, v, i, x) (SCHEME_BYTE_STR_VAL(v)[SCHEME_INT_VAL(i)] = SCHEME_INT_VAL(x), scheme_void)
#define MZC_CHAR_TO_INTEGER(p, v) scheme_make_integer((unsigned char)SCHEME_CHAR_VAL(v))
/* End unsafe versions */
#else
/* Safe versions */
#define MZC_CAR(p, av) (SCHEME_PAIRP(av) ? SCHEME_CAR(av) : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
#define MZC_CDR(p, av) (SCHEME_PAIRP(av) ? SCHEME_CDR(av) : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
#define MZC_CADR(p, av) ((SCHEME_PAIRP(av) && SCHEME_PAIRP(SCHEME_CDR(av))) ? SCHEME_CAR(SCHEME_CDR(av)) : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
#define MZC_CDDR(p, av) ((SCHEME_PAIRP(av) && SCHEME_PAIRP(SCHEME_CDR(av))) ? SCHEME_CDR(SCHEME_CDR(av)) : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
#define MZC_CDAR(p, av) ((SCHEME_PAIRP(av) && SCHEME_PAIRP(SCHEME_CAR(av))) ? SCHEME_CDR(SCHEME_CAR(av)) : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
#define MZC_CAAR(p, av) ((SCHEME_PAIRP(av) && SCHEME_PAIRP(SCHEME_CAR(av))) ? SCHEME_CAR(SCHEME_CAR(av)) : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
#define MZC_CADDR(p, av) ((SCHEME_PAIRP(av) && SCHEME_PAIRP(SCHEME_CDR(av)) && SCHEME_PAIRP(SCHEME_CDR(SCHEME_CDR(av)))) ? SCHEME_CADR(SCHEME_CDR(av)) : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
#define MZC_SET_CAR(p, av, bv) (SCHEME_MUTABLE_PAIRP(av) ? (SCHEME_CAR(av)=bv, scheme_void) : (arg[0] = av, arg[1] = bv, _scheme_direct_apply_primitive_multi(p, 2, arg)))
#define MZC_SET_CDR(p, av, bv) (SCHEME_MUTABLE_PAIRP(av) ? (SCHEME_CDR(av)=bv, scheme_void) : (arg[0] = av, arg[1] = bv, _scheme_direct_apply_primitive_multi(p, 2, arg)))
#define MZC_CHAR_TO_INTEGER(p, v) (SCHEME_CHARP(v) ? scheme_make_integer((unsigned char)SCHEME_CHAR_VAL(v)) \
: (arg[0] = v, _scheme_direct_apply_primitive_multi(p, 1, arg)))
# define MZC_VECTOR_REF(p, v, i) ((SCHEME_INTP(i) && SCHEME_VECTORP(v) && (SCHEME_INT_VAL(i) >= 0) \
&& (SCHEME_INT_VAL(i) < SCHEME_VEC_SIZE(v)) \
? SCHEME_VEC_ELS(v)[SCHEME_INT_VAL(i)] \
: (arg[0] = v, arg[1] = i, _scheme_direct_apply_primitive_multi(p, 2, arg))))
# define MZC_VECTOR_SET(p, v, i, x) ((SCHEME_INTP(i) && SCHEME_VECTORP(v) && (SCHEME_INT_VAL(i) >= 0) \
&& (SCHEME_INT_VAL(i) < SCHEME_VEC_SIZE(v)) \
? (SCHEME_VEC_ELS(v)[SCHEME_INT_VAL(i)] = x, scheme_void) \
: (arg[0] = v, arg[1] = i, arg[2] = x, _scheme_direct_apply_primitive_multi(p, 3, arg))))
# define MZC_STRING_REF(p, v, i) ((SCHEME_INTP(i) && SCHEME_CHAR_STRINGP(v) && (SCHEME_INT_VAL(i) >= 0) \
&& (SCHEME_INT_VAL(i) < SCHEME_CHAR_STRLEN_VAL(v)) \
? scheme_make_character(SCHEME_CHAR_STR_VAL(v)[SCHEME_INT_VAL(i)]) \
: (arg[0] = v, arg[1] = i, _scheme_direct_apply_primitive_multi(p, 2, arg))))
# define MZC_STRING_SET(p, v, i, x) ((SCHEME_INTP(i) && SCHEME_MUTABLE_CHAR_STRINGP(v) && SCHEME_CHARP(x) && (SCHEME_INT_VAL(i) >= 0) \
&& (SCHEME_INT_VAL(i) < SCHEME_CHAR_STRLEN_VAL(v)) \
? (SCHEME_CHAR_STR_VAL(v)[SCHEME_INT_VAL(i)] = SCHEME_CHAR_VAL(x), scheme_void) \
: (arg[0] = v, arg[1] = i, arg[2] = x, _scheme_direct_apply_primitive_multi(p, 3, arg))))
# define MZC_BYTES_REF(p, v, i) ((SCHEME_INTP(i) && SCHEME_BYTE_STRINGP(v) && (SCHEME_INT_VAL(i) >= 0) \
&& (SCHEME_INT_VAL(i) < SCHEME_BYTE_STRLEN_VAL(v)) \
? scheme_make_integer(SCHEME_BYTE_STR_VAL(v)[SCHEME_INT_VAL(i)]) \
: (arg[0] = v, arg[1] = i, _scheme_direct_apply_primitive_multi(p, 2, arg))))
# define MZC_BYTES_SET(p, v, i, x) ((SCHEME_INTP(i) && SCHEME_MUTABLE_BYTE_STRINGP(v) && SCHEME_INTP(x) \
&& (SCHEME_INT_VAL(x) >= 0) && (SCHEME_INT_VAL(x) <= 255) \
&& (SCHEME_INT_VAL(i) >= 0) && (SCHEME_INT_VAL(i) < SCHEME_BYTE_STRLEN_VAL(v)) \
? (SCHEME_BYTE_STR_VAL(v)[SCHEME_INT_VAL(i)] = SCHEME_INT_VAL(x), scheme_void) \
: (arg[0] = v, arg[1] = i, arg[2] = x, _scheme_direct_apply_primitive_multi(p, 3, arg))))
/* End safe versions */
#endif
#define _MZC_DBLP(obj) SAME_TYPE(_SCHEME_TYPE(obj), scheme_double_type)
#define MZC_ZEROP(zp, av) (SCHEME_INTP(av) \
? (av == scheme_make_integer(0)) \
: (_MZC_DBLP(av) \
? !SCHEME_DBL_VAL(av) \
: (arg[0] = av, SCHEME_TRUEP(_scheme_direct_apply_primitive_multi(zp, 1, arg)))))
#define MZC_ARITH_COMPARE(cp, av, bv, compareop) \
((SCHEME_INTP(av) && SCHEME_INTP(bv)) \
? (SCHEME_INT_VAL(av) compareop SCHEME_INT_VAL(bv)) \
: ((SCHEME_DBLP(av) && SCHEME_DBLP(bv)) \
? (SCHEME_DBL_VAL(av) compareop SCHEME_DBL_VAL(bv)) \
: (arg[0] = av, arg[1] = bv, SCHEME_TRUEP(_scheme_direct_apply_primitive_multi(cp, 2, arg)))))
#define MZC_LTP(cp, av, bv) MZC_ARITH_COMPARE(cp, av, bv, <)
#define MZC_GTP(cp, av, bv) MZC_ARITH_COMPARE(cp, av, bv, >)
#define MZC_LTEP(cp, av, bv) MZC_ARITH_COMPARE(cp, av, bv, <=)
#define MZC_GTEP(cp, av, bv) MZC_ARITH_COMPARE(cp, av, bv, >=)
#define MZC_EQLP(cp, av, bv) MZC_ARITH_COMPARE(cp, av, bv, ==)
#if MZC_FIXNUM
/* Numerically incorrect */
#define MZC_ADD1(p, av) (SCHEME_INTP(av) \
? scheme_make_integer(SCHEME_INT_VAL(av)+1) \
: (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
#define MZC_SUB1(p, av) (SCHEME_INTP(av) \
? scheme_make_integer(SCHEME_INT_VAL(av)-1) \
: (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
#define MZC_ARITH_OP(cp, av, bv, op, revop) \
((SCHEME_INTP(av) && SCHEME_INTP(bv)) \
? scheme_make_integer(SCHEME_INT_VAL(av) op SCHEME_INT_VAL(bv)) \
: ((SCHEME_DBLP(av) && SCHEME_DBLP(bv)) \
? scheme_make_double(SCHEME_DBL_VAL(av) op SCHEME_DBL_VAL(bv)) \
: (arg[0] = av, arg[1] = bv, _scheme_direct_apply_primitive_multi(cp, 2, arg))))
#define MZC_TIMES2(cp, av, bv) MZC_ARITH_OP(cp, av, bv, *, /)
/* End numerically incorrect */
#else
/* Numerically correct */
#define MZC_ADD1(p, av) ((SCHEME_INTP(av) && (SCHEME_INT_VAL(av) < 0x3FFFFFFF)) \
? scheme_make_integer(SCHEME_INT_VAL(av)+1) \
: (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
#define MZC_SUB1(p, av) ((SCHEME_INTP(av) && (SCHEME_INT_VAL(av) > (-0x3FFFFFFF))) \
? scheme_make_integer(SCHEME_INT_VAL(av)-1) \
: (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
#define MZC_ARITH_OP(cp, av, bv, op, revop) \
((SCHEME_INTP(av) && SCHEME_INTP(bv) \
&& (((SCHEME_INT_VAL(scheme_make_integer(SCHEME_INT_VAL(av) op SCHEME_INT_VAL(bv))) \
revop SCHEME_INT_VAL(bv)) \
== SCHEME_INT_VAL(av)))) \
? scheme_make_integer(SCHEME_INT_VAL(av) op SCHEME_INT_VAL(bv)) \
: ((SCHEME_DBLP(av) && SCHEME_DBLP(bv)) \
? scheme_make_double(SCHEME_DBL_VAL(av) op SCHEME_DBL_VAL(bv)) \
: (arg[0] = av, arg[1] = bv, _scheme_direct_apply_primitive_multi(cp, 2, arg))))
/* End numerically correct */
#endif
#define MZC_PLUS2(cp, av, bv) MZC_ARITH_OP(cp, av, bv, +, -)
#define MZC_MINUS2(cp, av, bv) MZC_ARITH_OP(cp, av, bv, -, +)
#define MZC_MAXMIN_OP(cp, av, bv, minlt) \
((SCHEME_INTP(av) && SCHEME_INTP(bv)) \
? ((SCHEME_INT_VAL(av) minlt SCHEME_INT_VAL(bv)) ? av : bv) \
: (arg[0] = av, arg[1] = bv, _scheme_direct_apply_primitive_multi(cp, 2, arg)))
#define MZC_MAX2(cp, av, bv) MZC_MAXMIN_OP(cp, av, bv, >)
#define MZC_MIN2(cp, av, bv) MZC_MAXMIN_OP(cp, av, bv, <)
#define MZC_QUOTIENT(cp, av, bv) \
((SCHEME_INTP(av) && SCHEME_INTP(bv) && SCHEME_INT_VAL(bv)) \
? scheme_make_integer(SCHEME_INT_VAL(av) / SCHEME_INT_VAL(bv)) \
: (arg[0] = av, arg[1] = bv, _scheme_direct_apply_primitive_multi(cp, 2, arg)))
static MSC_IZE(inline) Scheme_Object *mzc_force_value(Scheme_Object *v)
{
return _scheme_force_value(v);
}
#define _scheme_direct_apply_closed_primitive_multi_fv(prim, argc, argv) \
mzc_force_value(_scheme_direct_apply_closed_primitive_multi(prim, argc, argv))
#define _scheme_direct_apply_closed_primitive_fv(prim, argc, argv) \
scheme_check_one_value(_scheme_direct_apply_closed_primitive_multi_fv(prim, argc, argv))
static int mzc_strlen(const char *c) {
int l;
for (l = 0; c[l]; l++);
return l;
}
#if 0
static Scheme_Object *DEBUG_CHECK(Scheme_Object *v)
{
if ((SCHEME_TYPE(v) < _scheme_values_types_) || (SCHEME_TYPE(v) > _scheme_last_type_ + 5)) {
/* Could be a boxed value ... */
Scheme_Object *o = *(Scheme_Object **)v;
if ((SCHEME_TYPE(v) < _scheme_values_types_) || (SCHEME_TYPE(v) > _scheme_last_type_ + 5)) {
printf("wrong!\n");
}
}
return v;
}
#endif

2
collects/compiler/mzclink.h Normal file
View File

@ -0,0 +1,2 @@
#define LOCAL_PROC(x) x

41
collects/compiler/option-unit.ss Normal file
View File

@ -0,0 +1,41 @@
(module option-unit mzscheme
(require (lib "unitsig.ss"))
(require "sig.ss")
(provide compiler:option@)
(define compiler:option@
(unit/sig compiler:option^
(import)
(define propagate-constants (make-parameter #t))
(define assume-primitives (make-parameter #f))
(define stupid (make-parameter #f))
(define vehicles (make-parameter 'vehicles:automatic))
(define vehicles:monoliths (make-parameter 1))
(define seed (make-parameter 2001))
(define max-monoliths 32)
(define max-inline-size (make-parameter 50))
(define unsafe (make-parameter #f))
(define disable-interrupts (make-parameter #f))
(define fixnum-arithmetic (make-parameter #f))
(define verbose (make-parameter #f))
(define debug (make-parameter #f))
(define test (make-parameter #f))
(define clean-intermediate-files (make-parameter #t))
(define max-exprs-per-top-level-set (make-parameter 25))
(define setup-prefix (make-parameter ""))
(define compile-subcollections (make-parameter #t))
(define compile-for-embedded (make-parameter #f))
;; Maybe #f helps for register-poor architectures?
(define unpack-environments (make-parameter #f)))))

12
collects/compiler/option.ss Normal file
View File

@ -0,0 +1,12 @@
(module option mzscheme
(require (lib "unitsig.ss"))
(require "sig.ss")
(require "option-unit.ss")
(define-values/invoke-unit/sig
compiler:option^
compiler:option@)
(provide-signature-elements compiler:option^))

1413
collects/compiler/private/analyze.ss Normal file
View File

File diff suppressed because it is too large Load Diff

371
collects/compiler/private/anorm.ss Normal file
View File

@ -0,0 +1,371 @@
;; A-Normalizer
;; (c) 1996-7 Sebastian Good
;; (c) 1997-8 PLT, Rice University
; This file contains an "a-normalizer" for Zodiac abstract
; syntax trees for Scheme.
; This linear time algorithm is adapted from "The Essence
; of Compiling with Continuations"(Flanagan/Sabry/Duba/Felleisen)
; For unknown historical reasons, this phase is implemented as a
; non-destructive procedure on ASTs.
; An expressions is given a name when
; 1) it is not already the RHS of a let-assignment
; 2) it is not a tail expression
; 3) the value is not known to be ignored
; There's also a special hack for the test part of an
; `if' expression: it might be preserved as an
; application inlined in the `if' form.
; After a-normalizations, all let expressions are "linearized": one
; binding clause for each let-values expression. (Of course, the
; single clause can bind multiple variables.) This linearization does
; not apply to letrec expressions.
;;; Annotatitons: ----------------------------------------------
;; begin0 - lexical-binding for storing 0th expression result
;; with-continuation-mark - lexical-binding for storing body
;; result
;;; ------------------------------------------------------------
(module anorm mzscheme
(require (lib "unitsig.ss")
(lib "list.ss")
(lib "etc.ss"))
(require (lib "zodiac-sig.ss" "syntax"))
(require "sig.ss")
(require "../sig.ss")
(provide anorm@)
(define anorm@
(unit/sig
compiler:anorm^
(import (compiler:option : compiler:option^)
compiler:library^
compiler:cstructs^
(zodiac : zodiac^)
compiler:zlayer^
compiler:driver^)
(define compiler:a-value?
(one-of zodiac:quote-form? zodiac:varref? zodiac:quote-syntax-form?))
(define a-normalize
(letrec ([linearize-let-values
(lambda (ast)
(let ([vars (zodiac:let-values-form-vars ast)])
(cond
[(null? (cdr vars)) ast] ; to prevent N^2 behavior
[else
(let linear ([vars vars]
[vals (zodiac:let-values-form-vals ast)])
(if (null? vars)
(zodiac:let-values-form-body ast)
(zodiac:make-let-values-form (zodiac:zodiac-stx ast)
(make-empty-box)
(list (car vars))
(list (car vals))
(linear (cdr vars)
(cdr vals)))))])))]
[normalize-name
(lambda (ast k)
(normalize-name/special-a-values ast k (lambda (x) #f)))]
[normalize-name/special-a-values
;; The magic goodie that names expressions. If the expression
;; handed in is not an immediate a-value, it is named and the
;; computation continues; syntax correlation exists!
(lambda (ast k special-a-value?)
(a-normalize
ast
(lambda (exp)
(if (or (compiler:a-value? exp) (special-a-value? exp))
(k exp)
(let* ([tname (gensym)]
[tbound (zodiac:make-lexical-binding
(zodiac:zodiac-stx exp)
(make-empty-box)
tname
tname)]
[varref (zodiac:binding->lexical-varref tbound)])
;; hack: #f annotation => not mutable, or anything else
;; (The hack is resolved by the prephase:is-mutable?, etc.
;; procedures.)
(set-annotation! tbound #f)
(let ([body (k varref)])
(zodiac:make-let-values-form
(zodiac:zodiac-stx exp)
(make-empty-box)
(list (list tbound))
(list exp)
body)))))))]
;; This names a list of expressions (eg argument list)
[normalize-name*
(lambda (ast* k)
(if (null? ast*)
(k null)
(normalize-name
(car ast*)
(lambda (term)
(normalize-name* (cdr ast*)
(lambda (term*)
(k (cons term term*))))))))]
[a-normalize
(lambda (ast k)
(when (compiler:option:debug)
(zodiac:print-start! (debug:get-port) ast)
(newline (debug:get-port)))
(cond
;;----------------------------------------------------------------
;; LAMBDA EXPRESSIONS
;; We must make a recursive call to normalize the body.
;; Otherwise, we just pass them on. Lambda must be queried
;; before a-value, since lambda might be an a-value
;;
;; (norm (lambda x M)) -> (lambda x (norm M))
;;
[(zodiac:case-lambda-form? ast)
(k (zodiac:make-case-lambda-form
(zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
(zodiac:case-lambda-form-args ast)
(map (lambda (body)
(a-normalize body identity))
(zodiac:case-lambda-form-bodies ast))))]
;;--------------------------------------------------------------
;; A-VALUES
;; a-values are passed along unharmed. We have to handle
;; lambda separately above, but otherwise
;;
;; (norm a-value) -> a-value
;;
[(compiler:a-value? ast) (k ast)]
;;--------------------------------------------------------------
;; LET EXPRESSIONS
;; with let, we must normalize the bound expressions
;; as well as the body. We only bind one variable per
;; let in Core Scheme, so we have to expand these out
;; Zodiac already tells us if something is unbound, so we
;; can linearize this let as we like.
;;
;; we treat letrec separately to reduce the cost of
;; optimization
;; later. We don't have to look for special cases of set!
;; we do not guarantee a-values in the vals slot of the letrec
;; since we do each of those in its own context, otherwise we
;; can get bindings messed up.
;;
;; (norm (let x M B) k) ->
;; (norm M (lambda V (let x V (norm B k))))
;; (norm (letrec [x M] ... B)) ->
;; (letrec [x (norm M)] ... (norm B))
;;
[(zodiac:let-values-form? ast)
(if (null? (zodiac:let-values-form-vars ast))
(a-normalize (zodiac:let-values-form-body ast) k)
(let ([linear (linearize-let-values ast)])
(a-normalize
(car (zodiac:let-values-form-vals ast))
(lambda (V)
(zodiac:make-let-values-form
(zodiac:zodiac-stx linear)
(zodiac:parsed-back linear)
(zodiac:let-values-form-vars
linear)
(list V)
(a-normalize
(zodiac:let-values-form-body
linear)
k))))))]
[(zodiac:letrec-values-form? ast)
(let ([vals (map (lambda (val) (a-normalize val identity))
(zodiac:letrec-values-form-vals ast))])
(zodiac:make-letrec-values-form
(zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
(zodiac:letrec-values-form-vars ast)
vals
(a-normalize (zodiac:letrec-values-form-body ast) k)))]
;;---------------------------------------------------------------
;; IF EXPRESSIONS
;;
;; We do not make a recursive call for the test since it is in the
;; current 'context'. We want only a-values in the test slot,
;; or an application of a primitive function to a-values.
;;
;; We specially allow primitive applications
;; of a-values so the optimizer can recognize tests that can be
;; implemented primitively, e.g., (zero? x)
;;
;; (norm (if A B C) k) ->
;; (name A (lambda test (k (if test (norm B) (norm C)))))
;;
[(zodiac:if-form? ast)
(normalize-name/special-a-values
(zodiac:if-form-test ast)
(lambda (test)
(k (zodiac:make-if-form (zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
test
(a-normalize (zodiac:if-form-then ast)
identity)
(a-normalize (zodiac:if-form-else ast)
identity))))
(lambda (x)
(and (zodiac:app? x)
(let ([fun (zodiac:app-fun x)])
(and (zodiac:top-level-varref? fun)
(varref:has-attribute? fun varref:primitive))))))]
;;----------------------------------------------------------------
;; BEGIN EXPRESSIONS
;;
;; Begins pass through as begins, but every body is
;; a-normalized.
;; We are guaranteed no empty begins
;;
;; (norm (begin A B) k) ->
;; (norm A (lambda first (begin first (norm B k))))
;;
[(zodiac:begin-form? ast)
(k (zodiac:make-begin-form
(zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
(map (lambda (b) (a-normalize b identity))
(zodiac:begin-form-bodies ast))))]
;;----------------------------------------------------------------
;; BEGIN0 EXPRESSIONS
;;
;; The first is named in a special way, and the rest passes through
;;
;; (norm (begin0 A B) k) ->
;; (k (begin0 (norm A identity) (norm B identity)))
;;
[(zodiac:begin0-form? ast)
(let* ([tname (gensym)]
[tbound (zodiac:make-lexical-binding
(zodiac:zodiac-stx ast)
(make-empty-box)
tname
tname)]
[begin0-exp
(zodiac:make-begin0-form
(zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
(list
(a-normalize (zodiac:begin0-form-first ast) identity)
(a-normalize (zodiac:begin0-form-rest ast) identity)))])
(set-annotation! begin0-exp tbound)
(k begin0-exp))]
;;-----------------------------------------------------------
;; MODULE
;;
[(zodiac:module-form? ast)
(k (zodiac:make-module-form
(zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
(zodiac:module-form-name ast)
(zodiac:module-form-requires ast)
(zodiac:module-form-for-syntax-requires ast)
(zodiac:module-form-for-template-requires ast)
(a-normalize (zodiac:module-form-body ast) identity)
#f ; see split-module in driver.ss
(zodiac:module-form-provides ast)
(zodiac:module-form-syntax-provides ast)
(zodiac:module-form-indirect-provides ast)
(zodiac:module-form-kernel-reprovide-hint ast)
(zodiac:module-form-self-path-index ast)))]
;;---------------------------------------------------------------
;; SET! EXPRESSIONS / DEFINE EXPRESSIONS
;;
;; (norm (set! x M)) -> (name M (lambda val (set! x M)))
;; (norm (define x M))->(define x (norm M identity))
;;
[(zodiac:set!-form? ast)
(normalize-name
(zodiac:set!-form-val ast)
(lambda (norm-val)
(k (zodiac:make-set!-form
(zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
(zodiac:set!-form-var ast)
norm-val))))]
[(zodiac:define-values-form? ast)
(k (zodiac:make-define-values-form
(zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
(zodiac:define-values-form-vars ast)
(a-normalize (zodiac:define-values-form-val ast) identity)))]
;;----------------------------------------------------------
;; DEFINE-SYNTAX
;;
[(zodiac:define-syntaxes-form? ast)
(k (zodiac:make-define-syntaxes-form
(zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
(zodiac:define-syntaxes-form-names ast)
(a-normalize (zodiac:define-syntaxes-form-expr ast) identity)))]
;;---------------------------------------------------------------
;; APPLICATIONS
;; We will always apply the a-normalization to the function
;; position of arguments
;; first normalize the function, then the list of arguments
;;
;; (norm (M A ...) k) ->
;; (name M
;; (lambda fun (name* A .. (lambda term .. (fun term ..)))))
[(zodiac:app? ast)
(normalize-name
(zodiac:app-fun ast)
(lambda (norm-fun)
(normalize-name*
(zodiac:app-args ast)
(lambda (norm-terms)
(k (zodiac:make-app (zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
norm-fun
norm-terms))))))]
;;-----------------------------------------------------------
;; WITH-CONTINUATION-MARK
;;
[(zodiac:with-continuation-mark-form? ast)
(normalize-name
(zodiac:with-continuation-mark-form-key ast)
(lambda (key)
(normalize-name
(zodiac:with-continuation-mark-form-val ast)
(lambda (val)
(let* ([tname (gensym)]
[tbound (zodiac:make-lexical-binding
(zodiac:zodiac-stx ast)
(make-empty-box)
tname
tname)]
[wcm (zodiac:make-with-continuation-mark-form
(zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
key val
(a-normalize
(zodiac:with-continuation-mark-form-body ast)
identity))])
(set-annotation! wcm tbound)
(k wcm))))))]
[else (error 'a-normalize "unsupported ~a" ast)]))])
a-normalize)))))

217
collects/compiler/private/base.ss Normal file
View File

@ -0,0 +1,217 @@
(module base mzscheme
(require (lib "unitsig.ss"))
(require "../sig.ss")
(require "sig.ss")
(require (lib "zodiac-sig.ss" "syntax")
(lib "zodiac-unit.ss" "syntax"))
(require (lib "file-sig.ss" "dynext")
(lib "link-sig.ss" "dynext")
(lib "compile-sig.ss" "dynext"))
(require "zlayer.ss"
"library.ss"
"cstructs.ss"
"prephase.ss"
"anorm.ss"
"const.ss"
"known.ss"
"analyze.ss"
"lift.ss"
"closure.ss"
"vehicle.ss"
"rep.ss"
"vmscheme.ss"
"vmphase.ss"
"vmopt.ss"
"vm2c.ss"
"toplevel.ss"
"driver.ss")
;; The core Scheme->C compiler linkage, including everything
;; that's common to MrSpidey and non-MrSpidey compilation.
(provide base@)
(define base@
(compound-unit/sig
(import (COMPILE : dynext:compile^)
(LINK : dynext:link^)
(DFILE : dynext:file^)
(OPTIONS : compiler:option^))
(link
[ZODIAC : zodiac^ (zodiac@)]
[ZLAYER : compiler:zlayer^ (zlayer@
OPTIONS
ZODIAC
CSTRUCTS
DRIVER)]
[LIBRARY : compiler:library^ (library@
ZODIAC)]
[CSTRUCTS : compiler:cstructs^ (cstructs@
LIBRARY
ZODIAC
ZLAYER)]
[PREPHASE : compiler:prephase^ (prephase@
OPTIONS
LIBRARY
CSTRUCTS
ZODIAC
ZLAYER
DRIVER)]
[ANORM : compiler:anorm^ (anorm@
OPTIONS
LIBRARY
CSTRUCTS
ZODIAC
ZLAYER
DRIVER)]
[CONST : compiler:const^ (const@
OPTIONS
LIBRARY
CSTRUCTS
ZODIAC
ANALYZE
ZLAYER
VMSTRUCTS
TOP-LEVEL
DRIVER)]
[KNOWN : compiler:known^ (known@
OPTIONS
LIBRARY
CSTRUCTS
ZODIAC
ZLAYER
PREPHASE
ANORM
CONST
CLOSURE
REP
DRIVER)]
[ANALYZE : compiler:analyze^ (analyze@
OPTIONS
LIBRARY
CSTRUCTS
ZODIAC
ZLAYER
PREPHASE
ANORM
KNOWN
CONST
REP
VM2C
DRIVER)]
[LIFT : compiler:lift^ (lift@
OPTIONS
LIBRARY
CSTRUCTS
ZODIAC
ZLAYER
KNOWN
TOP-LEVEL
ANALYZE
CONST
CLOSURE
DRIVER)]
[CLOSURE : compiler:closure^ (closure@
OPTIONS
LIBRARY
CSTRUCTS
ZODIAC
ZLAYER
CONST
DRIVER)]
[VEHICLE : compiler:vehicle^ (vehicle@
OPTIONS
LIBRARY
CSTRUCTS
ZODIAC
ZLAYER
CONST
KNOWN
CLOSURE
DRIVER)]
[REP : compiler:rep^ (rep@
LIBRARY
CSTRUCTS
ANALYZE
ZODIAC
ZLAYER
CONST
VEHICLE
DRIVER)]
[VMSTRUCTS : compiler:vmstructs^ (vmscheme@
LIBRARY
CSTRUCTS
ZODIAC
ZLAYER
DRIVER)]
[VMPHASE : compiler:vmphase^ (vmphase@
OPTIONS
LIBRARY
CSTRUCTS
ZODIAC
ZLAYER
ANALYZE
CONST
VMSTRUCTS
REP
CLOSURE
VEHICLE
DRIVER)]
[VMOPT : compiler:vmopt^ (vmopt@
OPTIONS
LIBRARY
CSTRUCTS
ZODIAC
ZLAYER
VMSTRUCTS
KNOWN
REP
VMPHASE
DRIVER)]
[VM2C : compiler:vm2c^ (vm2c@
OPTIONS
LIBRARY
CSTRUCTS
ZODIAC
ZLAYER
ANALYZE
CONST
REP
CLOSURE
VEHICLE
VMSTRUCTS
DRIVER)]
[TOP-LEVEL : compiler:top-level^ (toplevel@
LIBRARY
CSTRUCTS)]
[DRIVER : compiler:driver^ (driver@
OPTIONS
LIBRARY
CSTRUCTS
ZODIAC
ZLAYER
PREPHASE
ANORM
KNOWN
ANALYZE
CONST
LIFT
CLOSURE
VEHICLE
REP
VMSTRUCTS
VMPHASE
VMOPT
VM2C
TOP-LEVEL
COMPILE
LINK
DFILE)])
(export (open (DRIVER : compiler:inner^))))))

291
collects/compiler/private/closure.ss Normal file
View File

@ -0,0 +1,291 @@
;; collect closure-making expressions
;; (c) 1996-1997 Sebastian Good
;; (c) 1997-2001 PLT
;; Closure-making expressions, such as lambda, are
;; replaced with explicit make-closure AST nodes.
;; Closures that with empty free-variable sets are replaced
;; with varrefs to a one-time created global closure. These
;; create-once closures are collected into a list for
;; special handling.
;; All closure-making AST nodes, which were replaced with
;; make-closure nodes, are collected into the list
;; compiler:closure-list.
;;; Annotatitons: ----------------------------------------------
;; <no annotation changes>
;;; ------------------------------------------------------------
(module closure mzscheme
(require (lib "unitsig.ss")
(lib "list.ss")
(lib "etc.ss"))
(require (lib "zodiac-sig.ss" "syntax"))
(require "sig.ss")
(require "../sig.ss")
(provide closure@)
(define closure@
(unit/sig
compiler:closure^
(import (compiler:option : compiler:option^)
compiler:library^
compiler:cstructs^
(zodiac : zodiac^)
compiler:zlayer^
compiler:const^
compiler:driver^)
(define compiler:closure-list null)
(define compiler:add-closure!
(lambda (l)
(set! compiler:closure-list
(cons l compiler:closure-list))))
(define (compiler:get-closure-list) compiler:closure-list)
(define-struct (top-level-varref/bind-from-lift zodiac:top-level-varref) (lambda pls?))
;; fully lifted lambdas (i.e., really static, not per-load)
(define compiler:lifted-lambda-vars null)
(define compiler:lifted-lambdas null)
;; one-time closure-creation to be performed per-load
(define compiler:once-closures-list null)
(define compiler:once-closures-globals-list null)
(define (compiler:get-lifted-lambda-vars) compiler:lifted-lambda-vars)
(define (compiler:get-lifted-lambdas) compiler:lifted-lambdas)
(define (compiler:get-once-closures-list) compiler:once-closures-list)
(define (compiler:get-once-closures-globals-list) compiler:once-closures-globals-list)
(define compiler:add-lifted-lambda!
(lambda (lam pls?)
;; Set the closure's liftable field to a new top-level-varref
(let* ([code (get-annotation lam)]
[var (gensym (if pls?
(if (varref:current-invoke-module)
'pmilifted
'pllifted)
'lifted))]
[sv (make-top-level-varref/bind-from-lift
(zodiac:zodiac-stx lam)
(make-empty-box)
var
#f
(box '())
#f
#f
#f
lam
(and pls? (or (varref:current-invoke-module) pls?)))]
[def (zodiac:make-define-values-form
(zodiac:zodiac-stx lam)
(make-empty-box)
(list sv) lam)])
(set-annotation! sv (varref:empty-attributes))
(varref:add-attribute! sv varref:static)
;; Set the procedure annoation's `liftable' field to a list
;; cotaining the sv, which indicates that it was just convrted;
;; (list sv) is changed to sv by a pass in lift.ss.
(set-procedure-code-liftable! code (list sv))
(if pls?
(let ([def (if (varref:current-invoke-module)
(let ([def (zodiac:make-module-form
(zodiac:zodiac-stx def)
(make-empty-box)
#f #f #f #f
def #f
#f #f #f #f #f)])
(set-annotation!
def
(let ([mi (varref:current-invoke-module)])
(make-module-info mi
#f
(if (varref:module-invoke-syntax? mi)
'syntax-body
'body))))
def)
def)])
(let ([mi (varref:current-invoke-module)])
(varref:add-attribute! sv (or mi varref:per-load-static))
((if mi
(lambda (v) (compiler:add-per-invoke-static-list! v mi))
compiler:add-per-load-static-list!)
var)
(set! compiler:once-closures-list (cons def compiler:once-closures-list))
(set! compiler:once-closures-globals-list (cons (code-global-vars code) compiler:once-closures-globals-list))))
(begin
(set! compiler:lifted-lambda-vars (cons sv compiler:lifted-lambda-vars))
(set! compiler:lifted-lambdas (cons def compiler:lifted-lambdas)))))))
(define (compiler:init-once-closure-lists!)
(set! compiler:once-closures-list null)
(set! compiler:once-closures-globals-list null))
(define (compiler:init-closure-lists!)
(set! compiler:closure-list null)
(set! compiler:lifted-lambda-vars null)
(compiler:init-once-closure-lists!)
(compiler:init-lifted-lambda-list!))
(define (compiler:init-lifted-lambda-list!)
(set! compiler:lifted-lambdas null))
(define closure-expression!
(letrec
([transform-closure!
(lambda (ast args)
(compiler:add-closure! ast)
(let* ([code (get-annotation ast)]
[name (closure-code-name code)]
[free (code-free-vars code)]
[mk-closure (make-compiler:make-closure
(zodiac:zodiac-stx ast)
ast free args
name)])
mk-closure))]
[transform!
(lambda (ast)
(cond
;;------------------------------------------------------------------
;; CONSTANTS
;;
[(zodiac:quote-form? ast) ast]
;;------------------------------------------------------------------
;; VARIABLE REFERENCES
;;
[(zodiac:varref? ast) ast]
;;------------------------------------------------------------------
;; LAMBDA EXPRESSIONS
;;
;; We turn this into a make-closure form and catalogue the code body
;; we also decide which vehicle in which to put the body
;;
[(zodiac:case-lambda-form? ast)
(zodiac:set-case-lambda-form-bodies! ast
(map (lambda (body)
(transform! body))
(zodiac:case-lambda-form-bodies ast)))
(transform-closure! ast null)]
;;------------------------------------------------------------------
;; LET EXPRESSIONS
;;
[(zodiac:let-values-form? ast)
(zodiac:set-let-values-form-vals!
ast (map transform! (zodiac:let-values-form-vals ast)))
(zodiac:set-let-values-form-body!
ast (transform! (zodiac:let-values-form-body ast)))
ast]
[(zodiac:letrec-values-form? ast)
(zodiac:set-letrec-values-form-vals!
ast
(map transform! (zodiac:letrec-values-form-vals ast)))
(zodiac:set-letrec-values-form-body!
ast (transform! (zodiac:letrec-values-form-body ast)))
ast]
;;-----------------------------------------------------------------
;; IF EXPRESSIONS
;;
[(zodiac:if-form? ast)
(zodiac:set-if-form-test! ast (transform! (zodiac:if-form-test ast)))
(zodiac:set-if-form-then! ast (transform! (zodiac:if-form-then ast)))
(zodiac:set-if-form-else! ast (transform! (zodiac:if-form-else ast)))
ast]
;;------------------------------------------------------------------
;; BEGIN EXPRESSIONS
;;
[(zodiac:begin-form? ast)
(map! transform! (zodiac:begin-form-bodies ast))
ast]
;;------------------------------------------------------------------
;; BEGIN0 EXPRESSIONS
;;
[(zodiac:begin0-form? ast)
(zodiac:set-begin0-form-first!
ast (transform! (zodiac:begin0-form-first ast)))
(zodiac:set-begin0-form-rest!
ast (transform! (zodiac:begin0-form-rest ast)))
ast]
;;------------------------------------------------------------------
;; DEFINE/SET! EXPRESSIONS
;;
[(zodiac:set!-form? ast)
(zodiac:set-set!-form-val! ast (transform! (zodiac:set!-form-val ast)))
ast]
[(zodiac:define-values-form? ast)
(zodiac:set-define-values-form-val!
ast
(transform! (zodiac:define-values-form-val ast)))
ast]
;;------------------------------------------------------------------
;; DEFINE-SYNTAX
;;
[(zodiac:define-syntaxes-form? ast)
(zodiac:set-define-syntaxes-form-expr!
ast
(transform! (zodiac:define-syntaxes-form-expr ast)))
ast]
;;-----------------------------------------------------------------
;; APPLICATIONS
;;
;; Now we should be applying closures to arguments. The actual
;; extraction of code and environment parts will happen in the
;; vm translation
;;
[(zodiac:app? ast)
(zodiac:set-app-fun! ast (transform! (zodiac:app-fun ast)))
(zodiac:set-app-args! ast (map transform! (zodiac:app-args ast)))
ast]
;;-------------------------------------------------------------------
;; WITH-CONTINUATION-MARK
;;
;;
[(zodiac:with-continuation-mark-form? ast)
(zodiac:set-with-continuation-mark-form-key!
ast
(transform! (zodiac:with-continuation-mark-form-key ast)))
(zodiac:set-with-continuation-mark-form-val!
ast
(transform! (zodiac:with-continuation-mark-form-val ast)))
(zodiac:set-with-continuation-mark-form-body!
ast
(transform! (zodiac:with-continuation-mark-form-body ast)))
ast]
;;-----------------------------------------------------------
;; MODULE
;;
[(zodiac:module-form? ast)
(zodiac:set-module-form-body!
ast
(transform! (zodiac:module-form-body ast)))
ast]
[else (compiler:internal-error
ast
(format
"closure-expression: form not supported: ~a" ast))]))])
(lambda (ast) (transform! ast)))))))

625
collects/compiler/private/const.ss Normal file
View File

@ -0,0 +1,625 @@
;; constant construction code generator
;; (c) 1996-7 Sebastian Good
;; (c) 1997-8 PLT, Rice University
; Handles code-generation for constructing constants.
; Symbols and floating point numbers are handled specially,
; in a way that allows the generated C code to be both
; efficient and small.
; Other kinds of constants are constrcted by generating code
; that is prefixed onto the beginning of the program.
(module const mzscheme
(require (lib "unitsig.ss")
(lib "list.ss")
(lib "etc.ss"))
(require (lib "zodiac-sig.ss" "syntax")
(lib "stx.ss" "syntax"))
(require "sig.ss")
(require "../sig.ss")
(provide const@)
(define const@
(unit/sig compiler:const^
(import (compiler:option : compiler:option^)
compiler:library^
compiler:cstructs^
(zodiac : zodiac^)
compiler:analyze^
compiler:zlayer^
compiler:vmstructs^
compiler:top-level^
compiler:driver^)
(define const:symbol-table (make-hash-table))
(define const:symbol-counter 0)
(define const:inexact-table (make-hash-table))
(define const:inexact-counter 0)
(define const:number-table (make-hash-table))
(define const:string-table (make-hash-table))
(define const:bytes-table (make-hash-table))
(define const:string-counter 0)
(define (const:get-symbol-table) const:symbol-table)
(define (const:get-symbol-counter) const:symbol-counter)
(define (const:get-inexact-table) const:inexact-table)
(define (const:get-inexact-counter) const:inexact-counter)
(define (const:get-string-table) const:string-table)
(define (const:get-bytes-table) const:bytes-table)
(define vector-table (make-hash-table))
(define compiler:static-list null)
(define compiler:per-load-static-list null)
(define compiler:per-invoke-static-list null)
(define (compiler:get-static-list) compiler:static-list)
(define (compiler:get-per-load-static-list) compiler:per-load-static-list)
(define (compiler:get-per-invoke-static-list) compiler:per-invoke-static-list)
(define new-uninterned-symbols null) ; list of (cons sym pos)
(define syntax-strings null) ; list of syntax-string structs
(define (const:init-tables!)
(set! const:symbol-table (make-hash-table))
(set! const:symbol-counter 0)
(set! const:inexact-table (make-hash-table))
(set! const:inexact-counter 0)
(set! const:number-table (make-hash-table))
(set! const:string-table (make-hash-table 'equal))
(set! const:bytes-table (make-hash-table 'equal))
(set! const:string-counter 0)
(set! compiler:static-list null)
(set! compiler:per-load-static-list null)
(set! compiler:per-invoke-static-list null)
(set! vector-table (make-hash-table))
(set! new-uninterned-symbols null)
(set! syntax-strings null))
(define (const:intern-string s)
(let ([table
(if (string? s)
const:string-table
const:bytes-table)])
(hash-table-get
table
s
(lambda ()
(begin0
const:string-counter
(hash-table-put! table s const:string-counter)
(set! const:string-counter (add1 const:string-counter)))))))
(define (compiler:add-per-load-static-list! var)
(set! compiler:per-load-static-list
(cons var compiler:per-load-static-list)))
(define (compiler:add-per-invoke-static-list! var mi)
(set! compiler:per-invoke-static-list
(cons (cons var mi) compiler:per-invoke-static-list)))
(define-values (const:the-per-load-statics-table
const:per-load-statics-table?)
(let-struct const:per-load-statics-table ()
(values (make-const:per-load-statics-table)
const:per-load-statics-table?)))
(define (wrap-module-definition def mi)
(let ([def (zodiac:make-module-form
(zodiac:zodiac-stx def)
(make-empty-box)
#f #f #f #f
def #f
#f #f #f #f #f)])
(set-annotation!
def
(make-module-info mi
#f
(if (varref:module-invoke-syntax? mi)
'syntax-body
'body)))
def))
;; we need to make this in a-normalized, analyzed form from the beginning
(define compiler:add-const!
(lambda (code attr)
(let* ([var (gensym 'const)]
[sv (zodiac:make-top-level-varref
(zodiac:zodiac-stx code)
(make-empty-box)
var
#f
(box '())
#f
#f
#f)]
[def (zodiac:make-define-values-form
(zodiac:zodiac-stx code)
(make-empty-box) (list sv) code)])
(set-annotation! sv (varref:empty-attributes))
(varref:add-attribute! sv varref:static)
(varref:add-attribute! sv attr)
(cond
[(eq? attr varref:per-load-static)
(set! compiler:per-load-static-list
(cons var compiler:per-load-static-list))
(compiler:add-local-per-load-define-list! def)]
[(varref:module-invoke? attr)
(set! compiler:per-invoke-static-list
(cons (cons var attr) compiler:per-invoke-static-list))
(let ([def (wrap-module-definition def attr)])
(compiler:add-local-per-invoke-define-list! def))]
[else
(set! compiler:static-list (cons var compiler:static-list))
(compiler:add-local-define-list! def)])
sv)))
(define compiler:get-special-const!
(lambda (ast sym attrib table counter)
(let ([v (hash-table-get table sym (lambda () #f))])
(if v
(values v counter)
(let ([sv (zodiac:make-top-level-varref
(and ast (zodiac:zodiac-stx ast))
(make-empty-box)
(string->symbol (number->string counter))
#f
(box '())
#f
#f
#f)])
(set-annotation! sv (varref:empty-attributes))
(varref:add-attribute! sv attrib)
(varref:add-attribute! sv varref:static)
(hash-table-put! table sym sv)
(values sv (add1 counter)))))))
(define compiler:get-symbol-const!
(lambda (ast sym)
(let-values ([(sv c) (compiler:get-special-const! ast sym varref:symbol
const:symbol-table
const:symbol-counter)])
(when (c . > . const:symbol-counter)
(unless (eq? sym (string->symbol (symbol->string sym)))
(set! new-uninterned-symbols (cons
(cons sym const:symbol-counter)
new-uninterned-symbols)))
(set! const:symbol-counter c))
sv)))
(define (get-new-uninterned-symbols!)
(begin0
new-uninterned-symbols
(set! new-uninterned-symbols null)))
(define-struct syntax-string (str mi uposes ustart id))
(define (compiler:add-syntax-string! str mi uninterned-positions uninterned-start)
(let ([naya (make-syntax-string str mi uninterned-positions uninterned-start
(length syntax-strings))])
(set! syntax-strings (cons naya syntax-strings))
naya))
(define (const:get-syntax-strings)
syntax-strings)
(define compiler:get-inexact-real-const!
(lambda (v ast)
(let ([sym (string->symbol (number->string v))])
(let-values ([(sv c) (compiler:get-special-const! ast sym varref:inexact
const:inexact-table
const:inexact-counter)])
(set! const:inexact-counter c)
sv))))
(define compiler:re-quote
(lambda (ast)
(zodiac:make-quote-form (zodiac:zodiac-stx ast)
(make-empty-box)
ast)))
;; [make this in analyzed form...]
(define compiler:make-const-constructor
(lambda (ast constructor-name args)
(let* ([v (zodiac:make-top-level-varref
;; FIXME?: wrong syntax
(zodiac:zodiac-stx ast)
(make-empty-box)
constructor-name
'#%kernel
(box '())
#f
#f
#f)]
[app (zodiac:make-app
(zodiac:zodiac-stx ast)
(make-empty-box)
v
args)])
(set-annotation! v (varref:empty-attributes))
(varref:add-attribute! v varref:primitive)
(set-annotation! app (make-app #f #t constructor-name))
(block:register-max-arity! (get-s:file-block) (length args))
(compiler:add-global-varref! v)
(compiler:add-primitive-varref! v)
app)))
(define ht-eol (gensym))
(define (get-hash-id elem)
(cond
[(zodiac:quote-form? elem) (let ([o (zodiac:quote-form-expr elem)])
(if (number? (zodiac:zread-object o))
(zodiac:zread-object o)
o))]
[else elem]))
(define (find-immutable-vector constructor elems)
(let ([ht (hash-table-get vector-table constructor (lambda () #f))])
(and ht
(let loop ([ht ht][l elems])
(if (null? l)
(hash-table-get ht ht-eol (lambda () #f))
(let ([ht (hash-table-get ht (get-hash-id (car l)) (lambda () #f))])
(and ht (loop ht (cdr l)))))))))
(define (remember-immutable-vector constructor elems const)
(let ([ht (hash-table-get vector-table constructor make-hash-table)])
(hash-table-put! vector-table constructor ht)
(let loop ([ht ht][l elems])
(if (null? l)
(hash-table-put! ht ht-eol const)
(let* ([hash-id (get-hash-id (car l))]
[htn (hash-table-get ht hash-id make-hash-table)])
(hash-table-put! ht hash-id htn)
(loop htn (cdr l)))))))
(define (construct-vector-constant ast constructor known-immutable?)
(let* ([elems (map (lambda (x)
(compiler:construct-const-code!
(zodiac:make-zread x)
known-immutable?))
(let ([p (zodiac:zodiac-stx ast)])
(or (syntax->list p)
(and (vector? (syntax-e p))
(vector->list (syntax-e p)))
(and (or (regexp? (syntax-e p))
(byte-regexp? (syntax-e p)))
(list (datum->syntax-object #f (object-name (syntax-e p)))))
(let loop ([p p])
(cond
[(stx-pair? p)
(cons (stx-car p)
(loop (stx-cdr p)))]
[else
(list p)])))))]
[known-immutable? (or known-immutable? (null? elems))])
(or (and known-immutable?
(find-immutable-vector constructor elems))
(let ([const (compiler:add-const!
(compiler:make-const-constructor
ast
constructor
elems)
(if known-immutable?
varref:static
varref:per-load-static))])
(when known-immutable?
(remember-immutable-vector constructor elems const))
const))))
(define (big-and-simple/cyclic? datum size ht)
(cond
[(null? datum) (negative? size)]
[(hash-table-get ht datum (lambda () #f)) 'cyclic]
[(pair? datum)
(hash-table-put! ht datum #t)
(let ([v (big-and-simple/cyclic? (car datum) 0 ht)])
(if (eq? v 'cyclic)
'cyclic
(let ([v2 (big-and-simple/cyclic? (cdr datum) (sub1 size) ht)])
(if (eq? v2 'cyclic)
'cyclic
(and v v2)))))]
[(vector? datum)
(let ([len (vector-length datum)])
(and (hash-table-put! ht datum #t)
(let loop ([i 0][so-far? #f])
(if (= i len)
so-far?
(let ([v (big-and-simple/cyclic? (vector-ref datum i) (- size i) ht)])
(if (eq? v 'cyclic)
'cyclic
(loop (add1 i) (or so-far? v))))))))]
[(hash-table? datum) 'cyclic] ;; assume content is ok and cyclic
[(and (negative? size)
(or (number? datum)
(string? datum)
(bytes? datum)
(symbol? datum)
(boolean? datum)
(regexp? datum)
(byte-regexp? datum)))
#t]
[else #f]))
(define-struct compiled-string (id len))
(define (construct-big-constant ast stx known-immutable?)
(let* ([s (let ([p (open-output-bytes)])
(write (compile `(quote ,stx)) p)
(get-output-bytes p))]
[id (const:intern-string s)])
(let ([const (compiler:add-const!
(compiler:re-quote
(zodiac:make-zread
(datum->syntax-object
#f
;; HACK!
(make-compiled-string id (bytes-length s)))))
(if known-immutable?
varref:static
varref:per-load-static))])
const)))
(define compiler:construct-const-code!
(lambda (ast known-immutable?)
(cond
;; base case - constant does not have to be built
[(vm:literal-constant? ast) (compiler:re-quote ast)]
;; c-lambda (kindof a hack)
[(c-lambda? ast)
(compiler:add-const! (compiler:re-quote
(zodiac:make-zread
(datum->syntax-object
#f
ast ;; See vm2c.ss
#f)))
varref:static)]
;; a box has a constant inside it to mess with, yet it's
;; still a scalar
[(box? (zodiac:zread-object ast))
(compiler:add-const! (compiler:make-const-constructor
ast
'box
(list (compiler:construct-const-code!
(zodiac:make-zread (unbox (zodiac:zread-object ast)))
known-immutable?)))
(if known-immutable?
varref:static
varref:per-load-static))]
;; Do symbols at most once:
[(symbol? (zodiac:zread-object ast))
(let ([sym (zodiac:zread-object ast)])
(compiler:get-symbol-const! ast sym))]
;; Numbers that must be built
[(number? (zodiac:zread-object ast))
(let ([n (zodiac:zread-object ast)])
(if (and (inexact? n) (eqv? 0 (imag-part n))
(not (member n '(+inf.0 -inf.0 +nan.0 -0.0))))
(compiler:get-inexact-real-const! n ast)
(let ([sym (string->symbol (number->string n))])
(hash-table-get const:number-table
sym
(lambda ()
(let ([num (compiler:add-const!
(compiler:re-quote ast)
varref:static)])
(hash-table-put! const:number-table sym num)
num))))))]
;; big/cyclic constants
[(big-and-simple/cyclic? (syntax-object->datum (zodiac:zodiac-stx ast)) 20 (make-hash-table))
(construct-big-constant ast (zodiac:zodiac-stx ast) known-immutable?)]
;; lists
[(stx-list? (zodiac:zodiac-stx ast))
(construct-vector-constant ast 'list known-immutable?)]
;; improper lists
[(pair? (zodiac:zread-object ast))
(construct-vector-constant ast 'list* known-immutable?)]
[(void? (zodiac:zread-object ast))
(zodiac:make-special-constant 'void)]
;; vectors
[(vector? (zodiac:zread-object ast))
(construct-vector-constant ast 'vector known-immutable?)]
;; regexp
[(regexp? (zodiac:zread-object ast))
(construct-vector-constant ast 'regexp #t)]
[(byte-regexp? (zodiac:zread-object ast))
(construct-vector-constant ast 'byte-regexp #t)]
;; comes from module paths in analyze:
[(module-path-index? (zodiac:zread-object ast))
(let-values ([(path base) (module-path-index-split (zodiac:zread-object ast))])
(if (or path base)
(let ([wrap (lambda (v)
(zodiac:make-zread
(datum->syntax-object
#f
v
(zodiac:zodiac-stx ast))))])
(compiler:add-const! (compiler:make-const-constructor
ast
'module-path-index-join
(list (compiler:construct-const-code!
(wrap path)
known-immutable?)
(compiler:construct-const-code!
(wrap base)
known-immutable?)))
(or (varref:current-invoke-module)
(if known-immutable?
varref:static
varref:per-load-static))))
(zodiac:make-special-constant 'self_modidx)))]
;; other atomic constants that must be built
[else
(when (or (string? (zodiac:zread-object ast))
(bytes? (zodiac:zread-object ast)))
(const:intern-string (zodiac:zread-object ast)))
(compiler:add-const! (compiler:re-quote ast)
varref:static)])))
(define syntax-constants null)
(define (const:reset-syntax-constants!)
(set! syntax-constants null))
(define (const:make-syntax-constant stx)
;; Marhsall to a string constant, and read back out at run-time.
;; For sharing of syntax info, put all syntax objects for a given
;; top-level expression into one marshal step.
(let* ([var (gensym 'conststx)]
[sv (zodiac:make-top-level-varref
stx
(make-empty-box)
var
#f
(box '())
#f
#f
#f)])
(set! syntax-constants (cons (cons sv stx)
syntax-constants))
(set-annotation! sv (varref:empty-attributes))
(varref:add-attribute! sv varref:static)
(varref:add-attribute! sv (or (varref:current-invoke-module)
varref:per-load-static))
(if (varref:current-invoke-module)
(set! compiler:per-invoke-static-list
(cons (cons var (varref:current-invoke-module))
compiler:per-invoke-static-list))
(set! compiler:per-load-static-list
(cons var compiler:per-load-static-list)))
sv))
;; We collect syntax objects together to share the cost of of
;; the rename tables. More gnerally, to get the expansion-time
;; info to use-time, we use the bytecode writer built into
;; MzScheme, putting multiple syntax objects together into a
;; syntax vector. The scheme_eval_compiled_stx_string() will
;; unpack it, and perform any necessary phase shifts. To perform
;; the module mapping associated with the phase shift,
;; scheme_eval_compiled_stx_string() expects the "syntax" vector
;; to have a module index path (the "self" path) as its last
;; element.
;; Returns a max-arity.
(define (const:finish-syntax-constants!)
(if (null? syntax-constants)
0
(let* ([s (open-output-bytes)]
[uninterned-symbol-info (get-new-uninterned-symbols!)]
[c (compile `(quote-syntax ,(list->vector
(let ([l (map cdr syntax-constants)]
[mi (varref:current-invoke-module)])
(append
l
(map car uninterned-symbol-info) ; car gets the syms
(if mi
(list (varref:module-invoke-context-path-index mi))
null))))))])
(display c s)
(let ([syntax-string (get-output-bytes s)])
(let* ([strvar (compiler:add-syntax-string!
syntax-string
(varref:current-invoke-module)
(map cdr uninterned-symbol-info) ; cdr gets positions
(length syntax-constants))] ; starting place for symbols
[vecvar (gensym 'conststxvec)]
[sv (zodiac:make-top-level-varref
#f
(make-empty-box)
vecvar
#f
(box '())
#f
#f
#f)])
(set-annotation! sv (varref:empty-attributes))
(varref:add-attribute! sv varref:static)
(varref:add-attribute! sv (or (varref:current-invoke-module)
varref:per-load-static))
(if (varref:current-invoke-module)
(set! compiler:per-invoke-static-list
(cons (cons vecvar (varref:current-invoke-module))
compiler:per-invoke-static-list))
(set! compiler:per-load-static-list
(cons vecvar compiler:per-load-static-list)))
((if (varref:current-invoke-module)
compiler:add-local-per-invoke-define-list!
compiler:add-local-per-load-define-list!)
(let ([def
(zodiac:make-define-values-form
#f
(make-empty-box) (list sv)
(compiler:re-quote
(zodiac:make-zread
(datum->syntax-object
#f
strvar ;; <------ HACK! See "HACK!" in vm2c.ss
#f))))])
(if (varref:current-invoke-module)
(wrap-module-definition def (varref:current-invoke-module))
def)))
;; Create construction code for each
;; syntax variable:
(let loop ([l syntax-constants]
[pos 0])
(unless (null? l)
(let ([app (zodiac:make-app
(cdar l)
(make-empty-box)
(zodiac:make-top-level-varref
(cdar l)
(make-empty-box)
'vector-ref
'#%kernel
(box '())
#f
#f
#f)
(list
sv
(compiler:re-quote
(zodiac:make-zread
(datum->syntax-object
#f
pos
(cdar l))))))])
(set-annotation! app (make-app #f #t 'vector-ref))
((if (varref:current-invoke-module)
compiler:add-local-per-invoke-define-list!
compiler:add-local-per-load-define-list!)
(let ([def
(zodiac:make-define-values-form
(cdar l)
(make-empty-box) (list (caar l))
app)])
(if (varref:current-invoke-module)
(wrap-module-definition def (varref:current-invoke-module))
def)))
(loop (cdr l) (add1 pos)))))))
(set! syntax-constants null)
;; We make an application with 2 arguments
2))))))

264
collects/compiler/private/cstructs.ss Normal file
View File

@ -0,0 +1,264 @@
;; Compiler structures
;; (c) 1996-1997 Sebastian Good
;; (c) 1997-2001 PLT
;; Mostly structure definitions, mostly for annotations.
(module cstructs mzscheme
(require (lib "unitsig.ss")
(lib "list.ss")
(lib "etc.ss"))
(require (lib "zodiac-sig.ss" "syntax"))
(require "sig.ss")
(require "../sig.ss")
(provide cstructs@)
(define cstructs@
(unit/sig compiler:cstructs^
(import compiler:library^
(zodiac : zodiac^)
compiler:zlayer^)
;;----------------------------------------------------------------------------
;; VARREF ATTRIBUTES
;; Used as the annotation for zodiac:varref objects
(define-struct va (flags invoke-module))
(define (varref:empty-attributes) (make-va 0 #f))
(define (varref:add-attribute! ast attr)
(let ([va (get-annotation ast)])
(let ([attr (if (varref:module-invoke? attr)
(begin
(set-va-invoke-module! va attr)
varref:per-invoke-static)
attr)])
(set-va-flags! va (bitwise-ior attr (va-flags va))))))
(define (varref:has-attribute? ast attr)
(let ([anno (get-annotation ast)])
(and (va? anno) (positive? (bitwise-and (va-flags anno) attr)))))
(define (varref:invoke-module ast)
(let ([anno (get-annotation ast)])
(and (va? anno) (va-invoke-module anno))))
(define varref:static 1)
(define varref:per-load-static 2)
(define varref:per-invoke-static 4)
(define varref:primitive 8)
(define varref:symbol 16)
(define varref:inexact 32)
(define varref:env 64)
(define varref:in-module 128)
(define varref:module-stx-string 256)
(define mi-counter -1)
(define-struct varref:module-invoke (id syntax? context-path-index))
(define (make-module-invokes self-path-index)
(set! mi-counter (add1 mi-counter))
(values (make-varref:module-invoke mi-counter #f self-path-index)
(make-varref:module-invoke mi-counter #t self-path-index)))
(define (get-num-module-invokes)
(add1 mi-counter))
(define (is-module-invoke? mi num)
(and (varref:module-invoke? mi)
(= num (varref:module-invoke-id mi))))
(define (varref:reset-module-id!) (set! mi-counter -1))
;;----------------------------------------------------------------------------
;; AST NODES
;; New AST nodes to augment the zodiac set:
;; AST node for the creation of a closure (replaces, e.g., a lambda expression)
(define-struct (compiler:make-closure zodiac:zodiac) (lambda free-vars args name))
;;----------------------------------------------------------------------------
;; ANNOTATION STRUCTURES
;;
;; mzc annotation for a zodiac:binding, installed in the `known'
;; analysis phase
(define-struct binding (rec? ; part of a letrec recursive binding set
mutable? ; set!ed? (but not for unit or letrec definitions)
unit-i/e? ; is imported/exported (including uses by invoke)
anchor ; zodiac:binding - anchor binding for this binding
letrec-set?; set! to implement a letrec
ivar? ; is a class ivar?
known? ; known to have a fixed value? (i.e., it's not
;; mutated or detectably #<undefined> for a while?)
val
;; ``known'' value as an abitrary AST (so it's
;; really only *known* if this is a constant
known-but-used?
;; known value used in an improper way?
;; if so, always preserve the variable (i.e., don't
;; propagate it away entirely)
rep ; reprsentation (#f until rep-choosing phase)
))
;; copy a binding record
(define (copy-binding b)
(make-binding (binding-rec? b)
(binding-mutable? b)
(binding-unit-i/e? b)
(binding-anchor b)
(binding-letrec-set? b)
(binding-ivar? b)
(binding-known? b)
(binding-val b)
(binding-known-but-used? b)
(binding-rep b)))
(define (copy-binding-for-light-closures b)
(make-binding #f
#f
#f
#f
#f
#f
(binding-known? b) (binding-val b)
#f
#f))
(define binder:empty-anno
(make-binding #f
#f
#f
#f
#f
#f
#f
#f
#f
#f))
(define-struct code (; The following fields, XXX-vars, are
;; all sets of zodiac:bindings
free-vars
;; lexical variables that are free in the
;; code (i.e., kept in a closure)
local-vars
;; variables introduced during the evaluation
;; of the code; includes, for example, the argument
;; variables if this is a lambda closure
global-vars
;; ``global'' variables used by this code;
;; we capture globals that are specific to
;; the namespace at load-time
used-vars
;; local variables that are eventually used in
;; an expression after they are introduced in the
;; code
captured-vars
;; free and used variables that are free within
;; a closure that is created by this code
parent
;; #f if this is a top-level expression, container
;; code otherwise
case-parent
;; #f, unless it's a code in a case-lambda, then
;; it's the case-code containing this code
children
;; list of children code structures
))
;; Structure for the annotation given to closures, such
;; as lambdas or units. The actual annotation will be
;; an instance of a sub-type of `code', depending on
;; the kind of closure.
(define-struct (closure-code code)
(; Representation and implementation info
rep
alloc-rep
label ; integer - id within vehicle
vehicle ; integer - vehicle id
max-arity
;; max number of args in applications
;; within the closure (which is unrelated
;; to the number of arguments used to invoke
;; this closure, if it happens to be a
;; lambda)
return-multi
;; #f (always single), #t (never single),
;; or 'possible
name
;; inferred name - can be #f, a varref, a binding,
;; or a list of inferred names.
;; (see also vm->c:extract-inferred-name)
))
;; Annotation type for case-lambda closures:
(define-struct (procedure-code closure-code)
(case-codes
;; A list of case-code records
case-arities
;; An integer indicating which
;; arity record in compiler:case-lambdas
;; contains MzScheme information for
;; the arity of the case-lambda. For
;; single-case lambdas, this is #f
;; because the arity information is
;; inlined.
liftable
;; top-level-varref => procedure is lifted
method?
;; #t => arity errors hide first argument
;; (triggered by 'method-arity-error property)
))
(define-struct (case-code code)
(; Does the compilation of this case use continue?
;; If so, output the case body within while(1){...}
has-continue?))
;; annotations given to zodiac:app AST nodes
(define-struct app (tail?
;; tail application?
prim?
;; application of a known primitive?
prim-name
;; MzScheme name for the known primitive, or #f
))
(define-struct module-info (invoke
;; a module-invoke record
syntax-invoke
;; another module-invoke record
part
;; 'body, 'syntax-body, or 'constructor
))
(define varref:current-invoke-module (make-parameter #f))
;;----------------------------------------------------------------------------
;; ACCESSOR
;;
;; Retrives the *annotation* of a zodiac:binding for a zodiac:bound-varref.
;; (Compare to zodiac:bound-varref-binding, which returns the
;; zodiac:binding itself, rather than its annotation.)
(define compiler:bound-varref->binding
(compose get-annotation zodiac:bound-varref-binding))
;;----------------------------------------------------------------------------
;; special constants
;;
(define-struct c-lambda (function-name scheme-name body arity))
;;----------------------------------------------------------------------------
;; error/warning structures
;;
(define-struct compiler:message (ast message))
(define-struct (compiler:error-msg compiler:message) ())
(define-struct (compiler:fatal-error-msg compiler:message) ())
(define-struct (compiler:internal-error-msg compiler:message) ())
(define-struct (compiler:warning-msg compiler:message) ()))))

1413
collects/compiler/private/driver.ss Normal file
View File

File diff suppressed because it is too large Load Diff

7
collects/compiler/private/embed.ss Normal file
View File

@ -0,0 +1,7 @@
(module embed mzscheme
(require (lib "embed.ss" "compiler"))
(define mzc:make-embedding-executable make-embedding-executable)
(define mzc:embedding-executable-add-suffix embedding-executable-add-suffix)
(provide mzc:make-embedding-executable
mzc:embedding-executable-add-suffix))

3
collects/compiler/private/info.ss Normal file
View File

@ -0,0 +1,3 @@
(module info (lib "infotab.ss" "setup")
(define name "mzc private"))

566
collects/compiler/private/known.ss Normal file
View File

@ -0,0 +1,566 @@
;; Known-value analysis
;; (c) 1996-1997 Sebastian Good
;; (c) 1997-2001 PLT
;; Sets the the real annotation for zodiac:binding AST nodes,
;; setting the known? and known-val fields as possible.
;; Known-value analysis is used for constant propagation, but
;; more importantly, it's used for compiling tail recursion
;; as a goto. mzc can only compile tail recursion as a goto
;; when it knows the actual destination of the jump.
;; Note that ``known'' means we know an AST that provides the
;; value; this AST could be arbitrarily complex, so we really
;; only know the value if the known AST is simple enough.
;;; Annotatitons: ----------------------------------------------
;; binding - `binding' structure (replaces prephase
;; binding-properties structure)
;; application - `app' structure
;;; ------------------------------------------------------------
(module known mzscheme
(require (lib "unitsig.ss")
(lib "list.ss")
(lib "etc.ss"))
(require (lib "zodiac-sig.ss" "syntax"))
(require "sig.ss")
(require "../sig.ss")
(provide known@)
(define known@
(unit/sig compiler:known^
(import (compiler:option : compiler:option^)
compiler:library^
compiler:cstructs^
(zodiac : zodiac^)
compiler:zlayer^
compiler:prephase^
compiler:anorm^
compiler:const^
compiler:closure^
compiler:rep^
compiler:driver^)
;; helper functions to create a binding annotation
(define make-known-binding
(lambda (bound val)
(make-binding #f (prephase:is-mutable? bound)
'not-unit (prephase:binding-anchor bound)
#f (prephase:is-ivar? bound)
#t val #f #f)))
(define make-unknown-letbound-binding
(lambda (mutable?)
(make-binding #f mutable?
#f #f
#f #f
#f #f #f #f)))
(define make-unknown-binding
(lambda (bound)
(make-binding #f (prephase:is-mutable? bound)
'not-unit (prephase:binding-anchor bound)
#f (prephase:is-ivar? bound)
#f #f #f #f)))
(define make-begin0-binding
(lambda (bound)
(make-binding #f #f #f #f #f #f
#f #f #f (make-rep:atomic 'begin0-saver))))
(define make-wcm-binding
(lambda (bound)
(make-binding #f #f #f #f #f #f
#f #f #f (make-rep:atomic 'wcm-saver))))
;; Determine whether a varref is a known primitive
(define (analyze:prim-fun fun)
(and (zodiac:top-level-varref? fun)
(varref:has-attribute? fun varref:primitive)
(primitive? (namespace-variable-value (zodiac:varref-var fun)))
(zodiac:varref-var fun)))
;; Some prims call given procedures directly, some install procedures
;; to be called later, and some call previously installed procedures.
;; We care abot the installers and callers.
(define prims-that-induce-procedure-calls
'(apply map for-each andmap ormap make-promise
dynamic-wind thread call-in-nested-thread
make-object call-with-values time-apply
call-with-output-file call-with-input-file
with-output-to-file with-input-from-file
exit-handler current-eval current-exception-handler
current-prompt-read current-load
call-with-escape-continuation call-with-current-continuation
current-print port-display-handler port-write-handler
port-print-handler global-port-print-handler
error-display-handler error-escape-handler
port-read-handler error-value->string-handler
call/ec call/cc hash-table-get
hash-table-map hash-table-for-each make-input-port make-output-port))
;; The valueable? predicate is used to determine how many variables
;; are reliably set in a mutually-recursive binding context.
;; Along the way, we set more `known-binding' information in let and letrec.
(define (analyze:valueable? v extra-known-bindings extra-unknown-bindings known-lambdas set-known?)
(let loop ([v v][extra-known-bindings extra-known-bindings])
(cond
[(zodiac:quote-form? v) #t]
[(zodiac:bound-varref? v)
;; the varref must not be unit-i/e?, or it must be in extra-known-bindings
;; and it must not be in extra-unknown-bindings
(let ([zbinding (zodiac:bound-varref-binding v)])
(and (not (memq zbinding extra-unknown-bindings))
(memq zbinding extra-known-bindings)))]
[(zodiac:varref? v) #t]
[(zodiac:case-lambda-form? v) #t]
[(zodiac:begin-form? v)
(andmap (lambda (v) (loop v extra-known-bindings)) (zodiac:begin-form-bodies v))]
[(zodiac:begin0-form? v)
(andmap (lambda (v) (loop v extra-known-bindings)) (zodiac:begin0-form-bodies v))]
[(zodiac:with-continuation-mark-form? v)
(and (loop (zodiac:with-continuation-mark-form-key v) extra-known-bindings)
(loop (zodiac:with-continuation-mark-form-val v) extra-known-bindings)
(loop (zodiac:with-continuation-mark-form-body v) extra-known-bindings))]
[(zodiac:set!-form? v) #f] ; because it changes a variable
[(zodiac:if-form? v)
(and (loop (zodiac:if-form-test v) extra-known-bindings)
(loop (zodiac:if-form-then v) extra-known-bindings)
(loop (zodiac:if-form-else v) extra-known-bindings))]
[(zodiac:let-values-form? v)
(and (andmap (lambda (vars v) (if (loop v extra-known-bindings)
(begin
(when (and set-known?
(= 1 (length vars)))
(prephase:set-known-val! (car vars) v))
#t)
#f))
(zodiac:let-values-form-vars v)
(zodiac:let-values-form-vals v))
(loop (zodiac:let-values-form-body v)
(append (apply append (zodiac:let-values-form-vars v))
extra-known-bindings)))]
[(zodiac:letrec-values-form? v)
(and (andmap (lambda (vars v) (if (loop v extra-known-bindings)
(begin
(when (and set-known?
(= 1 (length vars)))
(prephase:set-known-val! (car vars) v))
#t)
#f))
(zodiac:letrec-values-form-vars v)
(zodiac:letrec-values-form-vals v))
(loop (zodiac:letrec-values-form-body v)
(append (apply append (zodiac:letrec-values-form-vars v))
extra-known-bindings)))]
[(zodiac:app? v)
(let* ([fun (zodiac:app-fun v)]
[primfun (analyze:prim-fun fun)]
[args (zodiac:app-args v)]
[args-ok? (lambda ()
(andmap (lambda (v) (loop v extra-known-bindings))
args))])
(if primfun
;; Check whether the primitive can call any procedures:
(and (not (memq primfun prims-that-induce-procedure-calls))
(args-ok?))
;; Interesting special case: call a known function
(and (loop fun extra-known-bindings)
(args-ok?)
(let ([simple-case-lambda?
;; We know nothing about the args; still valueable?
;; What if we're trying to check a recursive function?
;; If we encounter a cycle, the body is valueable.
(lambda (v)
(or (memq v known-lambdas)
(andmap
(lambda (body) (analyze:valueable?
body
extra-known-bindings
extra-unknown-bindings
(cons v known-lambdas)
#f))
(zodiac:case-lambda-form-bodies v))))])
(cond
[(zodiac:bound-varref? fun)
(let ([v (extract-varref-known-val fun)])
(and v
(cond
[(zodiac:case-lambda-form? v)
(simple-case-lambda? v)]
[(zodiac:top-level-varref? v)
;; Could be a friendly primitive...
(let ([primfun (analyze:prim-fun v)])
(and primfun
(not (memq primfun prims-that-induce-procedure-calls))))]
[else #f])))]
[(zodiac:case-lambda-form? fun) (simple-case-lambda? fun)]
[else #f])))))]
[else #f])))
;; extract-ast-known-value tries to extract a useful value from a known-value AST
(define (extract-ast-known-value v)
(let extract-value ([v v])
(cond
[(zodiac:set!-form? v) (zodiac:make-special-constant 'void)]
[(zodiac:begin-form? v) (extract-value (car (last-pair (zodiac:begin-form-bodies v))))]
[(zodiac:begin0-form? v) (extract-value (car (zodiac:begin0-form-bodies v)))]
[(zodiac:with-continuation-mark-form? v) (extract-value (zodiac:with-continuation-mark-form-body v))]
[(zodiac:let-values-form? v) (extract-value (zodiac:let-values-form-body v))]
[(zodiac:letrec-values-form? v) (extract-value (zodiac:letrec-values-form-body v))]
[(zodiac:app? v)
(let ([fun (analyze:prim-fun (zodiac:app-fun v))])
(if fun
(let ([args (map extract-value (zodiac:app-args v))])
(case fun
[(void) (zodiac:make-special-constant 'void)]
[(char->integer)
(with-handlers ([void (lambda (x) v)])
(let ([args (map (lambda (a) (syntax-e (zodiac:zodiac-stx (zodiac:quote-form-expr a)))) args)])
(let ([new-v (apply (namespace-variable-value fun) args)])
(zodiac:make-quote-form
(zodiac:zodiac-stx v)
(make-empty-box)
(zodiac:structurize-syntax new-v v)))))]
[else v]))
v))]
[(top-level-varref/bind-from-lift? v) (top-level-varref/bind-from-lift-lambda v)]
[(zodiac:bound-varref? v) (extract-ast-known-value (extract-varref-known-val v))]
[else v])))
;; extract-varref-known-val works for bindings, too.
(define (extract-varref-known-val v)
(if (top-level-varref/bind-from-lift? v)
(top-level-varref/bind-from-lift-lambda v)
(let loop ([v v])
(let* ([zbinding (if (zodiac:binding? v)
v
(zodiac:bound-varref-binding v))]
[binding (get-annotation zbinding)]
[result (lambda (v)
(cond
[(top-level-varref/bind-from-lift? v)
(extract-varref-known-val v)]
[(or (zodiac:bound-varref? v)
(zodiac:binding? v))
(loop v)]
[else v]))])
(and binding
(cond
[(binding? binding)
(and (binding-known? binding)
(result (binding-val binding)))]
[else
(result (prephase:known-val zbinding))]))))))
;; analyze-knowns! sets the annotation for binding occurrences, setting information
;; about known variables. Also sets the annotation for applications.
(define analyze-knowns!
(letrec ([analyze!
(lambda (ast)
(when (compiler:option:debug)
(zodiac:print-start! (debug:get-port) ast)
(newline (debug:get-port)))
(cond
;;-----------------------------------------------------------------
;; CONSTANTS (A-VALUES)
[(zodiac:quote-form? ast) ast]
;;-----------------------------------------------------------------
;; VARIABLE REFERENCES (A-VALUES)
;;
[(zodiac:bound-varref? ast) ast]
[(zodiac:top-level-varref? ast) ast]
;;--------------------------------------------------------------------
;; LAMBDA EXPRESSIONS
;; analyze the bodies, and set binding info for the binding vars
;;
[(zodiac:case-lambda-form? ast)
(zodiac:set-case-lambda-form-bodies!
ast
(map
(lambda (args body)
;; annotate each binding with our information
(for-each
(lambda (bound) (set-annotation! bound (make-known-binding bound #f)))
(zodiac:arglist-vars args))
(analyze! body))
(zodiac:case-lambda-form-args ast)
(zodiac:case-lambda-form-bodies ast)))
ast]
;;--------------------------------------------------------------
;; LET EXPRESSIONS
;; Several values may be bound at once, in which case 'known'
;; analysis is not performed.
;;
;; Variables are assumed to be immutable and known, unless
;; proven otherwise; we store this information
;; in the binding structure in the compiler:bound structure.
;;
[(zodiac:let-values-form? ast)
(let* ([val (analyze! (car (zodiac:let-values-form-vals ast)))]
[vars (car (zodiac:let-values-form-vars ast))]
[bindings (map
(lambda (var)
(make-known-binding var (extract-ast-known-value val)))
vars)])
(for-each set-annotation! vars bindings)
(set-car! (zodiac:let-values-form-vals ast) val)
(if (= 1 (length vars))
; this is a one-value binding let
(let* ([var (car vars)])
(when (binding-mutable? (car bindings))
(set-binding-known?! (car bindings) #f)))
; this is a multiple (or zero) value binding let
; the values are unknown to simple analysis so skip
; that stuff;
; nothing is known
(for-each (lambda (binding) (set-binding-known?! binding #f))
bindings))
; analyze the body
(let ([body (analyze! (zodiac:let-values-form-body ast))])
(zodiac:set-let-values-form-body! ast body)))
ast]
;;-----------------------------------------------------------------
;; LETREC EXPRESSIONS
;;
[(zodiac:letrec-values-form? ast)
(let* ([varses (zodiac:letrec-values-form-vars ast)]
[vals (zodiac:letrec-values-form-vals ast)])
; Annotate each binding occurrence
(for-each
(lambda (vars)
(for-each (lambda (var)
(let ([binding (make-unknown-binding var)])
(set-annotation! var binding)))
vars))
varses)
; Mark known letrec-bound vars
(let loop ([varses varses][vals vals][done-vars null])
(unless (null? vals)
(when (analyze:valueable? (car vals) done-vars (apply append varses) null #t)
; Continue known marking
(let ([vars (car varses)])
(when (= 1 (length vars))
(let ([binding (get-annotation (car vars))])
(unless (binding-mutable? binding)
(set-binding-known?! binding #t)
(set-binding-val! binding (car vals)))))
(loop (cdr varses) (cdr vals)
(append vars done-vars))))))
(zodiac:set-letrec-values-form-vals! ast (map analyze! vals))
(zodiac:set-letrec-values-form-body!
ast
(analyze! (zodiac:letrec-values-form-body ast)))
ast)]
;;-----------------------------------------------------
;; IF EXPRESSIONS
;;
;; analyze the 3 branches.
;;
[(zodiac:if-form? ast)
(zodiac:set-if-form-test! ast (analyze! (zodiac:if-form-test ast)))
(let ([then (analyze! (zodiac:if-form-then ast))]
[else (analyze! (zodiac:if-form-else ast))])
(zodiac:set-if-form-then! ast then)
(zodiac:set-if-form-else! ast else)
ast)]
;;--------------------------------------------------------
;; BEGIN EXPRESSIONS
;;
;; analyze the branches
[(zodiac:begin-form? ast)
(let loop ([bodies (zodiac:begin-form-bodies ast)])
(if (null? (cdr bodies))
(let ([e (analyze! (car bodies))])
(set-car! bodies e))
(begin
(set-car! bodies (analyze! (car bodies)))
(loop (cdr bodies)))))
ast]
;;--------------------------------------------------------
;; BEGIN0 EXPRESSIONS
;;
;; analyze the branches
[(zodiac:begin0-form? ast)
(zodiac:set-begin0-form-first! ast (analyze! (zodiac:begin0-form-first ast)))
(zodiac:set-begin0-form-rest! ast (analyze! (zodiac:begin0-form-rest ast)))
(let ([var (get-annotation ast)])
(set-annotation! var (make-begin0-binding var)))
ast]
;;--------------------------------------------------------
;; SET! EXPRESSIONS
;;
;; we analyze the target, which will register it as being
;; mutable or used, as necessary. Then we analyze the value.
;;
[(zodiac:set!-form? ast)
(let ([target (analyze! (zodiac:set!-form-var ast))])
(when (zodiac:bound-varref? target)
(let ([binding (compiler:bound-varref->binding target)])
(unless (binding-mutable? binding)
(compiler:internal-error
target
(string-append
"analyze: variable found in set! but not"
" marked mutable by prephase!")))
(when (binding-mutable? binding)
(set-binding-known?! binding #f))))
(zodiac:set-set!-form-var! ast target)
(zodiac:set-set!-form-val!
ast
(analyze! (zodiac:set!-form-val ast))))
ast]
;;---------------------------------------------------------
;; DEFINE EXPRESSIONS
;;
[(zodiac:define-values-form? ast)
(zodiac:set-define-values-form-vars!
ast
(map (lambda (v) (analyze! v))
(zodiac:define-values-form-vars ast)))
(zodiac:set-define-values-form-val!
ast
(analyze! (zodiac:define-values-form-val ast)))
ast]
;;----------------------------------------------------------
;; DEFINE-SYNTAX
;;
[(zodiac:define-syntaxes-form? ast)
(zodiac:set-define-syntaxes-form-expr!
ast
(analyze! (zodiac:define-syntaxes-form-expr ast)))
ast]
;;-------------------------------------------------------------------
;; APPLICATIONS
;; analyze all the parts, and note whether the rator is
;; a primitive;
;; if this is a call to a primitive, check the arity.
;;
[(zodiac:app? ast)
(let* ([fun (analyze! (zodiac:app-fun ast))]
[args (map (lambda (arg) (analyze! arg))
(zodiac:app-args ast))]
[primfun (analyze:prim-fun fun)]
[primfun-arity-ok?
;; check the arity for primitive apps -- just an error check
(and primfun
(let* ([num-args (length args)]
[arity-ok? (procedure-arity-includes?
(namespace-variable-value primfun)
num-args)])
(unless arity-ok?
((if (compiler:option:stupid)
compiler:warning
compiler:error)
ast
(format "~a got ~a argument~a"
(zodiac:varref-var fun)
num-args
(if (= num-args 1)
""
"s"))))
arity-ok?))]
[prim? (and primfun primfun-arity-ok?)])
; for all functions, do this stuff
(zodiac:set-app-fun! ast fun)
(zodiac:set-app-args! ast args)
(set-annotation!
ast
(make-app #f prim? (and prim? primfun)))
ast)]
;;-------------------------------------------------------------------
;; WITH-CONTINUATION-MARK
;;
;; analyze the key, val, and body, and the binding in the annotation
;;
[(zodiac:with-continuation-mark-form? ast)
(zodiac:set-with-continuation-mark-form-key!
ast
(analyze! (zodiac:with-continuation-mark-form-key ast)))
(zodiac:set-with-continuation-mark-form-val!
ast
(analyze! (zodiac:with-continuation-mark-form-val ast)))
(zodiac:set-with-continuation-mark-form-body!
ast
(analyze! (zodiac:with-continuation-mark-form-body ast)))
(let ([var (get-annotation ast)])
(set-annotation! var (make-wcm-binding var)))
ast]
;;-----------------------------------------------------------------
;; QUOTE-SYNTAX
;;
;; Construct constant.
;;
[(zodiac:quote-syntax-form? ast)
ast]
;;-----------------------------------------------------------
;; MODULE
;;
[(zodiac:module-form? ast)
(zodiac:set-module-form-body!
ast
(analyze! (zodiac:module-form-body ast)))
ast]
[else (compiler:internal-error
ast
(format "unsupported syntactic form (~a)"
(if (struct? ast)
(vector-ref (struct->vector ast) 0)
ast)))]))])
(lambda (ast)
(analyze! ast)))))))

335
collects/compiler/private/library.ss Normal file
View File

@ -0,0 +1,335 @@
;; Library of functions for the compiler
;; (c) 1996-7 Sebastian Good
;; (c) 1997-8 PLT, Rice University
(module library mzscheme
(require (lib "unitsig.ss")
(lib "list.ss")
(lib "etc.ss"))
(require (lib "zodiac-sig.ss" "syntax"))
(require "sig.ss")
(provide library@)
(define library@
(unit/sig compiler:library^
(import (zodiac : zodiac^))
(define logical-inverse
(lambda (fun)
(lambda (obj)
(not (fun obj)))))
(define one-of
(case-lambda
[(p1 p2) (lambda (obj)
(or (p1 obj) (p2 obj)))]
[preds
(lambda (obj)
(ormap (lambda (p) (p obj)) preds))]))
(define all-of
(lambda preds
(lambda (obj)
(andmap (lambda (p) (p obj)) preds))))
(define none-of
(lambda preds
(logical-inverse (apply one-of preds))))
(define vector-map ; modified by PAS, but looks to be unused
(lambda (f vec)
(let* ([vec-len (vector-length vec)]
[x (make-vector vec-len)])
(let loop ((i 0))
(if (>= i vec-len)
x
(begin (vector-set! x i (f (vector-ref vec i)))
(loop (add1 i))))))))
(define improper-map
(lambda (f ilist)
(cond
((pair? ilist) (cons (f (car ilist)) (improper-map f (cdr ilist))))
((null? ilist) null)
(else (f ilist)))))
(define begin-map!
(lambda (non-tail tail list)
(if (null? list)
null
(begin
(let loop ([list list] [next (cdr list)])
(let ([tail? (null? next)])
(set-car! list ((if tail? tail non-tail) (car list)))
(unless tail? (loop next (cdr next)))))
list))))
(define begin-map
(lambda (non-tail tail list)
(if (null? list)
null
(let ([tail? (null? (cdr list))])
(cons ((if tail? tail non-tail) (car list))
(begin-map non-tail tail (cdr list)))))))
(define map!
(lambda (fun list)
(let loop ([l list])
(if (null? l)
list
(begin (set-car! l (fun (car l))) (loop (cdr l)))))))
(define list-index
(lambda (obj list)
(cond
[(null? list) (error 'list-index "~a not found int ~a" obj list)]
[(eq? obj (car list)) 0]
[else (add1 (list-index obj (cdr list)))])))
(define list-last
(lambda (list)
(if (null? list)
(error 'list-last "~a is empty!" list)
(let loop ([a list] [b (cdr list)])
(if (null? b)
(car a)
(loop b (cdr b)))))))
;; Set operations
;; -----> Begin bit-vector implementation <-----
#|
(define set-next-index 0)
(define index-vector (make-vector 100))
(define singleton-vector (make-vector 100))
(define index-table (make-hash-table))
(define (index->object i) (vector-ref index-vector i))
(define (object->index o)
(let ([i (hash-table-get index-table o (lambda () #f))])
(or i
(let ([i set-next-index])
(set! set-next-index (add1 set-next-index))
(unless (< i (vector-length index-vector))
(printf "grow ~a~n" i)
(let* ([old-iv index-vector]
[old-sv singleton-vector]
[old-size (vector-length index-vector)]
[new-size (* 2 old-size)])
(set! index-vector (make-vector new-size))
(set! singleton-vector (make-vector new-size))
(let loop ([n 0])
(unless (= n old-size)
(vector-set! index-vector n (vector-ref old-iv n))
(vector-set! singleton-vector n (vector-ref old-sv n))
(loop (add1 n))))))
(vector-set! index-vector i o)
(vector-set! singleton-vector i (arithmetic-shift 1 i))
(hash-table-put! index-table o i)
i))))
(define (object->singleton o)
(let ([i (object->index o)])
(vector-ref singleton-vector i)))
(define (set->objects s)
(letrec ([dloop ; double-search
(lambda (s i n d)
(if (zero? s)
null
(if (positive? (bitwise-and s i))
(if (= n 1)
(cons (index->object d)
(dloop (arithmetic-shift s -1) 1 1 (add1 d)))
(let ([n/2 (quotient n 2)])
; It's in d+n/2...d+n
(bloop (arithmetic-shift s (- n/2)) (arithmetic-shift i (- n/2)) n/2 (+ d n/2))))
(dloop s (bitwise-ior i (arithmetic-shift i n)) (* n 2) d))))]
[bloop
(lambda (s i n d)
(if (= n 1)
(cons (index->object d)
(dloop (arithmetic-shift s -1) 1 1 (add1 d)))
(let* ([n/2 (quotient n 2)]
[low_i (arithmetic-shift i (- n/2))])
(if (positive? (bitwise-and s low_i))
(bloop s low_i n/2 d)
(bloop (arithmetic-shift s (- n/2)) low_i n/2 (+ d n/2))))))])
(dloop s 1 1 0)))
(define (set->list s) (reverse! (set->objects s))) ; something relies on the order
(define empty-set 0)
(define make-singleton-set object->singleton)
(define (list->set l)
(let loop ([l l][s 0])
(if (null? l)
s
(loop (cdr l) (set-union s (object->singleton (car l)))))))
(define (set-memq? o s)
(positive? (bitwise-and s (object->singleton o))))
(define set-union bitwise-ior)
(define set-intersect bitwise-and)
(define (set-union-singleton s o) (set-union s (object->singleton o)))
(define (set-minus s1 s2) (bitwise-and s1 (bitwise-not s2)))
(define (set-subset? s1 s2) (zero? (bitwise-xor s1 (bitwise-and s1 s2))))
(define set-empty? zero?)
(define set? integer?) ; cheat
|#
;; -----> End bit-vector implementation <------
;; -----> Begin list implementation <------
(define-struct set (%m))
(define empty-set (make-set null))
(define make-singleton-set (compose make-set list))
(define list->set
(lambda (l)
; (unless (list? l) (error 'list->set "~a not a list" l))
(make-set l)))
(define set->list set-%m)
(define set-memq?
(lambda (obj set)
(memq obj (set->list set))))
(define set-empty? (compose null? set->list))
(define set-union ; O(|a|*|b|)
(lambda (a b)
(let union ([a (set->list a)]
[b (set->list b)])
(cond
[(null? a) (list->set b)]
[(memq (car a) b) (union (cdr a) b)]
[else (union (cdr a) (cons (car a) b))]))))
(define set-union-singleton
(lambda (set obj)
(when (void? obj)
(error 'stop))
(if (memq obj (set->list set))
set
(list->set (cons obj (set->list set))))))
(define set-minus ; O(|a|*|b|)
(lambda (a b)
(let minus ([a (set->list a)]
[b (set->list b)]
[acc null])
(cond
[(null? a) (list->set acc)]
[(memq (car a) b) (minus (cdr a) b acc)]
[else (minus (cdr a) b (cons (car a) acc))]))))
(define set-intersect ; O(|a|*|b|)
(lambda (a b)
(if (or (set-empty? a)
(set-empty? b))
empty-set
(let intersect ([a (set->list a)]
[acc null])
(cond
[(null? a) (list->set acc)]
[(set-memq? (car a) b) (intersect (cdr a) (cons (car a) acc))]
[else (intersect (cdr a) acc)])))))
(define (set-subset? s1 s2)
(if (eq? s1 s2)
#t
(let ([l1 (set->list s1)]
[l2 (set->list s2)])
(andmap (lambda (elt) (memq elt l2)) l1))))
;; -----> End list implementation <-----
(define set-remove
(lambda (e s)
(set-minus s (make-singleton-set e))))
(define improper-list->set
(lambda (l)
(let loop ([l l][acc null])
(cond
[(null? l) (list->set acc)]
[(pair? l) (loop (cdr l) (cons (car l) acc))]
[else (list->set (cons l acc))]))))
(define set-find
(lambda (p s)
(let ([lst (set->list s)])
(let loop ([l lst])
(cond [(null? l) #f]
[(p (car l)) (car l)]
[else (loop (cdr l))])))))
(define set-map
(lambda (f s)
(list->set (map f (set->list s)))))
(define set-filter
(lambda (f s)
(list->set (filter f (set->list s)))))
(define symbol-append
(lambda s
(let loop ([str ""] [s s])
(if (null? s)
(string->symbol str)
(loop (string-append str (symbol->string (car s))) (cdr s))))))
(define (remove-duplicates elts)
(if (null? elts)
'()
(if (memq (car elts) (cdr elts))
(remove-duplicates (cdr elts))
(cons (car elts) (remove-duplicates (cdr elts))))))
; end binder set ops
(define compiler:formals->arity
(lambda (f)
(let ([L (length (zodiac:arglist-vars f))])
(cond
[(zodiac:sym-arglist? f) (values 0 -1)]
[(zodiac:list-arglist? f) (values L L)]
[(zodiac:ilist-arglist? f) (values (- L 1) -1)]))))
(define compiler:formals->arity*
(lambda (fs)
(cond
[(null? fs) (values -1 0)]
[(null? (cdr fs)) (compiler:formals->arity (car fs))]
[else (let-values ([(a- a+) (compiler:formals->arity (car fs))]
[(b- b+) (compiler:formals->arity* (cdr fs))])
(values (min a- b-)
(if (or (negative? b+) (negative? a+))
-1
(max a+ b+))))])))
(define compiler:gensym gensym)
(define compiler:label-number 0)
(define (compiler:reset-label-number!)
(set! compiler:label-number 0))
(define compiler:genlabel
(lambda ()
(begin0 compiler:label-number
(set! compiler:label-number (add1 compiler:label-number)))))
(define (compiler:get-label-number) compiler:label-number)
(define re:bad-char (regexp "[][#+-.*/<=>!?:$%_&~^@;^(){}|\\,~\"`' \000-\040]"))
(define re:starts-with-number (regexp "^[0-9]"))
(define (compiler:clean-string s)
(let ([s (regexp-replace* re:bad-char s "_")])
(if (regexp-match re:starts-with-number s)
(string-append "_" s)
s)))
(define (protect-comment s)
(string-append
(regexp-replace* "[*]/"
(regexp-replace* "/[*]" s "-")
"-")
" "))
(define (global-defined-value* v)
(and v (namespace-variable-value v))))))

607
collects/compiler/private/lift.ss Normal file
View File

@ -0,0 +1,607 @@
;; A kind of lambda-lifting
;; (c) 1997-2001 PLT
;; Finds liftable procedures, sets their `liftable' field, and
;; replaces lexical variables for liftable procedures with
;; globals variables. This transformation can be applied
;; anytime (and multiple times) after analyze.ss and before
;; closure.ss.
;; Liftable lambdas are procedures whose free variables include only
;; lexical variables bound to known-lifted procedures, primitive
;; globals, and statics. (No namespace-sentsitive globals and no
;; per-load statics.) Per-load liftable lambdas are lifted to per-load
;; allocation; per-load liftable lambdas can have other per-load
;; liftable lambdas and values in their closure.
;; TODO: get rid of let{rec}-bound variables that are useless
;; because they are bound to lifted procedures.
;;; Annotatitons: ----------------------------------------------
;; lambda - sets `liftable' in the procedure-code structure
;;; ------------------------------------------------------------
(module lift mzscheme
(require (lib "unitsig.ss")
(lib "list.ss")
(lib "etc.ss"))
(require (lib "zodiac-sig.ss" "syntax"))
(require "sig.ss")
(require "../sig.ss")
(provide lift@)
(define lift@
(unit/sig compiler:lift^
(import (compiler:option : compiler:option^)
compiler:library^
compiler:cstructs^
(zodiac : zodiac^)
compiler:zlayer^
compiler:known^
compiler:top-level^
compiler:analyze^
compiler:const^
compiler:closure^
compiler:driver^)
(define lifting-allowed? #t)
(define mutual-lifting-allowed? #t)
(define per-load-lifting-only? #f)
(define procedures null)
(define single-module-mode? #f)
(define (set-single-module-mode! v)
(set! single-module-mode? v))
;; find-all-procedures!
(define find-all-procedures!
(letrec ([find!
(lambda (ast)
(cond
;;-----------------------------------------------------------------
;; CONSTANTS (A-VALUES)
[(zodiac:quote-form? ast) (void)]
;;-----------------------------------------------------------------
;; VARIABLE REFERENCES (A-VALUES)
;;
[(zodiac:bound-varref? ast) (void)]
[(zodiac:top-level-varref? ast) (void)]
;;--------------------------------------------------------------------
;; LAMBDA EXPRESSIONS
;;
[(zodiac:case-lambda-form? ast)
(set! procedures (cons (cons ast (varref:current-invoke-module )) procedures))
(for-each find! (zodiac:case-lambda-form-bodies ast))]
;;--------------------------------------------------------------
;; LET EXPRESSIONS
[(zodiac:let-values-form? ast)
(find! (car (zodiac:let-values-form-vals ast)))
(find! (zodiac:let-values-form-body ast))]
;;-----------------------------------------------------------------
;; LETREC EXPRESSIONS
;;
[(zodiac:letrec-values-form? ast)
(for-each find! (zodiac:letrec-values-form-vals ast))
(find! (zodiac:letrec-values-form-body ast))]
;;-----------------------------------------------------
;; IF EXPRESSIONS
;;
;; analyze the 3 branches.
;;
[(zodiac:if-form? ast)
(find! (zodiac:if-form-test ast))
(find! (zodiac:if-form-then ast))
(find! (zodiac:if-form-else ast))]
;;--------------------------------------------------------
;; BEGIN EXPRESSIONS
;;
;; analyze the branches
[(zodiac:begin-form? ast)
(for-each find! (zodiac:begin-form-bodies ast))]
;;--------------------------------------------------------
;; BEGIN0 EXPRESSIONS
;;
;; analyze the branches
[(zodiac:begin0-form? ast)
(find! (zodiac:begin0-form-first ast))
(find! (zodiac:begin0-form-rest ast))]
;;--------------------------------------------------------
;; SET! EXPRESSIONS
;;
;; we analyze the target, which will register it as being
;; mutable or used, as necessary. Then we analyze the value.
;;
[(zodiac:set!-form? ast)
(find! (zodiac:set!-form-val ast))]
;;---------------------------------------------------------
;; DEFINE EXPRESSIONS
;;
[(zodiac:define-values-form? ast)
(find! (zodiac:define-values-form-val ast))]
;;---------------------------------------------------------
;; DEFINE-SYNTAXES
;;
[(zodiac:define-syntaxes-form? ast)
(find! (zodiac:define-syntaxes-form-expr ast))]
;;-------------------------------------------------------------------
;; APPLICATIONS
;; analyze all the parts, and note whether the rator is
;; a primitive;
;; if this is a call to a primitive, check the arity.
;;
[(zodiac:app? ast)
(find! (zodiac:app-fun ast))
(for-each find! (zodiac:app-args ast))]
;;-------------------------------------------------------------------
;; WITH-CONTINUATION-MARK
;;
;; analyze the key, val, and body
;;
[(zodiac:with-continuation-mark-form? ast)
(find! (zodiac:with-continuation-mark-form-key ast))
(find! (zodiac:with-continuation-mark-form-val ast))
(find! (zodiac:with-continuation-mark-form-body ast))]
;;-----------------------------------------------------------
;; MODULE
;;
[(zodiac:module-form? ast)
(parameterize ([varref:current-invoke-module
(module-info-invoke (get-annotation ast))])
(find! (zodiac:module-form-body ast)))]
[else (compiler:internal-error
ast
(format "unsupported syntactic form (~a)"
(if (struct? ast)
(vector-ref (struct->vector ast) 0)
ast)))]))])
(lambda (ast)
(set! procedures null)
(find! ast))))
;; Recursively determines the `liftable' field in the procedure
;; record. If a cycle is encountered, return 'cycle or 'pls-cycle
;; (the latter of any part of the cycle had "globals" in its
;; "closure")
(define (get-liftable! lambda)
(let ([code (get-annotation lambda)])
(if (eq? (procedure-code-liftable code) 'unknown-liftable)
(if (and lifting-allowed?
(or mutual-lifting-allowed?
(set-empty? (code-free-vars code)))
(or single-module-mode?
(andmap (case-lambda
[(var)
(or (not (mod-glob? var))
(let ([modname (mod-glob-modname var)])
(if (eq? modname '#%kernel)
#t
(not modname))))])
(set->list (code-global-vars code)))))
;; Liftable only if there are no free (non-pls) global vars
(begin
;; Mark this one in case we encounter a cycle:
(set-procedure-code-liftable! code 'cycle)
;; Check each free variable
(let ([r (let loop ([l (set->list (code-free-vars code))]
[pls? (or per-load-lifting-only?
(not (set-empty? (code-global-vars code))))]
[cycle? #f])
(if (null? l)
;; It's liftable, assuming any cycles are resolved
(cond
[(and pls? cycle?) 'pls-cycle]
[cycle? 'cycle]
[pls? 'pls]
[else 'static])
;; Check the free variable - references a liftable proc?
(let ([v (extract-ast-known-value (extract-varref-known-val (car l)))])
(if (zodiac:case-lambda-form? v)
(let ([vl (let ([l (get-liftable! v)])
(cond
[(top-level-varref/bind-from-lift? l)
;; lifted in a previous phase
(if (top-level-varref/bind-from-lift-pls? l)
'pls
'static)]
[(pair? l)
;; lifted already in this phase
(if (top-level-varref/bind-from-lift-pls? (car l))
'pls
'static)]
[else l]))])
(if vl
(loop (cdr l)
(or pls? (eq? vl 'pls) (eq? vl 'pls-cycle))
(or cycle? (eq? vl 'cycle) (eq? vl 'pls-cycle)))
#f))
#f))))])
(cond
[(not r) (set-procedure-code-liftable! code #f)
#f]
[(or (eq? r 'cycle) (eq? r 'pls-cycle))
(set-procedure-code-liftable! code 'unknown-liftable)
r]
[(eq? r 'pls) (set-procedure-code-liftable! code 'pls)
'pls]
[else (set-procedure-code-liftable! code 'static)
'static])))
(begin
(set-procedure-code-liftable! code #f)
#f))
(procedure-code-liftable code))))
(define (set-liftable! lambda)
(unless (top-level-varref/bind-from-lift? (procedure-code-liftable (get-annotation lambda)))
(let ([v (get-liftable! lambda)])
(when v
(let ([pls? (or (eq? v 'pls) (eq? v 'pls-cycle))])
(when (compiler:option:verbose)
(compiler:warning lambda (format "found static procedure~a"
(if pls? " (per-load)" ""))))
(compiler:add-lifted-lambda! lambda pls?))))))
;; lift-lambdas! uses the `liftable' procedure annotation with known-value
;; analysis to replace lexical variables referencing known liftable
;; procedures with top-level-varrefs referencing the lifted
;; procedure
;; Since per-load lifting rarranges global variable sets, we
;; recompute them.
;; Returns (cons ast global-var-set)
(define lift-lambdas!
(letrec ([lift!
(lambda (ast code)
(when (compiler:option:debug)
(zodiac:print-start! (debug:get-port) ast)
(newline (debug:get-port)))
(cond
;;-----------------------------------------------------------------
;; CONSTANTS (A-VALUES)
[(zodiac:quote-form? ast) ast]
;;-----------------------------------------------------------------
;; VARIABLE REFERENCES (A-VALUES)
;;
[(zodiac:bound-varref? ast)
(let ([v (extract-ast-known-value (extract-varref-known-val ast))])
(if (zodiac:case-lambda-form? v)
(let ([lifted (let ([l (procedure-code-liftable (get-annotation v))])
(if (pair? l) (car l) l))])
(if lifted
;; The procedure was lifted
(begin
(when code
(remove-code-free-vars! code (make-singleton-set
(zodiac:bound-varref-binding ast))))
(when (top-level-varref/bind-from-lift-pls? lifted)
(add-global! (or (varref:current-invoke-module)
const:the-per-load-statics-table)))
lifted)
;; No change
ast))
;; No change
ast))]
[(zodiac:top-level-varref? ast)
(cond
[(varref:has-attribute? ast varref:primitive)
(void)]
[(varref:has-attribute? ast varref:per-load-static)
(add-global! const:the-per-load-statics-table)]
[(varref:has-attribute? ast varref:per-invoke-static)
(add-global! (varref:invoke-module ast))]
[(varref:has-attribute? ast varref:static)
(void)]
[else (add-global! (compiler:add-global-varref! ast))])
ast]
;;--------------------------------------------------------------------
;; LAMBDA EXPRESSIONS
;; analyze the bodies, and set binding info for the binding vars
;;
[(zodiac:case-lambda-form? ast)
(let ([code (get-annotation ast)]
[save-globals globals])
;; We're recomputing globals...
(set-code-global-vars! code empty-set)
(zodiac:set-case-lambda-form-bodies!
ast
(map (lambda (b ccode)
(set! globals empty-set)
;; Analyze case
(let ([b (lift! b ccode)])
;; Set and merge globals
(set-code-global-vars! ccode globals)
(set-code-global-vars! code
(set-union globals
(code-global-vars code)))
b))
(zodiac:case-lambda-form-bodies ast)
(procedure-code-case-codes code)))
;; If it being lifted ON THIS PASS, the value of `lifted' will be a list;
;; in that case, return the new static varref
(let ([lifted (procedure-code-liftable code)])
(if (or (not lifted) (top-level-varref/bind-from-lift? lifted))
;; Not lifted (or not on this pass)
(begin
(set! globals (set-union save-globals (code-global-vars code)))
ast)
;; Lifting on this pass
(let ([lifted (car lifted)])
(set-procedure-code-liftable! code lifted)
(if (top-level-varref/bind-from-lift-pls? lifted)
(set! globals (set-union-singleton
save-globals
(or (varref:current-invoke-module)
const:the-per-load-statics-table)))
(set! globals save-globals))
lifted))))]
;;--------------------------------------------------------------
;; LET EXPRESSIONS
;;
[(zodiac:let-values-form? ast)
(let* ([val (lift! (car (zodiac:let-values-form-vals ast)) code)])
(set-car! (zodiac:let-values-form-vals ast) val)
;; lift in body expressions
(let ([body (lift! (zodiac:let-values-form-body ast) code)])
(if (and (= 1 (length (car (zodiac:let-values-form-vars ast))))
(top-level-varref/bind-from-lift? val)
(not (binding-mutable? (get-annotation (caar (zodiac:let-values-form-vars ast))))))
;; Let binding value is a lifted procedure, drop the variable
(let ([var (caar (zodiac:let-values-form-vars ast))])
(remove-local-var! code var)
body)
(begin
(zodiac:set-let-values-form-body! ast body)
ast))))]
;;-----------------------------------------------------------------
;; LETREC EXPRESSIONS
;;
[(zodiac:letrec-values-form? ast)
(let* ([varses (zodiac:letrec-values-form-vars ast)]
[vals (zodiac:letrec-values-form-vals ast)])
(zodiac:set-letrec-values-form-vals!
ast
(map (lambda (val) (lift! val code)) vals))
(zodiac:set-letrec-values-form-body!
ast
(lift! (zodiac:letrec-values-form-body ast) code))
(let loop ([varses varses][vals (zodiac:letrec-values-form-vals ast)]
[vss-accum null][vs-accum null])
(if (null? varses)
(begin
(zodiac:set-letrec-values-form-vars! ast (reverse! vss-accum))
(zodiac:set-letrec-values-form-vals! ast (reverse! vs-accum)))
(let ([vars (car varses)]
[val (car vals)])
(if (and (= 1 (length vars))
(top-level-varref/bind-from-lift? val))
;; Let binding value is a lifted procedure, drop the variable
(begin
(remove-local-var! code (car vars))
(loop (cdr varses) (cdr vals) vss-accum vs-accum))
;; Normal binding
(loop (cdr varses) (cdr vals) (cons vars vss-accum) (cons val vs-accum))))))
(if (null? (zodiac:letrec-values-form-vars ast))
;; All binding values were lifted; return the body
(zodiac:letrec-values-form-body ast)
ast))]
;;-----------------------------------------------------
;; IF EXPRESSIONS
;;
;; analyze the 3 branches.
;;
[(zodiac:if-form? ast)
(zodiac:set-if-form-test! ast (lift! (zodiac:if-form-test ast) code))
(let ([then (lift! (zodiac:if-form-then ast) code)]
[else (lift! (zodiac:if-form-else ast) code)])
(zodiac:set-if-form-then! ast then)
(zodiac:set-if-form-else! ast else)
ast)]
;;--------------------------------------------------------
;; BEGIN EXPRESSIONS
;;
[(zodiac:begin-form? ast)
(zodiac:set-begin-form-bodies!
ast
(map (lambda (b) (lift! b code))
(zodiac:begin-form-bodies ast)))
ast]
;;--------------------------------------------------------
;; BEGIN0 EXPRESSIONS
;;
;; analyze the branches
[(zodiac:begin0-form? ast)
(zodiac:set-begin0-form-first! ast (lift! (zodiac:begin0-form-first ast) code))
(zodiac:set-begin0-form-rest! ast (lift! (zodiac:begin0-form-rest ast) code))
ast]
;;--------------------------------------------------------
;; SET! EXPRESSIONS
;;
;;
[(zodiac:set!-form? ast)
;; Possibly a top-level-varref; put it in the global-var set
(lift! (zodiac:set!-form-var ast) code)
(zodiac:set-set!-form-val!
ast
(lift! (zodiac:set!-form-val ast) code))
ast]
;;---------------------------------------------------------
;; DEFINE EXPRESSIONS
;;
[(zodiac:define-values-form? ast)
;; Top-level-varrefs; put them in the global-var set
(for-each (lambda (v) (lift! v code)) (zodiac:define-values-form-vars ast))
(zodiac:set-define-values-form-val!
ast
(lift! (zodiac:define-values-form-val ast) code))
ast]
;;---------------------------------------------------------
;; DEFINE-SYNTAXES
;;
[(zodiac:define-syntaxes-form? ast)
(zodiac:set-define-syntaxes-form-expr!
ast
(lift! (zodiac:define-syntaxes-form-expr ast) code))
ast]
;;-------------------------------------------------------------------
;; APPLICATIONS
;; analyze all the parts, and note whether the rator is
;; a primitive;
;; if this is a call to a primitive, check the arity.
;;
[(zodiac:app? ast)
(let* ([fun (lift! (zodiac:app-fun ast) code)]
[args (map (lambda (arg) (lift! arg code))
(zodiac:app-args ast))])
(zodiac:set-app-fun! ast fun)
(zodiac:set-app-args! ast args))
ast]
;;-------------------------------------------------------------------
;; WITH-CONTINUATION-MARK
;;
;; analyze the key, val, and body
;;
[(zodiac:with-continuation-mark-form? ast)
(zodiac:set-with-continuation-mark-form-key!
ast
(lift! (zodiac:with-continuation-mark-form-key ast) code))
(zodiac:set-with-continuation-mark-form-val!
ast
(lift! (zodiac:with-continuation-mark-form-val ast) code))
(zodiac:set-with-continuation-mark-form-body!
ast
(lift! (zodiac:with-continuation-mark-form-body ast) code))
ast]
;;-----------------------------------------------------------
;; MODULE
;;
[(zodiac:module-form? ast)
(parameterize ([varref:current-invoke-module (module-info-invoke (get-annotation ast))])
(zodiac:set-module-form-body!
ast
(lift! (zodiac:module-form-body ast) code)))
ast]
[else (compiler:internal-error
ast
(format "unsupported syntactic form (~a)"
(if (struct? ast)
(vector-ref (struct->vector ast) 0)
ast)))]))]
[remove-local-var! (lambda (code var)
(let ([vars (make-singleton-set var)])
(set-code-local-vars! code (set-minus (code-local-vars code) vars))
(set-code-captured-vars! code (set-minus (code-captured-vars code) vars))
;; Is it a case code?
(when (case-code? code)
(let ([code (code-parent code)])
(remove-local-var! code var)))))]
[globals empty-set]
[add-global! (lambda (v) (set! globals (set-union-singleton globals v)))])
(lambda (ast code)
;; Find all the procedures
(find-all-procedures! ast)
;; If we marked it as unliftable before, mark it as unknown
;; now because we'll check again:
(for-each
(lambda (l)
(let ([l (car l)])
(let ([c (get-annotation l)])
(unless (procedure-code-liftable c)
(set-procedure-code-liftable! c 'unknown-liftable)))))
procedures)
;; Set liftable flags
(for-each (lambda (l)
(let ([l (car l)]
[mi (cdr l)])
(parameterize ([varref:current-invoke-module mi])
(set-liftable! l))))
procedures)
(set! globals empty-set)
(let ([ast (lift! ast code)])
(cons ast globals))))))))

683
collects/compiler/private/prephase.ss Normal file
View File

@ -0,0 +1,683 @@
;; pre-compilation scan
;; (c) 1996-1997 Sebastian Good
;; (c) 1997-2001 PLT
; Notes mutability of lexical variables.
; Performs a few very-high-level optimizations, such as
; throwing away constant expressions in a begin.
; Performs a few ad hoc optimizations, like (+ x 1)
; => (add1 x)
; Normalizes the expression forms:
; - begin/begin0: flattened as much as possible; empty
; and one-expression begins are eliminated
; - ((lambda (x1 ... xn) e) a1 ... an1) => let expression
; - (define-values () e) => (let-values [() e] (void))
; (After this phase, a zodiac:top-level-varref is always
; a global variable.)
; Infers names for closures and interfaces. (Do this early so
; that elaboration doesn't mangle the names.)
; Detects global varrefs to built-in primitives.
; Detects known immutability of signature vectors produced by */sig
; forms
; Lambdas that are really c-lambdas are converted to quote forms
; containing c-lambda records
; Applications that are really c-declares are converted to voids
; Converts define-for-syntax to define-syntaxes (where id module
; phase distinguishes them in the end)
;;; Annotatitons: ----------------------------------------------
;; binding - `binding-properties' structure
;; (this is temporary; the next phase will change the
;; annotation)
;; varref - empty set of varref attrributes, except that
;; the varref:primitive attribute can be added, and
;; the varref:in-module attribute can be added
;; quote - 'immutable for known immutable quoted vars
;; lambda - an inferred name (temporary)
;; module - a module-info record
;; define-[for-]syntax - in-mod?, wrap RHS with
;; (for-syntax-in-env (lambda () ...))
;;; ------------------------------------------------------------
(module prephase mzscheme
(require (lib "unitsig.ss"))
(require (lib "zodiac-sig.ss" "syntax"))
(require "sig.ss")
(require "../sig.ss")
(provide prephase@)
(define prephase@
(unit/sig
compiler:prephase^
(import (compiler:option : compiler:option^)
compiler:library^
compiler:cstructs^
(zodiac : zodiac^)
compiler:zlayer^
compiler:driver^)
(define-struct binding-properties (mutable? unit-i/e? ivar? anchor known-val))
(define (prephase:init-binding-properties! binding mutable? unit-i/e? ivar?)
(set-annotation! binding (make-binding-properties mutable? unit-i/e? ivar? #f #f)))
(define (prephase:set-mutable! binding mutable?)
(set-binding-properties-mutable?! (get-annotation binding) mutable?))
(define (prephase:set-binding-anchor! binding a)
(set-binding-properties-anchor! (get-annotation binding) a))
(define (prephase:is-mutable? binding)
(let ([p (get-annotation binding)])
(and p (binding-properties-mutable? p))))
(define (prephase:is-ivar? binding)
(let ([p (get-annotation binding)])
(and p (binding-properties-ivar? p))))
(define (prephase:binding-anchor binding)
(let ([p (get-annotation binding)])
(and p (binding-properties-anchor p))))
;; Used in analyze to temporarily store known-value information for
;; let[rec] bindings
(define (prephase:known-val binding)
(let ([p (get-annotation binding)])
(and p (binding-properties-known-val p))))
(define (prephase:set-known-val! binding v)
(let ([p (get-annotation binding)])
(if p
(set-binding-properties-known-val! p v)
(begin
(prephase:init-binding-properties! binding #f #f #f)
(prephase:set-known-val! binding v)))))
;; what can be thrown away in a begin?
(define prephase:dead-expression?
(one-of zodiac:bound-varref? zodiac:quote-form?
zodiac:case-lambda-form?))
;; what can be ``pushed''?: (begin0 x ...) => (begin ... x)
(define prephase:begin0-pushable?
(one-of zodiac:case-lambda-form? zodiac:quote-form?))
;; returns a true value if the symbol refers to a primitive function.
(define prephase:primitive-name?
(lambda (ast)
(let ([m (zodiac:top-level-varref-module ast)])
(or (eq? '#%kernel m)
(and (box? m)
(eq? '#%kernel (unbox m)))))))
(define (preprocess:adhoc-app-optimization ast prephase-it)
(let ([fun (zodiac:app-fun ast)])
(and (zodiac:top-level-varref? fun)
(prephase:primitive-name? fun)
(let ([name (zodiac:varref-var fun)]
[args (zodiac:app-args ast)]
[new-fun (lambda (newname)
(prephase-it
(zodiac:make-top-level-varref
;; FIXME?: wrong syntax
(zodiac:zodiac-stx fun)
(make-empty-box)
newname
'#%kernel
(box '())
#f
#f
#f)))])
(case name
[(void) (if (null? args)
(prephase-it (zodiac:make-special-constant 'void))
#f)]
[(list) (if (null? args)
(prephase-it (zodiac:make-special-constant 'null))
#f)]
[(+ -) (when (and (= 2 (length args))
(zodiac:quote-form? (cadr args))
(equal? 1 (syntax-e (zodiac:zodiac-stx (zodiac:quote-form-expr (cadr args))))))
(let ([newname (if (eq? name '+) 'add1 'sub1)])
(zodiac:set-app-fun! ast (new-fun newname))
(zodiac:set-app-args! ast (list (car args)))))
#f] ; always return #f => use the (possibly mutated) ast
[(verify-linkage-signature-match)
;; Important optimization for compound-unit/sig: mark signature-defining vectors
;; as immutable
(when (= 5 (length args))
;; Mark 1st, 2nd, 4th, and 5th as 'immutable quotes
(let ([mark (lambda (qf)
(when (zodiac:quote-form? qf)
(set-annotation! qf 'immutable)))])
(mark (list-ref args 0))
(mark (list-ref args 1))
(mark (list-ref args 3))
(mark (list-ref args 4))))
#f]
[else #f])))))
(define for-syntax-slot (box #f))
;;----------------------------------------------------------------------------
;; PREPHASE MAIN FUNCTION
;;
(define prephase!
(letrec ([prephase!
(lambda (ast in-mod? need-val? name)
(when (compiler:option:debug)
(zodiac:print-start! (debug:get-port) ast)
(newline (debug:get-port)))
(cond
;;----------------------------------------------------------
;; CONSTANTS
;;
[(zodiac:quote-form? ast) ast]
;;----------------------------------------------------------
;; VARIABLE REFERENCES
;;
;; set up all varrefs with an attribute set
;; note all varrefs to primitives
;; change unit-bound `top-levels' to lexicals
;;
[(zodiac:varref? ast)
(set-annotation! ast (varref:empty-attributes))
(when (zodiac:top-level-varref? ast)
(when (prephase:primitive-name? ast)
(varref:add-attribute! ast varref:primitive))
(when in-mod?
(varref:add-attribute! ast varref:in-module)))
ast]
;;----------------------------------------------------------
;; LAMBDA EXPRESSIONS
;;
[(zodiac:case-lambda-form? ast)
;; Check for 'mzc-cffi attribute:
(if (syntax-property (zodiac:zodiac-stx ast) 'mzc-cffi)
;; A C glue function. Change to a quote so it gets treated atomically
(let* ([quote-expr (cadr
(zodiac:begin-form-bodies (car (zodiac:case-lambda-form-bodies ast))))]
[elems (syntax-e (zodiac:zodiac-stx (zodiac:quote-form-expr quote-expr)))]
[fname (syntax-e (car elems))]
[sname (syntax-e (cadr elems))]
[arity (syntax-e (caddr elems))]
[body (syntax-e (cadddr elems))])
(register-c-lambda-function fname body)
(zodiac:make-quote-form
(zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
(zodiac:make-zread
(datum->syntax-object
#f
(make-c-lambda fname sname body arity)
#f))))
;; Normal lambda
(let ([args (zodiac:case-lambda-form-args ast)]
[bodies (zodiac:case-lambda-form-bodies ast)])
(for-each
(lambda (args)
(for-each (lambda (b) (prephase:init-binding-properties! b #f #f #f))
(zodiac:arglist-vars args)))
args)
(let ([ast (zodiac:make-case-lambda-form
(zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
args
(begin-map (lambda (e) (prephase! e in-mod? #f #f))
(lambda (e) (prephase! e in-mod? #t #f))
bodies))])
(set-annotation! ast name)
ast)))]
;;----------------------------------------------------------
;; LET EXPRESSIONS
;;
[(zodiac:let-values-form? ast)
(for-each
(lambda (l)
(for-each (lambda (b) (prephase:init-binding-properties! b #f #f #f))
l))
(zodiac:let-values-form-vars ast))
(zodiac:set-let-values-form-vals!
ast
(map (lambda (e name) (prephase! e in-mod? #t name))
(zodiac:let-values-form-vals ast)
(zodiac:let-values-form-vars ast)))
(zodiac:set-let-values-form-body!
ast
(prephase! (zodiac:let-values-form-body ast) in-mod? need-val? name))
ast]
;;-----------------------------------------------------------
;; LETREC EXPRESSIONS
;;
[(zodiac:letrec-values-form? ast)
(for-each (lambda (l)
(for-each (lambda (b)
(prephase:init-binding-properties! b #f #f #f))
l))
(zodiac:letrec-values-form-vars ast))
(zodiac:set-letrec-values-form-vals!
ast
(map (lambda (e name) (prephase! e in-mod? #t name))
(zodiac:letrec-values-form-vals ast)
(zodiac:letrec-values-form-vars ast)))
(zodiac:set-letrec-values-form-body!
ast
(prephase!
(zodiac:letrec-values-form-body ast)
in-mod?
need-val?
name))
;; ????? Obsolete? ????
;; this will mark the letrec so it is NOT retraversed by
;; a possible future call to a-normalize! (the mutating version)
;; (set-annotation! ast #f)
ast]
;;-----------------------------------------------------------
;; IF EXPRESSIONS
;;
[(zodiac:if-form? ast)
(zodiac:set-if-form-test!
ast
(prephase! (zodiac:if-form-test ast) in-mod? #t #f))
(zodiac:set-if-form-then!
ast
(prephase! (zodiac:if-form-then ast) in-mod? need-val? name))
(zodiac:set-if-form-else!
ast
(prephase! (zodiac:if-form-else ast) in-mod? need-val? name))
;; Ad hoc optimization: (if (not x) y z) => (if x z y)
(let ([test (zodiac:if-form-test ast)])
(when (and (zodiac:app? test)
(zodiac:top-level-varref? (zodiac:app-fun test))
(eq? 'not (zodiac:varref-var (zodiac:app-fun test)))
(prephase:primitive-name? (zodiac:app-fun test))
(= 1 (length (zodiac:app-args test))))
(let ([then (zodiac:if-form-then ast)]
[else (zodiac:if-form-else ast)])
(zodiac:set-if-form-test! ast (car (zodiac:app-args test)))
(zodiac:set-if-form-then! ast else)
(zodiac:set-if-form-else! ast then))))
ast]
;;-----------------------------------------------------------
;; BEGIN EXPRESSIONS
;;
;; flatten, throw away dead values
;;
[(zodiac:begin-form? ast)
(let ([bodies (zodiac:begin-form-bodies ast)])
(if (null? bodies)
; must be a top-level begin...
(zodiac:make-special-constant 'void)
; Normal begin
(begin
(begin-map! (lambda (e) (prephase! e in-mod? #f #f))
(lambda (e) (prephase! e in-mod? need-val? name))
bodies)
(let ([final-bodies
(let loop ([bodies bodies])
(cond
; last expr in begin, finished
[(null? (cdr bodies)) bodies]
; flatten begins
[(zodiac:begin-form? (car bodies))
(loop (append! (zodiac:begin-form-bodies (car bodies))
(cdr bodies)))]
; flatten begin0s, too
[(zodiac:begin0-form? (car bodies))
(loop (append! (zodiac:begin0-form-bodies (car bodies))
(cdr bodies)))]
; throw away dead values if possible
[(prephase:dead-expression? (car bodies))
(loop (cdr bodies))]
; otherwise
[else (cons (car bodies) (loop (cdr bodies)))]))])
(if (null? (cdr final-bodies))
(car final-bodies)
(begin
(zodiac:set-begin-form-bodies! ast final-bodies)
ast))))))]
;;-----------------------------------------------------------
;; BEGIN0 EXPRESSIONS
;;
;; the 1st place is special -- the rest is just a begin
;; do our begin rewrites, then transform to a general form
;; if necessary
;;
;; if the value isn't going to be used, then the whole thing
;; is a begin
;;
[(zodiac:begin0-form? ast)
(if (not need-val?)
;; The value is ignored anyway - make it a begin
(prephase!
(zodiac:make-begin-form (zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
(zodiac:begin0-form-bodies ast))
in-mod?
#f
#f)
(let ([ast
(let ([make-begin
(lambda (bodies)
(zodiac:make-begin-form (zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
bodies))]
[bodies (zodiac:begin0-form-bodies ast)])
; simplify the first position
(set-car! bodies (prephase! (car bodies) in-mod? need-val? name))
; then simplify the begin0
(cond
; (begin0 M) --> M
[(null? (cdr bodies)) (car bodies)]
; (begin0 <push> ...) --> (begin ... <push>))
[(prephase:begin0-pushable? (car bodies))
(prephase!
(make-begin (append (cdr bodies) (list (car bodies))))
in-mod?
need-val?
name)]
; (begin0 M ...) --> (begin0 M (begin ...))
[else
(set-cdr!
(zodiac:begin0-form-bodies ast)
(list (prephase! (make-begin (cdr bodies)) in-mod? #f #f)))
ast]
))])
(if (zodiac:begin0-form? ast)
ast ; (prephase:convert-begin0 ast)
ast)))]
;;-----------------------------------------------------------
;; SET! EXPRESSIONS
;;
;; Mark lexical bindings as mutable
;;
[(zodiac:set!-form? ast)
(zodiac:set-set!-form-var! ast
(prephase!
(zodiac:set!-form-var ast)
in-mod?
#t
#f))
(let ([target (zodiac:set!-form-var ast)])
(when (zodiac:bound-varref? target)
(prephase:set-mutable!
(zodiac:bound-varref-binding target) #t))
(zodiac:set-set!-form-val! ast
(prephase!
(zodiac:set!-form-val ast)
in-mod?
#t
(zodiac:set!-form-var ast)))
ast)]
;;-----------------------------------------------------------
;; DEFINE EXPRESSIONS
;;
;;
[(zodiac:define-values-form? ast)
(if (null? (zodiac:define-values-form-vars ast))
;; (define-values () e) => (let-values [() e] (void))
(zodiac:make-let-values-form
(zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
(list null)
(list (prephase! (zodiac:define-values-form-val ast) in-mod? #t #f))
(zodiac:make-special-constant 'void))
;; Normal prephase
(begin
(zodiac:set-define-values-form-vars!
ast
(map (lambda (e) (prephase! e in-mod? #t #f))
(zodiac:define-values-form-vars ast)))
(zodiac:set-define-values-form-val!
ast
(prephase! (zodiac:define-values-form-val ast) in-mod? #t (zodiac:define-values-form-vars ast)))
ast))]
;;----------------------------------------------------------
;; DEFINE-SYNTAX or DEFINE-FOR-SYNTAX
;;
[(or (zodiac:define-syntaxes-form? ast)
(zodiac:define-for-syntax-form? ast))
(let ([get-names (if (zodiac:define-for-syntax-form? ast)
zodiac:define-for-syntax-form-names
zodiac:define-syntaxes-form-names)]
[get-expr (if (zodiac:define-for-syntax-form? ast)
zodiac:define-for-syntax-form-expr
zodiac:define-syntaxes-form-expr)])
(let ([ast
(zodiac:make-define-syntaxes-form
(zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
(map (lambda (e) (prephase! e in-mod? #t #f))
(get-names ast))
(prephase! (zodiac:make-app
(zodiac:zodiac-stx ast)
(make-empty-box)
(zodiac:make-top-level-varref
for-syntax-in-env-stx
(make-empty-box)
'for-syntax-in-env
#f
for-syntax-slot
#t
#f
#f)
(list
(zodiac:make-case-lambda-form
(zodiac:zodiac-stx ast)
(make-empty-box)
(list (zodiac:make-list-arglist null))
(list (get-expr ast)))))
in-mod?
#t (get-names ast)))])
(set-annotation! ast in-mod?)
ast))]
;;-----------------------------------------------------------
;; APPLICATIONS
;;
;; check for unsupported syntactic forms that end up
;; looking like applications
;;
;; We'll hack in a rewrite here that turns
;; ((lambda (x*) M) y*) -> (let ([x y]*) M)
;;
[(zodiac:app? ast)
;; Check for 'mzc-cffi attribute:
(if (syntax-property (zodiac:zodiac-stx ast) 'mzc-cffi)
;; Really a c-declare
(let* ([quote-expr (caddr (zodiac:app-args ast))]
[str (syntax-e (zodiac:zodiac-stx (zodiac:quote-form-expr quote-expr)))])
(register-c-declaration str)
;; return a void
(zodiac:make-quote-form (zodiac:zodiac-stx ast)
(make-empty-box)
(zodiac:make-zread
(datum->syntax-object #f (void) #f))))
(let ([process-normally
(lambda ()
(zodiac:set-app-fun!
ast
(prephase! (zodiac:app-fun ast) in-mod? #t #f))
(let ([adhoc (preprocess:adhoc-app-optimization
ast
(lambda (x)
(prephase! x in-mod? #t #f)))])
(if adhoc
(prephase! adhoc in-mod? need-val? name)
(begin
(zodiac:set-app-args!
ast
(map (lambda (e) (prephase! e in-mod? #t #f))
(zodiac:app-args ast)))
ast))))])
(if (and (zodiac:case-lambda-form? (zodiac:app-fun ast))
(not (syntax-property (zodiac:zodiac-stx (zodiac:app-fun ast)) 'mzc-cffi))
(= 1 (length (zodiac:case-lambda-form-args
(zodiac:app-fun ast))))
(zodiac:list-arglist?
(car (zodiac:case-lambda-form-args
(zodiac:app-fun ast)))))
;; optimize to let
(let* ([L (zodiac:app-fun ast)]
[args (zodiac:app-args ast)]
[ids (zodiac:arglist-vars
(car (zodiac:case-lambda-form-args L)))]
[body (car (zodiac:case-lambda-form-bodies L))]
[ok? (= (length ids) (length args))])
(unless ok?
((if (compiler:option:stupid) compiler:warning compiler:error)
ast
"wrong number of arguments to literal function"))
(if (not ok?)
(process-normally)
(prephase!
(zodiac:make-let-values-form
(zodiac:zodiac-stx ast)
(zodiac:parsed-back ast)
(map list ids)
args
body)
in-mod?
need-val?
name)))
;; don't optimize
(process-normally))))]
;;-----------------------------------------------------------
;; WITH-CONTINUATION-MARK
;;
[(zodiac:with-continuation-mark-form? ast)
(zodiac:set-with-continuation-mark-form-key!
ast
(prephase! (zodiac:with-continuation-mark-form-key ast) in-mod? #t #f))
(zodiac:set-with-continuation-mark-form-val!
ast
(prephase! (zodiac:with-continuation-mark-form-val ast) in-mod? #t #f))
(zodiac:set-with-continuation-mark-form-body!
ast
(prephase! (zodiac:with-continuation-mark-form-body ast) in-mod? need-val? name))
ast]
;;-----------------------------------------------------------
;; REQUIRE/PROVIDE
;;
[(zodiac:require/provide-form? ast)
;; Change to namespace[-transformer]-require calls:
(let-values ([(elems proc)
(syntax-case (zodiac:zodiac-stx ast) (require require-for-syntax)
[(require . elem)
(values (syntax->list (syntax elem))
'namespace-require)]
[(require-for-syntax . elem)
(values (syntax->list (syntax elem))
'namespace-transformer-require)])])
(let ([proc (zodiac:make-top-level-varref
(datum->syntax-object
#f
'namespace-require
(zodiac:zodiac-stx ast))
(make-empty-box)
proc
'#%kernel
(box '())
#f
#f
#f)])
(prephase!
(zodiac:make-begin-form
(zodiac:zodiac-stx ast)
(make-empty-box)
(map (lambda (elem)
(zodiac:make-app
(zodiac:zodiac-stx ast)
(make-empty-box)
proc
(list (zodiac:make-quote-form
(zodiac:zodiac-stx ast)
(make-empty-box)
(zodiac:make-zread
elem)))))
elems))
in-mod? need-val? name)))]
;;-----------------------------------------------------------
;; QUOTE-SYNTAX
;;
[(zodiac:quote-syntax-form? ast)
ast]
;;-----------------------------------------------------------
;; MODULE
;;
[(zodiac:module-form? ast)
(let-values ([(mi smi) (make-module-invokes
(zodiac:module-form-self-path-index ast))])
(set-annotation! ast (make-module-info mi smi #f)))
(zodiac:set-module-form-body!
ast
(prephase! (zodiac:module-form-body ast)
#t #f #f))
(zodiac:set-module-form-syntax-body!
ast
(prephase! (zodiac:module-form-syntax-body ast)
#t #f #f))
ast]
;;-----------------------------------------------------------
;; Unsupported forms
;;
[else (compiler:fatal-error
ast
(format "unsupported syntactic form ~a" ast))
ast]))])
prephase!)))))

240
collects/compiler/private/rep.ss Normal file
View File

@ -0,0 +1,240 @@
;; Representation choosing phase of the the compiler
;; (c) 1996-1997 Sebastian Good
;; (c) 1997-201 PLT
;; Chooses the representation of all bindings, and also
;; closures.
;; Currently, all variables for Scheme values are represented
;; as Scheme_Object* values. But representations are also
;; chosen for closures and indirected Scheme variables, so
;; not everything is a Scheme_Object*.
;;; Annotatitons: ----------------------------------------------
;; binding - `binding' structure UPDATED: rep field set
;;; ------------------------------------------------------------
(module rep mzscheme
(require (lib "unitsig.ss"))
(require (lib "zodiac-sig.ss" "syntax"))
(require "sig.ss")
(require "../sig.ss")
(provide rep@)
(define rep@
(unit/sig compiler:rep^
(import compiler:library^
compiler:cstructs^
compiler:analyze^
(zodiac : zodiac^)
compiler:zlayer^
compiler:const^
compiler:vehicle^
compiler:driver^)
;;----------------------------------------------------------------------------
;; REPRESENTATION (TYPE) LANGUAGE
;;
;; future : add const?
;;
(define-struct rep:atomic (type))
;; Where type is one of:
;; 'scheme-object
;; 'scheme-bucket
;; 'scheme-per-load-static
;; 'scheme-per-invoke-static
;; 'label
;; 'prim
;; 'prim-case
;; 'begin0-saver
;; 'wcm-saver
(define-struct rep:pointer (to))
(define-struct rep:struct (name orig-name fields))
(define-struct rep:struct-field (name orig-name rep))
(define-struct (rep:atomic/invoke rep:atomic) (module-invoke))
(define (rep:same-shape? a b)
(let ([al (rep:struct-fields a)]
[bl (rep:struct-fields b)])
(and (= (length al) (length bl))
(andmap (lambda (af bf)
(let ([ar (rep:struct-field-rep af)]
[br (rep:struct-field-rep bf)])
(or (and (rep:atomic? ar)
(rep:atomic? br)
(eq? (rep:atomic-type ar)
(rep:atomic-type br))
(or (not (rep:atomic/invoke? ar))
(eq? (rep:atomic/invoke-module-invoke ar)
(rep:atomic/invoke-module-invoke br))))
(and (rep:struct? ar)
(rep:struct? br)
(eq? (rep:struct-name ar)
(rep:struct-name br))))))
al bl))))
(define compiler:struct-index 0)
(define compiler:structs null)
(define (compiler:init-structs!)
(set! compiler:structs null))
(define compiler:add-struct!
(lambda (struct)
(let loop ([l compiler:structs])
(cond
[(null? l)
(let ([name (string->symbol (format "mergedStructs~a" compiler:struct-index))])
(set! compiler:struct-index (add1 compiler:struct-index))
(set-rep:struct-name! struct name)
(let loop ([l (rep:struct-fields struct)][n 0])
(unless (null? l)
(unless (rep:struct-field-name (car l))
(set-rep:struct-field-name! (car l)
(string->symbol
(format "f~a" n))))
(loop (cdr l) (add1 n)))))
(set! compiler:structs (cons struct compiler:structs))]
[(rep:same-shape? struct (car l))
(set-rep:struct-name! struct (rep:struct-name (car l)))
(let loop ([nl (rep:struct-fields struct)]
[ol (rep:struct-fields (car l))])
(unless (null? nl)
(set-rep:struct-field-name! (car nl)
(rep:struct-field-name (car ol)))
(loop (cdr nl) (cdr ol))))]
[else (loop (cdr l))]))))
(define (compiler:get-structs) compiler:structs)
(define (rep:find-field struct orig-name)
(let loop ([l (rep:struct-fields struct)])
(if (null? l)
(compiler:internal-error
#f
(format
"vm:find-field: ~a not found in ~a" orig-name
(rep:struct-fields struct)))
(if (eq? (rep:struct-field-orig-name (car l)) orig-name)
(rep:struct-field-name (car l))
(loop (cdr l))))))
;;----------------------------------------------------------------------------
;; choose-binding-representations! implements the lion's share of work in
;; chosing representations. It takes 3 inputs:
;; 1) a <set> of variables occurring local to an expression
;; 2) a <set> of those variables which are globals
;; 3) a <set> of those variables which are used
;; 4) a <set> of those variables which are captured
;; and returns no values
;;
;; As a side effect, it sets the representation fields of all those
;; struct:bindings living in those compiler:bound guys.
(define choose-binding-representations!
(lambda (local-vars global-vars used-vars captured-vars)
(let ([set-rep!
(lambda (local-var)
(let ([binding (get-annotation local-var)])
(unless (binding-rep binding)
(set-binding-rep! binding
(if (or (binding-mutable? binding)
(binding-letrec-set? binding)
(binding-ivar? binding))
(make-rep:pointer
(make-rep:atomic 'scheme-object))
(make-rep:atomic 'scheme-object))))))])
(for-each set-rep! (set->list local-vars)))))
;;----------------------------------------------------------------------------
;; choose-closure-representation! chooses representations for a closure
;; it takes 1 input
;; 1) a code structure
;;
;; and returns no values
;;
;; As a side effect, it sets the closure-code-rep field of the code structure
;; based on its free variables. It must be called _after_ binding
;; representations have been chosen
;;
(define choose-closure-representation!
(lambda (code)
(let* ([base (gensym)]
[struct (let ([fields
(append! (if (vehicle:only-code-in-vehicle? code)
null
(list
(make-rep:struct-field 'label
'label
(make-rep:atomic 'label))))
(map (lambda (bound)
(make-rep:struct-field
;; field-name
#f
(zodiac:binding-var bound)
;; field-type
(binding-rep (get-annotation bound))))
(set->list (code-free-vars code)))
(map (lambda (global)
(make-rep:struct-field
;; field-name
(if (const:per-load-statics-table? global)
'pls
(if (varref:module-invoke? global)
'pmis
#f))
(if (or (const:per-load-statics-table? global)
(varref:module-invoke? global))
global
(mod-glob-cname global))
;; field-type
(if (const:per-load-statics-table? global)
(make-rep:atomic 'scheme-per-load-static)
(if (varref:module-invoke? global)
(make-rep:atomic/invoke
'scheme-per-invoke-static
global)
(make-rep:atomic 'scheme-bucket)))))
(set->list (code-global-vars code))))])
(if (null? fields)
#f ; empty structure - don't use anything
(make-rep:struct
;; name
#f
(symbol-append 'struct base)
fields)))])
(when struct
(compiler:add-struct! struct))
(let* ([fields (append (cond
[(procedure-code? code)
(list
(make-rep:struct-field 'prim
'prim
(if (= 1 (length (procedure-code-case-codes code)))
(make-rep:atomic 'prim)
(make-rep:atomic 'prim-case))))]
[else
(compiler:internal-error
#f
"unknown closure code type: ~s" code)])
(if struct
(list
(make-rep:struct-field 'data
'data
struct))
null))]
[alloc-struct (if (null? fields)
#f
(make-rep:struct
; name
#f
(symbol-append 'allocstruct base)
fields))])
(when alloc-struct
(compiler:add-struct! alloc-struct))
(set-closure-code-rep! code struct)
(set-closure-code-alloc-rep! code alloc-struct)))))
)))

460
collects/compiler/private/sig.ss Normal file
View File

@ -0,0 +1,460 @@
(module sig mzscheme
(require (lib "unitsig.ss"))
(require "../sig.ss")
(require (lib "zodiac-sig.ss" "syntax"))
(define for-syntax-in-env-stx #'for-syntax-in-env)
(provide for-syntax-in-env-stx)
(provide compiler:library^)
(define-signature compiler:library^
(logical-inverse
one-of
all-of
none-of
vector-map
improper-map
begin-map!
begin-map
map!
list-index
list-last
set?
empty-set
make-singleton-set
list->set
set->list
improper-list->set
set-memq?
set-empty?
set-find
set-union
set-union-singleton
set-minus
set-remove
set-intersect
set-subset?
set-map
set-filter
remove-duplicates
symbol-append
compiler:formals->arity
compiler:formals->arity*
compiler:gensym
compiler:genlabel
compiler:clean-string
protect-comment
global-defined-value*
compiler:get-label-number
compiler:reset-label-number!))
(provide compiler:cstructs^)
(define-signature compiler:cstructs^
(varref:empty-attributes
varref:add-attribute!
varref:has-attribute?
varref:invoke-module
varref:static
varref:per-load-static
varref:per-invoke-static
varref:primitive
varref:symbol
varref:inexact
varref:env
varref:in-module
varref:module-stx-string
(struct varref:module-invoke (id syntax? context-path-index))
make-module-invokes
get-num-module-invokes
is-module-invoke?
varref:reset-module-id!
(struct compiler:make-closure (lambda free-vars args name))
(struct binding (rec? ; part of a letrec recursive binding set
mutable? ; set!ed?
anchor ; anchor binding for this binding
letrec-set?; set! for a letrec definition
ivar? ; is a class ivar?
known? val ; has known value?
known-but-used? ; known value used in an improper way?
rep)) ; reprsentation
copy-binding
copy-binding-for-light-closures
binder:empty-anno
(struct code (free-vars local-vars global-vars used-vars captured-vars
parent case-parent children))
(struct closure-code (rep alloc-rep label vehicle
max-arity
return-multi ; #f, #t, or 'possible
name))
(struct procedure-code (case-codes case-arities liftable method?))
(struct case-code (has-continue?))
(struct app (tail? prim? prim-name))
(struct module-info (invoke syntax-invoke part))
varref:current-invoke-module
compiler:bound-varref->binding
(struct c-lambda (function-name scheme-name body arity))
(struct compiler:message (ast message))
(struct compiler:error-msg ())
(struct compiler:fatal-error-msg ())
(struct compiler:internal-error-msg ())
(struct compiler:warning-msg ())))
(provide compiler:zlayer^)
(define-signature compiler:zlayer^
(static-error
dynamic-error
internal-error
compiler:empty-annotation
make-empty-box
get-annotation
set-annotation!
annotated?
remove-annotation!
compiler:escape-on-error
zodiac:begin0-form-first
zodiac:begin0-form-rest
zodiac:set-begin0-form-first!
zodiac:set-begin0-form-rest!
undefined?
zodiac:make-special-constant
self_modidx
zodiac:binding->lexical-varref
main-source-file
zodiac:print-start!
zodiac->sexp/annotate))
(provide compiler:prephase^)
(define-signature compiler:prephase^
(prephase:init-binding-properties!
prephase:set-mutable!
prephase:set-binding-anchor!
prephase:is-mutable?
prephase:is-ivar?
prephase:binding-anchor
prephase:known-val
prephase:set-known-val!
prephase!))
(provide compiler:anorm^)
(define-signature compiler:anorm^
(a-normalize))
(provide compiler:const^)
(define-signature compiler:const^
(const:init-tables!
const:the-per-load-statics-table
const:per-load-statics-table?
const:get-symbol-counter
const:get-symbol-table
const:get-inexact-counter
const:get-inexact-table
const:get-string-table
const:get-bytes-table
const:intern-string
compiler:add-const!
compiler:get-symbol-const!
compiler:construct-const-code!
compiler:get-static-list
compiler:get-per-load-static-list
compiler:get-per-invoke-static-list
compiler:add-per-load-static-list!
compiler:add-per-invoke-static-list!
compiler:make-const-constructor
const:make-syntax-constant
const:reset-syntax-constants!
const:finish-syntax-constants!
(struct syntax-string (str mi uposes ustart id))
const:get-syntax-strings
(struct compiled-string (id len))))
(provide compiler:rep^)
(define-signature compiler:rep^
((struct rep:atomic (type))
(struct rep:pointer (to))
(struct rep:struct (name orig-name fields))
(struct rep:struct-field (name orig-name rep))
(struct rep:atomic/invoke (module-invoke))
compiler:get-structs
compiler:init-structs!
rep:find-field
choose-binding-representations!
choose-closure-representation!))
(provide compiler:known^)
(define-signature compiler:known^
(make-unknown-letbound-binding
extract-varref-known-val
extract-ast-known-value
analyze-knowns!))
(provide compiler:analyze^)
(define-signature compiler:analyze^
(compiler:get-global-symbols
compiler:get-primitive-refs
compiler:get-define-list
compiler:get-per-load-define-list
compiler:get-per-invoke-define-list
compiler:init-define-lists!
compiler:add-global-varref!
compiler:add-primitive-varref!
compiler:add-local-define-list!
compiler:add-local-per-load-define-list!
compiler:add-local-per-invoke-define-list!
(struct case-info (body case-code global-vars used-vars captured-vars max-arity))
(struct mod-glob (cname modname varname position exp-time? exp-def? in-module?))
compiler:get-module-path-constant
compiler:finish-syntax-constants!
analyze-expression!))
(provide compiler:lift^)
(define-signature compiler:lift^
(lift-lambdas!
set-single-module-mode!))
(provide compiler:closure^)
(define-signature compiler:closure^
(compiler:get-closure-list
compiler:get-once-closures-list
compiler:get-once-closures-globals-list
compiler:get-lifted-lambdas
compiler:get-lifted-lambda-vars
compiler:init-closure-lists!
compiler:init-once-closure-lists!
compiler:init-lifted-lambda-list!
compiler:add-lifted-lambda!
(struct top-level-varref/bind-from-lift (lambda pls?))
closure-expression!))
(provide compiler:vehicle^)
(define-signature compiler:vehicle^
((struct vehicle (total-labels lambdas max-arity))
(struct procedure-vehicle (max-args))
compiler:get-vehicles
compiler:get-total-vehicles
compiler:get-case-lambdas
compiler:init-vehicles!
get-vehicle
relate-lambdas!
vehicle:only-code-in-vehicle?
choose-vehicles!))
(provide compiler:vmstructs^)
(define-signature compiler:vmstructs^
((struct vm:sequence (vals))
(struct vm:if (test then else))
(struct vm:module-body (vals invoke syntax?))
(struct vm:void (val))
(struct vm:return (val))
(struct vm:tail-apply (closure argc prim))
(struct vm:tail-call (label closure set-env?))
(struct vm:continue ())
(struct vm:set! (vars val mode))
(struct vm:generic-args (closure tail? prim vals))
(struct vm:register-args (vars vals))
(struct vm:args (type vals))
(struct vm:begin0-mark! (var val))
(struct vm:begin0-setup! (var))
(struct vm:syntax! (vars val in-mod?))
(struct vm:alloc (type))
(struct vm:build-constant (text))
(struct vm:make-closure (closure))
(struct vm:make-procedure-closure (vehicle min-arity max-arity name empty? method?))
(struct vm:make-case-procedure-closure (vehicle num-cases case-arities name empty? method?))
(struct vm:apply (closure argc known? multi? prim simple-tail-prim?))
(struct vm:macro-apply (name primitive args tail? bool?))
(struct vm:call (label closure))
(struct vm:begin0-extract (var))
(struct vm:wcm-mark! (key val))
(struct vm:wcm-push! (var))
(struct vm:wcm-pop! (var))
(struct vm:wcm-remember! (var val))
(struct vm:wcm-extract (var))
(struct vm:check-global (var))
(struct vm:module-create (shape id))
(struct vm:global-varref (var))
(struct vm:bucket (var))
(struct vm:per-load-statics-table ())
(struct vm:per-invoke-statics-table ())
(struct vm:cast (val rep)) ; last resort
(struct vm:local-varref (var binding))
(struct vm:static-varref (var))
(struct vm:static-varref-from-lift (lambda))
(struct vm:per-load-static-varref ())
(struct vm:per-invoke-static-varref ())
(struct vm:per-load-static-varref-from-lift (lambda))
(struct vm:per-invoke-static-varref-from-lift (lambda))
(struct vm:primitive-varref (var))
(struct vm:symbol-varref (var))
(struct vm:inexact-varref (var))
(struct vm:struct-ref (field var))
(struct vm:deref (var))
(struct vm:ref (var))
(struct vm:immediate (text))
(struct vm:struct-type (fields))
vm:box-struct-type
arg-type:register
arg-type:arg
arg-type:tail-arg
target-type:global
target-type:lexical
target-type:static
vm:control-return?
vm:fixnum?
vm:literal-constant?))
(provide compiler:vmphase^)
(define-signature compiler:vmphase^
(vm:convert-bound-varref
vm-phase))
(provide compiler:vmopt^)
(define-signature compiler:vmopt^
(vm-optimize!))
(provide compiler:driver^)
(define-signature compiler:driver^
((open compiler:inner^)
compiler:error
compiler:fatal-error
compiler:internal-error
compiler:warning
get-s:file-block
s:register-max-arity!
compiler:get-setup-suffix
compiler:multi-o-constant-pool
register-c-lambda-function
register-c-declaration
debug
debug:get-port))
(provide compiler:top-level^)
(define-signature compiler:top-level^
((struct block (source codes max-arity))
make-empty-block
block:register-max-arity!
add-code-local+used-vars!
remove-code-free-vars!))
(provide compiler:vm2c^)
(define-signature compiler:vm2c^
(vm->c:generate-modglob-name
vm->c:indent-by
vm->c:indent-spaces
vm->c:extract-inferred-name
vm->c:emit-symbol-list!
vm->c:emit-symbol-declarations!
vm->c:emit-symbol-definitions!
vm->c:emit-syntax-string-declarations!
vm->c:emit-syntax-string-definitions!
vm->c:emit-inexact-declarations!
vm->c:emit-inexact-definitions!
vm->c:emit-string-declarations!
vm->c:emit-prim-ref-declarations!
vm->c:emit-prim-ref-definitions!
vm->c:emit-struct-definitions!
vm->c:emit-static-declarations!
vm->c:emit-registration!
vm->c:emit-case-arities-definitions!
vm->c:emit-top-levels!
vm->c:emit-module-glue!
vm->c:emit-vehicle-prototype
vm->c:emit-vehicle-declaration
vm->c:emit-vehicle-header
vm->c:emit-vehicle-prologue
vm->c:emit-vehicle-epilogue
vm->c:convert-type-definition
vm->c:emit-function-prologue
vm->c:emit-case-prologue
vm->c:emit-case-epilogue
vm->c:emit-function-epilogue
vm->c-expression))
(provide compiler:basic-link^)
(define-signature compiler:basic-link^
((unit ZODIAC : zodiac^)
(unit ZLAYER : compiler:zlayer^)
(unit DRIVER : compiler:driver^)
(unit LIBRARY : compiler:library^))))

84
collects/compiler/private/toplevel.ss Normal file
View File

@ -0,0 +1,84 @@
;; routines for top-level entities
;; (c) 1996-1997 Sebastian Good
;; (c) 1997-2001 PLT
(module toplevel mzscheme
(require (lib "unitsig.ss"))
(require "sig.ss")
(provide toplevel@)
(define toplevel@
(unit/sig
compiler:top-level^
(import compiler:library^
compiler:cstructs^)
;;-------------------------------------------------------------
;; This contains information about a top-level block, either at
;; file level, or within a unit; typically a sequence of defines
;; but could be anything
;;
(define-struct block (source ; list of top-level ASTs
codes ; list of `code' structures (in parallel with source)
max-arity))
(define make-empty-block (lambda () (make-block null null 0)))
(define block:register-max-arity!
(lambda (b n)
(set-block-max-arity! b (max n (block-max-arity b)))))
;; Add a local variable to a code record.
;; If the local variable is in a case-code, add it from
;; the case-code and it will be automatically added
;; to the case-code's parent procedure-code.
(define (add-code-local+used-vars! code vars)
(set-code-local-vars! code (set-union vars (code-local-vars code)))
(set-code-used-vars! code (set-union vars (code-used-vars code)))
(when (case-code? code)
;; If this is just a case, also add it to the parent,
;; which is the real closure
(add-code-local+used-vars! (code-parent code) vars)))
;; Remove a free variable from a code record.
;; If the free variable is used in a case-code, remove it from
;; the case-code and it will be automatically removed
;; from the case-code's parent procedure-code (if appropriate).
(define (remove-code-free-vars! code vars)
(set-code-free-vars! code (set-minus (code-free-vars code) vars))
(set-code-captured-vars! code (set-minus (code-captured-vars code) vars))
(let ([code (if (case-code? code)
;; If this is just a case, recalculate the parent's free,
;; which is the free set for the real closure
(let ([code (code-parent code)])
(let loop ([fv empty-set]
[cv empty-set]
[cases (procedure-code-case-codes code)])
(if (null? cases)
(begin
(set-code-free-vars! code fv)
(set-code-captured-vars! code cv))
(loop (set-union (code-free-vars (car cases)) fv)
(set-union (code-captured-vars (car cases)) cv)
(cdr cases))))
code)
code)])
;; At this point, we go the code's parent and
;; adjust the free/captured variable information.
(let ([pcode (or (code-case-parent code)
(code-parent code))])
(when pcode
(let ([children (code-children pcode)])
(unless (ormap (lambda (child)
(not (set-empty? (set-intersect vars (code-free-vars code)))))
children)
;; No other child uses the variable
(remove-code-free-vars! pcode vars)))))))
;; Notes on some other possible functions:
;; add-code-global-vars - add to all [case-]ancestors
;; remove-code-captured-vars - parent handling is the same
;; as remove-code-free-vars
)))

251
collects/compiler/private/vehicle.ss Normal file
View File

@ -0,0 +1,251 @@
;; vehicle choosing phase for closures
;; (c) 1996-1997 Sebastian Good
;; (c) 1997-2001 PLT
; Assign closures to ``vehicles'', and collect information for
; MzScheme about the closures.
; A vehicle is a C function that implements the body of a
; closure. Multiple closures may be assigned to a single
; vehicle to improve the performance of tail calls.
; The relate-lambdas! procedure is used to put procedure
; code into equivalence sets. If A contains a tail-call to
; B, they're put in the same equivalence class, and then
; they'll be implemented in the same vehicle, so A's call
; to B can be implemented as a goto.
;;; Annotatitons: ----------------------------------------------
;; lambda: `code' structure UPDATED: label and
;; vehicle are set
;;; ------------------------------------------------------------
(module vehicle mzscheme
(require (lib "unitsig.ss"))
(require (lib "zodiac-sig.ss" "syntax"))
(require "sig.ss")
(require "../sig.ss")
(provide vehicle@)
(define vehicle@
(unit/sig
compiler:vehicle^
(import (compiler:option : compiler:option^)
compiler:library^
compiler:cstructs^
(zodiac : zodiac^)
compiler:zlayer^
compiler:const^
compiler:known^
compiler:closure^
compiler:driver^)
;; Used for union-find for lambda vehicles:
(define (get-vehicle-top code)
(let loop ([code code])
(let ([c (closure-code-vehicle code)])
(if (code? c)
(let ([top (loop c)])
(set-closure-code-vehicle! code top)
top)
code))))
(define-struct vehicle (total-labels lambdas max-arity))
(define-struct (procedure-vehicle vehicle) (max-args))
(define vehicle:procedure 'vehicle:procedure)
(define vehicles:automatic 'vehicles:automatic)
(define vehicles:functions 'vehicles:functions)
(define vehicles:monolithic 'vehicles:monolithic)
(define (make-empty-vehicle type)
(case type
[(vehicle:procedure) (make-procedure-vehicle 0 null 0 0)]))
(define (vehicle-is-type? v type)
(case type
[(vehicle:procedure) (procedure-vehicle? v)]))
(define compiler:vehicles #f)
(define compiler:total-vehicles 0)
(define vehicle:add-lambda!
(lambda (v type l)
(let ([old-v (hash-table-get compiler:vehicles v
(lambda () (make-empty-vehicle type)))])
(unless (vehicle-is-type? old-v type)
(compiler:internal-error
#f
"can't use vehicle ~a as type ~a"
old-v type))
(set-vehicle-lambdas! old-v (cons l (vehicle-lambdas old-v)))
(hash-table-put! compiler:vehicles v old-v))))
(define vehicle:register-max-arity!
(lambda (v n)
(set-vehicle-max-arity! v (max n (vehicle-max-arity v)))))
(define vehicle:register-max-args!
(lambda (v n)
(set-procedure-vehicle-max-args! v (max n (procedure-vehicle-max-args v)))))
;; These lists are built up backwards, so reverse it before outputting the list
(define compiler:case-lambdas null)
(define (compiler:get-vehicles) compiler:vehicles)
(define (compiler:get-total-vehicles) compiler:total-vehicles)
(define (compiler:get-case-lambdas) compiler:case-lambdas)
(define (compiler:init-vehicles!)
(set! compiler:vehicles (make-hash-table))
(set! compiler:total-vehicles 0)
(set! compiler:case-lambdas null))
(define choose-vehicles!
(lambda ()
(when (eq? (compiler:option:vehicles) vehicles:monolithic)
(set! compiler:total-vehicles (compiler:option:vehicles:monoliths)))
(for-each (lambda (L)
(let* ([code (get-annotation L)]
[type (cond
[(zodiac:case-lambda-form? L) vehicle:procedure])]
[new-vehicle
(lambda ()
(begin0 compiler:total-vehicles
(set! compiler:total-vehicles
(+ 1 compiler:total-vehicles))))]
[vnum (case (compiler:option:vehicles)
[(vehicles:automatic)
(case type
[(vehicle:procedure)
(let* ([top (get-vehicle-top code)]
[n (or (closure-code-vehicle top)
(new-vehicle))])
(set-closure-code-vehicle! top n)
(set-closure-code-vehicle! code n)
n)])]
[(vehicles:monolithic)
(case type
[(vehicle:procedure) (random (compiler:option:vehicles:monoliths))])]
[(vehicles:functions) (new-vehicle)]
[else (compiler:internal-error
#f
(format "bad option:vehicles - ~a" (compiler:option:vehicles)))])])
(set-closure-code-vehicle! code vnum)
(vehicle:add-lambda! vnum type L)
;; assign label, too
(let* ([vehicle (hash-table-get compiler:vehicles
vnum
(lambda ()
(compiler:internal-error
#f "bad hash table lookup (2)~n")))]
[curr-label (vehicle-total-labels vehicle)])
(vehicle:register-max-arity! vehicle (closure-code-max-arity code))
(s:register-max-arity! (closure-code-max-arity code))
(cond
[(procedure-vehicle? vehicle)
(vehicle:register-max-args!
vehicle
(apply max
(cons
0
(map (lambda (a) (length (zodiac:arglist-vars a)))
(zodiac:case-lambda-form-args L)))))]
[else (void)])
(set-closure-code-label! code curr-label)
(set-vehicle-total-labels! vehicle (+ 1 curr-label)))
;; We take this opportunity to collect other top-level info
;; that is closure-type-specific
(cond
[(zodiac:case-lambda-form? L)
(unless (= 1 (length (zodiac:case-lambda-form-args L)))
(set-procedure-code-case-arities! code (length compiler:case-lambdas))
(set! compiler:case-lambdas (cons L compiler:case-lambdas)))])))
(compiler:get-closure-list))))
(define (get-vehicle vehicle-number)
(hash-table-get compiler:vehicles
vehicle-number
(lambda ()
;; not an error because random placement
;; may leave some vehicles empty
(let ([v (make-empty-vehicle vehicle:procedure)])
(hash-table-put! compiler:vehicles vehicle-number v)
v))))
;; Traverse an AST and relate closure current-lambda to Y if
;; the AST includes a tail-call to Y.
(define relate-lambdas!
(letrec
([same-vehicle!
(lambda (a b)
(let ([a-top (get-vehicle-top (get-annotation a))]
[b-top (get-vehicle-top (get-annotation b))])
(unless (eq? a-top b-top)
(set-closure-code-vehicle! a-top b-top))))]
[relate!
(lambda (current-lambda ast)
(cond
;;------------------------------------------------------------------
;; LET EXPRESSIONS
;;
[(zodiac:let-values-form? ast)
(relate! current-lambda (zodiac:let-values-form-body ast))]
[(zodiac:letrec-values-form? ast)
(relate! current-lambda (zodiac:letrec-values-form-body ast))]
;;-----------------------------------------------------------------
;; IF EXPRESSIONS
;;
[(zodiac:if-form? ast)
(relate! current-lambda (zodiac:if-form-then ast))
(relate! current-lambda (zodiac:if-form-else ast))]
;;------------------------------------------------------------------
;; BEGIN EXPRESSIONS
;;
[(zodiac:begin-form? ast)
(let loop ([l (zodiac:begin-form-bodies ast)])
(if (null? (cdr l))
(relate! current-lambda (car l))
(loop (cdr l))))]
;;------------------------------------------------------------------
;; WITH-CONTINUATION-MARK EXPRESSIONS
;;
[(zodiac:with-continuation-mark-form? ast)
(relate! current-lambda (zodiac:with-continuation-mark-form-body ast))]
;;-----------------------------------------------------------
;; MODULE
;;
[(zodiac:module-form? ast)
(relate! current-lambda (zodiac:module-form-body ast))]
;;-----------------------------------------------------------------
;; APPLICATIONS
;;
;; Check for known func & relate to this one
;;
[(zodiac:app? ast)
(let ([f (zodiac:app-fun ast)])
(cond
[(or (zodiac:bound-varref? f)
(top-level-varref/bind-from-lift? f))
(let ([known (extract-varref-known-val f)])
(and known
(when (zodiac:case-lambda-form? known)
(same-vehicle! current-lambda known))))]
[else (void)]))]
[else (void)]))])
(lambda (current-lambda ast) (relate! current-lambda ast))))
(define (vehicle:only-code-in-vehicle? code)
(= (vehicle-total-labels (get-vehicle (closure-code-vehicle code))) 1)))))

1733
collects/compiler/private/vm2c.ss Normal file
View File

File diff suppressed because it is too large Load Diff

583
collects/compiler/private/vmopt.ss Normal file
View File

@ -0,0 +1,583 @@
;; VM Optimization pass
;; (c) 1996-1997 Sebastian Good
;; (c) 1997-201 PLT
;; This pass only allows T & V statements to be expanded into multiple
;; statments there is not a mechanism to expand R, A, or L
;; expressions. (See vmscheme.ss.)
(module vmopt mzscheme
(require (lib "unitsig.ss")
(lib "list.ss")
(lib "etc.ss"))
(require (lib "zodiac-sig.ss" "syntax"))
(require "sig.ss")
(require "../sig.ss")
(provide vmopt@)
(define vmopt@
(unit/sig
compiler:vmopt^
(import (compiler:option : compiler:option^)
compiler:library^
compiler:cstructs^
(zodiac : zodiac^)
compiler:zlayer^
compiler:vmstructs^
compiler:known^
compiler:rep^
compiler:vmphase^
compiler:driver^)
(define satisfies-arity?
(lambda (arity L arglist)
(let-values ([(min-arity max-arity) (compiler:formals->arity*
(if arglist
(list arglist)
(zodiac:case-lambda-form-args L)))])
(if (= -1 max-arity)
(>= arity min-arity)
(= arity min-arity)))))
(define (select-case L argc)
(if L
(let loop ([args (zodiac:case-lambda-form-args L)][i 0])
(cond
[(null? args) (values #f #f)]
[(satisfies-arity? argc L (car args)) (values i (car args))]
[else (loop (cdr args) (add1 i))]))
(values #f #f)))
(define (case-label L label case)
(if (= 1 (length (zodiac:case-lambda-form-args L)))
label
(begin
(unless case
(compiler:internal-error
#f
(format "vm-optimize: bad case label ~a" case)))
(cons label case))))
(define a-val/l-val/immediate? (one-of vm:global-varref? vm:primitive-varref? vm:local-varref?
vm:symbol-varref? vm:inexact-varref?
vm:static-varref? vm:bucket?
vm:per-load-statics-table? vm:per-invoke-statics-table?
vm:struct-ref? vm:deref? vm:immediate?))
(define vm-optimize!
(lambda (current-lambda current-case)
(letrec ([closure-info
(lambda (closure)
(let* ([L #f]
[closure-label
(let loop ([closure closure])
(cond
[(or (vm:local-varref? closure)
(vm:static-varref-from-lift? closure)
(vm:per-load-static-varref-from-lift? closure)
(vm:per-invoke-static-varref-from-lift? closure))
(let ([known
(cond
[(vm:local-varref? closure) (extract-varref-known-val
(vm:local-varref-binding closure))]
[(vm:static-varref-from-lift? closure)
(vm:static-varref-from-lift-lambda closure)]
[(vm:per-load-static-varref-from-lift? closure)
(vm:per-load-static-varref-from-lift-lambda closure)]
[else
(vm:per-invoke-static-varref-from-lift-lambda closure)])])
(and known
(zodiac:case-lambda-form? known)
(begin (set! L known) #t)
(closure-code-label
(get-annotation known))))]
[(vm:deref? closure) (loop (vm:deref-var closure))]
[else #f]))])
(values L closure-label)))]
;; This takes action based on the label associated with the closure
;; passed in. There is a HACK here. The 'known' value of this lexical
;; varref is a lambda, even though we have eliminated lambda.
[with-closure
(lambda (closure closure-case unknown call recur)
(let-values ([(L closure-label) (closure-info closure)])
(let ([same-vehicle?
(and L
current-vehicle
(= current-vehicle
(closure-code-vehicle (get-annotation L))))])
((cond
[(not closure-label) unknown]
[(not current-lambda) call]
[(not current-label) call]
[(not current-vehicle) call]
[(and same-vehicle? (= closure-label current-label) (= closure-case current-case)) recur]
[else call])
closure-label
closure-case
L
same-vehicle?
))))]
[current-label
(and current-lambda
(closure-code-label (get-annotation current-lambda)))]
[current-vehicle
(and current-lambda
(closure-code-vehicle (get-annotation current-lambda)))]
[new-locs empty-set]
[add-local-var!
(lambda (binding)
(set! new-locs (set-union-singleton new-locs binding)))]
[process!
(lambda (ast)
(cond
;;====================================================================
;; BLOCK STATMENTS (B & S)
;;--------------------------------------------------------------------
;; SEQUENCE STATMENTS
;;
;; very simple. gather the transformations for each of the
;; instructions weave them back together into one sequence
;;
[(vm:sequence? ast)
(set-vm:sequence-vals! ast
(apply append!
(map process! (vm:sequence-vals ast))))
ast]
[(vm:module-body? ast)
(set-vm:module-body-vals! ast
(apply append!
(map process! (vm:module-body-vals ast))))
ast]
;;--------------------------------------------------------------------
;; IF STATEMENTS
;;
;; to reduce the nesting of ifs, especially in functional code, we
;; do the following optimization
;; (if A (sequence ... (RET X)) B) -->
;; (if A (sequence ... (RET X))), B
;; where RET is any instruction that terminates control such as
;; a return, tail-call, etc.
;;
[(vm:if? ast)
(let*-values ([(test) (apply append (map process! (vm:if-test ast)))]
[(test-setup test) (let loop ([l test][acc null])
(if (null? (cdr l))
(values (reverse! acc) (car l))
(loop (cdr l) (cons (car l) acc))))])
(append
test-setup
(begin
(set-vm:if-test! ast test)
(set-vm:if-then! ast (process! (vm:if-then ast)))
(set-vm:if-else! ast (process! (vm:if-else ast)))
(let* ([seq (vm:sequence-vals (vm:if-then ast))]
[last (and (pair? seq) ; optimizations can make it null
(list-last seq))])
(if (vm:control-return? last)
(begin0
(cons ast (vm:sequence-vals (vm:if-else ast)))
(set-vm:if-else! ast (make-vm:sequence #f '())))
(list ast))))))]
;;--------------------------------------------------------------------
;; BEGIN0 STATMENTS
;;
;;
[(vm:begin0-mark!? ast)
(set-vm:begin0-mark!-var! ast (car (process! (vm:begin0-mark!-var ast))))
(set-vm:begin0-mark!-val! ast (car (process! (vm:begin0-mark!-val ast))))
(list ast)]
[(vm:begin0-setup!? ast)
(set-vm:begin0-setup!-var! ast (car (process! (vm:begin0-setup!-var ast))))
(list ast)]
[(vm:begin0-extract? ast)
(set-vm:begin0-extract-var! ast (car (process! (vm:begin0-extract-var ast))))
(list ast)]
;;====================================================================
;; TAIL POSITION STATEMENTS
;;--------------------------------------------------------------------
;; VOID STATEMENT
;;
;; with dead code flags, we could throw it out
;;
[(vm:void? ast)
(let ([val (car (process! (vm:void-val ast)))])
(if (vm:immediate? val)
null
(begin
(set-vm:void-val! ast val)
(list ast))))]
;;--------------------------------------------------------------------
;; RETURN STATEMENT
;;
[(vm:return? ast)
(set-vm:return-val! ast (car (process! (vm:return-val ast))))
(list ast)]
;;--------------------------------------------------------------------
;; TAIL-APPLY STATEMENT
;;
;; if this is to a known function, turn this into a tail CALL
;; or if it is a tail-recursion, turn into a CONTINUE
;;
[(vm:tail-apply? ast)
(list
(let*-values ([(closure) (vm:tail-apply-closure ast)]
[(L closure-label) (closure-info closure)]
[(cl-case arglist) (select-case L (vm:tail-apply-argc ast))])
(if (and L (not (and cl-case
(zodiac:list-arglist? arglist)
(satisfies-arity? (vm:tail-apply-argc ast) L arglist))))
ast
(with-closure
closure
cl-case
;; unknown tail call site
(lambda (_ __ ___ ____) ast)
;; known tail call site
;; if the environment is empty, allow the backend to
;; eliminate the env-setting instruction
(lambda (label cl-case _ same-vehicle?)
(let* ([code (get-annotation L)]
[free-vars (code-free-vars code)]
[global-vars (code-global-vars code)])
(if same-vehicle?
(make-vm:tail-call
(zodiac:zodiac-stx ast)
(case-label L label cl-case)
closure
(or (not (set-empty? free-vars))
(not (set-empty? global-vars))))
ast)))
;; known tail recursion site
(lambda (label cl-case _ __)
(if (zodiac:list-arglist? arglist)
(begin
;; Mark the case as having a continue
(set-case-code-has-continue?!
(list-ref (procedure-code-case-codes (get-annotation L)) cl-case)
#t)
(make-vm:continue (zodiac:zodiac-stx ast)))
(make-vm:tail-call (zodiac:zodiac-stx ast)
(case-label L label cl-case)
closure)))))))]
;;====================================================================
;; NON-TAIL POSITION STATEMENTS
;;--------------------------------------------------------------------
;; SET! STATEMENTS
;;
;; if this binds multiple values, be sure the apply on the other end
;; is a multi-apply
;;
[(vm:set!? ast)
(when (vm:apply? (vm:set!-val ast))
(set-vm:apply-multi?!
(vm:set!-val ast)
(not (= 1 (length (vm:set!-vars ast))))))
(set-vm:set!-val! ast (car (process! (vm:set!-val ast))))
(list ast)]
;;--------------------------------------------------------------------
;; ARGS
;;
;; We implement a mapping of many types of function calls to 3 arg
;; types and check for arity if the call is to a known function
;;
;;
[(vm:generic-args? ast)
(if (vm:generic-args-prim ast)
(list (make-vm:args (zodiac:zodiac-stx ast)
(if (vm:generic-args-tail? ast)
arg-type:tail-arg
arg-type:arg)
(vm:generic-args-vals ast)))
(let*-values ([(L closure-label)
(closure-info (vm:generic-args-closure ast))]
[(tail?) (vm:generic-args-tail? ast)]
[(vals) (vm:generic-args-vals ast)]
[(cl-case arglist) (select-case L (length (vm:generic-args-vals ast)))])
(if (and closure-label
cl-case
(zodiac:list-arglist? arglist))
;; known function, fixed arity
(if (not (satisfies-arity? (length (vm:generic-args-vals ast))
L arglist))
(begin
((if (compiler:option:stupid) compiler:warning compiler:error )
ast
"procedure called with wrong number of arguments")
(list (make-vm:args (zodiac:zodiac-stx ast)
(if tail?
arg-type:tail-arg
arg-type:arg)
vals)))
(with-closure
(vm:generic-args-closure ast)
cl-case
;; unknown function - could be at a level where an
;; optimized jump is not allowed
(lambda (_ __ ___ ____)
(list (make-vm:args (zodiac:zodiac-stx ast)
(if tail?
arg-type:tail-arg
arg-type:arg)
vals)))
;; known call
(lambda (label cl-case L same-vehicle?)
(list (make-vm:args (zodiac:zodiac-stx ast)
(if tail?
(if same-vehicle?
arg-type:register
arg-type:tail-arg)
arg-type:arg)
vals)))
;; known recursion
;; tail recursion we just optimize to
;; set! of local variables
(lambda (label cl-case L _)
(if (not tail?)
(list (make-vm:args (zodiac:zodiac-stx ast)
arg-type:arg vals))
(let ([bindings (zodiac:arglist-vars
(list-ref (zodiac:case-lambda-form-args L)
cl-case))])
(let loop ([bindings bindings][vals vals][set-ok? #f])
(if (null? bindings)
null
(let* ([binding (car bindings)]
[val (car vals)]
[this-binding?
(lambda (val)
(let loop ([val val])
(or (and (vm:local-varref? val)
(eq? (vm:local-varref-binding val)
binding))
(and (vm:deref? val)
(loop (vm:deref-var val))))))])
;; If this is x = x, skip it.
(if (this-binding? val)
(loop (cdr bindings) (cdr vals) #f)
;; Check whether the binding we're about to set is needed later as a value.
;; If so, invent a new register
(if (and (not set-ok?)
(ormap this-binding? (cdr vals)))
(let* ([rep (binding-rep (get-annotation binding))]
[name (gensym)]
[new-binding (let ([b (zodiac:make-binding
#f
(make-empty-box)
name name)])
(set-annotation! b
(make-binding #f #t #f #f #f #f #f #f #f
(if (rep:pointer? rep)
(rep:pointer-to rep)
rep)))
b)]
[v (make-vm:local-varref #f name new-binding)])
(add-local-var! new-binding)
;; Start over; replace uses of binding in vals with uses of new-binding
(loop (cons new-binding bindings)
(list* (let ([v (make-vm:local-varref
#f
(zodiac:binding-var binding)
binding)])
(if (rep:pointer? rep)
(make-vm:deref #f v)
v))
(car vals)
(map
(lambda (val)
(if (this-binding? val)
v
val))
(cdr vals)))
#t))
;; Normal set
(let*-values ([(vref)
(zodiac:binding->lexical-varref binding)]
[(vm _) (vm-phase vref #f #f identity #f)]
[(vm) (car (vm:sequence-vals vm))])
(cons (make-vm:set!
(zodiac:zodiac-stx val)
(list
(cons target-type:lexical vm))
val
#f)
(loop (cdr bindings) (cdr vals) #f)))))))))))))
;; unknown or variable arity function call - always use args
(if (or (not closure-label)
(and closure-label (satisfies-arity? (length vals)
L arglist)))
(list (make-vm:args (zodiac:zodiac-stx ast)
(if tail?
arg-type:tail-arg
arg-type:arg)
vals))
(begin
((if (compiler:option:stupid) compiler:warning compiler:error)
ast
"procedure called with wrong number of arguments")
(list (make-vm:args (zodiac:zodiac-stx ast)
(if tail?
arg-type:tail-arg
arg-type:arg)
vals)))))))]
;;--------------------------------------------------------------------
;; ARGS
;;
;; args that have already been assigned to register variables
;;
[(vm:register-args? ast) (list ast)]
;;--------------------------------------------------------------------
;; SYNTAX! DEFINITIONS
[(vm:syntax!? ast)
(set-vm:syntax!-val! ast (car (process! (vm:syntax!-val ast))))
(list ast)]
;;====================================================================
;; R-VALUES (ONE STEP COMPUTATIONS)
;;--------------------------------------------------------------------
;; ALLOC EXPRESSION
;;
[(vm:alloc? ast) (list ast)]
;;--------------------------------------------------------------------
;; BUILD-CONSTANT
;;
[(vm:build-constant? ast) (list ast)]
;;--------------------------------------------------------------------
;; MAKE-CLOSURE, all kinds (wrap closure?)
;;
[(vm:make-closure? ast)
(set-vm:make-closure-closure!
ast
(let ([cc (vm:make-closure-closure ast)])
(and cc (car (process! cc)))))
(list ast)]
;;--------------------------------------------------------------------
;; APPLY EXPRESSION
;;
;; check for primitive applications
;; check for variable arity applications
;; check for applications that can return multiple values
;;
[(vm:apply? ast)
(if (not (vm:apply-prim ast))
(let*-values ([(closure) (vm:apply-closure ast)]
[(L closure-label) (closure-info closure)]
[(cl-case arglist) (select-case L (vm:apply-argc ast))]
[(check-known-sv)
(lambda ()
(when (not (closure-code-return-multi
(get-annotation L)))
; Known proc returns a single value, so we can
; use the more efficient multi call form
(set-vm:apply-multi?! ast #t)))])
(if (or (not cl-case)
(and cl-case (not (zodiac:list-arglist? arglist)))
(and cl-case (not (satisfies-arity? (vm:apply-argc ast) L arglist))))
(list ast)
(with-closure closure
cl-case
; unknown application
(lambda (_ __ ___ ____) (list ast))
; known call
(lambda (label _ __ ___)
(check-known-sv)
(set-vm:apply-known?! ast #t)
(list ast))
; known recursion
(lambda (label _ __ ____)
(check-known-sv)
(set-vm:apply-known?! ast #t)
(list ast)))))
(list ast))]
[(vm:macro-apply? ast) (list ast)]
;;--------------------------------------------------------------------
;; MODULE CONSTRUCTION
;;
[(vm:module-create? ast) (list ast)]
;;--------------------------------------------------------------------
;; WITH-CONTINUATION-MARK
;;
[(vm:wcm-mark!? ast)
(set-vm:wcm-mark!-key! ast (car (process! (vm:wcm-mark!-key ast))))
(set-vm:wcm-mark!-val! ast (car (process! (vm:wcm-mark!-val ast))))
(list ast)]
[(vm:wcm-push!? ast)
(set-vm:wcm-push!-var! ast (car (process! (vm:wcm-push!-var ast))))
(list ast)]
[(vm:wcm-pop!? ast)
(set-vm:wcm-pop!-var! ast (car (process! (vm:wcm-pop!-var ast))))
(list ast)]
[(vm:wcm-remember!? ast)
(set-vm:wcm-remember!-var! ast (car (process! (vm:wcm-remember!-var ast))))
(set-vm:wcm-remember!-val! ast (car (process! (vm:wcm-remember!-val ast))))
(list ast)]
[(vm:wcm-extract? ast)
(set-vm:wcm-extract-var! ast (car (process! (vm:wcm-extract-var ast))))
(list ast)]
;;====================================================================
;; A-VALUES, L-VALUES, IMMEDIATES
[(a-val/l-val/immediate?
ast)
(list ast)]
[else
(compiler:internal-error
#f
(format "vm-optimize: unrecognized form ~a" ast))]))])
(lambda (ast)
(set! new-locs empty-set)
(values
(process! ast)
new-locs))))))))

1004
collects/compiler/private/vmphase.ss Normal file
View File

File diff suppressed because it is too large Load Diff

207
collects/compiler/private/vmscheme.ss Normal file
View File

@ -0,0 +1,207 @@
;; VM-Scheme
;; (c) 1996-1997 Sebastian Good
;; (c) 1997-2001 PLT
;; Mostly structure definitions for VM AST nodes.
(module vmscheme mzscheme
(require (lib "unitsig.ss")
(lib "list.ss")
(lib "etc.ss"))
(require (lib "zodiac-sig.ss" "syntax"))
(require "sig.ss")
(require "../sig.ss")
(provide vmscheme@)
(define vmscheme@
(unit/sig compiler:vmstructs^
(import compiler:library^
compiler:cstructs^
(zodiac : zodiac^)
compiler:zlayer^
compiler:driver^)
;; Block statements
(define-struct (vm:sequence zodiac:zodiac) (vals))
(define-struct (vm:if zodiac:zodiac) (test then else))
(define-struct (vm:module-body zodiac:zodiac) (vals invoke syntax?))
;; Tail position statements
(define-struct (vm:void zodiac:zodiac) (val))
(define-struct (vm:return zodiac:zodiac) (val))
(define-struct (vm:tail-apply zodiac:zodiac) (closure argc prim))
(define-struct (vm:tail-call zodiac:zodiac) (label closure set-env?))
(define-struct (vm:continue zodiac:zodiac) ())
;; non-tail imperative statements
(define-struct (vm:set! zodiac:zodiac) (vars val mode))
(define-struct (vm:generic-args zodiac:zodiac) (closure tail? prim vals))
(define-struct (vm:register-args zodiac:zodiac) (vars vals))
(define-struct (vm:args zodiac:zodiac) (type vals))
(define-struct (vm:begin0-mark! zodiac:zodiac) (var val))
(define-struct (vm:begin0-setup! zodiac:zodiac) (var))
(define-struct (vm:syntax! zodiac:zodiac) (vars val in-mod?))
;; r-values (1 step computations)
(define-struct (vm:alloc zodiac:zodiac) (type))
(define-struct (vm:build-constant zodiac:zodiac) (text))
(define-struct (vm:make-closure zodiac:zodiac) (closure))
(define-struct (vm:make-procedure-closure vm:make-closure)
(vehicle min-arity max-arity name empty? method?))
(define-struct (vm:make-case-procedure-closure vm:make-closure)
(vehicle num-cases case-arities name empty? method?))
(define-struct (vm:apply zodiac:zodiac)
(closure argc known? multi? prim simple-tail-prim?))
(define-struct (vm:macro-apply zodiac:zodiac)
(name primitive args tail? bool?))
(define-struct (vm:call zodiac:zodiac) (label closure))
(define-struct (vm:begin0-extract zodiac:zodiac) (var))
(define-struct (vm:wcm-mark! zodiac:zodiac) (key val))
(define-struct (vm:wcm-push! zodiac:zodiac) (var))
(define-struct (vm:wcm-pop! zodiac:zodiac) (var))
(define-struct (vm:wcm-remember! zodiac:zodiac) (var val))
(define-struct (vm:wcm-extract zodiac:zodiac) (var))
(define-struct (vm:check-global zodiac:zodiac) (var))
(define-struct (vm:module-create zodiac:zodiac) (shape id))
;; a-values
(define-struct (vm:global-varref zodiac:zodiac) (var))
(define-struct (vm:bucket zodiac:zodiac) (var))
(define-struct (vm:per-load-statics-table zodiac:zodiac) ())
(define-struct (vm:per-invoke-statics-table zodiac:zodiac) ())
(define-struct (vm:cast zodiac:zodiac) (val rep)) ; last resort
;; l-values (locations in memory)
(define-struct (vm:local-varref zodiac:zodiac) (var binding))
(define-struct (vm:static-varref zodiac:zodiac) (var))
(define-struct (vm:static-varref-from-lift vm:static-varref) (lambda))
(define-struct (vm:per-load-static-varref vm:static-varref) ())
(define-struct (vm:per-invoke-static-varref vm:static-varref) ())
(define-struct (vm:per-load-static-varref-from-lift vm:per-load-static-varref) (lambda))
(define-struct (vm:per-invoke-static-varref-from-lift vm:per-invoke-static-varref) (lambda))
(define-struct (vm:primitive-varref zodiac:zodiac) (var))
(define-struct (vm:symbol-varref zodiac:zodiac) (var))
(define-struct (vm:inexact-varref zodiac:zodiac) (var))
(define-struct (vm:struct-ref zodiac:zodiac) (field var))
(define-struct (vm:deref zodiac:zodiac) (var))
(define-struct (vm:ref zodiac:zodiac) (var))
;; immediate values
(define-struct (vm:immediate zodiac:zodiac) (text))
;; defines a structure type
;; all structures may be indexed by number as well.
(define-struct vm:struct-type (fields))
(define vm:box-struct-type (make-vm:struct-type '(box)))
;; argument types
(define arg-type:register 'arg-type:register)
(define arg-type:arg 'arg-type:arg)
(define arg-type:tail-arg 'arg-type:tail-arg)
;; set!-target types
(define target-type:global 'target-type:global)
(define target-type:lexical 'target-type:lexical)
(define target-type:static target-type:lexical)
;; this is the class of statements that make control leave the block
(define vm:control-return?
(one-of vm:return? vm:tail-apply? vm:tail-call? vm:continue?))
;; Defines fixnumness in the VM Scheme.
;; may change under different implementations; and will certainly
;; need to change as things get unwrapped...
(define vm:fixnum?
(lambda (n)
(and (exact? n) (integer? n) (< n (expt 2 30)) (> n (- (expt 2 30))))))
;; This function defines whether a constant must be built or not.
;; This functions answers #t to constants that may just appear
;; as constants in VM Scheme.
(define vm:literal-constant?
(let ([p? (one-of (all-of number? vm:fixnum?)
null?
boolean?
char?
void?
undefined?)])
(lambda (i)
(p? (syntax-e (zodiac:zodiac-stx i)))))))))
#|
(define vm:vm->sexp
(lambda (ast)
(cond
[(vm:sequence? ast) `(sequence ,@(map vm:vm->sexp (vm:sequence-vals ast)))]
[(vm:if? ast) `(if ,(vm:vm->sexp (vm:if-test ast))
,(vm:vm->sexp (vm:if-then ast))
,(vm:vm->sexp (vm:if-else ast)))]
[(vm:void? ast) `(void ,(vm:vm->sexp (vm:void-val ast)))]
[(vm:return? ast) `(return ,(vm:vm->sexp (vm:return-val ast)))]
[(vm:tail-apply? ast) `(tail-apply ,(vm:vm->sexp (vm:tail-apply-closure ast))
(argc ,(vm:tail-apply-argc ast))
(prim ,(vm:tail-apply-prim ast)))]
[(vm:tail-call? ast) `(tail-call ,label (set-env? ,(vm:tail-call-set-env? ast)))]
[(vm:continue? ast) '(continue)]
[(vm:set!? ast) `(set! ,@(map (lambda (v)
`(,(car v) ,(vm:vm->sexp (cdr v))))
(vm:set!-vars ast))
,(vm:vm->sexp (vm:set!-val ast)))]
[(vm:generic-args? ast)
`(generic-args (tail? ,(vm:generic-args-tail? ast))
(prim ,(vm:generic-args-prim ast))
(vals ,@(map vm:vm->sexp (vm:generic-args-vals ast))))]
[(vm:args? ast)
`(args (type ,(vm:args-type ast)) (vals ,@(map vm:vm->sexp (vm:args-vals ast))))]
[(vm:struct? ast)
(let ([super (vm:struct-super ast)])
`(struct ,(vm:struct-type ast)
,(if super (vm:vm->sexp (vm:struct-super ast)) #f)
,(vm:struct-fields ast)))]
[(vm:alloc? ast)
`(alloc ,(rep->sexp (vm:alloc-type ast)))]
[(vm:build-constant? ast)
`(build-constant ,(zodiac:zread-object (vm:build-constant-text ast)))]
[(vm:make-procedure-closure? ast)
`(make-procedure-closure ,(vm:vm->sexp (vm:make-closure-closure ast))
,(vm:make-closure-min-arity ast)
,(vm:make-closure-max-arity ast))]
[(vm:apply? ast)
`(apply ,(vm:vm->sexp (vm:apply-closure ast))
(argc ,(vm:apply-argc ast))
(known? ,(vm:apply-known? ast))
(multi? ,(vm:apply-multi? ast))
(prim ,(vm:apply-prim ast)))]
[(vm:call? ast)
`(call ,(vm:call-label ast))]
[(vm:global-varref? ast)
`(global-varref ,(vm:global-varref-var ast))]
[(vm:local-varref? ast)
`(local-varref ,(vm:local-varref-var ast))]
[(vm:static-varref? ast)
`(static-varref ,(vm:static-varref-var ast))]
[(vm:primitive-varref? ast)
`(primitive-varref ,(vm:primitive-varref-var ast))]
[(vm:struct-ref? ast)
`(struct-ref ,(vm:struct-ref-field ast)
,(vm:vm->sexp (vm:struct-ref-var ast)))]
[(vm:deref? ast)
`(deref ,(vm:vm->sexp (vm:deref-var ast)))]
[(vm:ref? ast)
`(ref ,(vm:vm->sexp (vm:ref-var ast)))]
[(vm:immediate? ast)
(let ([text (vm:immediate-text ast)])
`(immediate ,(cond [(number? text)
`(label ,text)]
[(zodiac:zread? text)
(zodiac:zread-object text)]
[else (error 'vm:vm->sexp "~a bad immediate text" text)])))]
[else
(error 'vm:vm->sexp "~a not supported" ast)])))
|#

855
collects/compiler/private/winicon.ss Normal file
View File

@ -0,0 +1,855 @@
(module winicon mzscheme
(require (lib "list.ss"))
(provide install-icon
extract-icons
parse-icon
build-icon)
(define (byte->integer p)
(read-byte p))
(define (word->integer p)
(integer-bytes->integer (read-bytes 2 p) #f #f))
(define (dword->integer p)
(integer-bytes->integer (read-bytes 4 p) #f #f))
;; The 0 added in the alpha position apparently means "ignore the alpha
;; and use the mask, instead"
(define (3/2word->integer p)
(integer-bytes->integer (bytes-append (read-bytes 3 p) #"\0") #f #f))
(define (integer->word i p)
(display (integer->integer-bytes i 2 #f #f) p))
(define (integer->dword i p)
(display (integer->integer-bytes i 4 #f #f) p))
(define (flag v)
(positive? (bitwise-and #x80000000 v)))
(define (value v)
(bitwise-and #x7FFFFFFF v))
(define (skip-to-image-headers-after-signature p)
;; p is expected to be a file port
(file-position p 60)
(let ([pos (word->integer p)])
;; pos points to IMAGE_NT_HEADERS
(file-position p pos)
(unless (= #x4550 (dword->integer p))
(error "bad signature"))
pos))
(define (get-image-base p)
(let ([pos (skip-to-image-headers-after-signature p)])
(file-position p (+ 4
20
28))
(dword->integer p)))
(define (find-section p find-name)
(let ([pos (skip-to-image-headers-after-signature p)])
(word->integer p) ; skip machine
(let ([num-sections (word->integer p)]
[_ (begin (dword->integer p)
(dword->integer p)
(dword->integer p))]
[size (word->integer p)])
(let ([pos (+ pos
4 ; Signature : DWORD
20 ; FileHeader: IMAGE_FILE_HEADER
size)]) ; "optional" header
(let sloop ([section 0][section-pos pos])
(if (= section num-sections)
(error 'find-section "can't find section: ~e" find-name)
(begin
(file-position p section-pos)
;; p points to an IMAGE_SECTION_HEADER
(let ([name (read-bytes 8 p)])
(if (bytes=? find-name name)
(let ([_ (dword->integer p)]) ; skip
(values (dword->integer p) ; virtual address
(dword->integer p) ; length
(dword->integer p))); file pos
(sloop (add1 section) (+ section-pos 40)))))))))))
(define (find-rsrc-start p re:rsrc)
(let-values ([(rsrc-virtual-addr rsrc-len rsrc-pos)
(find-section p #".rsrc\0\0\0")])
(let loop ([dir-pos 0][path ""])
(file-position p (+ rsrc-pos dir-pos 12))
(let ([num-named (word->integer p)]
[num-ided (word->integer p)])
(let iloop ([i 0])
(if (= i (+ num-ided num-named))
#f
(let ([name-delta (dword->integer p)]
[data-delta (dword->integer p)]
[next (file-position p)])
(or (let ([name (if (flag name-delta)
(begin
(file-position p (+ rsrc-pos (value name-delta)))
(let* ([len (word->integer p)])
;; len is in unicode chars...
(let ([unistr (read-bytes (* 2 len) p)])
;; Assume it fits into ASCII...
(regexp-replace* "\0"
(bytes->string/latin-1 unistr)
""))))
(value name-delta))])
;;(printf "Name: ~a~a = ~a~n" path name (+ rsrc-pos (value data-delta)))
(let ([full-name (format "~a~a" path name)])
(if (flag data-delta)
(loop (value data-delta) (string-append full-name "."))
;; Found the icon?
(and (regexp-match re:rsrc full-name)
;; Yes, so read IMAGE_RESOURCE_DATA_ENTRY
(begin
(file-position p (+ rsrc-pos (value data-delta)))
(cons
(+ (dword->integer p) ; offset (an RVA)
(- rsrc-pos
rsrc-virtual-addr))
(dword->integer p))))))) ; size
(begin
(file-position p next)
(iloop (add1 i)))))))))))
;; >>> Probably doesn't work <<<
(define (find-import-names p)
(let-values ([(seg-virtual-addr seg-len seg-pos)
(find-section p #".idata\0\0")])
(let loop ([pos seg-pos])
;; pos points to an IMAGE_IMPORT_DESCRIPTOR;
;; skip first 4 fields
(file-position p pos)
(if (zero? (dword->integer p)) ; 0 is terminator
null
(begin
(dword->integer p)
(dword->integer p)
;; next field is name
(let ([name-pos (+ (dword->integer p) ; RVA to nul-terminated name
(- seg-pos seg-virtual-addr))])
(file-position p name-pos)
(let ([name (regexp-match "^[^\0]*" p)])
(cons (cons (car name) name-pos)
(loop (+ pos 20))))))))))
;; >>> Doesn't work <<<
(define (find-delay-loads p)
(let-values ([(seg-virtual-addr seg-len seg-pos)
(find-section p #".text\0\0")])
(let ([pos (skip-to-image-headers-after-signature p)]
[image-base (get-image-base p)])
(let ([pos (+ pos
4 ; Signature : DWORD
20 ; FileHeader: IMAGE_FILE_HEADER
96 ; IMAGE_OPTIONAL_HEADER up to directory
104)] ; skip 13 directory entries
[vdelta image-base])
(file-position p pos)
(let loop ([delay-pos (dword->integer p)])
(printf "~a ~a~n" delay-pos vdelta)
(file-position p (+ delay-pos vdelta))
(dword->integer p) ; skip attributes
(let ([name-pos (dword->integer p)])
(printf "~a ~a~n" name-pos vdelta)
(file-position p (+ name-pos vdelta))
(let ([name (regexp-match "^[^\0]*" p)])
(printf "~a~n" name))))))))
(define-struct icon (desc data))
;; desc is (list width height colors 0 planes bitcount)
;; data is (cons pos string)
(define (num-colors l)
(let ([n (caddr l)])
(if (zero? n)
(arithmetic-shift 1 (list-ref l 5))
n)))
(define (install-icon exe-file ico-file . extra-icons)
(let ([ico-icons (append (if ico-file
(extract-icons ico-file)
null)
extra-icons)]
[exe-icons (extract-icons exe-file)])
(let ([p (open-output-file exe-file 'update)])
(dynamic-wind
void
(lambda ()
(for-each (lambda (exe-icon)
(let ([best-ico-icon
;; Find exact match?
(ormap (lambda (ico-icon)
(let ([le (icon-desc exe-icon)]
[li (icon-desc ico-icon)])
(and (= (car li) (car le))
(= (cadr li) (cadr le))
(= (num-colors li) (num-colors le))
(= (bytes-length (cdr (icon-data exe-icon)))
(bytes-length (cdr (icon-data ico-icon))))
ico-icon)))
ico-icons)])
(let ([ico-icon (or best-ico-icon
;; Look for a conversion, if we
;; need a 16x16, 32x32, or 48x48
;; icon
(and
(= (car (icon-desc exe-icon))
(cadr (icon-desc exe-icon)))
(memq (car (icon-desc exe-icon))
'(16 32 48))
(let ([biggest-colorest #f])
(for-each
(lambda (ico-icon)
(let ([w (car (icon-desc ico-icon))]
[exew (car (icon-desc exe-icon))])
(when (and
(= w
(cadr (icon-desc ico-icon)))
(memq w '(16 32 48))
(or
(not biggest-colorest)
(and (= w exew)
(not (= exew (car (icon-desc biggest-colorest)))))
(and (= w exew)
(> (num-colors (icon-desc ico-icon))
(num-colors (icon-desc biggest-colorest))))
(and (not (= exew (car (icon-desc biggest-colorest))))
(or (> w (car (icon-desc biggest-colorest)))
(> (num-colors (icon-desc ico-icon))
(num-colors (icon-desc biggest-colorest)))))))
(set! biggest-colorest ico-icon))))
ico-icons)
(and
biggest-colorest
;; Convert...
(let* ([src-size (car (icon-desc biggest-colorest))]
[dest-size (car (icon-desc exe-icon))]
[src (parse-icon biggest-colorest)]
[image (list-ref src 3)]
[mask (list-ref src 4)]
[has-alpha? (<= 256 (num-colors (icon-desc biggest-colorest)))])
(if (= src-size dest-size)
(build-icon exe-icon
(if has-alpha?
image
(mask->alpha image mask))
mask)
(let ([cvt
(cond
[(and (= src-size 32) (= dest-size 16))
(lambda (i) (48->16 (32->48 i)))]
[(and (= src-size 32) (= dest-size 48))
32->48]
[(and (= src-size 48) (= dest-size 16))
48->16]
[(and (= src-size 48) (= dest-size 32))
48->32]
[(and (= src-size 16) (= dest-size 32))
16->32]
[(and (= src-size 16) (= dest-size 48))
(lambda (i) (32->48 (16->32 i)))])])
(let ([mask (cvt mask)])
(build-icon exe-icon
(if has-alpha?
image
(mask->alpha (cvt image) mask))
mask)))))))))])
(unless ico-icon (printf "no! ~a~n" (icon-desc exe-icon)))
(when ico-icon
(file-position p (car (icon-data exe-icon)))
(display (cdr (icon-data ico-icon)) p)))))
exe-icons))
(lambda () (close-output-port p))))))
;; ------------------------------
;; Image parsing
;; ------------------------------
(define (get-icons file res?)
(let ([p (if (input-port? file)
file
(open-input-file file))])
(dynamic-wind
void
(lambda ()
(unless (= 0 (word->integer p))
(error 'get-icons "~a doesn't start with 0" file))
(unless (= 1 (word->integer p))
(error "type isn't 1"))
(let ([cnt (word->integer p)])
(let ([icons (let loop ([i 0])
(if (= i cnt)
null
(cons
(make-icon
(list (byte->integer p) ; w
(byte->integer p) ; h
(byte->integer p) ; colors
(byte->integer p) ; 0
(word->integer p) ; planes
(word->integer p)) ; bitcount
(list (dword->integer p) ; bytes
((if res? ; where or icon id
word->integer
dword->integer)
p)))
(loop (add1 i)))))])
;; (printf "~a~n" icons)
(for-each (lambda (icon)
(set-icon-data!
icon
(let ([size (car (icon-data icon))]
[where (cadr (icon-data icon))])
(let ([icon-pos (if res?
;; last number is icon id:
(car (find-rsrc-start p (format "^3[.]~a[.]" where)))
;; last number is file position:
where)])
(file-position p icon-pos)
(cons icon-pos
(read-bytes size p)))))
;; If colors, planes, and bitcount are all 0,
;; get the info from the DIB data
(let ([desc (icon-desc icon)])
(when (and (zero? (list-ref desc 2))
(zero? (list-ref desc 4))
(zero? (list-ref desc 5)))
(let ([bi (bitmapinfo icon)])
(set-car! (list-tail desc 4)
(list-ref bi 3))
(set-car! (list-tail desc 5)
(list-ref bi 4))))))
icons)
icons)))
(lambda ()
(when (path-string? file)
(close-input-port p))))))
(define (bitmapinfo icon)
(let ([p (open-input-bytes (cdr (icon-data icon)))])
(list (dword->integer p) ; size == 40 in practice
(dword->integer p) ; width
(dword->integer p) ; height
(word->integer p) ; planes
(word->integer p) ; bitcount
(dword->integer p) ; compression == 0
(dword->integer p) ; size image
(dword->integer p) ; x pixels per meter == 0
(dword->integer p) ; y pixels per meter == 0
(dword->integer p) ; used == 0
(dword->integer p)))) ; important == 0
;; Assumes that bits-per-pixel is 1, 2, 4, 8, 24, or 32.
;; Also assumes that (bits-per-pixel * width) is a multiple of 8.
(define (parse-dib icon)
(let* ([bi (bitmapinfo icon)]
[header-size (list-ref bi 0)]
[num-colors (caddr (icon-desc icon))]
[w (list-ref bi 1)]
[h (/ (list-ref bi 2) 2)]
[bits-per-pixel (list-ref bi 4)])
(let ([p (open-input-bytes (cdr (icon-data icon)))])
;; Skip header
(read-bytes header-size p)
(let* ([read-n
(lambda (n read-one combine)
(let loop ([i n][r null])
(if (= i 0)
(reverse! r)
(loop (sub1 i)
(combine (read-one p) r)))))]
[read-lines
(lambda (w h read-one combine)
(if (zero? (modulo w 4))
(read-n (* w h) read-one combine)
(let loop ([h h])
(if (zero? h)
null
(append (read-n w read-one combine)
(begin
;; pad line to dword:
(read-n (- 4 (modulo w 4)) byte->integer cons)
;; read next line:
(loop (sub1 h))))))))]
[split-bits (lambda (b)
(list
(bitwise-and b 1)
(arithmetic-shift (bitwise-and b 2) -1)
(arithmetic-shift (bitwise-and b 4) -2)
(arithmetic-shift (bitwise-and b 8) -3)
(arithmetic-shift (bitwise-and b 16) -4)
(arithmetic-shift (bitwise-and b 32) -5)
(arithmetic-shift (bitwise-and b 64) -6)
(arithmetic-shift (bitwise-and b 128) -7)))])
(let ([main-image
(cond
[(= bits-per-pixel 32)
;; RGB mode:
(read-n (* w h) dword->integer cons)]
[(= bits-per-pixel 24)
;; RGB mode:
(read-n (* w h) 3/2word->integer cons)]
[else
;; Index mode:
(let ([color-table (list->vector
(read-n (if (zero? num-colors)
(arithmetic-shift 1 bits-per-pixel)
num-colors)
dword->integer cons))]
[image (read-lines (/ w (/ 8 bits-per-pixel))
h
(lambda (p)
(let ([b (byte->integer p)])
(case bits-per-pixel
[(1) (split-bits b)]
[(2)
(list
(bitwise-and b 3)
(arithmetic-shift (bitwise-and b 12) -2)
(arithmetic-shift (bitwise-and b 48) -4)
(arithmetic-shift (bitwise-and b 192) -6))]
[(4)
(list
(bitwise-and b 15)
(arithmetic-shift (bitwise-and b 240) -4))]
[(8) (list b)])))
append)])
(map (lambda (i) (vector-ref color-table i)) image))])])
(let ([mask (read-lines (/ w 8)
h
(lambda (p) (split-bits (byte->integer p)))
append)])
(unless (eof-object? (read-char p))
(error 'parse-dib "not extactly at end"))
(list main-image mask)))))))
;; rgb->indexed
;; The color-reduction strategy isn't great, and because it
;; depends on hash-table order, it's non-deterministic in
;; principle. But the actual hash-table implementatin is
;; deterministic, of course. Also, the re-ordering of the
;; image via the hash tables tends to produce better
;; (pseudo-random) representatives of the image for colors.
(define (rgb->indexed image num-colors)
(let ([image (map (lambda (i) (bitwise-and #xFFFFFF i)) image)] ; drop alphas, if any
[table (make-vector num-colors 0)]
[ht (make-hash-table 'equal)]
[map-ht (make-hash-table 'equal)]
[color-dist (lambda (a b)
(sqrt (+ (expt (- (bitwise-and #xFF a)
(bitwise-and #xFF b))
2)
(expt (- (arithmetic-shift (bitwise-and #xFF00 a) -8)
(arithmetic-shift (bitwise-and #xFF00 b) -8))
2)
(expt (- (arithmetic-shift (bitwise-and #xFF0000 a) -16)
(arithmetic-shift (bitwise-and #xFF0000 b) -16))
2))))])
(for-each (lambda (c)
(hash-table-put!
ht
c
(add1
(hash-table-get ht c (lambda () 0)))))
image)
(let ([kv-sorted
(quicksort (hash-table-map ht cons)
(lambda (a b)
(< (cdr a) (cdr b))))])
(let ([n 0])
(for-each (lambda (kv)
(let ([key (car kv)])
(let ([n (if (< n (sub1 num-colors))
n
;; Find closest match:
(let ([n 0])
(let loop ([i 1])
(unless (= i num-colors)
(when (< (color-dist key (vector-ref table i))
(color-dist key (vector-ref table n)))
(set! n i))
(loop (add1 i))))
n))])
(vector-set! table n key)
(hash-table-put! map-ht key n))
(when (< n (sub1 num-colors))
(set! n (add1 n)))))
kv-sorted)))
(values (vector->list table)
(map (lambda (c) (hash-table-get map-ht c)) image))))
;; Assumes that bits-per-pixel is 1, 2, 4, 8, or 32.
;; Also assumes that (bits-per-pixel * width) is a multiple of 8.
(define (build-dib icon image mask)
(let* ([bi (bitmapinfo icon)]
[header-size (list-ref bi 0)]
[num-colors (caddr (icon-desc icon))]
[w (list-ref bi 1)]
[h (/ (list-ref bi 2) 2)]
[bits-per-pixel (list-ref bi 4)])
(let ([orig-p (open-input-bytes (cdr (icon-data icon)))]
[result-p (open-output-bytes)])
;; Copy header:
(display (read-bytes header-size orig-p) result-p)
(let ([get-lines (lambda (image bits-per-pixel)
(map (lambda (line)
;; pad line to dword boundary
(let ([line-bytes (/ (* w bits-per-pixel) 8)])
(if (zero? (modulo line-bytes 4))
line
(append line
(vector->list
(make-vector (* (- 4 (modulo line-bytes 4))
(/ 8 bits-per-pixel))
0))))))
;; break out lines
(let loop ([l image])
(if (null? l)
null
(cons (let loop ([l l][i 0])
(if (= i w)
null
(cons (car l) (loop (cdr l) (add1 i)))))
(loop (list-tail l w)))))))]
[bits->dwords (lambda (l bpp)
(let ([chunk-size (/ 32 bpp)]
[1byte (lambda (l)
(bitwise-ior
(arithmetic-shift (list-ref l 0) 7)
(arithmetic-shift (list-ref l 1) 6)
(arithmetic-shift (list-ref l 2) 5)
(arithmetic-shift (list-ref l 3) 4)
(arithmetic-shift (list-ref l 4) 3)
(arithmetic-shift (list-ref l 5) 2)
(arithmetic-shift (list-ref l 6) 1)
(arithmetic-shift (list-ref l 7) 0)))]
[2byte (lambda (l)
(bitwise-ior
(arithmetic-shift (list-ref l 0) 6)
(arithmetic-shift (list-ref l 1) 4)
(arithmetic-shift (list-ref l 2) 2)
(arithmetic-shift (list-ref l 3) 0)))]
[4byte (lambda (l)
(bitwise-ior
(arithmetic-shift (list-ref l 0) 4)
(arithmetic-shift (list-ref l 1) 0)))])
(let loop ([l l])
(if (null? l)
null
(cons (case bpp
[(1) (bitwise-ior
(arithmetic-shift (1byte (list-tail l 0)) 0)
(arithmetic-shift (1byte (list-tail l 8)) 8)
(arithmetic-shift (1byte (list-tail l 16)) 16)
(arithmetic-shift (1byte (list-tail l 24)) 24))]
[(2) (bitwise-ior
(2byte l)
(arithmetic-shift (2byte (list-tail l 4)) 8)
(arithmetic-shift (2byte (list-tail l 8)) 16)
(arithmetic-shift (2byte (list-tail l 12)) 24))]
[(4) (bitwise-ior
(4byte l)
(arithmetic-shift (4byte (list-tail l 2)) 8)
(arithmetic-shift (4byte (list-tail l 4)) 16)
(arithmetic-shift (4byte (list-tail l 6)) 24))]
[(8) (bitwise-ior
(car l)
(arithmetic-shift (list-ref l 1) 8)
(arithmetic-shift (list-ref l 2) 16)
(arithmetic-shift (list-ref l 3) 24))])
(loop (list-tail l chunk-size)))))))])
(if (= bits-per-pixel 32)
(for-each (lambda (col) (integer->dword col result-p))
image)
(let-values ([(colors indexed-image) (rgb->indexed image (arithmetic-shift 1 bits-per-pixel))])
;; color table
(for-each (lambda (col) (integer->dword col result-p))
colors)
(let* ([lines (get-lines indexed-image bits-per-pixel)]
[dwords (apply append (map (lambda (l) (bits->dwords l bits-per-pixel))
lines))])
(for-each (lambda (col) (integer->dword col result-p))
dwords))))
(let* ([lines (get-lines mask 1)]
[dwords (apply append (map (lambda (l) (bits->dwords l 1)) lines))])
(for-each (lambda (col) (integer->dword col result-p))
dwords))
(let ([s (get-output-bytes result-p)])
(unless (= (bytes-length s) (bytes-length (cdr (icon-data icon))))
(error 'build-dib "bad result size ~a != ~a"
(bytes-length s) (bytes-length (cdr (icon-data icon)))))
s)))))
(define (parse-icon icon)
(let ([image (parse-dib icon)])
(list (car (icon-desc icon))
(cadr (icon-desc icon))
(let ([cols (caddr (icon-desc icon))])
(if (zero? cols)
(expt 2 (list-ref (icon-desc icon) 5))
cols))
(car image)
(cadr image))))
(define (build-icon base-icon image mask)
(make-icon (icon-desc base-icon)
(cons (car (icon-desc base-icon))
(build-dib base-icon image mask))))
(define (extract-icons file)
(if (regexp-match #rx"[.]ico$" (if (path? file)
(path->string file)
file))
(get-icons-in-ico file)
(get-icons-in-exe file)))
(define (get-icons-in-ico ico-file)
(get-icons ico-file #f))
(define (get-icons-in-exe exe-file)
(let ([p (open-input-file exe-file)])
(dynamic-wind
void
(lambda ()
(let ([pos+size (find-rsrc-start p "^14[.]")])
(file-position p (car pos+size))
(get-icons p #t)))
(lambda () (close-input-port p)))))
;; The following is useful for bitmap->icon,
;; but it uses MrEd, and this module is used by
;; Setup PLT. Probably this code should just be
;; moved somewhere else.
#;
(begin
(require (lib "mred.ss" "mred")
(lib "class.ss"))
(define (bitmap%->icon bm)
(let* ([w (send bm get-width)]
[h (send bm get-height)]
[argb (make-bytes (* w h 4))]
[mdc (make-object bitmap-dc% bm)])
(send mdc get-argb-pixels 0 0 w h argb)
(send mdc set-bitmap #f)
;; Get mask (inverse alpha), if any:
(let ([mask-argb (make-bytes (* w h 4) #o377)]
[mbm (send bm get-loaded-mask)])
(when mbm
(send mdc set-bitmap mbm)
(send mdc get-argb-pixels 0 0 w h mask-argb)
(send mdc set-bitmap #f))
(bitmap->icon w h argb mask-argb)))))
(define (bitmap->icon w h argb mask-argb)
(let ([o (open-output-bytes)])
(integer->dword 40 o) ; size
(integer->dword w o) ; width
(integer->dword (* 2 h) o) ; height
(integer->word 1 o) ; planes
(integer->word 32 o) ; bitcount
(integer->dword 0 o) ; compression
(integer->dword 0 o) ; size image
(integer->dword 0 o) ; x pixels per meter
(integer->dword 0 o) ; y pixels per meter
(integer->dword 0 o) ; used
(integer->dword 0 o) ; important
;; Got ARGB, need BGRA
(let* ([flip-pixels (lambda (s)
(let ([s (bytes-copy s)])
(let loop ([p 0])
(unless (= p (bytes-length s))
(let ([a (bytes-ref s p)]
[r (bytes-ref s (+ p 1))]
[g (bytes-ref s (+ p 2))]
[b (bytes-ref s (+ p 3))])
(bytes-set! s p b)
(bytes-set! s (+ p 1) g)
(bytes-set! s (+ p 2) r)
(bytes-set! s (+ p 3) a)
(loop (+ p 4)))))
s))]
[rgba (flip-pixels argb)]
[mask-rgba (flip-pixels mask-argb)]
[row-size (if (zero? (modulo w 32))
w
(+ w (- 32 (remainder w 32))))]
[mask (make-bytes (* h row-size 1/8) 0)])
(let loop ([i (* w h 4)])
(unless (zero? i)
(let ([mr (bytes-ref mask-rgba (- i 2))]
[mg (bytes-ref mask-rgba (- i 3))]
[mb (bytes-ref mask-rgba (- i 4))]
[a (- i 1)])
(let ([alpha (- 255
(floor (/ (+ mr mg mb)
3)))])
(if (< alpha 10)
;; white mask -> zero alpha; add white pixel to mask
(begin
(bytes-set! rgba a 0)
(let ([pos (+ (* (quotient (sub1 (/ i 4)) w) row-size)
(remainder (sub1 (/ i 4)) w))])
(bytes-set! mask
(quotient pos 8)
(bitwise-ior
(arithmetic-shift 1 (- 7 (remainder pos 8)))
(bytes-ref mask (quotient pos 8))))))
;; non-white mask -> non-zero alpha
(bytes-set! rgba a alpha))))
(loop (- i 4))))
;; Windows icons are upside-down:
(let ([flip (lambda (str row-width)
(apply
bytes-append
(reverse
(let loop ([pos 0])
(if (= pos (bytes-length str))
null
(cons (subbytes str pos (+ pos row-width))
(loop (+ pos row-width))))))))])
(display (flip rgba (* w 4)) o)
(display (flip mask (/ row-size 8)) o))
(make-icon (list w h 0 0 1 32)
(cons 0 (get-output-bytes o))))))
;; ------------------------------
;; Image conversion
;; ------------------------------
(define (mask->alpha image mask)
(map (lambda (i m)
(if (zero? m)
(bitwise-ior #xFF000000 i)
m))
image mask))
(define (first-n n l)
(let loop ([l l][i n])
(if (zero? i)
null
(cons (car l) (loop (cdr l) (sub1 i))))))
(define (16->32 l)
(let loop ([l l])
(if (null? l)
null
(let ([l2 (let loop ([l (first-n 16 l)])
(if (null? l)
null
(list* (car l) (car l) (loop (cdr l)))))])
(append l2 l2
(loop (list-tail l 16)))))))
(define (32->48 l)
(let loop ([l l][dup? #t])
(if (null? l)
null
(let ([l2 (let loop ([l (first-n 32 l)])
(if (null? l)
null
(list* (car l) (car l) (cadr l)
(loop (cddr l)))))])
(append l2
(if dup? l2 null)
(loop (list-tail l 32) (not dup?)))))))
(define (48->16 l)
(let loop ([l l])
(if (null? l)
null
(let ([l2 (let loop ([l (first-n 48 l)])
(if (null? l)
null
(cons (car l) (loop (cdddr l)))))])
(append l2
(loop (list-tail l 144)))))))
(define (48->32 l)
(let loop ([l l][step 0])
(if (null? l)
null
(let ([l2 (let loop ([l (first-n 48 l)][step 0])
(if (null? l)
null
(if (= 1 (modulo step 3))
(loop (cdr l) 2)
(cons (car l) (loop (cdr l) (add1 step))))))])
(append (if (= 1 (modulo step 3)) null l2)
(loop (list-tail l 48) (add1 step))))))))
#|
;; ----------------------------------------
;; Test code
(define icons (extract-icons "e:/matthew/plt/mred.exe"))
(define (show-icon w h col-count image mask)
(let* ([f (make-object frame% (format "~a x ~a (~a) Image" w h col-count))]
[bm (make-object bitmap% w h)]
[mbm (make-object bitmap% w h)]
[c (instantiate canvas% (f)
[paint-callback (lambda (c dc)
(send dc draw-bitmap bm 0 0)
(send dc draw-bitmap mbm w 0))])])
(let ([mdc (make-object bitmap-dc% bm)]
[col (make-object color%)])
(let loop ([l image][i 0][j 0])
(unless (= j h)
(let ([v (car l)])
(send col set
(bitwise-and v #xFF)
(arithmetic-shift (bitwise-and v #xFF00) -8)
(arithmetic-shift (bitwise-and v #xFF0000) -16))
(send mdc set-pixel i j col)
(if (= (add1 i) w)
(loop (cdr l) 0 (add1 j))
(loop (cdr l) (add1 i) j)))))
(send mdc set-bitmap mbm)
(let loop ([l (if (col-count . > . 256) image mask)][i 0][j 0])
(unless (= j h)
(let ([v (if (col-count . > . 256)
(- 255 (arithmetic-shift (bitwise-and (car l) #xFF000000) -24))
(if (zero? (car l))
0
255))])
(send col set v v v)
(send mdc set-pixel i j col)
(if (= (add1 i) w)
(loop (cdr l) 0 (add1 j))
(loop (cdr l) (add1 i) j)))))
(send mdc set-bitmap #f))
(send c min-client-width (* 2 w))
(send c min-client-height h)
(send c stretchable-width #f)
(send c stretchable-height #f)
(send f show #t)))
(define (find-icon icons w h colors)
(ormap (lambda (i)
(let ([p (parse-icon i)])
(and (= w (car p))
(= h (cadr p))
(= colors (caddr p))
i)))
icons))
(let ([orig (find-icon icons 48 48 (expt 2 32))]
[target (find-icon icons 32 32 256)])
(apply show-icon (parse-icon orig))
(apply show-icon (parse-icon target))
(apply show-icon
(parse-icon
(let* ([p (parse-icon orig)]
[mask (48->32(list-ref p 4))]
[image (mask->alpha (48->32 (list-ref p 3)) mask)])
(build-icon target image mask)))))
;; ----------------------------------------
;; End test code
|#

249
collects/compiler/private/zlayer.ss Normal file
View File

@ -0,0 +1,249 @@
;; Zodiac interface and library routines
;; (c)1996-1997 Sebastian Good
;; (c)1997-2001 PLT
(module zlayer mzscheme
(require (lib "unitsig.ss")
(lib "list.ss")
(lib "etc.ss"))
(require (lib "zodiac-sig.ss" "syntax"))
(require "../sig.ss")
(require "sig.ss")
(provide zlayer@)
(define zlayer@
(unit/sig compiler:zlayer^
(import (compiler:option : compiler:option^)
(zodiac : zodiac^)
compiler:cstructs^
compiler:driver^)
;;----------------------------------------------------------------------------
;; ANNOTATIONS
;;
;; zodiac:* AST notes are annotated using set-annotation!, and
;; the annotations are extracted using get-annotation. Every
;; AST node has a single annotation, but the type of the annotation
;; depends on the type of the AST node.
;; This is the default annotation value, used before the annotation
;; is set for an AST node
(define compiler:empty-annotation (gensym 'mzc-default-annotation))
;; Create a new back-box for a new zodiac AST node
(define (make-empty-box) (zodiac:make-empty-back-box))
;; Manipulating annotations:
;; NOTE: Zodiac must be invoked before this unit
(define-values (get-annotation set-annotation!)
(let-values ([(getter setter)
(zodiac:register-client 'compiler
(lambda ()
compiler:empty-annotation))])
(values
(lambda (ast)
(getter (zodiac:parsed-back ast)))
(lambda (ast obj)
(setter (zodiac:parsed-back ast) obj)))))
(define (annotated? ast)
(not (eq? (get-annotation ast)
compiler:empty-annotation)))
(define (remove-annotation! ast)
(set-annotation! ast compiler:empty-annotation))
;;----------------------------------------------------------------------------
;; Error handling
(define compiler:escape-on-error (make-parameter #f))
;; initialize zodiac-error procedures
(define zodiac-error-template
(lambda (c s)
(lambda (where fmt-spec . args)
(c where
(string-append
s
(apply format (cons fmt-spec args))))
(when (compiler:escape-on-error)
(error 'compiler "parsing error")))))
(define (call-compiler:fatal-error . args)
(apply compiler:fatal-error args))
(define static-error
(zodiac-error-template call-compiler:fatal-error "(syntax) "))
(define internal-error
(zodiac-error-template call-compiler:fatal-error "(elaboration) "))
(define dynamic-error
(zodiac-error-template call-compiler:fatal-error "(parser dynamic) "))
;;----------------------------------------------------------------------------
;; BEGIN0-FORM
;;
;; maintain the illusion of a two slot begin0-form
(define zodiac:begin0-form-first
(compose car zodiac:begin0-form-bodies))
(define zodiac:begin0-form-rest
(compose cadr zodiac:begin0-form-bodies))
(define zodiac:set-begin0-form-first!
(lambda (ast v)
(set-car! (zodiac:begin0-form-bodies ast) v)))
(define zodiac:set-begin0-form-rest!
(lambda (ast v)
(set-car! (cdr (zodiac:begin0-form-bodies ast)) v)))
;;----------------------------------------------------------------------------
;; SPECIAL CONSTANTS
;;
;; some constants we don't know how to write, like #<void>
;;
(define undefined (letrec ([x x]) x))
(define (undefined? x) (eq? x undefined))
(define self_modidx (let ()
(define-struct self_modidx ())
(make-self_modidx)))
(define zodiac:make-special-constant
;; make-quote, make-constant
(lambda (text)
(let ([stx (case text
[(void) (datum->syntax-object #f (void) #f)]
[(null) (datum->syntax-object #f null)]
[(undefined) (datum->syntax-object #f undefined)]
[(self_modidx) (datum->syntax-object #f self_modidx)]
[else (compiler:internal-error 'make-special-constant "bad type")])])
(zodiac:make-quote-form
stx (make-empty-box)
(zodiac:make-zread stx)))))
;;-----------------------------------------------------------------------------
;; BINDING->LEXICAL-VARREF
;;
;; creates a zodiac:lexical-varref from a zodiac:binding
;;
(define zodiac:binding->lexical-varref
(lambda (ast)
(let ([v (zodiac:make-lexical-varref (zodiac:zodiac-stx ast)
(make-empty-box)
(zodiac:binding-var ast)
ast)])
(set-annotation! v (varref:empty-attributes))
v)))
;;----------------------------------------------------------------------------
;; POSITION REPORTING
(define main-source-file (make-parameter #f))
(define zodiac:print-start!
(lambda (port ast)
(let ([bad (lambda () (fprintf port " [?,?]: "))])
(if (and ast (zodiac:zodiac? ast))
(let* ([start (zodiac:zodiac-start ast)]
[good (lambda ()
(fprintf port " ~a[~a,~a]: "
(if (equal? (main-source-file) (zodiac:location-file start))
""
(format "~s " (zodiac:location-file start)))
(zodiac:location-line start)
(zodiac:location-column start)))])
(good))
(bad)))))
;;----------------------------------------------------------------------
;; Debugging: AST to annotated S-expression
(define zodiac->sexp/annotate
(lambda (ast)
(zodiac->sexp ast)))
(define zodiac->sexp
(lambda (ast)
(cond
[(zodiac:quote-form? ast)
(syntax-object->datum (zodiac:zodiac-stx ast))]
[(zodiac:binding? ast)
(zodiac:binding-var ast)]
[(zodiac:varref? ast)
(zodiac:varref-var ast)]
;; compound sexps
[(zodiac:define-values-form? ast)
`(define-values ,(map zodiac->sexp (zodiac:define-values-form-vars ast))
,(zodiac->sexp/annotate (zodiac:define-values-form-val ast)))]
[(zodiac:app? ast)
`(,(zodiac->sexp/annotate (zodiac:app-fun ast))
,@(map zodiac->sexp/annotate (zodiac:app-args ast)))]
[(zodiac:set!-form? ast)
`(set! ,(zodiac->sexp (zodiac:set!-form-var ast))
,(zodiac->sexp/annotate (zodiac:set!-form-val ast)))]
[(zodiac:case-lambda-form? ast)
`(case-lambda
,@(map
(lambda (args body)
`(,(let ([vars (zodiac:arglist-vars args)])
(cond
[(zodiac:sym-arglist? args) (zodiac->sexp (car vars))]
[(zodiac:list-arglist? args) (map zodiac->sexp vars)]
[(zodiac:ilist-arglist? args) (let loop ([args vars])
(if (null? (cdr args))
(zodiac->sexp (car args))
(cons (zodiac->sexp (car args))
(loop (cdr args)))))]))
,(zodiac->sexp/annotate body)))
(zodiac:case-lambda-form-args ast)
(zodiac:case-lambda-form-bodies ast)))]
[(zodiac:begin-form? ast)
`(begin ,@(map zodiac->sexp/annotate (zodiac:begin-form-bodies ast)))]
[(zodiac:begin0-form? ast)
`(begin0 ,@(map zodiac->sexp/annotate (zodiac:begin0-form-bodies ast)))]
[(zodiac:let-values-form? ast)
`(let-values
,(map list
(map (lambda (l) (map zodiac->sexp l)) (zodiac:let-values-form-vars ast))
(map zodiac->sexp/annotate (zodiac:let-values-form-vals ast)))
,(zodiac->sexp/annotate (zodiac:let-values-form-body ast)))]
[(zodiac:letrec-values-form? ast)
`(letrec-values
,(map list
(map (lambda (l) (map zodiac->sexp l)) (zodiac:letrec-values-form-vars ast))
(map zodiac->sexp/annotate (zodiac:letrec-values-form-vals ast)))
,(zodiac->sexp/annotate (zodiac:letrec-values-form-body ast)))]
[(zodiac:if-form? ast)
`(if ,(zodiac->sexp/annotate (zodiac:if-form-test ast))
,(zodiac->sexp/annotate (zodiac:if-form-then ast))
,(zodiac->sexp/annotate (zodiac:if-form-else ast)))]
[(zodiac:with-continuation-mark-form? ast)
`(with-continuation-mark
,(zodiac->sexp/annotate (zodiac:with-continuation-mark-form-key ast))
,(zodiac->sexp/annotate (zodiac:with-continuation-mark-form-val ast))
,(zodiac->sexp/annotate (zodiac:with-continuation-mark-form-body ast)))]
[(zodiac:require/provide-form? ast)
`(require/provide ...)]
[(zodiac:module-form? ast)
`(module ... ,(zodiac->sexp/annotate (zodiac:module-form-body ast)))]
[else
(error 'zodiac->sexp/annotate "unsupported ~s" ast)]))))))

106
collects/compiler/sig.ss Normal file
View File

@ -0,0 +1,106 @@
(module sig mzscheme
(require (lib "unitsig.ss"))
(provide compiler:option^
compiler^
compiler:inner^
compiler:linker^)
;; Compiler options
(define-signature compiler:option^
(verbose ; default = #f
setup-prefix ; string to embed in public names;
; used mainly for compiling extensions
; with the collection name so that
; cross-extension conflicts are less
; likely in architectures that expose
; the public names of loaded extensions
; default = ""
clean-intermediate-files ; #t => keep intermediate .c/.o files
; default = #f
compile-subcollections ; #t => use 'compile-subcollections
; from infor for collection compiling
; default = #t
compile-for-embedded ; #f => make objects to be linked
; directly with MzScheme, not dynamically
; loaded; default = #f
max-inline-size ; max size of inlined procedures
disable-interrupts ; #t => UNSAFE: turn off breaking, stack
; overflow, and thread switching;
; default = #f
unsafe ; #t => UNSAFE: omit some type checks
; default = #f
fixnum-arithmetic ; #t => UNSAFE: don't check for overflow or
; underflow for fixnum arithmetic;
; default = #f
propagate-constants ; default = #t
assume-primitives ; #t => car = #%car; default = #f
stupid ; allow obvious non-syntactic errors;
; e.g.: ((lambda () 0) 1 2 3)
vehicles ; Controls how closures are compiled:
; 'vehicles:automatic,
; 'vehicles:functions,
; 'vechicles:units, or
; 'vehicles:monolithic.
; default = 'vehicles:automatic
vehicles:monoliths ; Size for 'vehicles:monolithic
seed ; Randomizer seed for 'vehicles:monolithic
max-exprs-per-top-level-set ; Number of top-level Scheme expressions
; crammed into one C function; default = 25
unpack-environments ; default = #t
; Maybe #f helps for register-poor architectures?
debug ; #t => creates debug.txt debugging file
test ; #t => ignores top-level expressions with syntax errors
))
;; Compiler procedures
(define-signature compiler^
(compile-extensions
compile-extensions-to-c
compile-c-extensions
compile-extension-parts
compile-extension-parts-to-c
compile-c-extension-parts
link-extension-parts
glue-extension-parts
compile-zos
compile-collection-extension
compile-collection-zos
compile-directory-extension
compile-directory-zos
current-compiler-dynamic-require-wrapper
compile-notify-handler))
;; Low-level extension compiler interface
(define-signature compiler:inner^
(compile-extension
compile-extension-to-c
compile-c-extension
compile-extension-part
compile-extension-part-to-c
compile-c-extension-part
eval-compile-prefix))
;; Low-level multi-file extension linker interface
(define-signature compiler:linker^
(link-extension
glue-extension)))

1839
collects/compiler/src2src.ss Normal file
View File

File diff suppressed because it is too large Load Diff

535
collects/compiler/start.ss Normal file
View File

@ -0,0 +1,535 @@
;; Starts up the compiler according to command-line flags.
;; (c) 1997-2001 PLT
;; Scheme->C compilation is the only mode really handled
;; by the code in this collection. Other modes are handled
;; by other collections, such as MzLib and dynext.
;; If you are interested Scheme->C part of mzc, look in
;; driver.ss, which is the `main' file for the compiler.
;; Different compilation modes are driven by dynamically
;; linking in appropriate libraries. This is handled
;; by compiler.ss.
;; See doc.txt for information about the Scheme-level interface
;; provided by this collection.
(module start mzscheme
;; On error, exit with 1 status code
(error-escape-handler (lambda () (exit 1)))
(error-print-width 512)
(require (prefix compiler:option: "option.ss"))
(require "compiler.ss")
;; Read argv array for arguments and input file name
(require (lib "cmdline.ss")
(lib "list.ss")
(lib "file.ss" "dynext")
(lib "compile.ss" "dynext")
(lib "link.ss" "dynext")
(lib "pack.ss" "setup")
(lib "getinfo.ss" "setup"))
(define dest-dir (make-parameter #f))
(define auto-dest-dir (make-parameter #f))
(define ld-output (make-parameter #f))
(define exe-output (make-parameter #f))
(define exe-embedded-flags (make-parameter '("-mvq-")))
(define exe-embedded-libraries (make-parameter null))
(define exe-aux (make-parameter null))
(define module-mode (make-parameter #f))
(define default-plt-name "archive")
(define plt-output (make-parameter #f))
(define plt-name (make-parameter default-plt-name))
(define plt-files-replace (make-parameter #f))
(define plt-files-plt-relative? (make-parameter #f))
(define plt-files-plt-home-relative? (make-parameter #f))
(define plt-setup-collections (make-parameter null))
(define plt-include-compiled (make-parameter #f))
(define use-3m (make-parameter #f))
(define (extract-suffix appender)
(bytes->string/latin-1
(subbytes
(path->bytes (appender (bytes->path #"x")))
1)))
;; Returns (values mode files prefixes)
;; where mode is 'compile, 'link, or 'zo
(define (parse-options argv)
(parse-command-line
"mzc"
argv
`([help-labels
"-------------------------------- mode flags ---------------------------------"]
[once-any
[("-e" "--extension")
,(lambda (f) 'compile)
(,(format "Output ~a file(s) from Scheme source(s) (default)" (extract-suffix append-extension-suffix)))]
[("-c" "--c-source")
,(lambda (f) 'compile-c)
(,(format "Output ~a file(s) from Scheme source(s)" (extract-suffix append-c-suffix)))]
[("-o" "--object")
,(lambda (f) 'compile-o)
(,(format "Output ~a/~a from Scheme source(s) for a multi-file extension"
(extract-suffix append-object-suffix)
(extract-suffix append-constant-pool-suffix)))]
[("-l" "--link-extension")
,(lambda (f) 'link)
(,(format "Link multiple ~a and ~a files into a ~a file"
(extract-suffix append-object-suffix)
(extract-suffix append-constant-pool-suffix)
(extract-suffix append-extension-suffix)))]
[("-g" "--link-glue")
,(lambda (f) 'link-glue)
(,(format "Create the ~a glue for --link-extension, but do not link"
(extract-suffix append-object-suffix)))]
[("-z" "--zo")
,(lambda (f) 'zo)
(,(format "Output ~a file(s) from Scheme source(s)" (extract-suffix append-zo-suffix)))]
[("-k" "--make")
,(lambda (f) 'make-zo)
("Like --zo, but uses .dep, recurs for imports, implies --auto-dir")]
[("--collection-extension")
,(lambda (f) 'collection-extension)
("Compile specified collection to extension")]
[("--collection-zos")
,(lambda (f) 'collection-zos)
(,(format "Compile specified collection to ~a files" (extract-suffix append-zo-suffix)))]
[("--cc")
,(lambda (f) 'cc)
(,(format "Compile arbitrary file(s) for an extension: ~a -> ~a"
(extract-suffix append-c-suffix)
(extract-suffix append-object-suffix)))]
[("--ld")
,(lambda (f name) (ld-output name) 'ld)
(,(format "Link arbitrary file(s) to create <extension>: ~a -> ~a"
(extract-suffix append-object-suffix)
(extract-suffix append-extension-suffix))
"extension")]
[("--exe")
,(lambda (f name) (exe-output name) 'exe)
(,(format "Embed module in MzScheme to create <exe>")
"exe")]
[("--gui-exe")
,(lambda (f name) (exe-output name) 'gui-exe)
(,(format "Embed module in MrEd to create <exe>")
"exe")]
[("--collection-plt")
,(lambda (f name) (plt-output name) 'plt-collect)
(,(format "Create .plt <archive> containing collections")
"archive")]
[("--plt")
,(lambda (f name) (plt-output name) 'plt)
(,(format "Create .plt <archive> containing relative files/dirs")
"archive")]]
[once-each
[("-m" "--module")
,(lambda (f) (module-mode #t))
("Skip eval of top-level syntax, etc. for -e/-c/-o/-z")]
[("--3m")
,(lambda (f) (use-3m #t))
("Compile/link for 3m, with -e/-c/-o/etc.")]
[("--embedded")
,(lambda (f) (compiler:option:compile-for-embedded #t))
("Compile for embedded run-time engine, with -c/-o/-g")]
[("-p" "--prefix")
,(lambda (f v) v)
("Add elaboration-time prefix file for -e/-c/-o/-z" "file")]
[("-n" "--name")
,(lambda (f name) (compiler:option:setup-prefix name))
("Use <name> as extra part of public low-level names" "name")]]
[once-any
[("-d" "--destination")
,(lambda (f d)
(unless (directory-exists? d)
(error 'mzc "the destination directory does not exist: ~s" d))
(dest-dir d))
("Output -e/-c/-o/-l/-g/-z file(s) to <dir>" "dir")]
[("--auto-dir")
,(lambda (f)
(auto-dest-dir #t))
(,(format "Output -z to \"compiled\", -e to ~s"
(path->string
(build-path "compiled" "native" (system-library-subpath)))))]]
[help-labels
"------------------- compiler/linker configuration flags ---------------------"]
[once-each
[("--tool")
,(lambda (f v)
(let ([v (string->symbol v)])
(use-standard-compiler v)
(use-standard-linker v)))
(,(format "Use pre-defined <tool> as C compiler/linker:~a"
(apply string-append
(apply append
(map (lambda (t)
(list " " (symbol->string t)))
(get-standard-compilers)))))
"tool")]
[("--compiler")
,(lambda (f v) (current-extension-compiler v))
("Use <compiler-path> as C compiler" "compiler-path")]]
[multi
[("++ccf")
,(lambda (f v) (current-extension-compiler-flags
(append (current-extension-compiler-flags)
(list v))))
("Add C compiler flag" "flag")]
[("--ccf")
,(lambda (f v) (current-extension-compiler-flags
(remove v (current-extension-compiler-flags))))
("Remove C compiler flag" "flag")]
[("--ccf-clear")
,(lambda (f) (current-extension-compiler-flags null))
("Clear C compiler flags")]
[("--ccf-show")
,(lambda (f)
(printf "C compiler flags: ~s~n" (expand-for-link-variant
(current-extension-compiler-flags))))
("Show C compiler flags")]]
[once-each
[("--linker")
,(lambda (f v) (current-extension-linker v))
("Use <linker-path> as C linker" "linker-path")]]
[multi
[("++ldf")
,(lambda (f v) (current-extension-linker-flags
(append (current-extension-linker-flags)
(list v))))
("Add C linker flag" "flag")]
[("--ldf")
,(lambda (f v) (current-extension-linker-flags
(remove v (current-extension-linker-flags))))
("Remove C linker flag" "flag")]
[("--ldf-clear")
,(lambda (f) (current-extension-linker-flags null))
("Clear C linker flags")]
[("--ldf-show")
,(lambda (f)
(printf "C linker flags: ~s~n" (expand-for-link-variant
(current-extension-linker-flags))))
("Show C linker flags")]
[("++ldl")
,(lambda (f v) (current-standard-link-libraries
(append (current-standard-link-libraries)
(list v))))
("Add C linker library" "lib")]
[("--ldl-show")
,(lambda (f)
(printf "C linker libraries: ~s~n" (expand-for-link-variant
(current-standard-link-libraries))))
("Show C linker libraries")]]
[help-labels
"--------------------- executable configuration flags ------------------------"]
[once-each
[("--ico")
,(lambda (f i) (exe-aux
(cons (cons 'ico i)
(exe-aux))))
("Windows icon for --[gui-]exe executable" ".ico-file")]
[("--icns")
,(lambda (f i) (exe-aux
(cons (cons 'icns i)
(exe-aux))))
("Mac OS X icon for --[gui-]exe executable" ".icns-file")]]
[multi
[("++lib")
,(lambda (f l c) (exe-embedded-libraries
(append (exe-embedded-libraries)
(list (list l c)))))
("Embed <lib> from <collect> in --[gui-]exe executable" "lib" "collect")]
[("++exf")
,(lambda (f v) (exe-embedded-flags
(append (exe-embedded-flags)
(list v))))
("Add flag to embed in --[gui-]exe executable" "flag")]
[("--exf")
,(lambda (f v) (exe-embedded-flags
(remove v (exe-embedded-flags))))
("Remove flag to embed in --[gui-]exe executable" "flag")]
[("--exf-clear")
,(lambda (f) (exe-embedded-flags null))
("Clear flags to embed in --[gui-]exe executable")]
[("--exf-show")
,(lambda (f)
(printf "Flags to embed: ~s~n" (exe-embedded-flags)))
("Show flag to embed in --[gui-]exe executable")]]
[help-labels
"----------------------------- .plt archive flags ----------------------------"]
[once-each
[("--plt-name")
,(lambda (f n) (plt-name n))
("Set the printed <name> describing the archive" "name")]
[("--replace")
,(lambda (f) (plt-files-replace #t))
("Files in archive replace existing files when unpacked")]
[("--at-plt")
,(lambda (f) (plt-files-plt-relative? #t))
("Files/dirs in archive are relative to PLT add-ons directory")]
[("--all-users")
,(lambda (f) (plt-files-plt-home-relative? #t))
("Files/dirs in archive are relative to PLT installation directory")]
[("--include-compiled")
,(lambda (f) (plt-include-compiled #t))
("Include \"compiled\" subdirectories in the archive")]]
[multi
[("++setup")
,(lambda (f c) (plt-setup-collections
(append (plt-setup-collections)
(list c))))
("Setup <collect> after the archive is unpacked" "collect")]]
[help-labels
"----------------------- compiler optimization flags -------------------------"]
[once-each
[("--no-prop")
,(lambda (f) (compiler:option:propagate-constants #f))
("Don't propagate constants")]
[("--inline")
,(lambda (f d) (compiler:option:max-inline-size
(with-handlers ([void
(lambda (x)
(error 'mzc "bad size for --inline: ~a" d))])
(let ([v (string->number d)])
(unless (and (not (negative? v)) (exact? v) (real? v))
(error 'bad))
v))))
("Set the maximum inlining size" "size")]
[("--prim")
,(lambda (f) (compiler:option:assume-primitives #t))
("Assume primitive bindings at top-level")]
[("--stupid")
,(lambda (f) (compiler:option:stupid #t))
("Compile despite obvious non-syntactic errors")]
[("--unsafe-disable-interrupts")
,(lambda (f) (compiler:option:disable-interrupts #t))
("Ignore threads, breaks, and stack overflow")]
[("--unsafe-skip-tests")
,(lambda (f) (compiler:option:unsafe #t))
("Skip run-time tests for some primitive operations")]
[("--unsafe-fixnum-arithmetic")
,(lambda (f) (compiler:option:fixnum-arithmetic #t))
("Assume fixnum arithmetic yields a fixnum")]]
[help-labels
"-------------------------- miscellaneous flags ------------------------------"]
[once-each
[("-v")
,(lambda (f) (compiler:option:verbose #t))
("Verbose mode")]
[("--save-temps")
,(lambda (f) (compiler:option:clean-intermediate-files #f))
("Keep intermediate files")]
[("--debug")
,(lambda (f) (compiler:option:debug #t))
("Write debugging output to dump.txt")]])
(lambda (accum file . files)
(let ([mode (let ([l (filter symbol? accum)])
(if (null? l)
'compile
(car l)))])
(values
mode
(cons file files)
(let ([prefixes (filter string? accum)])
(unless (memq mode '(compile compile-c compile-o zo))
(unless (null? prefixes)
(error 'mzc "prefix files are not useful in ~a mode" mode)))
(if (module-mode)
(begin
(when (compiler:option:assume-primitives)
(error 'mzc "--prim is not useful with -m or --module"))
(unless (null? prefixes)
(error 'mzc "prefix files not allowed with -m or --module"))
#f)
`(begin
,(if (compiler:option:assume-primitives) '(require mzscheme) '(void))
(require (lib "cffi.ss" "compiler"))
(require-for-syntax mzscheme)
,@(map (lambda (s) `(load ,s)) prefixes)
(void)))))))
(list "file/directory/collection" "file/directory/sub-collection")))
(printf "MzScheme compiler (mzc) version ~a, Copyright (c) 2005 PLT Scheme, Inc.~n"
(version))
(define-values (mode source-files prefix)
(parse-options (current-command-line-arguments)))
(when (auto-dest-dir)
(unless (memq mode '(zo compile))
(error 'mzc "--auto-dir works only with -z, --zo, -e, or --extension (or default mode)")))
(define (never-embedded action)
(when (compiler:option:compile-for-embedded)
(error 'mzc "cannot ~a an extension for an embedded MzScheme" action)))
(when (use-3m)
(link-variant '3m)
(compile-variant '3m))
(case mode
[(compile)
(never-embedded "compile")
((compile-extensions prefix) source-files (if (auto-dest-dir)
'auto
(dest-dir)))]
[(compile-c)
((compile-extensions-to-c prefix) source-files (dest-dir))]
[(compile-o)
((compile-extension-parts prefix) source-files (dest-dir))]
[(link)
(never-embedded "link")
(link-extension-parts source-files (or (dest-dir) (current-directory)))]
[(link-glue)
(glue-extension-parts source-files (or (dest-dir) (current-directory)))]
[(zo)
((compile-zos prefix) source-files (if (auto-dest-dir)
'auto
(dest-dir)))]
[(make-zo)
(let ([n (make-namespace)]
[mc (dynamic-require '(lib "cm.ss")
'managed-compile-zo)]
[cnh (dynamic-require '(lib "cm.ss")
'manager-compile-notify-handler)]
[did-one? #f])
(parameterize ([current-namespace n]
[cnh (lambda (p)
(set! did-one? #t)
(printf " making ~s~n" (path->string p)))])
(map (lambda (file)
(set! did-one? #f)
(let ([name (extract-base-filename/ss file 'mzc)])
(printf "\"~a\":~n" file)
(mc file)
(let ([dest (append-zo-suffix
(let-values ([(base name dir?) (split-path name)])
(build-path (if (symbol? base) 'same base)
"compiled" name)))])
(printf " [~a \"~a\"]~n"
(if did-one?
"output to"
"already up-to-date at")
dest))))
source-files)))]
[(collection-extension)
(apply compile-collection-extension source-files)]
[(collection-zos)
(apply compile-collection-zos source-files)]
[(cc)
(for-each
(lambda (file)
(let* ([base (extract-base-filename/c file 'mzc)]
[dest (append-object-suffix
(let-values ([(base name dir?) (split-path base)])
(build-path (or (dest-dir) 'same) name)))])
(printf "\"~a\":~n" file)
(compile-extension (not (compiler:option:verbose))
file
dest
null)
(printf " [output to \"~a\"]~n" dest)))
source-files)]
[(ld)
(extract-base-filename/ext (ld-output) 'mzc)
;; (for-each (lambda (file) (extract-base-filename/o file 'mzc)) source-files)
(let ([dest (if (dest-dir)
(build-path (dest-dir) (ld-output))
(ld-output))])
(printf "~a:~n" (let ([s (apply string-append
(map (lambda (n) (format " \"~a\"" n)) source-files))])
(substring s 1 (string-length s))))
(link-extension (not (compiler:option:verbose))
source-files
dest)
(printf " [output to \"~a\"]~n" dest))]
[(exe gui-exe)
(unless (= 1 (length source-files))
(error 'mzc "expected a single module source file to embed; given: ~e"
source-files))
(let ([dest ((dynamic-require '(lib "embed.ss" "compiler" "private")
'mzc:embedding-executable-add-suffix)
(exe-output)
(eq? mode 'gui-exe))])
((dynamic-require '(lib "embed.ss" "compiler" "private")
'mzc:make-embedding-executable)
dest
(eq? mode 'gui-exe)
(compiler:option:verbose)
(cons
`(#%mzc: (file ,(car source-files)))
(map (lambda (l)
`(#t (lib ,@l)))
(exe-embedded-libraries)))
null
`(require ,(string->symbol
(format
"#%mzc:~a"
(let-values ([(base name dir?) (split-path (car source-files))])
(path->bytes (path-replace-suffix name #""))))))
(let ([flags (exe-embedded-flags)])
(if (eq? mode 'gui-exe)
(cons "-Z" flags)
flags))
(exe-aux))
(printf " [output to \"~a\"]~n" dest))]
[(plt)
(for-each (lambda (fd)
(unless (relative-path? fd)
(error
'mzc
"file/directory is not relative to the current directory: \"~a\""
fd)))
source-files)
(pack (plt-output) (plt-name)
source-files
(map list (plt-setup-collections))
std-filter #t
(if (plt-files-replace)
'file-replace
'file)
#f
(or (plt-files-plt-relative?)
(plt-files-plt-home-relative?))
;; Get current version of mzscheme for require:
(let ([i (get-info '("mzscheme"))])
(let ([v (and i (i 'version (lambda () #f)))])
(list (list '("mzscheme") v))))
null
(plt-files-plt-home-relative?))
(printf " [output to \"~a\"]~n" (plt-output))]
[(plt-collect)
(pack-collections
(plt-output)
(if (eq? default-plt-name (plt-name))
#f
(plt-name))
(map (lambda (sf)
(let loop ([sf sf])
(let ([m (regexp-match "^([^/]*)/(.*)$" sf)])
(if m
(cons (cadr m) (loop (caddr m)))
(list sf)))))
source-files)
(plt-files-replace)
(map list (plt-setup-collections))
(if (plt-include-compiled)
(lambda (path)
(or (regexp-match #rx"compiled$" path)
(std-filter path)))
std-filter)
(plt-files-plt-home-relative?))
(printf " [output to \"~a\"]~n" (plt-output))]
[else (printf "bad mode: ~a~n" mode)]))

6
collects/cvs-time-stamp/doc.txt Normal file
View File

@ -0,0 +1,6 @@
This collection is used only for the repository. It is not included
in normal releases. (It's existence indicates a checked out tree.)
The stamp.ss module provides one definition: `stamp' that is bound to
a string representing the current day. The time-stamp.ss file is a
tool, used by drscheme to set the version based on the time stamp.

5
collects/cvs-time-stamp/info.ss Normal file
View File

@ -0,0 +1,5 @@
(module info (lib "infotab.ss" "setup")
(define name "Repository Time Stamp")
(define doc.txt "doc.txt")
(define tools (list "time-stamp.ss"))
(define tool-names (list "Repository Time Stamp")))

1
collects/cvs-time-stamp/stamp.ss Normal file
View File

@ -0,0 +1 @@
(module stamp mzscheme (provide stamp) (define stamp "24may2005"))

18
collects/cvs-time-stamp/time-stamp.ss Normal file
View File

@ -0,0 +1,18 @@
(module time-stamp mzscheme
(require (lib "tool.ss" "drscheme")
(lib "unitsig.ss")
(lib "framework.ss" "framework"))
(require "stamp.ss")
(provide tool@)
(require "stamp.ss")
(define tool@
(unit/sig drscheme:tool-exports^
(import drscheme:tool^)
(define (phase1) (void))
(define (phase2) (void))
(version:add-spec '-cvs stamp))))

2
collects/defaults/README Normal file
View File

@ -0,0 +1,2 @@
This directory hold defaults for the DrScheme preferences. Search in
Help Desk for "site-specific" for more information.

61
collects/drscheme/acks.ss Normal file
View File

@ -0,0 +1,61 @@
(module acks mzscheme
(provide get-general-acks
get-translating-acks
get-authors)
(define (get-authors)
(string-append
"DrScheme was written by "
"John Clements, "
"Matthias Felleisen, "
"Robby Findler, "
"Paul Graunke, "
"Matthew Flatt, "
"Shriram Krishnamurthi, "
"and "
"Paul Steckler."))
(define (get-general-acks)
(string-append
"Thanks to "
"Ian Barland, "
"Eli Barzilay, "
"Gann Bierner, "
"Richard Cobbe, "
"Moy Easwaran, "
"Kathi Fisler, "
"Cormac Flanagan, "
"Sebastian Good, "
"Kathy Gray, "
"Bruce Hauman, "
"Mark Krentel, "
"Mario Latendresse, "
"Scott Owens, "
"Jamie Raymond, "
"Paul Schlie, "
"Dorai Sitaram, "
"Mike Sperber, "
"Francisco Solsona, "
"Neil W. Van Dyke, "
"Anton van Straaten, "
"Stephanie Weirich, "
"Noel Welsh, "
"and "
"Adam Wick "
"for contributions of prototypes, libraries, testing, and criticism of PLT documentation."))
(define (get-translating-acks)
(string-append
"Thanks to "
"Ian Barland, "
"Biep Durieux, "
"Tim Hanson, "
"Chihiro Kuraya, "
"Philippe Meunier, "
"Jens Axel Søgaard, "
"Francisco Solsona, "
"Reini Urban, "
"and "
"Paolo Zoppetti "
"for their help translating DrScheme's GUI to other languages.")))

195
collects/drscheme/arrow.ss Normal file
View File

@ -0,0 +1,195 @@
(module arrow mzscheme
(require (lib "class.ss")
(lib "list.ss")
(lib "math.ss")
(lib "mred.ss" "mred"))
(provide draw-arrow)
(define largest 16383)
(define smallest -16383)
(define arrow-head-angle (/ pi 8))
(define cos-arrow-head-angle (cos arrow-head-angle))
(define sin-arrow-head-angle (sin arrow-head-angle))
(define arrow-head-size 8)
(define arrow-head-size-cos-arrow-head-angle (* arrow-head-size cos-arrow-head-angle))
(define arrow-head-size-sin-arrow-head-angle (* arrow-head-size sin-arrow-head-angle))
(define arrow-root-radius 2.5)
(define arrow-root-diameter (* 2 arrow-root-radius))
; If alpha is the angle between the x axis and the Start->End vector:
;
; p2-x = end-x + arrow-head-size * cos(alpha + pi - arrow-head-angle)
; = end-x - arrow-head-size * cos(alpha - arrow-head-angle)
; = end-x - arrow-head-size * (cos(alpha) * cos(arrow-head-angle) + sin(alpha) * sin(arrow-head-angle))
; = end-x - arrow-head-size-cos-arrow-head-angle * cos-alpha - arrow-head-size-sin-arrow-head-angle * sin-alpha
; = end-x - arrow-head-size-cos-arrow-head-angle-cos-alpha - arrow-head-size-sin-arrow-head-angle-sin-alpha
;
; p2-y = end-y + arrow-head-size * sin(alpha + pi - arrow-head-angle)
; = end-y - arrow-head-size * sin(alpha - arrow-head-angle)
; = end-y - arrow-head-size * (sin(alpha) * cos(arrow-head-angle) - cos(alpha) * sin(arrow-head-angle))
; = end-y - arrow-head-size-cos-arrow-head-angle * sin-alpha + arrow-head-size-sin-arrow-head-angle * cos-alpha
; = end-y - arrow-head-size-cos-arrow-head-angle-sin-alpha + arrow-head-size-sin-arrow-head-angle-cos-alpha
;
; p3-x = end-x + arrow-head-size * cos(alpha + pi + arrow-head-angle)
; = end-x - arrow-head-size * cos(alpha + arrow-head-angle)
; = end-x - arrow-head-size * (cos(alpha) * cos(arrow-head-angle) - sin(alpha) * sin(arrow-head-angle))
; = end-x - arrow-head-size-cos-arrow-head-angle * cos-alpha + arrow-head-size-sin-arrow-head-angle * sin-alpha
; = end-x - arrow-head-size-cos-arrow-head-angle-cos-alpha + arrow-head-size-sin-arrow-head-angle-sin-alpha
;
; p3-y = end-y + arrow-head-size * sin(alpha + pi + arrow-head-angle)
; = end-y - arrow-head-size * sin(alpha + arrow-head-angle)
; = end-y - arrow-head-size * (sin(alpha) * cos(arrow-head-angle) + cos(alpha) * sin(arrow-head-angle))
; = end-y - arrow-head-size-cos-arrow-head-angle * sin-alpha - arrow-head-size-sin-arrow-head-angle * cos-alpha
; = end-y - arrow-head-size-cos-arrow-head-angle-sin-alpha - arrow-head-size-sin-arrow-head-angle-cos-alpha
; dc<%> real real real real real real -> void
; draw one arrow
; The reason of the "-0.5" in the definition of start-x and end-x in the let
; right below is because, well, after numerous experiments done under carefully
; controlled conditions by a team of independent experts, it was thought to
; be The Right Thing for the arrows to be drawn correctly, maybe.
(define (draw-arrow dc uncropped-pre-start-x uncropped-pre-start-y uncropped-pre-end-x uncropped-pre-end-y dx dy)
(let ([uncropped-start-x (+ uncropped-pre-start-x dx -0.5)]
[uncropped-start-y (+ uncropped-pre-start-y dy)]
[uncropped-end-x (+ uncropped-pre-end-x dx -0.5)]
[uncropped-end-y (+ uncropped-pre-end-y dy)]
[old-smoothed (send dc get-smoothing)])
(let*-values ([(start-x start-y) (crop-to uncropped-start-x uncropped-start-y uncropped-end-x uncropped-end-y)]
[(end-x end-y) (crop-to uncropped-end-x uncropped-end-y uncropped-start-x uncropped-start-y)])
(send dc set-smoothing 'aligned)
(send dc draw-line start-x start-y end-x end-y)
(when (and (< smallest start-x largest)
(< smallest end-x largest))
(send dc draw-ellipse
(- start-x arrow-root-radius) (- start-y arrow-root-radius)
arrow-root-diameter arrow-root-diameter))
(when (and (< smallest end-x largest)
(< smallest end-y largest))
(unless (and (= start-x end-x) (= start-y end-y))
(let* ([offset-x (- end-x start-x)]
[offset-y (- end-y start-y)]
[arrow-length (sqrt (+ (* offset-x offset-x) (* offset-y offset-y)))]
[cos-alpha (/ offset-x arrow-length)]
[sin-alpha (/ offset-y arrow-length)]
[arrow-head-size-cos-arrow-head-angle-cos-alpha (* arrow-head-size-cos-arrow-head-angle cos-alpha)]
[arrow-head-size-cos-arrow-head-angle-sin-alpha (* arrow-head-size-cos-arrow-head-angle sin-alpha)]
[arrow-head-size-sin-arrow-head-angle-cos-alpha (* arrow-head-size-sin-arrow-head-angle cos-alpha)]
[arrow-head-size-sin-arrow-head-angle-sin-alpha (* arrow-head-size-sin-arrow-head-angle sin-alpha)]
; pt1 is the tip of the arrow, pt2 is the first point going clockwise from pt1
[pt1 (make-object point% end-x end-y)]
[pt2 (make-object point%
(- end-x arrow-head-size-cos-arrow-head-angle-cos-alpha arrow-head-size-sin-arrow-head-angle-sin-alpha)
(+ end-y (- arrow-head-size-cos-arrow-head-angle-sin-alpha) arrow-head-size-sin-arrow-head-angle-cos-alpha))]
[pt3 (make-object point%
(+ end-x (- arrow-head-size-cos-arrow-head-angle-cos-alpha) arrow-head-size-sin-arrow-head-angle-sin-alpha)
(- end-y arrow-head-size-cos-arrow-head-angle-sin-alpha arrow-head-size-sin-arrow-head-angle-cos-alpha))])
(send dc draw-polygon (list pt1 pt2 pt3)))))
(send dc set-smoothing old-smoothed))))
;; crop-to : number number number number -> (values number number)
;; returns x,y if they are in the range defined by largest and smallest
;; otherwise returns the coordinates on the line from x,y to ox,oy
;; that are closest to x,y and are in the range specified by
;; largest and smallest
(define (crop-to x y ox oy)
(cond
[(and (< smallest x largest) (< smallest y largest))
(values x y)]
[else
(let* ([xy-pr (cons x y)]
[left-i (find-intersection x y ox oy smallest smallest smallest largest)]
[top-i (find-intersection x y ox oy smallest smallest largest smallest)]
[right-i (find-intersection x y ox oy largest smallest largest largest)]
[bottom-i (find-intersection x y ox oy smallest largest largest largest)]
[d-top (and top-i (dist top-i xy-pr))]
[d-bottom (and bottom-i (dist bottom-i xy-pr))]
[d-left (and left-i (dist left-i xy-pr))]
[d-right (and right-i (dist right-i xy-pr))])
(cond
[(smallest? d-top d-bottom d-left d-right)
(values (car top-i) (cdr top-i))]
[(smallest? d-bottom d-top d-left d-right)
(values (car bottom-i) (cdr bottom-i))]
[(smallest? d-left d-top d-bottom d-right)
(values (car left-i) (cdr left-i))]
[(smallest? d-right d-top d-bottom d-left)
(values (car right-i) (cdr right-i))]
[else
;; uh oh... if this case happens, that's bad news...
(values x y)]))]))
;; smallest? : (union #f number)^4 -> boolean
;; returns #t if can is less and o1, o2, and o3
;; if can is #f, return #f. If o1, o2, or o3 is #f, assume that can is smaller than them
(define (smallest? can o1 o2 o3)
(and can
(andmap (λ (x) (< can x))
(filter (λ (x) x)
(list o1 o2 o3)))))
;; inside? : (union #f (cons number number)) -> (union #f (cons number number))
;; returns the original pair if the coordinates are between smallest and largest
;; and returns #f if the pair is #f or the coordinates are outside.
(define (inside? pr)
(and pr
(let ([x (car pr)]
[y (cdr pr)])
(if (and (< smallest x largest)
(< smallest y largest))
pr
#f))))
;; find-intersection : (number^2)^2 -> (union (cons number number) #f)
;; finds the intersection between the lines specified by
;; (x1,y1) -> (x2,y2) and (x3,y3) -> (x4,y4)
(define (find-intersection x1 y1 x2 y2 x3 y3 x4 y4)
(cond
[(and (= x1 x2) (= x3 x4))
#f]
[(and (= x1 x2) (not (= x3 x4)))
(let* ([m2 (/ (- y3 y4) (- x3 x4))]
[b2 (- y3 (* m2 x3))])
(cons x1
(+ (* m2 x1) b2)))]
[(and (not (= x1 x2)) (= x3 x4))
(let* ([m1 (/ (- y1 y2) (- x1 x2))]
[b1 (- y1 (* m1 x1))])
(cons x3
(+ (* m1 x3) b1)))]
[(and (not (= x1 x2)) (not (= x3 x4)))
(let* ([m1 (/ (- y1 y2) (- x1 x2))]
[b1 (- y1 (* m1 x1))]
[m2 (/ (- y3 y4) (- x3 x4))]
[b2 (- y3 (* m2 x3))])
(if (= m1 m2)
#f
(let* ([x (/ (- b1 b2) (- m2 m1))]
[y (+ (* m1 x) b1)])
(cons x y))))]))
;; dist : (cons number number) (cons number number) -> number
(define (dist p1 p2)
(sqrt (+ (sqr (- (car p1) (car p2)))
(sqr (- (cdr p1) (cdr p2))))))
;; localled defined test code.... :(
;; use module language to run tests
(define (tests)
(and (equal? (find-intersection 0 1 0 10 0 2 0 20) #f)
(equal? (find-intersection 0 1 0 10 0 0 10 10) (cons 0 0))
(equal? (find-intersection 0 0 10 10 0 1 0 10) (cons 0 0))
(equal? (find-intersection 0 0 3 3 2 2 4 4) #f)
(equal? (find-intersection -3 3 3 -3 -3 -3 3 3) (cons 0 0))
(equal? (smallest? 3 1 2 3) #f)
(equal? (smallest? 0 1 2 3) #t)
(equal? (smallest? 1 0 2 3) #f)
(equal? (smallest? 1 0 #f 4) #f)
(equal? (smallest? 1 #f #f 4) #t)
(equal? (smallest? 1 #f #f #f) #t)
(equal? (dist (cons 1 1) (cons 4 5)) 5))))

27
collects/drscheme/default-code-style.ss Normal file
View File

@ -0,0 +1,27 @@
(module default-code-style mzscheme
(provide color-default-code-styles
bw-default-code-styles
code-style-color
code-style-slant?
code-style-bold?
code-style-underline?)
(define-struct code-style (color slant? bold? underline?))
;; code-style = (make-code-style (union (list number number number) string) bolean boolean)
;; bw-default-code-styles : (listof (list symbol code-style
(define bw-default-code-styles
(list (list 'lexically-bound-variable (make-code-style "black" #f #f #t))
(list 'lexically-bound-syntax (make-code-style "black" #f #f #t))
(list 'imported-variable (make-code-style "black" #f #f #t))
(list 'imported-syntax (make-code-style "black" #f #f #t))
(list 'unbound-variable (make-code-style "black" #t #f #f))
(list 'constant (make-code-style '(51 135 39) #f #f #f))))
;; color-default-code-styles : (listof (list symbol code-style))
(define color-default-code-styles
(list (list 'keyword (make-code-style '(40 25 15) #f #f #f))
(list 'unbound-variable (make-code-style "red" #f #f #f))
(list 'bound-variable (make-code-style "navy" #f #f #f))
(list 'primitive (make-code-style "navy" #f #f #f))
(list 'constant (make-code-style '(51 135 39) #f #f #f)))))

BIN
collects/drscheme/doc.icns Normal file
View File

Binary file not shown.

2
collects/drscheme/drscheme.creator Normal file
View File

@ -0,0 +1,2 @@
DrSc
(This code is registered with Apple.)

Some files were not shown because too many files have changed in this diff Show More