flat assembler
Message board for the users of flat assembler.
 Home   FAQ   Search   Register 
 Profile   Log in to check your private messages   Log in 
flat assembler > High Level Languages > 17 byte demo! in pascal

Goto page 1, 2  Next
Author
Thread Post new topic Reply to topic
arcangel



Joined: 19 Aug 2009
Posts: 39
17 byte demo! in pascal
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 axcx 
stosb 
loop paint 
inc ax 
jmp paint



And I've added to my favorite language, Pascal


Code:
uses dos,crt;
var regs:registers;
var pantallaarray [1..64000of 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?
Post 30 Jan 2014, 19:45
View user's profile Send private message Reply with quote
sid123



Joined: 30 Jul 2013
Posts: 340
Location: Asia, Singapore
ADC is the same as ADD but adds an extra 1 if the carry flag is set. Wink
Post 31 Jan 2014, 00:11
View user's profile Send private message Reply with quote
revolution
When all else fails, read the source


Joined: 24 Aug 2004
Posts: 14783
Location: Not in LAX

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;

Post 31 Jan 2014, 00:26
View user's profile Send private message Visit poster's website Reply with quote
typedef



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

revolution wrote:
Also, this looks wrong to me:

Code:
until cx<>0;




<> is the same as !=
Post 31 Jan 2014, 03:35
View user's profile Send private message Reply with quote
revolution
When all else fails, read the source


Joined: 24 Aug 2004
Posts: 14783
Location: Not in LAX

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.
Post 31 Jan 2014, 03:39
View user's profile Send private message Visit poster's website Reply with quote
arcangel



Joined: 19 Aug 2009
Posts: 39
With the explanations that you give to me. The program shows that way and works.


Code:
uses dos,crt;
var regs:registers;
var pantallaarray [1..64000of byte absolute $A000:0000;
var newcarryflagoldcarryflag : 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) < axthen 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
Post 31 Jan 2014, 10:24
View user's profile Send private message Reply with quote
arcangel



Joined: 19 Aug 2009
Posts: 39
Changing the palette it shows a beautiful effect of water drops Smile


Code:
uses dos,crt;

var regs:registers;
var pantallaarray [1..64000of byte absolute $A000:0000;
var newcarryflagoldcarryflagi : 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(ishr 2);
inc(i);
until i=0;

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

repeat

if ((ax+cx) < axthen 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
Post 31 Jan 2014, 10:39
View user's profile Send private message Reply with quote
revolution
When all else fails, read the source


Joined: 24 Aug 2004
Posts: 14783
Location: Not in LAX
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]
Post 31 Jan 2014, 10:50
View user's profile Send private message Visit poster's website Reply with quote
revolution
When all else fails, read the source


Joined: 24 Aug 2004
Posts: 14783
Location: Not in LAX
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=0then newcarryflag:=0 else if ((ax+cx+oldcarryflag) <= axthen newcarryflag:=1 else newcarryflag:=0;
ax := ax + cx + oldcarryflag;
oldcarryflag := newcarryflag;

I hope this is correct now. I couldn't test it. Sad
Post 31 Jan 2014, 10:57
View user's profile Send private message Visit poster's website Reply with quote
arcangel



Joined: 19 Aug 2009
Posts: 39
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=0then newcarryflag:=0 else if ((ax+cx+oldcarryflag) <= axthen 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 pantallaarray [1..64000of byte absolute $A000:0000;

var newcarryflagoldcarryflagloopcounterindice : 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) < counterthen 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
Post 31 Jan 2014, 21:13
View user's profile Send private message Reply with quote
arcangel



Joined: 19 Aug 2009
Posts: 39
This code is intended for Pachi Twisted Evil


Code:
program demo;

var auxiliarycarryflagcountercolorindice : 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 esax
      mov diindice
      mov alcolor
      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(colorcounter);

inc(colorcarryflag);

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/
Post 31 Jan 2014, 21:37
View user's profile Send private message Reply with quote
arcangel



Joined: 19 Aug 2009
Posts: 39

Code:
#fasm#

org  100h

mov ax0 ; carryflag := 0;  

mov bx0 ; counter := 0;  

mov cx0 ; color := 0;  

mov dx0 ; indice := 0;  

; setVideo13;  

mov ax,$13
int $10

; fin setVideo13;  

loop0:

loop1:

mov si0 ; auxiliary := 0;  

add sicx ; inc(auxiliary,color);  

add sibx ; inc(auxiliary,counter);  

mov ax0 ; carryflag := 0;  

cmp sicx

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

add ax1

jmpIF:

add cxbx ; inc(color, counter);  

add cxax ; inc(color, carryflag);  

; putPixel(indice,color);  

      push ax
      mov ax$A000
      mov esax
      mov didx ; indice  
      mov axcx ; color  
      mov [di], al
      pop ax

; fin putPixel  

add dx1 ; inc(indice,1);  

sub bx1 ; dec(counter,1);  

cmp bx0

; if counter <> 0 then goto loop1;  

jne loop1

add cx1 ; 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
Post 01 Feb 2014, 15:30
View user's profile Send private message Reply with quote
arcangel



Joined: 19 Aug 2009
Posts: 39
This code works


Code:
label jmpIFloop0loop1exit;

begin

asm;

mov ax0 { carryflag := 0 }

mov bx0 { counter := 0 }

mov cx0 { color := 0 }

mov dx0 { indice := 0 }

{setVideo13 }

mov ax,$13
int $10

{fin setVideo13 }

loop0:

loop1:

mov si0 { auxiliary := 0 }

add sicx { inc(auxiliary,color) }

add sibx { inc(auxiliary,counter) }

mov ax0 { carryflag := 0 }

cmp sicx

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

add ax1

jmpIF:

add cxbx { inc(colorcounter) }

add cxax { inc(colorcarryflag) }

putPixel(indice,color) }

      push ax
      mov ax$A000
      mov esax
      mov didx { indice }
      mov axcx { color }
      mov es:[di], al
      pop ax

fin putPixel }

add dx1 { inc(indice,1) }

sub bx1 { dec(counter,1) }

cmp bx0

if counter <> 0 then goto loop1 }

jne loop1

add cx1 { inc(color,1) }

jmp loop0 { goto loop0 }

exit:

end;
end.




The difference is:

PASCAL


Code:
      mov axcx { color }
      mov es:[di], al



FASM


Code:
      mov axcx ; color   
      mov [di], al



I'm doing something wrong, but What?
Post 01 Feb 2014, 18:00
View user's profile Send private message Reply with quote
LocoDelAssembly
Your code has a bug


Joined: 06 May 2005
Posts: 4641
Location: Argentina
"mov [es:di], al"?
Post 02 Feb 2014, 00:24
View user's profile Send private message Reply with quote
LocoDelAssembly
Your code has a bug


Joined: 06 May 2005
Posts: 4641
Location: Argentina
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 destword; const src: word; const cin: boolean; var cout: boolean);
var
  tempword;
  bit15_16word;
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 destword; const src: word; const cin: boolean; var cout: boolean);
var
  tempLongint;
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;

