17 byte demo! in pascal

Index > High Level Languages > 17 byte demo! in pascal

Goto page 1, 2 Next

Author

Thread

arcangel

Joined: 19 Aug 2009
Posts: 39

arcangel 30 Jan 2014, 19:45

I found this little demo

http://board.flatassembler.net/topic.php?t=9147

Code:

use16 
org 0x100 
mov ax,0x13 
int 0x10 
push word 0xA000 
pop es 
paint: 
adc ax, cx 
stosb 
loop paint 
inc ax 
jmp paint

And I've added to my favorite language, Pascal

Code:

uses dos,crt;
var regs:registers;
var pantalla: array [1..64000] of byte absolute $A000:0000;
label paint;
procedure setVideo;
begin
asm;
mov ax,$13
int $10
end;
end;

begin
setVideo;

with regs do begin
ah:=$0a0;
es:=ax;
paint:
repeat

ax := ax + cx;

pantalla[di]:=al;

inc(di);
dec(cx);
until cx<>0;
inc(ax);
if not keypressed then goto paint;
end;
end.

But not implement the instruction well adc ax, cx does anyone could help me?

30 Jan 2014, 19:45

sid123

Joined: 30 Jul 2013
Posts: 339
Location: Asia, Singapore

sid123 31 Jan 2014, 00:11

ADC is the same as ADD but adds an extra 1 if the carry flag is set. Wink

31 Jan 2014, 00:11

revolution
When all else fails, read the source

Joined: 24 Aug 2004
Posts: 20306
Location: In your JS exploiting you and your system

revolution 31 Jan 2014, 00:26

Code:

if (ax+cx) < ax then newcarryflag=1 else newcarryflag=0
ax := ax + cx + oldcarryflag;
oldcarryflag = newcarryflag;

I don't know pascal so you will probably need to pascalise the if statement.
_______________________________________________________

Also, this looks wrong to me:

Code:

until cx<>0;

31 Jan 2014, 00:26

typedef

Joined: 25 Jul 2010
Posts: 2909
Location: 0x77760000

typedef 31 Jan 2014, 03:35

revolution wrote:

Also, this looks wrong to me:
Code:
until cx<>0;    

<> is the same as !=

31 Jan 2014, 03:35

revolution
When all else fails, read the source

Joined: 24 Aug 2004
Posts: 20306
Location: In your JS exploiting you and your system

revolution 31 Jan 2014, 03:39

typedef wrote:

revolution wrote:
Also, this looks wrong to me:
Code:
until cx<>0;    
<> is the same as !=

But the condition is wrong. Should it be ==? If it was a while then "while cx <> 0" would be sensible.

31 Jan 2014, 03:39

arcangel

Joined: 19 Aug 2009
Posts: 39

arcangel 31 Jan 2014, 10:24

With the explanations that you give to me. The program shows that way and works.

Code:

uses dos,crt;
var regs:registers;
var pantalla: array [1..64000] of byte absolute $A000:0000;
var newcarryflag, oldcarryflag : integer;
label paint;
procedure setVideo;
begin
asm;
mov ax,$13
int $10
end;
end;
var i : integer;
begin
oldcarryflag := 0;
setVideo;

with regs do begin
ah:=$0a0;
es:=ax;
paint:

repeat

if ((ax+cx) < ax) then newcarryflag:=1 else newcarryflag:=0;

oldcarryflag := newcarryflag;

ax := ax + cx + oldcarryflag;


pantalla[di]:=al;

inc(di);
dec(cx);
until cx=0;
inc(ax);
if not keypressed then goto paint;
end;
end.

thank you very much

31 Jan 2014, 10:24

arcangel

Joined: 19 Aug 2009
Posts: 39

arcangel 31 Jan 2014, 10:39

Changing the palette it shows a beautiful effect of water drops Smile

Code:

uses dos,crt;

var regs:registers;
var pantalla: array [1..64000] of byte absolute $A000:0000;
var newcarryflag, oldcarryflag, i : integer;

label paint;

procedure setVideo;
begin
asm;
mov ax,$13
int $10
end;
end;


procedure setrgbpalette(i,r,g,b : byte);
begin
asm;
mov dx,3c8h;
mov al,i;
out dx,al;
inc dx;
mov al,r;
out dx,ax;
mov al,g;
out dx,al;
mov al,b;
out dx,al;
end;
end;

begin
oldcarryflag := 0;
setVideo;

i:=0;
repeat
setrgbpalette(i,0,0,lo(i) shr 2);
inc(i);
until i=0;

with regs do begin
ah:=$0a0;
es:=ax;
paint:

repeat

if ((ax+cx) < ax) then newcarryflag:=1 else newcarryflag:=0;

oldcarryflag := newcarryflag;

ax := ax + cx + oldcarryflag;


