Page 1 of 1

Assembly Answer

Posted: Thu Mar 24, 2011 3:19 am
by TRANERAECK
Here is what I found at Microsoft. How to save and restore a text mode screen I find it interesting, it uses assembly, and it makes a call to an assembly file.

Code: Select all

   Defint A-Z
   '$Dynamic
   Dim Storage(1999)
   FirstLine = 1
   LastLine  = 5
   Cls
   For X = 1 To 15
       Color X
       Print String$(80, X + 64);
   Next
   Locate 20
   Print "Press a key to save the screen";
   While Inkey$ = "" : Wend
   'Call Ptr86(Segment, Address, Varptr(Storage(0)))  ' For QB 3.00.
   Segment=VARSEG(Storage(0)) ' For QB 4.00
   Address=VARPTR(Storage(0)) ' For QB 4.00
   Call ScrnSave(FirstLine, LastLine, Segment, Address)
   Cls
   Print "Press a key to restore the top";
   While Inkey$ = "" : Wend
   'Call Ptr86(Segment, Address, Varptr(Storage(0))) ' For QB 3.00.
   Segment=VARSEG(Storage(0))  ' For QB 4.00
   Address=VARPTR(Storage(0))  ' For QB 4.00
   Call ScrnRest(FirstLine, LastLine, Segment, Address)
				

The following is SCRNSAVE.ASM, an assembly language routine. SCRNSAVE.ASM saves a portion of the text screen in QuickBasic: 
Code        Segment Byte Public 'Code'
            Assume  CS:Code
            Public  ScrnSave

ScrnSave    Proc    Far

Begin:      Push  BP            ;save registers for Basic

            ;* Push  DS  DELETE THIS LINE

            Mov   BP,SP         ;locate stack to get variable
                                ;addresses later

            PUSH  DS            ;* SAVE THE DATA SEGMENT
            PUSH  ES            ;* SAVE THE EXTRA SEGMENT


            Mov   DX,0          ;look at low memory using ES
            Mov   ES,DX
            Mov   BX,0B000h     ;assume monochrome screen segment for
                                ;now
            Mov   AL,ES:[410h]  ;get the equipment list
            And   AL,48         ;just look at the monitor type
            Cmp   AL,48         ;is it monochrome?
            JZ    Get_Params    ;if yes, skip over adding 800h
            Add   BX,800h       ;if no, adjust for color-screen memory

            Mov   AL,ES:[487h]  ;if an EGA is present, AL will not be
                                ;zero
            Cmp   AL,0          ;is it an EGA?
            JNZ   Get_Params    ;if yes, leave DX set to zero as a
                                ;flag for later
            Mov   DX,3DAh       ;if no, specify the port to check for
                                ;retrace

Get_Params: Push  BX            ;save the screen segment for later

            ;* Mov   SI,[BP+08] ;get the starting address of the
                                ;storage array
            ;* change to BP+6
            Mov   SI,[BP+06]    ;get the starting address of the
                                ;storage array
            Mov   DI,[SI]       ;and put it into DI


            ;* Mov   SI,[BP+10] ;get the segment for the array
            ;* change to BP+8
            Mov   SI,[BP+8]    ;get the segment for the array


            Mov   ES,[SI]       ;and assign it to ES

            ;* Mov   SI,[BP+12]    ;get the address for LastLine
            ;* change to BP+10
            Mov   SI,[BP+10]    ;get the address for LastLine

            Mov   AL,[SI]    ;and put it into AL
            Mov   CL,160     ;prepare to multiply times 160
            Mul   CL         ;now AX holds the last screen address to
                             ;save
            Mov   BX,AX      ;save it in BX for later

            ;* Mov   SI,[BP+14]    ;get the address for FirstLine
            ;* change to BP+12
            Mov   SI,[BP+12]  ;get the address for FirstLine
            Mov   AL,[SI]     ;put it into AL
            Dec   AL          ;adjust 1-25 to 0-24
            Mul   CL          ;calculate actual starting address on
                              ;screen
            Mov   SI,AX       ;now SI points to the source address

            Sub   BX,AX       ;calculate the number of bytes to copy
            Mov   CX,BX       ;put it into CX for Rep or Loop below
            Shr   CX,1        ;divide CX by 2 to obtain the number of
                              ;words
            Pop   DS          ;retrieve the screen segment saved
                              ;earlier
            Cld               ;all data moves below will be forward
            Cmp   DL,0        ;are we doing monochrome or EGA?
            JZ    Mono        ;if monochrome, skip over the retrace

