Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/C4PAS000.ZIP/C4PAS000.DOC

Text File | 1990-05-04 | 22.6 KB | 643 lines

                              C4PAS000

                 C routines for Turbo Pascal 5.5

                        Copyright (C) 1990

                             Bill Weaks
                            3303 37th St
                        Lubbock, TX   79413

All rights reserved except as otherwise indicated in this
document.

C4PAS000 is a collection of some useful C routines that don't
have a direct counterpart in Turbo Pascal.  Having cut my
programming teeth in Pascal, I still enjoy the language
immensely, and use it as my language of choice.

I had to learn C for one of my clients, and found several useful
functions in that language that I could have used in Turbo
Pascal.  I have coded them in Pascal and/or assembly language and
put them in this unit that can be used with version 5.5 of that
compiler.  These are mostly string routines, but there are some
others here to boot.

But before we examine these routines, we need to get some
formalities out of the way in the front of this document:

 ************* LICENSING INFORMATION *************

This unit is intended as a demonstration package only:  NO
LICENSE IS TRANSFERRED WITH IT!!!  If you intend to, or actually
do use any of these routines in your own applications - personal,
private, commercial or otherwise, you will need to obtain a
legitimate license by doing the following:

Send $30.00 to:

Bill Weaks
3303 37th Street
Lubbock, TX   79413

Upon receipt, you will be sent the latest version of this
software along with full source in Turbo Pascal and assembly
language and a license to use the software in any application you
may compile and distribute.

There are several reasons to do this:  First, it's the only legal
and moral way.  Second, Borland has been very good about
upgrading it's compilers, but the units generally have to be
re-compiled to work with the new versions.  Since you can't do
this without the source, if you are going to use any of these
routines in future versions, you will need either a new version,
or the source.

Texas residents will need to add sales tax (currently $1.95) to
their orders.

Subject to those restrictions, anybody can copy this software and
distribute it so long as they do not charge more than $10.00 for
media, handling and operating profit charges.  In fact, you are
encouraged to do so.

Turbo Pascal is a trademark of Borland International, the best
software company on the face of the earth.

 ************* DISCLAIMER *************

The author disclaims any and all responsibility for the
reliability of the software in this unit.  By using this
software, User accepts all liability for performance, and
indemnifies author against any and all claims.  It works as far
as I know, but I've got to say that.

Registered users may report bugs by mailing a description of the
problem, the version of the Unit and sample source to the above
address.  If the bug is legitimate, the sender will receive a
free updated version with the fix.

Non-registered users are encouraged to send in bug reports, also.
In the event that a non-registered user is the first to report a
bug, he or she will automatically become a registered user, and a
free copy of the program, with source, will me sent to them with
my thanks.


 **********  THE UNIT **********

The following is the unit header, excluding the actual
declarations of the functions and procedures:

unit c4pas000;

interface

uses dos,crt;

type _dtstr=string[26];
     str_ptr = ^string;
     _pass_str=string[8];

const
_days_o_week:array[0..6] of array[1..3] of char =
{days of the week}
('Sun','Mon','Tue','Wed','Thu','Fri','Sat');

_mos_o_year:array[1..12] of array[1..3] of char =
{months of the year}
('Jan','Feb','Mar','Apr','May','Jun',
 'Jul','Aug','Sep','Oct','Nov','Dec');


dr_found :byte = $01;                { drive found in file spec }
dir_found:byte = $02;            { directory found in file spec }
nm_found :byte = $04;                 { name found in file spec }
ext_found:byte = $08;            { extension found in file spec }
wdc_name :byte = $10;            { wild card char found in name }
wdc_ext  :byte = $20;            { wild card found in extension }

csense:boolean = true;                  {case sensitive searches}
ncsense:boolean = false;            {non case sensitive searches}

var
    NULL:str_ptr;
    nullstr:string[1];

These constants, types and variables are available to any module
that incorporates C4PAS000 with a "uses" statement.  They are
used by the internal routines, and I made them public since they
will take up space anyway; why not use them in your routines if
they are helpful?  Unlike C, TP's linker will strip them out if
you don't access them.  Pretty nice, eh?

