; Thomas 1.9+ object file [basic]
; by Thomas Lacką, http://togye.host.sk
IDEAL
MODEL LARGE,PASCAL
P486

DATASEG
  extrn Strg:proc

CODESEG

macro lodsb_es
  db 26h
  lodsb
endm

macro lodsw_es
  db 26h
  lodsw
endm

;********** XCHG **********
public Xchg1,Xchg2,Xchg3,Xchg4,Xchg6,Xchg8,Xchg10
public XchgB,XchgS,XchgK,XchgW,XchgI,XchgL,XchgP
public XchgRS,XchgR,XchgRD,XchgRC,XchgRE
public XchgT,Xchg24,Xchg64, XchgVar

proc Xchg1 ; vA:dword,vB:dword
proc XchgB
proc XchgK
proc XchgS
  mov   bx,sp
  les   di,[ss:bx+8] ;vA
  lfs   si,[ss:bx+4] ;vB
  mov   al,[es:di]
  xchg  al,[fs:si]
  stosb
  ret   8
endp
endp
endp
endp

proc Xchg2 ; vA:dword,vB:dword
proc XchgW
proc XchgI
  mov   bx,sp
  les   di,[ss:bx+8] ;vA
  lfs   si,[ss:bx+4] ;vB
  mov   ax,[es:di]
  xchg  ax,[fs:si]
  stosw
  ret   8
endp
endp
endp

proc Xchg3 ; vA:dword,vB:dword
proc XchgT
proc Xchg24
  mov   bx,sp
  les   di,[ss:bx+8] ;vA
  lfs   si,[ss:bx+4] ;vB
  mov   ax,[es:di]
  xchg  ax,[fs:si]
  stosw
  mov   al,[es:di]
  xchg  al,[fs:si]
  stosb
  ret   8
endp
endp
endp

proc Xchg4 ; vA:dword,vB:dword
proc XchgL
proc XchgP
proc XchgRS
  mov   bx,sp
  les   di,[ss:bx+8] ;vA
  lfs   si,[ss:bx+4] ;vB
  mov   eax,[es:di]
  xchg  eax,[fs:si]
  stosd
  ret   8
endp
endp
endp
endp

proc Xchg6 ; vA:dword,vB:dword
proc XchgR
  mov   bx,sp
  les   di,[ss:bx+8] ;vA
  lfs   si,[ss:bx+4] ;vB
  mov   eax,[es:di]
  xchg  eax,[fs:si]
  stosd
  mov   ax,[es:di]
  xchg  ax,[fs:si]
  stosw
  ret   8
endp
endp

proc Xchg8 ; vA:dword,vB:dword
proc XchgRD
proc XchgRC
proc Xchg64
  mov   bx,sp
  les   di,[ss:bx+8] ;vA
  lfs   si,[ss:bx+4] ;vB
  mov   eax,[es:di]
  xchg  eax,[fs:si]
  stosd
  mov   eax,[es:di]
  xchg  eax,[fs:si]
  stosd
  ret   8
endp
endp
endp
endp

proc Xchg10 ; vA:dword,vB:dword
proc XchgRE
  mov   bx,sp
  les   di,[ss:bx+8] ;vA
  lfs   si,[ss:bx+4] ;vB
  mov   eax,[es:di]
  xchg  eax,[ds:si]
  stosd
  mov   eax,[es:di]
  xchg  eax,[ds:si]
  stosd
  mov   ax,[es:di]
  xchg  ax,[ds:si]
  stosw
  ret   8
endp
endp

proc XchgVar A:dword,B:dword,S:word
uses ds
  les   di,[A]
  lds   si,[B]
  mov   cx,[S]
  shr   cx,2
  jz    @@last3
@@nextdword:
  lodsd
  mov   edx,[es:di]
  stosd
  mov   [ds:si-4],edx
  loop  @@nextdword