pantalla[di]:=al;

inc(di);
dec(cx);
until cx=0;
inc(ax);
if not keypressed then goto paint;
end;
end.

Thank you again

31 Jan 2014, 10:39

revolution
When all else fails, read the source

Joined: 24 Aug 2004
Posts: 20306
Location: In your JS exploiting you and your system

revolution 31 Jan 2014, 10:50

arcangel: When you move the "oldcarryflag := newcarryflag;" line above the addition line then you are nullifying the point of having separate old and new carry flags, and also fail to properly emulate the adc instruction from the original source.

I never realised just how difficult it was in C to deal with overflows and carries until I read this page:

http://www.fefe.de/intof.html

[troll bait]Also note how the document describes this working with AMD CPUs. I thought the idea of HLLs was to be portable and not have to consider what the underlying architecture was? I guess I was mistaken and now see that HLLs are just a platform dependent as assembly.[/troll bait]

31 Jan 2014, 10:50

revolution
When all else fails, read the source

Joined: 24 Aug 2004
Posts: 20306
Location: In your JS exploiting you and your system

revolution 31 Jan 2014, 10:57

Hehe, I just realised the above is also incorrect. Perhaps this will be a more accurate emulation of adc:

Code:

if (cx=0 AND oldcarryflag=0) then newcarryflag:=0 else if ((ax+cx+oldcarryflag) <= ax) then newcarryflag:=1 else newcarryflag:=0;
ax := ax + cx + oldcarryflag;
oldcarryflag := newcarryflag;

I hope this is correct now. I couldn't test it. Sad

31 Jan 2014, 10:57

arcangel

Joined: 19 Aug 2009
Posts: 39

arcangel 31 Jan 2014, 21:13

Both codes are working the same. Adding the addition at the end.

Code:

if (ax+cx) < ax then newcarryflag=1 else newcarryflag=0 
oldcarryflag = newcarryflag;
ax := ax + cx + oldcarryflag;

Code:

if (cx=0 AND oldcarryflag=0) then newcarryflag:=0 else if ((ax+cx+oldcarryflag) <= ax) then newcarryflag:=1 else newcarryflag:=0;

oldcarryflag := newcarryflag;
ax := ax + cx + oldcarryflag;

This code is pure Pascal and it works Twisted Evil

Code:

uses crt;

var pantalla: array [1..64000] of byte absolute $A000:0000;

var newcarryflag, oldcarryflag, loop, counter, indice : integer;

procedure setVideo;
begin
asm;
mov ax,$13
int $10
end;
end;

begin

oldcarryflag := 0;

loop := 0;

counter := 0;

indice := 0;

setVideo;

repeat

repeat

if ((counter+loop) < counter) then newcarryflag := 1 else newcarryflag := 0;

oldcarryflag := newcarryflag;

counter := counter + loop + oldcarryflag;

pantalla[indice] := counter;

inc(indice);

dec(loop);

until loop=0;

inc(counter);

until keypressed;

end.

Thank you very much Very Happy

31 Jan 2014, 21:13

arcangel

Joined: 19 Aug 2009
Posts: 39

arcangel 31 Jan 2014, 21:37

This code is intended for Pachi Twisted Evil

Code:

program demo;

var auxiliary, carryflag, counter, color, indice : integer;

label loop0,loop1,exit;

procedure setVideo13;
begin
asm;
mov ax,$13
int $10
end;
end;

procedure putPixel(indice:integer;color:byte);
begin
asm;
      push ax
      mov ax, $A000
      mov es, ax
      mov di, indice
      mov al, color
      mov es:[di], al
      pop ax
end;
end;

begin

carryflag := 0;

counter := 0;

color := 0;

indice := 0;

setVideo13;

loop0:

loop1:

auxiliary := 0;

inc(auxiliary,color);

inc(auxiliary,counter);

carryflag := 0;

if auxiliary < color then inc(carryflag,1);

inc(color, counter);

inc(color, carryflag);

putPixel(indice,color);

inc(indice,1);

dec(counter,1);

if counter <> 0 then goto loop1;

inc(color,1);

goto loop0;

exit:

end.

Pachi: https://sites.google.com/site/bluedragonos1/

31 Jan 2014, 21:37

arcangel

Joined: 19 Aug 2009
Posts: 39

arcangel 01 Feb 2014, 15:30

Code:

#fasm#

org  100h

mov ax, 0 ; carryflag := 0;  

mov bx, 0 ; counter := 0;  

mov cx, 0 ; color := 0;  

mov dx, 0 ; indice := 0;  

; setVideo13;  

mov ax,$13
int $10

; fin setVideo13;  

loop0:

loop1:

mov si, 0 ; auxiliary := 0;  

add si, cx ; inc(auxiliary,color);  