Their utility and uses will be made clear as you peruse the
routines below.  I have divided them by category, and hope that
you will find them of interest.

 ********** ROUTINES INCLUDED IN C4PAS000 **********

First, I start all identifiers with an underscore to try and
eliminate conflicts with other libraries, including your own.  If
you tire of including them, then you should register, get the
source code, and eliminate them!!  I know I would.  If you have
conflicts regardless, you can always identify the one you are
looking for by typing:

  c4pas000.<identifier>

where <identifier> is the function or procedure that you are
looking for.

******

The following routines I have found very useful, and should more
than pay for the cost of this library if you use them even once!!
The first two aren't even TP implementations of C routines, just
better versions of TP routines.  I put them in here anyway.

******

>>> procedure _ffill(var dest; ccount:word; fillval:byte); <<<
Assembly language.  This is a faster version of the Turbo Pascal
FillChar procedure.  It is actually up to 48% faster.  There's no
magic, but it does work that way.  Use this to fill arrays with a
predetermined value, or to null out a series of variables with
one call.

>>> procedure _fmove(var source,dest; ccount:word); <<<
Assembly language.  This is a faster version of the Turbo Pascal
Move procedure.  Again, no magic, but it is up to 24% faster than
the normal version.

You will find that you can save even more by using _fmove instead
of assigning records.  For instance, you can assign one record's
contents to another by simply using the ":=" assignment operator.
This merely moves the contents of one record into the other.  If
you do a lot of this, using _fmove can really speed things up.

>>> procedure _strrev(var st:string); <<<
Assembly language routine reverses all characters in the string
passed up.

>>> procedure _strupr(var st:string); <<<
Assembly language routine converts all characters in the string
passed up to their uppercase equivalents if they exist.

>>> procedure _strlwr(var st:string); <<<
Assembly language routine converts all characters in the string
passed up to their lowercase equivalents if they exist.

>>> function _strrchr(var st:string;
               targ:char;
                  nocase:boolean):integer; <<<

Assembly language routine returns the index into the string
passed up of the last occurrence of the char passed in targ.  If
nocase is TRUE (use the const csense) then a strict case
sensitive search is made.  If nocase is FALSE (use the const
ncsense) then a non-case sensitive search is made of the string.
Returns a 0 if the char is not found.

EXAMPLE:

var st:string;
    i:integer;

