Postez vos petits programmes en QBasic

Auteur

Message

gm86

Sujet du message : Re: Postez vos petits programmes en QBasic

Publié : 04 déc. 2019 15:43

Membre inscrit

Hors-ligne

Messages : 623

Inscription : 01 sept. 2008 19:07

Comme tous les 2/3 ans, un nouveau message.

La touche COS¯¹ des calculatrices n'a pas d'équivalent en BASIC. Heureusement, le guide du GW-BASIC donne la solution :
http://www.antonis.de/qbebooks/gwbasman ... x%20B.html

Prenons par exemple une formule trigonométrique utile en astronomie,
cos A/2 = - tg D . tg L
tirée du lien suivant :
http://oncle.dom.pagesperso-orange.fr/p ... tm#Maisons
Elle donne la valeur angulaire de l'arc que parcourt une étoile dans le ciel sous la forme
A = 2 arc cos (- tg D . tg L)
avec D la déclinaison de l'astre et L la latitude du lieu.

Vu que le BASIC Microsoft travaille en radians, les données en degrés seront converties pour obtenir le résultat intermédiaire T=-TAN(D)*TAN(L).
Avec A=2*FNARCCOS(T),
DEF FNARCCOS(X)=ATN (X/SQR(-X*X+1)) + PI/2
soit ATN (X/SQR(-X*X+1)) + ATN(1)*2
puisque PI=ATN(1)*4 en simple précision (355/113).

Lors de la recopie du code suivant, faites sauter les sauts à l'intérieur des lignes numérotées ! Les éditeurs de texte ne connaissent pas Ctrl+J.

Code : Tout sélectionner

10 REM Déterminer le parcours angulaire d'un astre depuis son lever au coucher.
20 PRINT"Renseignez la position de l'étoile et le lieu d'observation."
30 INPUT "Déclinaison ";D
40 IF D>90 OR D<-90 THEN PRINT"Angle requis entre -90 et 90° !" :GOTO 30
50 INPUT "Latitude ";L
60 IF L>90 OR L<-90 THEN PRINT"Angle requis entre -90 et 90° !" :GOTO 50
70 REM Coordonnées converties en radians sauf cas particuliers des pôles.
80 IF ABS(D)-90 AND ABS(L)-90 THEN T=-TAN(D*ATN(1)/45)*TAN(L*ATN(1)/45)
				ELSE T=(ABS(D-L)<90)*2+1	'T=+/-1 si pôle
90 IF FIX(T) THEN
	IF T<0 THEN PRINT"L'étoile est circumpolaire."		:END
		ELSE PRINT"L'étoile reste sous l'horizon."	:END
100 A=90*-ATN(T/SQR(1-T*T))/ATN(1)+180				'(2.arc cos T)°
110 PRINT"L'étoile décrit un arc de";STR$(A);"° dans le ciel."

La formule traite avec |T|<1 pour renvoyer 0°<A<360°. De même, nous tenons compte des cas spécifiques aux pôles célestes et terrestres.

En attendant 2021 ou 2022...

_________________

C:\ONGRTLNS.W95

Haut

Profil

Citer

glaby91

Sujet du message : Re: Postez vos petits programmes en QBasic

Publié : 17 juil. 2020 21:21

Membre inscrit

Hors-ligne

Messages : 20

Inscription : 17 juil. 2020 20:54

Voila le dernier programme non pas en Qbasic mais en basic compatible CPC 6128.

C'est un editeur de niveau de jeu de labyrinthe et on peut aussi tester les niveaux creer:

Code : Tout sélectionner

