LEX 'MW' * (c) Copyright PPC Paris 1986 * Janick Taillandier 1986 * * Change history * 1.3 version w/o left & right parenthesis 86/03/15 * B: as 1.3 + parenthesis ie (CH3)2CCOOH 86/03/30 * Corrected Iodine entry, updated atwts from ChemAust Vol 55,Nús1,2 pp31,32 * Jack Elhay, 1st March 1988. ID #50 MSG 0 POLL poll ENTRY mass CHAR #F KEY 'MOLEWT' TOKEN 1 ENDTXT in( EQU 0 FUNCD0 EQU #2F8BB RANGE EQU #1B07C ARGERR EQU #0BF19 REVPOP EQU #0BD31 DRANGE EQU #1B076 STSCR EQU #0E92C RCSCR EQU #0E954 SPLITA EQU #0C6BF SPLITC EQU #0C940 AD2-15 EQU #0C363 MP2-12 EQU #0C432 FLOAT EQU #1B322 uRES12 EQU #0C994 FNRTN1 EQU #0F216 MP2-15 EQU #0C43A EJECT poll ?B=0 B GOYES hVER$0 RTNSXM no other polls hVER$0 C=R3 handle VER$ D1=C A=R2 D1=D1- (VER$en)-(VER$st)-2 CD1EX ?A>C A GOYES hVER$1 D1=C R3=C VER$st LCASC ' MW:ec' VER$en DAT1=C (VER$en)-(VER$st)-2 hVER$1 RTNSXM NIBHEX 411 mass CD0EX D0=(5) (FUNCD0) DAT0=C A save D0 in FUNCD0 ST=0 in( A=0 W B=0 W GOSUB stscr GOSBVL =REVPOP pop & reverse string C=0 W for CSRB C=A A get length in nibbles CSRB length in bytes ?C#0 A GOYES mass01 argerr GOVLNG ARGERR mass01 C=C-1 A count 1st char R0=C length in R0 mass11 A=DAT1 B GOSUB Arange GONC mass12 LCASC '(' ?C=A B GOYES mass13 LCASC ')' ?C=A B GOYES mass14 GOTO argerr if not in A..Z mass13 GOSUB LP D1=D1+ 2 GOTO mass11 mass14 P= 1 GOSUB mass40 GOSUB mass+ GOTO RP mass12 R1=A save char in R1 C=R0 restore count ?C#0 A GOYES mass20 not yet finished P= 1 GOTO mass90 find component and exit mass20 R0=C save count D1=D1+ 2 A=DAT1 B read next char GOSBVL =DRANGE GONC mass21 it is a digit GOSUB Arange GONC mass25 it is in A..Z LCASC 'za' GOSUB range GONC mass26 it is in a..z LCASC '(' ?A=C B GOYES mass25 LCASC ')' ?A=C B GOYES mass28 GOTO argerr otherwise 'Invalid Arg' mass21 P= 1 GOTO mass34 process digit after processing mass mass25 P= 1 GOSUB mass40 GOSUB mass+ GOSUB cnt-1 GOTO mass11 mass26 C=R1 uppercase + lowecase component CSL W CSL W C=A B R1=C new character appended GOSUB cnt-1 update count ?C#0 A GOYES mass31 P= 3 # of nibbles in comp name GOTO mass90 mass28 P= 1 GOSUB mass40 GOSUB mass+ GOSUB cnt-1 GOTO RP mass31 D1=D1+ 2 A=DAT1 B read new char GOSUB drange GONC mass32 in 0..9 GOSUB Arange GONC mass33 LCASC '(' ?A=C B GOYES mass3a LCASC ')' ?A=C B GOYES mass3b GOTO argerr otherwise 'Invalid Arg' mass3a P= 3 GOSUB mass40 GOSUB mass+ GOSUB LP D1=D1+ 2 GOTO mass11 mass3b P= 3 GOSUB mass40 GOSUB mass+ GOSUB cnt-1 GOTO RP mass33 P= 3 GOSUB mass40 return mass in C[W] GOSUB mass+ update total GOSUB cnt-1 GOTO mass11 process new elt mass32 P= 3 mass34 GOSUB mass40 R2=C save mass in R2 GOSUB dig ?C=0 A GOYES mass37 end of string GOSUB Arange GONC mass38 LCASC '(' ?A=C B GOYES mass35 LCASC ')' ?A=C B GOYES mass36 GOTO argerr * dig<12: test if number of digits as counted in D[A] * is <= 12. * RTN if ok, otherwise error exit dig<12 C=0 A LCHEX C 12 ?D<=C A RTNYES GOTO argerr mass35 GOSUB dig<12 GOSUB massad GOSUB LP D1=D1+ 2 GOTO mass11 mass36 GOSUB dig<12 GOSUB massad GOTO RP mass38 GOSUB dig<12 GOSUB massad GOTO mass11 process new component mass37 GOSUB dig<12 GOSUB massad GOTO mass80 exit... mass90 GOSUB mass40 GOSUB mass+ add it to total * fall into mass80 * Exit mass80 ?ST=0 in( GOYES mass81 GOTO argerr we have no ) before end mass81 GOSUB rcscr result in C/D D0=(5) (FUNCD0) A=DAT0 A D0=A restore D0 D1=D1+ 2 D1 @ end of string BCEX W from XYEX CDEX W BCEX W ACEX W C/D to A/B GOSBVL =uRES12 pack result GOVLNG =FNRTN1 RP ?ST=1 in( already found ( ? GOYES RP01 GOTO argerr no, then error RP01 ST=0 in( no more in () C=R0 ?C#0 A GOYES RP02 still chars after ) GOSUB add GOTO mass80 RP02 D1=D1+ 2 A=DAT1 B what is after ) GOSUB drange GONC RP03 in 0..9 GOSUB Arange GONC RP04 in A..Z LCASC '(' ?A=C B GOYES RP04 we have '..)(..' GOTO argerr otherwise error RP04 GOSUB add GOSUB cnt-1 GOTO mass11 RP03 GOSUB dig read number ?C=0 A GOYES RP051 nothing after last digit GOSUB endRP process ( GOTO mass11 go to next component RP051 GOSUB endRP GOTO mass80 LP ?ST=0 in( GOYES LP01 not already inside () GOTO argerr otherwise error LP01 ST=1 in( A=0 W B=0 W GOSUB stscr GOSUB cnt-1 ?C#0 A RTNYES GOTO argerr they have written '...(' * endRP: sub-prgm for byte savings only .... endRP GOSUB dig<12 SETDEC A=B W GOSBVL =FLOAT result in A GOSBVL =SPLITA GOSUB rcscr GOSBVL =MP2-15 GOSUB stscr GOSUB add add returns in HEX mode RTN * add: add 2 15-dig numbers on top of scratch * scratch math stack and push result on stack add GOSUB rcscr pop 1st element on top of stack BCEX W from XYEX CDEX W BCEX W ACEX W GOSUB rcscr pop second element SETDEC GOSBVL =AD2-15 add them SETHEX GOSUB stscr RTN * dig: process string of digit * in: D1 @ first digit * # of characters left in R0 * * out: C=0 A end of string * C#0 A non digit char in A[B] * both cases number (DEC) in B[W] dig B=0 W prepare image of count D=0 A prepare digit counter GOSUB cnt-1 A=DAT1 B read char dig01 P= 0 for B=A P BSL W B=A P D=D+1 A update digit count C=R0 ?C=0 A RTNYES GOSUB cnt-1 D1=D1+ 2 point to new character A=DAT1 B GOSUB drange use C[A] GONC dig01 character in 0..9 RTN drange GOVLNG =DRANGE Arange LCASC 'ZA' range GOVLNG =RANGE stscr GOSBVL =STSCR P= 0 RTN rcscr GOSBVL =RCSCR P= 0 RTN * cnt-1 cnt-1 C=R0 C=C-1 A R0=C RTN * massad: multiply mass in R2 by count in B[W] * and add to running total on top of scratch stack massad SETDEC A=B W GOSBVL =FLOAT C=R2 GOSBVL =MP2-12 GOTO mass+1 * mass+ : add mass in C[W] to running total * on top of math stack. * use: A,B,C,D,D0,P mass+ SETDEC A=C W copy mass in A[W] for addition GOSBVL =SPLITA in 15-digit format in A[W] mass+1 GOSBVL =RCSCR recall top of scratch in C[W] GOSBVL =AD2-15 add them GOSBVL =STSCR push them again P= 0 SETHEX RTN * mass40: get mass from component name * entry: name in R1[WP] (P=1 or P=3) * exit: mass in C[W] * use: A[W],C[W],D0 mass40 A=R1 recover name ?P= 1 GOYES srch10 GOTO srch20 srch10 GOSUB srch11 LIST OFF NIBASC 'B' NIBHEX 100000000011801 NIBASC 'C' NIBHEX 100000000011021 NIBASC 'F' NIBHEX 100000230489981 NIBASC 'H' NIBHEX 000000000497001 NIBASC 'I' NIBHEX 200000074409621 NIBASC 'K' NIBHEX 100000000389093 NIBASC 'N' NIBHEX 100000004760041 NIBASC 'O' NIBHEX 100000000499951 NIBASC 'P' NIBHEX 100000026737903 NIBASC 'S' NIBHEX 100000000066023 NIBASC 'U' NIBHEX 200000009820832 NIBASC 'V' NIBHEX 100000000514905 NIBASC 'W' NIBHEX 200000000058381 NIBASC 'Y' NIBHEX 100000005850988 NIBHEX 00 LIST ON srch11 C=RSTK get address D0=C srch12 C=DAT0 2 get name ?A=C WP GOYES srch13 ?C=0 WP GOYES srch14 D0=D0+ 2 past name D0=D0+ 15 past numeric value GOTO srch12 srch14 GOTO argerr srch13 P= 0 D0=D0+ 2 C=0 W prepare register C=DAT0 15 read mass P= 0 RTN * 2 letters components srch20 GOSUB srch21 LIST OFF NIBASC 'cA' NIBHEX 200000000000722 NIBASC 'gA' NIBHEX 200000002868701 NIBASC 'lA' NIBHEX 100000093518962 NIBASC 'mA' NIBHEX 200000000000342 NIBASC 'rA' NIBHEX 100000000084993 NIBASC 'sA' NIBHEX 100000009512947 NIBASC 'tA' NIBHEX 200000000000012 NIBASC 'uA' NIBHEX 200000045669691 NIBASC 'aB' NIBHEX 200000000723731 NIBASC 'eB' NIBHEX 000000002812109 NIBASC 'iB' NIBHEX 200000073089802 NIBASC 'kB' NIBHEX 200000000000742 NIBASC 'rB' NIBHEX 100000000040997 NIBASC 'aC' NIBHEX 100000000087004 NIBASC 'dC' NIBHEX 200000000114211 NIBASC 'eC' NIBHEX 200000000511041 NIBASC 'fC' NIBHEX 200000000000152 NIBASC 'lC' NIBHEX 100000000725453 NIBASC 'mC' NIBHEX 200000000000742 NIBASC 'oC' NIBHEX 100000000233985 NIBASC 'rC' NIBHEX 100000000169915 NIBASC 'sC' NIBHEX 200000034509231 NIBASC 'uC' NIBHEX 100000000064536 NIBASC 'yD' NIBHEX 200000000005261 NIBASC 'rE' NIBHEX 200000000062761 NIBASC 'sE' NIBHEX 200000000000452 NIBASC 'uE' NIBHEX 200000000569151 NIBASC 'eF' NIBHEX 100000000074855 NIBASC 'mF' NIBHEX 200000000000752 NIBASC 'rF' NIBHEX 200000000000322 NIBASC 'aG' NIBHEX 100000000032796 NIBASC 'dG' NIBHEX 200000000052751 NIBASC 'eG' NIBHEX 100000000001627 NIBASC 'eH' NIBHEX 000000002062004 NIBASC 'fH' NIBHEX 200000000094871 NIBASC 'gH' NIBHEX 200000000095002 NIBASC 'oH' NIBHEX 200000023039461 NIBASC 'nI' NIBHEX 200000000028411 NIBASC 'rI' NIBHEX 200000000022291 NIBASC 'rK' NIBHEX 100000000000838 NIBASC 'aL' NIBHEX 200000005509831 NIBASC 'iL' NIBHEX 000000000001496 NIBASC 'rL' NIBHEX 200000000000062 NIBASC 'uL' NIBHEX 200000000769471 NIBASC 'dM' NIBHEX 200000000000852 NIBASC 'gM' NIBHEX 100000000050342 NIBASC 'nM' NIBHEX 100000005083945 NIBASC 'oM' NIBHEX 100000000004959 NIBASC 'aN' NIBHEX 100000086798922 NIBASC 'bN' NIBHEX 100000008360929 NIBASC 'dN' NIBHEX 200000000042441 NIBASC 'eN' NIBHEX 100000000797102 NIBASC 'iN' NIBHEX 100000000009685 NIBASC 'oN' NIBHEX 200000000000552 NIBASC 'pN' NIBHEX 200000002840732 NIBASC 'sO' NIBHEX 200000000002091 NIBASC 'aP' NIBHEX 200000088530132 NIBASC 'bP' NIBHEX 200000000002702 NIBASC 'dP' NIBHEX 200000000024601 NIBASC 'mP' NIBHEX 200000000000541 NIBASC 'oP' NIBHEX 200000000000902 NIBASC 'rP' NIBHEX 200000056709041 NIBASC 'tP' NIBHEX 200000000080591 NIBASC 'uP' NIBHEX 200000000000442 NIBASC 'aR' NIBHEX 200000004520622 NIBASC 'bR' NIBHEX 100000000876458 NIBASC 'eR' NIBHEX 200000000702681 NIBASC 'hR' NIBHEX 200000005509201 NIBASC 'nR' NIBHEX 200000000000222 NIBASC 'uR' NIBHEX 200000000070101 NIBASC 'bS' NIBHEX 200000000057121 NIBASC 'cS' NIBHEX 100000001955944 NIBASC 'eS' NIBHEX 100000000006987 NIBASC 'iS' NIBHEX 100000000558082 NIBASC 'mS' NIBHEX 200000000063051 NIBASC 'nS' NIBHEX 200000000017811 NIBASC 'rS' NIBHEX 100000000002678 NIBASC 'aT' NIBHEX 200000009749081 NIBASC 'bT' NIBHEX 200000043529851 NIBASC 'cT' NIBHEX 100000000000079 NIBASC 'eT' NIBHEX 200000000006721 NIBASC 'hT' NIBHEX 200000001830232 NIBASC 'iT' NIBHEX 100000000008874 NIBASC 'lT' NIBHEX 200000003383402 NIBASC 'mT' NIBHEX 200000012439861 NIBASC 'eX' NIBHEX 200000000092131 NIBASC 'bY' NIBHEX 200000000040371 NIBASC 'nZ' NIBHEX 100000000009356 NIBASC 'rZ' NIBHEX 100000000042219 NIBHEX 0000 end of table LIST ON srch21 C=RSTK D0=C srch22 C=DAT0 4 get name ?A=C WP GOYES srch23 ?C=0 WP GOYES srch24 D0=D0+ 4 D0=D0+ 15 past numeric value GOTO srch22 srch24 GOTO srch14 not in table srch23 P= 0 D0=D0+ 4 @ numeric value C=0 W C=DAT0 15 P= 0 RTN END