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 ! -"-          '<space>lbl1<space>lbl2<space>lbl3'                    !
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 Slask<J THEN J=Slask
65113   Flag=1
65114   Oper=FNCalc(MID$(Evalu$,J-1,3),Stack$)
65115   Flag=0
65116   Evalu=ASCII(MID$(Evalu$,J-1,1))-128
65117   MID$(Stack$,Evalu*2+1,2)=CVT%$(Oper)
65118   Evalu$=LEFT$(Evalu$,J-2)+CHR$(Evalu+128)+RIGHT$(Evalu$,J+2)
65119   GOTO 65091
65120   ! 
65121   ! Evaluate '+-*/ AND OR XOR NOT'
65122   ! 
65123   A=ASCII(Evalu$) : Evalu$=RIGHT$(Evalu$,2)
65124   IF (A AND 128)=0 GOTO 65174
65125   Stack2$=MID$(Stack$,(A AND 127)*2+1,2)
65126   Oper=CVT$%(Stack2$)
65127   IF Evalu$="" THEN RETURN Oper
65128   I=ASCII(Evalu$) : Evalu$=RIGHT$(Evalu$,2)
65129   IF I=9 Oper=CVT$%(Stack2$) : GOTO 65135
65130   A=ASCII(Evalu$) : Evalu$=RIGHT$(Evalu$,2)
65131   Stack2$=MID$(Stack$,(A AND 127)*2+1,2)+Stack2$
65132   IF LEN(Stack2$)>4 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