10 MODE 1:BORDER 0:INK 0,0:PAPER 0:INK 1,5: PEN 1:INK 3,18,25:SPEED INK 25,25
20 INK 2,17
30 index=1:carac=143
35 PEN 1
40 REM FOR a=110 TO 255:PRINT a;:PRINT CHR$(a)
50 REM IF INKEY$="" THEN GOTO 50
60 REM NEXT
70 FOR a=1 TO 40
80 LOCATE a,1:PRINT CHR$(carac)
85 LOCATE a,25:PRINT CHR$(carac);:
90 NEXT
100 FOR a=1 TO 25 : LOCATE 1,a:PRINT CHR$(carac);:LOCATE 40,a:PRINT CHR$(carac);:NEXT
105 PEN 2:LOCATE 1,1:PRINT CHR$(22)+CHR$(1)+"EDiteur Laby V0.3":PRINT CHR$(22)+CHR$(0)
110 DIM table(40,25)
120 cursx=20:cursy=12
130 PEN 1:LOCATE cursx,cursy:PRINT CHR$(carac)
140 clav$=INKEY$:clav$=LOWER$(clav$)
150 IF clav$="4" THEN GOSUB 210
160 IF clav$="6" THEN GOSUB 260
170  IF clav$="8" THEN GOSUB 310
180  IF clav$="2" THEN GOSUB 350
181 IF clav$="t" THEN GOSUB 1300
190  IF clav$=" " THEN GOSUB 400
191 IF clav$="j" THEN GOSUB 2000
192 IF clav$="s" THEN GOSUB 1000
193 IF clav$="c" THEN CLS:FOR y=1 TO 25:FOR x=1 TO 40:table(x,y)=0:NEXT x:NEXT y:index=1:carac=143:PEN 1:LOCATE cursx,cursy:PRINT CHR$(carac);:FOR a=1 TO 40:LOCATE a,1:PRINT CHR$(carac):LOCATE a,25:PRINT CHR$(carac);:NEXT
194 IF clav$="l" THEN GOSUB 1100
200 GOTO 140
210 'rem gauche
220 GOSUB 600
230 cursx=cursx-1
231 PEN 1
240 IF cursx=0 THEN cursx=1
241 IF index=1 THEN PEN 1 ELSE IF index=2 THEN PEN 3 ELSE IF index=3 OR INDEX=8 THEN PEN 2
242 LOCATE cursx,cursy:PRINT CHR$(carac);:
250 RETURN
260 ' droite
270 GOSUB 600
280 cursx=cursx+1
281 PEN 1
290 IF cursx=41 THEN cursx=40
291 IF index=1 THEN PEN 1 ELSE IF index=2 THEN PEN 3 ELSE IF index=3 OR INDEX=8 THEN PEN 2
300 LOCATE cursx,cursy:PRINT CHR$(carac);:RETURN
310 'rem haut
320 GOSUB 600
321 PEN 1
330 cursy=cursy-1:IF cursy=0 THEN cursy=1
331 IF index=1 THEN PEN 1 ELSE IF index=2 THEN PEN 3 ELSE IF index=3 OR INDEX=8 THEN PEN 2
340 LOCATE cursx,cursy:PRINT CHR$(carac);:RETURN
350 'rem BAS
360 GOSUB 600    
365 PEN 1
370 cursy=cursy+1:IF cursy=26 THEN cursy=25
371 IF index=1 THEN PEN 1 ELSE IF index=2 THEN PEN 3 ELSE IF index=3 OR INDEX=8 THEN PEN 2
380 LOCATE cursx,cursy:PRINT CHR$(carac);:RETURN  
390 'press space
400 IF table(cursx,cursy)=index THEN table(cursx,cursy)=0 ELSE table(cursx,cursy)=index
410 RETURN
600 PEN 0:LOCATE cursx,cursy:PRINT CHR$(143);
601 IF table(cursx,cursy)=1 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(143)
602 IF table(cursx,cursy)=2 THEN PEN 3:LOCATE cursx,cursy:PRINT CHR$(231)
603 IF table(cursx,cursy)=3 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(207)
604 IF table(cursx,cursy)=4 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(244)
605 IF table(cursx,cursy)=5 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(245) 
606 IF table(cursx,cursy)=6 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(246) 
607 IF table(cursx,cursy)=7 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(247)
608 IF table(cursx,cursy)=8 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(228)
610 RETURN
1000 'sauvegarde tableau
1010 OPENOUT"table.lab"
1020 REM PRINT #9,40
1030 FOR x=1 TO 40
1040 FOR y=1 TO 25
1050 PRINT #9,table(x,y)
1060 NEXT y
1070 NEXT x
1080 CLOSEOUT
1090 RETURN
1100 ' charge table
1110 OPENIN"table.lab"
1130 FOR x=1 TO 40
1140 FOR y=1 TO 25
1150 INPUT #9,table(x,y)
1160 NEXT y
1170 NEXT x
1175 CLOSEIN
1180 'affichage
1190 FOR y=1 TO 25
1200 FOR x=1 TO 40
1210 index=table(x,y):IF index=1 THEN PEN 1:carac=143:LOCATE x,y:PRINT CHR$(carac)
1211 IF index=2 THEN PEN 3:carac=231:LOCATE x,y:PRINT CHR$(carac)
1212 IF index=3 THEN PEN 2:carac=207:LOCATE x,y:PRINT CHR$(carac) 
1213 IF index=4 THEN PEN 1:carac=244:LOCATE x,y:PRINT CHR$(carac)
1214 IF index=5 THEN PEN 1:carac=245:LOCATE x,y:PRINT CHR$(carac)
1215 IF index=6 THEN PEN 1:carac=246:LOCATE x,y:PRINT CHR$(carac)     
1216 IF index=7 THEN PEN 1:carac=247:LOCATE x,y:PRINT CHR$(carac)
1217 IF index=8 THEN PEN 2:carac=228:LOCATE x,y:PRINT CHR$(carac)   
1220 NEXT x
1230 NEXT y
1240 LOCATE cursx,cursy:PRINT CHR$(carac);:
1250 RETURN
1300 index=index+1
1310 IF index=9 THEN index=1
1320 IF index=1 THEN carac=143:PEN 1
1321 IF index=8 THEN carac=228:PEN 2
1330 IF index=2 THEN carac=231:PEN 3
1335 IF index=3 THEN carac=207:PEN 2
1336 IF index=4 THEN carac=244:PEN 1
1337 IF index=5 THEN carac=245:PEN 1
1338 IF index=6 THEN carac=246:PEN 1
1339 IF index=7 THEN carac=247:PEN 1
1340 LOCATE cursx,cursy:PRINT CHR$(carac);:
1350 RETURN
2000 REM jeux simulation
2001 tableau=1
2010 vie=3:index=table(cursx,cursy):miam=0
2011 FOR y=1 TO 25
2012 FOR x=1 TO 40
2013 IF table(x,y)=2 THEN miam=miam+1
2014 NEXT x
2015 NEXT y
2020 IF index=0 THEN PEN 0:LOCATE cursx,cursy:PRINT CHR$(143)
2030 IF index=1 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(143)
2040 IF index=2 THEN PEN 3:LOCATE cursx,cursy:PRINT CHR$(231)
2050 IF index=3 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(203)
2051 IF index=4 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(244)
2052 IF index=5 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(245)
2053 IF index=6 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(246)
2054 IF index=7 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(247)
2055 IF index=8 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(228)
2060 REM affichage perso
2070 cursx=2:cursy=24
2080 PEN 2:LOCATE cursx,cursy:PRINT CHR$(224);:
2082 GOSUB 4000
2090 REM test clavier
2100 a$=INKEY$
2110 IF a$="r" THEN RETURN
2120 IF a$="6" THEN GOSUB 2300
2130 IF a$="4" THEN GOSUB 2500
2140 IF a$="8" THEN GOSUB 2700
2150 IF a$="2" THEN GOSUB 2900
2151 IF a$="p" THEN miam=0:vie=3:GOSUB 5000
2200 GOTO 2100
2300  GOSUB 3500
2350 cursx=cursx+1:IF cursx=40 THEN cursx=cursx-1:vie=vie-1:SOUND 2,1200,7:GOSUB 4000
2360 index=table(cursx,cursy)
2370 IF index=0 OR index=2 OR index=3 OR index=8 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(224) ELSE cursx=cursx-1:PEN 2:LOCATE cursx,cursy:PRINT CHR$(224):SOUND 2,1200,7:vie=vie-1:GOSUB 4000 
2380 IF index=2 THEN miam=miam-1:table(cursx,cursy)=0:SOUND 2,150,15:SOUND 2,200,15:SOUND 2,250,15:GOSUB 4000
2381 IF index=8 THEN table(cursx,cursy)=0:vie=vie+1:GOSUB 4000
2390 IF miam=0 AND index=3 THEN GOSUB 5000
2400 RETURN
2500 GOSUB 3500:cursx=cursx-1:IF cursx=1 THEN cursx=cursx+1:vie=vie-1:SOUND 2,1200,7:GOSUB 4000 
2510 index=table(cursx,cursy) 
2520 IF index=8 OR index=0 OR index=2 OR index=3 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(224) ELSE cursx=cursx+1:PEN 2:LOCATE cursx,cursy:PRINT CHR$(224):SOUND 2,1200,7:vie=vie-1:GOSUB 4000     
2530 IF index=2 THEN miam=miam-1:table(cursx,cursy)=0:SOUND 2,150,15:SOUND 2,200,15:SOUND 2,250,15:GOSUB 4000   
2531 IF index=8 THEN table(cursx,cursy)=0:vie=vie+1:GOSUB 4000
2540 IF miam=0 AND index=3 THEN GOSUB 5000    
2600 RETURN
2700 GOSUB 3500:cursy=cursy-1:IF cursy=1 THEN cursy=cursy+1:vie=vie-1:SOUND 2,1200,7:GOSUB 4000 
2710 index=table(cursx,cursy)   
2720 IF index=8 OR index=0 OR index=2 OR index=3 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(224) ELSE cursY=cursY+1:PEN 2:LOCATE cursx,cursy:PRINT CHR$(224):SOUND 2,1200,7:vie=vie-1:GOSUB 4000
2730 IF index=2 THEN miam=miam-1:table(cursx,cursy)=0:SOUND 2,150,15:SOUND 2,200,15:SOUND 2,250,15:GOSUB 4000 
2731 IF index=8 THEN table(cursx,cursy)=0:vie=vie+1:GOSUB 4000   
2740 IF miam=0 AND index=3 THEN GOSUB 5000
2800 RETURN
2900 GOSUB 3500:cursY=cursY+1:IF cursy=25 THEN cursy=cursy-1:vie=vie-1:SOUND 2,1200,7:GOSUB 4000
2910 index=table(cursx,cursy)
2920 IF index=8 OR index=0 OR index=2 OR index=3 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(224) ELSE cursY=cursY-1:PEN 2:LOCATE cursx,cursy:PRINT CHR$(224):SOUND 2,1200,7:vie=vie-1:GOSUB 4000      
2930 IF index=2 THEN miam=miam-1:table(cursx,cursy)=0:SOUND 2,150,15:SOUND 2,200,15:SOUND 2,250,15:GOSUB 4000   
2931 IF index=8 THEN table(cursx,cursy)=0:vie=vie+1:GOSUB 4000
2940 IF miam=0 AND index=3 THEN GOSUB 5000
3100 RETURN
3500 index=table(cursx,cursy) 
3510 IF index=0 THEN PEN 0:LOCATE cursx,cursy:PRINT CHR$(143)  
3520 IF index=2 THEN PEN 3:LOCATE cursx,cursy:PRINT CHR$(231)    
3530 IF index=3 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(207)   
3540 RETURN
4000 PEN 1:LOCATE 17,25:PRINT CHR$(143);:PRINT CHR$(143):PEN 2:LOCATE 10,25:PRINT CHR$(22)+CHR$(1)+"Vies :"+STR$(vie);:PEN 1:LOCATE 31,25:PRINT CHR$(143);:PRINT CHR$(143);:PRINT CHR$(143):PEN 2:LOCATE 25,25:PRINT"Miam:";:PRINT miam;:PRINT CHR$(22)+CHR$(0)
4010 IF vie=0 THEN END
4020 RETURN
5000 'charge tableau prochaine
5001 IF tableau=1 THEN OPENIN"table1.lab"
5011 IF tableau=2 THEN OPENIN"table2.lab"
5021 IF tableau=3 THEN OPENIN"table3.lab" 
5031 IF tableau=4 THEN OPENIN"table4.lab"   
5041 IF tableau=5 THEN OPENIN"table5.lab"    
5051 IF tableau=6 THEN OPENIN"table6.lab"
5061 IF tableau=7 THEN OPENIN"table7.lab" 
5071 IF tableau=8 THEN OPENIN"table8.lab" 
5081 IF tableau=9 THEN OPENIN"table9.lab"
5091 IF tableau=10 THEN CLS:PRINT" Bravo vous avez fini le jeu":CLOSEIN:END
5092 tableau=tableau+1
5093 CLS
5096 FOR x=1 TO 40
5099 FOR y=1 TO 25
5102 INPUT #9,table(x,y)
5112 NEXT y:NEXT x: CLOSEIN
5122 FOR x=1 TO 40:FOR y=1 TO 25:index=table(x,y)
5123 IF index=2 THEN PEN 3:LOCATE x,y:PRINT CHR$(231);:miam=miam+1
5124 IF index=1 THEN PEN 1:LOCATE x,y:PRINT CHR$(143);:
5133 IF index=3 THEN PEN 2:LOCATE x,y:PRINT CHR$(207);: 
5134 IF index=4 THEN PEN 1:LOCATE x,y:PRINT CHR$(244);:
5135 IF index=5 THEN PEN 1:LOCATE x,y:PRINT CHR$(245);:
5136 IF index=6 THEN PEN 1:LOCATE x,y:PRINT CHR$(246);:
5137 IF index=7 THEN PEN 1:LOCATE x,y:PRINT CHR$(247);:
5138 IF index=8 THEN PEN 2:LOCATE x,y:PRINT CHR$(228);:
5139 NEXT y
5140 NEXT x 
5141 FOR x=1 TO 40:PEN 1:LOCATE x,1:PRINT CHR$(143);:LOCATE x,25:PRINT CHR$(143);:NEXT x:FOR y=1 TO 25:LOCATE 1,y:PRINT CHR$(143);:LOCATE 40,y:PRINT CHR$(143);:NEXT y
5142 cursx=2:cursy=24:PEN 2:LOCATE cursx,cursy:PRINT CHR$(224);:
5143 GOSUB 4000
5144 RETURN

