1 REM Experimenteller Code, Marc Meidlinger, Juni 2022
2 REM Mandelbrot z^2+c using CPC's float
3 REM simulating interval arithmetics by
4 REM adding/subtracting 1 from the mantissa
5 REM of a float operation. If invalid, seed c
6 REM will remain UNCLEAR. Subnormals are not considered
10 MODE 1:DEFINT A-Z
11 REM ADJUST ----------------------------
12 X0!=-2.0:X1!=2.0:XXE=64:REM alles 2er-Potenz
13 Y0!=-2.0:Y1!=2.0:YYE=64:YYH=32:REM alles 2er-Potenz
14 SKX!=0.0625:SKY!=0.0625:REM alles 2er-Potenz, (X1!-X0!)/XXE, (Y1!-Y0!)/YYE
15 SIGADD=1:REM what to add/sub to the mantissa
19 MAXIT=15
48 REM -----------------------------------
50 COLUNC=1:INK 1,13:COLESC=2:INK 2,26
52 flsubflag=0:fladdflag=0:flmulflag=0:flulpflag=0:flulpT0!=0.0:flulpT1!=0.0
75 TL!=1E+10:TS!=1E-10
117 CY0!=Y0!-SKY!:CY1!=Y0!:REM exakt im Wertebereich Y0,Y1,SKY
119 Y=0
120 Y=Y+1:IF Y>YYH THEN GOTO 951
130 CY0!=CY1!:CY1!=CY1!+SKY!:REM exakt, s.o.
140 CX0!=X0!-SKX!:CX1!=X0!:REM exakt im Wertebereich
144 X=0
145 X=X+1:IF X>XXE THEN GOTO 901
155 CX0!=CX1!:CX1!=CX1!+SKX!:REM exakt
160 ESC=0:ZX0!=0.0:ZX1!=0.0:ZY0!=0.0:ZY1!=0.0
164 K=0
165 K=K+1:IF K>MAXIT THEN GOTO 801:REM END
166 IF ESC>0 THEN K=MAXIT+1:GOTO 800
170 IF ZX1!<-2.0 OR ZX0!>2.0 OR ZY1!<-2.0 OR ZY0!>2.0 THEN ESC=1:K=MAXIT+1:GOTO 800:REM escaping
171 REM to prevent float overflow
172 IF ABS(ZX0!)>TL! OR ABS(ZX1!)>TL! OR ABS(ZY0!)>TL! OR ABS(ZY1!)>TL! THEN ESC=0:K=MAXIT+1:GOTO 800
174 IF (SGN(ZX0!)<>0 AND ABS(ZX0!)<TS!) THEN ESC=0:K=MAXIT+1:GOTO 800
175 IF (SGN(ZX1!)<>0 AND ABS(ZX1!)<TS!) THEN ESC=0:K=MAXIT+1:GOTO 800
176 IF (SGN(ZY0!)<>0 AND ABS(ZY0!)<TS!) THEN ESC=0:K=MAXIT+1:GOTO 800
177 IF (SGN(ZY1!)<>0 AND ABS(ZY1!)<TS!) THEN ESC=0:K=MAXIT+1:GOTO 800
190 REM Intervall-Arithemtik z^2+c = ([ZX0!..ZX1!]+i*[ZY0!..ZY1!])^2+[CX0!..CX1!]+i*[CY0!..CY1!]
195 flmulA!=ZX0!:flmulB!=ZX0!:GOSUB 21000:XA!=flmulT0!:XD!=flmulT1!:IF flmulerr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
198 flmulA!=ZX0!:flmulB!=ZX1!:GOSUB 21000:XB!=flmulT0!:XE!=flmulT1!:IF flmulerr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
199 flmulA!=ZX1!:flmulB!=ZX1!:GOSUB 21000:XC!=flmulT0!:XF!=flmulT1!:IF flmulerr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
200 XABC!=XA!:IF XB!<XABC! THEN XABC!=XB!
201 IF XC!<XABC! THEN XABC!=XC!
202 XDEF!=XD!:IF XE!>XDEF! THEN XDEF!=XE!
203 IF XF!>XDEF! THEN XDEF!=XF!
210 flmulA!=ZY0!:flmulB!=ZY0!:GOSUB 21000:YA!=flmulT0!:YD!=flmulT1!:IF flmulerr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
211 flmulA!=ZY0!:flmulB!=ZY1!:GOSUB 21000:YB!=flmulT0!:YE!=flmulT1!:IF flmulerr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
212 flmulA!=ZY1!:flmulB!=ZY1!:GOSUB 21000:YC!=flmulT0!:YF!=flmulT1!:IF flmulerr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
250 YABC!=YA!:IF YB!<YABC! THEN YABC!=YB!
251 IF YC!<YABC! THEN YABC!=YC!
252 YDEF!=YD!:IF YE!>YDEF! THEN YDEF!=YE!
253 IF YF!>YDEF! THEN YDEF!=YF!
260 flsubA!=XABC!:flsubB!=YDEF!:GOSUB 20000:TMP!=flsubT0!:IF flsuberr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
261 fladdA!=TMP!:fladdB!=CX0!:GOSUB 20500:ZX0NEU!=fladdT0!:IF fladderr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
270 flsubA!=XDEF!:flsubB!=YABC!:GOSUB 20000:TMP!=flsubT1!:IF flsuberr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
271 fladdA!=TMP!:fladdB!=CX1!:GOSUB 20500:ZX1NEU!=fladdT1!:IF fladderr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
300 flmulA!=ZX0!:flmulB!=ZY0!:GOSUB 21000:A!=flmulT0!:E!=flmulT1!:IF flmulerr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
301 flmulA!=ZX0!:flmulB!=ZY1!:GOSUB 21000:B!=flmulT0!:F!=flmulT1!:IF flmulerr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
302 flmulA!=ZX1!:flmulB!=ZY0!:GOSUB 21000:C!=flmulT0!:G!=flmulT1!:IF flmulerr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
303 flmulA!=ZX1!:flmulB!=ZY1!:GOSUB 21000:D!=flmulT0!:H!=flmulT1!:IF flmulerr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
310 ABCD!=A!:IF B!<ABCD! THEN ABCD!=B!
311 IF C!<ABCD! THEN ABCD!=C!
312 IF D!<ABCD! THEN ABCD!=D!
320 EFGH!=E!:IF F!>EFGH! THEN EFGH!=F!
321 IF G!>EFGH! THEN EFGH!=G!
322 IF H!>EFGH! THEN EFGH!=H!
330 fladdA!=ABCD!:fladdB!=ABCD!:GOSUB 20500:TMP!=fladdT0!:IF fladderr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
331 fladdA!=TMP!:fladdB!=CY0!:GOSUB 20500:ZY0NEU!=fladdT0!:IF fladderr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
340 fladdA!=EFGH!:fladdB!=EFGH!:GOSUB 20500:TMP!=fladdT1!:IF fladderr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
341 fladdA!=TMP!:fladdB!=CY1!:GOSUB 20500:ZY1NEU!=fladdT1!:IF fladderr<>0 THEN ESC=0:K=MAXIT+1:GOTO 800
770 ZX0!=ZX0NEU!:ZX1!=ZX1NEU!:ZY0!=ZY0NEU!:ZY1!=ZY1NEU!
800 GOTO 165:REM K LOOP
801 REM END K
850 IF ESC>0 THEN PLOT X,Y,COLESC:PLOT X,YYE+1-Y,COLESC ELSE PLOT X,Y,COLUNC:PLOT X,YYE+1-Y,COLUNC:REM Symmetrie
900 GOTO 145:REM X LOOP
901 REM END X
950 GOTO 120:REM Y LOOP
951 REM END Y
19999 END
20000 REM funcfloatsub
20001 IF flsubflag>0 THEN PRINT"error. multiple sub.":END
20005 flsubflag=1:flsuberr=0
20006 IF flsubA!=flsubB! THEN flsubT0!=0.0:flsubT1!=0.0:flsubflag=0:RETURN:REM exakt
20010 flsubtmp!=flsubA!-flsubB!
20011 IF SGN(flsubtmp!)=0 THEN flsuberr=1:flsubflag=0:RETURN:REM could be underflow
20015 flulpA!=flsubtmp!:GOSUB 21500:IF flulperr<>0 THEN flsuberr=1:flsubflag=0:RETURN
20020 flsubT0!=flulpT0!:flsubT1!=flulpT1!:flsuberr=0
20099 flsubflag=0:RETURN
20500 REM funcfloatadd
20501 IF fladdflag>0 THEN PRINT"error. multiple add.":END
20505 fladdflag=1:fladderr=0
20506 IF SGN(fladdA!)=0 THEN fladdT0!=fladdB!:fladdT1!=fladdB!:fladdflag=0:RETURN:REM exakt
20507 IF SGN(fladdB!)=0 THEN fladdT0!=fladdA!:fladdT1!=fladdA!:fladdflag=0:RETURN:REM exakt
20508 IF SGN(fladdA!)<>SGN(fladdB!) AND ABS(fladdA!)=ABS(fladdB!) THEN fladdT0!=0.0:fladdT1!=0.0:fladdflag=0:RETURN:REM exakt
20510 fladdtmp!=fladdA!+fladdB!
20511 IF SGN(fladdtmp!)=0 THEN fladderr=1:fladdflag=0:RETURN:REM could be underflow
20515 flulpA!=fladdtmp!:GOSUB 21500:IF flulperr<>0 THEN fladderr=1:fladdflag=0:RETURN
20520 fladdT0!=flulpT0!:fladdT1!=flulpT1!:fladderr=0
20580 fladdflag=0:RETURN
21000 REM funcfloatmul
21001 IF flmulflag>0 THEN PRINT"error. multiple mul.":END
21005 flmulflag=1:flmulerr=0
21006 IF SGN(flmulA!)=0 OR SGN(flmulB!)=0 THEN flmulT0!=0.0:flmulT1!=0.0:flmulflag=0:RETURN:REM exakt
21010 IF @flmulA!>30000 OR @flmulB!>30000 THEN GOTO 21060
21011 IF PEEK(@flmulA!+0)=0 THEN flmulAP2=1 ELSE flmulAP2=0
21012 IF flmulAP2>0 THEN IF PEEK(@flmulA!+1)<>0 THEN flmulAP2=0
21013 IF flmulAP2>0 THEN IF PEEK(@flmulA!+2)<>0 THEN flmulAP2=0
21014 IF flmulAP2>0 THEN IF (PEEK(@flmulA!+3) OR 128)<>128 THEN flmulAP2=0
21015 IF flmulAP2>0 THEN GOTO 21100
21021 IF PEEK(@flmulB!+0)=0 THEN flmulBP2=1 ELSE flmulBP2=0
21022 IF flmulBP2>0 THEN IF PEEK(@flmulB!+1)<>0 THEN flmulBP2=0
21023 IF flmulBP2>0 THEN IF PEEK(@flmulB!+2)<>0 THEN flmulBP2=0
21024 IF flmulBP2>0 THEN IF (PEEK(@flmulB!+3) OR 128)<>128 THEN flmulBP2=0
21025 IF flmulBP2>0 THEN GOTO 21100
21060 flmultmp!=flmulA!*flmulB!:REM gerundet
21061 IF SGN(flmultmp!)=0 THEN flmulerr=1:flmulflag=0:RETURN:REM could be underflow
21070 flulpA!=flmultmp!:GOSUB 21500:IF flulperr<>0 THEN flmulerr=1:flmulflag=0:RETURN
21080 flmulT0!=flulpT0!:flmulT1!=flulpT1!:flmulerr=0
21090 flmulflag=0:RETURN
21100 REM mul if one factor is a power of 2
21101 flmultmp!=flmulA!*flmulB!:REM exakt wenn nicht under/overflow
21110 IF SGN(flmultmp!)=0 THEN flmulerr=1:flmulflag=0:RETURN:REM could be underflow
21112 REM overflow will be printed by CPC on screen
21120 flmulT0!=flmultmp!:flmulT1!=flmultmp!:flmulerr=0:flmulflag=0:RETURN
21500 REM funcfloatulp
21501 IF flulpflag>0 THEN PRINT"error. multiple ulp.":END
21502 flulpflag=1:flulperr=0
21503 IF SGN(flulpA!)=0 THEN flulperr=1:flulpflag=0:RETURN
21504 flulpT0!=flulpA!:flulpT1!=flulpA!
21506 IF @flulpT0!>30000 OR @flulpT1!>30000 THEN flulperr=1:flulpflag=0:RETURN
21510 flulphlp=0:IF PEEK(@flulpT0!+3)>=128 THEN flulphlp=1
21512 POKE @flulpT0!+3,128 OR PEEK(@flulpT0!+3):REM implicit 1
21520 flulpdone=0:flulpco=SIGADD:FOR flulpi=0 TO 3
21530 flulpw=PEEK(@flulpT0!+flulpi) - flulpco
21540 IF flulpw>=0 AND flulpw<=255 THEN POKE @flulpT0!+flulpi,flulpw:flulpdone=1:flulpi=4:GOTO 21580
21550 flulpw=flulpw+256:flulpco=1
21560 IF flulpw<0 OR flulpw>255 THEN PRINT"error. ulp1":END
21570 POKE @flulpT0!+flulpi,flulpw
21580 NEXT flulpi
21590 IF flulpdone<=0 OR PEEK(@flulpT0!+3)<128 THEN flulperr=1:flulpflag=0:RETURN:REM not added or not normal
21595 IF flulphlp>0 THEN POKE @flulpT0!+3,PEEK(@flulpT0!+3) OR 128 ELSE POKE @flulpT0!+3,PEEK(@flulpT0!+3) AND 127:REM sign restore
21610 flulphlp=0:IF PEEK(@flulpT1!+3)>=128 THEN flulphlp=1
21612 POKE @flulpT1!+3,128 OR PEEK(@flulpT1!+3):REM implicit 1
21620 flulpdone=0:flulpco=SIGADD:FOR flulpi=0 TO 3
21630 flulpw=PEEK(@flulpT1!+flulpi) + flulpco
21640 IF flulpw>=0 AND flulpw<=255 THEN POKE @flulpT1!+flulpi,flulpw:flulpdone=1:flulpi=4:GOTO 21680
21650 flulpw=flulpw-256:flulpco=1
21660 IF flulpw<0 OR flulpw>255 THEN PRINT"error. ulp2":END
21670 POKE @flulpT1!+flulpi,flulpw
21680 NEXT flulpi
21690 IF flulpdone<=0 OR PEEK(@flulpT1!+3)<128 THEN flulperr=1:flulpflag=0:RETURN:REM not added or not normal
21695 IF flulphlp>0 THEN POKE @flulpT1!+3,PEEK(@flulpT1!+3) OR 128 ELSE POKE @flulpT1!+3,PEEK(@flulpT1!+3) AND 127:REM sign restore
21720 IF flulpT0!>flulpT1! THEN flulptmp!=flulpT0!:flulpT0!=flulpT1!:flulpT1!=flulptmp!
21721 IF NOT(flulpT0!<=flulpA! AND flulpA!<=flulpT1!) THEN PRINT"error. ulp3":END
21800 flulperr=0:flulpflag=0:RETURN