add si, bx ; inc(auxiliary,counter);  

mov ax, 0 ; carryflag := 0;  

cmp si, cx

ja jmpIF ; if auxiliary < color then inc(carryflag,1);  

add ax, 1

jmpIF:

add cx, bx ; inc(color, counter);  

add cx, ax ; inc(color, carryflag);  

; putPixel(indice,color);  

      push ax
      mov ax, $A000
      mov es, ax
      mov di, dx ; indice  
      mov ax, cx ; color  
      mov [di], al
      pop ax

; fin putPixel  

add dx, 1 ; inc(indice,1);  

sub bx, 1 ; dec(counter,1);  

cmp bx, 0

; if counter <> 0 then goto loop1;  

jne loop1

add cx, 1 ; inc(color,1);  

jmp loop0 ; goto loop0;  

exit:


ret

This code does not work, but do not know why. Crying or Very sad

Does anyone know? Rolling Eyes

01 Feb 2014, 15:30

arcangel

Joined: 19 Aug 2009
Posts: 39

arcangel 01 Feb 2014, 18:00

This code works

Code:

label jmpIF, loop0, loop1, exit;

begin

asm;

mov ax, 0 { carryflag := 0 }

mov bx, 0 { counter := 0 }

mov cx, 0 { color := 0 }

mov dx, 0 { indice := 0 }

{setVideo13 }

mov ax,$13
int $10

{fin setVideo13 }

loop0:

loop1:

mov si, 0 { auxiliary := 0 }

add si, cx { inc(auxiliary,color) }

add si, bx { inc(auxiliary,counter) }

mov ax, 0 { carryflag := 0 }

cmp si, cx

ja jmpIF { if auxiliary < color then inc(carryflag,1) }

add ax, 1

jmpIF:

add cx, bx { inc(color, counter) }

add cx, ax { inc(color, carryflag) }

{ putPixel(indice,color) }

      push ax
      mov ax, $A000
      mov es, ax
      mov di, dx { indice }
      mov ax, cx { color }
      mov es:[di], al
      pop ax

{ fin putPixel }

add dx, 1 { inc(indice,1) }

sub bx, 1 { dec(counter,1) }

cmp bx, 0

{ if counter <> 0 then goto loop1 }

jne loop1

add cx, 1 { inc(color,1) }

jmp loop0 { goto loop0 }

exit:

end;
end.

The difference is:

PASCAL

Code:

      mov ax, cx { color }
      mov es:[di], al

FASM

Code:

      mov ax, cx ; color   
      mov [di], al

I'm doing something wrong, but What?

01 Feb 2014, 18:00

LocoDelAssembly
Your code has a bug

Joined: 06 May 2005
Posts: 4624
Location: Argentina

LocoDelAssembly 02 Feb 2014, 00:24

"mov [es:di], al"?

02 Feb 2014, 00:24

LocoDelAssembly
Your code has a bug

Joined: 06 May 2005
Posts: 4624
Location: Argentina

LocoDelAssembly 02 Feb 2014, 04:48

BTW, could you write and run a test to confirm that your ADC code is actually equivalent? Here I have more complicated alternatives:

Code:

procedure adc(var dest: word; const src: word; const cin: boolean; var cout: boolean);
var
  temp: word;
  bit15_16: word;
begin
  temp     := (dest and $7FFF) + (src and $7FFF) + Ord(cin);
  bit15_16 := (dest shr 15) + (src shr 15) + (temp shr 15);
  dest     := temp + (bit15_16 shl 15);
  cout     := bit15_16 > 1;
end;

{ Or just cheat }
procedure simple_adc(var dest: word; const src: word; const cin: boolean; var cout: boolean);
var
  temp: Longint;
begin
  temp := Longint(dest) + Longint(src) + Ord(cin);
  dest := word(temp); { You may use word(temp and $FFFF) if you think this sentence could produce different result}
  cout := temp > $FFFF;
end;

02 Feb 2014, 04:48

arcangel

Joined: 19 Aug 2009
Posts: 39

arcangel 02 Feb 2014, 09:36

Quote:

"mov [es:di], al"?

It would be a pleasure to see your code snippets

But the mode may be rewritten

function adc(ax,cx:integer):integer;

function adc_simple(ax,cx:integer):integer;

thanks

02 Feb 2014, 09:36

arcangel

Joined: 19 Aug 2009
Posts: 39

arcangel 02 Feb 2014, 09:48

Very interesting:

PASCAL

PascalMania http://www.oocities.org/ar/nrs_arg/pascalmania/sources.htm

FUNDAMENTOS http://www.oocities.org/siliconvalley/code/2632/d_funda.htm#pixel

JUEGOS http://www.oocities.org/siliconvalley/code/2632/