Un petit générateur de courbe de bézier, modifié les valeurs des couples de points x0,y0 x1,y1 x2,y2 et x3,y3 pour changer l'allure de la courbe.

Code : Tout sélectionner

10 REM courbe de bezier
20 MODE 2
30 x0=100:y0=350
40 x1=200:y1=350
50 x2=400:y2=10
51 x3=500:y3=250
60 FOR t=0 TO 1.01 STEP 0.001
70 x=(x0*(1-t)*(1-t)*(1-t))+(3*x1*t*(1-t)*(1-t)*(1-t))+(3*x2*t*t*(1-t))+(x3*t*t*t)
71 y=(y0*(1-t)*(1-t)*(1-t))+(3*y1*t*(1-t)*(1-t)*(1-t))+(3*y2*t*t*(1-t))+(y3*t*t*t)  
75 REM PRINT "T";:PRINT t;:PRINT"X";:PRINT x;:PRINT "Y";:PRINT Y
76 PLOT x,y,1
80 NEXT
90 PLOT x0,y0
100 PLOT x1,y1
110 PLOT x2,y2
120 PLOT x3,y3

Fonctionne sur CPC Basic V1.1 !

Haut

Profil

Citer

remax17

Sujet du message : Re: Postez vos petits programmes en QBasic