No_Retrace: In    AL,DX       ;get the video-status byte
            Test  AL,1        ;test just the horizontal retrace part
            JNZ   No_Retrace  ;if doing a retrace, wait until it is
                              ;not
Retrace:    In    AL,DX       ;get the status byte again
            Test  AL,1        ;are we currently doing a retrace?
            JZ    Retrace     ;if no, wait until we are
            Lodsw             ;now get the word from the screen
            Stosw             ;and put it into the array
            Loop  No_Retrace  ;loop until done
            Jmp   Exit        ;skip over the monochrome routine and
                              ;exit
Mono:       Rep   Movsw       ;move the data in one operation

Exit:       POP   ES          ;* ADD THIS LINE
            Pop   DS          ;restore registers for Basic
            Pop   BP
            Ret   8           ;return skipping the passed parameters

ScrnSave    Endp
Code        Ends
            End   ;* REMOVE THE LABEL Begin
				

The following is SCRNREST.ASM, which restores a portion of the text screen in the QuickBasic program: 
Code        Segment Byte Public 'Code'
            Assume  CS:Code
            Public  ScrnRest

ScrnRest    Proc    Far

Begin:      Push  BP            ;save registers for Basic

            ;* Push  DS  DELETE THIS LINE

            Mov   BP,SP       ;locate stack to get variable addresses
                              ;later
            PUSH  DS          ;* ADD THIS LINE
            PUSH  ES          ;* ADD THIS LINE


            Mov   DX,0        ;look at low memory using ES
            Mov   ES,DX
            Mov   BX,0B000h   ;assume monochrome screen segment for
                              ;now
            Mov   AL,ES:[410h];get the equipment list
            And   AL,48       ;just look at the monitor type
            Cmp   AL,48       ;is it monochrome?
            JZ    Get_Params  ;if yes, skip over adding 800h
            Add   BX,800h     ;if no, adjust for color-screen memory

            Mov   AL,ES:[487h];if an EGA is present, AL will not be
                              ;zero
            Cmp   AL,0        ;is it an EGA?
            JNZ   Get_Params  ;yes, leave DX set to zero as flag for
                              ;later
            Mov   DX,3DAh     ;no, specify the port to check for
                              ;retrace
Get_Params: Mov   ES,BX       ;set ES to the appropriate screen
                              ;segment

            ;* Mov   DI,[BP+12]    ;get the address for LastLine
            ;* change to BP+10
            Mov   DI,[BP+10]    ;get the address for LastLine


            Mov   AL,[DI]      ;and put it into AL
            Mov   CL,160       ;prepare to multiply times 160
            Mul   CL           ;now AX holds last screen address to
                               ;restore
            Mov   BX,AX        ;save it in BX for later

            ;* Mov   DI,[BP+14]    ;get the address for FirstLine
            ;* change to BP+12
            Mov   DI,[BP+12]  ;get the address for FirstLine

            Mov   AL,[DI]     ;put it into AL
            Dec   AL          ;adjust 1-25 to 0-24
            Mul   CL          ;calculate actual starting address on
                              ;screen
            Mov   DI,AX       ;now DI points to the destination
                              ;address
            Sub   BX,AX       ;calculate the number of bytes to copy
            Mov   CX,BX       ;put it into CX for Rep or Loop below
            Shr   CX,1        ;divide CX by 2 to obtain the number of
                              ;words
            ;* Mov   SI,[BP+10]    ;get the segment of the storage
                                    array
            ;* change  BP + 8
            Mov   SI,[BP+8]    ;get the segment of the storage array

            Mov   AX,[SI]       ;and save it in AX for a moment

            ;* Mov   SI,[BP+08] ;get the address of the first array
                                ;element
            ;* change to BP+6
            Mov   SI,[BP+06]  ;get the address of the first array
                              ;element
            Mov   SI,[SI]     ;and put it into SI
            Mov   DS,AX       ;okay to change DS after getting all
                              ;variables
            Cld               ;all data moves below will be forward
            Cmp   DL,0        ;are we doing monochrome or EGA?
            JZ    Mono        ;if monochrome, skip over the retrace