@@last3:
  mov   cx,[S]
  rcr   cx,2
  jnc   @@last1
  lodsw
  mov   dx,[es:di]
  stosw
  mov   [ds:si-2],dx
@@last1:
  or    cx,cx
  jns   @@exit
  lodsb
  mov   dl,[es:di]
  stosb
  mov   [ds:si-1],dl
@@exit:
  ret
endp

;***** SERIAL NUMBER *****
public Ser

macro MovW O,W
  mov   [word ptr di+O],W
endm

proc SerFunction Result:dword,X:dword
endp

proc Ser X:dword ; function:string
uses ds
  les   di,[Result]
  push  es di [X]
  call  Strg
  pop   di ds
  mov   bx,di
  movzx ax,[di]
  add   [byte ptr di],2
  inc   di
  add   di,ax
  cmp   al,1
  jne   @@long
  xlat
  mov   ah,al
  jmp   short @@testah
@@long:
  mov   ax,[di-2]
  cmp   al,'1'
  je    @@th
@@testah:
  cmp   ah,'1'
  je    @@st
  cmp   ah,'2'
  je    @@nd
  cmp   ah,'3'
  je    @@rd
@@th:
  MovW  0,'ht'
  jmp   short @@exit
@@st:
  MovW  0,'ts'
  jmp   short @@exit
@@nd:
  MovW  0,'dn'
  jmp   short @@exit
@@rd:
  MovW  0,'dr'
@@exit:
  ret
endp

;********** SWAP **********
public Swap2,Swap3,Swap4,Swap8
public SwapW,SwapI,SwapL,SwapT,Swap24,Swap64
public GetSwapW,GetSwapI,GetSwapL

proc Swap2 ; vX:dword
proc SwapW
proc SwapI
  mov   bx,sp
  les   di,[ss:bx+4] ;vX
  mov   al,[es:di]
  xchg  al,[es:di+1]
  stosb
  ret   4
endp
endp
endp

proc Swap3 ; vX:dword
proc SwapT
proc Swap24
  mov   bx,sp
  les   di,[ss:bx+4] ;vX
  mov   eax,[es:di]
  bswap eax
  mov   [es:di],ah
  shr   eax,16
  mov   [es:di+1],ax
  ret   4
endp
endp
endp

proc Swap4 ; vX:dword
proc SwapL
  mov   bx,sp
  les   di,[ss:bx+4] ;vX
  mov   eax,[es:di]
  bswap eax
  mov   [es:di],eax
  ret   4
endp
endp

proc Swap8 ; vX:dword
proc Swap64
  mov   bx,sp
  les   di,[ss:bx+4] ;vX
  mov   edx,[es:di]
  bswap edx
  mov   eax,[es:di+4]
  bswap eax
  stosd
  mov   [es:di],edx
  ret   4
endp
endp

proc GetSwapW ; X:word ; function:Word
proc GetSwapI ; X:word ; function:Integer
  mov   bx,sp
  mov   ax,[ss:bx+4] ;X
  xchg  ah,al
  ret   2
endp
endp

proc GetSwapL ; X:dword ; function:Longint
  mov   bx,sp
  mov   dx,[ss:bx+4] ;Low(X)
  xchg  dh,dl
  mov   ax,[ss:bx+6] ;High(X)
  xchg  ah,al
  ret   4
endp

;********** QSORT **********
public Sort

struc SortRef
  List dd ?
  Func dd ?
  Size dw ?
ends

; illustrative algorithm for Sort:
; procedure Sort (Ref:Word{offset SortRef}; L,R:Word);
; begin
;   if L>=R then Exit;
;   if R-L=1 then begin { two elements }
;     if List[L]>List[R] then Exchange(List[L],List[R]);
;   end
;   else begin { three or more elements }
;     i:=L; j:=R; x:=List[(L+R) div 2];
;     repeat
;       while List[i]<x do Inc(i);
;       while x<List[j] do Dec(j);
;       if i<=j then begin
;         if List[i]<>List[j] then Exchange(List[i],List[j]);
;         Inc(i); Dec(j);
;       end;
;     until i>j;
;     if l<j then QSort(L,j);
;     if i<r then QSort(i,R);
;   end;
; end;