Publié : 18 juil. 2020 10:03

Membre inscrit

Hors-ligne

Messages : 1113

Inscription : 22 sept. 2010 15:03

PC Rétro : PIII 500mhz -384Mb RAM - Voodoo 2 en SLI

C'est du Locomotive Basic

_________________

Mon OneDrive

Haut

Profil

Citer

glaby91

Sujet du message : Re: Postez vos petits programmes en QBasic

Publié : 18 juil. 2020 22:28

Membre inscrit

Hors-ligne

Messages : 20

Inscription : 17 juil. 2020 20:54

Oui et je programme aussi en Z80. C'est juste qu'en basic on peut faire des petites choses assez vite.
Pour le côté vitesse c'est toutefois mieux avec l'ASM, j'ais noté 42s pour charger/afficher un niveau du petit jeu en basic et à peine 8 pour faire la même action en ASM. Toutefois il es certainement possible d'optimisé le code mais pour le moment je m'attelle à le faire fonctionner !

En faite j'ais commençé assez jeune avec le CPC et son manuel a programmé en basic ou plutot recopié les programmes du manuel puis j'ais fait du qbasic sur un IBM PS1 je croit bien, et ceci jusqu'au dernier Qbasic compilable meme windows 10 je crois bien. Aujourdhui je me remet au CPC et surtout son asm , de formation bts electronique , j'ais fait pas mal de programmation pour du Atmel / Pic / 6809 et du C / VHDL mais je ne me souviens plus de grand chose. Maintenant c'est Z80 et ses banques memoire de 64 Ko qui m'appele, le pilotage du gate array , crtrc, puce sonore yamaha. C'est ce que j'aime dans la programmation, maitrisé le bazarre de A à Z et etre independant de tout autre systeme. Si ça ne marche pas ça n'est que de ma faute !
Bonne soirée à tous !