No_Retrace: In    AL,DX       ;get the video status byte
            Test  AL,1        ;test just the horizontal retrace part
            JNZ   No_Retrace  ;if doing a retrace, wait until it is
                              ;not
Retrace:    In    AL,DX       ;get the status byte again
            Test  AL,1        ;are we currently doing a retrace?
            JZ    Retrace     ;if no, wait until we are
            Lodsw             ;now get the word from the screen
            Stosw             ;and put it into the array
            Loop  No_Retrace  ;loop until done
            Jmp   Exit        ;skip over the monochrome routine and
                              ;exit
Mono:       Rep   Movsw       ;move the data in one operation

Exit:       POP   ES          ;* ADD THIS LINE
            Pop   DS          ;restore registers for Basic
            Pop   BP
            Ret   8           ;return skipping the passed parameters

ScrnRest    Endp
Code        Ends
            End   ;* REMOVE THE LABEL Begin
				

I hope this helps anyone ever wanting to use assembly in qbasic I know this is awesome for me; never knew how. 8) [/code]

Posted: Sun Apr 03, 2011 8:57 pm
by Kiyotewolf
This won't work, if you were to copy & paste into the QBasic IDE.

You have to either load values of assembly language into memory from DATA statements, or BLOAD a binary file with the ASM code into memory that way.

You can't insert ASM code written out like that for something like MASM to compile from.

MOV AX,[004F]
PUSH FF
That type of language above is INCOMPATIBLE WITH Qbasic.

00 F3 30 FE AB 99 02 04
A string of numbers like that, is ASM which CAN be put into QBasic, but you have to contain it first.

Code: Select all


REM SAMPLE PROGRAM
REM SHOW PURPOSES ONLY ~ DO NOT RUN
REM Working on simpler & smaller ASM routine to show & tell instead.

DATA &HB8, &H13, &H0, &HCD, &H10, &HB8, &H12, &H10, &HBB, &H0, &H0, &HB9, &H0, &H1, &HBA, &H2E, &H1, &HCD
DATA &H10, &HFC, &HBE, &H2E, &H4, &H2B, &HFF, &HB8, &H0, &HA0, &H8E, &HC0, &HB9, &H80, &HC, &HF3, &HA5, &HB4
DATA &H0, &HC3, &H16, &HB8, &H3, &H0, &HCD, &H10, &HCD, &H20, &H0, &H0, &H0, &H0, &H0, &H2A, &H0, &H2A
DATA &H0, &H0, &H2A, &H2A, &H2A, &H0, &H0, &H2A, &H0, &H2A, &H2A, &H15, &H0, &H2A, &H2A, &H2A, &H15, &H15
DATA -1
' Basic Codefile created from  C:\EXAMPLE.COM

finished = 0
DO
  READ a
  IF a = -1 THEN
    finished = -1
      ELSE
    a$ = a$ + CHR$(a)
  END IF
LOOP UNTIL finished

SCREEN 0
WIDTH 80, 25
COLOR 7, 0
CLS

SCREEN 13

CALL absolute(VARSEG(a$))

WHILE INKEY$ = "": WEND

CLS

END


Although it's not perfect, it's a shell of what it looks like to use ASM in Qbasic.
The practice is correct, the execution is not, meaning the ASM routine hangs.
I'm not best at rewriting ASM yet, so the example ASM was from an automatically generated *.COM file, which displays a 320x200x256 graphic from the command line.

