Assembler / Machine Language
Assembler / Machine Language
Hi
I have been programming in QuickBasic for as long as I can remember...
I now have a small 143 line routine in one of my programs that I would like to rewrite in assembler/machine code to drastically improve performance. It is a pretty straightforward routine with various cycles performing compares and moves amongst static arrays.
If anyone is able to help me in rewriting this code, I would greatly appreciate.
I have been programming in QuickBasic for as long as I can remember...
I now have a small 143 line routine in one of my programs that I would like to rewrite in assembler/machine code to drastically improve performance. It is a pretty straightforward routine with various cycles performing compares and moves amongst static arrays.
If anyone is able to help me in rewriting this code, I would greatly appreciate.
- burger2227
- Veteran
- Posts: 2466
- Joined: Mon Aug 21, 2006 12:40 am
- Location: Pittsburgh, PA
Try tutorials
There are several tutorials here on Assembly. You may want to get ahold of Nasm or another assembler program.
Ted
Ted
Please acknowledge and thank members who answer your questions!
QB64 is a FREE QBasic compiler for WIN, MAC(OSX) and LINUX : https://www.qb64.org/forum/index.php
Get my Q-Basics demonstrator: https://www.dropbox.com/s/fdmgp91d6h8ps ... s.zip?dl=0
QB64 is a FREE QBasic compiler for WIN, MAC(OSX) and LINUX : https://www.qb64.org/forum/index.php
Get my Q-Basics demonstrator: https://www.dropbox.com/s/fdmgp91d6h8ps ... s.zip?dl=0
Yes, thanks burger2227.
My problem is I do not have much time on my hands at this moment and I have other QB routines to write. What I am wishing is that someone visiting this forum is willing to rewrite this small portion of code in Assembler/Machine code.
The code in question is on another machine and I will post it here as soon as I can.
Thank you.
My problem is I do not have much time on my hands at this moment and I have other QB routines to write. What I am wishing is that someone visiting this forum is willing to rewrite this small portion of code in Assembler/Machine code.
The code in question is on another machine and I will post it here as soon as I can.
Thank you.
- Michael Calkins
- Veteran
- Posts: 76
- Joined: Tue Apr 05, 2005 8:40 pm
- Location: Floresville, Texas
- Contact:
I'll take a look at it when you post it. I usually don't frequent this forum as much as the network54 one, but I'll check back here.
I can probably write a Call Absolute version suitable for QBASIC 1.1 as well as QB. If you want an actual module to link with QB 4.5, I don't have experience with QB 4.5, but the code could be adapted.
Regards,
Michael
I can probably write a Call Absolute version suitable for QBASIC 1.1 as well as QB. If you want an actual module to link with QB 4.5, I don't have experience with QB 4.5, but the code could be adapted.
Regards,
Michael
Ok... here is the code I would like to have transformed into assembler / machine code. I have cut out all code that will remain as QB.
I am using Microsoft (R) QuickBASIC Extended v7.1 ... has always been my programming language
I am using Microsoft (R) QuickBASIC Extended v7.1 ... has always been my programming language
Code: Select all
...
Last edited by mestrinho on Tue Apr 01, 2008 10:50 am, edited 2 times in total.
- Michael Calkins
- Veteran
- Posts: 76
- Joined: Tue Apr 05, 2005 8:40 pm
- Location: Floresville, Texas
- Contact:
So it isn't just data manipulation... It has user interaction and file i/o... that is going to be more work.
Already I see some things in this routine that would not be practical in a Call Absolute routine. END, RANDOMIZE, and RND are not things I want to implement.
I have a number of initial questions...
The number of END IFs in the section is not correct. Please verify your IF...END IF blocks. Also please verify your FOR...NEXT blocks.
This line looks like a mistake:
IF melh <5> 99 THEN
this expression will always have a value of 0.
Perhaps if you could please post the corrected code in code blocks like this:[/code] it should probably preserve indentation.
I cannot implement RANDOMIZE, RND, or END. You should not try to end your program from a Call Absolute routine. Perhaps from a module you could call the appropriate functions in the QB/PDS runtime environment??
also, there seem to be undimensioned, uninitialized variables. For example, the first executable line is
IF qtap < bestval THEN
well I guess these are INTEGERs that are initially 0, but I don't know for sure.
There is also the question of scope. What variables/arrays need to be shared with the calling code? It looks like the ones you DIMensioned at the start are ones that would be in the calling code and passed to the routine. Are all other variables local to the routine? Please specify the parameters passed to the routine, and the returned information, if any. Converting the section to a SUB or FUNCTION in the pure QB version would help you build a profile of what needs to be passed.
This must be viewed a modular way. Things like CLOSE and RESET are broad... Are they affecting files opened elsewhere in the program, or are they just for that one file? Why are you using RESET after CLOSE anyway?
Rather than converting the whole section all at once, it might be advisable to convert small portions of it, specifically the loops that do not contain any reliance on RANDOMIZE/RND. This may or may not result in a performance increase.
' values of elements in above arrays will always be between 0 and 255
cool. I can use 8 bit registers. Perhaps the arrays could be converted to fixed length strings to save space?
Regards,
Michael
Already I see some things in this routine that would not be practical in a Call Absolute routine. END, RANDOMIZE, and RND are not things I want to implement.
I have a number of initial questions...
The number of END IFs in the section is not correct. Please verify your IF...END IF blocks. Also please verify your FOR...NEXT blocks.
This line looks like a mistake:
IF melh <5> 99 THEN
this expression will always have a value of 0.
Perhaps if you could please post the corrected code in code blocks like this:
Code: Select all
[code]put code here
I cannot implement RANDOMIZE, RND, or END. You should not try to end your program from a Call Absolute routine. Perhaps from a module you could call the appropriate functions in the QB/PDS runtime environment??
also, there seem to be undimensioned, uninitialized variables. For example, the first executable line is
IF qtap < bestval THEN
well I guess these are INTEGERs that are initially 0, but I don't know for sure.
There is also the question of scope. What variables/arrays need to be shared with the calling code? It looks like the ones you DIMensioned at the start are ones that would be in the calling code and passed to the routine. Are all other variables local to the routine? Please specify the parameters passed to the routine, and the returned information, if any. Converting the section to a SUB or FUNCTION in the pure QB version would help you build a profile of what needs to be passed.
This must be viewed a modular way. Things like CLOSE and RESET are broad... Are they affecting files opened elsewhere in the program, or are they just for that one file? Why are you using RESET after CLOSE anyway?
Rather than converting the whole section all at once, it might be advisable to convert small portions of it, specifically the loops that do not contain any reliance on RANDOMIZE/RND. This may or may not result in a performance increase.
' values of elements in above arrays will always be between 0 and 255
cool. I can use 8 bit registers. Perhaps the arrays could be converted to fixed length strings to save space?
Regards,
Michael
Bring on the Maulotaurs! oops...
I like to slay Disciples of D'Sparil...
I like to slay Disciples of D'Sparil...
While your going to make ASM, optimize the QB code... make lots of use of numbers that are powers of 2, also start things form 0 not 1. 256 is a BEAUTIFUL number, you can make tons of optimizations around it, and it fits well for x86 and Z80 (for which I usually write my ASM code).
Mida sa loed ? Nagunii aru ei saa
Yes, it fits perfectly for x86 and Z80.
1) I am going to "correct" it so numbers vary between 0 and 255.
2) I am also going to take out the i/o, rnd and randomize parts to ease it up...
3) I will also prepare an array with random numbers to be used within the assembler routine as if it were the rnd function
I will post the "corrected" code shortly...
By the way, all variables are integers with exception of variables "cyclez" and "cycle" which are LONG Integers
P.S.
===
I see now that the code I posted had various errors... this is due to the fact that when I first posted it, I had not inserted the [/code] so some of the code was transformed into smileys... and instead of re-pasting the correct code again I simply tried to correct what was already posted resulting in several errors and also the "disappearance" of some code...
I am going to post the correct code already striped of i/o, etc....
Sorry
1) I am going to "correct" it so numbers vary between 0 and 255.
2) I am also going to take out the i/o, rnd and randomize parts to ease it up...
3) I will also prepare an array with random numbers to be used within the assembler routine as if it were the rnd function
I will post the "corrected" code shortly...
By the way, all variables are integers with exception of variables "cyclez" and "cycle" which are LONG Integers
P.S.
===
I see now that the code I posted had various errors... this is due to the fact that when I first posted it, I had not inserted the
Code: Select all
[code]
I am going to post the correct code already striped of i/o, etc....
Sorry
- Michael Calkins
- Veteran
- Posts: 76
- Joined: Tue Apr 05, 2005 8:40 pm
- Location: Floresville, Texas
- Contact:
Thank you, mestrinho. As for the file i/o, the screen output, and the keyboard polling, this is all possible. I might not be able to duplicate QBASIC's exact behavior, but the effective result would be similar. The file i/o would take some research, but is possible. The keyboard polling you might leave in there to be able to escape the routine... Might use a byref variable to inform the calling code of early termination.
Regards, Michael
Regards, Michael
Ok... finally managed to post the code...
All variables are integers with exception of variable cycle which is a LONG Integer
All variables are integers with exception of variable cycle which is a LONG Integer
Code: Select all
DEFINT A-Z
'$STATIC
DIM arr1(4000, 4), ar0(500, 3)
DIM tmp(200, 4), ok(50, 3)
DIM ar1(50, 3), rndnumb(4095)
DIM cycle AS LONG
'...
'... inicial QB code goes here
'...
'... following code is to be assembler...
exitcode = 0
qttmp = 0
qtp0 = qtp
FOR i1 = 1 TO qtp - 4
'LOCATE 1, 1: PRINT i1;
FOR i2 = i1 + 1 TO qtp - 3
'LOCATE 1, 4: PRINT i2;
FOR i3 = i2 + 1 TO qtp - 2
'LOCATE 1, 7: PRINT i3;
FOR i4 = i3 + 1 TO qtp - 1
FOR i5 = i4 + 1 TO qtp
FOR i6 = 1 TO qtorig
FOR i7 = 1 TO qtp
IF i7 <> i1 AND i7 <> i2 AND i7 <> i3 AND i7 <> i4 AND i7 <i5> 1 THEN EXIT FOR
END IF
NEXT
IF i7 > qtp THEN
qttmp = qttmp + 1
FOR i8 = 1 TO 3
tmp(qttmp, i8) = arr1(i6, i8)
NEXT
END IF
NEXT
qtorig1 = qttmp
ERASE ar1
FOR i6 = 1 TO qtorig1
tmp(i6, 0) = 1: tmp(i6, 4) = 0
NEXT
tenta = 0
melh = 999
qtnv = 0
qtemp = qtorig1
Ciclo1:
FOR i6 = 1 TO qtorig1
IF tmp(i6, 4) = 0 THEN tmp(i6, 0) = 1 ELSE tmp(i6, 0) = 0
NEXT
FOR i6 = 1 TO qtorig1 - 1
IF tmp(i6, 4) <> 255 THEN
FOR i7 = i6 + 1 TO qtorig1
IF tmp(i7, 4) <255> 1 THEN
IF tmp(i7, 4) = 0 THEN tmp(i6, 0) = tmp(i6, 0) + 1
IF tmp(i6, 4) = 0 THEN tmp(i7, 0) = tmp(i7, 0) + 1
END IF
END IF
END IF
NEXT
END IF
NEXT
maior = 0: ind = 0
rndindex = rndindex + 1
IF rndindex > 4095 THEN rndindex = 0
k = rndnumb(rndindex) MOD 9
k = k + 9
FOR i6 = 1 TO qtorig1
IF tmp(i6, 0) > 0 AND tmp(i6, 0) > maior THEN
maior = tmp(i6, 0): ind = i6: k = k - 1
IF k = 0 THEN EXIT FOR
END IF
NEXT
FOR i6 = 1 TO qtorig1
IF tmp(i6, 4) = 0 THEN
qt = 0
FOR k = 1 TO 3
IF tmp(i6, k) = tmp(ind, k) THEN qt = qt + 1
NEXT
IF qt > 1 AND tmp(i6, 4) = 0 THEN qtemp = qtemp - 1
IF qt = 3 THEN tmp(i6, 4) = 255
IF qt = 2 THEN tmp(i6, 4) = 128
END IF
NEXT
qtnv = qtnv + 1
FOR i6 = 1 TO 3: ar1(qtnv, i6) = tmp(ind, i6): NEXT
IF qtemp > 0 THEN
IF qtnv < melh - 1 GOTO Ciclo1
END IF
tenta = tenta + 1
IF qtnv < melh AND qtemp = 0 THEN
melh = qtnv
FOR i6 = 1 TO melh
FOR i7 = 1 TO 3: ok(i6, i7) = ar1(i6, i7): NEXT
NEXT
IF melh < 5 THEN
cycle = cycle + 1
IF cycle MOD 50 = 0 THEN
'LOCATE 5, 11: PRINT cycle;
END IF
GOTO Continuar
END IF
END IF
IF tenta > 99 THEN cycle = cycle + 1: GOTO Continuar
FOR i6 = 1 TO qtorig1: tmp(i6, 4) = 0: NEXT
FOR i6 = 1 TO qtorig1
rndindex = rndindex + 1
IF rndindex > 4095 THEN rndindex = 0
k = rndnumb(rndindex) MOD qtorig1
k = k + 1
FOR i7 = 1 TO 3
SWAP tmp(i6, i7), tmp(k, i7)
NEXT
NEXT
qtnv = 0
qtemp = qtorig1
GOTO Ciclo1
Continuar:
IF melh <5> 1 THEN FOR i6 = 1 TO 3: ar0(i2, i6) = ok(2, i6): NEXT
IF melh > 2 THEN FOR i6 = 1 TO 3: ar0(i3, i6) = ok(3, i6): NEXT
IF melh > 3 THEN FOR i6 = 1 TO 3: ar0(i4, i6) = ok(4, i6): NEXT
IF melh < 4 THEN FOR i6 = 1 TO 3: ar0(i4, i6) = ar0(qtp - 1, i6): NEXT
IF melh < 3 THEN FOR i6 = 1 TO 3: ar0(i3, i6) = ar0(qtp - 2, i6): NEXT
IF melh < 2 THEN FOR i6 = 1 TO 3: ar0(i2, i6) = ar0(qtp - 3, i6): NEXT
FOR i6 = 1 TO 3: ar0(i5, i6) = ar0(qtp, i6): NEXT
qtp = qtp - 5 + melh
'LOCATE 8, 19: PRINT qtp;
END IF
qttmp = 0
IF qtp < qtp0 GOTO TheEnd1
NEXT
IF qtp < qtp0 GOTO TheEnd1
NEXT
IF qtp < qtp0 GOTO TheEnd1
NEXT
IF qtp < qtp0 GOTO TheEnd1
y$ = INKEY$
IF y$ = CHR$(27) GOTO TheEnd0
NEXT
IF qtp < qtp0 GOTO TheEnd1
NEXT
FOR i1 = 1 TO qtorig: arr1(i1, 4) = 0: NEXT
GOTO TheEnd
TheEnd0:
exitcode = 1
GOTO TheEnd
TheEnd1:
exitcode = -1
TheEnd:
'exit point of assembler code
'...
'... final QB code goes here
'...
- Michael Calkins
- Veteran
- Posts: 76
- Joined: Tue Apr 05, 2005 8:40 pm
- Location: Floresville, Texas
- Contact:
Thanks you for posting the code.
It seems to have too many END IFs. You are aware, I assume, that if you put a statement on the same line, following the THEN keyword, that it is just one line, there is no block, and no END IF.For example, with:, not only is the melh <5> 1 type problem still there, but there is code on the same line after the THEN. There is no IF block, just the code on the same line. You have indented the lines after that line, as if they were in the block, but they aren't. Also, the END IF after that is extra. There are 2 solutions there: delete the END IF, or move the FOR loop to the next line, so that THEN is not followed by anything on the same line. The difference is whether you want the other lines to be in an IF block or not.
Your code, as is, has 4 too many END IF statements.
I am scheduled to work about 46 hours (7 days) this week, and about 41 hours (6 days) next week. As I like to enjoy some free time, I won't be able to spend very much time on this. However, I will work on it, but it might take me a while to finish.
Regards,
Michael
It seems to have too many END IFs. You are aware, I assume, that if you put a statement on the same line, following the THEN keyword, that it is just one line, there is no block, and no END IF.
Code: Select all
IF true THEN doit
'no IF block, no END IF
IF true THEN
doit 'this is in the IF block
END IF 'END IF required
Code: Select all
IF melh <5> 1 THEN FOR i6 = 1 TO 3: ar0(i2, i6) = ok(2, i6): NEXT
Your code, as is, has 4 too many END IF statements.
I am scheduled to work about 46 hours (7 days) this week, and about 41 hours (6 days) next week. As I like to enjoy some free time, I won't be able to spend very much time on this. However, I will work on it, but it might take me a while to finish.
Regards,
Michael
Bring on the Maulotaurs! oops...
I like to slay Disciples of D'Sparil...
I like to slay Disciples of D'Sparil...
Michael,
? The code is correct and compiles correctly without errors...
? But I noticed now that once again, there was a problem with the copy / paste into the forum :( grrrrrrrr.... I must disable everything, smilies, html, BBCode, etc... otherwise some of the variables are transformed to smilies and blocks of code are simply "cut out" !!! I do not understand why this happens... I think something is very wrong with BBCode/HTML... :((
? Yes, this is correct... "a statement on the same line, following the THEN keyword, that it is just one line, there is no block, and no END IF"
Thank you
Below I have re-pasted the source code, this time with none of the following activated: BBCode, Smilies and HTML. This way, all the code is correctly posted !... But unfortunately, because of this, one cannot see the indents... :(((
Important:
All variables are integers with exception of variable cycle which is a LONG Integer
DEFINT A-Z
'$STATIC
DIM arr1(4000, 4), ar0(500, 3)
DIM tmp(200, 4), ok(50, 3)
DIM ar1(50, 3), rndnumb(4095)
DIM cycle AS LONG
'...
'... inicial QB code goes here
'...
'... following code is to be assembler...
exitcode = 0
qttmp = 0
qtp0 = qtp
FOR i1 = 1 TO qtp - 4
'LOCATE 1, 1: PRINT i1;
FOR i2 = i1 + 1 TO qtp - 3
'LOCATE 1, 4: PRINT i2;
FOR i3 = i2 + 1 TO qtp - 2
'LOCATE 1, 7: PRINT i3;
FOR i4 = i3 + 1 TO qtp - 1
FOR i5 = i4 + 1 TO qtp
FOR i6 = 1 TO qtorig
FOR i7 = 1 TO qtp
IF i7 <> i1 AND i7 <> i2 AND i7 <> i3 AND i7 <> i4 AND i7 <> i5 THEN
qt = 0
FOR i8 = 1 TO 3
IF arr1(i6, i8) = ar0(i7, i8) THEN qt = qt + 1
NEXT
IF qt > 1 THEN EXIT FOR
END IF
NEXT
IF i7 > qtp THEN
qttmp = qttmp + 1
FOR i8 = 1 TO 3
tmp(qttmp, i8) = arr1(i6, i8)
NEXT
END IF
NEXT
qtorig1 = qttmp
ERASE ar1
FOR i6 = 1 TO qtorig1
tmp(i6, 0) = 1: tmp(i6, 4) = 0
NEXT
tenta = 0
melh = 999
qtnv = 0
qtemp = qtorig1
Ciclo1:
FOR i6 = 1 TO qtorig1
IF tmp(i6, 4) = 0 THEN tmp(i6, 0) = 1 ELSE tmp(i6, 0) = 0
NEXT
FOR i6 = 1 TO qtorig1 - 1
IF tmp(i6, 4) <> 255 THEN
FOR i7 = i6 + 1 TO qtorig1
IF tmp(i7, 4) <> 255 THEN
IF tmp(i7, 4) = 0 OR tmp(i6, 4) = 0 THEN
qt = 0
FOR k = 1 TO 3
IF tmp(i6, k) = tmp(i7, k) THEN qt = qt + 1
NEXT
IF qt > 1 THEN
IF tmp(i7, 4) = 0 THEN tmp(i6, 0) = tmp(i6, 0) + 1
IF tmp(i6, 4) = 0 THEN tmp(i7, 0) = tmp(i7, 0) + 1
END IF
END IF
END IF
NEXT
END IF
NEXT
maior = 0: ind = 0
rndindex = rndindex + 1
IF rndindex > 4095 THEN rndindex = 0
k = rndnumb(rndindex) MOD 9
k = k + 9
FOR i6 = 1 TO qtorig1
IF tmp(i6, 0) > 0 AND tmp(i6, 0) > maior THEN
maior = tmp(i6, 0): ind = i6: k = k - 1
IF k = 0 THEN EXIT FOR
END IF
NEXT
FOR i6 = 1 TO qtorig1
IF tmp(i6, 4) = 0 THEN
qt = 0
FOR k = 1 TO 3
IF tmp(i6, k) = tmp(ind, k) THEN qt = qt + 1
NEXT
IF qt > 1 AND tmp(i6, 4) = 0 THEN qtemp = qtemp - 1
IF qt = 3 THEN tmp(i6, 4) = 255
IF qt = 2 THEN tmp(i6, 4) = 128
END IF
NEXT
qtnv = qtnv + 1
FOR i6 = 1 TO 3: ar1(qtnv, i6) = tmp(ind, i6): NEXT
IF qtemp > 0 THEN
IF qtnv < melh - 1 GOTO Ciclo1
END IF
tenta = tenta + 1
IF qtnv < melh AND qtemp = 0 THEN
melh = qtnv
FOR i6 = 1 TO melh
FOR i7 = 1 TO 3: ok(i6, i7) = ar1(i6, i7): NEXT
NEXT
IF melh < 5 THEN
cycle = cycle + 1
IF cycle MOD 50 = 0 THEN
'LOCATE 5, 11: PRINT cycle;
END IF
GOTO Continuar
END IF
END IF
IF tenta > 99 THEN cycle = cycle + 1: GOTO Continuar
FOR i6 = 1 TO qtorig1: tmp(i6, 4) = 0: NEXT
FOR i6 = 1 TO qtorig1
rndindex = rndindex + 1
IF rndindex > 4095 THEN rndindex = 0
k = rndnumb(rndindex) MOD qtorig1
k = k + 1
FOR i7 = 1 TO 3
SWAP tmp(i6, i7), tmp(k, i7)
NEXT
NEXT
qtnv = 0
qtemp = qtorig1
GOTO Ciclo1
Continuar:
IF melh < 5 THEN
FOR i6 = 1 TO 3: ar0(i1, i6) = ok(1, i6): NEXT
IF melh > 1 THEN FOR i6 = 1 TO 3: ar0(i2, i6) = ok(2, i6): NEXT
IF melh > 2 THEN FOR i6 = 1 TO 3: ar0(i3, i6) = ok(3, i6): NEXT
IF melh > 3 THEN FOR i6 = 1 TO 3: ar0(i4, i6) = ok(4, i6): NEXT
IF melh < 4 THEN FOR i6 = 1 TO 3: ar0(i4, i6) = ar0(qtp - 1, i6): NEXT
IF melh < 3 THEN FOR i6 = 1 TO 3: ar0(i3, i6) = ar0(qtp - 2, i6): NEXT
IF melh < 2 THEN FOR i6 = 1 TO 3: ar0(i2, i6) = ar0(qtp - 3, i6): NEXT
FOR i6 = 1 TO 3: ar0(i5, i6) = ar0(qtp, i6): NEXT
qtp = qtp - 5 + melh
'LOCATE 8, 19: PRINT qtp;
END IF
qttmp = 0
IF qtp < qtp0 GOTO TheEnd1
NEXT
IF qtp < qtp0 GOTO TheEnd1
NEXT
IF qtp < qtp0 GOTO TheEnd1
NEXT
IF qtp < qtp0 GOTO TheEnd1
y$ = INKEY$
IF y$ = CHR$(27) GOTO TheEnd0
NEXT
IF qtp < qtp0 GOTO TheEnd1
NEXT
FOR i1 = 1 TO qtorig: arr1(i1, 4) = 0: NEXT
GOTO TheEnd
TheEnd0:
exitcode = 1
GOTO TheEnd
TheEnd1:
exitcode = -1
TheEnd:
'exit point of assembler code
'...
'... rest of QB code goes here
'...
? The code is correct and compiles correctly without errors...
? But I noticed now that once again, there was a problem with the copy / paste into the forum :( grrrrrrrr.... I must disable everything, smilies, html, BBCode, etc... otherwise some of the variables are transformed to smilies and blocks of code are simply "cut out" !!! I do not understand why this happens... I think something is very wrong with BBCode/HTML... :((
? Yes, this is correct... "a statement on the same line, following the THEN keyword, that it is just one line, there is no block, and no END IF"
Thank you
Below I have re-pasted the source code, this time with none of the following activated: BBCode, Smilies and HTML. This way, all the code is correctly posted !... But unfortunately, because of this, one cannot see the indents... :(((
Important:
All variables are integers with exception of variable cycle which is a LONG Integer
DEFINT A-Z
'$STATIC
DIM arr1(4000, 4), ar0(500, 3)
DIM tmp(200, 4), ok(50, 3)
DIM ar1(50, 3), rndnumb(4095)
DIM cycle AS LONG
'...
'... inicial QB code goes here
'...
'... following code is to be assembler...
exitcode = 0
qttmp = 0
qtp0 = qtp
FOR i1 = 1 TO qtp - 4
'LOCATE 1, 1: PRINT i1;
FOR i2 = i1 + 1 TO qtp - 3
'LOCATE 1, 4: PRINT i2;
FOR i3 = i2 + 1 TO qtp - 2
'LOCATE 1, 7: PRINT i3;
FOR i4 = i3 + 1 TO qtp - 1
FOR i5 = i4 + 1 TO qtp
FOR i6 = 1 TO qtorig
FOR i7 = 1 TO qtp
IF i7 <> i1 AND i7 <> i2 AND i7 <> i3 AND i7 <> i4 AND i7 <> i5 THEN
qt = 0
FOR i8 = 1 TO 3
IF arr1(i6, i8) = ar0(i7, i8) THEN qt = qt + 1
NEXT
IF qt > 1 THEN EXIT FOR
END IF
NEXT
IF i7 > qtp THEN
qttmp = qttmp + 1
FOR i8 = 1 TO 3
tmp(qttmp, i8) = arr1(i6, i8)
NEXT
END IF
NEXT
qtorig1 = qttmp
ERASE ar1
FOR i6 = 1 TO qtorig1
tmp(i6, 0) = 1: tmp(i6, 4) = 0
NEXT
tenta = 0
melh = 999
qtnv = 0
qtemp = qtorig1
Ciclo1:
FOR i6 = 1 TO qtorig1
IF tmp(i6, 4) = 0 THEN tmp(i6, 0) = 1 ELSE tmp(i6, 0) = 0
NEXT
FOR i6 = 1 TO qtorig1 - 1
IF tmp(i6, 4) <> 255 THEN
FOR i7 = i6 + 1 TO qtorig1
IF tmp(i7, 4) <> 255 THEN
IF tmp(i7, 4) = 0 OR tmp(i6, 4) = 0 THEN
qt = 0
FOR k = 1 TO 3
IF tmp(i6, k) = tmp(i7, k) THEN qt = qt + 1
NEXT
IF qt > 1 THEN
IF tmp(i7, 4) = 0 THEN tmp(i6, 0) = tmp(i6, 0) + 1
IF tmp(i6, 4) = 0 THEN tmp(i7, 0) = tmp(i7, 0) + 1
END IF
END IF
END IF
NEXT
END IF
NEXT
maior = 0: ind = 0
rndindex = rndindex + 1
IF rndindex > 4095 THEN rndindex = 0
k = rndnumb(rndindex) MOD 9
k = k + 9
FOR i6 = 1 TO qtorig1
IF tmp(i6, 0) > 0 AND tmp(i6, 0) > maior THEN
maior = tmp(i6, 0): ind = i6: k = k - 1
IF k = 0 THEN EXIT FOR
END IF
NEXT
FOR i6 = 1 TO qtorig1
IF tmp(i6, 4) = 0 THEN
qt = 0
FOR k = 1 TO 3
IF tmp(i6, k) = tmp(ind, k) THEN qt = qt + 1
NEXT
IF qt > 1 AND tmp(i6, 4) = 0 THEN qtemp = qtemp - 1
IF qt = 3 THEN tmp(i6, 4) = 255
IF qt = 2 THEN tmp(i6, 4) = 128
END IF
NEXT
qtnv = qtnv + 1
FOR i6 = 1 TO 3: ar1(qtnv, i6) = tmp(ind, i6): NEXT
IF qtemp > 0 THEN
IF qtnv < melh - 1 GOTO Ciclo1
END IF
tenta = tenta + 1
IF qtnv < melh AND qtemp = 0 THEN
melh = qtnv
FOR i6 = 1 TO melh
FOR i7 = 1 TO 3: ok(i6, i7) = ar1(i6, i7): NEXT
NEXT
IF melh < 5 THEN
cycle = cycle + 1
IF cycle MOD 50 = 0 THEN
'LOCATE 5, 11: PRINT cycle;
END IF
GOTO Continuar
END IF
END IF
IF tenta > 99 THEN cycle = cycle + 1: GOTO Continuar
FOR i6 = 1 TO qtorig1: tmp(i6, 4) = 0: NEXT
FOR i6 = 1 TO qtorig1
rndindex = rndindex + 1
IF rndindex > 4095 THEN rndindex = 0
k = rndnumb(rndindex) MOD qtorig1
k = k + 1
FOR i7 = 1 TO 3
SWAP tmp(i6, i7), tmp(k, i7)
NEXT
NEXT
qtnv = 0
qtemp = qtorig1
GOTO Ciclo1
Continuar:
IF melh < 5 THEN
FOR i6 = 1 TO 3: ar0(i1, i6) = ok(1, i6): NEXT
IF melh > 1 THEN FOR i6 = 1 TO 3: ar0(i2, i6) = ok(2, i6): NEXT
IF melh > 2 THEN FOR i6 = 1 TO 3: ar0(i3, i6) = ok(3, i6): NEXT
IF melh > 3 THEN FOR i6 = 1 TO 3: ar0(i4, i6) = ok(4, i6): NEXT
IF melh < 4 THEN FOR i6 = 1 TO 3: ar0(i4, i6) = ar0(qtp - 1, i6): NEXT
IF melh < 3 THEN FOR i6 = 1 TO 3: ar0(i3, i6) = ar0(qtp - 2, i6): NEXT
IF melh < 2 THEN FOR i6 = 1 TO 3: ar0(i2, i6) = ar0(qtp - 3, i6): NEXT
FOR i6 = 1 TO 3: ar0(i5, i6) = ar0(qtp, i6): NEXT
qtp = qtp - 5 + melh
'LOCATE 8, 19: PRINT qtp;
END IF
qttmp = 0
IF qtp < qtp0 GOTO TheEnd1
NEXT
IF qtp < qtp0 GOTO TheEnd1
NEXT
IF qtp < qtp0 GOTO TheEnd1
NEXT
IF qtp < qtp0 GOTO TheEnd1
y$ = INKEY$
IF y$ = CHR$(27) GOTO TheEnd0
NEXT
IF qtp < qtp0 GOTO TheEnd1
NEXT
FOR i1 = 1 TO qtorig: arr1(i1, 4) = 0: NEXT
GOTO TheEnd
TheEnd0:
exitcode = 1
GOTO TheEnd
TheEnd1:
exitcode = -1
TheEnd:
'exit point of assembler code
'...
'... rest of QB code goes here
'...
Mestrinho:
Because it seems that Michael will be pretty busy, I am taking the liberty of informing you that Michale has already pointed out that the following partial code is wrong:
In BASIC and QB, the above line should be written as:
O.K., it seems that, when one enters the last line above as code in this forum. with the order reversed to 5 first, then the 1, it is changed to the confusing and wrong line,
IF melh <5> 1 THEN
Conclusion: Your code is right, but the posting changes your code, as described above! So, it now becomes mandatory to carefully check our results by using the Preview option BEFORE posting!
Because it seems that Michael will be pretty busy, I am taking the liberty of informing you that Michale has already pointed out that the following partial code is wrong:
Code: Select all
IF melh <5> 1 THEN
Code: Select all
IF melh > 1 AND melh < 5 THEN
IF melh <5> 1 THEN
Conclusion: Your code is right, but the posting changes your code, as described above! So, it now becomes mandatory to carefully check our results by using the Preview option BEFORE posting!
Ralph, with QuickBASIC 4.5, operating under Windows XP, wiht anHP LaserJet 4L Printer. Bilingual in English/Spanish
- burger2227
- Veteran
- Posts: 2466
- Joined: Mon Aug 21, 2006 12:40 am
- Location: Pittsburgh, PA
Strange
I have also recently had problems posting <> arrows.
You cannot post the word C_O_M_P_A_R_I_S_O_N either LOL
I wonder if something has been changed in the forum editor?
I don't think this was a problem previously. Somebody told me to disable the HTML.
Ted
You cannot post the word C_O_M_P_A_R_I_S_O_N either LOL
I wonder if something has been changed in the forum editor?
I don't think this was a problem previously. Somebody told me to disable the HTML.
Ted
Please acknowledge and thank members who answer your questions!
QB64 is a FREE QBasic compiler for WIN, MAC(OSX) and LINUX : https://www.qb64.org/forum/index.php
Get my Q-Basics demonstrator: https://www.dropbox.com/s/fdmgp91d6h8ps ... s.zip?dl=0
QB64 is a FREE QBasic compiler for WIN, MAC(OSX) and LINUX : https://www.qb64.org/forum/index.php
Get my Q-Basics demonstrator: https://www.dropbox.com/s/fdmgp91d6h8ps ... s.zip?dl=0