Dernière modification par glaby91 le 18 juil. 2020 22:34, modifié 1 fois.

Haut

Profil

Citer

gm86

Sujet du message : Re: Postez vos petits programmes en QBasic

Publié : 03 janv. 2021 19:19

Membre inscrit

Hors-ligne

Messages : 623

Inscription : 01 sept. 2008 19:07

Super ! Le dernier est facile à modifier pour l'écran du PC (PSET au lieu de PLOT).

Ces derniers temps, je me suis intéressé à l'arithmérique non signée en BASIC. Cela signifie en dehors de tout interpréteur (y compris QBasic) et sans l'option Debug, car /D ajouterait des appels INTO (interruption si overflow). Voici le résultat qui use de la faculté d'annuler une valeur en débordant (retenue hors des seize bits) :

Code : Tout sélectionner

REM $LINESIZE:132 $DYNAMIC
'Compilation du crible d'Eratosthène (tableau de nombres impairs).
'
'Versions Microsoft 5.36 et IBM 1.0 (directive $DYNAMIC ignorée) :
'	BASCOM SIEVE/N/O;
'	LINK SIEVE;
'
'QuickBASIC 4.5 :
'	BC SIEVE;
'	LINK SIEVE;
'
'Machine MS-DOS/PC>64Ko|I'm afraid, Dave. Dave, my mind is going. I can fill it.

DEFINT D-Z
T$ = TIME$
WHILE T$ = TIME$: WEND
PRINT TIME$, "Début du calcul."
DIM P(31249)							'0;1000000/32-1

