This is a PP file for the transfer of APL information. The next line describes the system of origin: .origin hardware = PC, OS = MS-DOS, interpreter = APL2/PC, PP version = 3 .escape . .begin function PPAB R.is A PPAB B;M A.is (.ng 2.ua 1 1,.ro A).ro A B.is (.ng 2.ua 1 1,.ro B).ro B M.is (.ng 1.ua .ro A).ce .ng 1.ua .ro B R.is (((1.ua .ro A),M).ua A),[.bx IO]((1.ua .ro B),M).ua B .end function .begin function PPAPL R.is PPAPL X;Y;Z;.bx IO;I;E;LALF;ALF;Q .lmp ascii to apl one line .bx IO.is 1 R.is '' X.is ,X E.is PPESC LALF.is 'abcdefghijklmnopqrstuvwxyz' ALF.is 'ABCDEFGHIJKLMNOPQRSTUVWXYZ',LALF LOOP:.go (E=1.ua X)/TRANS R.is R,(.ng 1+X.io E).ua X X.is (.ng 1+X.io E).da X NEXT:.go (0.ne .ro X)/LOOP .go 0 .lmp Y is name of symbol, e. g. 'rho ' from '@rho ' TRANS:Y.is 1.da (X.io ' ').ua X .xq ('z'.ne 1.ua Y)/'Y[(Y.ep 26.ua ALF)/.io .ro Y].is ALF[26+ALF.io (Y.. ep 26.ua ALF)/Y]' .lmp to lower X.is (1+.ro Y).da X .go (('ascii'.and . =5.ua Y).and (1.ua 5.da Y).ep '1234567890')/INDEX .go ((.ng 2+.ng 1.ua .ro PPAV)<.ro Y)/UN I.is (PPAV[;3]=1.ua Y)/.io 1.ua .ro PPAV Z.is (PPAV[I;(.ro Y).ua 2.da .io .ng 1.ua .ro PPAV].and . =Y)/PPAV[I;1] .go (0=.ro Z)/UN R.is R,Z .go NEXT UN:' Unknown symbol, not translated: ',PPESC,Y R.is R,E,Y,' ' .go NEXT INDEX:R.is R,.bx AV[256.fl 1.ce .xq (5.da Y)] .go NEXT .end function .begin function PPASC R.is PPASC X;.bx IO;LALF .lmp translate a line of apl code to ascii form .bx IO.is 1 LALF.is 'abcdefghijklmnopqrstuvwxyz' R.is ('.io '.ne R)/R.is ,0 1.da PPAV[PPAV[;1].io X;] .end function .begin function PPELZM R.is PPELZM X R.is (.nt 1.ua R).da (R.or 1.da (R.is ' '.ne X),0)/X .end function .begin function PPERPP PPERPP;NL;.bx IO;Q .bx IO.is 1 Q.is .bx EX(NL[;1 2].and . ='PP')/[1]NL.is .bx NL 3 2 Q.is .bx EX 'C.us PP1' Q.is .bx EX 'C.us PP2' Q.is .bx EX 'Cfs' Q.is .bx EX 'D.us PP1' Q.is .bx EX 'D.us PP2' Q.is .bx EX 'Dfs' .end function .begin function PPFCL R.is PPFCL D R.is .bx SVR.dd ('C.us PP',.fm D)('D.us PP',.fm D) .end function .begin function PPFIND R.is M PPFIND X;.bx IO .lmp find line X in matrix M .bx IO.is 1 R.is 0 .go ((.ro ,X)>.ng 1.ua .ro M)/0 .lmp cant be there R.is .or /M.and . =(.ng 1.ua .ro M).ua ,X .end function .begin function PPFOP R.is D PPFOP FN;Q .lmp open file FN with descriptor D R.is D Q.is 210 .bx SVO.dd ('C.us PP',.fm D)('D.us PP',.fm D) Q.is .bx SVO.dd ('C.us PP',.fm D)('D.us PP',.fm D) .go (.or /2.ne Q)/NOTSHARED .go ('W'=1.ua FN)/WRITE .xq 'C.us PP',(.fm D),'.is ''IR,'',(1.da FN),'',D''' .go 0 WRITE:.xq 'C.us PP',(.fm D),'.is ''DL,'',1.da FN' .xq 'C.us PP',(.fm D),'.is ''IW,'',(1.da FN),'',D''' .go 0 NOTSHARED:'AP210 IS NOT ACTIVE, CANNOT ACCESS FILES. ' .end function .begin function PPFRD R.is PPFRD D .xq 'C.us PP',(.fm D.is 1.ua D),'.is 4' .go (0.ne R.is .xq 'C.us PP',.fm D)/0 R.is .ng 2.da .xq 'D.us PP',.fm D .end function .begin function PPFWR D PPFWR X .xq 'D.us PP',(.fm D),'.is X' .xq 'C.us PP',(.fm D),'.is 5' .end function .begin function PPFX PP2R.is PPFX PP2Y;PP2D;PP2S;PP2L;PP2P;PP2T;PP2Q;PP2N .lmp fix object in ISO transfer form in TF2Y .lmp drop length string, if there PP2R.is '' PP2T.is 1.ua PP2Y.is (.or .bl .nt PP2Y.ep '0123456789')/PP2Y .lmp t. ype .go ((PPVER.ne 2).and PP2T='E')/PP2ERRE PP2N.is (.and .bl ' '.ne PP2Y)/PP2Y.is 1.da PP2Y .lmp nam. e PP2D.is (.and .bl ' '.ne PP2Y)/PP2Y.is (1+.ro PP2N).da PP2Y .lmp . dimension .xq ('.so '=1.ua PP2N)/'PP2N.is ''PP2Q''' .lmp recursion PP2Y.is (1+.ro PP2D).da PP2Y PP2S.is '' .go (0=.xq PP2D)/PP2NEXT PP2S.is .fm (.xq PP2D).ua .xq (.and .bl PP2Y.ep '0123456789 ')/PP2Y .lm. p shape PP2Y.is (1+.ro PP2S).da PP2Y .lmp value PP2NEXT:.go ('FONCE'=PP2T)/PP2FUN,PP2FUN,PP2NUM,PP2CHAR,PP2ENC PP2FUN:PP2R.is .xq '.bx FX ',PP2S,'.ro PP2Y' .go 0 PP2NUM:.xq PP2N,'.is PP2R.is (',PP2D,'.ro ',PP2S,' 0).ro ',PP2Y,',.io 0. ' .go 0 PP2CHAR:.xq PP2N,'.is PP2R.is (',PP2D,'.ro ',PP2S,' 0).ro PP2Y' .go 0 PP2ENC:PP2R.is .io 0 PP2LOOP:PP2L.is (.and .bl PP2Y.ep '0123456789')/PP2Y PP2Q.is (.xq PP2L).ua PP2Y.is (.ro ,PP2L).da PP2Y PP2R.is PP2R,.ru PPFX PP2Q PP2Y.is (.xq PP2L).da PP2Y .go ((0.ne .ro PP2Y).and ' '.ne 1.ua PP2Y)/PP2LOOP .xq PP2N,'.is PP2R.is (',PP2D,'.ro ',PP2S,' 0).ro PP2R' .go 0 PP2ERRE:PP2R.is .bx .is 'CANNOT RECONSTRUCT ENCLOSED ARRAYS. ' .end function .begin function PPGIF R.is PPGIF X .lmp ADT get input file name R.is X .end function .begin function PPGOF R.is PPGOF X .lmp ADT get output filename R.is X .end function .begin function PPMAT R.is X PPMAT Y;S;T;U;V;.bx IO .bx IO.is 1 V.is .ce /U.is .ng 1+(T,1+.ro Y)-0,T.is (.nt S.is X.ne Y)/.io .ro Y.is . ,Y R.is ((.ro U),V).ro (,U.so . .ge .io V).bl S/Y .end function .begin function PPMATCH R.is A PPMATCH B R.is 0 .go ((.ro A.is ,A).ne .ro B.is ,B)/0 R.is .and /A=B .end function .begin function PPMAV R.is PPMAV;W;.bx IO;IS;ID .lmp make atomic vector for transliteration 'Creating translation table. . . ' .bx IO.is 1 W.is 20 .lmp width of table R.is .tr (2,53).ro ' ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwx. yz' R.is R,(53,W-2).ro '.io ' PPESC.is 1.ua PPMESC .lmp make escape char (semiglobal) + add it's tr. anslation R.is R,[1](1,W).ro W.ua PPESC,PPESC,' ',W.ro '.io ' .lmp aux functions Q.is .bx FX 'I IS X' 'R.is R,[1](1,W).ro W.ua .bx AV[I],PPESC,X,'' '',. W.ro ''.io ''' Q.is .bx FX 'ID I' 'R.is R,[1](1,W).ro W.ua .bx AV[I,I],W.ro ''.io ''' 1 IS 'ascii1' 2 IS 'ascii2' 3 IS 'ascii3' 4 IS 'ascii4' 5 IS 'ascii5' 6 IS 'ascii6' 7 IS 'ascii7' 8 IS 'ascii8' 9 IS 'ascii9' 10 IS 'ascii10' 11 IS 'linefeed' 12 IS 'ascii12' 13 IS 'ascii13' 14 IS 'newline' 15 IS 'ascii15' 16 IS 'ascii16' 17 IS 'ascii17' 18 IS 'ascii18' 19 IS 'ascii19' 20 IS 'ascii20' 21 IS 'paragraph' 22 IS 'section' 23 IS 'ascii23' 24 IS 'ascii24' 25 IS 'fullarrowup' 26 IS 'fullarrowdown' 27 IS 'fullarrowright' 28 IS 'fullarrowleft' 29 IS 'ascii29' 30 IS 'ascii30' 31 IS 'ascii31' 32 IS 'ascii32' .lmp 33 blank 34 IS 'fac' 35 IS 'dqt' ID 36 .lmp pound ID 37 .lmp dollar ID 38 .lmp percent ID 39 .lmp ampersand ID 40 .lmp forward quote ID 41 .lmp '(' ID 42 .lmp ')' ID 43 .lmp '*' ID 44 .lmp '+' ID 45 .lmp ',' ID 46 .lmp '-' 47 IS 'point' ID 48 .lmp '/' ID 49 .lmp '0' ID 50 .lmp '1' ID 51 .lmp '2' ID 52 .lmp '3' ID 53 .lmp '4' ID 54 .lmp '5' ID 55 .lmp '6' ID 56 .lmp '7' ID 57 .lmp '8' ID 58 .lmp '9' ID 59 .lmp ':' ID 60 .lmp ';' ID 61 .lmp '<' ID 62 .lmp '=' ID 63 .lmp '>' ID 64 .lmp '?' ID 65 .lmp at .lmp 66. . 91 = A. . Z ID 92 .lmp '[' 93 IS 'bl' ID 94 .lmp ']' 95 IS 'and' .lmp .and 96 IS 'us' .lmp .us 97 IS 'lqt' .lmp 98. . 123 = a. . z 124 IS 'lb' 125 IS 'ab' 126 IS 'rb' 127 IS 'nt' 128 IS 'ascii128' 129 IS 'ascii129' 130 IS 'umlautu' 131 IS 'ascii131' 132 IS 'ascii132' 133 IS 'umlauta' 134 IS 'ascii134' 135 IS 'ascii135' 136 IS 'ascii136' 137 IS 'ascii137' 138 IS 'ascii138' 139 IS 'ascii139' 140 IS 'ascii140' 141 IS 'ascii141' 142 IS 'ascii142' 143 IS 'umlautA' 144 IS 'ascii144' 145 IS 'bx' .lmp .bx 146 IS 'qq' .lmp .qq 147 IS 'dq' .lmp .dq 148 IS 'ascii148' 149 IS 'umlauto' 150 IS 'ascii150' 151 IS 'ascii151' 152 IS 'ascii152' 153 IS 'en' .lmp .en 154 IS 'umlautO' 155 IS 'umlautU' 156 IS 'ascii156' 157 IS 'pounds' 158 IS 'de' .lmp .de 159 IS 'ascii159' 160 IS 'ib' .lmp .ib 161 IS 'ascii161' 162 IS 'ascii162' 163 IS 'ascii163' 164 IS 'ascii164' 165 IS 'ascii165' 166 IS 'ascii166' 167 IS 'ascii167' 168 IS 'ascii168' 169 IS 'ascii169' 170 IS 'ce' .lmp .ce 171 IS 'ascii171' 172 IS 'ascii172' 173 IS 'uu' .lmp .uu 174 IS 'ascii174' 175 IS 'fm' .lmp .fm 176 IS 'xq' .lmp .xq 177 IS 'ascii177' 178 IS 'ascii178' 179 IS 'ascii179' 180 IS 'ascii180' 181 IS 'ascii181' 182 IS 'lg' .lmp .lg 183 IS 'ld' .lmp .ld 184 IS 'del' .lmp .del 185 IS 'go' .lmp .go 186 IS 'ascii186' 187 IS 'ascii187' 188 IS 'ascii188' 189 IS 'ascii189' 190 IS 'is' .lmp .is 191 IS 'fl' .lmp .fl 192 IS 'ascii192' 193 IS 'ascii193' 194 IS 'ascii194' 195 IS 'ascii195' 196 IS 'ascii196' 197 IS 'ascii197' 198 IS 'ascii198' 199 IS 'ua' .lmp .ua 200 IS 'da' .lmp .da 201 IS 'ascii201' 202 IS 'ascii202' 203 IS 'ascii203' 204 IS 'ascii204' 205 IS 'ascii205' 206 IS 'ascii206' 207 IS 'ascii207' 208 IS 'eqv' .lmp .eqv 209 IS 'zio' .lmp .zio 210 IS 'zep' .lmp .zep 211 IS 'mst' .lmp .mst 212 IS 'sqd' .lmp small quad 213 IS 'qbs' .lmp quad backslash 214 IS 'qjt' .lmp quad jot 215 IS 'lk' .lmp left tack 216 IS 'rk' .lmp right tack 217 IS 'dm' .lmp diamond 218 IS 'ascii218' 219 IS 'ascii219' 220 IS 'ascii220' 221 IS 'ascii221' 222 IS 'ascii222' 223 IS 'ascii223' 224 IS 'ascii224' 225 IS 'al' .lmp .al 226 IS 'ascii226' 227 IS 'ru' .lmp .ru 228 IS 'lu' .lmp .lu 229 IS 'lmp' .lmp .lmp 230 IS 'nand' .lmp .nand 231 IS 'ro' .lmp .ro 232 IS 'nor' .lmp .nor 233 IS 'rv' .lmp .rv 234 IS 'cr' .lmp .cr 235 IS 'lo' .lmp .lo 236 IS 'or' .lmp .or 237 IS 'io' .lmp .io 238 IS 'tr' .lmp .tr 239 IS 'ep' .lmp .ep 240 IS 'du' .lmp .du 241 IS 'cs' .lmp .cs 242 IS 'cb' .lmp .cb 243 IS 'ge' .lmp .ge 244 IS 'le' .lmp .le 245 IS 'ne' .lmp .ne 246 IS 'ti' .lmp .ti 247 IS 'div' .lmp .div 248 IS 'zld' .lmp .zld 249 IS 'so' .lmp .so 250 IS 'om' .lmp .om 251 IS 'pd' .lmp .pd 252 IS 'gu' .lmp .gu 253 IS 'gd' .lmp .gd 254 IS 'ng' .lmp .ng 255 IS 'dd' .lmp .dd 256 IS 'ascii256' R.is R,[1](1,W).ro W.ua 'a',PPESC,'zA',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'b',PPESC,'zB',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'c',PPESC,'zC',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'd',PPESC,'zD',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'e',PPESC,'zE',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'f',PPESC,'zF',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'g',PPESC,'zG',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'h',PPESC,'zH',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'i',PPESC,'zI',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'j',PPESC,'zJ',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'k',PPESC,'zK',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'l',PPESC,'zL',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'm',PPESC,'zM',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'n',PPESC,'zN',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'o',PPESC,'zO',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'p',PPESC,'zP',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'q',PPESC,'zQ',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'r',PPESC,'zR',W.ro '.io ' R.is R,[1](1,W).ro W.ua 's',PPESC,'zS',W.ro '.io ' R.is R,[1](1,W).ro W.ua 't',PPESC,'zT',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'u',PPESC,'zU',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'v',PPESC,'zV',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'w',PPESC,'zW',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'x',PPESC,'zX',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'y',PPESC,'zY',W.ro '.io ' R.is R,[1](1,W).ro W.ua 'z',PPESC,'zZ',W.ro '.io ' .end function .begin function PPMESC R.is PPMESC R.is '. point ' .lmp default escape char .end function .begin function PPMTX PPMTX;AP;Q;W;I;R;RH;E .lmp TeX translation table W.is 30 Q.is .bx FX 'AP X' PPAB 'PPTX.is PPTX,[1]W.ua (1.ua X),(1.da X),W.ro ''. .io ''' .lmp first symbols which map onto themselves PPTX.is ' ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz012345678. 9' PPTX.is PPTX,'. ,;:+-*/[]()?.fac =' PPTX.is (.tr (2,.ro PPTX).ro PPTX),((.ro PPTX),W-2).ro '.io ' .lmp ap. pend filler .io .lmp escape character at AP '''.lb .bl APLquote.rb ' AP '.bl .lb .bl APLslope.rb ' AP '$.bl $' AP '.lb .lb .bl APLleftbrace.rb ' AP '.rb .lb .bl APLrightbrace.rb ' AP '<$<$' AP '>$>$' AP '.us .bl .us ' AP '.ab .lb .bl APLstile.rb ' AP '.nt .lb .bl APLtilde.rb ' AP '.and .lb .bl APLupcaret.rb ' AP '@@' .lmp now apl symbols AP '.io .lb .bl APLiota.rb ' AP '.ro .lb .bl APLrho.rb ' AP '.om .lb .bl APLomega.rb ' AP '.ep .lb .bl APLepsilon.rb ' AP '.ua .lb .bl APLuparrow.rb ' AP '.da .lb .bl APLdownarrow.rb ' AP '.lo .lb .bl APLcircle.rb ' AP '.go .lb .bl APLrightarrow.rb ' AP '.is .lb .bl APLleftarrow.rb ' AP '.sqd .lb .bl APLleftbracketrightbracket.rb ' AP '.zio .lb .bl APLiotaunderbar.rb ' AP '.zep .lb .bl APLepsilonunderbar.rb ' AP '.mst .lb .bl APLdieresisdot.rb ' AP '.eqv .lb .bl APLequalunderbar.rb ' AP '.al .lb .bl APLalpha.rb ' AP '.ce .lb .bl APLupstile.rb ' AP '.fl .lb .bl APLdownstile.rb ' AP '.del .lb .bl APLdel.rb ' AP '.ld .lb .bl APLdelta.rb ' AP '.so .lb .bl APLjot.rb ' AP '.bx .lb .bl APLquad.rb ' AP '.qq .lb .bl APLquadquote.rb ' AP '.xq .lb .bl APLdowntackjot.rb ' AP '.fm .lb .bl APLuptackjot.rb ' AP '.ru .lb .bl APLleftshoe.rb ' AP '.lu .lb .bl APLrightshoe.rb ' AP '.du .lb .bl APLupshoe.rb ' AP '.uu .lb .bl APLdownshoe.rb ' AP '.de .lb .bl APLdowntack.rb ' AP '.en .lb .bl APLuptack.rb ' AP '.lmp .lb .bl APLupshoejot.rb ' AP '.cb .lb .bl APLslopebar.rb ' AP '.cs .lb .bl APLslashbar.rb ' AP '.dd .lb .bl APLdieresis.rb ' AP '.ng .lb .bl APLoverbar.rb ' AP '.le .lb .bl APLnotgreater.rb ' AP '.ge .lb .bl APLnotless.rb ' AP '.ne .lb .bl APLnotequal.rb ' AP '.or .lb .bl APLdowncaret.rb ' AP '.ti .lb .bl APLtimes.rb ' AP '.div .lb .bl APLdivide.rb ' AP '.ib .lb .bl APLdowntackuptack.rb ' AP '.pd .lb .bl APLdeltilde.rb ' AP '.gd .lb .bl APLdelstile.rb ' AP '.gu .lb .bl APLdeltastile.rb ' AP '.rv .lb .bl APLcirclestile.rb ' AP '.tr .lb .bl APLcircleslope.rb ' AP '.cr .lb .bl APLcirclebar.rb ' AP '.lg .lb .bl APLcirclestar.rb ' AP '.nor .lb .bl APLdowncarettilde.rb ' AP '.nand .lb .bl APLupcarettilde.rb ' AP '.zld .lb .bl APLdeltaunderbar.rb ' AP '.dq .lb .bl APLquaddivide.rb ' .lmp ascii characters AP '.dqt .lb ''''.rb ' AP '#.bl #' AP '$.bl $' AP '%.bl %' AP '&.bl &' AP '.umlautu .lb .bl .dqt u.rb ' AP '.umlauta .lb .bl .dqt a.rb ' AP '.umlautA .lb .bl .dqt A.rb ' AP '.umlauto .lb .bl .dqt o.rb ' AP '.umlautO .lb .bl .dqt O.rb ' AP '.umlautU .lb .bl .dqt U.rb ' AP '.pounds .lb .bl pounds.rb ' AP '.ascii226 .lb .bl ss.rb ' AP '.paragraph .lb .bl P.rb ' AP '.section .lb .bl S.rb ' .end function .begin function PPMXD R.is PPMXD X R.is 2=.ro ((R.io R)=.io .ro R)/R.is 1.ua .dd 0.ro .dd .ep X .end function .begin function PPQNL R.is PPQNL;I;.bx IO .lmp all vars, functions, operators (if definable) .lmp APL2/PC .bx IO.is 1 R.is .bx NL 2 3 4 R.is R I.is .io 0 .lmp we don't want those: I.is I,(R.and . =(.ng 1.ua .ro R).ua 'C.us PP1')/.io 1.ua .ro R I.is I,(R.and . =(.ng 1.ua .ro R).ua 'C.us PP2')/.io 1.ua .ro R I.is I,(R.and . =(.ng 1.ua .ro R).ua 'Cfs')/.io 1.ua .ro R I.is I,(R.and . =(.ng 1.ua .ro R).ua 'D.us PP1')/.io 1.ua .ro R I.is I,(R.and . =(.ng 1.ua .ro R).ua 'D.us PP2')/.io 1.ua .ro R I.is I,(R.and . =(.ng 1.ua .ro R).ua 'Dfs')/.io 1.ua .ro R R.is R[(.nt (.io 1.ua .ro R).ep I)/.io 1.ua .ro R;] .lmp drop names starting 'PP' R.is ((R[;1].ne 'P').and R[;2].ne 'P')/[1]R .end function .begin function PPRE R.is PPRE R.is .bx TC[2] .end function .begin function PPREAD PPREAD PPNL;PPCR;PPQ;PPLIN;PPFN;PPNA;PPHD;PPLI;PPAV;PPESC PPAV.is PPMAV .lmp make transl. table PPFN.is PPGIF(.ng 1+(.nt .bx IO)+PPNL.io ' ').ua PPNL.is ,PPNL PPNL.is ((.nt .bx IO)+PPNL.io ' ').da PPNL .xq (0.ne .ro PPNL)/'PPNL.is '' '' PPMAT PPNL.is PPELZM PPNL' PPFN.is 1 PPFOP 'R',PPFN PPTOP:.go (0.ep 1.ua 0.ro PPLIN.is PPFRD PPFN)/PPEND .go ((PPQ.ua '. newescape ').and . =(PPQ.is (.nt .bx IO)+PPLIN.io ' ').. ua PPLIN)/PPNEWESC .go (.nt (PPESC,'begin ').and . =7.ua PPLIN)/PPTOP .lmp read until ob. ject PPHD.is ' ' PPMAT PPAPL PPELZM PPLIN.is 7.da PPLIN .lmp parse header PPNA.is PPELZM,PPHD[.bx IO+1;] .lmp get name .go (0=.ro PPNL)/PPEXP .lmp do we read everything? .go (.nt PPNL PPFIND PPNA)/PPTOP .lmp dont read that object.fac PPEXP:.bx .is PPELZM,' ',PPHD[.bx IO+0 1;] .xq ('.bx '.ne 1.ua PPNA)/'PPQ.is .bx EX PPNA' .lmp expunge whatever . was there .go ('array '.and . =6.ua PPLIN)/PPVAR .lmp is it a variable? PPFUN:PPCR.is 0 0.ro ' ' PPFUNL:PPLI.is '' PPFUNL2:.go ((PPESC,'end ').and . =5.ua PPLIN.is PPFRD PPFN)/PPEST PPLI.is PPLI,PPLIN.is (.rv .or .bl ' '.ne .rv PPLIN)/PPLIN .go (PPESC.ne .ng 1.ua PPLIN)/PPFL2 PPLI.is .ng 1.da PPLI .go PPFUNL2 PPFL2:PPCR.is PPCR PPAB PPAPL PPLI .go PPFUNL PPEST:PPQ.is .bx FX PPCR .go PPCHK PPVAR:PPCR.is '' PPVARL:.go ((PPESC,'end ').and . =5.ua PPLIN.is PPFRD PPFN)/PPVNXT PPCR.is PPCR,2.da 72.ua PPLIN .lmp drop leading 2 blanks, line length. 72 .go PPVARL PPVNXT:PPQ.is PPFX PPAPL PPCR PPCHK:.go ('.bx '=1.ua PPNA)/PPTOP .xq (.nt .or /2 3 4=.bx NC PPNA)/''' Object NOT established.fac ''' .go PPTOP PPNEWESC:PPESC.is .ng 1.ua (1+PPLIN.io ' ').ua PPLIN .go PPTOP PPEND:PPQ.is PPFCL PPFN .end function .begin function PPSAV PPSAV;I I.is 0 LOOP:.go (2561.ua .ro PPTX)/X 'Unknown symbols: ''',N,''', using blank instead. ' R[(R=1+1.ua .ro PPTX)/.io .ro R].is PPTX[;1].io ' ' .go NEXT .end function .begin function PPTEXW R.is L PPTEXW X .lmp where to wrap a long line R.is (.nt .ne .bl X.ep '.lb .rb ')/.io .ro X R.is (.ng 1.ua (L>R)/R).ua X .end function .begin function PPTF TF2R.is TF2C PPTF TF2A;TF2Q;TF2N .lmp CREATE TRANSFER FORM OF OBJECT NAMED IN TF2A TF2R.is '' TF2N.is '.so ' .go TF2C/TF2ISENC .lmp IS A A VALUE? C IS 1 ONLY IN RECURSIVE CALL. TF2ISFUN:.go (.or /3 4=.bx NC TF2A.is (' '.ne TF2A)/TF2A)/TF2FUN .go (0=.bx NC TF2A)/TF2NONAM TF2N.is TF2A TF2A.is .xq TF2A TF2ISENC:.go (2.ne PPVER)/TF2VAR .lmp AVOID ERROR IN GEN 1 APLS .go (1<.ab .eqv TF2A)/TF2ENC .go (PPMXD TF2A)/TF2ENC TF2VAR:TF2R.is TF2N,' ',(.fm (.ro .ro TF2R),.ro TF2R),' ',.fm ,TF2R.is . TF2A TF2R.is (.fm .ro TF2R),TF2R.is 'NC'[(.io 1)+' '=1.ua 0.ro TF2A],TF2R .go 0 TF2FUN:.go (0.ep .ro .bx CR TF2A)/TF2LOCK TF2R.is (.fm .ro TF2R),TF2R.is 'F',TF2A,' ',(.fm (.ro .ro TF2R),.ro TF2. R),' ',,TF2R.is .bx CR TF2A .go 0 TF2ENC:TF2R.is 'E',TF2N,' ',(.fm (.ro .ro TF2A),.ro TF2A),' ' .go (0=.ro TF2A.is ,TF2A)/TF2END TF2LOOP:TF2R.is TF2R,1 PPTF.lu TF2A[1] .go (0.ne .ro TF2A.is 1.da TF2A)/TF2LOOP TF2END:TF2R.is (.fm .ro TF2R),TF2R .go 0 TF2LOCK:TF2R.is 'RLOCKED OR EXTERNAL FUNCTION, .bx CR IS EMPTY. ' .go 0 TF2NONAM:TF2R.is 'RTHERE IS NO OBJECT OF THAT NAME. ' .end function .begin function PPVER R.is PPVER R.is 2 .end function .begin function PPWALL PPWALL PPFN .lmp write all objects in WS to file PPFN PPFWR PPESC,'begin array ',PPASC .bx .is '.bx IO' PPFN PPFWR ' 8N',(PPASC '.bx IO'),' 0 ',.fm PPQIO .lmp remembered .b. x IO PPFN PPFWR PPESC,'end array' PPFN PPFWR ' ' ' Object written to file. ' PPNL.is ,' ','.bx LX' PPAB '.bx PW' PPAB '.bx PP' PPAB PPQNL .end function .begin function PPWO PPFN PPWO PPNA;PPCR;PPQ;PPLIN;PPLL PPLL.is 73 .lmp line length for functions PPLOOP:.go (2=.bx NC PPNA)/PPVAR PPFN PPFWR PPESC,'begin function ',PPELZM PPASC,PPNA .go (0.ep .ro PPCR.is .bx CR PPNA)/PPE2 PPFN PPFWR ' ',PPASC,(.rv .or .bl .rv ' '.ne PPQ)/PPQ.is ,PPCR[1;] .go (0.ep .ro PPCR.is 1 0.da PPCR)/PPE2 PPLOOP2:PPLIN.is ' ',PPASC(.rv .or .bl .rv ' '.ne PPQ)/PPQ.is ,PPCR[1;. ] PPLOOP3:PPFN PPFWR(PPLL.ua PPLIN),(PPLL<.ro PPLIN).ro PPESC .go (0.ne .ro PPLIN.is PPLL.da PPLIN)/PPLOOP3 .go (0.ne 1.ua .ro PPCR.is 1 0.da PPCR)/PPLOOP2 PPE2:PPFN PPFWR PPESC,'end function' PPEND:PPFN PPFWR ' ' ' Object written to file. ' .go 0 PPVAR:.go (0=.ro PPCR.is 0 PPTF PPNA)/PPERR PPLIN.is PPESC,'begin array ',PPASC PPNA PPFN PPFWR PPLIN PPCR.is PPASC PPCR PPVL2:PPFN PPFWR ' ',70.ua PPCR .go (0.ne .ro PPCR.is 70.da PPCR)/PPVL2 PPFN PPFWR PPESC,'end array' .go PPEND PPERR:'+++ ERROR +++ Object *NOT* written to file. ' .end function .begin function PPWRITE PPWRITE PPNL;PPCR;PPQ;PPAV;PPLIN;PPFN;PPNA;PPQIO;PPESC PPAV.is PPMAV .lmp make transl. table PPQIO.is .bx IO .lmp remember .bx IO setting .bx IO.is 1 PPFN.is PPGOF(.ng 1+PPNL.io ' ').ua PPNL.is ,PPNL PPFN.is 1 PPFOP 'W',PPFN PPNL.is (PPNL.io ' ').da PPNL PPFN PPFWR ' This is a PP file for the transfer of APL information. ' PPFN PPFWR ' The next line describes the system of origin:' PPFN PPFWR PPESC,'origin ',PPSYS .lmp write header PPFN PPFWR ' ' PPFN PPFWR '. escape ',PPESC PPFN PPFWR ' ' .xq (0=.ro PPNL)/'PPWALL PPFN' .lmp all user-definable objects . in WS PPNL.is ' ' PPMAT PPNL.is PPELZM PPNL PPLOOP:PPFN PPWO PPELZM .bx .is ,PPNL[1;] .go (.nt 0.ep .ro PPNL.is 1 0.da PPNL)/PPLOOP PPQ.is PPFCL PPFN .bx IO.is PPQIO .end function