proc Sort near Ref,L,R
local i,j
  ; i:=L; j:=R;
  mov   di,[Ref]
  les   cx,[ss:di+SortRef.List]
  mov   bx,cx
  mov   si,[ss:di+SortRef.Size]
  mov   ax,[L]
  mov   [i],ax
  mov   di,[R]
  sub   di,ax
  mul   si
  add   cx,ax ; es:cx = @List[i]
  mov   ax,[R]
  mov   [j],ax
  mul   si
  mov   dx,bx
  add   dx,ax ; es:dx = @List[j]
  dec   di
  mov   di,[Ref]
  jz    @@two
  ; at least 3 elements
  ; x:=List[(L+R) div 2];
  push  dx
  mov   ax,[L]
  add   ax,[R]
  shr   ax,1
  mul   si
  add   bx,ax ; es:bx = @List[(i+j) div 2]
  jmp   short @@left
@@repeat: ; repeat
  push  dx
@@left: ; while Cmp(List[i],x)<0 do Inc(i);
  push  es cx es bx
  call  [dword ptr ss:di+SortRef.Func]
  sub   sp,8
  pop   bx es cx es
  mov   di,[Ref]
  or    ax,ax
  jge   @@left_found
  inc   [i]
  add   cx,[ss:di+SortRef.Size]
  jmp   short @@left
@@left_found:
  pop   dx
  sete  al
  push  ax cx
@@right: ; while Cmp(x,List[j])<0 do Dec(j);
  push  es bx es dx
  call  [dword ptr ss:di+SortRef.Func]
  sub   sp,8
  pop   dx es bx es
  mov   di,[Ref]
  or    ax,ax
  jge   @@right_found
  dec   [j]
  sub   dx,[ss:di+SortRef.Size]
  jmp   short @@right
@@right_found: ; if i<=j then begin
  pop   cx ax
  sete  ah
  cmp   cx,dx
  ja    @@next
  push  [ss:di+SortRef.Size]
  and   al,ah ; AL=1 iff List[i]=x=List[j]
  jnz   @@step
  ; XchgVar(List[i],List[j],Size);
  cmp   bx,cx
  jne   @@cmpdx
  push  dx ; BX will become DX
  jmp   short @@exchange
@@cmpdx:
  cmp   bx,dx
  jne   @@not_moved
  push  cx ; BX will become CX
  jmp   short @@exchange
@@not_moved:
  push  bx
@@exchange:
  push  es cx es dx
  push  [ss:di+SortRef.Size]
  call  XchgVar
  sub   sp,8
  pop   dx es cx es bx
  mov   di,[Ref]
@@step: ; Inc(i); Dec(j);
  pop   si
  inc   [i]
  add   cx,si
  dec   [j]
  sub   dx,si
@@next: ; until i>j;
  jc    @@recurse1
  cmp   cx,dx
  jbe   @@repeat
@@recurse1: ; if l<j then Sort(l,j);
  mov   ax,[j]
  cmp   [L],ax
  jae   @@recurse2
  push  di [L] ax
  call  Sort
@@recurse2: ; if i<r then Sort(i,r);
  mov   ax,[i]
  cmp   ax,[R]
  jae   @@exit
  push  [Ref] ax [R]
  call  Sort
  ret
@@two: ; two elements
  ; if Cmp(List[L],List[R])>0 then
  push  es cx es dx
  call  [dword ptr ss:di+SortRef.Func]
  or    ax,ax
  jle   @@exit
  ; XchgVar(List[L],List[R],Size);
  sub   sp,8
  mov   di,[Ref]
  push  [ss:di+SortRef.Size]
  call  XchgVar
@@exit:
  ret
endp

END