begin
  st:='D:\TURBO5\SOURCE\*.PAS';
  writeln(_strrchr(st,'\',csense));
end.

This would result in the number 17 being printed to the screen,
as that is the index of the last occurrence of the backslash
character.  Using non-case sensitive searches will be a tad
faster, since the conversion doesn't have to take place with each
character of the string.


>>> function _stricmp(var st1,st2:string):integer; <<<
Assembly language routine returns a value based upon a case
insensitive comparison of the two strings passed up.  Returns a
value of 0 if the strings are equal, a value greater than 0 if
st1 is greater than st2, and a value less than 0 if st1 is less
than st2.

_stricmp will not search more than the length of the shorter of
the two, that is, if st1 has a length of 20, and st2 has a length
of 30, the routine will only search 20 chars.  If the string were
identical for the first 20 chars, the routine would return a
negative number, since st2 still contained characters.

EXAMPLE:

var st1,st2:string;

begin
  st1:='Hello There';
  st2:="hello there yourself';
  writeln(_stricmp(st1,st2));
end.

This would result in a negative number being printed on the
screen, since st1 was less than st2.  REMEMBER:  the comparison
is not case sensitive!!!  Turbo Pascal already has the capability
to perform case sensitive comparisons of strings.  This could
speed up things since you don't need to uppercase the strings
first to check for equality.

Those of you who get the source should find it easy to make a
version of strnicmp, which will only search a maximum number of
chars OR the shorter of the two strings.

>>> function _strcspn(var org,targ:string):integer; <<<
Returns the length of the first part of string org that does not
contain any of the characters found in string targ.  That is, it
starts at character one of string org and checks to see if it is
in targ.  If not, it checks the next char in string org.  If none
of the chars are found in targ, returns the length of org.

EXAMPLE:

var st1,st2:string;

begin
  st1:='Hello';
  st2:='+-*/';
  writeln(_strcspn(st1,st2));
end.

This would result in the number 5 being printed on the screen,
since st1 contains none of the letters found in st2.

>>> function _strspn(var org,targ:string):integer; <<<
This is the reverse of _strcspn.  It returns the length of the
inital part of string org that consists entirely of chars found
in the string targ.  If none of the chars are found, it would
return a 0.

The source shown above would result in the number 0 being printed
to the screen.

>>> function _strtok(var org,
                 dest:string;
              targ:string;
              appendchar:boolean):char; <<<

This is probably my favorite of all of these routines.  It is a
general purpose token parser that can be invoked numerous times
and search for various tokens defined by many delimiters.  It is
quite powerful and with some imagination I'm sure you will find
many uses for it.

This routine takes the initial argument, string org, and then
searches it for the first occurrence of any of the characters in
the string targ.  The resultant string (that is, the initial part
of org up to the char tagged) is placed into the string dest.
The parameter appendchar is TRUE or FALSE, based upon whether or
not you wish the delimiter to be appended to the string dest.

You may "whittle" the original string down, token by token, until
the string is exhausted by using the variable "nullstr" (defined
in the interface of the unit) instead of your original source
string after the first call to _strtok.

The string org is not modified, as it is in the C version.  We
keep an internal string that is used for subsequent calls to the
routine.  Consider this example for counting words in a text
file:

program wordcount;

uses crt,c4pas000;

var f1:text;
    wcount:word;
    st1,st2:string;
    ch:char;

begin
  assign(f1,'Myfile.txt');
  reset(f1);
  wcount:=0;
  while not eof(f1) do
    begin
      readln(f1,st1);
      ch:=_strtok(st1,st2,' ',false); {init and get first token}
      repeat
        { eliminate multiple spaces }
        if ch = ' ' and st2 <> ' ' then inc(wcount);
        ch:=_strtok(nullstr,st2,' ',false);
      until ch = #0;
      if (ch = #0) and (st2 <> '') then inc(wcount);{last token?}
    end;
  close(f1);
  writeln(wcount);
end.

Further, since the routine parses up to the first occurrence of
any of the characters in targ, it makes a dandy equation parser,
or a handy routine for reading in a comma delimited file from
another program.  Take this code for an equation parser:

begin
  write('Enter equation => ');
  readln(st1);
  ch:=_strtok(st1,st2,'()*+-/=',false);
  repeat
    case ch of
      '(':;     {appropriate code here to evaluate}
      ')':;
      '*':;
       etc,etc.
    end; {case}
    ch:=_strtok(nullstr,st2,'()*+-/=',false);
  until ch = #0;
end.

Of course, you could have assigned the string '()*+-/=' to a
variable named "mathstr" or something and saved some complicated
typing (and some .EXE size).  I really hope you like this
function.

>>> function _fnsplit(pathh :string;
                 ddrive:str_ptr;
                 ddir  :str_ptr;
                 nname :str_ptr;
                 eext  :str_ptr
                ):integer; <<<

Turbo Pascal provides a similar routine, but I liked the C
version better, and decided to include a spiffed up version of
it.  _fnsplit takes a filename string (pathh) and breaks it up
into it's various components.  It then deposits those components
into the appropriate string passed up by reference.

There are a few quirks to this one, however:  If you pass up the
value NULL (defined in the interface) then the routine will NOT
attempt to deposit the token, but will just go on.  That way, if
you are only interested in the drive, perhaps, or just the
extension of a file name, you only need one string to pass up.

The routine also returns an integer that is concocted of the
following values (also defined in the interface):

dr_found :byte = $01;                { drive found in file spec }
dir_found:byte = $02;            { directory found in file spec }
nm_found :byte = $04;                 { name found in file spec }
ext_found:byte = $08;            { extension found in file spec }
wdc_name :byte = $10;            { wild card char found in name }
wdc_ext  :byte = $20;            { wild card found in extension }

By 'and-ing' the result of _fnsplit with these values you can
determine whether any or all of the various components were found
in the string passed up.  I added the two wild card values so
that if a '?' or '*' are present in either the file name or
extension, these values will be present in the result of the
function.  The values are just added into the result as each
becomes true.  The maximum value that _fnsplit can currently
return is, therefore, $3f.

EXAMPLE:

var i:integer;
    xdrv,dir,name,ext:string;

  i:=_fnsplit('D:\TURBO5\SRC\*.PAS',@drv,@dir,@name,@ext);

Would result in the value $1f being assigned to i.  The string
drv would contain 'D:'; the string dir would contain
'\TURBO5\SRC\'; the string name would contain '*', and the string
ext would contain '.PAS'.  And-ing the variable i with "wdc_name"
would result in "wdc_name", telling you that a wildcard was found
in the file name.  If you were only interested in the extension,
you could write something like this:

  i:=_fnsplit('D:\TURBO5\SRC\*.PAS',NULL,NULL,NULL,@@ext);

In this case, i would contain the value "ext_found", since the
routine didn't check for anything else.  The ability to check for
a particular component saves time and variable space.  This
should be a useful function also.

>>> function getpass(llenn:byte;echo:char):string; <<<
This function allows your application to get a hidden password
from a user.  It returns a string with a maximum length of llenn.
You can pass up a character which will be echoed to the screen
regardless of which key the user may press.  If the echo char is
#0, the routine will print the number of the keypress mod 10.
this is useful for telling the user how many chars they have
entered.

The function ends when it encounters a carriage return or llenn
chars have been read.  This routine takes anything, including
backspaces, so be aware when entering the password that mistakes
are not tolerated!

EXAMPLE:

program getpassword;

uses dos, c4pas000;

var st:_pass_str;  {defined in c4pas000}
begin
  clrscr;
  gotoxy(1,12);
  write('Enter your password, please => ');
  st:=getpass(sizeof(st)-1,'*');
  _strupr(st);
  if st <> 'GORILLAS' then halt;
end.

This would return a string with a maximum of 8 chars, printing an
asterisk on the screen whenever a user touched the keyboard. The
line would look like this:

Enter your password, please => ********

If you were to pass up a char #0 as echo, the screen would look
like this:

Enter your password, please => 12345678


>>> function _asctime:_dtstr; <<<

Converts current system date and time to 26 char ASCII string
according to the template:

Wed Apr 10 13:45:48 1990

The appropriate information is obtained from DOS and then placed
into the string that is returned.  By using a variable of type
_dtstr, you will be assured that you will have the precise amount
of room necessary to receive the information.

EXAMPLE:

var dstr:_ststr;
    { get system date and time into string dstr }
begin
  dstr:=_asctime;
  writeln(dstr);
end;

You could also just have used a simple

  writeln(_asctime);

if you only wanted to display the info.

 ********

Most of the following functions are performed via a table lookup
for speed.  Those of you who obtain the source code could modify
the table to suit specialized needs.

 ********

>>> function _isalnum(ch:char):boolean; <<<
Returns TRUE if the char passed up is in the range '0'..'9',
'A'..'Z', 'a'..'z'.  Returns FALSE if any other char.

>>> function _isalpha(ch:char):boolean; <<<
Returns TRUE if the char passed up is in the range 'A'..'Z',
'a'..'z'.  Returns FALSE if any other char.

>>> function _isascii(ch:char):boolean; <<<
Returns  TRUE if the ordinal value of the char passed up is <
128.  Returns FALSE if 128 or greater.

>>> function _iscntrl(ch:char):boolean; <<<
Returns TRUE if the ordinal value of the char passed up is in the
range 0..31 ($00..$2f).  Returns FALSE if any other value.

>>> function _isdigit(ch:char):boolean; <<<
Returns TRUE if the char passed up is in the range '0'..'9'.
Returns FALSE if any other char;

>>> function _isgraph(ch:char):boolean; <<<
Returns TRUE if the char passed up will actually show up on when
displayed.  That is, if the result of printing ch is visible.  It
includes all characters from '!'..'~'($33..$7e).  Returns FALSE
if any other char.  Note that the extended character set is not
included, since it is not straight ASCII.  See _isextended for
info on these chars.

>>> function _islower(ch:char):boolean; <<<
Returns TRUE if char passed up is in range 'a'..'z'.  Returns
FALSE for any other char.

>>> function _isprint(ch:char):boolean; <<<
Similar to _isgraph, but returns TRUE for space char also.

>>> function _ispunct(ch:char):boolean; <<<
Returns TRUE if the char passed up is one of the following
punctuation marks:  !"',-.:;?`.  Returns FALSE if any other char;

>>> function _isspace(ch:char):boolean; <<<
Returns TRUE if char passed up is a spacing char, that is, one
that moves the cursor or print head without leaving any visible
result.  These chars include the control chars tab, carriage
return, newline, vertical tab, or formfeed ($09..$0d) and the
space char itself ($20).  Returns FALSE if any other char.

>>> function _isupper(ch:char):boolean; <<<
Returns TRUE if char passed up is in the range 'A'..'Z'.  Returns
FALSE if any other char.

>>> function _isxdigit(ch:char):boolean; <<<
Returns TRUE if char passed up is a hexadecimal character, that
is, '0'..'9', 'A'..'F','a'..'f'.  Returns FALSE if any other
char.

>>> function _isextended(ch:char):boolean; <<<
Returns TRUE if the char passed up is one of the IBM extended
characters, that is a char that normally wouldn't print if taken
as straight ASCII.  This includes all chars outside the normal
ASCII range ($00..$2f,$7f..$255).  Returns FALSE if any other
char.  No C equivalent, but there should have been?

>>> function _tolower(ch:char):char; <<<
Returns the lowercase equivalent of char passed up if
appropriate.  If not, returns char.

>>> function _toupper(ch:char):char; <<<
Returns the uppercase equivalent of char passed up if
appropriate.  If not, returns char.

 ********

The following are some useful routines I incorporated to make
your life a little easier.  The min routines (_bytemin.._realmin)
all return the smaller of the two values passed up to them.  The
max routines (_bytemax.._realmax) all return the larger of the
two values passed up.  If they are equal the b value is returned
in all cases.  Remember that reals are tricky when you are
determining lesser or greater:  The difference may be minimal at
best!

C is nice in that this is implemented as a macro that is
type-independent.  Pascal isn't so flexible, so we need a
separate routine for each type.

 ********

>>> function _bytemin(a,b:byte)     :byte;    <<<
>>> function _intmin(a,b:integer)   :integer; <<<
>>> function _wordmin(a,b:word)     :word;    <<<
>>> function _longmin(a,b:longint)  :longint; <<<
>>> function _charmin(a,b:char)     :char;    <<<
>>> function _realmin(a,b:real)     :real;    <<<

>>> function _bytemax(a,b:byte)     :byte;    <<<
>>> function _intmax(a,b:integer)   :integer; <<<
>>> function _wordmax(a,b:word)     :word;    <<<
>>> function _longmax(a,b:longint)  :longint; <<<
>>> function _charmax(a,b:char)     :char;    <<<
>>> function _realmax(a,b:real)     :real;    <<<

 ********
These two are just inline procedures for disabling and enabling
interrupts.  Useful when reading ports or changing program
contexts.
 ********

>>> procedure _disable;inline($fa); <<<
>>> procedure _enable; inline($fb); <<<

 ********
Peeks and pokes are useful at times, and I included these to peek
and poke various types of integers.  Use the PTR function to
provide an address.  You can also use the @ operator to cast
values, but there are probably better ways of doing that.
 ********

>>> function  _peek (p:pointer):word;    <<<
>>> function  _peeki(p:pointer):integer; <<<
>>> function  _peekb(p:pointer):byte;    <<<
>>> function  _peekl(p:pointer):longint; <<<

>>> procedure _poke (p:pointer;w:word);    <<<
>>> procedure _pokei(p:pointer;i:integer); <<<
>>> procedure _pokeb(p:pointer;b:byte);    <<<
>>> procedure _pokel(p:pointer;l:longint); <<<

EXAMPLE:

{ DOS keeps the timer ticks since midnight in a longint at
  $0000:$046c.Do a loop and count the ticks that it took }

var dosticks:pointer;
    i:integer;
    time1:longint;

begin
  dosticks:=ptr($0000,$046c);
  time1:=_peekl(dosticks);
  for i:=1 to 10000 do;  {null loop}
  writeln('It took ',_peekl(dosticks) - time1,
          ' ticks to do that loop');
end.