Post 02 Feb 2014, 04:48
View user's profile Send private message Reply with quote
arcangel



Joined: 19 Aug 2009
Posts: 39
I do not understand the code

Quote:
"mov [es:di], al"?



ok Smile

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
Post 02 Feb 2014, 09:36
View user's profile Send private message Reply with quote
arcangel



Joined: 19 Aug 2009
Posts: 39
Post 02 Feb 2014, 09:48
View user's profile Send private message Reply with quote
LocoDelAssembly
Your code has a bug


Joined: 06 May 2005
Posts: 4641
Location: Argentina

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,cxinteger; var cf: boolean): integer;
var
  tempinteger;
  bit15_16integer;
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;

Post 02 Feb 2014, 20:11
View user's profile Send private message Reply with quote
arcangel



Joined: 19 Aug 2009
Posts: 39

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

function adc(ax,cxinteger; var cf: boolean): integer; 
var 
  tempinteger
  bit15_16integer
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
Post 02 Feb 2014, 21:07
View user's profile Send private message Reply with quote
LocoDelAssembly
Your code has a bug


Joined: 06 May 2005
Posts: 4641
Location: Argentina
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 regsregisters;
var pantallaarray [1..64000of byte absolute $A000:0000
 
procedure setVideo;
begin 
  regs.ax := $13;
  Intr($10regs); { 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 registersso I'll use the same type here }
  tempWord;
  bit15_16Word;
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 $FFFEor 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 anythingin 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.

Post 03 Feb 2014, 00:37
View user's profile Send private message Reply with quote
Display posts from previous:
Post new topic Reply to topic

Jump to:  
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


Powered by phpBB © 2001-2005 phpBB Group.

Main index   Download   Documentation   Examples   Message board
Copyright © 2004-2016, Tomasz Grysztar.