P(0) = 1							'1 n'est pas 1er
N2 = 0								'Pointe le carré
M2 = 1								'Masques d'1 bit
M = 0
FOR I = 1 TO 498						'1;SQR(1E6)/2-2
	N2 = 4 * I + N2						'(a+b)²/2 ; b=2
	IF N2 - 31250 >= 0 THEN N2 = N2 - 31250: M2 = 2 * M2	'Ignore le signe
	IF (P(I) AND 1) = 0 THEN PAS = 2 * I + 1: M = M2: N = N2'Saut si non 1er
	WHILE M
1000		P(N) = P(N) OR M
		N = N + PAS
		IF N < 31250 THEN 1000
		N = N - 31250
		M = 2 * M
	WEND
NEXT

PRINT TIME$, "Fin du calcul."
PRINT "Appuyez sur une touche pour sortir les nombres premiers..."
WHILE LEN(INKEY$) = 0: WEND
C = 1
PRINT 2,							'2 est premier
M = 1
FOR J = 0 TO 15							'Entrelacement
	FOR I = 0 TO 31249
		IF (P(I) AND M) = 0 THEN C = C + 1: PRINT 62500 * J + I + I + 1,
	NEXT
	M = 2 * M
NEXT
PRINT : PRINT C; "nombres inférieurs au million sont premiers."

Le listing en assembleur a permis le choix et l'ordre des opérateurs, du moins pour la désuète version MS-DOS (ni Quick ni IBM) :

Code : Tout sélectionner

BASCOM SIEVE,nul,sieve/a/N/O;

P.S. : le label 1000 seul limiterait l'optimisation du compilateur. Lié au saut interne à la boucle WHILE, il apporte un gain de temps. Autre précision, il vaut mieux reprendre la variable d'une des instructions adjacentes que d'écrire LET PAS%=PAS%+2. Ici, BASCOM remarque l'emploi de I% pour PAS% et récupère donc le calcul automatique d'index P%(I%).

Code : Tout sélectionner

                                                                                                                                                                                                                                                      PAGE   1
                                                                                                                           01-24-21
                                                                                                                           14:46:10
Offset  Data    Source Line                                                                          Microsoft BASIC Compiler V5.36

 001A   0002    REM $LINESIZE:132 $DYNAMIC
 001A   0002    'Compilation du crible d'Eratosthène (tableau de nombres impairs).
 001A   0002    '
 001A   0002    'Versions Microsoft 5.36 et IBM 1.0 (directive $DYNAMIC ignorée) :
 001A   0002    '       BASCOM SIEVE/N/O;
 001A   0002    '       LINK SIEVE;
 001A   0002    '
 001A   0002    'QuickBASIC 4.5 :
 001A   0002    '       BC SIEVE;
 001A   0002    '       LINK SIEVE;
 001A   0002    '
 001A   0002    'Machine MS-DOS/PC>64Ko|I'm afraid, Dave. Dave, my mind is going. I can fill it.
 001A   0002    
 001A   0002    DEFINT D-Z
 001A   0002    T$ = TIME$
 0026    **            I00001: CALL  $535
 002B   0002    WHILE T$ = TIME$: WEND
 002B    **                    CALL  $TIF
 0030    **                    MOV   DX,OFFSET T$
 0033    **                    CALL  $SASA
 0038    **            I00002: CALL  $TIF
 003D    **                    XCHG  AX,BX
 003E    **                    MOV   BX,OFFSET T$
 0041    **                    CALL  $SCMA
 0046    **                    JE    $-10H
 0048   0006    PRINT TIME$, "Début du calcul."
 0048   0006    DIM P(31249)                                                    '0;1000000/32-1
 0048   F42A    
 0048   F42A    P(0) = 1                                                        '1 n'est pas 1er
 0048   F42A    N2 = 0                                                          'Pointe le carré
 0048   F42A    M2 = 1                                                          'Masques d'1 bit
 0048   F42A    M = 0
 0048   F42A    FOR I = 1 TO 498                                                '1;SQR(1E6)/2-2
 0048    **                    CALL  $PR0A
 004D    **                    CALL  $TIF
 0052    **                    CALL  $PV0D
 0057    **                    MOV   BX,OFFSET <const>
 005A    **                    CALL  $PV2D
 005F    **                    MOV   P%,0001H
 0065    **                    MOV   N2%,0000H
 006B    **                    MOV   M2%,0001H
 0071    **                    MOV   M%,0000H
 0077    **                    MOV   AX,0001H
 007A    **                    JMP   I00004
 007D   F430            N2 = 4 * I + N2                                         '(a+b)²/2 ; b=2
 007D   F430            IF N2 - 31250 >= 0 THEN N2 = N2 - 31250: M2 = 2 * M2    'Ignore le signe
 007D    **            I00005: MOV   BX,I%
 0081    **                    SAL   BX,1
 0083    **                    SAL   BX,1
 0085    **                    ADD   BX,N2%
 0089    **                    XCHG  AX,BX
 008A    **                    MOV   N2%,AX
 008D    **                    MOV   BX,N2%
 0091    **                    ADD   BX,85EEH
                                                                                                                           PAGE   2
                                                                                                                           01-24-21
                                                                                                                           14:46:10