I will DEBUG up a tiny little ASM program, that plots a few points using BIOS calls, and follow up to this asap.



~Kiyote!

Posted: Sun Apr 03, 2011 9:00 pm
by Kiyotewolf
Call ScrnSave(
You can't call ASM language by the name of the routine.
You have to use MASM to take that routine that's the *.ASM file, get it into hex values, then do something similar to what I did above, and run it, using

CALL ABSOLUTE()



~Kiyote!

I have a perfect example to illustrate this. Will grab & brb, and it WORKS too.

Posted: Sun Apr 03, 2011 9:20 pm
by Kiyotewolf

Code: Select all


'Example of CALL ABSOLUTE and ASM language
DEFINT A-Z

TYPE REGTYPE 'Machine language interface
     AX    AS INTEGER
     BX    AS INTEGER
     CX    AS INTEGER
     DX    AS INTEGER
     BP    AS INTEGER
     SI    AS INTEGER
     DI    AS INTEGER
     FLAGS AS INTEGER
     DS    AS INTEGER
     ES    AS INTEGER
END TYPE
DIM SHARED REGS AS REGTYPE

DECLARE SUB INTERRUPT (INTNUM%, REGS AS REGTYPE)

'Other SUBs and FUNCTIONs
DECLARE SUB BackIntens (Setting%)

REDIM SHARED INTRPT(1 TO 50) 'Machine language interface
DEF SEG = VARSEG(INTRPT(1))
ADDRESS = VARPTR(INTRPT(1))
OPEN "c:\interupt.bin" FOR BINARY AS #1

DIM dummy AS STRING * 1

FOR i = 0 TO 99
    READ a
    POKE ADDRESS + i, a
    dummy = CHR$(a)
    PUT #1, , dummy
NEXT
CLOSE #1

Flash = 0

SCREEN 0
WIDTH 80, 25
COLOR 7, 0
CLS


BackIntens Flash 'Make sure colors flash


DEF SEG = &HB800
FOR x = 0 TO 15
  FOR y = 0 TO 15
    POKE x * 2 * 2 + y * 160, x + y * 16
    POKE x * 2 * 2 + y * 160 + 1, x + y * 16
  NEXT y
NEXT x

BackIntensTest = -1
IF BackIntensTest THEN
  Flash = -1
  FOR x = 0 TO 15
    FOR y = 0 TO 15
      LOCATE y + 1, x * 2 + 1
      COLOR x - 16 * Flash, y
      PRINT CHR$(254);
      COLOR x, y
      PRINT CHR$(254);
    NEXT
  NEXT
  DO
    WHILE INKEY$ = "": WEND
    BackIntens -1
    WHILE INKEY$ = "": WEND
    BackIntens 0
  LOOP
END IF

END

'Machine code for interrupt calling routine:
DATA 85                  : 'PUSH BP
DATA 139, 236            : 'MOV  BP, SP
DATA 86                  : 'PUSH SI
DATA 87                  : 'PUSH DI
DATA 30                  : 'PUSH DS
DATA 139, 118, 6         : 'MOV  SI, WORD PTR [BP+6]
DATA 139, 4              : 'MOV  AX, WORD PTR [SI]
DATA 139, 92, 2          : 'MOV  BX, WORD PTR [SI+2]
DATA 139, 76, 4          : 'MOV  CX, WORD PTR [SI+4]
DATA 139, 84, 6          : 'MOV  DX, WORD PTR [SI+6]
DATA 139, 108, 8         : 'MOV  BP, WORD PTR [SI+8]
DATA 139, 124, 12        : 'MOV  DI, WORD PTR [SI+12]
DATA 142, 68, 18         : 'MOV  ES, [SI+18]
DATA 255, 116, 10        : 'PUSH WORD PTR [SI+10]
DATA 131, 124, 18, 255   : 'CMP  WORD PTR [SI+18],-1
DATA 117, 2              : 'JNZ  LABEL1
DATA 30                  : 'PUSH DS
DATA 7                   : 'POP  ES
                         : 'LABEL1:
DATA 131, 124, 16, 255   : 'CMP  WORD PTR [SI+16],-1
DATA 116, 3              : 'JZ   LABEL2
DATA 142, 92, 16         : 'MOV DS, [SI+16]
                         : 'LABEL2:
DATA 94                  : 'POP  SI
DATA 205, 33             : 'INT 33
DATA 85                  : 'PUSH BP
DATA 139, 236            : 'MOV  BP, SP
DATA 30                  : 'PUSH DS
DATA 86                  : 'PUSH SI
DATA 142, 94, 2          : 'MOV DS, [BP+2]
DATA 139, 118, 14        : 'MOV SI, WORD PTR [BP+14]
DATA 137, 4              : 'MOV WORD PTR [SI], AX
DATA 137, 92, 2          : 'MOV WORD PTR [SI+2], BX
DATA 137, 76, 4          : 'MOV WORD PTR [SI+4], CX
DATA 137, 84, 6          : 'MOV WORD PTR [SI+6], DX
DATA 143, 68, 10         : 'POP WORD PTR [SI+10]
DATA 143, 68, 16         : 'POP WORD PTR [SI+16]
DATA 143, 68, 8          : 'POP WORD PTR [SI+8]
DATA 137, 124, 12        : 'MOV WORD PTR [SI+12], DI
DATA 140, 68, 18         : 'MOV WORD PTR [SI+18], ES
DATA 156                 : 'PUSHF
DATA 143, 68, 14         : 'POP WORD PTR [SI+14]
DATA 95                  : 'POP DI
DATA 95                  : 'POP DI
DATA 94                  : 'POP SI
DATA 93                  : 'POP BP
DATA 202, 2, 0           : 'RETF 2

SUB BackIntens (Setting)
  REGS.AX = &H1003
  IF Setting THEN
    REGS.BX = 0 'High intensity background
  ELSE
    REGS.BX = 1 'Flashing foreground
  END IF
  CALL INTERRUPT(&H10, REGS)
END SUB


SUB INTERRUPT (INTNUM, REGS AS REGTYPE)

  DEF SEG = VARSEG(INTRPT(1))'Point to buffer segment
  ADDRESS = VARPTR(INTRPT(1)) '  and offset
  POKE ADDRESS + 51, INTNUM   'Replace INT number in code
  CALL ABSOLUTE(REGS, ADDRESS) 'Call assembler routine.

END SUB


The above and the below, are two different worlds.
Your effort is very clean & intelligent, but you missed a couple points on getting it working right.

Below is the partial dissasembly of the routine that was loaded into QBasic and DOS's conventional memory.

Your example, would have us copy both into the same text file, then hit RUN in QBasic. It would not work that way.

THE ABOVE EXAMPLE IS COMPLETE, WORKING, so you CAN copy / paste into QBasic (NOT QUICKBASIC v4.5), and run it.

Code: Select all

C:\>debug interupt.bin
-u
5E17:0100 55            PUSH    BP
5E17:0101 8BEC          MOV     BP,SP
5E17:0103 56            PUSH    SI
5E17:0104 57            PUSH    DI
5E17:0105 1E            PUSH    DS
5E17:0106 8B7606        MOV     SI,[BP+06]
5E17:0109 8B04          MOV     AX,[SI]
5E17:010B 8B5C02        MOV     BX,[SI+02]
5E17:010E 8B4C04        MOV     CX,[SI+04]
5E17:0111 8B5406        MOV     DX,[SI+06]
5E17:0114 8B6C08        MOV     BP,[SI+08]
5E17:0117 8B7C0C        MOV     DI,[SI+0C]
5E17:011A 8E4412        MOV     ES,[SI+12]
5E17:011D FF740A        PUSH    [SI+0A]
-u
5E17:0120 837C12FF      CMP     WORD PTR [SI+12],-01
5E17:0124 7502          JNZ     0128
5E17:0126 1E            PUSH    DS
5E17:0127 07            POP     ES
5E17:0128 837C10FF      CMP     WORD PTR [SI+10],-01
5E17:012C 7403          JZ      0131
5E17:012E 8E5C10        MOV     DS,[SI+10]
5E17:0131 5E            POP     SI
5E17:0132 CD21          INT     21
5E17:0134 55            PUSH    BP
5E17:0135 8BEC          MOV     BP,SP
5E17:0137 1E            PUSH    DS
5E17:0138 56            PUSH    SI
5E17:0139 8E5E02        MOV     DS,[BP+02]
5E17:013C 8B760E        MOV     SI,[BP+0E]
5E17:013F 8904          MOV     [SI],AX
-u
5E17:0141 895C02        MOV     [SI+02],BX
5E17:0144 894C04        MOV     [SI+04],CX
5E17:0147 895406        MOV     [SI+06],DX
5E17:014A 8F440A        POP     [SI+0A]
5E17:014D 8F4410        POP     [SI+10]
5E17:0150 8F4408        POP     [SI+08]

[/quote]

Posted: Sun Apr 03, 2011 9:22 pm
by Kiyotewolf
NOTE: if you run the program in a DOS Window, you have to hit ALT-ENTER to go FULLSCREEN to see the effect of the program.
Otherwise it will override the blink function of a DOS text screen, and you won't see the effects of the program running.

Press CTRL-BREAK or CTRL-C or CTRL-SCROLLLOCK to exit the program, which ever key combination your keyboard requires.



~Kiyote!

Posted: Mon Apr 04, 2011 1:04 am
by Anonymous
this is great. I have myself a utility that converts my assembled com files into compact QB code using call absolute.

Code: Select all

DIM a AS LONG
DIM i AS INTEGER
CLS
ON ERROR GOTO 1
f$ = COMMAND$
IF f$ = "" THEN
  PRINT "syntax: asm.exe arrayname pathto.com"
  SYSTEM
END IF
f$ = LTRIM$(RTRIM$(f$))
FOR i = 1 TO LEN(f$)
  IF MID$(f$, i, 1) = " " THEN EXIT FOR
  s$ = s$ + MID$(f$, i, 1)
NEXT
s$ = LCASE$(s$)
l = LEN(f$)
f$ = RIGHT$(f$, l - i)
i = 0
OPEN f$ FOR BINARY AS #1
  DO
    GET #1, , a
    i = i + 1
  LOOP UNTIL EOF(1)
CLOSE
PRINT "dim " + s$ + "(" + LTRIM$(STR$(i - 1)) + ") as long"
i = 0
OPEN f$ FOR BINARY AS #1
  DO
    GET #1, , a
    PRINT s$ + "(" + LTRIM$(STR$(i)) + ")=" + "&H" + HEX$(a) '+ CHR$(10)
    i = i + 1
  LOOP UNTIL EOF(1)
CLOSE
SYSTEM
1 PRINT "error"
SYSTEM

Here is my personal mouse routine that I use in most of my programs. It even works with QB64.

Code: Select all

DIM mb AS INTEGER, mx AS INTEGER, my AS INTEGER
DIM a(7) AS LONG
a(0) = &H8BE58955
a(1) = &H48B0C76
a(2) = &H768B33CD
a(3) = &H8B1C890A
a(4) = &HC890876
a(5) = &H8906768B
a(6) = &H8CA5D14
DEF SEG = VARSEG(a(0))

SCREEN 12
CALL absolute(1, mb, mx, my, VARPTR(a(0)))

DO
   CALL absolute(3, mb, mx, my, VARPTR(a(0)))
   LOCATE 1, 1
   PRINT mb, mx, my
LOOP UNTIL INP(&H60) = 1
SYSTEM

This is the program I use to find my way around in DOS

Code: Select all

DEFINT A-Z
TYPE dtatype
   reserved AS STRING * 21
   a AS STRING * 1
   time AS INTEGER
   date AS STRING * 2
   size AS LONG
   n AS STRING * 13
END TYPE
TYPE filetype
   n AS STRING * 13
   a AS STRING * 1
END TYPE

DIM n(19) AS LONG
n(0) = &H1EE58955
n(1) = &HB80656C5
n(2) = &H21CD1A00
n(3) = &H4CA5D1F
n(5) = &H8BE58955
n(6) = &H4E8B0656
n(7) = &HA768B08
n(8) = &H21CD048B
n(9) = &HCA5D0489
n(10) = &H6
n(11) = &H8BE58955
n(12) = &H33CD0C46
n(13) = &H890A768B
n(14) = &H8768B1C
n(15) = &H4103E9C1
n(16) = &H768B0C89
n(17) = &H3EAC106
n(18) = &H5D148942
n(19) = &H8CA
DEF SEG = VARSEG(n(0))

DIM f(500) AS filetype
DIM dta AS dtatype
CALL absolute(SEG dta, VARPTR(n(0)))
d$ = "c:\"
d$ = "d:\"
1 CLS
COLOR 14
VIEW PRINT 1 TO 25

FOR i = 1 TO 23
   LOCATE i, 20
   PRINT STRING$(10, 25 + (i <= 11))
NEXT

CALL absolute(BYVAL 1, mb, mx, my, VARPTR(n(11)))

j = 0
ax = &H4E00
e$ = d$ + "*.*" + CHR$(0)
CALL absolute(ax, BYVAL 16, BYVAL SADD(e$), VARPTR(n(5)))
FOR i = 0 TO UBOUND(f)
   ax = &H4F00
   CALL absolute(ax, 0, 0, VARPTR(n(5)))
   IF (ax AND &HF) <> 0 THEN EXIT FOR
   file$ = LEFT$(dta.n, INSTR(dta.n, CHR$(0)) - 1)
   f(i).n = file$
   ' PRINT file$, dta.date
   f(i).a = dta.a
   ' SLEEP
NEXT
n = i
' SYSTEM

DO
   CALL absolute(BYVAL 3, mb, mx, my, VARPTR(n(11)))

   LOCATE 1, 1
   FOR i = 0 + j TO 22 + j
   IF i < n THEN PRINT CHR$(-((i - j + 1) = my) * 16) + CHR$(92 * -(f(i).a = CHR$(16))) + f(i).n + CHR$(-((i - j + 1) = my) * 17)
   NEXT
   LOCATE 25
   IF (my + j - 1) < n THEN PRINT d$ + f(my + j - 1).n;

   IF mb = 1 THEN
      IF mx < 17 AND f(my + j - 1).a = CHR$(16) AND (my + j - 1) < n THEN
         DO UNTIL mb = 0
            CALL absolute(BYVAL 3, mb, mx, my, VARPTR(n(11)))
         LOOP
         d$ = d$ + RTRIM$(f(my + j - 1).n) + "\"
         GOTO 1
      ELSE
         t! = TIMER
         j = j + (mx > 19 AND mx < 30) * (my > 11) AND ((j + 22) < n)
         j = j - (mx > 19 AND mx < 30) * (my < 11) AND (j > 0)
2 IF TIMER < (t! + .1) THEN 2
      END IF
   END IF

LOOP UNTIL INP(&H60) = 1
SYSTEM


Posted: Mon Apr 04, 2011 1:15 am
by Kiyotewolf
Wow you're good! These are awesome!



~Kiyote!

Posted: Mon Apr 04, 2011 1:19 am
by Kiyotewolf
Does your *.COM file packer have to alter how the *.COM file terminates?
I am not fluent in 8086 (80686) ASM, and I've seen various exit, RETF commands RETN commands, that are the last thing before exiting a *.COM vs the last thing before exiting a ASM routine in QB, especially if passing variables.

Usually there's a RETF two bytes after, that designate how many bytes to return on the stack when exiting.

Does your packer modify anything when it's converting it to a QB source file?



~Kiyote!

Posted: Mon Apr 04, 2011 4:09 pm
by Anonymous
Kiyotewolf wrote:Does your *.COM file packer have to alter how the *.COM file terminates?
I am not fluent in 8086 (80686) ASM, and I've seen various exit, RETF commands RETN commands, that are the last thing before exiting a *.COM vs the last thing before exiting a ASM routine in QB, especially if passing variables.

Usually there's a RETF two bytes after, that designate how many bytes to return on the stack when exiting.

Does your packer modify anything when it's converting it to a QB source file?



~Kiyote!
It does not modify the com file, but this requires that the RETF is included in the com file and that you yourself know how many bytes to return to stack, etc.

I'm going to post one of my programs that BLOADs a raw binary file and that excutes it with CALL ABSOLUTE.

Posted: Mon Apr 04, 2011 4:20 pm
by Anonymous
Here is a font routine I use for some of my good programs. It uses a font file that is only about 1kb and it includes the font data for characters 32 - 126 and in the font file also included the machine code to display it on screen quickly.

It is much quicker then the BIOS font and more flexible with coordinates, but it is limited in some ways seeing as it is my personal font routine which I made for my own needs.

You need the 1kb font file:
http://qbasic.orgfree.com/FONT.F

Code: Select all

DEFINT A-Z
DECLARE SUB printf (x, y, s$)
DIM SHARED font(282) AS LONG
DEF SEG = VARSEG(font(0))
BLOAD "font.f", VARPTR(font(0))

SCREEN 12

LINE (50, 50)-(250, 250), 15, BF

FOR i = 0 TO 450 STEP 15
printf 0, i, "abcdefghijklmnopqrsSDGASAF~!@#$%#@%^43562345@!#$ HELLO WORLD!!!!!!!!!!!"
NEXT

SLEEP

SUB printf (x, y, s$)
CALL absolute(BYVAL x, BYVAL y, BYVAL VARPTR(s$), SEG font(0), VARPTR(font(262)))
END SUB

Posted: Mon Apr 04, 2011 5:33 pm
by Kiyotewolf
"but it is limited in some ways seeing as it is my personal font routine which I made for my own needs. "

Can't do everything with everything.
Did you write the ASM in the routine?
This is slick. This is very slick! I'd like to try using this on my own *.BAS's.
I've always been on the outside looking in when it came to ASM on an IBM compatible.
On an 6502, I can program it in ASM like you wouldn't believe. I'm a whiz, or at least I know enough to be able to read and write and modify code.
On 8088 (meaning 80686 now..), I've only just a few months ago begun to understand a few more ASM concepts. Mike Chambers has been doing an 8086/80186 Fake86 emulator, and talking a bit to him has made me a bit braver and a bit wiser on just the simple hows and whys.

Yesterday I was even typing in actual opcode names in DEBUG to get the HEX values back out.
Not writing code mind you, just finding out which OPCODE went with which machine code.

I guess what really grinds my gears, is the fact that I can't ever seem to find a piece of paper that has the 8086 (yes I mean simply the 8086 & or 8088) opcodes, listed, and then how many operands they use per operation mode, so I could sit there and write machine code (HEX values to plug into a QBasic program natively) by hand with a pencil.
I'd try just writing in DEBUG, but how do you take a script in ASM written for MASM or TASM and then dumb it down and strip it of the markings, so that DEBUG accepts it??
I don't know what legal syntax DEBUG has for entering ASM, I mean the exact grammer you need to use, so I can successfully translate some MASM ASM scripts into plain vanilla assembly language

MOV AX,0000

type instructions. I hang up when I get to jump points which are labels

JUMPPOINT;

and don't know how to replace those with the proper OPCODE and the jump vector in the HEX right after.



~Kiyote!

I see what your saying here

Posted: Mon Apr 04, 2011 9:54 pm
by TRANERAECK
I tried making a big post but see what you are saying and I received Internal server error.

Posted: Tue Apr 05, 2011 12:10 am
by Kiyotewolf
On the internal server error, either try reposting, or host it somewhere else, and link to it.
Do you need some free hosting space recommendations?
I can PM you websites that are easy to use & free with lots of perks.



~Kiyote!