JUEGOS http://www.pacop.net/curso-de-programacion-de-videojuegos-cpv.html

SVGA MB!! MB!! https://github.com/romiras/turbo-pascal-archive/tree/master/Graphics/SVGA

SVGA ftp://ftp.lanet.lv/pub/programming/mirror-x2ftp/libs/

svgabg55.zip

ASM

Macedonia http://macedoniamagazine.frodrig.com/aulak.htm

Ensamblador 8086 Modo 13h Memoria para GrÃ¡ficos
http://tipsparaisc.blogspot.com.es/2012/04/ensamblador-8086-modo-13h-memoria-para.html

MODO DE VIDEO 13H http://www.investigacion.frc.utn.edu.ar/labsis/Publicaciones/InvesDes/3deng/Intro/13h.htm

02 Feb 2014, 09:48

LocoDelAssembly
Your code has a bug

Joined: 06 May 2005
Posts: 4624
Location: Argentina

LocoDelAssembly 02 Feb 2014, 20:11

Quote:

function adc(ax,cx:integer):integer;

function adc_simple(ax,cx:integer):integer;

Three inputs and two outputs are needed, otherwise the CF is lost. cin and cout could be just "var cf: boolean".

Code:

function adc(ax,cx: integer; var cf: boolean): integer;
var
  temp: integer;
  bit15_16: integer;
begin
  temp     := (ax and $7FFF) + (cx and $7FFF) + Ord(cf);
  bit15_16 := (ax shr 15) + (cx shr 15) + (temp shr 15);
  cf       := bit15_16 < -1; { I'm assuming that shr behaves like x86's sar on integer type }
  adc      := temp xor (bit15_16 shl 15);
end;

02 Feb 2014, 20:11

arcangel

Joined: 19 Aug 2009
Posts: 39

arcangel 02 Feb 2014, 21:07

Code:

uses dos,crt; 
var regs:registers; 
var pantalla: array [1..64000] of byte absolute $A000:0000; 
 
label paint; 
procedure setVideo; 
begin 
asm; 
mov ax,$13 
int $10 
end; 
end; 

function adc(ax,cx: integer; var cf: boolean): integer; 
var 
  temp: integer; 
  bit15_16: integer; 
begin 
  temp     := (ax and $7FFF) + (cx and $7FFF) + Ord(cf);
  bit15_16 := (ax shr 15) + (cx shr 15) + (temp shr 15);
  cf       := bit15_16 < -1; { I'm assuming that shr behaves like x86's sar on integer type }
  adc      := temp xor (bit15_16 shl 15);
end;

var i : integer;
    carryflag : boolean;
begin

setVideo;

with regs do begin
ah:=$0a0;
es:=ax;
paint:

repeat

adc(ax,cx,carryflag);

ax := ax + cx;

if carryflag then ax := ax +1;

pantalla[di]:=al;

inc(di); 
dec(cx); 
until cx=0; 
inc(ax); 
if not keypressed then goto paint; 
end; 
end.

not working Sad

02 Feb 2014, 21:07

LocoDelAssembly
Your code has a bug

Joined: 06 May 2005
Posts: 4624
Location: Argentina

LocoDelAssembly 03 Feb 2014, 00:37

Not sure if it works as I cannot run anything here, but I'd implement the original asm code in the following way (making use of the Registers record just to keep the style):

Code:

uses dos,crt;
var regs: registers;
var pantalla: array [1..64000] of byte absolute $A000:0000; 
 
procedure setVideo;
begin 
  regs.ax := $13;
  Intr($10, regs); { The original demo is affected by the returned value in AX and maybe CF, that is why I replaced the asm code }
end;

procedure adc;
var { Registers' members are defined as Word for 16-bit registers, so I'll use the same type here }
  temp: Word;
  bit15_16: Word;
begin
  with regs do begin
    temp     := (ax and $7FFF) + (cx and $7FFF) + (flags and 1);
    bit15_16 := (ax shr 15) + (cx shr 15) + (temp shr 15);
    ax       := temp xor (bit15_16 shl 15);
    flags    := (flags and $FFFE) or Ord(bit15_16 > 1);
  end
end;

begin
  with regs do begin
    { Make sure these regs are zero like a COM executable at entry point }
    cx := 0;
    di := 0;

    setVideo;

    { Not actually being used for anything, in fasm replace with push $A000 / pop es }
    es := $A000;

    repeat
      repeat
        adc;
        pantalla[di] := al; { This is not using es at all, but in fasm version you would use it }
        inc(di);
        dec(cx);
      until cx = 0;
      inc(ax);
    until keypressed;
  end;
end.

03 Feb 2014, 00:37

Goto page 1, 2 Next

< Last Thread | Next Thread >

Forum Rules:

You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
You cannot attach files in this forum
You can download files in this forum