Offset  Data    Source Line                                                                          Microsoft BASIC Compiler V5.36

 0095    **                    OR    BX,BX
 0097    **                    JNL   $+03H
 0099    **                    JMP   I00006
 009C    **                    XCHG  AX,BX
 009D    **                    MOV   N2%,AX
 00A0    **                    MOV   AX,M2%
 00A3    **                    SAL   AX,1
 00A5    **                    MOV   M2%,AX
 00A8   F432            IF (P(I) AND 1) = 0 THEN PAS = 2 * I + 1: M = M2: N = N2'Saut si non 1er
 00A8    **            I00006: MOV   DI,I%
 00AC    **                    SAL   DI,1
 00AE    **                    MOV   BX,P%[DI]
 00B2    **                    AND   BX,01H
 00B5    **                    OR    BX,BX
 00B7    **                    JE    $+03H
 00B9    **                    JMP   I00007
 00BC    **                    XCHG  AX,DI
 00BD    **                    INC   AX
 00BE    **                    MOV   PAS%,AX
 00C1    **                    MOV   AX,M2%
 00C4    **                    MOV   M%,AX
 00C7    **                    MOV   AX,N2%
 00CA    **                    MOV   N%,AX
 00CD   F436            WHILE M
 00CD    **            I00007:
 00CD   F436    1000            P(N) = P(N) OR M
 00CD    **            I00008: MOV   BX,M%
 00D1    **                    AND   BX,BX
 00D3    **                    JNE   $+03H
 00D5    **                    JMP   I00009
 00D8   F436                    N = N + PAS
 00D8   F436                    IF N < 31250 THEN 1000
 00D8    **            L01000: MOV   DI,N%
 00DC    **                    MOV   BX,DI
 00DE    **                    SAL   DI,1
 00E0    **                    MOV   DX,P%[DI]
 00E4    **                    OR    DX,M%
 00E8    **                    MOV   P%[DI],DX
 00EC    **                    ADD   BX,PAS%
 00F0    **                    XCHG  AX,BX
 00F1    **                    MOV   N%,AX
 00F4    **                    CMP   N%,7A12H
 00FA    **                    JL    $-24H
 00FC   F436                    N = N - 31250
 00FC   F436                    M = 2 * M
 00FC   F436            WEND
 00FC    **                    MOV   AX,N%
 00FF    **                    ADD   AX,85EEH
 0102    **                    MOV   N%,AX
 0105    **                    MOV   AX,M%
 0108    **                    SAL   AX,1
 010A    **                    MOV   M%,AX
 010D    **                    JMP   I00008
 0110   F436    NEXT
                                                                                                                           PAGE   3
                                                                                                                           01-24-21
                                                                                                                           14:46:10
