comp.lang.pascal.borland FAQ, version 0.6

Table of Contents

Preface
  1. Passing Parameters To Programs (Reading The Command Line)
    1.1 How do I read command line parameters?
    1.2 How do I read the whole command line?
  2. Logarithms, Trigonometry, and Other Numerical Calculations
    2.1 How do I calculate X^Y (aka X**Y)?
    2.2 How do I take 'un-natural' logarithms?
    2.3 Why do the trig functions like Sin() and Cos() give the wrong answers?
    2.4 How do I calculate ArcSin() or ArcCos()?
    2.5 Can I trap (and recover from) floating point overflow errors?
    2.6 Why do I always get the same random numbers every time I run my program?
  3. Strings and Numbers
    3.1 How do I convert a string to a number?
    3.2 How do I convert a number to a string?
  4. Breaking The 64K Limit
    4.1 I have 64K of global data and can't add anymore - what do I do?
    4.2 Can I have more than 64K of global data in my Windows program?
    4.3 How can I build an array bigger than 64K?
    4.4 How do I handle .BMP and/or .WAV files with more than 64K of data?
  5. Procedural Types
    5.1 Can I make an indirect call to an object's method, using a pointer or a procedural type?
  6. Windows Sound Programming
    6.1 Where can I find documentation on Windows sound programming?
  7. Delphi and/or BP8
    7.1 What about Delphi?
    7.2 Will there be a BP8?
  8. Other Pascal Resources
  9. Runtime Error 200 when using CRT unit on fast computers

Preface

This file was originally intended to be an official news.answers/rtfm.mit.edu FAQ for comp.lang.pascal.borland. However, work and Delphi intervened, and now I no longer use BP at all. This file will never go beyond this draft stage; the only work I've done on it in four years is to add the section on Runtime Error 200 when using CRT unit on fast computers.

I have only included answers to questions that seem to me to be genuinely frequently asked. I have no desire to write a Pascal primer, nor do I want to produce a intimidatingly large document. On the other hand, if this FAQ does get out of hand, it's being written and maintained as an HTML file, so you can use Mosaic or Lynx to jump straight from the Table Of Contents to the answer to a particular question. I'll post the ASCII version periodically to comp.lang.pascal.borland; you can always get the latest version via the World Wide Web at <http://www.midnightbeach.com/jon/pubs/clp-faq.htm>.

This FAQ began life as a draft of a comp.lang.pascal FAQ, back before that group was split up. This heritage shows primarily in phrases like in Turbo/Borland Pascal that are no longer necessary. Some of the questions and answers may apply to other Pascal's, but it's up to you to decide if this is the case.

Please note that this FAQ file is a free public service, and comes with no warranty as to accuracy. Use any information you find here with discretion and caution.

Contributors


Passing Parameters To Programs (Reading The Command Line)

1.1: How do I read command line parameters?

The standard function ParamCount: word will return the number of command line parameters, while function ParamStr(N: word): string will return the N-th parameter. (Under DOS 3.0 or greater, the 0-th parameter (ie, ParamStr(0)) is the path and file name of the current program.) Thus,
	function CommandLine: string;
	var
	  Idx:    word;
	  Result: string;
	begin
	  Result := '';
	  for Idx := 1 to ParamCount do
	    begin
            if Idx > 1 then Result := Result + ' ';
	    Result := Result + ParamStr(Idx);
	    end;
	  CommandLine := Result;
	end;
will return the whole command line, with any embedded whitespace (spaces or tabs) converted to single spaces. If you care about the amount or type of whitespace, or you want commas, semicolons, and equal signs to count as parameter separators (as per ancient versions of DOS manuals), see the next question:

1.2: How do I read the whole command line?

ParamCount and ParamStr are for parsed parts of the command line and cannot be used to get the command line exactly as it was. If you try to capture
	"Hello.   I'm here"
you'll end up with a false number of blanks. For obtaining the command line unaltered use
	type CommandLines = string[127];
	function CommandLine: CommandLines;
	type
	  CommandLinePtr = ^CommandLines;
	begin
	  CommandLine := CommandLinePtr( Ptr(PrefixSeg, $80) )^;
	end;
