'===========================================================================
' 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 <title>, <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