Offset  Data    Source Line                                                                          Microsoft BASIC Compiler V5.36

 0110    **            I00009: MOV   AX,I%
 0113    **                    INC   AX
 0114    **            I00004: MOV   I%,AX
 0117    **                    CMP   I%,01F2H
 011D    **                    JG    $+03H
 011F    **                    JMP   I00005
 0122   F436    
 0122   F436    PRINT TIME$, "Fin du calcul."
 0122   F436    PRINT "Appuyez sur une touche pour sortir les nombres premiers..."
 0122   F436    WHILE LEN(INKEY$) = 0: WEND
 0122    **                    CALL  $PR0A
 0127    **                    CALL  $TIF
 012C    **                    CALL  $PV0D
 0131    **                    MOV   BX,OFFSET <const>
 0134    **                    CALL  $PV2D
 0139    **                    CALL  $PR0A
 013E    **                    MOV   BX,OFFSET <const>
 0141    **                    CALL  $PV2D
 0146    **            I00011: CALL  $INK
 014B    **                    CALL  $LENA
 0150    **                    OR    BX,BX
 0152    **                    JE    $-0EH
 0154   F436    C = 1
 0154   F436    PRINT 2,                                                        '2 est premier
 0154   F436    M = 1
 0154   F436    FOR J = 0 TO 15                                                 'Entrelacement
 0154    **                    MOV   DI,OFFSET C!
 0157    **                    MOV   SI,OFFSET <const>
 015A    **                    CALL  $FASA
 015F    **                    CALL  $PR0A
 0164    **                    MOV   BX,0002H
 0167    **                    CALL  $PV0C
 016C    **                    MOV   M%,0001H
 0172    **                    XOR   AX,AX
 0174    **                    JMP   I00013
 0177   F43A            FOR I = 0 TO 31249
 0177    **            I00014: XOR   AX,AX
 0179    **                    JMP   I00015
 017C   F43A                    IF (P(I) AND M) = 0 THEN C = C + 1: PRINT 62500 * J + I + I + 1,
 017C    **            I00016: MOV   DI,I%
 0180    **                    MOV   BX,DI
 0182    **                    SAL   DI,1
 0184    **                    MOV   DX,P%[DI]
 0188    **                    AND   DX,M%
 018C    **                    OR    DX,DX
 018E    **                    JE    $+03H
 0190    **                    JMP   I00017
 0193    **                    MOV   DI,OFFSET <const>
 0196    **                    MOV   SI,OFFSET C!
 0199    **                    CALL  $FADA
 019E    **                    XCHG  DI,SI
 01A0    **                    MOV   DX,SI
 01A2    **                    CALL  $FASC
 01A7    **                    CALL  $PR0A
                                                                                                                           PAGE   4
                                                                                                                           01-24-21
                                                                                                                           14:46:10
Offset  Data    Source Line                                                                          Microsoft BASIC Compiler V5.36

 01AC    **                    MOV   CX,BX
 01AE    **                    MOV   BX,J%
 01B2    **                    CALL  $CISA
 01B7    **                    MOV   DI,OFFSET <const>
 01BA    **                    CALL  $FMUC
 01BF    **                    XCHG  BX,CX
 01C1    **                    CALL  $STFA
 01C6    **                    DB    81H
 01C7    **                    CALL  $CISA
 01CC    **                    CALL  $STFA
 01D1    **                    DB    82H
 01D2    **                    CALL  $FADG
 01D7    **                    DB    81H
 01D8    **                    MOV   DI,OFFSET $FT#+0008H
 01DB    **                    CALL  $FADC
 01E0    **                    XCHG  DI,DX
 01E2    **                    CALL  $FADC
 01E7    **                    MOV   BX,OFFSET $AC!
 01EA    **                    CALL  $PV0A
 01EF   F43C            NEXT
 01EF    **            I00017: MOV   AX,I%
 01F2    **                    INC   AX
 01F3    **            I00015: MOV   I%,AX
 01F6    **                    CMP   I%,7A11H
 01FC    **                    JG    $+03H
 01FE    **                    JMP   I00016
 0201   F43C            M = 2 * M
 0201   F43C    NEXT
 0201    **                    MOV   AX,M%
 0204    **                    SAL   AX,1
 0206    **                    MOV   M%,AX
 0209    **                    MOV   AX,J%
 020C    **                    INC   AX
 020D    **            I00013: MOV   J%,AX
 0210    **                    CMP   WORD PTR J%,0FH
 0215    **                    JG    $+03H
 0217    **                    JMP   I00014
 021A   F43C    PRINT : PRINT C; "nombres inférieurs au million sont premiers."
 021A   F43C    
 021A    **                    CALL  $PR0A
 021F    **                    MOV   BX,OFFSET <const>
 0222    **                    CALL  $PV2D
 0227    **                    CALL  $PR0A
 022C    **                    MOV   BX,OFFSET C!
 022F    **                    CALL  $PV1A
 0234    **                    MOV   BX,OFFSET <const>
 0237    **                    CALL  $PV2D
 023C    **                    CALL  $ENP
 0241   F43C    
                                                                                                                           PAGE   5
                                                                                                                           01-24-21
                                                                                                                           14:46:10
Offset  Data    Source Line                                                                          Microsoft BASIC Compiler V5.36


23791 Bytes Available
22668 Bytes Free

    0 Warning Error(s)
    0 Severe  Error(s)

Ce n'est pas un compilateur optimisant (sauts en avant) mais il s'en sort bien. Une courte routine en langage 8086 aurait permis de calculer le carré 32 bits d'un nombre 16 bits, mais au prix d'une lente mutiplication. Enfin, le fait que la boucle la plus utilisée soit alignée sur un quadruple-mot est une coïncidence : sur un Pentium aux caches désactivés, on constate un léger ralentissement en retirant LET M%=0 (l'inverse avec le compilo IBM 1.0).

_________________

C:\ONGRTLNS.W95

Haut

Profil

Win3x.Org

Règles du forum