A warning. If you want to get this correct (the same goes for TP's own ParamStr and ParamCount) apply them early in your program, before any disk I/O takes place.

For the contents of the Program Segment Prefix (PSP) see a DOS Technical Reference Manual (available on the Microsoft DevNet CD) or Tischer, Michael (1992), PC Intern System Programming, p. 753.

- Based on [ts]'s Turbo Pascal FAQ


Logarithms, Trigonometry, and Other Numerical Calculations

I often find it convenient to define floating-point functions in terms of a type float = {$ifopt N+} double {$else} real {$endif}, rather than either explicitly using real or double. This way, the same function will automatically use the 'best' argument and result type for either the N+ (80x87) or N- state, without any changes and without obscuring its logic with lots of {$ifdef}s.

2.1: How do I calculate X^Y (X**Y)?

Prof. Timo Salmi writes
Pascals do not have an inbuilt power function. You have to write one yourself. The common, but non-general method is defining
	function POWERFN(number, exponent: float): float;
	begin
	  PowerFn := Exp(Exponent*Ln(Number));
	end;
To make it general use:
	(* Generalized power function by [ts] *)
	{  Some modifications by jds }
	function GenPowFn(Number, Exponent: float): float;
	begin
	 if (Exponent = 0.0)
	   then GenPowFn := 1.0
	   else if Number = 0.0
	     then GenPowFn := 0.0
	     else if Abs(Exponent*Ln(Abs(Number))) > 87.498
	       then RunError(205) {Floating point overflow}
	       else if Number > 0.0
	         then GenPowFn := Exp(Exponent*Ln(Number))
	         else if (Number < 0.0) and (Frac(Exponent) = 0.0)
		   then if Odd(Round(Exponent))
	             then GenPowFn := -GenPowFn(-Number, Exponent)
	             else GenPowFn :=  GenPowFn(-Number, Exponent)
		   else RunError(207); {Invalid float-op}
	end;  (* genpowfn *)

On the lighter side of things, here's an extract from an answer of mine [TS] in the comp.lang.pascal UseNet newsgroup:

> anyone point out why X**Y is not allowed in Turbo Pascal?
The situation in TP is a left-over from standard Pascal. You'll recall that Pascal was originally devised for teaching programming, not for something as silly and frivolous as actually writing programs. :-)

For the common special-case where you're raising a floating point number to an integral power (eg, X^7 or Y^3), you can use this fast code:
	function RealPower(Base: Float; Power: word): Float;
	begin
	  if Odd(Power)
	    then if Power = 1
	      then RealPower := Base
	      else RealPower := Base * RealPower(Base, Power - 1)
	  else if Power = 0
	    then RealPower := 1
	    else RealPower := Sqr(RealPower(Base, Power shr 1));
	end;

2.2: How do I take 'un-natural' logarithms?

Just define
	function Log(X, Base: float): float;
	begin
	  Log := Ln(X) / Ln(Base);
	end;
This result is based on some elementary math. By definition y = log(x) in base B is equivalent to x = B^y (where the ^ indicates an exponent). Thus ln(x) = y ln(B) and hence y = ln(x) / ln(B).

- A lightly-edited version of the answer from [ts]'s Turbo Pascal FAQ

2.3: Why do the trig functions like Sin() and Cos() give the wrong answers?

While most people express angles in degrees, the trig functions expect their arguments to be in radians. For historical reasons, a complete rotation is 360 degrees; for more cosmological reasons, the same complete rotation is 2 * Pi radians (the circumference of a circle with a radius of 1). Thus, to convert degrees to radians, just divide by 180 / Pi.

2.4: How do I calculate ArcSin() or ArcCos()?

Borland Pascal does not have ArcSin or ArcCos functions. It does have an ArcTan function, and the online help for that function gives the following conversion formulae:
	ArcSin(x) = ArcTan (x/sqrt (1-sqr (x)))
	ArcCos(x) = ArcTan (sqrt (1-sqr (x)) /x)

Dr. John Stockton, jrs@merlin.dclf.npl.co.uk, points out that ArcTan will always return a value between -Pi / 2 and Pi / 2. Also, there are two angles in the range from 0 to 2 pi for any given sine or cosine value, even though the formulae above will only give you one of them. For this reason, the formula ArcCos(x) = (Pi / 2) - ArcSin(X) from the CRC Standard Mathematical Tables handbook is generally better.

2.5: Can I trap (and recover from) floating point overflow errors?

Duncan Murdoch [dm] writes:
Because the floating point processor operates in parallel to the integer processor, this is generally quite tricky. The best approach is not to trap the errors, but just to mask them, and at the end of a calculation check whether they have occurred by examining the coprocessor status word.

Be aware that Borland's string-conversion routines (used in Str, Write and Writeln) clear the FPU's status word. If you do any I/O of floating point values in between status checks, you may miss seeing signs of errors.

I would add that it's probably best to leave the floating point overflow exception on (unmasked) in the vast majority of your code, and that you should only mask it off around the few calculations where you expect and can handle a possible overflow. That is, a runtime error is probably better than allowing the program to continue with unnoticed math errors!

The following demo code may be helpful:

	function Get87CtrlWord: word; assembler;
	var
	  CtrlWord: word;
	asm
		fstcw	[CtrlWord]
		mov	ax,[CtrlWord]
	end;

	procedure Set87CtrlWord(NewCtrlWord: word); assembler;
	asm
		fldcw	[NewCtrlWord]
	end;

	function Get87StatusWord: word; assembler;
	var
	  StatusWord: word;
	asm
		fstsw	[StatusWord]
		mov	ax,[StatusWord]
	end;

	const
	  InvalidOp	= $01;
	  DenormalOp	= $02;
	  ZeroDivide	= $04;
	  Overflow	= $08;
	  Underflow	= $10;
	  Precision	= $20;

	var
	  Ctrl, Status: word;
	  X, Y: double;

	begin
	  Ctrl := Get87CtrlWord;
	  Set87CtrlWord(Ctrl or Overflow); {Setting a bit masks the exception}
	  X := 1e308; Y := X * X;
	  Status := Get87StatusWord;
	  Set87CtrlWord(Ctrl);
	  if (Status and Overflow) <> 0    {A set bit indicates an exception}
	    then WriteLn('Overflow flag set')
	    else WriteLn('Overflow flag clear');
	end.
[dm] adds
	const
	  StackFault    =  $40;
	  StackOverflow = $200;
These bits are supported in the 387 and up; together they indicate a stack overflow (both set) or stack underflow (just StackFault).

Zweitze de Vries <Z.A.deVries@et.tudelft.nl> adds

Windows programmers who want to deal with floating point code are always dealing with WIN87EM.DLL. This DLL manages the FP processor, and, when not available, emulates it.

Explanation on this DLL, as well as exception handling, is explained in WINFLO.ZIP. This technical article is on the MSN CD.

2.6: Why do I always get the same random numbers every time I run my program?

Software random number generators apply a function to a RandSeed which cycles the seed through its possible values in a quasi-random way. Each call to the random number generator does one iteration of the function, and returns a result based on the new seed value.

When your program loads, this seed will have some default value (probably 0). If you do not change the seed, a series of calls to the random number generator will yield the same series of "random" numbers every time your program is run. (Obviously, this will make it easier to track down the bugs!) Typically, the system clock is used to provide a value for the random number seed: Even if a given task is always run at the same time of day, a difference of a few milliseconds is enough to put a good random number generator in an entirely different part of its sequence.

In Borland Pascal, the command to randomize the seed is (surprise!) Randomize. Note that you should only call this routine once per program, when it first loads, or at the very least at times separated by minutes or hours - calling it on every timer tick (say) will just reset the 'random' sequence several times a second!


Strings and Numbers

3.1: How do I convert a string to a number?

In Turbo/Borland Pascal, you can use the standard Val() procedure. The first argument is a string, and the second argument is a numeric variable which will be set to the numeric value represented by the string. The result variable can be any of the numeric types - from byte or ShortInt to comp or extended - the compiler will automagically pass the variable's type to the Val() procedure.

Val() is a procedure, not a function, which means that it does not return any sort of error code to indicate that it couldn't set the result variable because eg the string was 'Four score and seven' not '87', or because the string was '3.14159' and the result variable was a word, or even because '12261958' is too big for a word variable. Obviously, you do want to be able to find out whether Val() was able to decode the string. This is where the third parameter - an integer (or word) variable which will receive a result code - comes in. If the result code is 0, then the string represents a number which could be (and was) placed in the result variable; a nonzero result code means that the string does not represent a compatible number: the result variable has not been changed, and the error code is the index of the first illegal character in the string.

Note that Val() and ReadLn() can handle hexadecimal numbers, using the $1234 format.

3.2: How do I convert a number to a string?

In Turbo/Borland Pascal, you can use the standard Str() procedure. The first argument is a number, and the second is a string variable which will be set to the formatted value. Just as with Write() and WriteLn(), the number may (but does not have to) be followed by a colon and a width specifier and (for float point numbers) a second colon and a number of digits after the decimal point.

Str() is a procedure, not a function, which makes it a lot harder to use than, say, WriteLn(). Obviously, it's pretty trivial to put a 'wrapper' around it so that you can write string expressions like Fmt(Month,2) + DateSep + Fmt(Day,2) + DateSep + Fmt(Year,2):

	type NString = string[20];
	function Fmt(N: LongInt; Width: word): NString;
	var Result: NString;
	begin
	  Str(N: Width, Result); {A width of 0 is the same as no width at all}
	  Fmt := Result;
	end;

While Val() can read hex strings, there's no way to force Str() to produce a hex string. For that, you can use

	type HexString = string[8];
	function HexFmt(Int: LongInt; Width: integer): HexString;
	const Hex: array[0..$000F] of char = '0123456789ABCDEF';
	begin
          if (Width <= 1) and (Int and $FFFFFFF0 = 0)
	    then HexFmt := Hex[Int]
	    else HexFmt := HexFmt(Int shr 4, Width-1) + Hex[Int and $000F];
	end;

Breaking The 64K Limit

4.1: I have 64K of global data and can't add anymore - what do I do?

What you have to do is to find the largest data structures. A good way to do this is to look at a .map file with the addresses of "public" names, and look for large jumps between names. Often, a big jump flags a big variable. However, the .map file will not show any variables that are private to a unit, so a big jump may just indicate a lot of private variables within a unit. In that case, you'll have to look at the unit's source code to see what's taking up so much space.

When you find your largest data structures, look at how they're used. (The cross-reference tool in the BP7 IDE is an excellent way to do this.) If they're only used in a single function or procedure, you can move them into that procedure's local variables section, which will get them out of the global data segment and onto the stack.

Of course, this may now cause the stack to be too big. If so, or if the data are used in more than one place, you'll have to move the data structure onto the heap. To do this, you'll have to do three things:

  1. Replace a declaration like
    var BigVar: BigType;
    with
    var SmallVar: ^BigType;
  2. Change all references to BigVar to SmallVar^. Because BP is so fast, it's usually quite practical to just keep compiling until you get no more 'BigVar unknown' or 'need a ^' errors.
  3. Somewhere in your program initialization, before you ever execute any code that refers to SmallVar^, do a New(SmallVar); to allocate space on the heap.

    It's a good idea to get in the habit of using Dispose() whenever you no longer need the space you've allocated, but it's not strictly necessary, here: neither DOS nor Windows will 'lose' any memory that you allocate but don't free when your program terminates.

One thing to keep in mind is that reading or writing (dereferencing) a pointer is slower than reading or writing a global or local variable, especially in protected mode. Generally, you shouldn't worry about this sort of thing except in bottleneck code but, where efficiency does matter, you should definitely replace a series of dereferences of the same pointer with a single with statement. (BP7 is significantly better at "peephole" optimization than its predecessors, but even in BP7 there are cases where a with PtrVar^ statement produces better code than the equivalent series of 'raw' pointer statements. Certainly replacing multiple instances of Row[Idx]^ or even RecordPtr^.RecordField with a single with will result in smaller and faster code.)

Finally, a word of admonition: You should use global data very sparingly. If you are pushing the 64K limit, and it's not all in a handful of large buffers, you're almost certainly using too many global variables. Obviously, global variables that are only used in one place waste space; less obviously, using global variables tends to produce bugs. A seemingly innocuous change to a variable here can have effects way over there. You can fight this sort of potentially crippling interdepence by explicitly passing parameters to a function, and explicitly returning results. It can be impossible to totally avoid writing code that has side-effects, but such code should be avoided as much as possible -- and always documented.

4.2: Can I have more than 64K of global data in my Windows program?

Yes and no. Your .exe module can only have a single 64K data-and-stack segment, but each .dll has its own, up-to-64K data segment. Thus, if you run out of room in your global data segment, you can move some units and their global data into a DLL.

There are two things to keep in mind if you do this:

  1. A call to a DLL is more expensive than a call within an EXE. Each call into a DLL swaps data segments on the way in and on the way out.
  2. If a user is running two or more copies of your program at the same time, each copy shares the code, but has its own copy of the .exe's global data. However, there will only be one copy of the .dll's global data, no matter how many copies of your application (or how many different applications) are using it.

    That is, any global variables in your .exe are a task resource; any global variables in a .dll are a system resource.

4.3: How can I build an array bigger than 64K?

Break the array into two (types of) pieces: an array of row ptrs, and a set of rows on the heap. That is, replace
	type BigArrayType = array[0..Rows, 0..Cols] of DataType;
	var  BigArray: BigArrayType;
with
	type BigArrayRow  = array[0..Cols] of DataType;
	     BigArrayType = array[0..Rows] of ^ BigArrayRow;
	var  BigArray: BigArrayType
and replace any references to BigArray[Row, Col] with references to BigArray[Row]^[Col]. (As per the answer to 4.1, don't forget to allocate memory for each row!)

If performance isn't a major issue, you might well want to encapsulate the array behavior in an object. That is, instead of replacing BigArray[Row, Col] with BigArray[Row]^[Col], you would replace it with calls to BigArray.Get(Row, Col) or BigArray.Set(Row, Col, NewVal). While this is a bit slower than direct array references, the object (compiled) code is smaller and the source code is both easier to read and easier to change. If you need to add virtual memory (swapping to and from disk, EMS, or XMS) or to move your code to a 32-bit compiler, you would only have to change the object definitions, not every reference to your big array.

(One way to maintain both modifiability and good performance is to replace the array of row pointers with a function that returns a row pointer. Since you only need to call this once, no matter how many operations you're doing on the row, using your huge array might not be much slower than a normal array. Since the function can do anything from simply looking up a pointer in an array to swapping out the Least Recently Used row and swapping in the one you need, you maintain flexibility.)

If the array has a lot of rows, and the rows are not somemultiple of 8 (or 16 bytes) long, you might end up wasting a lot of space at the end of each row. If so, and if you're just barely running out of room, you might want to New() a "multi-row" type, that consists of an array of 8 (or 16) individual rows. This will eliminate the wasted pad bytes, and will only complicate your setup and teardown code: since the row pointer array will still point to the start of each individual row, access to any individual array element will be no different than if each row is its own heap block.

Of course, decomposing an array in this way only works if the array has two (or more) dimensions. See the next question if you have to deal with a one-dimensional data stream that's larger than 64K.

4.4: How do I handle .BMP and/or .WAV files with more than 64K of data?

There are two issues here: allocating a single heap block that's bigger than 64K, and accessing it. Both are significantly different in real mode than in protected mode.

Real mode:
In real mode, the primary issue is allocating the space: BP's heap manager won't let you allocate blocks bigger than 63 and a bit K-bytes. One approach is to simply rely on the current implementation's behavior and break your large heap request into multiple subrequests. If previous allocation and deallocation hasn't left the heap fragmented, back-to-back allocations will all be contiguous: The last byte of one will be just below the first byte of the next. This behavior is not guaranteed by Borland, though, and may change in future releases; similarly, if the heap is fragmented, back-to-back allocations will probably not be contiguous. A better approach is to restrict the size of the heap, and to use DOS services to allocate memory outside of your .exe's memory map.

However you allocate it, you will still have to access it. In real mode, this is simply a matter of understanding that the segment part of a pointer is multiplied by 16 and added to the offset part to obtain a linear address within the first meg of memory. You can thus use a function like

	function RealPtrTo(Base: pointer; Offset: LongInt): pointer;
	{Note:  This function has NOT been pulled from existing code
	 and has NOT been tested.  JDS, 30 September 1994}
	var Normal: record Segment, Offset: word; end;
	begin
	  Normal.Segment := Seg(Base^) + Ofs(Base^) shr 4;
	  Normal.Offset  := Ofs(Base^) and $000F;
	  {Normalise the Base pointer}
	  Inc(Offset, Normal.Offset); {# bytes from start of Base seg}
	  RealPtrTo := Ptr(Normal.Segment + Offset shr 4,
	                   Normal.Offset + Offset and $0000000F);
	end;
to generate a pointer to any byte within your huge data structure. This pointer can then be used just as you use any other 16-bit pointer, to address an up-to-64K window within your huge data.

Protected mode:
In protected mode, allocation is easy, and access is hard. Just use GlobalAlloc() or GlobalAllocPtr() to allocate however much space you need. (Well, if your program is running in Windows standard mode, this had better be less than or equal to one meg.)

Once you've allocated it, life continues to be easy - if you're using 386 Enhanced Mode and a 32-bit compiler or assembler. The selector you get from GlobalAllocPtr can be used with any 32-bit offset within the declared size of the heap block. If you're using Standard Mode, or 16-bit compilers like TPW or BP7, though, you'll have to work a bit.

To start with, you can't do segment arithmetic: segments have been replaced with selectors, which are essentially indices into a system-global table of allocated segments. Doing arithmetic with selectors will either result in value that points to the wrong selector or (more likely) produce an invalid selector. In either case, using the resulting pointer will probably produce a General Protection Fault.

This is a complicated subject that I've already covered elsewhere (see http://www.midnightbeach.com/jon/pubs/huge-model.htm for my PC Techniques article on huge model programming): All I'll say here is that

  1. You have to use SelectorInc to 'step' the selector from one 64K window to the next, and
  2. You can't make a single reference that starts in one 64K window and ends in the next.

Procedural Types

5.1: Can I make an indirect call to an object's method, using a pointer or a procedural type?

Yes, but you'll need to make aggressive use of casting, and to have a bit of background on just what a method call is. While method calls look and act very differently than normal calls -- the call looks like a reference to one of the object's fields, and there's the implicit with Self do that lets us refer to the object's fields as if they were global variables -- at the level of words on the stack they're not all that different from a normal procedure or function call. All methods have an `invisible', or implicit, parameter, var Self, after any regular, or explicit, parameters; constructors and destructors also add an implicit word parameter (the 16-bit VMT pointer) between the explicit parameters and Self. Also, while constructors act as if they return a boolean, they actually return a pointer which contains @ Self if Fail was not called, and Nil if it was.

The implicit parameters and the special handling of constructor results are the only differences between method calls and normal calls: there's no magic involved. If we simply define a procedural type, ProcType, that explicitly declares the method's implicit parameters after any normal parameters, we can then use ProcType to cast any pointer variable to a procedural variable. Once it's cast, the pointer acts just like a normal procedural variable; we can assign it to another procedural variable or use it to call a procedure. Just as with a normal procedural type, the only difference between a direct and indirect call lies in the way we make the call: The parameters are pushed and popped in the same way; the called code operates just the same; and indirectly called methods have the same full access to their object's fields (through the Self pointer) as directly called methods do.

Thus, if we have a method with no arguments and no results, we would simply make the declaration type Niladic = procedure (var Self);. To use it, we remember that we can only cast pointer variables, not pointer expressions, and so do something like PtrVar := @ ObjectType.Method; Niladic(PtrVar)(Self); Now, while there is something strange looking about a cast (in parentheses) followed by an argument list (in parentheses), indirect method calls are typically rare and concentrated in a few key routines, even in programs that rely heavily on them. (My typical uses for indirect method calls involve things like executing a list of object/method pairs on every timer tick, or calling a window object's message handler after DMT lookup reveals that it does have a handler.) What's more, the strange look of an indirect method call does not translate into strange object code: Using a cast to a procedural type generates the exact same code as using an normal procedural type, and that's both a little smaller and only slightly slower than a normal, direct procedure or function call.

Methods that require parameters or that return results are only slightly different than our Niladic example above. We simply have to remember to put any explicit parameters before the implicit parameter(s). Thus, we might use type SimplePredicate = function (var Self): boolean; for a method that takes no arguments and returns a boolean, and type UntypedDyadic = procedure (var A, B; var Self); for a method that requires two untyped memory references.

Just as with a normal procedure call, the compiler will not let us make an indirect method call with the wrong number or type of arguments. This is obviously desirable behavior, but it's tempered with a bit of a caveat: When we make a cast, we are effectively telling the compiler that we know exactly what we are doing. If we accidentally use a pointer to a UntypedDyadic method as a Niladic, the compiler will neither require nor accept the two var parameters to the UntypedDyadic method but the procedure will probably use them and the result will not be pretty! Similarly, the compiler will not complain if you cast a data pointer or the address of a near routine into a procedural type: it will blithely generate code that will (at best!) crash your computer.

This answer is based on my [jds] article Three Myths About Procedural Variables which originally appeared in the Dec/Jan 1993 issue of PC Techniques.

Windows Sound Programming

6.1: Where can I find documentation on Windows sound programming?

For a start, try MMSYSTEM.HLP, in your \bp\bin directory.
(The BP7 install program creates an icon for this in the Borland Pascal program group, but many people simply copy the BPW icon to a working group, and zap the BP group. Then, when they want to do some sound programming, they find there is no mention of it in the online help file, and they don't know where to turn.)
Unfortunately, MMSYSTEM.HLP only contains part of material in the SDK's Multimedia Programmer's Reference. Piecing together the sequence of steps to properly open a MIDI or WAV device from the help file can be tough! I strongly recommend the SDK - or, better, the DevNet CD.

Delphi and/or BP8

7.1: What about Delphi?

At the time of this writing, Delphi groups are still being voted on. In the meantime, please post your Delphi questions in comp.lang.pascal.misc, not here in comp.lang.pascal.borland. Yes, I know this is silly - Delphi is a Borland Pascal product - but if you post your Delphi questions here, you'll just give some stupid twits yet another excuse to flame.

7.2: Will there be a BP8?

Why are you asking me? I don't work for Borland! But, this sure is a FAQ, so here's my opinion:

No way!
  1. Anders Hjeilsberg is undoubtedly a genius, but even he can be spread too thin.
  2. Since Delphi can compile TPW and BP7 Windows programs, the only real point to a BP8 would be DOS support. I doubt there's enough demand to justify the expense of releasing even as easy a BP8 as the Delphi compiler with the BP7 DOS IDE.

Other Pascal Resources


Runtime Error 200 when using CRT unit on fast computers

The CRT unit has a 'speed-independent' Delay() routine that works pretty well on machines from a 4.77MHz 8088 to all the way up to Pentiums running at nearly 200 MHz. Above that speed, though, programs using the CRT unit give a Runtime Error 200 (division by 0) error when they start running.

The reason for this error is that the CRT unit's initialization code 'tares' the CPU speed by seeing how many iterations of an empty loop it can run between one clock tick and the next. This lets it calculate how many empty loops it needs for each millisecond of Delay(). The problem is that on fast machines, the very large number of idle loops the machine can do in 55 milliseconds divided by 55 is too big a number to fit in a 16-bit register. The processor throws the same exception (interrupt) for overflow as for division by 0, so the error surfaces as a Runtime Error 200.

For more information: http://www.merlyn.demon.co.uk/pas-r200.htm
For patches: http://www.geocities.com/SiliconValley/2926/tp_pat.html


Jon Shemitz - jon@midnightbeach.com - 30-Sep-94..22-Jan-99