https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=404354&view=findpost&p=3613739 Sun, 19 Jul 2015 04:02:31 +0000 https://forum.sources.ru/index.php?showtopic=404354&view=findpost&p=3613739 MBo 32-битные компиляторы https://forum.sources.ru/index.php?showtopic=404354&view=findpost&p=3613736 Sat, 18 Jul 2015 23:04:54 +0000 https://forum.sources.ru/index.php?showtopic=404354&view=findpost&p=3613736 Вот задачка:
Не совсем понимаю, как перевести данную процедуру (ТурбоПас) на "нормальный" язык для ФриПаскаль. :(
Кто-нибудь может помочь переписать этот код (ниже) на ФрииПаскаль?
Полный модуль (исходник) пристёгиваю.
Возможно есть у кого версия 1.4 данной библиотеки? В нем есть эти процедуры без inline, был бы благодарен
за исходники версии 1.4 (Turbo BTree)


type
TimeArr = record
lsLongInt : LongInt; (* least significant long integer *)
msLongInt : LongInt; (* most significant long integer *)
end;

var
clock : TimeArr;

(* This routine does two things that are important to understand when
using it. It first increments the internal clock. It then sets x to this
new "time". *)

procedure GetTime(var x : TimeArr);
begin
Inline(
(* This was created from the original source code using the INLINE4
utility from CompuServe. It has difficulty dealing with the lea
si, >CLOCK instruction. This was hand coded using a listing of the
original assembled file. Thus, if any future modifications require
changing this file and reassembling with INLINE, be sure to check
the output to make sure this instruction is OK. INLINE does flag
an error here to remind you - I have not included the original
source code for simplicities sake. If anyone wants it, I have it
- Dean *)

$C4/$BE/>X/ (* les di, >x[bp] ; set es:di to point
to the users time
var *)
$8D/$36/>CLOCK/ (* lea si, >CLOCK ; set ds:si to point
to the local
database time var *)
$83/$04/$01/ (* add word ptr [si],1 ; inc the database
time *)
$83/$54/$02/$00/ (* adc word ptr 2[si], 0 ; *)
$83/$54/$04/$00/ (* adc word ptr 4[si], 0 ; *)
$83/$54/$06/$00/ (* adc word ptr 6[si], 0 ; *)
$FC/ (* cld ; copy new time to
UserTime *)
$B9/$04/$00/ (* mov cx, 4 ; *)
$F2/$A5); (* rep movsw ; use movsw to save
one memory access *)

end; (* end of GetTime routine *)


Модуль не большой, пару процедур-функций. Вообще интересно еще то же самое и для функции CompareTime из этого модуля.

Заранее Спасибо всем откликнувшимся.
П.С.
Сделал предпросмотр и почему-то файл не возможно прикрепить. Поэтому приведу весь код модуля ниже (не большой он, извиняюсь что слегка нарушаю правила форума)

(* TBTree16 Copyright © 1988,1989 Dean H. Farwell II *)

unit Time;

(*****************************************************************************)
(* *)
(* T I M E R O U T I N E S *)
(* *)
(*****************************************************************************)


(* This unit is completely redesigned as of version 1.4 and can be used to
track the sequence of events. As opposed to previous versions, it does not
use actual time, but uses a counter to simulate time. This counter is just
like an internal clock with each "tick" being noted by incrementing the
counter. The clock is an internal variable of type TimeArr (defined in
this unit) which is nothing more than a record of two long integers. This
gives the clock a range of over 2 billion squared which is larger than
anyone will ever need. The use of this unit is straightforward. The user
has variables of type TimeArr. To assign a time call GetTime. To compare
two times call CompareTime. A routine to set the max time and to print
times is also provided.

note - The idea to use the simulated clock rather than using my previous
method came from Chris Cardozo. It was an extremely slick way to
get around compatibility problems which I would not have thought
of. *)

(* Version Information

Version 1.1 - No Changes

Version 1.2 - No Changes

Version 1.3 - No Changes

Version 1.4 - Redesigned complete unit. The reason for the redesign was to
alleviate any dependancies on specific memory locations which
the previous version had.

Version 1.5 - GetTime and CompareTime were redone using INLINE statements
by Chris Cardozo. They function the same way as in version
1.4, but are faster and smaller (400 bytes verses 560). His
extensive efforts on all facets of TBTREE are appreciated.

- The order of the fields in TimeArr are switched

Version 1.6 - No Changes *)

(*!*)
(*\*)
(*////////////////////////// I N T E R F A C E //////////////////////////////*)

interface

uses
Compare,
Numbers;


type
TimeArr = record
lsLongInt : LongInt; (* least significant long integer *)
msLongInt : LongInt; (* most significant long integer *)
end;


(* This routine does two things that are important to understand when
using it. It first increments the internal clock. It then sets x to this
new "time". *)

procedure GetTime(var x : TimeArr);


(* This function compares two time arrays. LESSTHAN is returned if X is less
than Y (earlier). GREATERTHAN is returned if X is greater than Y (later).
If they are equal then EQUALTO is returned *)

function CompareTime(var x : TimeArr;
var y : TimeArr) : Comparison;


(* This routine will print the two long integers that make up x (of type
TimeArr) *)

procedure PrintTime(x : TimeArr);


(* This routine sets both long integer fields of a timeArr variable to the
maximum possible value (MAXLONGINT) *)

procedure SetMaxTime(var x : TimeArr);


(*\*)
(*///////////////////// I M P L E M E N T A T I O N /////////////////////////*)

implementation

var
clock : TimeArr;

(* This routine does two things that are important to understand when
using it. It first increments the internal clock. It then sets x to this
new "time". *)

procedure GetTime(var x : TimeArr);

begin
Inline(
(* This was created from the original source code using the INLINE4
utility from CompuServe. It has difficulty dealing with the lea
si, >CLOCK instruction. This was hand coded using a listing of the
original assembled file. Thus, if any future modifications require
changing this file and reassembling with INLINE, be sure to check
the output to make sure this instruction is OK. INLINE does flag
an error here to remind you - I have not included the original
source code for simplicities sake. If anyone wants it, I have it
- Dean *)

$C4/$BE/>X/ (* les di, >x[bp] ; set es:di to point
to the users time
var *)
$8D/$36/>CLOCK/ (* lea si, >CLOCK ; set ds:si to point
to the local
database time var *)
$83/$04/$01/ (* add word ptr [si],1 ; inc the database
time *)
$83/$54/$02/$00/ (* adc word ptr 2[si], 0 ; *)
$83/$54/$04/$00/ (* adc word ptr 4[si], 0 ; *)
$83/$54/$06/$00/ (* adc word ptr 6[si], 0 ; *)
$FC/ (* cld ; copy new time to
UserTime *)
$B9/$04/$00/ (* mov cx, 4 ; *)
$F2/$A5); (* rep movsw ; use movsw to save
one memory access *)

end; (* end of GetTime routine *)

(*\*)
(* This function compares two time arrays. LESSTHAN is returned if X is less
than Y (earlier). GREATERTHAN is returned if X is greater than Y (later).
If they are equal then EQUALTO is returned *)

function CompareTime(var x : TimeArr;
var y : TimeArr) : Comparison;

begin
Inline(
(* ; LI1 = StackOffs + 4 *)
(* ; LI2 = StackOffs *)
$8C/$DA/ (* mov dx, ds ; save Turbo's ds *)
$C5/$B6/>X/ (* lds si, >x[bp] ; point ds:si to high
word of first memory
region *)
$83/$C6/$03/ (* add si, 3 ; region is 4 words
long *)
$C4/$BE/>Y/ (* les di, >y[bp] ; point es:di to high
word of second
memory region *)
$83/$C7/$03/ (* add di, 3 ; region is 4 words
long *)
$FD/ (* std ; compare from high
word to low word *)
$B9/$04/$00/ (* mov cx, 4 ; 4 words to compare *)
$F3/$A7/ (* repe cmpsw ; do compare *)
$B8/$01/$00/ (* mov ax, 1 ; assume result was
EQUAL *)
$74/$0B/ (* je Done ; if so, then we are
all done *)
$77/$06/ (* ja GrThan ; was first parameter
greater ? *)
$B8/$00/$00/ (* mov ax, 0 ; no, then it must
have been less than
second *)
$E9/$03/$00/ (* jmp Done ; *)
$B8/$02/$00/ (* GrThan: mov ax, 2 ; *)
$8E/$DA/ (* Done: mov ds, dx ; all done so can
restore Turbo's ds *)
$88/$46/$FF); (* mov [bp-1], al ; store function
result for Turbo *)

end; (* end of CompareTime routine *)


(* This routine will print the two long integers that make up x (of type
TimeArr) *)

procedure PrintTime(x : TimeArr);

begin
Writeln('Most Significant Long Integer = ',x.msLongInt);
Writeln('Least Significant Long Integer = ',x.lsLongInt);
end; (* end of PrintTime routine *)

(*\*)
(* This routine sets both long integer fields of a timeArr variable to the
maximum possible value (MAXLONGINT) *)

procedure SetMaxTime(var x : TimeArr);

begin
x.lsLongInt := MAXLONGINT;
x.msLongInt := MAXLONGINT;
end; (* end of SetMaxTime routine *)

begin
clock.msLongInt := 0;
clock.lsLongInt := 0;
end. (* end of Time unit *)]]> vohman 32-битные компиляторы