1 REM Ins{nd av Hans Holmberg <2838> 1988-04-05 02.14.17 (DUMP) 100 REM +---------------------------------------------------------------------+ 101 REM ! Program: EVALU.BAS version 1.0, (C) 1988 Hans Holmberg /Mummel ! 102 REM ! ! 103 REM ! Programmet f}r ej anv{ndas i kommersiellt syfte utan upphovsmannens ! 104 REM ! till}telse. Ej heller f}r programmet |verf|ras, kopieras eller p} ! 105 REM ! annat s{tt reproduceras till annan typ av dator {n ABC800/802/806 ! 106 REM ! i sin helhet eller i delar utan densammes till}telse. ! 107 REM +---------------------------------------------------------------------+ 108 REM ! F|r mer information kring programmer eller i allm{nhet, skriv till: ! 109 REM ! ! 110 REM ! Hans Holmberg ! 111 REM ! Sommarv{gen 5 ! 112 REM ! 852 59 Sundsvall ! 113 REM ! ! 114 REM +---------------------------------------------------------------------+ 115 REM ! Globala variabler som programmet anv{nder sig av: ! 116 REM ! ================================================== ! 117 REM ! Lbl$ Inneh}ller alla labler i formatet: ! 118 REM ! -"- 'lbl1lbl2lbl3' ! 119 REM ! Lbl(..) Inneh}ller v{rdena f|r varje label. ! 120 REM ! Lbllen L{ngd p} labels inklusive space't ! 121 REM ! Adrptr Inneh}ller det v{rde som '$' {r lika med ! 122 REM ! Err Errorr{knare som h}ller reda antalet errors ! 123 REM ! Errf Filnummer d{r alla error texter hamnar ! 124 REM ! Line Vilken rad som evalueras ! 125 REM ! Dbase Default base, default bas som anv{nds vid evalueringen ! 126 REM ! Flag Intern flagga som m}ste vara global ! 127 REM ! Slask+Slask. Slaskvariabel som anv{nds lite h{r och d{r ! 128 REM +---------------------------------------------------------------------+ 129 REM ! In: Ut: ! 130 REM ! ==== ==== ! 131 REM ! Ett uttryck, som tex: Det tal som ber{knats i FNEvalu(nn) ! 132 REM ! '(SLUT-START)/256D', eller: exv: Tal=FNEvalu('HEJ_D]+KALLE') ! 133 REM ! 'V[RDE.AND.255D' ! 134 REM +---------------------------------------------------------------------+ 135 REM ! De funktioner som finns i programmet {r (listade efter prioritet): ! 136 REM ! ======================================== ! 137 REM ! 1. (,) Paranteser ! 138 REM ! 2. *,/ Multiplikation samt division ! 139 REM ! 3. +,- Addition och subtraktion ! 140 REM ! AND OR XOR NOT Logiska operatorer ! 141 REM +---------------------------------------------------------------------+ 142 REM ! Programexempel: ! 143 REM ! =============== ! 144 REM ! 10 Lbllen=9 ! 145 REM ! 20 Lbl$=' START LOOP KLAR? SLUT ' ! 146 REM ! 30 Lbl(0)=32768 : Lbl(1)=32779 : Lbl(2)=32788 : Lbl(3)=32793 ! 147 REM ! 40 Line=1 : Err=0 ! 148 REM ! 50 Proglen=FNEvalu('SLUT-START+1') ! 149 REM ! 60 PRINT 'Programmets l{ngd:' Proglen ! 150 REM ! 70 Looplen=FNEvalu('KLAR?-LOOP+1') ! 151 REM ! 80 PRINT 'Programloopen upptar' Looplen ' bytes!' ! 152 REM ! 90 PRINT '10+3*4-(100/27) = '; ! 153 REM ! 100 PRINT FNEvalu('10+3*4-(100/27)') ! 154 REM ! 110 PRINT 'Det h{r ska den inte klara: "HEJSAN+HOPPSAN" ! 155 REM ! 120 PRINT FNEvalu('HEJSAN+HOPPSAN') ! 156 REM ! 130 PRINT 'H{r ska den skriva ut' Lbl(0) ! 157 REM ! 140 Adrptr=Lbl(0) ! 158 REM ! 150 PRINT FNEvalu('$') ! 159 REM ! RUN ! 160 REM ! Programmets l{ngd: 26 ! 161 REM ! Programmloopen upptar 9 bytes! ! 162 REM ! 10+3*4-(100/27) = 19 ! 163 REM ! Det h{r ska den inte klara: "HEJSAN+HOPPSAN" ! 164 REM ! Line 1 - Bad operand. ! 165 REM ! 0 ! 166 REM ! H{r ska den skriva ut 32768 ! 167 REM ! 32768 ! 168 REM ! ABC80x ! 169 REM ! _ ! 170 REM ! ! 171 REM +---------------------------------------------------------------------+ 172 REM ! Den del som b|rjar p} rad 65000 mergas ihop med l{mpligt program ! 173 REM ! f|r anv{ndning. Lyck till... ! 174 REM +---------------------------------------------------------------------+ 65000 INTEGER : EXTEND 65001 DEF FNEvalunum LOCAL Slask$=16,Base0$=4,Base1$=4,Base2$=4,Dbase,Bconst,A 65002 Base0$=CHR$(2,8,10,16) : Base1$="BODH" : IF Dbase=0 THEN Dbase=3 65003 Base2$=CHR$(16,6,5,4) 65004 A=ASCII(Oper$) 65005 ! 65006 ! Check if number 65007 ! 65008 IF A>47 AND A<58 GOTO 65025 65009 ! 65010 ! Check if adrptr 65011 ! 65012 IF A=36 Oper$=RIGHT$(Oper$,2) : RETURN Adrptr 65013 ! 65014 ! Get label-value 65015 ! 65016 FOR Slask=1 TO LEN(Oper$) 65017 IF INSTR(1,'+-/*.()',MID$(Oper$,Slask,1))=0 NEXT Slask 65018 I=INSTR(1,Lbl$,' '+LEFT$(LEFT$(Oper$,Slask-1)+SPACE$(Lbllen),Lbllen)) 65019 IF I=0 THEN 65048 65020 Oper$=RIGHT$(Oper$,Slask) 65021 RETURN Lbl(INT((I-1)/9)) 65022 ! 65023 ! Transform a number from base nn to a 16-bit number 65024 ! 65025 N$="" 65026 A=ASCII(Oper$) 65027 IF A<48 OR (A>57 AND A<65) OR Oper$="" 65029 65028 N$=N$+CHR$(A) : Oper$=RIGHT$(Oper$,2) : GOTO 65026 65029 B$=RIGHT$(N$,LEN(N$)) 65030 B=INSTR(1,Base1$,B$) 65031 IF B=0 B=Dbase ELSE N$=LEFT$(N$,LEN(N$)-1) 65032 Bconst=ASCII(MID$(Base2$,B,1)) 65033 B=ASCII(RIGHT$(Base0$,B)) 65034 Oper=0 65035 X=LEN(N$) 65036 IF X>Bconst THEN X=X-Bconst ELSE X=1 65037 FOR Slask=X TO LEN(N$) 65038 A=ASCII(MID$(N$,Slask,1))-48 65039 IF A>9 A=A-7 65040 IF A>(B-1) 65048 65041 Slask.=Oper-65536.*(Oper<0) 65042 IF Slask.*B<65536. THEN 65045 ELSE Slask.=Slask.*B+A-65536. 65043 IF Slask.>65535. THEN Slask.=Slask.-65536. : GOTO 65043 65044 Oper=Slask. : GOTO 65046 65045 Oper=Oper*B+A 65046 NEXT Slask 65047 RETURN Oper 65048 ; #Erf "Line" Line " - Bad operand." : Err=Err+1 : RETURN 0 65049 FNEND 65050 DEF FNEvalu(Slask$) LOCAL Slask$=16,Stack$=35,Evalu$=35,I,A,Cnt 65051 Stack$="" : Evalu$="" 65052 Oper$=Slask$ 65053 IF ASCII(Oper$)<48 AND ASCII(Oper$)<>36 GOTO 65064 65054 Stack$=Stack$+CVT%$(FNEvalunum) 65055 Evalu$=Evalu$+CHR$(128+Cnt) : Cnt=Cnt+1 65056 IF Cnt=17 GOTO 65087 65057 IF Oper$<>"" 65064 65058 I=-1 65059 I=INSTR(I+2,Evalu$,CHR$(9)) 65060 IF I=0 THEN RETURN FNCalc(Evalu$,Stack$) 65061 MID$(Evalu$,I,2)=LEFT$(Evalu$,I-1)+CVT%$(SWAP%(CVT$%(MID$(Evalu$,I,2))))+RIGHT$(Evalu$,I+2) 65062 GOTO 65059 65063 Oper$=RIGHT$(Oper$,2) 65064 A=ASCII(Oper$) : IF A=32 GOTO 65063 65065 I=INSTR(1,"+-*/().",CHR$(A)) 65066 IF I 65068 ELSE IF Evalu$="" THEN 65085 65067 A=ASCII(RIGHT$(Evalu$,LEN(Evalu$))) : IF A<5 OR (A>5 AND A<128) 65054 ELSE 65085 65068 IF I=7 GOSUB 65074 65069 Evalu$=Evalu$+CHR$(I-1) 65070 Oper$=RIGHT$(Oper$,2) 65071 IF Oper$="" 65058 ELSE A=ASCII(Oper$) 65072 IF A=46 OR A=40 OR I=6 GOTO 65065 65073 GOTO 65054 65074 I=INSTR(2,Oper$,".") 65075 IF I=0 THEN 65085 65076 X$=LEFT$(MID$(Oper$,2,I-2)+' ',3) 65077 Oper$=RIGHT$(Oper$,I) 65078 I=INSTR(1,"ANDOR XORNOT",X$) 65079 IF I=0 OR MOD(I-1,3)<>0 GOTO 65085 65080 I=7+(I-1)/3 65081 IF Evalu$="" RETURN 65082 X=ASCII(RIGHT$(Evalu$,LEN(Evalu$))) 65083 IF X=9 GOTO 65086 65084 RETURN 65085 ; #Erf "Line" Line " - Unknown function." : Err=Err+1 : RETURN 0 65086 ; #Erf "Line" Line " - 'NOT' statement placed wrong." : Err=Err+1 : RETURN 0 65087 ; #Erf "Line" Line " - Formula to complex." : Err=Err+1 : RETURN 0 65088 FNEND 65089 DEF FNCalc(In0$,In1$) LOCAL Stack$=64,In1$=64,Evalu$=35,In0$=35,I,J,A,Oper,Oper2,Stack2$=6 65090 Evalu$=In0$ : Stack$=In1$ 65091 I=0 : J=0 65092 J=INSTR(I+1,Evalu$,CHR$(4)) 65093 IF J=0 IF I=0 IF Flag 65123 ELSE 65109 65094 ! 65095 ! Evaluate '( operation )' 65096 ! 65097 IF J I=J : GOTO 65092 65098 J=INSTR(I+1,Evalu$,CHR$(5)) 65099 IF J=I+1 GOTO 65172 65100 IF J=0 THEN 65171 65101 Oper=FNCalc(MID$(Evalu$,I+1,(J-I)-1),Stack$) 65102 Evalu=ASCII(MID$(Evalu$,I+1,1))-128 65103 MID$(Stack$,Evalu*2+1,2)=CVT%$(Oper) 65104 Evalu$=LEFT$(Evalu$,I-1)+CHR$(Evalu+128)+RIGHT$(Evalu$,J+1) 65105 GOTO 65091 65106 ! 65107 ! Evaluate in correct order (*/ first) 65108 ! 65109 J=INSTR(I+1,Evalu$,CHR$(2)) : Slask=INSTR(I+1,Evalu$,CHR$(3)) 65110 IF J=0 IF Slask=0 THEN 65123 65111 IF J=0 THEN J=Slask : GOTO 65113 65112 IF Slask<>0 IF Slask4 GOTO 65172 65133 Oper2=CVT$%(Stack2$) : Stack2$=RIGHT$(Stack2$,3) 65134 Oper=CVT$%(Stack2$) 65135 ON I+1 GOSUB 65141,65145,65149,65154,65174,65174,65158,65162,65166,65170 65136 Stack2$=CVT%$(Oper)+RIGHT$(Stack2$,3) 65137 GOTO 65127 65138 ! 65139 ! '+' function 65140 ! 65141 Oper=Oper+Oper2 : RETURN 65142 ! 65143 ! '-' function 65144 ! 65145 Oper=Oper-Oper2 : RETURN 65146 ! 65147 ! '*' function 65148 ! 65149 Slask.=Oper : IF (Slask.*Oper2)>65535. THEN 65173 65150 Oper=Oper*Oper2 : RETURN 65151 ! 65152 ! '/' function 65153 ! 65154 Oper=INT(Oper/Oper2) : RETURN 65155 ! 65156 ! 'AND' function 65157 ! 65158 Oper=Oper AND Oper2 : RETURN 65159 ! 65160 ! 'OR ' function 65161 ! 65162 Oper=Oper OR Oper2 : RETURN 65163 ! 65164 ! 'XOR' function 65165 ! 65166 Oper=Oper XOR Oper2 : RETURN 65167 ! 65168 ! 'NOT' function 65169 ! 65170 Oper=NOT Oper : RETURN 65171 ; #Erf "Line" Line "- ')' missing." : Err=Err+1 : RETURN 0 65172 ; #Erf "Line" Line "- Operand missing." : Err=Err+1 : RETURN 0 65173 ; #Erf "Line" Line "- Value out of range." : Err=Err+1 : RETURN 0 65174 ; #Erf "Line" Line "- Program error, call your dealer." : Err=Err+1 : RETURN 0 65175 FNEND