'=========================================================================== ' Subject: ABSOLUTE ASSEMBLY Date: 04-14-00 (11:02) ' Author: James A. Davis Code: QB, PDS ' Origin: jad@iswt.com Packet: MISC.ABC '=========================================================================== ' ** 3-24-2000 ' ** this WAS ' Absolute Assembly 2.1 by Petter Holmberg, -97. '** I JAD modified it, trying to work a large asm program '** it works for me, tho its a little tricky '** Petter writes above my head, he is a great writer . i changed some of it ' ** trying to get it to work on a larger program '** _Petter I hope you didn't mind ' *** use at your own risk this can wipe old files *** ' ** I am James Davis : email jad@iswt.com '** USE qb45/L '** not responsible ** use at your own risk **** ' ** if your asm program doesn't have jmps, banches, or labels where '** some thing is stored use the call absolute Petter has at end '** other wise make an array and read the asm into it at offset &h100 '** like below ' **** I make an array at start of program '*** REDIM storage%(1 TO 1000) 'this * 2 = 2000 bytes '*** dump% = VARSEG(storage%(1)) '** after I put the asm$ program on the program I then read the asm$ and '** poke it back into my array at offset &h100 '** if more than 1 asm$ i make more what ever it takes '** I call like this CALL ABSOLUTE(who$, buff%, &H100): '** I don't declare the call absolute '** debug doesn't like this mov ax,es:word ptr{121} '** use this es: '** mov ax,word ptr[121] '** I don't delete the files "tempfila.txt (a tho g), used to make the asm '** the errors are general found in tempfilc.txt which you can look at with '** edit or what ever '** good luck ' Absolute Assembly takes use of DEBUG, the program shipped with MS-DOS. ' ' DEBUG only supports 8088/8086 instructions, but it's still a good tool for ' ' getting machine language out of Assembly instructions. And since QBASIC ' ' ' ' Absolute Assembly 2.1 features: ' ' * Support for blank lines and lines with just comments or lables. ' ' * Support for double Assembly commands, like REP STOSB. ' ' * Option to automatically add CALL ABSOLUTE lines to output file. ' ' * All Assembly source lines printed to BASIC file in the same column. ' ' * Option to merge lines directly into a BASIC file. ' ' * Auto-detection of QuickBASIC binary files to ensure safe merging. ' ' * Handling of errors and bugs in the sourcefile. ' ' ' ' Notes: ' ' * Comments must start with a semicolon, (;). ' ' * The maximum number of labels are 256. You shouldn't need half as much. ' ' * The maximum number of letters for a label are 16. It's easy to change ' ' * the program to accept a larger number, but it's probably not necessary. ' ' * A line label must be immediately followed by a colon, (:). Do NOT use a ' ' colon after the label name in jump-instructions. ' ' * Never use Assembly opcodes, numbers or single letters as labels. ' ' * Do not name labels so that the name includes the letters REP, REPE or ' ' * REPZ after each other, for example RepeatLoop: ' ' "Label:" and "label:" are processed as the same label. ' ' * If no code string name is specified, it will be asm$ as default. ' ' * This program was made in QB45, but you should be able to run it in ' ' QBASIC, PDS, VBDOS and PB as well. ' ' * If the program locks up, it's probably while running DEBUG. If this ' ' happens, reboot your computer and check your source code for lines with ' ' other things than Assembly instrucions, comments, labels or spaces. ' ' * You may use this program freely; distribute it, modify it, learn from it ' ' or erase it from your hard drive. ;) Just be sure to credit me in the ' ' programs where you have used Absolute Assembly for some of the code. ' ' * If your computer gets damaged while using this program, don't blame me. ' ' * If you use Absolute Assembly in a program, please mail me and tell me ' ' about it! ' ' * Any comments/suggestions/bug reports etc. can be sent to: ' ' petter.holmberg@usa.net ' ' * Enjoy the program and have fun! Petter Holmberg, Sweden. ' CONST rundebug$ = "C:\DOS\DEBUG.EXE" ' Change this if you have DEBUG '** some where else CONST tempa$ = "TEMPFILA.TXT" ' Change this if the filename already CONST tempb$ = "TEMPFILB.TXT" ' Change this if the filename already CONST tempc$ = "TEMPFILC.TXT" ' Change this if the filename already CONST tempd$ = "TEMPFILD.TXT" ' Change this if the filename already CONST tempe$ = "TEMPFILE.TXT" CONST tempF$ = "TEMPFILf.TXT" CONST tempg$ = "TEMPFILg.TXT" TYPE labeltype ' Usertype for storing of labels. labelname AS STRING * 16 ' Change this if you want longer labels. labelpos AS STRING * 4 labelnum AS INTEGER END TYPE DIM label(1 TO 256) AS labeltype ' Array for storing of labels. DIM ll$(3000) DIM w(200) DIM i(900) DIM wh(900) DIM lc$(900) DIM lbc(900) '** 256 here would not work DIM lnc(900) DIM lbs(900) CLS DIM thefile$(4000) INPUT "Assembly source text file:", sourcefilename$ INPUT "BASIC destination file : ", destfilename$ INPUT "Name of code string : ", codestring$ codestring$ = LTRIM$(RTRIM$(codestring$)) IF codestring$ = "" THEN codestring$ = "asm$" IF RIGHT$(codestring$, 1) <> "$" THEN codestring$ = codestring$ + "$" PRINT "Append to destfile? (y/n) : "; DO kbd$ = INKEY$ IF LCASE$(kbd$) = "n" THEN writemethod% = 0 IF LCASE$(kbd$) = "y" THEN writemethod% = 1 LOOP UNTIL LCASE$(kbd$) = "n" OR LCASE$(kbd$) = "y" PRINT LCASE$(kbd$) PRINT "Add CALL ABSOLUTE lines? (y/n) : "; DO kbd$ = INKEY$ IF LCASE$(kbd$) = "n" THEN callabs% = 0 IF LCASE$(kbd$) = "y" THEN callabs% = 1 LOOP UNTIL LCASE$(kbd$) = "n" OR LCASE$(kbd$) = "y" PRINT LCASE$(kbd$) PRINT SCREEN 9 2345 conversiontime! = TIMER w = 0 spec$ = sourcefilename$ '"satload.asm" ' w"clear.asm" '"eg2save.asm" '2draw.asm " '"browse.asm "' "SAT.ASM "' "2a.ASM " '" OPEN spec$ FOR BINARY AS #1 IF LOF(1) = 0 THEN PRINT : PRINT "File Not Found" CLOSE OPEN spec$ FOR BINARY AS #1 IF LOF(1) = 0 THEN PRINT : PRINT "File Not Found" CLOSE OPEN spec$ FOR INPUT AS #1 DO UNTIL (EOF(1)) LINE INPUT #1, Temp$ LET lines = lines + 1 LOOP CLOSE CLOSE 2: OPEN tempa$ FOR OUTPUT AS 2 OPEN spec$ FOR INPUT AS #1 FOR i = 1 TO lines LINE INPUT #1, thefile$(i) f$ = "" FOR x = 1 TO LEN(thefile$(i)) d$ = MID$(thefile$(i), x, 1) DD$ = MID$(thefile$(i), x + 1, 1) DDD$ = MID$(thefile$(i), x + 2, 1) d$ = UCASE$(d$) DD$ = UCASE$(DD$) DDD$ = UCASE$(DDD$) '*** IF d$ = " " AND DD$ = " " THEN GOTO 2190 IF d$ = CHR$(9) THEN GOTO 2190 '** masm 6 put this at start of each line IF d$ = ":" AND RIGHT$(f$, 2) = "CS" THEN GOTO 2180 IF d$ = ":" AND RIGHT$(f$, 2) = "ES" THEN GOTO 2180 IF d$ = ":" AND RIGHT$(f$, 2) = "DS" THEN GOTO 2180 IF d$ = ";" THEN GOSUB 2500: f$ = f$ + " ": GOTO 2190 '** this removes most IF d$ = ":" THEN w = w + 1: ll$(w) = f$: wh(w) = l + 1: f$ = "": d$ = "": GOTO 2190 2180 f$ = f$ + UCASE$(d$) '**making f$ d$ = "" 2190 IF i > lines THEN i = lines NEXT l = l + 1 thefile$(i) = "" f$ = LTRIM$(RTRIM$(f$)) '** removing blanks IF LEN(f$) = 0 THEN l = l - 1: GOTO 2209 PRINT #2, f$ 2209 d$ = "" f$ = "" 2300 NEXT CLOSE 1 CLOSE 2 ln = 0 lc = 100 '60 ' 150 '100 OPEN tempa$ FOR INPUT AS #1 OPEN tempb$ FOR OUTPUT AS #2 PRINT #2, "a" DO '** putting a dummy number in our [ ] places '** debug won't use letter here :used 100 but if it a long program '** debug thinks its to far from its location e, we are allowed abt 125 + '** I think in jz and others branches:so increase it by 6 on each loop you '** will have play with this:in your case it could be different:a short '** program, no sweat LINE INPUT #1, f$ FOR e = 1 TO w lc$ = STR$(lc) IF INSTR(f$, LTRIM$(RTRIM$(ll$(e)))) <> 0 THEN ff = LEN(f$) r$ = RIGHT$(f$, INSTR(LTRIM$(RTRIM$(f$)), "]")) ff = ff - LEN(r$): IF r$ = "" THEN f$ = LEFT$(f$, INSTR(f$, LTRIM$(RTRIM$(ll$(e)))) - 1) + lc$ 'was 0100 '** now its lc$ which is changed if i get errors ELSE f$ = LEFT$(f$, INSTR(f$, LTRIM$(RTRIM$(ll$(e)))) - 1) + lc$ + RIGHT$(f$, ff + 1): ' PRINT "2f$ "; f$: SLEEP '*+1 lc = lc + 8' 6 '30 '25 '66 *** lc$ increases as you go along:try to keep '* with in 125 of where you are else a error in debug:look at tempfilc.txt END IF END IF ln = ln + 1 NEXT f$ = LTRIM$(RTRIM$(f$)) PRINT #2, f$ LOOP UNTIL EOF(1) PRINT #2, "" PRINT #2, "u 100, 100" PRINT #2, "q" CLOSE #1 CLOSE #2 SHELL rundebug$ + "<" + tempb$ + ">" + tempc$ CLOSE ' OK 333 '** b looks ok '*** how long **** OPEN tempc$ FOR INPUT AS #1 DO ee$ = mp$: '** getting how long: looking at tempc a line at a time '** it has line numbers so when we get to the -u 100, 100 '** which is the end: the length is the line before -u,100, 100 end LINE INPUT #1, mp$ SEEK #1, SEEK(1) + 2 LOOP UNTIL mp$ = "-u 100, 100" CLOSE asmlength$ = MID$(ee$, INSTR(ee$, ":") + 1, 4) CLOSE 1 ee$ = "" OPEN tempc$ FOR INPUT AS #1 OPEN tempd$ FOR OUTPUT AS #2 SEEK #1, SEEK(1) + 5 PRINT #2, "a" DO LINE INPUT #1, f$ SEEK #1, SEEK(1) + 2 f$ = RIGHT$(f$, LEN(f$) - 10) IF LEN(f$) > 0 THEN PRINT #2, f$ LOOP UNTIL f$ = "" CLOSE 1 PRINT #2, "" PRINT #2, "u 100, " + asmlength$ PRINT #2, "q" CLOSE #2 SHELL rundebug$ + "<" + tempd$ + ">" + tempe$ CLS OPEN tempe$ FOR INPUT AS #1 DO LINE INPUT #1, f$ LOOP UNTIL INSTR(f$, "-u 100, ") SEEK #1, SEEK(1) + 2 lnc = 1 lbc = 1 DO LINE INPUT #1, f$ IF wh(lbc) = lnc THEN '* WH(LBC) ARE THE LABELS '** wh(lbc) are the line numbers of the labels:if wh(lbc)number equals '** the line number then lcl$(lbc) equals mid$(f$,6,4):this is used later '** unrem the print statements and look lc$(lbc) = MID$(f$, 6, 4) lbc = lbc + 1 END IF lnc = lnc + 1 LOOP UNTIL f$ = "-q" '*************************************************************************** CLOSE OPEN tempa$ FOR INPUT AS #1 OPEN tempF$ FOR OUTPUT AS #2 PRINT #2, "a" DO LINE INPUT #1, f$ FOR lbs = 1 TO w 'rem PRINT "f$ "; f$; " "; LTRIM$(RTRIM$(ll$(lbs))): SLEEP '** putting back the addresses in the lines '**it takes a line of f$ and checks it to see if any of the labels in '** ll$(lbs) matches if it matches it then inserts it in f$ '** it checks w times this is number of labels '** run the print above and below that are rem out IF INSTR(f$, LTRIM$(RTRIM$(ll$(lbs)))) THEN r$ = RIGHT$(f$, INSTR(LTRIM$(RTRIM$(f$)), "]")) rt = INSTR(LTRIM$(RTRIM$(f$)), "]") r$ = RIGHT$(f$, LEN(f$) - rt + 1) IF rt <> 0 THEN f$ = LEFT$(f$, INSTR(f$, LTRIM$(RTRIM$(ll$(lbs)))) - 1) + lc$(lbs) + r$ ELSE f$ = LEFT$(f$, INSTR(f$, LTRIM$(RTRIM$(ll$(lbs)))) - 1) + lc$(lbs): END IF END IF NEXT 'PRINT f$ 'SLEEP PRINT #2, f$ LOOP UNTIL EOF(1) CLOSE #1 PRINT #2, "" PRINT #2, "u 100, "; asmlength$ PRINT #2, "q" CLOSE 2 SHELL rundebug$ + "<" + tempF$ + ">" + tempg$ linecounter% = 1 longestline% = 0 maxsourcelength% = 0 maxcodelength% = 0 OPEN tempg FOR INPUT AS #1 DO LINE INPUT #1, readline$ LOOP UNTIL INSTR(readline$, "-u 100,") SEEK #1, SEEK(1) + 2 DO LINE INPUT #1, readline$ linelength% = LEN(RTRIM$(MID$(readline$, 11, 14))) IF linelength% >= longestline% THEN codelength% = 0 FOR findcodelength% = 1 TO linelength% STEP 2 IF MID$(RTRIM$(MID$(readline$, 11, 14)), findcodelength%, 1) = "0" THEN codelength% = codelength% + 1 ELSE codelength% = codelength% + 2 END IF NEXT findcodelength% IF maxsourcelength% < codelength% THEN maxsourcelength% = codelength% longestline% = linelength% END IF linecounter% = linecounter + 1 LOOP UNTIL readline$ = "-q" maxcodelength% = LEN(codestring$) + 3 + LEN(codestring$) + (longestline% \ 2) * 11 + maxsourcelength% CLOSE #1 ' -------------------------------------------------------------------------- ' ' Transform the source code to BASIC string declaration lines: ' ' -------------------------------------------------------------------------- ' FOR modifylabels% = 1 TO numlabels% MID$(label(modifylabels%).labelname, 2, 16) = LCASE$(RIGHT$(label(modifylabels%).labelname, 15)) NEXT modifylabels% OPEN tempg FOR INPUT AS #1 OPEN tempa FOR INPUT AS #2 IF writemethod% = 1 THEN OPEN destfilename$ FOR APPEND AS #3 ELSE OPEN destfilename$ FOR OUTPUT AS #3 END IF DO LINE INPUT #1, readline$ LOOP UNTIL INSTR(readline$, "-u 100,") SEEK #1, SEEK(1) + 2 PRINT #3, "' ------ Created with Absolute Assembly 2.1 by Petter Holmberg, -97. ------- '" PRINT #3, "' -------modified by jad 3-24-00------------ " PRINT #3, codestring$ + " = " + CHR$(34) + CHR$(34) linecounter% = 1 labelcounter% = 1 DO LINE INPUT #1, readline$ readline$ = RTRIM$(readline$) IF NOT EOF(2) THEN LINE INPUT #2, sourceline$ ELSE sourceline$ = "" IF readline$ <> "-q" THEN sourcedata$ = RTRIM$(MID$(readline$, 11, 14)) basicline$ = codestring$ + " = " + codestring$ FOR makebasicline% = 1 TO LEN(sourcedata$) STEP 2 IF MID$(RTRIM$(MID$(readline$, 11, 14)), makebasicline%, 1) = "0" THEN basicline$ = basicline$ + " + CHR$(&H" + MID$(sourcedata$, makebasicline% + 1, 1) + ")" ELSE basicline$ = basicline$ + " + CHR$(&H" + MID$(sourcedata$, makebasicline%, 2) + ")" END IF NEXT makebasicline% IF LEN(basicline$) < maxcodelength% THEN basicline$ = basicline$ + SPACE$(maxcodelength% - LEN(basicline$)) basicline$ = basicline$ + " ' " IF label(labelcounter%).labelnum = linecounter% THEN basicline$ = basicline$ + RTRIM$(label(labelcounter%).labelname) + ": " labelcounter% = labelcounter% + 1 END IF asmline$ = (RIGHT$(readline$, (LEN(readline$) - 24))) IF INSTR(asmline$, CHR$(9)) THEN MID$(asmline$, INSTR(asmline$, CHR$(9))) = " " asmline$ = RTRIM$(asmline$) basicline$ = basicline$ + asmline$ FOR labelscan% = 1 TO numlabels% IF INSTR(sourceline$, UCASE$(RTRIM$(label(labelscan%).labelname))) AND INSTR(sourceline$, ":") = 0 THEN basicline$ = LEFT$(basicline$, LEN(basicline$) - 4) basicline$ = basicline$ + RTRIM$(label(labelscan%).labelname) END IF NEXT labelscan% PRINT #3, basicline$ '** asm END IF linecounter% = linecounter% + 1 LOOP UNTIL readline$ = "-q" asmlength$ = ("&h" + asmlength$) PRINT #3, "' length " PRINT #3, "'"; VAL(asmlength$) - 256 IF callabs% = 1 THEN PRINT #3, "" PRINT #3, "offset% = SADD("; codestring$; ")" PRINT #3, "DEF SEG = VARSEG("; codestring$; ")" PRINT #3, "CALL ABSOLUTE(offset%)" PRINT #3, "DEF SEG" END IF PRINT #3, "" PRINT #3, "' ------ Created with Absolute Assembly 2.1 by Petter Holmberg, -97. ------- '" PRINT #3, "' ------ modified by jad 3-24-00 ------------- " CLOSE #3 CLOSE #2 CLOSE #1 PRINT "Source code successfully moved to BASIC destination file." PRINT PRINT "Time of conversion:"; TIMER - conversiontime!; "seconds." PRINT PRINT "Convert another file? (y/n) : "; DO kbd$ = INKEY$ IF LCASE$(kbd$) = "n" THEN PRINT LCASE$(kbd$) END END IF IF LCASE$(kbd$) = "y" THEN PRINT LCASE$(kbd$) END END IF LOOP END PRINT "end Press any key" SLEEP END 2500 '*******************************************************************. '******************************************* d$ = MID$(thefile$(i), x, 1) IF d$ <> ">" AND x < LEN(thefile$(i)) THEN x = x + 1: GOTO 2500 d$ = "" '** getting rid of , <center>,and <what> ever between < > RETURN 2510 d$ = MID$(thefile$(i), x, 1) IF d$ = " " AND x < LEN(thefile$(i)) THEN x = x + 1: GOTO 2510 d$ = "" '** getting rid of <title>, <center>,and <what> ever between < > ' PRINT "2510" ' SLEEP RETURN