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