SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00053 MEMORY/DPMI MANAGEMENT ROUTINES 1 05-28-9313:50ALL SWAG SUPPORT TEAM BIGMEM1.PAS IMPORT 13 ä▒÷
> I have seen posts about using Pointer Arrays instead of the standard fixedπ> Arrays. These posts have been helpful but I think the rewriting of an exampleπ> problem would benefit me the best. Please take a look at this simple exampleπ> code:π>π> Program LotsofData;π>π> Type LOData = Array [1..10000] of Real;π>π> Var Value : LOData;π> MaxSizeArray, I, NumElement : Integer;π> NewValue : Real;π>π> beginπ> Write('Please input the Maximum Size of the Array: ');π> Readln(MaxSizeArray);π> For I := 1 to MaxSizeArray Doπ> Value[I] := 0.0;π> Writeln('Array Initialized');π> Writeln;π> Write('Please input the Number of Array Element to Change: ');π> Readln(NumElement);π> Write('Please input the New Number For Value[',NumElement,']: ');π> Readln(NewValue);π> Value[NumElement] := NewValue;π> end.π>ππResponse;π1. Declare the Variable Value as LOData -π e.g. Var Value : LOData;ππ2. Read MaxSizeArray;ππ3. Allocate memory For the Array by using NEW() or GETMEM()π e.g. NEW(Value);π or GetMem(Value, Sizeof(Real) * MaxSizeArray);ππGetmem() is better because you can allocate just the precise amount ofπmemory needed.ππ4. From then on refer to your Array as Valueπ e.g. Value[Element] := NewValue;ππ5. When you finish, deallocate memory byπ [a] Dispose(Value) - if you used NEW() to begin with, orπ [b] FreeMem(Value, Sizeof(Real) * MaxSizeArray) - if you usedπ GetMem() to begin with.ππ 2 05-28-9313:50ALL SWAG SUPPORT TEAM BIGMEM2.PAS IMPORT 10 ä▒≤ {πBP7 is not limited to 16Meg of memory, by running the Program below in aπWindows 3.1 Window, it created 744 Objects allocating 30Meg of memory. Theπfinal printout verified that all the items were still there.ππSo if you use a third party DPMI server, you should be able to use all yourπmemory.ππI might point out that I allocated 30Meg of memory on my 16Meg machine. I runπWindows 3.1 With a 32Meg permanent swap File.π}ππProgram BigMemory;πUsesπ OpStrDev,Objects;ππTypeπ PDataType=^DataType;π DataType=Object(tObject)π C:LongInt;π S:String;π Stuffing:Array[1..40000] of Byte;π Constructor Init(I:LongInt);π end;πVarπ Counter:LongInt;π List:TCollection;ππConstructor DataType.Init(I:LongInt);πbeginπ tObject.Init;π C:=I;π Write(tpstr,'I = ',I,' I div 2 =',I div 2);π S:=returnstr;πend;ππProcedure Printall;π Procedure PrintOne(P:PDataType);Far;π beginπ Writeln(P^.C,' - ',P^.S);π end;πbeginπ List.Foreach(@PrintOne);πend;ππbeginπ Counter:=0;π List.Init(1000,1000);π Repeatπ inc(Counter);π List.Insert(New(PDataType,Init(Counter)));π Write(Counter,' mem =',Memavail,^M);π Until Memavail<50000;π PrintAll;πend.π 3 05-28-9313:50ALL SWAG SUPPORT TEAM CMOSSTUF.PAS IMPORT 69 ä▒
α (*******************************************************************)π Program SaveCMOS; { Compiler: Turbo & Quick Pascal }π{ }π{ File name: SaveCMOS.PAS coded: Mar.3.1993, Greg Vigneault }π{ }π{ This utility will read the entire contents of the CMOS RAM, and }π{ save it to a File. Invoke this Program as... }π{ }π{ SAVECMOS <Filename> }π{ }π Uses Crt; { import ReadKey }π Const AddressRTC = $70; { RTC register address latch }π DataRTC = $71; { RTC register data }π AStatusRTC = $0A; { RTC status register A }π Var tempCMOS,π RegCMOS : Byte; { RTC register }π MapCMOS : Array [0..63] of Byte; { RTC CMOS reg map }π OutFile : File; { saved CMOS data }π ch : Char; { For user input }π FResult : Integer; { check File Write }π(*-----------------------------------------------------------------*)π Function ReadCMOS( RegCMOS :Byte ) :Byte;π beginπ RegCMOS := RegCMOS and $3F; { don't set the NMI bit }π if (RegCMOS < AStatusRTC) then { wait For end of update? }π Repeatπ Port[AddressRTC] := AStatusRTC; { read status }π Until (Port[DataRTC] and $80) <> 0; { busy bit }π Port[AddressRTC] := RegCMOS; { tell RTC which register }π ReadCMOS := Port[DataRTC]; { and read in the data Byte }π end {ReadCMOS};π(*-----------------------------------------------------------------*)π Procedure HelpExit;π begin WriteLn; WriteLn( 'Usage: SAVECMOS <Filename>' );π WriteLn( CHR(7) ); Halt(1);π end {HelpExit};π(*-----------------------------------------------------------------*)π beginπ WriteLn; WriteLn( 'SaveCMOS v0.1 Greg Vigneault' ); WriteLn;π if (ParamCount <> 1) then HelpExit;π Assign( OutFile, ParamStr(1) );π {$i-} Reset( OutFile, SizeOf(MapCMOS) ); {$i+}π if (IoResult = 0) then beginπ Repeatπ Write('File ',ParamStr(1),' exists! OverWrite? (Y/N): ',#7);π ch := UpCase( ReadKey ); WriteLn;π Until (ch in ['Y','N']);π if (ch = 'N') then begin WriteLn('ABORTED'); Halt(2); end;π end;π ReWrite( OutFile, SizeOf(MapCMOS) ); WriteLn;π For RegCMOS := 0 to 63 do MapCMOS[RegCMOS] := ReadCMOS(RegCMOS);π MapCMOS[AStatusRTC] := MapCMOS[AStatusRTC] and $7F; { clear UIP }π BlockWrite( OutFile, MapCMOS, 1, FResult );π if (FResult <> 1) then beginπ WriteLn( 'Error writing to ',ParamStr(1),'!',#7 );π Close( OutFile ); Halt(3);π end;π FillChar( MapCMOS, SizeOf(MapCMOS), 0 );π Reset( OutFile, SizeOf(MapCMOS) );π BlockRead( OutFile, MapCMOS, 1, FResult );π if (FResult <> 1) then beginπ WriteLn( 'Error reading from ',ParamStr(1),'!',#7 );π Close( OutFile ); Halt(4);π end;π Close(OutFile);π For RegCMOS := 10 to 63 do begin { don't include time in verify }π if (RegCMOS = AStatusRTC) thenπ MapCMOS[RegCMOS] := MapCMOS[RegCMOS] and $7F;π if (MapCMOS[RegCMOS] <> ReadCMOS(RegCMOS)) then beginπ WriteLn('!!! Error: can''t verify File contents !!!');π WriteLn(#7#7#7#7#7); Halt(5);π end;π end;π WriteLn('! The CMOS RAM has now been saved in ',ParamStr(1),#7);π end {SaveCMOS}.π(*******************************************************************)ππ Greg_ππ Mar.03.1993.Toronto.Canada. greg.vigneault@bville.gts.orgπ---π ■ QNet3ß ■ City2City / 1/0/11 / Baudeville BBS / Toronto / 416-283-0114π<<<>>>πππDate: 03-04-93 (03:03) Number: 127 of 160 (Echo)π To: CHRIS LAUTENBACH Refer#: NONEπFrom: GREG VIGNEAULT Read: 03-05-93 (17:02)πSubj: TP: LOADCMOS SOURCE CODE Status: PUBLIC MESSAGEπConf: C-ProgramMING (368) Read Type: GENERAL (+)ππ(*******************************************************************)π Program LoadCMOS; { Compiler: Turbo & Quick Pascal }π{ }π{ File name: LoadCMOS.PAS coded: Mar.3.1993, Greg Vigneault }π{ }π{ LOADCMOS <Filename> }π{ }π Uses Crt; { import ReadKey }π Const AddressRTC = $70; { RTC register address latch }π DataRTC = $71; { RTC register data }π AStatusRTC = $0A; { RTC status register A }π BStatusRTC = $0B; { RTC status register B }π CStatusRTC = $0C; { RTC status register C }π DStatusRTC = $0D; { RTC status register D }π SecondsRTC = 0; { seconds (BCD, 0..59) }π MinutesRTC = 2; { minutes (BCD, 0..59) }π HoursRTC = 4; { hours (BCD, 0..23) }π WeekDayRTC = 6; { day of week (1..7) }π DayOfMonthRTC = 7; { day of month (BCD, 1..31) }π MonthRTC = 8; { month (BCD, 1..12) }π YearRTC = 9; { year (BCD, 0..99) }π Var RegCMOS : Byte; { RTC register }π MapCMOS : Array [0..63] of Byte; { RTC CMOS reg map }π ChkSumCMOS : Integer; { CMOS checksum }π InFile : File; { saved CMOS data }π ch : Char; { For user input }π FResult : Integer; { check File Write }π(*-----------------------------------------------------------------*)π Procedure WriteCMOS( RegCMOS, Value :Byte );π Var temp : Byte;π beginπ if not (RegCMOS in [0,1,CStatusRTC,DStatusRTC]) thenπ beginπ if (RegCMOS < CStatusRTC) then beginπ Port[AddressRTC] := BStatusRTC;π temp := Port[DataRTC] or $80; { stop the clock}π Port[AddressRTC] := BStatusRTC;π Port[DataRTC] := temp;π end;π Port[AddressRTC] := RegCMOS and $3F; { select reg }π Port[DataRTC] := Value; { Write data }π if (RegCMOS < CStatusRTC) then beginπ Port[AddressRTC] := BStatusRTC;π temp := Port[DataRTC] and not $80; { enable clock }π Port[AddressRTC] := BStatusRTC;π Port[DataRTC] := temp;π end;π end;π end {WriteCMOS};π(*-----------------------------------------------------------------*)π Procedure HelpExit;π begin WriteLn; WriteLn( 'Usage: LOADCMOS <Filename>' );π WriteLn( CHR(7) ); Halt(1);π end {HelpExit};π(*-----------------------------------------------------------------*)π beginπ WriteLn; WriteLn( 'LoadCMOS v0.1 Greg Vigneault' ); WriteLn;π if (ParamCount <> 1) then HelpExit;π Assign( InFile, ParamStr(1) );π {$i-} Reset( InFile, SizeOf(MapCMOS) ); {$i+}π if (IoResult <> 0) then beginπ Write('Can''t find ',ParamStr(1),'!',#7);π Halt(1);π end;π FillChar( MapCMOS, SizeOf(MapCMOS), 0 ); { initialize }π BlockRead( InFile, MapCMOS, 1, FResult ); { saved CMOS }π Close(InFile);π if (FResult <> 1) then beginπ WriteLn('! Error reading File',#7);π Halt(2);π end;π MapCMOS[AStatusRTC] := MapCMOS[AStatusRTC] and $7F;π ChkSumCMOS := 0; { do checksum }π For RegCMOS := $10 to $2Dπ do ChkSumCMOS := ChkSumCMOS + Integer( MapCMOS[RegCMOS] );π if (Hi(ChkSumCMOS) <> MapCMOS[$2E])π or (Lo(ChkSumCMOS) <> MapCMOS[$2F]) then beginπ WriteLn('!!! CheckSum error in ',ParamStr(1) );π WriteLn(#7#7#7#7#7); Halt(2);π end;π For RegCMOS := AStatusRTC to 63π do WriteCMOS( RegCMOS, MapCMOS[RegCMOS] );π WriteLn('! The CMOS RAM has been restored from ',ParamStr(1),#7);π end {LoadCMOS}.π(*******************************************************************)π 4 05-28-9313:50ALL SWAG SUPPORT TEAM DPMIINFO.PAS IMPORT 164 ä▒▄ƒ Hello All,ππAgain, interrupts from protected mode. This is an updated version of myπprevious article, which, by the way, generated much less respons (none)πthan I expected. Where are the BTrieve Programmers, the DesqView APIπWriters, the fossil Writers, the .... Maybe they know everythingπalready. Well then, what has been changed?ππ* little bugs fixed (memory not freed, SEG does not work, etc.)π* I stated that if you want to pass parameters on the stack you had toπ do low level stuff. This is not necessary. I do everything in highπ level(?) pascal now.π* Point 5 of the first Type of unsupported interrupts was inComplete.π There's sometimes much more work involved :-(π* A simple Unit is presented, which helps to cut down code size. Seeπ Appendix AππCompiling Real to protected mode has been very simple For most of us.πJust Compile and go ahead. 99.5% of your code works fine. But the otherπ0.5% is going to give you some hard, hard work.π In this article I describe first how I first stuck on the protectedπstone. Than I try to give a general overview of problems one mightπencounter when using interrupts. Next I describe the solutions or giveπat least some hints, and I give a solution to the original Program whichπmade me aware of protected mode conversion problems. Appendix A listsπthe code For a Unit I found usefull when porting my DesqView API toπprotected mode.π References can be found at the end of this article. of course, allπdisclaimers you can come up With apply!πππWhen Compiling a big Program, which supported DesqView, a GP faultπoccurred. It was simple to trace the bug down: TDX would show me theπoffending code. You can get the same error if you try to run theπfollowing Program in protected mode:ππ========cut here==========================πProgram Test;ππFunction dv_win_me : LongInt; Assembler;πAsmπ mov bx,0001hπ mov ah,12hπ int 15h {* push dWord handle on stack *}π pop ax {* pop it *}π pop dx {* and return it *}πend;ππbeginπ Writeln(dv_win_me);πend.π========cut here==========================ππThis little Program must be run under DesqView. When run under DesqViewπit returns the current Window handle on the stack. BUT: when Compiledπunder protected mode NO dWord handle is returned on the stack. So aπstack fault occurs.ππWhat happened? I stuck on one of those unsupported interrupts. Onlyπsupported interupts guarantee to return correct results. You can find aπlist of all supported interrupts in the Borland Open ArchitectureπHandboek For Pascal, Chapter 2 (seperate sold by Borland, not includedπin your BP7 package). Supported are the general Dos and Bios interrupts.ππBeFore eleborating on supported and unsupported interrupts, I have toπexplain a few issues which are probably new to us Pascal Programmers.πWhenever a user interrupt occurs in protected mode (you issue a int xxπcall) Borlands DPMI Extender switches to Real mode, issues theπinterrupt, and switches back to protected mode.ππThis works find For most Cases: interrupts which only pass registerπparameters work fine. But what happens if you, For example, called theπPrint String Function? (int 21h, ah=09h). You pass as parameters ds:dxπpointing to the String to be printed. But, be aware: in protected modeπds contains not a segment but a selector! and the selector in dsπprobably points to an area above the 1MB boundary. These two things areπgoing to give Real mode Dos big, big problems. Don't even try it!π So Borland's DPMI Extender does more than just switching fromπprotected to Real mode when an interrupt occurs: it translates selectorsπto segments when appropriate. But, it can only do so For interrupts itπKNOWS that they need a translation. Such interrupts are calledπsupported. Interrupts about which Borland's DPMI Extender does not knowπabout are unsupported. and they are going to give you Real problems!ππSo you see, when only data is passed in Registers, everything worksπfine. But if you need to pass Pointers, there is a problem. But why didπthe above Program not work? It didn't use selectors you might ask. Well,πthere is another set of interrupts that are unsupported: those thatπexpect or return values on the stack. This is the Case With the aboveπProgram.ππSo, to conclude:π* supported interruptsπ - simple parameter passing using Registers, no segments/selectorsπ or stacks includedπ - interrupts which Borland's DPMI Extender knows about (too few Forπ most of us)π* unsupported interruptsπ - using segments/selectorsπ - involving stacksππIn the next two sections I will fix both Types of problems. I make useπof the DPMI Unit, which comes With the Open Architecture Handbook. Youπdo not need this Unit. As this DPMI Unit is just a wrapper around theπDPMI interrupt 31h, simply looking the interrupts up in Ralph Brown'sπinterrupts list and writing Functions/Procedures For them, works fine.πππUnsupported interrupts which need segmentsπ------------------------------------------ππBecause the data segment and stack segment reside in protected mode, youπneed to allocate memory in Real mode, copy your data (which residesπabove 1MB) and issue the interrupt by calling the DPMI Simulate RealπInterrupt. So our to-do list is:π1) allocate Real mode memoryπ2) copy data from protected mode to Real modeπ3) set up the Real mode Registersπ4) issue interruptπ5) examine resultsππ1) You can allocate Real mode memory by issueing a GlobalDosAlloc (notπ referenced in the online help, but you can look it up in theπ Programmer's refercence manual) request. The GlobalDosAlloc is in theπ WinApi Unit. For example:ππ Uses WinAPI;π Varπ Return : LongInt;π MemSize : LongInt;π beginπ MemSize := 1024;π Return := GlobalDosAlloc(MemSize);π end;ππ This call allocates a block of memory, 1K in size, below the 1MBπ boundary. The value in Return should be split in LongRec(Return).Loπ and LongRec(Return).Hi. The Hi-order Word contains the segment baseπ address of the block. The low-order Word contains the selector Forπ the block.ππ2) You use the selector to acces the block from protected mode and youπ use the segment of the block to acces the block within Real mode (yourπ interrupt).π For example: we want to exchange messages With some interrupt. Theπ code For this would be:π Uses WinAPI;π Varπ Return : LongInt;π MemSize : LongInt;π RealModeSel : Pointer;π RealModeSeg : Pointer;π Message : String;π beginπ MemSize := 256;π Return := GlobalDosAlloc(MemSize);π PtrRec(RealModeSel).seg := LongRec(Return).Lo;π PtrRec(RealModeSel).ofs := 0;π PtrRec(RealModeSeg).seg := LongRec(Return).Hi;π PtrRec(RealModeSeg).ofs := 0;ππ {* Both RealModeSel(ector) and RealModeSeg(ment) point to the sameππ physical address now. *}ππ {* move message from protected mode memory to the allocated selector *}π Message := 'How are your?';π Move(Message, RealModeSel^, Sizeof(Message));ππ {* issue interupt, explained below *}π { <..code..> }π {* the interrupt returns a message *}ππ {* move interrupt's message below 1MB to protected mode *}π Move(RealModeSel^, Message, Sizeof(Message));π Writeln(Message); {* "yes, I'm fine. Thank you!" *}π end;ππ3) We will now examine how to setup an interrupt For Real mode. Most ofπ the time this is transparantly done by Borland's DPMI Extender, butπ we are on our own now. to interrupt Dos, we use the DPMI Functionπ 31h, 0300h. This interrupt simulates an interrupt in Real mode.ππ The Simulate Real Mode Interrupt Function needs a Real mode registerπ data structure. We pass the interrupt and the Real mode register dataπ structure to this Function, which will than start to simulate theπ interrupt.π This Function switches to Real mode, copies the contents of theπ data structure into the Registers, makes the interrupt, copies theπ Registers back into the supplied data structure, switches theπ processor back to protected mode and returns. Voila: you are inπ control again.π Maybe you ask: why need I to setup such a data structure? Why canπ I not simply pass Registers? Several reasons exist, but take Forπ example the RealModeSeg of the previous example. You cannot simplyπ load a RealModeSeg in a register. Most likely a segment violationπ would occur (referring to a non existing segment or you do not haveπ enough rights etc.). ThereFore only in Real mode can Real modeπ segments be loaded.ππ The data structure to pass Registers between protected and Realπ mode can be found in the DPMI Unit which I Repeat here:ππ Typeπ TRealModeRegs = Recordπ Case Integer ofπ 0: (π EDI, ESI, EBP, EXX, EBX, EDX, ECX, EAX: LongInt;π Flags, ES, DS, FS, GS, IP, CS, SP, SS: Word);π 1: (π DI,DIH, SI, SIH, BP, BPH, XX, XXH: Word;π Case Integer ofπ 0: (π BX, BXH, DX, DXH, CX, CXH, AX, AXH: Word);ππ 1: (π BL, BH, BLH, BHH, DL, DH, DLH, DHH,π CL, CH, CLH, CHH, AL, AH, ALH, AHH: Byte));π end;ππ This looks reasonably Complex, doesn't it! More simply is theπ following structure (found in, For example, "Extending Dos" by Rayπ Duncan e.a.)π offset Lenght Contentsπ 00h 4 DI or EDIπ 04h 4 SI or ESIπ 08h 4 BP or EBPπ 0Ch 4 reserved, should be zeroπ 10h 4 BX or EBXπ 14h 4 DX or EDXπ 18h 4 CX or ECXπ 1Ch 4 AX or EAXπ 20h 2 CPU status flagsπ 22h 2 ESπ 24h 2 DSπ 26h 2 FSπ 28h 2 GSπ 2Ah 2 IP (reserved, ignored)π 2Ch 2 CS (reserved, ignored)π 2Eh 2 SP (ignored when zero)π 30h 2 SS (ignored when zero)ππ In the following example, I set the Registers For the above messageπ exchanging Function. It's best to clear all Registers (or at leastπ the SS:SP Registers) beFore calling the Simulate Real Mode Interrupt.ππ Uses DPMI;π Varπ Regs : TRealModeRegs;π beginπ FillChar(Regs, Sizeof(TRealModeRegs), #0); {* clear all Registers *}ππ With Regs do beginπ ah := $xx;π es := PtrRec(RealModeSeg).Seg;π di := PtrRec(RealModeSeg).ofsπ end; { of With }π end;ππ All this is fairly standard. Just set up the Registers you interruptsπ expect, very much like the Intr Procedure.ππ4) We can now issue the interrupt in Real mode using the RealModeIntπ Procedure (in the DPMI Unit). Its definition isππ Procedure RealModeInt(Int: Byte; Var Regs: TRealModeRegs);ππ or you can call int 31h, Function 0300h, see Ralph Brown's interruptπ list.π For our message exchanging Program it would simply be:π RealModeInt(xx, Regs);ππ5) Examine the results. Modified Registers are passed in the Regs dataπ structure so you can check the results.π It is necessary to discriminate between to Types of returnedπ segments. In the example above, I assumed that the Interrupt returnedπ data in the allocated memory block. I already have a selector Forπ that block, so I can examine the results.π Another Type of interrupt returns Pointers to segments it hasπ allocated itself. As we don't have a selector For that memory blockπ we have to create one. We need the following Functions:π - AllocSelectors, to allocate a selectorπ - SetSelectorBase, to let it point to a physical addressπ - SetSelectorLimit, to set the sizeπ An example For this situation: Assume that a certain interruptπ returns a Pointer to a memory area. This Pointer is in es:di.π Register cs contains the size of that memorya rea. I show you how toπ acces that segment.ππ Uses DPMI;π Varπ Regs : TRealModeRegs;π p : Pointer;π beginπ {* setup Regs *}π {* issue interrupt, returning es:di *}ππ {* as we don't have a selector, create one *}π PtrRec(p).Seg := AllocSelectors(1);π PtrRec(p).ofs := 0;ππ {* this selector points to no physical address and has size 0 *}π {* so let the selector point to es:di *}π SetSelectorBase(PtrRec(p).Seg, Regs.es*16+Regs.di);ππ {* Forgive me! This was a joke. The last statement does not work *}π {* of course. Regs.es*16+Regs.di will in the best Cases ({$R+,Q+}) *}π {* result in an overflow error. You have to Write: *}π SetSelectorBase(PtrRec(p).Seg, Regs.es*LongInt(16)+Regs.di);ππ {* the selector now points to a memory area of size 0 *}π SetSelectorLimit(PtrRec(p).Seg, Regs.cx);ππ {* we don't have to set the accesrights (code/data, read/Write, etc. *}π {* as they are almost ok *}ππ {* we can now acces this memory using selector p *}π { <acces block> }ππ {* after using it, free selector *}π FreeSelector(PtrRec(p).Seg);π end;πππAre there any questions? No? Let's go ahead than to the next Type ofπinterrupts.ππUnsupported interrupts which use the stackπ------------------------------------------πThe second Type of unsupported interrupts are the ones which make use ofπthe stack. We can distinguish between:π1. interrupts which need parameters on the stackπ2. interrupts which return parameters on the stackππ1) For the first Type we need to setup a stack. There is an extraπ Compilication, which I had not told yet. As the stack in protectedπ mode resides in a protected mode segment it is unusable For the Realπ mode interrups. So Borland's DPMI Extender switches from theπ protected to a Real mode stack (and back). We can supply a defaultπ Real mode stack if we set the stack Registers (ss and sp) in the Realπ mode register data structure to zero. else it is assumed that ss:spπ points to a Real mode stack. Failure to set them up properly couldπ have disastrous results!ππ We will have to do:π 1) create a Real mode stack using GlobalDosAllocπ 2) fill this stack With valuesπ 3) set ss and sp properlyπ 4) issue interruptππ All in one example Program. The following Program sets DesqView'sπ mouse on a given location on the screen. The supplied handle is theπ handle of the mouse. As DesqView needs dWord values on the stack Iπ allocated a LongIntArray stack which is defined as:ππ Constπ MaxLongIntArray = 1000;π Typeπ PLongIntArray = ^TLongIntArray;π TLongIntArray = Array [0..MaxLongIntArray] of LongInt;ππ The example Program:ππ Procedure SetMouse(Handle, x, y : LongInt);π Constπ StackSize = 3*Sizeof(LongInt);π Varπ Regs : TRealModeRegs;π Stack : PLongIntArray;π l : LongInt;π beginπ {* clear all Registers *}π FillChar(Regs, Sizeof(TRealModeRegs), 0);ππ {* setup the Registers *}π Regs.ax := $1200;π Regs.bx := $0500;ππ {* allocate the stack *}π l := GlobalDosAlloc(StackSize);ππ {* set stacksegment register sp. ss should be set to the bottom of *}π {* the stack = 0 *}π Regs.sp := LongRec(l).Hi;π Stack := Ptr(LongRec(l).Lo, 0);ππ {* fill the stack *}π Stack^[0] := Handle;π Stack^[1] := y;π Stack^[2] := x;ππ {* issue the interrupt *}π RealModeInt($15, Regs);ππ {* free the stack *}π GlobalDosFree(PtrRec(Stack).Seg);π end;ππ2) Looks much like solution above. if only values are returned on theπ stack. Don't Forget to set sp to the top of the stack. In the aboveπ example settings Regs.sp := StackSize;π An example is given below, where a solution to my originalπ problem is given.πππSolution For the dv_win_me Procedure:ππ Uses DVAPI, Objects, WinApi, WinTypes, DPMI;ππ Function dv_win_me : LongInt;π Constπ StackSize = Sizeof(LongInt);π Varπ Regs : TRealModeRegs;π RealStackSeg : Word;π RealStackSel : Word;π l : LongInt;π beginπ {* clear all Registers *}π FillChar(Regs, Sizeof(TRealModeRegs), #0);ππ {* allocate a 1 dWord stack *}π l := GlobalDosAlloc(StackSize);π RealStackSeg := LongRec(l).Hi;π RealStackSel := LongRec(l).Lo;ππ {* clear the stack (not necessary) *}π FillChar(Ptr(RealStackSel, 0)^, StackSize, #0);ππ {* set Registers *}π With Regs do beginπ bx := $0001;π ah := $12;π ss := RealStackSeg;π sp := StackSize;π end; { of With }ππ {* perForm Real mode interrupt *}π RealModeInt($15, Regs);π dv_win_me := PLongInt(Ptr(RealStackSel, 0))^;ππ {* free the stack *}π GlobalDosFree(PtrRec(RealStackSel).Seg);π end;ππ beginπ Writeln(dv_win_me);π end.πππYou see, code size bloats in protected mode! (ThereFore Borland gave usπ16MB....)πππAppendix A.π-----------ππAs promised, some routines I found usefull when working With Real modeπsegments.ππ====================cut here====================πUnit DPMIUtil;ππInterfaceππUses Objects, DPMI;ππConstπ MaxLongIntArray = 1000;πTypeπ{* this Type is usefull For DesqView stacks *}π PLongIntArray = ^TLongIntArray;π TLongIntArray = Array [0..MaxLongIntArray] of LongInt;πππ{* clear all Registers to zero *}ππProcedure ClearRegs(Var Regs : TRealModeRegs);ππ{* allocate memory using GlobalDosAlloc and split the returned *}π{* LongInt into a protected mode Pointer and a Real mode segment *}ππFunction XGlobalDosAlloc(Size : LongInt; Var RealSeg : Word) : Pointer;ππ{* free memory *}ππProcedure XGlobalDosFree(p : Pointer);πππImplementationππUses WinAPI;ππProcedure ClearRegs(Var Regs : TRealModeRegs);πbeginπ FillChar(Regs, Sizeof(TRealModeRegs), 0);πend;ππFunction XGlobalDosAlloc(Size : LongInt; Var RealSeg : Word) : Pointer;πVarπ l : LongInt;πbeginπ l := GlobalDosAlloc(Size);π RealSeg := LongRec(l).Hi;π XGlobalDosAlloc := Ptr(LongRec(l).Lo, 0);πend;ππProcedure XGlobalDosFree(p : Pointer);πbeginπ GlobalDosFree(PtrRec(p).Seg);πend;ππend. { of Unit DPMIUtil }π====================cut here====================πππExample code how to use it. The above dv_win_me routine would look like:ππ Uses DVAPI, Objects, WinApi, WinTypes, DPMI;ππ Function dv_win_me : LongInt;π Constπ StackSize = Sizeof(LongInt);π Varπ Regs : TRealModeRegs;π Stack : PLongIntArray;π beginπ {* clear all Registers *}π ClearReges(Regs);ππ {* allocate a 1 dWord stack *}π Stack := XGlobalDosAlloc(StackSize, Regs.ss);ππ {* set Registers *}π Regs.bx := $0001;π Regs.ah := $12;π Regs.sp := StackSize;ππ {* perForm Real mode interrupt *}π RealModeInt($15, Regs);π dv_win_me := Stack^[0];ππ {* free the stack *}π XGlobalDosFree(Stack);π end;ππ beginπ Writeln(dv_win_me);π end.ππCompare this to the previous code. It just looks a bit prettierπaccording to my honest opininion.πππConclusionπ----------ππAs you saw, the switch from Real to protected mode may be ratherπpainfull. I hope With the above examples and explanations you can makeπit a bit more enjoyable. One question remains: why did Borland notπclearly told us so? Why not present a few examples, warnings, etc.?πMaybe RiChard Nelson can answer this questions For us. Everything heπsays is his private opinion of course, but a look in the kitchen couldπbe worthWhile.ππif you still have questions, I'm willing to answer them in eitherπusenet's Comp.LANG.PASCAL or fidonet's PASCAL.028 or PASCAL. I can'tπport your library of course but if the inFormation presented here is notπenough, just ask.ππππReferencesπ----------π- The usual Borland set of handbooksππ- "Borland Open Architecture Handbook For Pascal", sold separately byπBorland,π 184 pages.ππ- "Extending Dos, a Programmer's Guide to protected-mode Dos", Rayπ Duncan, Charles Petzold, andrew Schulman, M. Steven Baker, Ross P.π Nelson, Stephen R. Davis and Robert Moote. Addison-Wesly, 1992.π ISBN: 0-201-56798-9ππ- "PC Magazine Programmer's Technical Reference: The Processor andπ Coprocessor", Robert L. Hummel. Ziff-Davis Press, 1992.π ISBN: 1-56276-016-5πππ { Dunno if this came before or after this message :) }ππHello Protectors,ππof course, a few hours after my message has been released to the net,πbugfixes seem necessary )-:ππSome minor bugfixes:ππ* In the example about allocating memory below the 1MB, memory isπ allocated but not released. As we have only 1MB down their, this canπ become a problem ;-)π Fix: adding the statementπ GlobalDosFree(RealModeSel);π will clean things upππ * The solution to interrupts which requires parameters passed on theπ stack has a bug. Theπ les di,Regsπ statement does not work of course. Replace byπ mov di,ofFSET Regsπ mov dx,SEG Regsπ mov es,dxπ This does not work when Regs is declared in the stack segment (wellπ done Borland....), you encounter bug number 16, just as I did.... (seeπ next message)πππ 5 05-28-9313:50ALL SWAG SUPPORT TEAM FASTMEM.PAS IMPORT 36 ä▒áá Unit MEM16;π{π Author: Paul VanderSpekπ Date: 03-20-1993ππ This source code is being released as Free-Ware. You may useπ this code in your Programs and modify it to fit your needs. Theπ only restrictions are that you may not distribute the sourceπ code in modified Form or Charge For the source code itself.πππ}ππInterfaceππProcedure Move16(Var Source,Dest;Count:Word);πProcedure FillChar16(Var X; Count: Word; Value:Byte);ππImplementationππProcedure Move16(Var Source,Dest;Count:Word); Assembler;πAsmπ PUSH DSπ LDS SI,SOURCEπ LES DI,DESTπ MOV AX,COUNTπ MOV CX,AXπ SHR CX,1π REP MOVSWπ TEST AX,1π JZ @endπ MOVSBπ@end:POP DSπend;ππProcedure FillChar16(Var X; Count: Word; Value:Byte); Assembler;πAsmπ LES DI,Xπ MOV CX,COUNTπ SHR CX,1π MOV AL,ValUEπ MOV AH,ALπ REP StoSWπ TEST COUNT,1π JZ @endπ StoSBπ@end:πend;ππend.ππ{πThese routines are twice as fast as the normal Move and FillChar routinesπsInce they use MOVSW and StoSW instead of MOVSB and StoSB. They work inπexactly the same way, so you can just replace Move and FillChar With them.π}ππ{π> This source code is being released as Free-Ware. You may useπ> this code in your Programs and modify it to fit your needs. Theπ> only restrictions are that you may not distribute the sourceπ> code in modified form or Charge For the source code itself.ππI'm sorry to say that I'm not impressed, since hundreds of people already haveπinvented this wheel. Besides, your move routine has at least one serious flaw:πit assumes that source and destinaton do not overlap. Which is not always theπcase; if you have a Variable of the Type String as the source, and you want toπcopy a few Characters furtheron in this Variable, you'll mess up the result.ππ> SHR CX,1π> REP MOVSWπ> TEST AX,1π> JZ @endπ> MOVSBπ> @end:POP DSππThe TEST AX, 1 instruction is superfluous. If the number of Bytes in the CXπregister is odd, the SHR CX, 1 instruction will set the carry bit. It's moreπconvenient to test this bit. Here's how:ππ SHR CX, 1π JNC @1π MOVSBπ REP MOVSWπ @1:ππ> Have Fun,ππNo fun if source and destination overlap, as said earlier. Here follows aπmemory move routine With 16-bit moves and overlap check:π}πProcedure MoveMem(Var source, target; size : Word); Assembler;ππAsmπ PUSH DSπ LDS SI, sourceπ LES DI, targetπ MOV CX, sizeπ CLDππ { If an overlap of source and target could occur,π copy data backwards }ππ CMP SI, DIπ JAE @2ππ ADD SI, CXπ ADD DI, CXπ DEC SIπ DEC DIπ STDππ SHR CX, 1π JAE @1π MOVSBπ@1: DEC SIπ DEC DIπ JMP @3ππ@2: SHR CX, 1π JNC @3π MOVSBππ@3: REP MOVSWπ POP DSπend; { MoveMem }πππ{π> For I := 0 to 200 doπ> Move(Buffer,Mem[$A000:0000],320);ππLooks weird to me. Why moving all that stuff 200 times to the first lineπof the screen ?ππ> For I := 100 to 200 doπ> Move(Buffer[320*I],Mem[$A000:(I*320)],320);ππThis could be done viaππMove(Buffer[320*StartLine], Mem[$a000:320*StartLine], 320*NumberOfLines) ;ππwhich should somehow be faster.ππAlso note that TP's Move Procedure Uses a LODSB instruction, which isπtwice as slow as a LODSW instruction on 286+ computers, With big buffers.πSo here is a replacement Move proc, which works fine EXCEPT if the twoπbuffers overlap and destination is at a greater address than source, whichπanyway is not the Case here.π}πProcedure FastMove(Var Src, Dst ; Cnt : Word) ;πAssembler ;πAsmπ Mov DX, DS { Sauvegarde DS }π Mov CX, Cntπ LDS SI, Srcπ LES DI, Dstπ ClD { A priori, on va du dbut vers la fin }π ShR CX, 1 { On va travailler sur des mots }π Rep MovSW { Copie des mots }π JNC @Done { Pas d'octet restant (Cnt pair) ? }π MovSB { Copie dernier octet }π@Done:π Mov DS, DX { Restauration DS }πend ;π{πWell, just a note : this proc works twice faster than TP's Move _only_ ifπSrc and Dst are Word aligned, which is the Case if :π- they are Variables allocated on the heap,π- they are declared in the stack,π- $a+ is specified,π- you use it as described in your examples of code :-)π} 6 05-28-9313:50ALL SWAG SUPPORT TEAM FREEMEM1.PAS IMPORT 4 ä▒ {πDoes anyone have any routines to find the available memory outside of theπheap ?π}ππFunction GetFreeMemory : LongInt;πVarπ Regs : Registers;πbeginπ Regs.AH := $48;π Regs.BX := $FFFF;π Intr($21,Regs);π GetFreeMemory := LongInt(Regs.BX)*16;πend;π{ππThis Procedure tries to allocate 1MB memory (what's impossible).πDos will give you the maximum of free memory back.π} 7 05-28-9313:50ALL SWAG SUPPORT TEAM GETCACHE.PAS IMPORT 34 ä▒MA {π> Well is there a way to find out if Norton Cache is installed?ππTest For SmartDrv.* , HyperDsk only. ! Others Untested !π}ππProgram IsThereAnyCache;πUsesπ Dos;ππConstπ AktCache : Byte = 0;π CacheNames : Array[0..10] of String[25] = (π '*NO* Disk-Cache found','SmartDrv.Exe','SmartDrv.Sys',π 'Compaq SysPro','PC-Cache V6.x','PC-Cache V5.x',π 'HyperDsk ?', 'NCache-F','NCache-S',π 'IBMCache.Sys','Q-Cache (?)');ππVarπ Version : Integer;π Regs : Registers;ππFunction SmartDrvVersion:Integer;πVarπ Bytes : Array[0..$27] of Byte; { return Buffer }π TFile : Text;πbeginπ SmartDrvVersion := -1; { assume NO smartdrv ! }π {--------Check For SmartDrv.EXE---------- }π FillChar( Regs, Sizeof(Regs), 0 );π Regs.AX := $4A10; { install-check }π Intr( $2F, Regs );π if Regs.FLAGS and FCARRY = 0 then { OK! }π beginπ if Regs.AX = $BABE then { the MAGIC-# }π beginπ SmartDrvVersion := Integer(Regs.BP);π AktCache := 1;π Exit;π end;π end;π { -------Check For SmartDrv.SYS----------- }π Assign(TFile,'SMARTAAR');π {$I-}π Reset(TFile);π {$I+}π if IOResult <> 0 thenπ Exit; { No SmartDrv }π FillChar( Regs, Sizeof(Regs), 0 );π Regs.AX := $4402; { IoCtl }π Regs.BX := TextRec(TFile).Handle;π Regs.CX := Sizeof(Bytes);π Regs.DS := Seg(Bytes);π Regs.DX := Ofs(Bytes);π MsDos(Regs); { int 21h }π Close(TFile);π if Regs.FLAGS and FCARRY <> 0 thenπ Exit; { Error-# in Regs.AX ...}π SmartDrvVersion := Bytes[$E] + 256 * Bytes[$F];π AktCache := 2;πend;ππFunction CompaqPro : Integer;πbeginπ CompaqPro := -1;π Regs.AX := $F400;π Intr($16, Regs);π if Regs.AH <> $E2 thenπ Exit;π if Regs.AL in[1,2] thenπ AktCache := 3;π CompaqPro := $100;πend;ππFunction PC6 : Integer; { PCTools v6, v5 }πbeginπ PC6 := -1;π Regs.AX := $FFA5;π Regs.CX := $1111;π Intr($16, Regs);π if Regs.CH <> 0 thenπ Exit;π PC6 := $600;π AktCache := 4;πend;ππFunction PC5 : Integer;πbeginπ PC5 := -1;π Regs.AH := $2B;π Regs.CX := $4358; {'CX'}π Intr($21, Regs);π if Regs.AL <> 0 thenπ Exit;π PC5 := $500;π AktCache := 5;πend;ππFunction HyperDsk : Integer; { 4.20+ ... }πbeginπ Hyperdsk:= -1;π Regs.AX := $DF00;π Regs.BX := $4448; {'DH'}π Intr($2F, Regs);π if Regs.AL <> $FF thenπ Exit;π if Regs.CX <> $5948 thenπ Exit; { not a "Hyper" product }π HyperDsk := Regs.DX;π AktCache := 6;πend;ππFunction Norton : Integer;πbeginπ Norton := -1;π Regs.AX := $FE00;π Regs.DI := $4E55; {'NU'}π Regs.SI := $4353; {'CS' test For Ncache-S v5 }π Intr($2F, Regs);π if Regs.AH = $00 thenπ beginπ Norton := $500;π AktCache := 7;π Exit;π end;π { Test For Ncache-F v5 / v6 }π Regs.AX := $FE00;π Regs.DI := $4E55; {'NU'}π Regs.SI := $4353; {'CF' test For Ncache-F v5, V6+ }π Intr($2F, Regs);π if Regs.AH <> $00 thenπ Exit;π Norton := $600;π AktCache := 8;πend;ππFunction IBM : Integer;πbeginπ IBM:= -1;π Regs.AX := $1D01;π Regs.Dl := $2; { drive C: }π Intr($13, Regs);π if Regs.Flags and FCarry <> 0 thenπ Exit;π { ES:(BX+$22) -> ASCII-Version-# }π Inc( Regs.BX, $22 );π Regs.AH := (Mem[Regs.ES : Regs.BX] - $30 ) shl 4;π Regs.AH := Regs.AH or (Mem[Regs.ES : Regs.BX + 1] - $30 );π Regs.AL := (Mem[Regs.ES : Regs.BX + 2] - $30 ) shl 4;π Regs.AL := Regs.AL or (Mem[Regs.ES : Regs.BX + 3] - $30 );π IBM := Regs.AX;π AktCache := 9;πend;ππFunction QCache : Integer;πbeginπ QCache := -1;π Regs.AH := $27;π Regs.BX := 0;π intr($13,Regs);π if Regs.BX = 0 thenπ Exit;π QCache := Regs.BX; { ??? }π AktCache := 10;πend;ππbeginπ Writeln('DISK-CACHE-CHECK v1.00 Norbert Igl ''1/93');π Version := SmartDrvVersion;π if Aktcache = 0 thenπ Version := Hyperdsk;π if Aktcache = 0 thenπ Version := Norton;π if Aktcache = 0 thenπ Version := PC6;π if Aktcache = 0 thenπ Version := PC5;π if Aktcache = 0 thenπ Version := IBM;π if Aktcache = 0 thenπ Version := QCache;π if Aktcache = 0 thenπ Version := CompaqPro;ππ Write(CacheNames[AktCache]);π if AktCache <> 0 thenπ Writeln(' (V', Version div 256, '.', Version mod 256, ') installed.');π Writeln;πend.π 8 05-28-9313:50ALL SWAG SUPPORT TEAM MALLOC.PAS IMPORT 28 ä▒║î {$S-,R-,V-,I-,N-,B-,F-}ππ{$IFNDEF Ver40}π{Allow overlays}π{$F+,O-,X+,A-}π{$ENDIF}ππUNIT MemAlloc;ππ { Purpose is to provide the ability to create (destroy) dynamic variables }π { without needing to reserve heap space at compile time. }ππINTERFACEππFUNCTION Malloc(VAR Ptr; Size : Word) : Word;π { Allocate free memory and return a pointer to it. The amount of memory }π { requested from DOS is calculated as (Size/4)+1 paragraphs. If the }π { allocation is successful, the untyped VAR parameter Ptr will be populated }π { with the address of the allocated memory block, and the function will return}π { a zero result. Should the request to DOS fail, Ptr will be populated with }π { the value NIL, and the function will return the appropriate DOS error code. }ππFUNCTION Dalloc(VAR Ptr) : Word;π { Deallocate the memory pointed to by the untyped VAR parameter Ptr }ππIMPLEMENTATIONππ FUNCTION Malloc(VAR Ptr; Size : Word) : Word;π BEGINπ INLINE(π $8B / $46 / <Size / { mov ax,[bp+<Size]}π $B9 / $04 / $00 / { mov cx,4}π $D3 / $E8 / { shr ax,cl}π $40 / { inc ax}π $89 / $C3 / { mov bx,ax}π $B4 / $48 / { mov ah,$48}π $CD / $21 / { int $21 ;Allocate memory}π $72 / $07 / { jc AllocErr ;If any errors ....}π $C7 / $46 / $FE / $00 / $00 / {NoErrors: mov word [bp-2],0 ;Return 0 for successful allocation}π $EB / $05 / { jmp short Exit}π $89 / $46 / $FE / {AllocErr: mov [bp-2],ax ;Return error code}π $31 / $C0 / { xor ax,ax ;Store a NIL value into the ptr}π $C4 / $7E / <Ptr / {Exit: les di,[bp+<Ptr] ;Address of pointer into es:di}π $50 / { push ax ;Save the Segment part}π $31 / $C0 / { xor ax,ax ;Offset is always 0}π $FC / { cld ;Make sure direction is upward}π $AB / { stosw ;Store offset of memory block}π $58 / { pop ax ;Get back segment part}π $AB); { stosw ;Store segment of memory block}π π END {Malloc} ;ππ FUNCTION Dalloc(VAR Ptr) : Word;π BEGINπ IF Pointer(Ptr) <> NIL THEN BEGINπ INLINE(π $B4 / $49 / { mov ah,$49}π $C4 / $7E / <Ptr / { les di,[bp+<Ptr]}π $26 / $C4 / $3D / { es: les di,[di]}π $CD / $21 / { int $21}π $72 / $02 / { jc Exit}π $31 / $C0 / {NoError: xor ax,ax}π $89 / $46 / $FE); {Exit: mov [bp-2],ax}π Pointer(Ptr) := NIL;π END {if} ;π END {Dealloc} ;ππEND {Unit MemAlloc} .ππ 9 05-28-9313:50ALL SWAG SUPPORT TEAM MEMALLOC.PAS IMPORT 37 ä▒Å∙ {This is a Unit MEMALLOC.PAS For use With the .VOC player...}πUnit MemAlloc;ππ{ Purpose is to provide the ability to create (destroy) dynamic Variables }π{ without needing to reserve heap space at Compile time. }ππInterfaceππFunction Malloc(Var Ptr; Size : Word) : Word;π{ Allocate free memory and return a Pointer to it. The amount of memoryπ{ requested from Dos is calculated as (Size/4)+1 paraGraphs. if theπ{ allocation is successful, the unTyped Var parameter Ptr will be populatedπ{ With the address of the allocated memory block, and the Function will return}π{ a zero result. Should the request to Dos fail, Ptr will be populated withπ{ the value NIL, and the Function will return the appropriate Dos error code.π}ππFunction Dalloc(Var Ptr) : Word;π{ Deallocate the memory pointed to by the unTyped Var parameter Ptrπ}ππFunction DosMemAvail : LongInt;π{ Return the size of the largest contiguous chuck of memory available For useπ}ππ{ ---------------------------------------------------------------------------π}ππImplementationππ{ ---------------------------------------------------------------------------π}ππFunction Malloc(Var Ptr; Size : Word) : Word;πbeginπ Inline(π $8B/$46/<SIZE/ { mov ax,[bp+<Size]}π $B9/$04/$00/ { mov cx,4}π $D3/$E8/ { shr ax,cl}π $40/ { inc ax}π $89/$C3/ { mov bx,ax}π $B4/$48/ { mov ah,$48}π $CD/$21/ { int $21 ;Allocate memory}π $72/$07/ { jc AllocErr ;if any errors ....}π $C7/$46/$FE/$00/$00/ {NoErrors: mov Word [bp-2],0 ;Return 0 For successful allocation}π $EB/$05/ { jmp short Exit}π $89/$46/$FE/ {AllocErr: mov [bp-2],ax ;Return error code}π $31/$C0/ { xor ax,ax ;Store a NIL value into the ptr}π $C4/$7E/<PTR/ {Exit: les di,[bp+<Ptr] ;Address of Pointer into es:di}π $50/ { push ax ;Save the Segment part}π $31/$C0/ { xor ax,ax ;offset is always 0}π $FC/ { cld ;Make sure direction is upward}π $AB/ { stosw ;Store offset of memory block}π $58/ { pop ax ;Get back segment part}π $AB); { stosw ;Store segment of memory block}ππend {Malloc};ππ{ ---------------------------------------------------------------------------π}ππFunction Dalloc(Var Ptr) : Word;πbeginπ if Pointer(Ptr) <> NIL then beginπ Inline(π $B4/$49/ { mov ah,$49}π $C4/$7E/<PTR/ { les di,[bp+<Ptr]}π $26/$C4/$3D/ { es: les di,[di]}π $CD/$21/ { int $21}π $72/$02/ { jc Exit}π $31/$C0/ {NoError: xor ax,ax}π $89/$46/$FE); {Exit: mov [bp-2],ax}π Pointer(Ptr) := NIL;π end {if}π elseπ Dalloc := 0;πend {Dealloc};ππ{ ---------------------------------------------------------------------------π}ππFunction DosMemAvail : LongInt;πbeginπ Inline(π $BB/$FF/$FF/ { mov bx,$FFFF}π $B4/$48/ { mov ah,$48}π $CD/$21/ { int $21}π $89/$D8/ { mov ax,bx}π $B9/$10/$00/ { mov cx,16}π $F7/$E1/ { mul cx}π $89/$46/$FC/ { mov [bp-4],ax}π $89/$56/$FE); { mov [bp-2],dx}πend; {DosMemAvail}ππend. {Unit MemAlloc}ππ{Ok.. The Code can be rewritten to use GetMem and FreeMem (in fact I suggestπyou do this). I rewrote it myself to do so, but this is the distribution copy.π(I made one change in line 316-318 of SBVOICE.PAS bumping up the driver sizeπfrom 3000 to 5000 to accomodate the SoundBlaster 2.0 driver)πThis Program requires CT-VOICE.DRV which is distributed With the Soundblaster.π}π 10 05-28-9313:50ALL SWAG SUPPORT TEAM MEMINFO.PAS IMPORT 32 ä▒bX {πFirst of all something about Turbo Pascal memory management. A Turbo PascalπProgram Uses the upper part of the memory block it allocates as the heap.πThe heap is the memory allocated when using the Procedures 'New' andπ'GetMem'. The heap starts at the address location pointed to by 'Heaporg' andπgrows to higher addresses as more memory is allocated. The top of the heap,πthe first address of allocatable memory space above the allocated memoryπspace, is pointed to by 'HeapPtr'.ππMemory is deallocated by the Procedures 'Dispose' and 'FreeMem'. As memoryπblocks are deallocated more memory becomes available, but..... When a blockπof memory, which is not the top-most block in the heap is deallocated, a gapπin the heap will appear. to keep track of these gaps Turbo Pascal maintainsπa so called free list.ππThe Function 'MaxAvail' holds the size of the largest contiguous free blockπ_in_ the heap. The Function 'MemAvail' holds the sum of all free blocks inπthe heap.ππThus Far nothing has changed from TP5.5 to TP6.0. But here come theπdifferences:ππTP5.5ππto keep track of the free blocks in the heap, TP5.5 maintains a free listπwhich grows _down_ from the top of the heap. As more free blocks becomeπavailable, this list will grow. Every item in this list, a free-list Record,πcontains two four-Byte Pointers to the top and the bottom of a free blockπin the heap. _FreePtr_ points to the first free-list Record (the bottom mostπfree-list Record).ππThe minimum _allowable_ distance between 'FreePtr' and 'HeapPtr' can be setπwith the Variable 'FreeMin'.ππTP6.0ππIn TP6.0 the Variables 'FreePtr' and 'FreeMin' no longer exist. The free listπas implemented in TP5.5 no longer exists either (although the TP6.0πProgrammer's guide still mentions a down growing free list??)). TP6.0 keepsπtrack of the free blocks by writing a 'free list Record' to the first eightπBytes of the freed memory block! A (TP6.0) free-list Record contains two fourπByte Pointers of which the first one points to the next free memory block, theπsecond Pointer is not a Real Pointer but contains the size of the memory block.πSummaryππSo instead of a list of 'free list Records', growing down from the top of theπheap, containing Pointers to individual memory blocks, TP6.0 maintains a linkedπlist With block sizes and Pointers to the _next_ free block.πIn TP6.0 an extra heap Variable 'Heapend' designating the end of the heap isπadded. When 'HeapPtr' and 'FreeList' have the same value, the free list isπempty.ππThe below figure pictures the memory organization of both TP5.5 and TP6.0:πππ TP5.5 TP6.0 Heapendπ─── ┌─────────┐ ┌─────────┐ <────π ^ ┌──────│ │ │ │π │ │ ├─────────┤ │ │π │ │ ┌── │ │ FreePtr │ │π │ │ │ ├─────────┤ <──── │ │πHeap │ │ │ │ │ │π │ │ │ │ │ │ │π │ │ │ │ │ │ │π v │ │ │ │ HeapPtr │ │ HeapPtrπ─── │ │ ├─────────┤ <──── ┌─>├─────────┤ <────π │ │ │ │ │ │ │π │ ├──>├─────────┤ │ ├─────────┤π │ │ │ Free │ └──│ Free │π │ └──>├─────────┤ ┌─>├─────────┤π │ │ │ │ │ │π ├─────>├─────────┤ │ ├─────────┤π │ │ Free │ Heaporg └──│ Free │ FreeListπ └─────>├─────────┤ <──── ├─────────┤ <────π │ │ Heaporgπ ├─────────┤ <────ππππππI hope this will help you modifying existing toolBox's which make use of theseπdisappeared Variables. In some Case a modification may be quite easy, but asπyou see it might get quite quite difficult as well.π 11 05-28-9313:50ALL SWAG SUPPORT TEAM MEMINFO2.PAS IMPORT 10 ä▒@: π I need the proper syntax For a Pascal Program that will execute a Dosπ prog (a small one) and then resume the Pascal Program when the Dos progπ is finished. Any suggestions gladly accepted...ππ TP method:ππ Assumes Programe name is \PROGPATH\PROGNAME.EXE, and the commandπ line parameters are /Rππ Exec('\PROGPATH\PROGNAME.EXE','/R');ππ You need to make sure that you have the Heap set With the $Mπ directives, so that you have enough memory to execute theπ porgram.ππ example (this Program doesn't use the heap at all):ππ {$M 1024, 0, 0} { 1 kb stack, 0k min, 0k max }ππ (this Program needs 20k minimum heap to run, and can use up toπ 100k)ππ {$M 1024, 20480, 102400} { 1k stack, 20k min, 100k max }ππ A Turbo Pascal Program will always use as much RAM as there isπ avaiable, up to the "max" limit. if you do not put a $M directiveπ in your Program, the heap will be the entire available memory ofπ your machine, so no memory will be available For your externalπ Program to run.ππ It is also a good idea to bracket your Exec command withπ "SwapVector;" statements.π 12 05-28-9313:50ALL SWAG SUPPORT TEAM OVERSIZE.PAS IMPORT 45 ä▒á▌ Unit Oversize;ππ{ Author: Trevor J Carlsenπ Algorithm Enterprises Pty Ltdπ PO Box 568π Port Hedland 6721π Western Australiaπ Telephone: (Voice) +61 [0]91 73 2026π (Data ) +61 [0]91 73 2569π π Released into the Public Domain 1991.ππ An Unit that will enable logical Arrays to be created using up to the amount π of heap memory available.ππ The line marked (**) MUST be altered to reflect the Type of data in big π Array and the Unit MUST be reCompiled after this change.ππ No provision is made in this Unit For recovering the memory used by the big π Array as the intention was to keep it appearing to the Programmer as close π as possible to static Type global Variables.ππ Bear in mind that you do not declare your Array anywhere using this Unit. π That is all handled automatically. All you have to do is give the global π Variable MaxElements a value With the number of elements you want in the π Array and then call the Procedure initialise. From then on your Array is π called data^. (Actually it is called nothing as it is dynamic and is π referenced via the Pointer "data" but if you think of it as being called π "data^" you don't even need to know how Pointers work!)ππ The Array, using this Unit, can only be singly dimensioned although there is π no reason why the Unit could not be hacked to allow multi-dimensions.π π }ππInterfaceππTypeπ(**) DataType = LongInt; { change to whatever Type you want For the Array }π bigArray = Array[0..0] of DataType;π bigptr = ^bigArray;πVarπ data : bigptr;π MaxElements : LongInt; { this Variable must have the number of elements }ππ{----------------------------------------------------------------------------}πFunction Element(l:LongInt):Byte;π π { Call by passing the element number you wish to reference. }π { Always returns zero. It works by changing the value of the Pointer }π { data. This means that you cannot ever reference your big Array by }π { data^[100000] := whatever; }π { It MUST always be referenced by calling this Function eg. }π { data^[Element(100000)] := whatever; }π ππ{----------------------------------------------------------------------------}πFunction AllocateMem(Var b,l): Boolean;π π { Returns True if memory was allocated successfully For the big Array and }π { False if there was insufficient memory. }ππ{----------------------------------------------------------------------------}πProcedure Initialise; { Must be called beFore using any other Procedure }ππ{============================================================================}ππImplementationππ{============================================================================}π{ private declarations }ππConstπ max = 65520 div sizeof(dataType);{ The number of elements/segment }π initialised : Boolean = False;π πTypeπ address = Record { allows arithmetic on the Pointers }π offset,π segment : Word;π end;π baseArray = Array[0..9] of address; { For the addresses of the segments }ππVarπ base : baseArray;π ππ{----------------------------------------------------------------------------}πFunction Element(l:LongInt):Byte;ππ Varπ theaddress : address Absolute data;π bigaddress : baseArray Absolute base;ππ beginπ π { First make sure that initialisation has been done correctly }π if not initialised then begin π Writeln('Initialise Procedure has not been called');π halt(254);π end; { if not initialised }π π Element := 0; { It is Really irrelevent but any other value here would }π { produce a range check error at runtime if R+ }π π { Now let us fool TP into thinking that the address of element zero is }π { address of the element we are looking For. }π With theaddress do beginπ segment := bigaddress[l div max].segment; { Get the segment }π offset := (l mod max) * sizeof(dataType); { Get the offset }π end; { With theaddress }π end; { ElementNumber }ππ{----------------------------------------------------------------------------}πFunction AllocateMem(Var b,l): Boolean;π π Typeπ ptrArray = Array[0..9] of Pointer;π Varπ bArray: ptrArray Absolute b;π x : Byte;π count : LongInt;π beginπ count := MaxElements;π AllocateMem := True;π For x := 0 to (count div max) do { allocate in 64K contiguous chunks }π if (count * sizeof(dataType)) > 65520 then beginπ if MaxAvail < (max * sizeof(dataType)) then begin { not enough memory} π dec(count,max);π AllocateMem := False;π end π elseπ GetMem(bArray[x],max * sizeof(dataType));π endπ elseπ if MaxAvail < (count * sizeof(dataType)) thenπ AllocateMem := Falseπ elseπ GetMem(bArray[x],count * sizeof(dataType)); π end; { AllocateMem }π π{----------------------------------------------------------------------------}πProcedure Initialise;π beginπ FillChar(base,sizeof(base),0);π if not AllocateMem(base,MaxElements) then beginπ Writeln('Insufficient memory');π halt(255);π end;π initialised := True; { All Ok and memory has been allocated }π end; { Initialise }π πend. { Unit Oversize }π π 13 05-28-9313:50ALL SWAG SUPPORT TEAM SDRVFLSH.PAS IMPORT 7 ä▒σ╩ {πHAGEN LEHMANNππThis Procedure flushes the SMARTDRV.EXE-cache.π}ππProcedure FlushChache; Assembler;πAsmπ mov ax,$4A10π mov bx,$0002π int $2Fπend;ππ{πMARCO MILTENBURGππFlushing SmartDrive: It's written by Max Maischein (2:249/6.17) and NorbertπIgl (2:2402/300.3), both from Germany (if I'm not mistaken).π}ππProcedure FlushSD_sys; Far;πVarπ F : File;π B : Byte;πbeginπ Assign(F, 'SMARTAAR');π Reset(F);π B := 0;π Asmπ push dsπ mov ax, 04403hπ mov bx, FileRec(F).Handleπ mov cx, 1π int 21hπ pop dsπ end;πend;ππProcedure FlushSD_exe; Far;πbeginπ Asmπ mov ax, 04A10hπ mov bx, 1π int 2Fhπ end;πend;π 14 05-28-9313:50ALL SWAG SUPPORT TEAM SMARTDRV.PAS IMPORT 12 ä▒ò£ { MN> How can I find out if Smartdrv is installed ? I have made a harddiskπ MN> benchmark Program, and I would like it to detect if Smartdrv isπ MN> installed.π}πUses Dos;ππFunction SmartDrvVersion:Integer; { -1 means not inSTALLED }πVarπ R: Registers;π B: Array[0..$27] of Byte; { return Buffer }π F: Text;ππbeginπ SmartDrvVersion := -1; { assume NO smartdrv ! }ππ {--------Check For SmartDrv.EXE---------- }π FillChar( R, Sizeof(R), 0 );π R.AX := $4A10; { install-check }π Intr( $2F, R );π if R.FLAGS and FCARRY = 0 then { OK! }π beginπ if R.AX = $BABE then { the MAGIC-# }π beginπ SmartDrvVersion := Integer(R.BP);π Exitπ end;π end;π { -------Check For SmartDrv.SYS----------- }π Assign(f,'SMARTAAR');π {$I-}π Reset(f);π {$I+}π if IoResult <> 0 then Exit; { No SmartDrv }π FillChar( R, Sizeof(R), 0 );π R.AX := $4402; { IoCtl }π R.BX := TextRec(f).Handle;π R.CX := Sizeof(B);π R.DS := Seg(B);π R.DX := ofs(B);π MsDos(R); { int 21h }π close(f);π if R.FLAGS and FCARRY <> 0 then Exit; { Error-# in R.AX ...}π SmartDrvVersion := B[$E] + 256* B[$F];πend;ππVarπ SMV:Integer;πbeginπ SMV := SmartDrvVersion;π Write(' SmartDrv');π if SMV = -1 thenπ Writeln(' not installed.')π elseπ Writeln(' V', SMV div 256,'.',SMV mod 256,' installed.');πend.π 15 05-29-9322:20ALL GAYLE DAVIS Fast MOVE Replacement IMPORT 8 ä▒W¡ {$S-,R-,V-,I-,N-,B-,F-}ππ{$IFNDEF Ver40}π {Allow overlays}π {$F+,O-,X+,A-}π{$ENDIF}ππUNIT FastMove;ππINTERFACEππ(* This routine will move a block of data from a source to a destination. Itπ replaces Turbo Pascal's Move routine. *)ππPROCEDURE FastMover (VAR source;π VAR dest;π numToMove : WORD);πππIMPLEMENTATIONππPROCEDURE FastMover (VAR source;π VAR dest;π numToMove : WORD);ππ BEGINπ INLINE ($8C / $DA / $C5 / $B6 / > SOURCE / $C4 / $BE / > DEST / $8B / $8E / > NUMTOMOVE);π INLINE ($39 / $FE / $72 / $08 / $FC / $D1 / $E9 / $73 / $11 / $A4 / $EB / $0E / $FD / $01 / $CE);π INLINE ($4E / $01 / $CF / $4F / $D1 / $E9 / $73 / $01 / $A4 / $4E / $4F / $F2 / $A5 / $8E / $DA);π END;ππEND.π 16 05-29-9322:25ALL GAYLE DAVIS Extend HEAP to UMB IMPORT 74 ä▒╡. {$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S+,V-,X-}ππUnit UMB_Heap;ππ{----------------------------------------------------------------------------}ππinterfaceππ Procedure Extend_Heap; { Use Upper Memory Blocks (UMB) to extend }π { the Turbo Pascal 6.0 heap. This procedure }π { should be called as soon as possible in }π { your code. }π varπ UMB_Heap_Debug : Boolean; { If true, releases UMBs immediately to make }π { sure they're available for the next run }π { without rebooting. Used when debugging in }π { the IDE. If not used then, the UMBs may }π { not get freed between executions. }ππ{----------------------------------------------------------------------------}ππimplementationππconstπ Max_Blocks = 4; { It's not likely more than 4 UMBs are needed }ππtypeπ PFreeRec = ^TFreeRec; { From pg. 216 of the TP6 programmer's guide. }π TFreeRec = record { It's used for traversing the free blocks of }π Next : PFreeRec; { the heap. }π Size : Pointer;π end;ππvarπ XMS_Driver : Pointer; { Pointer to the XMS driver. }π Num_Blocks : Word;π Block_Address,π Block_Size : Array[1..Max_Blocks+1] of Pointer;π SaveExitProc : Pointer;ππ{----------------------------------------------------------------------------}ππ{ Swap to pointers. Needed when sorting the UMB addresses. }ππProcedure Pointer_Swap(var A,B : Pointer);π varπ Temp : Pointer;π Beginπ Temp := A;π A := B;π B := Temp;π End;ππ{----------------------------------------------------------------------------}ππFunction XMS_Driver_Present : Boolean; { XMS software present? }π varπ Result : Boolean;π Beginπ Result := False; { Assume no XMS driver }π asmπ @Begin:π mov ax,4300hπ int 2Fhπ cmp al,80hπ jne @Failπ mov ax,4310hπ int 2Fhπ mov word ptr XMS_Driver+2,es { Get the XMS driver entry point }π mov word ptr XMS_Driver,bxπ mov Result,1π jmp @Endπ @Fail:π mov Result,0π @End:π end;π XMS_Driver_Present := Result;π End;ππ{----------------------------------------------------------------------------}ππProcedure Allocate_UMB_Heap; { Add the four largest UMBs to the heap }π varπ i,j : Word;π UMB_Strategy,π DOS_Strategy,π Segment,Size : Word;π Get_Direct : Boolean; { Get UMB direct from XMS if TRUE, else from DOS }π Beginπ Num_Blocks := 0;ππ for i := 1 to Max_Blocks doπ beginπ Block_Address[i] := nil;π Block_Size[i] := nil;π end;ππ asmπ mov ax,5800hπ int 21h { Get and save the DOS allocation strategy }π mov [DOS_Strategy],axπ mov ax,5802hπ int 21h { Get and save the UMB allocation strategy }π mov [UMB_Strategy],axπ mov ax,5801hπ mov bx,0000hπ int 21h { Set the DOS allocation strategy so that }π mov ax,5803h { it uses only high memory }ππ { DON'T TRUST THIS FUNCTION. DOS WILL GO }π { AHEAD AND TRY TO ALLOCATE LOWER MEMORY }π { EVEN AFTER YOU TELL IT NOT TO! }π mov bx,0001hπ int 21h { Set the UMB allocation strategy so that }π end; { UMBs are added to the DOS mem chain }ππ Get_Direct := True; { Try to get UMBs directly from the XMS }π { if possible. }π for i := 1 to Max_Blocks doπ beginπ Segment := 0;π Size := 0;ππ if Get_Direct then { Get a UMB direct from the XMS driver. }π beginπ asmπ @Begin:π mov ax,01000h π mov dx,0FFFFh { Ask for the impossible to ... }π push ds { Get the size of the next largest UMB }π mov cx,dsπ mov es,cxπ call es:[XMS_Driver]π cmp dx,100h { Don't bother with anything < 1K }π jl @Endπ mov ax,01000hπ call es:[XMS_Driver] { Get the next largest UMB }π cmp ax,1π jne @Endπ cmp bx,0A000h { It better be above 640K }π jl @End { We can't trust DOS 5.00 }π mov [Segment],bxπ mov [Size],dxπ @End:π pop dsπ end;π if ((i = 1) and (Size = 0)) then { if we couldn't get the UMB }π Get_Direct := False; { from the XMS driver, don't }π end; { try again the next time. }ππ if (not Get_Direct) then { Get a UMB via DOS }π beginπ asmπ @Begin:π mov ax,4800hπ mov bx,0FFFFh { Ask for the impossible to ... }π int 21h { Get the size of the next largest UMB }π cmp bx,100h { Don't bother with anything < 1K }π jl @Endπ mov ax,4800hπ int 21h { Get the next largest UMB }π jc @Endπ cmp ax,0A000h { It better be above 640K }π jl @End { We can't trust DOS 5.00 }π mov [Segment],axπ mov [Size],bxπ @End:π end;π end;ππ if (Segment > 0) then { Did it work? }π beginπ Block_Address[i] := Ptr(Segment,0);π Inc(Num_Blocks);π end;π Block_Size[i] := Ptr(Size,0);π end;π if (Num_Blocks > 0) then { Sort the UMB addrs in ASC order }π beginπ for i := 1 to Num_Blocks-1 doπ for j := i+1 to Num_Blocks doπ if (Seg(Block_Address[i]^) > Seg(Block_Address[j]^)) thenπ beginπ Pointer_Swap(Block_Address[i],Block_Address[j]);π Pointer_Swap(Block_Size[i],Block_Size[j]);π end;π end;π asmπ mov ax,5803hπ mov bx,[UMB_Strategy]π int 21h { Restore the UMB allocation strategy }π mov ax,5801hπ mov bx,[DOS_Strategy]π int 21h { Restore the DOS allocation strategy }π end;π End;ππ{----------------------------------------------------------------------------}ππProcedure Release_UMB; far; { Exit procedure to release UMBs }π varπ i : Word;π Segment : Word;π Beginπ ExitProc := SaveExitProc;π if (Num_Blocks > 0) thenπ beginπ asmπ mov ax,5803hπ mov bx,0000hπ int 21h { Set the UMB status to release UMBs }π end;π for i := 1 to Num_Blocks doπ beginπ Segment := Seg(Block_Address[i]^);π if (Segment > 0) thenπ asmπ mov ax,$4901π mov bx,[Segment]π mov es,bxπ int 21h { Release the UMB }π end;π end;π end;π End;ππ{----------------------------------------------------------------------------}ππProcedure Extend_Heap;π varπ i : Word;π Temp : PFreeRec;π Beginπ if XMS_Driver_Present thenπ beginπ Allocate_UMB_Heap;π if UMB_Heap_Debug thenπ Release_UMB;π if (Num_Blocks > 0) thenπ begin { Attach UMBs to the FreeList }π for i := 1 to Num_Blocks doπ PFreeRec(Block_Address[i])^.Size := Block_Size[i];π for i := 1 to Num_Blocks doπ PFreeRec(Block_Address[i])^.Next := Block_Address[i+1];ππ PFreeRec(Block_Address[Num_Blocks])^.Next := nil;ππ if (FreeList = HeapPtr) thenπ with PFreeRec(FreeList)^ doπ beginπ Next := Block_Address[1];π Size := Ptr(Seg(HeapEnd^)-Seg(HeapPtr^),0);π endπ elseπ with PFreeRec(HeapPtr)^ doπ beginπ Next := Block_Address[1];π Size := Ptr(Seg(HeapEnd^)-Seg(HeapPtr^),0);π end;ππ { HEAPPTR MUST BE IN THE LAST FREE BLOCK SOπ THAT TP6 DOESN'T TRY TO USE ANY MEMORY BETWEENπ 640K AND HEAPPTR }ππ HeapPtr := Block_Address[Num_Blocks];π HeapEnd := Ptr(Seg(Block_Address[Num_Blocks]^)+Seg(Block_Size[Num_Blocks]^),0);π end;π end;π End;ππ{----------------------------------------------------------------------------}ππBEGINπ UMB_Heap_Debug := False;π Num_Blocks := 0;π SaveExitProc := ExitProc;π ExitProc := @Release_UMB;πEND.ππ{----------------------------------------------------------------------------}π 17 06-08-9308:22ALL GUY MCLOUGHLIN DPMI Memory Swap IMPORT 51 ä▒ ░ π{===========================================================================π BBS: Canada Remote SystemsπDate: 05-30-93 (02:30) Number: 25203πFrom: GUY MCLOUGHLIN Refer#: NONEπ To: ALL Recvd: NOπSubj: BP7 DPMI SWAP-FILE #1 Conf: (552) R-TPπ---------------------------------------------------------------------------ππ Hi to All:ππ ...I saw this source-code posted by one of the support people inπ the Borland Pascal conference on Compuserve. For those of youπ who are writing DPMI apps, this could come in quite handy asπ a means of obtaining "virtual" DPMI HEAP space.ππ *** NOTE: This unit is ONLY for BORLAND PASCAL 7, and cannot beπ compiled with any version of Turbo Pascal. <sorry>π------------------------------------------------------------------------}ππ {.$DEFINE DebugMode}ππ {$IFDEF DebugMode}π {$A+,B-,D+,E-,F-,G+,I+,L+,N-,O-,P+,Q+,R+,S+,T+,V+,X+,Y+}π {$ELSE}π {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}π {$ENDIF}ππ {$IFNDEF DPMI}π ERROR!!! UNIT MUST BE COMPILED FOR PROTECTED MODE TARGET!!!π {$ENDIF}ππunit RTMswap;ππinterfaceππconstπ rtmOK = $0;π rtmNoMemory = $1;π rtmFileIOError = $22;ππ (***** Opens a swapfile of the specified size. If a swapfile *)π (* already exists, and the new size is larger, the swapfile *)π (* will grow, otherwise the previous swap file parameters *)π (* are used. *)π (* *)π (* Returns: rtmOK - Successful *)π (* rtmNoMemory - Not enough disk space *)π (* rtmFileIOError - Could not open/grow file *)π (* *)π function MemInitSwapFile({input } FileName : pchar;π FileSize : longint) :π {output} integer;ππ (***** Closes the swapfile if it was created by the current task. *)π (* If the value returned in "Delete" is non-zero, the swapfile *)π (* was deleted. *)π (* *)π (* Returns: rtmOK - Successful *)π (* rtmNoMemory - Not enough physical memory to *)π (* run without the swap file. *)π (* rtmFileIOError - Could not close/delete the file. *)π (* *)π function MemCloseSwapFile({update} var Delete : integer) :π {output} integer;ππ implementationππ function MemInitSwapFile; external 'RTM' index 35;ππ function MemCloseSwapFile; external 'RTM' index 36;ππ END.πππ{------------------------------------------------------------------------ππ ...I still can't figure out what to do with the value returned inπ the "Delete" parameter passed to "MemCloseSwapFile", as it doesn'tπ seem to return any specific value for me??? (Maybe it has to failπ to return a value???)ππ ...The next message is a demo program using this "RTMswap" unit.πππ - Guy }ππ {.$DEFINE DebugMode}ππ {$IFDEF DebugMode}π {$A+,B-,D+,E-,F-,G+,I+,L+,N-,O-,P+,Q+,R+,S+,T+,V+,X+,Y+}π {$ELSE}π {$A+,B-,D-,E-,F-,G+,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}π {$ENDIF}ππ {$IFNDEF DPMI}π ERROR!!! PROGRAM MUST BE COMPILED FOR PROTECTED MODE TARGET!!!π {$ENDIF}ππ (* Program to demonstrate how to create/delete DPMI *)π (* HEAP swap-file. *)πprogram RTMswap_Demo;πusesπ RTMswap;ππconst (* Maximum size for DPMI HEAP in bytes. *)π DPMI_HeapMax = 16000 * 1024;ππvarπ SwapError,π DeleteStatus : integer;π SwapSize : longint;π SwapFilename : pchar;ππBEGINπ (* Calculate required DPMI HEAP swap-file size. *)π SwapSize := (DPMI_HeapMax - memavail);ππ (* Display current DPMI HEAP size. *)π writeln;π writeln('Current DPMI HEAP size = ', (memavail div 1024), ' K');π writeln;π writeln('Increasing DPMI HEAP to 16,000 K via swap-file');π writeln;ππ (* Assign DPMI HEAP swap-file name. *)π SwapFilename := 'SWAPDEMO.$$$';ππ (* Attempt to create DPMI HEAP swap-file. *)π SwapError := MemInitSwapFile(SwapFilename, SwapSize);ππ (* Check for errors in creating DPMI HEAP swap-file. *)π case SwapError ofπ rtmOK : beginπ writeln((SwapSize div 1024), ' K DPMI HEAP ' +π 'swap file created');π writeln;π writeln('Total DPMI HEAP size now = ',π (memavail div 1024), ' K');π writelnπ end;π rtmNoMemory : writeln('ERROR!!! Not enough disk space to ' +π 'create DPMI HEAP swap-file');π rtmFileIOerror : writeln('ERROR!!! Could not open/grow DPMI ' +π 'HEAP swapfile')π elseπ writeln('UNKNOWN RTM ERROR!!!')π end;ππ (* If DPMI HEAP swap-file was created, then close it. *)π if (SwapError = rtmOK) thenπ beginπ writeln('Closing DPMI HEAP swap-file'); writeln;ππ (* Attempt to close DPMI HEAP swap-file. *)π SwapError := MemCloseSwapFile(DeleteStatus);ππ (* Check for errors in closing DPMI HEAP swap-file. *)π case SwapError ofπ rtmOK : beginπ writeln('DPMI HEAP swap-file is closed');π writeln;π writeln('Current DPMI HEAP size now = ',π (memavail div 1024), ' K')π end;π rtmNoMemory : writeln('ERROR!!! Not enough RAM to run ' +π 'without swap-file');π rtmFileIOerror : writeln('ERROR!!! Could not close/delete ' +π 'swapfile')π elseπ writeln('UNKNOWN RTM ERROR!!!')π endπ endπEND.π 18 06-08-9308:28ALL STEVE ROGERS Stack Usage Report IMPORT 32 ä▒àÜ (*π===========================================================================π BBS: Canada Remote SystemsπDate: 05-30-93 (08:25) Number: 8026πFrom: STEVE ROGERS Refer#: NONEπ To: PAUL HICKEY Recvd: NO πSubj: HELP PLEASE Conf: (1617) L-PASCALπ---------------------------------------------------------------------------πPH> EP> {$M $A,B,C}ππPH> I always set A and B to high and C to 0. I want to allow the most memory IπPH>can to program usage within the 640K limit.ππ To get the most ram for your prog to use in the 640k set "B" to 0π and "C" to 655360. Setting "C" to 0 prevents you from accessing anyπ heap at all.ππ "A" should be set to the amount of stack your program needs. I have aπ unit that I use to help determine this. It was initially released forπ TP4 but I've used with BP7 OK.ππ{***********************************************************π StackUse - A unit to report stack usage informationππ by Richard S. Sadowskyπ version 1.0 7/18/88π released to the public domainππ Inspired by a idea by Kim Kokkonen.ππ This unit, when used in a Turbo Pascal 4.0 program, willπ automatically report information about stack usage. This is veryπ useful during program development. The following information isπ reported about the stack:ππ total stack spaceπ Unused stack spaceπ Stack spaced used by your programππ The unit's initialization code handles three things, it figures outπ the total stack space, it initializes the unused stack space to aπ known value, and it sets up an ExitProc to automatically report theπ stack usage at termination. The total stack space is calculated byπ adding 4 to the current stack pointer on entry into the unit. Thisπ works because on entry into a unit the only thing on the stack is theπ 2 word (4 bytes) far return value. This is obviously version andπ compiler specific.ππ The ExitProc StackReport handles the math of calculating the used andπ unused amount of stack space, and displays this information. Noteπ that the original ExitProc (Sav_ExitProc) is restored immediately onπ entry to StackReport. This is a good idea in ExitProc in case aπ runtime (or I/O) error occurs in your ExitProc!ππ I hope you find this unit as useful as I have!ππ************************************************************)ππ{$R-,S-} { we don't need no stinkin range or stack checking! }πunit StackUse;ππinterfaceππvarπ Sav_ExitProc : Pointer; { to save the previous ExitProc }π StartSPtr : Word; { holds the total stack size }ππimplementationππ{$F+} { this is an ExitProc so it must be compiled as far }πprocedure StackReport;ππ{ This procedure may take a second or two to execute, especially }π{ if you have a large stack. The time is spent examining the }π{ stack looking for our init value ($AA). }ππvarπ I : Word;ππbeginπ ExitProc := Sav_ExitProc; { restore original exitProc first }ππ I := 0;π { step through stack from bottom looking for $AA, stop when found }π while I < SPtr doπ if Mem[SSeg:I] <> $AA then beginπ { found $AA so report the stack usage info }π WriteLn('total stack space : ',StartSPtr);π WriteLn('unused stack space: ', I);π WriteLn('stack space used : ',StartSPtr - I);π I := SPtr; { end the loop }π endπ elseπ inc(I); { look in next byte }πend;π{$F-}πππbeginπ StartSPtr := SPtr + 4; { on entry into a unit, only the FAR return }π { address has been pushed on the stack. }π { therefore adding 4 to SP gives us the }π { total stack size. }π FillChar(Mem[SSeg:0], SPtr - 20, $AA); { init the stack }π Sav_ExitProc := ExitProc; { save exitproc }π ExitProc := @StackReport; { set our exitproc }πend.π 19 06-22-9309:13ALL SWAG SUPPORT TEAM Calls to EMS Manager IMPORT 74 ä▒ º {*************************** EMS.PAS ************************π*** Demonstrate calls to Extended memory manager ***π************************************************************}ππUSESππ Crt,Dos;ππ{***************************************************************}ππTYPEπ PtrType = RECORD {Define a pointer record }π Offset : Word; { type so we can access the}π Segment : Word { individual pointer fields}π END;π DeviceName = ARRAY[1..8] OF Char; {Defined to test device Name}ππCONSTππ EmsInt = $67; {EMS Interrupt number }π IOCtlFunc = $44; {IOCtl DOS Function number }π PageLen = 16384; {Length of memory page }π MsgLen = 16; {Message len plus len byte }π MsgsPerPage = PageLen DIV MsgLen; {Number of messages in page }π NumMsgs = 5000; {Number EMS messages }ππ {*** Emm functions ***}ππ GetStatus = $40;π GetPageFrameAddr = $41;π GetUnallocPages = $42;π GetEmmVersion = $46;π AllocatePages = $43;π MapHandlePage = $44;π DeallocatePages = $45;ππVARπ P0, P1, P2, P3 : Pointer; {Pointers to physical pages }π EmmHandle : Integer; {Handle for EMM allocated pages }π Tmp : FILE; {Temp file to test if EMM exists}π MsgBuf : Pointer; {Pointer into mapped memory }π Buff : String[15]; {Buffer for msg stored in EM }π I : Integer; {Dummy variable }π EmmRegs : Registers; {Registers for interrupt calls }π Page,Index : Integer; {Used to address page frame }π EmsVector : Pointer; {EMM address from Int $67 }π StrNum : String[4]; {Holds record # for EMM msg }ππ{******** Function to convert word value to Hex string *********}ππFUNCTION Hex(IntNbr : Word): String;πCONSTπ HexDigit :ARRAY[0..15] OF Char = '0123456789ABCDEF';πVARπ S : String[2]; {Temporary String}π TempByte : Byte;πBEGINπ TempByte := Hi(IntNbr); {Convert upper nibble}π S := HexDigit[TempByte DIV 16] +π HexDigit[TempByte MOD 16];π TempByte := Lo(IntNbr); {Convert lower nibble}π Hex := S + HexDigit[TempByte DIV 16] +π HexDigit[TempByte MOD 16];πEND;ππ{******** Create a string that contains a pointer value ********}ππFUNCTION PrintPointer(P : Pointer): String;ππBEGINπ PrintPointer := Hex(PtrType(P).Segment) + ':' +π Hex(PtrType(P).Offset);π END;ππ{*********** Print the EMM Status to the screen ****************}ππPROCEDURE EmmPrintStatus(Status: Byte);ππCONSTπ EmmStatus : ARRAY [$80..$8F] OF String =π ('Driver malfunction',π 'Hardware malfunction',π '',π 'Bad Handle',π 'Undefined FUNCTION',π 'No free handles',π 'Page map context Error',π 'Insufficient memory pages',π 'Not enough free pages',π 'Can''t allocate zero (0) pages',π 'Logical page out of range',π 'Physical page out of range',π 'Page map hardware RAM full',π 'Page map already has a Handle',π 'Page map not mapped to Handle',π 'Undefined subfunction number');ππBEGINπ CASE Status OFπ 0 : WriteLn('Ok');π $80..$8F : WriteLn('EMM: ',EmmStatus[Status])π ELSE WriteLn('EMM: Unknown status = $',Hex(Status))π ENDπEND;ππππ{******** Generic procedure to call the EMM interrupt **********}ππPROCEDURE CallEmm(EmmFunction : Byte; VAR R : Registers);ππBEGINπ R.AH := EmmFunction;π Intr(EmsInt,R);π IF (R.AH <> 0) THEN BEGINπ EmmPrintStatus(EmmRegs.AH);π Halt(EmmRegs.AH)π ENDπ END;ππ{****************** Main Program *****************************}πππBEGINππ ClrScr;ππ{$DEFINE CheckFile} {Undefine to test second method}ππ{$IFDEF CheckFile} {Check EMM driver - Method 1}ππ GetIntVec(EmsInt,EmsVector);π PtrType(EmsVector).Offset := 10;π IF (DeviceName(EmsVector^) <> 'EMMXXXX0') THEN BEGINπ WriteLn('No EMM driver present');π Halt(1)π END;ππ{$ELSE} {Check EMM driver - Method 2}ππ {***** Determine if EMM is installed by opening EMMXXXX0 *****}ππ {$I-}π Assign(Tmp,'EMMXXXX0');π Reset(Tmp);π {$I+}π IF (IOResult <> 0) THEN BEGIN {Opened file without error?}π WriteLn('No EMM driver present');π WriteLn('IO error #',IOResult:3);π Halt(1)π END;ππ EmmRegs.AH := IOCtlFun {Call IOCtl function to }π EmmRegs.AL := $00; { test whether EMMXXXX0 is}π EmmRegs.BX := FileRec(Tmp).Handle; { a file or a device }ππ MsDos(EmmRegs);π Close(Tmp);ππ IF (EmmRegs.Flags AND 1) = 0 THEN {Call successfull}π IF (EmmRegs.DX AND $80) = $80 THEN {Handle is for a device}π WriteLn('Handle refers to a device')π ELSE BEGINπ WriteLn('Handle refers to a FILE');π WriteLn('Unable to contact EMM driver if present');π Halt(1)π ENDπ ELSE BEGIN {Call unsuccessfull}π CASE EmmRegs.AX OFπ 1 : WriteLn('Invalid IOCTL subfunction');π 5 : WriteLn('Access to IOCTL denied');π 6 : WriteLn('Invalid Handle')π ELSE WriteLn('Unknown error # ',Hex(EmmRegs.AX))π END;π WriteLn('Unable to contact EMM driver');π Halt(1)π END;πππ{$ENDIF}ππ WriteLn('EMM driver present');ππ {******** Print the current status of the EMM driver ********}ππ CallEmm(GetStatus,EmmRegs);π WriteLn('EMM Status Ok');ππ {******** Print the version number of EMM driver *************}ππ CallEmm(GetEmmVersion,EmmRegs);ππ WriteLn('EMS driver version = ',π (EmmRegs.AL SHR 4):1,'.',π (EmmRegs.AL AND $0F):1);ππ IF EmmRegs.AL < $32 THEN BEGINπ WriteLn('Error - EMM is version is earlier than 3.2');π Halt(1)π END;ππ {***** Print the page frame & physical window addresses ******}ππ CallEmm(GetPageFrameAddr,EmmRegs);ππ PtrType(P0).Segment := EmmRegs.BX; { Window 0 -> P0 = BX:0000 }π PtrType(P0).Offset := $0;π PtrType(P1).Segment := EmmRegs.BX; { Window 1 -> P1 = BX:4000 }π PtrType(P1).Offset := $4000;π PtrType(P2).Segment := EmmRegs.BX; { Window 2 -> P2 = BX:8000 }π PtrType(P2).Offset := $8000;π PtrType(P3).Segment := EmmRegs.BX; { Window 3 -> P3 = BX:C000 }π PtrType(P3).Offset := $C000;ππ WriteLn('Page frame segment address = ',Hex(EmmRegs.BX));π WriteLn('Physical page 0 address = ',PrintPointer(P0));π WriteLn('Physical page 1 address = ',PrintPointer(P1));π WriteLn('Physical page 2 address = ',PrintPointer(P2));π WriteLn('Physical page 3 address = ',PrintPointer(P3));ππ {***** Print # of unallocated pages and total # of pages *****}ππ CallEmm(GetUnallocPages,EmmRegs);π WriteLn('Total EMS pages = ',EmmRegs.DX:4);π WriteLn('Unused EMS pages = ',EmmRegs.BX:4);ππ {***** Allocate some pages of expanded memory *****}ππ EmmRegs.BX := (NumMsgs + MsgsPerPage) DIV MsgsPerPage;π CallEmm(AllocatePages,EmmRegs);π WriteLn('Allocated ',EmmRegs.BX,π ' pages to handle # ',EmmRegs.DX);π EmmHandle := EmmRegs.DX;ππ {***** Load EMS RAM with data *****}ππ MsgBuf := P0; {* Set Message pointer to Page 0 *}ππ FOR I := 0 TO NumMsgs-1 DO BEGINπ Str(I:4,StrNum); {Create msg string }π Buff := ' EMS msg # ' + StrNum;π IF (I MOD 100) = 0 THEN Write('.'); {Dsp status on screen}π Page := I DIV MsgsPerPage;π Index := I MOD MsgsPerPage;π PtrType(MsgBuf).Offset := Index * SizeOf(Buff);ππ {**** Map indicated logical page into physical page 0 ****}ππ EmmRegs.AH := MapHandlePage; {Map EMS page cmd }π EmmRegs.BX := Page; {Logical page number }π EmmRegs.AL := 0; {Physical page 0 }π EmmRegs.DX := EmmHandle; {EMM RAM handle }ππ Intr(EmsInt,EmmRegs);ππ IF EmmRegs.AH = 0 THENπ Move(Buff[0],MsgBuf^,SizeOf(Buff)) {Set message into mem}π ELSE BEGINπ EmmPrintStatus(EmmRegs.AH);π I := NumMsgsπ ENDπ END;ππ WriteLn;ππ {****** Allow user to access any message in the buffer ******}ππ I := $FF;π WHILE I <> -1 DO BEGINπ MsgBuf := P3; {Set MsgBuf to physical page 3}π Write('Enter message # to retrieve, or -1 to quit: ');π ReadLn(I);π IF (I >= 0) AND (I < NumMsgs) THEN BEGINπ Page := I DIV MsgsPerPage;π Index := I MOD MsgsPerPage;ππ {**** Map indicated page into physical page 3 ****}ππ EmmRegs.AH := MapHandlePage; {Map EMM page command}π EmmRegs.BX := Page; {Logical page number }π EmmRegs.AL := 3; {Physical page 3 }π EmmRegs.DX := EmmHandle; {EMM RAM handle }ππ Intr(EmsInt,EmmRegs);ππ IF EmmRegs.AH = 0 THEN BEGINπ Inc(PtrType(MsgBuf).Offset,Index * SizeOf(Buff));π Move(MsgBuf^,Buff[0],SizeOf(Buff));π Write('Retrieved message -> ',Buff);π WriteLn(' from page #',Page:2,' Index',Index:5);π ENDπ ELSE BEGINπ EmmPrintStatus(EmmRegs.AH);π I := -1;π ENDπ ENDπ END;ππ {***** Free the EMS RAM back to the EMM driver ****}ππ EmmRegs.DX := EmmHandle;π CallEmm(DeallocatePages,EmmRegs);π WriteLn('Released all memory for handle ',EmmRegs.DX:2);πEND.π 20 06-22-9309:14ALL SWAG SUPPORT TEAM Detect EMS/XMS IMPORT 16 ä▒Qc ===========================================================================π BBS: Canada Remote SystemsπDate: 06-12-93 (09:36) Number: 26301πFrom: CHRIS JANTZEN Refer#: NONEπ To: WILLIAM SITCH Recvd: NO πSubj: RE: DETECTING EMS/XMS Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πOn Thursday June 10 1993, William Sitch wrote to All:ππ WS> Does anyone know how to detect XMS/EMS? I've used something documented inπ WS> my PC INTERRUPTS book, but I can't seem to get it to work.ππThe following code was *mostly* right. Go back to your original source toπcompare the changes I made:ππ procedure check_ems (VAR installed:boolean; VAR ver,ver2:byte); varπ regs : registers;π beginπ regs.ax := $46;π intr($67,regs);π installed := regs.ah = $00;π if (installed = true) thenπ beginπ ver := hi(regs.al);π ver2 := lo(regs.al);π end;π end;ππ procedure check_xms (VAR installed:boolean; VAR ver,ver2:byte); varπ regs : registers;π beginπ regs.ax := $4300;π intr($2F,regs);π installed := regs.al = $80;π if (installed = true) thenπ beginπ regs.ax := $4310;π regs.ah := $00;π intr($2F,regs);π ver := regs.ax;π ver2 := regs.bx;π end;π end;ππ WS> I am pretty sure I'm calling the interrupts right, but it always returnsπ WS> false, indicating that I do NOT have EMS/XMS, although I do. Can anyoneπ WS> help me out?ππYou were. Mostly. What you forgot was that when a real world book like PCπInterrupts says "Load the AX register with the value 4300h", it means to usπPascal programmers "Load the AX variable with the value $4300". Note the dollarπsign. That means hexadecimal (like the little h on the end means hexadecimal toπassembly programmers).ππChris KB7RNL =->ππ--- GoldED 2.41π * Origin: SlugPoint * Coos Bay, OR USA (1:356/18.2)π 21 08-27-9320:15ALL SEPP MAYER BIG Arrays on the HEAP IMPORT 28 ä▒;é {πSEPP MAYERππ> Unfortunately I can't cut down on the size of my variables...(well,π> ok, one of them I did, but it drastically reduces the usefulness ofπ> the program itself). So now I got rid of it, but one of my variablesπ> is of Array [1..1000] Of String[12]. I'd like to have the array go toπ> 2500. Unfortunately, when I do this, it gives me the error. Is thereπ> some way to get around that??ππAt the Time your Array uses 13000 Byte of Memory in the Data-Segmentπ(12 Byte for the 12 characters in the string + 1 Byte for the Length).ππThe Only Thing You have to do, is to put your Array to the Heap, so youπcan have an Array[1..3250] of your String with the same Use of Memory inπyour Data-Segment.π}ππprogram BigArray;ππtypeπ PStr12 = ^TStr12;π tStr12 = String[12];ππvarπ TheTab : Array[1..3250] of PStr12;π i : Integer;ππfunction AddTabEle(i : Integer; s : String) : Boolean;πbeginπ if i < 1 thenπ beginπ WriteLn('You Used an Index lower than 1');π AddTabEle := false;π Exit;π end;π if i > 3250 thenπ beginπ WriteLn('You Used an Index higher then 3250');π AddTabEle := false;π Exit;π end;π if TheTab[i] <> nil thenπ beginπ WriteLn('TAB Element is already in Use');π AddTabEle := false;π Exit;π end;π if MemAvail < 13 thenπ beginπ WriteLn('Not Enough Heap Memory');π AddTabEle := false;π Exit;π end;π New[TheTab[i]);π TheTab[i]^ := Copy(s,1,12); {Limit to 12 Characters}π AddTabEle := true;πend;ππfunction ChangeTabEle(i : integer; s : string) : Boolean;πbeginπ if TheTab[i] = nil thenπ beginπ WriteLn('You Tried to Modify an non-existing TAB Element, Use AddTabEle');π ChangeTabEle := false;π Exit;π end;π TheTab[i]^ := Copy(s, 1, 12);π ChangeTabEle := true;πend;ππfunction GetTabEle(i : integer) : string;πbeginπ if TheTab[i] = nil thenπ beginπ GetTabEle := 'TAB Ele not found'; {No error occurs}π Exit;π end;π s := TheTab[i]^;πend;πfunction FreeTabEle(i : integer) : Boolean;πbeginπ if TheTab[i] = nil thenπ beginπ WriteLn('TAB Element is not used';π FreeTabEle := false;π Exit;π end;π Dispose(TheTab[i]);π TheTab[i] := nil;π FreeTabEle := true;πend;ππprocedure FreeTab;πbeginπ for i := 1 to 3250 doπ beginπ if TheTab[i] <> nil thenπ if NOT FreeTabEle(i) thenπ WriteLn('Error releasing Tab element');π end;πend;ππbeginπ for i := 1 to 3250 do {Initialize Pointers with nil, to test }π TheTab[i] := nil; {if Element is Used, compare pointer with nil}π {.......} {Your Program}π if NOT AddTabEle(1, 'Max 12 Chars') then {Add an Ele}π WriteLn('Error creating TAB element'); {evtl. use FreeMem + Halt(1)}π {to terminate Programm}π WriteLn(GetTabEle(1)); {Write an Tab Ele}π if NOT ChangeTabEle(1, '12 Chars Max') then {Change an Ele}π WriteLn('Error changing TAB element'); {evtl. use FreeMem + Halt(1)}π {to terminate Programm}π WriteLn(GetTabEle(1)); {Write an Tab Ele}π if NOT FreeTabEle(1) then {Delete(Free) an Ele}π WriteLn('Error releasing Tab element'); {evtl. use FreeMem + Halt(1)}π {to terminate Programm}π {.......} {Your Program}π FreeTab; {At The End of Your Program free all TAB Ele}πend.ππ 22 08-27-9320:21ALL FRANCOIS THUNUS Checking for Cache IMPORT 39 ä▒à] {πFRANCOIS THUNUSππ> Would it be possible to throw a [Ctrl-Alt-Del] into the keyboard buffer,π> causing Smartdrv to Write its data and warm boot the computer? if so, anyπ> ideal how a person would do this?ππtrap keyboard infoπif ctr-alt-del then beginπ check For smrtdrvπ if smrtdrv then flush cacheπ rebootπ end;ππFlush cache: (was posted here but since it is more than a month old, i guessπit's ok to repost ?):π}ππUnit SfeCache;π{ππMax Maischein Sunday, 7.03.1993π2:249/6.17 Frankfurt, GERππThis Unit implements an automatic flush For installedπWrite-behind caches like SmartDrive and PC-Cache. It's based onπcache detection code by Norbert Igl, I added the calls to flushπthe buffers. The stuff is only tested For SMARTDRV.EXE, the restπrelies on Norbert and the INTERRUP.LST from Ralf Brown.ππAl says : "Save early, save often !"ππThe Unit exports one Procedure, FlushCache, this flushes theπfirst cache found. It could be good to flush everything onπProgram termination, since users are likely to switch off theirπcomputers directly upon Exit from the Program.ππThis piece of code is donated to the public domain, but I requestπthat, if you use this code, you mention me in the DOCs somewhere.π -maxπ}πInterfaceππImplementationππUsesπ Dos;ππConstπ AktCache : Byte = 0;ππTypeπ FlushProc = Procedure;ππVarπ FlushCache : FlushProc;ππFunction SmartDrv_exe : Boolean;πVarπ Found : Boolean;πbeginπ Found := False;π Asmπ push bpπ stcπ mov ax, 4A10hπ xor bx, bxπ int 2Fhπ pop bpπ jc @NoSmartDriveπ cmp ax, 0BABEhπ jne @NoSmartDriveπ mov Found, Trueπ @NoSmartDrive:π end;π SmartDrv_exe := Found;πend;ππFunction SmartDrv_sys : Boolean;πVarπ F : File;π B : Array[0..$27] of Byte; { return Buffer }π OK : Boolean;πConstπ S = SizeOf( B );πbeginπ SmartDrv_sys := False;π OK := False;π { -------Check For SmartDrv.SYS----------- }π Assign(f,'SMARTAAR');π {$I-}π Reset( F );π {$I+}π if IoResult <> 0 thenπ Exit; { No SmartDrv }π FillChar( B, Sizeof(B), 0 );π Asmπ push dsπ mov ax, 4402hπ mov bx, TextRec( F ).Handleπ mov cx, Sπ mov dx, seg Bπ mov ds, dxπ mov dx, offset Bπ int 21hπ jc @Errorπ mov OK, 1π @Error:π pop dsπ end;π close(f);π SmartDrv_sys := OK;πend;ππFunction CompaqPro : Boolean;πVarπ OK : Boolean;πbeginπ CompaqPro := False;π OK := False;π Asmπ mov ax, 0F400hπ int 16hπ cmp ah, 0E2hπ jne @NoCacheπ or al, alπ je @NoCacheπ cmp al, 2π ja @NoCacheπ mov OK, 1π @NoCache:π end;π CompaqPro := OK;πend;ππFunction PC6 : Boolean; { PCTools v6, v5 }πVarπ OK : Boolean;πbeginπ PC6 := False;π OK := False;π Asmπ mov ax, 0FFA5hπ mov cx, 01111hπ int 16hπ or ch, chπ jne @NoCacheπ mov OK, 1π @NoCache:π end;π PC6 := OK;πend;ππFunction PC5 : Boolean;πVarπ OK : Boolean;πbeginπ PC5 := False;π OK := False;π Asmπ mov ax, 02BFFhπ mov cx, 'CX';π int 21hπ or al, alπ jne @NoCacheπ mov ok, 1π @NoCache:π end;π PC5 := OK;πend;ππFunction HyperDsk : Boolean; { 4.20+ ... }πVarπ OK : Boolean;πbeginπ Hyperdsk := False;π OK := False;π Asmπ mov ax, 0DF00hπ mov bx, 'DH'π int 02Fhπ cmp al, 0FFhπ jne @NoCacheπ cmp cx, 05948hπ jne @NoCacheπ mov OK, 1π @NoCache:π end;π HyperDSK := OK;πend;ππFunction QCache : Boolean;πVarπ OK : Boolean;πbeginπ QCache := False;π OK := False;π Asmπ mov ah, 027hπ xor bx, bxπ int 013hπ or bx, bxπ je @NoCacheπ mov OK, 1π @NoCache:π end;π QCache := OK;πend;ππProcedure FlushSD_sys; Far;πVarπ F : File;π B : Byte;πbeginπ Assign(F, 'SMARTAAR');π Reset(F);π B := 0;π Asmπ push dsπ mov ax, 04403hπ mov bx, FileRec(F).Handleπ mov cx, 1π int 21hπ pop dsπ end;πend;ππProcedure FlushSD_exe; Far; Assembler;πAsmπ mov ax, 04A10hπ mov bx, 1π int 2Fhπend;ππProcedure FlushPC6; Far; Assembler;πAsmπ mov ax, 0F5A5hπ mov cx, -1π int 16hπend;ππProcedure FlushPC5; Far; Assembler;πAsmπ mov ah, 0A1hπ mov si, 04358hπ int 13hπend;ππProcedure FlushNoCache; Far;πbeginπend;ππbeginπ if SmartDrv_exe thenπ FlushCache := FlushSD_exeπ elseπ if SmartDrv_sys thenπ FlushCache := FlushSD_sysπ elseπ if PC6 thenπ FlushCache := FlushPC6π elseπ if PC5 thenπ FlushCache := FlushPC5π elseπ FlushCache := FlushNoCache;ππ FlushCache;πend.π 23 08-27-9320:27ALL JOACHIM BARTZ Compare Memory Blocks IMPORT 6 ä▒îc { JOACHIM BARTZ }ππFunction CompBlocks(Buf1, Buf2 : Pointer;π BufSize : Word) : Boolean; Assembler;πAsm { Compares two buffers and returns True if contents are equal }π PUSH DSπ MOV AX,1 { Init error return: True }π LDS SI,Buf1π LES DI,Buf2π MOV CX,BufSizeπ JCXZ @@Doneπ CLD { Loop Until different or end of buffer }π REP CMPSB { Flag to bump SI,DI }π JE @@Doneπ { Compare error }π XOR AX, AX { Return False }π @@Done:π POP DS { Restore }πend;π 24 08-27-9320:53ALL HENRIK SCHMIDT-MOELLER EMS Addressing IMPORT 25 ä▒ï│ {πHENRIK SCHMIDT-MOELLERππI've made some procedures for EMS addressing in TP. EMS uses a technic calledπbank switching. It reserves a 64k area (EmmSeg) in memory for EMS and maps/πunmaps 16k EMS-pages in this area. Look at interrupt 67h for a complete list ofπEMS commands. I haven't had time to comment on these procedures, so if youπdon't understand them, feel free to ask. OK, here goes nothing...ππOh, by the way, REMEMBER to DEallocate!!!π}ππVARπ EmmSeg,π EmmHandle : Word;π Err : Byte;ππPROCEDURE DeallocateMem(Handle : Word); Forward;ππPROCEDURE Error(E : String);πBEGINπ DeallocateMem(Emmhandle);π WriteLn(#7 + E);π Halt(1);πEND;ππPROCEDURE AllocateMem(LogPages : Word);πBEGINπ ASMπ MOV AH, 43hπ MOV BX, LogPagesπ INT 67hπ MOV Err, AHπ MOV EmmHandle, DXπ END;π CASE Err OFπ $80 : Error('AllocateMem: Internal error in EMS software');π $81 : Error('AllocateMem: Malfunction in EMS software');π $84 : Error('AllocateMem: Undefined function');π $85 : Error('AllocateMem: No more handles available');π $87 : Error('AllocateMem: Allocation requested more pages than are' + #13#10 +π ' physically available; no pages allocated');π $88 : Error('AllocateMem: Specified more logical pages than are'+ #13#10 +π ' currently available; no pages allocated');π $89 : Error('AllocateMem: Zero pages requested');π END;πEND;ππPROCEDURE MapEmm(PsyPage : Byte; LogPage : Word);πBEGINπ ASMπ MOV AH, 44hπ MOV AL, PsyPageπ MOV BX, LogPageπ MOV DX, EmmHandleπ INT 67hπ MOV Err, AH;π END;π CASE Err OFπ $80 : Error('MapEmm: Internal error in EMS software');π $81 : Error('MapEmm: Malfunction in EMS software');π $83 : Error('MapEmm: Invalid handle');π $84 : Error('MapEmm: Undefined function');π $8A : Error('MapEmm: Logical page not assigned to this handle');π $8B : Error('MapEmm: Physical page number invalid');π END;πEND;ππPROCEDURE DeallocateMem(Handle : Word);πBEGINπ ASMπ MOV AH, 45hπ MOV DX, Handleπ INT 67hπ END;πEND;ππPROCEDURE GetPageSeg;πBEGINπ ASMπ MOV AH, 41hπ INT 67hπ MOV EmmSeg, BXπ MOV Err, AH;π END;π CASE Err OFπ $80 : Error('GetPageSeg: Internal error in EMS software');π $81 : Error('GetPageSeg: Malfunction in EMS software');π $84 : Error('GetPageSeg: Undefined function');π END;πEND;ππPROCEDURE GetMaxPages(VAR Num : Word);πVARπ Dummy : Word;πBEGINπ ASMπ MOV AH, 42hπ INT 67hπ MOV Dummy, BXπ MOV Err, AH;π END;π Num := Dummy;π CASE Err OFπ $80 : Error('GetMaxPages: Internal error in EMS software');π $81 : Error('GetMaxPages: Malfunction in EMS software');π $84 : Error('GetMaxPages: Undefined function');π END;πEND;ππPROCEDURE WriteMem(Page : Byte; Pos : Integer; Ch : Char);πBEGINπ Mem[EmmSeg : Page * $4000 + Pos] := Ord(Ch);πEND;ππPROCEDURE ReadMem(Page : Byte; Pos : Integer; VAR Ch : Char);πBEGINπ Ch := Chr(Mem[EmmSeg : Page * $4000 + Pos]);πEND;ππ 25 08-27-9321:28ALL KENT BRIGGS Shrink/Expand the Heap IMPORT 9 ä▒█└ {πKENT BRIGGSππHere is what I came up with regarding my problem of needing a largeπheap (temporarily) and needing memory for an EXEC routine:π}ππprocedure heap_shrink; {free up all unused heap}πbeginπ reg.bx := memw[seg(heapptr) : ofs(heapptr) + 2] - prefixseg;π reg.es := prefixseg;π reg.ah := $4a; {dos memory alloc. interrupt}π msdos(reg);πend;ππprocedure heap_expand; {reclaim unused heap}πbeginπ reg.bx := memw[seg(heapend) : ofs(heapend) + 2] - prefixseg;π reg.es := prefixseg;π reg.ah := $4a;π msdos(reg);πend;ππ{πLeave the default heapmax at 655360. Dispose of all temporary pointersπand call heap_shrink right before exec(my_prgm) and heap_expand rightπafter. The memw's get the segment addresses for the heapend and heapptrπvariables (see memory map in manual). Subtract the PSP segment and thatπgets you the number of paragraphs (16 byte blocks) to allocate.ππAnyone see any dangers with this scheme? I instantly freed up 110K forπDOS shells in my application. No problems so far.π} 26 08-27-9321:28ALL MAX MAISCHEIN Writing Data to HiMem IMPORT 38 ä▒» {πMAX MAISCHEINππ> Yes, but my question deals with storage in the Heap - I want to loadπ> and manipulate as much data in memory as possible. Hence, I am lookingπ> for 1 byte improvements, if possible. The actual file content size isπ> not an issue...ππFor the case that some of your machines have UMBs available, I have a unitπthat extends the heap into these UMB blocks completely transparent.πTHe unit seems to work, I'd like to see any comments about bugs etc. on it.ππ Max Maischein 2:249/6.17ππ This unit was created to use the high memory under DOS whereπ LoadHi loads the TSRs etc. as extra heap. This was possible dueπ to the revamped heap manager of Turbo Pascal, which now againπ uses MCBs to control its freelist instead of an array of 8192π pointers. I used this technique just like Himem / Quemm to insertπ a huge used block, the high DOS / BIOS area in the heap and thenπ to add the free RAN behind it. Now I have a maximum heap size ofπ 700K, which is nicer than the old 640K limit. Note that usingπ UseHi will not pay attention to the compiler $M settings in yourπ source. The memory is freed automatically by DOS, but I had toπ adjust the MaxHeapxxx variable in the Memory unit, this is a wordπ that contains the maximum heap size, which increased by usingπ UseHi. If you don't need Turbo Vision, you can remove the Usesπ Memory line and also remove the MaxHeapxxx adjustment. But withπ TVision, it will only work, if you have this line in it.ππ The text variable HeapWalk is for debugging purposes, if you wantπ to see a dump of the free blocks in the heap, you need to assignπ and reset / rewrite the HeapWalk variable and then call ListWalk.π Don't forget to close the HeapWalk variable again. It will dumpπ the whole freelist into the file.ππ This piece of code is donated to the public domain, but I requestπ that, if you use this code, you mention me in the DOCs somewhere.ππ -maxπ}ππUnit UseHi;πInterfaceππTypeπ PFreeRec = ^TFreeRec;π TFreeRec = Recordπ Next : Pointer;π Remain : Word;π Paras : Word;π End;ππVarπ HeapWalk : ^Text;ππProcedure ListWalk;ππVarπ NewHeap : Pointer;π NewSize : Word;ππImplementationπUsesπ MemAlloc,π Memory,π Objects,π Strings2;ππConstπ MemStrategy : Word = 0;π UMBState : Boolean = False;ππProcedure himem_Init; Assembler;πAsmπ mov ax, 5800hπ int 21hπ mov MemStrategy, axπ mov ax, 5802hπ int 21hπ mov UMBState, alπ mov ax, 5803hπ mov bx, 1π int 21hπ mov ax, 5801hπ mov bx, 0040hπ int 21hπEnd;ππProcedure himem_Done; Assembler;πAsmπ mov ax, 5801hπ mov bx, MemStrategyπ int 21hπ mov ax, 5803hπ mov bl, UMBStateπ xor bh, bhπ int 21hπ mov ax, 1πEnd;ππProcedure MakeFreeList;πVarπ Mem : LongInt; { size of last block between heapPtr / HeapEnd }π P : PFreeRec;πBeginπ If (NewHeap = nil) thenπ Exit;ππ P := HeapPtr;ππ Mem := LongInt(PtrRec(HeapEnd).Seg) shl 4 + PtrRec(HeapEnd).Ofs;π Dec(Mem, LongInt(PtrRec(HeapPtr).Seg) shl 4 + PtrRec(HeapPtr).Ofs);ππ If (Mem < 8) thenπ RunError(203);ππ With P^ doπ Beginπ Next := NewHeap;π Paras := Mem shr 4;π Remain := Mem and $0F;π End;ππ HeapPtr := NewHeap;π HeapEnd := NewHeap;π With PtrRec(HeapEnd) doπ Inc(Seg, Pred(NewSize));π MaxHeapSize := PtrRec(HeapEnd).Seg - PtrRec(HeapOrg).Seg;πEnd;ππFunction BlockSize(P : PFreeRec) : LongInt;πBeginπ With P^ doπ BlockSize := LongInt(Paras) * 16 + LongInt(Remain);πEnd;ππProcedure ListWalk;πVarπ P : PFreeRec;π Mem : LongInt;πBeginπ WriteLn(HeapWalk^, 'Free list :', WPointer(FreeList));π WriteLn(HeapWalk^, 'Heap end :', WPointer(HeapEnd));π WriteLn(HeapWalk^, 'Heap pointer :', WPointer(HeapPtr));π WriteLn(HeapWalk^, 'New heap :', WPointer(NewHeap));π WriteLn(HeapWalk^, 'Walk of freelist :' );π P := FreeList;π If P <> HeapPtr thenπ While P <> HeapPtr doπ Beginπ Write(HeapWalk^, WPointer(Addr(P^)), ' -- ');π With PtrRec(P), P^ doπ Write(HeapWalk^, WPointer(Ptr(Seg + Paras, Ofs + Remain)));π WriteLn(HeapWalk^, ', ', BlockSize(P) : 7, ' bytes.');π P := P^.Next;π End;π Mem := LongInt(PtrRec(HeapEnd).Seg) shl 4 + PtrRec(HeapEnd).Ofs;π Dec(Mem, LongInt(PtrRec(HeapPtr).Seg) shl 4 + PtrRec(HeapPtr).Ofs);π WriteLn(HeapWalk^, WPointer(HeapPtr), ' -- ', WPointer(HeapEnd), ', ',π Mem : 7, ' bytes left on top of heap.');πEnd;ππBeginπ NewHeap := nil;π HeapWalk := @Output;ππ himem_Init;π NewSize := DOSMemAvail shr 4;π MAlloc(NewHeap, DosMemAvail);π himem_Done;ππ MakeFreeList;πEnd.π 27 08-27-9321:32ALL GUY MCLOUGHLIN Loading a file on HEAP IMPORT 13 ä▒' {πGUY MCLOUGHLINππ>How would I load a file straight into memory, and access it directlyπ>using pointers?ππLoad file data onto the HEAP memory-pool.π}ππprogram LoadFileOnHEAP;ππtypeπ { Array type used to define the data buffer. }π arby_60K = array[1..61440] of byte;π { Pointer type used to allocate the data buffer on the HEAP memory pool. }π po_60KBuff = ^arby_60K;ππconstπ { Buffer size in bytes constant. }π co_BuffSize = sizeof(arby_60K);ππ{ Check for IO errors, close data file if necessary. }πprocedure CheckForErrors(var fi_Temp : file; bo_CloseFile : boolean);πvarπ by_Temp : byte;πbeginπ by_Temp := ioresult;π if (by_Temp <> 0) thenπ beginπ writeln('FILE ERROR = ', by_Temp);π if bo_CloseFile thenπ close(fi_Temp);π halt(1)π endπend;ππvarπ wo_BuffIndex,π wo_BytesRead : word;π po_Buffer : po_60KBuff;π fi_Temp : file;ππBEGINπ assign(fi_Temp, 'EE.PAS');π {$I-}π reset(fi_Temp, 1);π {$I+}π CheckForErrors(fi_Temp, false);ππ { Check if there is enough free memory on the HEAP. }π { If there is, then allocate buffer on the HEAP. }π if (maxavail > co_BuffSize) thenπ new(po_Buffer)π elseπ beginπ close(fi_Temp);π writeln('ERROR: Insufficient HEAP memory!')π end;ππ { Load file-data into buffer. }π blockread(fi_Temp, po_Buffer^, co_BuffSize, wo_BytesRead);π CheckForErrors(fi_Temp, true);ππ { Display each byte that was read-in. }π for wo_BuffIndex := 1 to wo_BytesRead doπ write(chr(po_Buffer^[wo_BuffIndex]));ππ close(fi_Temp)πEND.π 28 08-27-9321:36ALL SWAG SUPPORT TEAM Detect Which Memory IMPORT 5 ä▒d Usesπ Dos;ππVarπ HaveMem : Boolean;ππprocedure check_xms(VAR installed : boolean);πVarπ regs : registers;πbeginπ regs.ax := $4300;π intr($2F, regs);π installed := regs.al = $80;πend;ππprocedure check_ems(VAR installed : boolean);πvarπ regs : registers;πbeginπ regs.ah := $46;π intr($67, regs);π installed := regs.ah = $00;πend;ππbeginπ check_xms(HaveMem);π writeln('XMS: ',HaveMem);π check_ems(HaveMem);π writeln('EMS: ',HaveMem);πend.ππ 29 08-27-9322:13ALL SEAN PALMER XMS Unit IMPORT 49 ä▒j {πSean Palmerππ> I did not mean to imply that I expected a library that could provideπ> access to XMS With simple Pointer dereferences. I understand theπ> difficulty of accessing >1MB from a Real-mode Program. I would beπ> happy(ECSTATIC in fact) if I could find a library that would allow anπ> allocation to XMS, returning a handle to the block, and allowπ> access(copying) of the block via a Procedure call. Of course, theπ> catch is that the library would have to be able to deal With randomπ> allocations and deallocations-like a heap manager For XMS. I know thatπ> there are VMM's out there that can do this-I just can't get my handsπ> on one!ππTry this:ππturbo pascal 6.0 sourceπ}ππUnit xms; {this Unit won't handle blocks bigger than 64k}ππInterfaceππFunction installed : Boolean;πFunction init(Var h : Word; z : Word) : Boolean; {alloc xms}πProcedure avail(Var total, largest : Word); {how much free?}πFunction save(h, z : Word; Var s) : Boolean; {move main to xms}πFunction load(h, z : Word; Var s) : Boolean; {move xms to main}πProcedure free(h : Word); {dispose xms}πFunction lock(h : Word) : LongInt;πFunction unlock(h : Word) : Boolean;πFunction getInfo(h : Word; Var lockCount, handlesLeft : Byte;π Var sizeK : Word) : Boolean;πFunction resize(h, sizeK : Word) : Boolean;ππImplementationππ{Error codes, returned in BL reg}ππConstπ FuncNotImplemented = $80; {Function is not implemented}π VDiskDeviceDetected = $81; {a VDISK compatible device found}π A20Error = $82; {an A20 error occurred}π GeneralDriverError = $8E; {general driver error}π UnrecoverableError = $8F; {unrecoverable driver error}π HmaDoesNotExist = $90; {high memory area does not exist}π HmaAlreadyInUse = $91; {high memory area already in use}π HmaSizeTooSmall = $92; {size requested less than /HMAMIN}π HmaNotAllocated = $93; {high memory area not allocated}π A20StillEnabled = $94; {A20 line is still enabled}π AllExtMemAllocated = $A0; {all extended memory is allocated}π OutOfExtMemHandles = $A1; {extended memory handles exhausted}π InvalidHandle = $A2; {invalid handle}π InvalidSourceHandle = $A3; {invalid source handle}π InvalidSourceOffset = $A4; {invalid source offset}π InvalidDestHandle = $A5; {invalid destination handle}π InvalidDestOffset = $A6; {invalid destination offset}π InvalidLength = $A7; {invalid length}π OverlapInMoveReq = $A8; {overlap in move request}π ParityErrorDetected = $A9; {parity error detected}π BlockIsNotLocked = $AA; {block is not locked}π BlockIsLocked = $AB; {block is locked}π LockCountOverflowed = $AC; {lock count overflowed}π LockFailed = $AD; {lock failed}π SmallerUMBAvailable = $B0; {a smaller upper memory block is avail}π NoUMBAvailable = $B1; {no upper memory blocks are available}π InvalidUMBSegment = $B2; {invalid upper memory block segment}ππ xmsProc : Pointer = nil; {entry point For xms driver, nil if none}ππVarπ copyRec : Recordπ size : LongInt; {Bytes to move (must be even)}π srcH : Word; {handle (0=conventional mem)}π srcP : Pointer;π dstH : Word;π dstP : Pointer;π end;πππFunction installed : Boolean;πbeginπ installed := (xmsProc <> nil);πend;ππFunction init(Var h : Word; z : Word) : Boolean; Assembler;πAsmπ mov dx, zπ test dx, $3FFπ jz @Sπ add dx, $400π @S: {allow For partial K's}π mov cl, 10π shr dx, cl {convert to K}π mov ah, 9π call xmsProc {allocate XMS block}π cmp ax, 1π je @S2π xor al, alπ @S2:π les di, hπ mov es:[di], dxπend;ππProcedure avail(Var total, largest : Word); Assembler;πAsmπ mov ah, 8π call xmsProc {query free xms}π les di, totalπ mov es:[di], dxπ les di, largestπ mov es:[di], axπend;ππFunction copy : Boolean; Assembler;πAsm {internal}π push dsπ mov si, offset copyRec {it's in DS, right?}π mov ah, $Bπ call xmsProc {copy memory}π cmp ax,1π je @Sπ xor al,alπ @S:π pop dsπend;ππFunction save(h, z : Word; Var s) : Boolean;πbeginπ if odd(z) thenπ inc(z);π With copyRec doπ beginπ size := z;π srcH := 0;π srcP := @s; {source, from main memory}π dstH := h;π dstP := ptr(0,0); {dest, to xms block}π end;π save := copy;πend;ππFunction load(h, z : Word; Var s) : Boolean;πbeginπ if odd(z) thenπ inc(z);π With copyRec doπ beginπ size := z;π srcH := h;π srcP := ptr(0,0); {source, from xms block}π dstH := 0;π dstP := @s; {dest, to main memory}π end;π load := copy;πend;ππProcedure free(h : Word); Assembler;πAsmπ mov dx, hπ mov ah, $Aπ call xmsProcπend;ππFunction lock(h : Word) : LongInt; Assembler;πAsmπ mov ah, $Cπ mov dx, hπ call xmsProc {lock xms block}π cmp ax, 1π je @OKπ xor bx, bxπ xor dx, dxπ @OK: {set block to nil (0) if err}π mov ax, bxπend;ππFunction unlock(h : Word) : Boolean; Assembler;πAsmπ mov ah, $Dπ mov dx, hπ call xmsProc {unlock xms block}π cmp ax, 1π je @Sπ xor al, alπ @S:πend;ππFunction getInfo(h : Word; Var lockCount, handlesLeft : Byte;π Var sizeK : Word) : Boolean; Assembler;πAsmπ mov ah, $Eπ mov dx, hπ call xmsProc {get xms handle info}π cmp ax, 1π je @Sπ xor al, alπ @S:π les di, lockCountπ mov es:[di], bhπ les di, handlesLeftπ mov es:[di], blπ les di, sizeKπ mov es:[di], dxπend;ππFunction resize(h, sizeK : Word) : Boolean; Assembler;πAsmπ mov ah, $Fπ mov dx, hπ mov bx, sizeKπ call xmsProc {resize XMS block}π cmp ax ,1π je @Sπ xor al, alπ @S:πend;ππbeginπ Asm {there is a possibility these ints will trash the ds register}π mov ax, $4300 {load check Function For xms driver}π int $2F {call multiplex int}π cmp al, $80π jne @Xπ mov ax, $4310π int $2F {get adr of entry point->es:bx}π mov Word ptr xmsProc, bxπ mov Word ptr xmsProc+2, esπ @X:π end;πend.ππ 30 09-26-9309:36ALL SWAG SUPPORT TEAM XMS Memory Access Unit IMPORT 87 ä▒á {---------------- Extended Memory Access Unit -----------------}πUNIT XMS;π(**) INTERFACE (**)πVARπ XMSErrorCode : byte; { Error Code - Defined in XMS Spec }π XMSAddr : Pointer; { Entry Point for HIMEM.SYS Driver }ππFUNCTION XMSDriverLoaded: Boolean;πFUNCTION XMSTotalMemoryAvailable: Word;πFUNCTION XMSLargestBlockAvailable: Word;πFUNCTION XMSAllocateBlock(KBSize: Word): Word;πFUNCTION XMSReleaseBlock(Handle: Word): Boolean;πFUNCTION XMSMoveDataTo(SourceAddr: Pointer; NumBytes: LongInt;π XMSHandle: Word; XMSOffset: LongInt): Boolean;πFUNCTION XMSGetDataFrom(XMSHandle: Word; XMSOffset: LongInt;π NumBytes: LongInt; LowMemAddr: Pointer): Boolean;ππ(**) IMPLEMENTATION (**)ππTYPEπ XMSMoveStruct = recordπ movelen : LongInt; { length of block to move in bytes }π case integer ofπ { Case 0 Variant for Low Memory to XMS }π 0: (SHandle : Word; { source handle = 0π for conventional memory }π SPtr : pointer; { source address }π XMSHdl : Word; { XMS destination handle }π XMSOffset : LongInt); { 32 bit XMS offset }π { Case 1 Variant for XMS to Low Memory }π 1: (XMSH : Word; { XMS source handle }π XMSOfs : LongInt; { starting offset in XMS}π DHandle : Word; { 0 when conventional memoryπ destination }π DPtr : pointer); { address in conventional memory }π END;ππVAR moveparms : XMSMoveStruct; { structure for moving to andπ from XMS }ππ{**************************************************************}π{ XMSDriverLoaded - Returns true IF Extended Memory Driver }π{ HIMEM.SYS Loaded }π{ - Sets Entry Point Address - XMSAddr }π{**************************************************************}πFUNCTION XMSDriverLoaded: Boolean;πCONSTπ himemseg: Word = 0;π himemofs: Word = 0;πBEGINπ XMSErrorCode := 0;π ASMπ mov ax,4300h { Check to see IF HIMEM.SYS installed }π int 2fhπ cmp al,80h { Returns AL = 80H IF installed }π jne @1π mov ax,4310h { Now get the entry point }π int 2fhπ mov himemofs,bxπ mov himemseg,esπ @1:π END;π XMSDriverLoaded := (himemseg <> 0);π XMSAddr := Ptr(himemseg,himemofs);πEND;ππ{**************************************************************}π{ XMSTotalMemoryAvailable - Returns Total XMS Memory Available }π{**************************************************************}πFUNCTION XMSTotalMemoryAvailable: Word;πBEGINπ XMSErrorCode := 0;π XMSTotalMemoryAvailable := 0;π IF XMSAddr = nil THEN { Check IF HIMEM.SYS Loaded }π IF NOT XMSDriverLoaded THEN exit;π ASMπ mov ah,8π call XMSAddrπ or ax,axπ jnz @1π mov XMSErrorCode,bl { Set Error Code }π xor dx,dxπ @1:π mov @Result,dx { DX = total free extended memory }π END;πEND;ππ{**************************************************************}π{ XMSLargestBlockAvailable - Returns Largest Contiguous }π{ XMS Block Available }π{**************************************************************}πFUNCTION XMSLargestBlockAvailable: Word;πBEGINπ XMSErrorCode := 0;π XMSLargestBlockAvailable := 0;π IF XMSAddr = nil THEN { Check IF HIMEM.SYS Loaded }π IF NOT XMSDriverLoaded THEN exit;π ASMπ mov ah,8π call XMSAddrπ or ax,axπ jnz @1π mov XMSErrorCode,bl { On Error, Set Error Code }π @1:π mov @Result,ax { AX=largest free XMS block }π END;πEND;ππ{***************************************************************}π{ XMSAllocateBlock - Allocates Block of XMS Memory }π{ - Input - KBSize: No of Kilobytes requested }π{ - Returns Handle for memory IF successful }π{***************************************************************}πFUNCTION XMSAllocateBlock(KBSize: Word): Word;πBEGINπ XMSAllocateBlock := 0;π XMSErrorCode := 0;π IF XMSAddr = nil THEN { Check IF HIMEM.SYS Loaded }π IF NOT XMSDriverLoaded THEN exit;π ASMπ mov ah,9π mov dx,KBSizeπ call XMSAddrπ or ax,axπ jnz @1π mov XMSErrorCode,bl { On Error, Set Error Code }π xor dx,dxπ @1:π mov @Result,dx { DX = handle for extended memory }π END;πEND;ππ{**************************************************************}π{ XMSReleaseBlock - Releases Block of XMS Memory }π{ - Input: Handle identifying memory to be }π{ released }π{ - Returns true IF successful }π{**************************************************************}πFUNCTION XMSReleaseBlock(Handle: Word): Boolean;πVAR OK : Word;πBEGINπ XMSErrorCode := 0;π XMSReleaseBlock := false;π IF XMSAddr = nil THEN { Check IF HIMEM.SYS Loaded }π IF NOT XMSDriverLoaded THEN exit;π ASMπ mov ah,0Ahπ mov dx,Handleπ call XMSAddrπ or ax,axπ jnz @1π mov XMSErrorCode,bl { On Error, Set Error Code }π @1:π mov OK,axπ END;π XMSReleaseBlock := (OK <> 0);πEND;ππ{**************************************************************}π{ XMSMoveDataTo - Moves Block of Data from Conventional }π{ Memory to XMS Memory }π{ - Data Must have been previously allocated }π{ - Input - SourceAddr : address of data in }π{ conventional memory }π{ - NumBytes : number of bytes to move }π{ - XMSHandle : handle of XMS block }π{ - XMSOffset : 32 bit destination }π{ offset in XMS block }π{ - Returns true IF completed successfully }π{**************************************************************}πFUNCTION XMSMoveDataTo(SourceAddr: Pointer; NumBytes: LongInt;π XMSHandle: Word; XMSOffset: LongInt): Boolean;πVAR Status : Word;πBEGINπ XMSErrorCode := 0;π XMSMoveDataTo := false;π IF XMSAddr = nil THEN { Check IF HIMEM.SYS Loaded }π IF NOT XMSDriverLoaded THEN exit;π MoveParms.MoveLen := NumBytes;π MoveParms.SHandle := 0; { Source Handle=0 Forπ Conventional Memory}π MoveParms.SPtr := SourceAddr;π MoveParms.XMSHdl := XMSHandle;π MoveParms.XMSOffset := XMSOffset;π ASMπ mov ah,0Bhπ mov si,offset MoveParmsπ call XMSAddrπ mov Status,ax { Completion Status }π or ax,axπ jnz @1π mov XMSErrorCode,bl { Save Error Code }π @1:π END;π XMSMoveDataTo := (Status <> 0);πEND;ππ{**************************************************************}π{ XMSGetDataFrom - Moves Block From XMS to Conventional Memory }π{ - Data Must have been previously allocated }π{ and moved to XMS }π{ - Input - XMSHandle : handle of source }π{ XMS block }π{ - XMSOffset : 32 bit source offset }π{ in XMS block }π{ - NumBytes : number of bytes to move }π{ - LowMemAddr : destination addr in }π{ conventional memory }π{ - Returns true IF completed successfully }π{**************************************************************}πFUNCTION XMSGetDataFrom(XMSHandle: Word; XMSOffset: LongInt;π NumBytes: LongInt; LowMemAddr: Pointer): Boolean;πVAR Status : Word;πBEGINπ XMSErrorCode := 0;π XMSGetDataFrom := false;π IF XMSAddr = nil THEN { Check IF HIMEM.SYS Loaded }π IF NOT XMSDriverLoaded THEN exit;π MoveParms.MoveLen := NumBytes; { Set-Up Structure to Pass }π MoveParms.XMSh := XMSHandle;π MoveParms.XMSOfs := XMSOffset;π MoveParms.DHandle := 0; { Dest Handle=0 Forπ Conventional Memory}π MoveParms.DPtr := LowMemAddr;π ASMπ mov ah,0Bhπ mov si,offset MoveParmsπ call XMSAddrπ mov Status,ax { Completion Status }π or ax,axπ jnz @1π mov XMSErrorCode,bl { Set Error Code }π @1:π END;π XMSGetDataFrom := (Status <> 0);πEND;ππBEGINπ XMSAddr := nil; { Initialize XMSAddr }π XMSErrorCode := 0;πEND.ππ{ *********************************************************************** }π{ *********************************************************************** }π{ *********************************************************************** }π{ XMS DEMO PROGRAM }ππ{$X+}πProgram XMSTest;πUSES crt, XMS;πCONSTπ NumVars = 131072; { 131072 total no of variables in array }π BytesPerVar = 4; { ie. 2 for integers, 4 for LongInts ...}πVARπ I : LongInt;π Result : LongInt;π Hdl : Word; { Handle for Extended memory allocated }π HiMemOK : boolean;πBEGINπ ClrScr;π HiMemOK := XMSDriverLoaded;π WriteLn('HIMEM.SYS Driver Loaded=', HiMemOK);π IF NOT HiMemOK THEN Halt;π WriteLn('Total Extended Memory: ', XMSTotalMemoryAvailable, ' KB');π WriteLn('Largest Free Extended Memory Block: ',π XMSLargestBlockAvailable, ' KB');ππ {Allocate Memory - Hdl is memory block handle or identifier}π Hdl := XMSAllocateBlock((NumVars * BytesPerVar + 1023) DIV 1024);π {1023 to Round Up to next KB}π WriteLn((NumVars * BytesPerVar + 1023) DIV 1024,'KB Handle=',Hdl);π WriteLn('Total Extended Memory Available After Allocation: ',π XMSTotalMemoryAvailable, ' KB');ππ { Fill the variables with 1 ... NumVars for exercise }π WriteLn('Filling Memory Block ');π FOR I := 1 TO NumVars DOπ BEGINπ { parameters in Move Data are - Address of Data to Moveπ - Number of Bytesπ - Memory Handleπ - Offset in XMS Area }π IF NOT XMSMoveDataTo(@I, BytesPerVar, Hdl, (I - 1) *π BytesPerVar) THENπ WriteLn('Error on Move to XMS: ',I,' Error: ', XMSErrorCode);π IF I MOD 1024 = 0 THEN Write(I:6,^M);π END;π WriteLn;π { Now read a couple of locations just to show how}π I := 1; { First Element }π IF NOT XMSGetDataFrom(Hdl, (I - 1) * BytesPerVar,π BytesPerVar, @Result) THENπ WriteLn('Error on XMSGetDataFrom')π ELSE WriteLn('XMS Data [',I,']=',Result); { Print it }π I := NumVars; { Last Element }π IF NOT XMSGetDataFrom(Hdl, (I - 1) * BytesPerVar, BytesPerVar,π @Result) THENπ WriteLn('Error on XMSGetDataFrom')π ELSE WriteLn('XMS Data [',I,']=',Result); { Print it }ππ WriteLn('Release status=', XMSReleaseBlock(Hdl));π WriteLn('Press a key.');π ReadKey;πEND.π 31 11-02-9306:05ALL PETER BEFFTINK Nice XMS unit IMPORT 87 ä▒Üì {πPETER BEEFTINKππSee below an XMS Unit I picked up somewhere. I must admit that I have neverπbeen successful at using it, but maybe you have more luck.π}ππUnit MegaXMS;ππInterfaceππVarπ Present : Boolean; {True if XMM driver is installed}π XMSError : Byte; {Error number. if 0 -> no error}ππFunction XMMPresent : Boolean;πFunction XMSErrorString(Error : Byte) : String;πFunction XMSMemAvail : Word;πFunction XMSMaxAvail : Word;πFunction GetXMMVersion : Word;πFunction GetXMSVersion : Word;πProcedure MoveFromEMB(Handle : Word; Var Dest; BlockLength : LongInt);πProcedure MoveToEMB(Var Source; Handle : Word; BlockLength : LongInt);πFunction EMBGetMem(Size : Word) : Word;πProcedure EMBFreeMem(Handle : Word);πProcedure EMBResize(Handle, Size : Word);πFunction GetAvailEMBHandles : Byte;πFunction GetEMBLock(Handle : Word) : Byte;πFunction GetEMBSize(Handle : Word) : Word;πFunction LockEMB(Handle : Word) : LongInt;πProcedure UnlockEMB(Handle : Word);πFunction UMBGetMem(Size : Word; Var Segment : Word) : Word;πProcedure UMBFreeMem(Segment : Word);πFunction GetA20Status : Boolean;πProcedure DisableLocalA20;πProcedure EnableLocalA20;πProcedure DisableGlobalA20;πProcedure EnableGlobalA20;πProcedure HMAGetMem(Size : Word);πProcedure HMAFreeMem;πFunction GetHMA : Boolean;ππImplementationππUsesπ Dos;ππConstπ High = 1;π Low = 2;π NumberOfErrors = 27;ππ ErrorNumber : Array [1..NumberOfErrors] Of Byte =π ($80,$81,$82,$8E,$8F,$90,$91,$92,$93,$94,$A0,$A1,$A2,$A3,π $A4,$A5,$A6,$A7,$A8,$A9,$AA,$AB,$AC,$AD,$B0,$B1,$B2);ππ ErrorString : Array [0..NumberOfErrors] Of String = (π 'Unknown error',π 'Function no implemented',π 'VDISK device driver was detected',π 'A20 error occured',π 'General driver errror',π 'Unrecoverable driver error',π 'High memory area does not exist',π 'High memory area is already in use',π 'DX is less than the ninimum of KB that Program may use',π 'High memory area not allocated',π 'A20 line still enabled',π 'All extended memory is allocated',π 'Extended memory handles exhausted',π 'Invalid handle',π 'Invalid source handle',π 'Invalid source offset',π 'Invalid destination handle',π 'Invalid destination offset',π 'Invalid length',π 'Invalid overlap in move request',π 'Parity error detected',π 'Block is not locked',π 'Block is locked',π 'Lock count overflowed',π 'Lock failed',π 'Smaller UMB is available',π 'No UMBs are available',π 'Inavlid UMB segment number');ππTypeπ XMSParamBlock= Recordπ Length : LongInt;π SHandle : Word;π SOffset : Array [High..Low] Of Word;π DHandle : Word;π DOffset : Array [High..Low] Of Word;π end;ππVarπ XMSAddr : Array [High..Low] Of Word; {XMM driver address 1=Low,2=High}ππFunction XMMPresent: Boolean;πVarπ Regs : Registers;πbeginπ Regs.AX := $4300;π Intr($2F, Regs);π XMMPresent := Regs.AL = $80;πend;ππFunction XMSErrorString(Error : Byte) : String;πVarπ I, Index : Byte;πbeginπ Index := 0;π For I := 1 To NumberOfErrors Doπ if ErrorNumber[I] = Error Thenπ Index := I;π XMSErrorString := ErrorString[Index];πend;ππFunction XMSMemAvail : Word;πVarπ Memory : Word;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 8π Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ Jmp @@2π @@1:π Mov Memory, DXπ @@2:π end;π XMSMemAvail := Memory;πend;ππFunction XMSMaxAvail : Word;πVarπ Temp : Word;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 8π Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ Jmp @@2π @@1:π Mov Temp, AXπ @@2:π end;π XMSMaxAvail := Temp;πend;ππFunction EMBGetMem(Size : Word) : Word;πVarπ Temp : Word;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 9π Mov DX, Sizeπ Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ Jmp @@2π @@1:π Mov Temp, DXπ @@2:π end;π EMBGetMem := Temp;πend;ππProcedure EMBFreeMem(Handle : Word);πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 0Ahπ Mov DX, Handleπ Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ @@1:π end;πend;ππProcedure EMBResize(Handle, Size : Word);πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 0Fhπ Mov DX, Handleπ Mov BX, Sizeπ Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ @@1:π end;πend;ππProcedure MoveToEMB(Var Source; Handle : Word; BlockLength : LongInt);πVarπ ParamBlock : XMSParamBlock;π XSeg, PSeg,π POfs : Word;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π With ParamBlock Doπ beginπ Length := BlockLength;π SHandle := 0;π SOffset[High] := Ofs(Source);π SOffset[Low] := Seg(Source);π DHandle := Handle;π DOffset[High] := 0;π DOffset[Low] := 0;π end;π PSeg := Seg(ParamBlock);π POfs := Ofs(ParamBlock);π XSeg := Seg(XMSAddr);ππ Asmπ Push DSπ Mov AH, 0Bhπ Mov SI, POfsπ Mov BX, XSegπ Mov ES, BXπ Mov BX, PSegπ Mov DS, BXπ Call [ES:XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ @@1:π Pop DSπ end;πend;ππProcedure MoveFromEMB(Handle : Word; Var Dest; BlockLength : LongInt);πVarπ ParamBlock : XMSParamBlock;π XSeg, PSeg,π POfs : Word;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π With ParamBlock Doπ beginπ Length := BlockLength;π SHandle := Handle;π SOffset[High] := 0;π SOffset[Low] := 0;π DHandle := 0;π DOffset[High] := Ofs(Dest);π DOffset[Low] := Seg(Dest);π end;π PSeg := Seg(ParamBlock);π POfs := Ofs(ParamBlock);π XSeg := Seg(XMSAddr);ππ Asmπ Push DSπ Mov AH, 0Bhπ Mov SI, POfsπ Mov BX, XSeg;π Mov ES, BXπ Mov BX, PSegπ Mov DS, BXπ Call [ES:XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ @@1:π Pop DSπ end;πend;ππFunction GetXMSVersion : Word;πVarπ HighB, LowB : Byte;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 0π Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ Jmp @@2π @@1:π Mov HighB, AHπ Mov LowB, ALπ @@2:π end;π GetXMSVersion := (HighB * 100) + LowB;πend;ππFunction GetXMMVersion : Word;πVarπ HighB, LowB : Byte;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 0π Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ Jmp @@2π @@1:π Mov HighB, BHπ Mov LowB, BLπ @@2:π end;π GetXMMVersion := (HighB * 100) + LowB;πend;ππFunction GetHMA : Boolean;πVarπ Temp : Boolean;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Temp := False;π Asmπ Mov AH, 0π Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ Jmp @@2π @@1:π Cmp DX, 0π Je @@2π Mov Temp, 1π @@2:π end;π GetHMA := Temp;πend;ππProcedure HMAGetMem(Size : Word);πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 1π Mov DX, Sizeπ Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ @@1:π end;πend;ππProcedure HMAFreeMem;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 2π Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ @@1:π end;πend;ππProcedure EnableGlobalA20;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 3π Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ @@1:π end;πend;πππProcedure DisableGlobalA20;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 4π Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ @@1:π end;πend;ππProcedure EnableLocalA20;πbeginπ XMSError := 0;π if Not(Present) Then Exit;π Asmπ Mov AH, 5π Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ @@1:π end;πend;ππProcedure DisableLocalA20;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 6π Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ @@1:π end;πend;ππFunction GetA20Status : Boolean;πVarπ Temp : Boolean;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Temp := True;π Asmπ Mov AH, 6π Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ Or AX, AXπ Jne @@1π Or BL, BLπ Jne @@2π Mov Temp, 0π Jmp @@1π @@2:π Mov XMSError, BLπ @@1:π end;πend;ππFunction LockEMB(Handle : Word) : LongInt;πVarπ Temp1,π Temp2 : Word;π Temp : LongInt;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 0Chπ Mov DX, Handleπ Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ Jmp @@2π @@1:π Mov Temp1, DXπ Mov Temp2, BXπ @@2:π end;π Temp := Temp1;π LockEMB := (Temp Shl 4) + Temp2;πend;ππProcedure UnlockEMB(Handle : Word);πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 0Dhπ Mov DX, Handleπ Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ @@1:π end;πend;ππFunction GetEMBSize(Handle : Word) : Word;πVarπ Temp : Word;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 0Ehπ Mov DX, Handleπ Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ Jmp @@2π @@1:π Mov Temp, DXπ @@2:π end;π GetEMBSize := Temp;πend;ππFunction GetEMBLock(Handle : Word) : Byte;πVarπ Temp : Byte;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 0Ehπ Mov DX, Handleπ Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ Jmp @@2π @@1:π Mov Temp, BHπ @@2:π end;π GetEMBLock := Temp;πend;ππFunction GetAvailEMBHandles : Byte;πVarπ Temp : Byte;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 0Ehπ Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ Jmp @@2π @@1:π Mov Temp, BLπ @@2:π end;π GetAvailEMBHandles := Temp;πend;ππFunction UMBGetMem(Size : Word; Var Segment : Word) : Word; {Actual size}πVarπ Temp1, Temp2 : Word;πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 10hπ Mov DX, Sizeπ Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ Jmp @@2π @@1:π Mov Temp2, BXπ @@2:π Mov Temp1, DXπ end;π Segment := Temp2;π UMBGetMem := Temp1;πend;ππProcedure UMBFreeMem(Segment : Word);πbeginπ XMSError := 0;π if Not(Present) Thenπ Exit;π Asmπ Mov AH, 10hπ Mov DX, Segmentπ Call [XMSAddr]π Or AX, AXπ Jne @@1π Mov XMSError, BLπ @@1:π end;πend;ππVarπ Regs : Registers;πbeginπ if Not(XMMPresent) Thenπ beginπ WriteLn('XMS not supported!');π Present := False;π Exit;π end;π Present := True;π With Regs Doπ beginπ AX := $4310;π Intr($2F, Regs);π XMSAddr[High] := BX;π XMSAddr[Low] := ES;π end;πend.π 32 11-02-9307:36ALL WILLIAM CONROY Another XMS Unit IMPORT 126 ä▒¼( {πJD3GTRCW.TRANSCOM@transcom.safb.af.mil (CONROY WILLIAM F)ππI have seen numerous requests for XMS routines. Here are some I haveπwritten for a programming effort I headed.πFeel free to use in any way fit.π}ππ{$O+,F+}πUNIT XMSUnit;π{ Programmer: Major William F. Conroy III }π{ Last Mod: 3/12/93 }π{ Touched: File date set to coorespond to baseline date }π{ for Computer Aided Aircrew Scheduling System }π{ }π{ This unit is written to give access to the XMS memory Specification for }π{ the IBM PC. Do not alter this unit without an excellent understanding }π{ of the PC internal architecture, the Extended Memory Specification(XMS) }π{ and the Borland Inline Assembler. For a much more in depth discussion }π{ of the XMS memory standard and how to implement it on a PC classπ computer }π{ Refer to "Extending Dos" by Ray Duncan, Published by Addison Wesley }ππINTERFACEππTYPEπ PHandlePtrArray = ^THandlePtrArray;π THandlePtrArray = ARRAY [1..10]OF WORD;π { This type definition is used by the graphics system as a way }π { to dynamically allocate space to hold the handles required to }π { access the extended memory. }ππ PXMSParamBlock = ^TXMSParamBlock;π TXMSParamBlock = RECORDπ LengthOfBlock : LONGINT; { Size of block to move }π SourceEMBHandle : WORD;π { 0 if source is in conventional memory, }π { handle returned by AllocateEMB otherwise }π SourceOffset : LONGINT;π { if SourceEMBHandle= 0 SourceOffset contains }π { a far pointer in Intel standard format else }π { SourceOffset indicates offset from the base }π { of the block. }π DestEMBHandle : WORD;π { 0 if source is in conventional memory, }π { handle returned by AllocateEMB otherwise }π DestOffset : LONGINT;π { if DestEMBHandle= 0 DestOffset contains }π { a far pointer in Intel standard format else }π { DestOffset indicates offset from the base }π { of the block. }π END;π { This type definition is used by the XMM memory manager for }π { block memory moves. As required by the xms specification. }ππVARπ XMSExists : BOOLEAN;ππ { Function AllocateEMB allocates an Extended Memory Block in Extended }π { memory. It requests the block via the Extended Memory Manager(XMM) }π { It returns True if it was successful False otherwise. If true, if }π { EMB_Handle will contain the Extended Memory Block Handle. If }π {returning false, the errorcode is in the ErrorCode parameter. }πFUNCTION AllocateEMB(VAR EMB_Handle, ParRequested, ErrorCode : WORD) : BOOLEAN;ππ { Function FreeEMB releases an Extended Memory Block in Extended Memory }π { allocated by the AllocateEMB function call. It requests the XMM }π { remove the block. It returns True if it was successful False }π { otherwise. If true, if block was released correctly. If returning }π { false, the errorcode is in the ErrorCode parameter. }πFUNCTION FreeEMB(VAR EMB_Handle, ErrorCode : WORD) : BOOLEAN;ππ { Function MoveEMB allows memory tranfers between conventional and XMS }π { Memory. This function requires a filled in TXMSParamBlock record. }π { It returns True if it was successful False otherwise. If true, the }π { memory block was successfully moved. If returning false, the }π { errorcode is in the ErrorCode parameter. }πFUNCTION MoveEMB(PParamBlock : PXMSParamBlock; VAR ErrorCode : WORD) : BOOLEAN;ππππIMPLEMENTATIONππVARπ XMMAddress : POINTER;π XMS_Version : WORD;π XMM_DriverVersion : WORD;π HMA_Exists : BOOLEAN;π LastErrorCode : WORD;πππ{---------------------------------------------------------------------------}π{ }π{ Local Procedure }π{ function XMSPresent }π{ }π{ This function return true if there is an Extended memory manager present }π{ in the system capable of supporting our XMS requests. It uses a DOS }π{ multiplexing interrupt request to determine if the driver signiture is }π{ present in the system. This is the Microsoft recomended method of }π{ determining the presence of this driver. }π{ }π{---------------------------------------------------------------------------}ππFUNCTION XMSPresent : BOOLEAN; ASSEMBLER;ππASMπ MOV AX, 4300h { MultiPlexing interrupt request number }π INT 2fh { Dos Multiplexing Interrupt }π CMP AL, 80h { was the signature byte returned in AL }π JZ @1 { yes?, jump to @1 }π MOV AX, 00h { set false for return }π JMP @2 { unconditional jump to end of function }π @1:π MOV AX, 01h { set True for return then fall thru to }π { exit. }π @2:πEND;ππ{------------------------------------------------------------------------- --}π{ }π{ Local Procedure }π{ function ReturnDriverAddress }π{ }π{ This function return true if it could determine the device driver entry }π{ point. This information is required to call any XMS functions. It uses }π{ a DOS multiplexing interrupt request to get this address. This is the }π{ Microsoft recomended method of getting the base address of this driver. }π{ This address is required to setup an indirect call to the driver by the }π{ XMS functions. }π{ }π{---------------------------------------------------------------------------}πFUNCTION ReturnDriverAddress : POINTER; ASSEMBLER;π { This function returns the address for the XMM memory manager }π { This value is required to later call the driver for XMS calls }ππASMπ MOV AX, 4310h { MultiPlexing interrupt request number }π INT 2fh { Dos Multiplexing Interrupt }π { Set Registers up for Return of Pointer }π MOV AX, BX { Set Offset Value }π MOV DX, ES { Set Segment Value }πEND;ππ{-------------------------------------------------------------------------}π{ }π{ Local Procedure }π{ function GetXMSVersion }π{ }π{-------------------------------------------------------------------------}πFUNCTION GetXMSVersion(VAR XMS_Version, XMM_DriverVersion : WORD;π VAR HMA_Exists : BOOLEAN;π VAR ErrorCode : WORD) : BOOLEAN; ASSEMBLER;ππ { This function loads the version numbers into the unit global }π { variables. The information is coded in binary Coded Decimal. }ππASMπ XOR AX, AX { set ax to zero }π CALL XMMAddress { indirect call to XMM driver }π CMP AX, 00h { error set ? }π JZ @1 { Jump error finish }ππ LES DI, XMS_Version { Load XMS_Version Address into es:di }π MOV ES:[DI],AX { Load variable indirect }ππ LES DI, XMM_DriverVersion { Load XMM_DriverVrsn Address in es:di }π MOV ES:[DI],BX { Load variable Indirect }ππ LES DI, HMA_Exists { Load HMA_Exists Address in es:di }π MOV ES:[DI],DX { Load variable Indirect }ππ LES DI,ErrorCode { Load ErrorCode Address into es:di }π MOV WORD PTR ES:[DI],00h { Clear Error Code }π MOV AX, 01h { set function return to true }π JMP @2 { Jump to finish }ππ @1:π LES DI, ErrorCode { Load error code address in es:di }π MOV WORD PTR ES:[DI],00h { copy 0 into ErrorCode }π @2:πEND;ππ{-------------------------------------------------------------------------}π{ }π{ Exported Procedure }π{ function AllocateEMB }π{ }π{ }π{ Function AllocateEMB allocates an Extended Memory Block in Extended }π{ memory. It requests the block via the Extended Memory Manager(XMM) }π{ It returns True if it was successful False otherwise. If true, if }π{ EMB_Handle will contain the Extended Memory Block Handle. If }π{ returning false, the errorcode is in the ErrorCode parameter. }π{ }π{-------------------------------------------------------------------------}πFUNCTION AllocateEMB(VAR EMB_Handle, ParRequested,π ErrorCode : WORD) : BOOLEAN; ASSEMBLER;ππASMπ MOV AH, 09h { set ax for Allocate EMB call }π LES DI, ParRequested { load ParRequested address in es:di }π MOV DX, ES:[DI] { copy parRequested value in DX }π CALL XMMAddress { indirect call to XMM driver }π CMP AX, 00h { error set ? }π JZ @1 { Jump error finish }π LES DI, EMB_Handle { load EMB_Handle in es:di }π MOV ES:[DI],DX { copy DX into EMB_Handle }π MOV AX, 01h { Return True }π LES DI, ErrorCode { Load error code address in es:di }π MOV WORD PTR ES:[DI],00h { copy 0 into ErrorCode }π JMP @2 { unconditional jump to finish }π { Error Finish }π @1:π LES DI, ErrorCode { load ErrorCode in es:di }π MOV BYTE PTR ES:[DI],BL { copy BL into ErrorCode }π @2:πEND;ππ{-------------------------------------------------------------------------}π{ }π{ Exported Procedure }π{ function FreeEMB }π{ }π{ Function FreeEMB releases an Extended Memory Block in Extended Memory }π{ allocated by the AllocateEMB function call. It requests the XMM }π{ remove the block. It returns True if it was successful False }π{ otherwise. If true, if block was released correctly. If returning }π{ false, the errorcode is in the ErrorCode parameter. }π{ }π{-------------------------------------------------------------------------}πFUNCTION FreeEMB(VAR EMB_Handle, ErrorCode : WORD) : BOOLEAN; ASSEMBLER;ππASMπ XOR AX, AX { clear AX to zero }π MOV AH, 0Ah { set ax for Free EMB call }π LES DI, EMB_Handle { load EMB_Handle address in es:di }π MOV DX, ES:[DI] { load EMB_Handle value in DX }π CALL XMMAddress { indirect call to XMM driver }π CMP AX, 00h { error set ? }π JZ @1 { Jump error finish }π MOV AX, 01H { Set True }π LES DI, ErrorCode { Load error code address in es:di }π MOV WORD PTR ES:[DI],00h { copy 0 into ErrorCode }π JMP @2 { unconditional jump to finish }π { Error Finish }π @1:π LES DI, ErrorCode { load ErrorCode in es:di }π MOV BYTE PTR ES:[DI],BL { copy BL into ErrorCode }π @2:πEND;ππ{-------------------------------------------------------------------------}π{ }π{ Exported Procedure }π{ function MoveEMB }π{ }π{ Function MoveEMB allows memory tranfers between conventional and XMS }π{ Memory. This function requires a filled in TXMSParamBlock record. }π{ It returns True if it was successful False otherwise. If true, the }π{ memory block was successfully moved. If returning false, the }π{ errorcode is in the ErrorCode parameter. }π{ }π{-------------------------------------------------------------------------}πFUNCTION MoveEMB(PParamBlock : PXMSParamBlock;π VAR ErrorCode : WORD) : BOOLEAN; ASSEMBLER;ππASMπ MOV AX, DS { move DS to AX register }π MOV ES, AX { move AX to ES register }π MOV AH, 0Bh { set ax for Move EMB call }π PUSH DS { push DS to Stack }π LDS SI, PParamBlock { load PParamBlock Address to ds:si }π MOV DI, OFFSET XMMAddress { move XMMAddress offset to di }π CALL DWORD PTR ES:[DI] { indirect call to XMMdriver via es:di }π POP DS { save TP's data segment }π CMP AX, 00h { error set ? }π JZ @1 { Jump error finish }π MOV AX, 01H { Set True }π LES DI, ErrorCode { Load error code address in es:di }π MOV WORD PTR ES:[DI],00h { copy 0 into ErrorCode }π JMP @2 { unconditional jump to finish }π { Error Finish }π @1:π LES DI, ErrorCode { load ErrorCode in es:di }π MOV WORD PTR ES:[DI],AX { Clear ErrorCode prior to load }π MOV BYTE PTR ES:[DI],BL { copy BL into ErrorCode }π MOV AX, 01h { Return False }π @2:πEND;ππBEGINπ XMSExists := XMSPresent;π IF XMSExists THENπ BEGINπ XMMAddress := ReturnDriverAddress;π GetXMSVersion(XMS_Version, XMM_DriverVersion, HMA_Exists, LastErrorCode);π END;πEND.π 33 11-02-9310:26ALL MARK OUELLET Get ALL the Memory IMPORT 9 ä▒═ {πMARK OUELLETππCompile for Protected Mode in BP 7.x}ππ{$A+,B-,D+,E+,F-,G+,I+,L+,N-,P-,Q-,R-,S+,T-,V+,X+,Y+}π{$M 16384,0}ππtypeπ MyElement = longint;ππconstπ Chunk = 65520 div sizeof(MyElement);π ChunkCnt = 10;π Limit : longint = Chunk * ChunkCnt - 1;ππtypeπ HeapArrPtr = ^HeapArr;π HeapArr = array [0..(Chunk - 1)] of MyElement;π BigHeapArr = array [0..(ChunkCnt - 1)] of HeapArrPtr;ππvarπ MyHeap : BigHeapArr;π Index : longint;ππbeginπ for Index := 0 to ChunkCnt-1 doπ new(MyHeap[Index]);π for Index := 0 to Limit doπ MyHeap[Index div Chunk]^[Index mod Chunk] := Index;π for Index := 0 to Limit doπ writeln(Index:10,MyHeap[Index div Chunk]^[Index mod Chunk]:10);π for Index := 0 to ChunkCnt-1 doπ dispose(MyHeap[Index]);πend.ππ{πI just tested it and it stored 163,800 Longintegers on the heap. Theπnice thing is you could make this into an Object with SET and GETπmethods and treat it as a 163800 element array.π}π 34 11-02-9318:38ALL CYRUS PATEL EMS Unit IMPORT 109 ä▒╩¡ {πFrom: CYRUS PATELπSubj: EMS for BPπ}ππprogram Ems_Test;π{ *************************************************************π* This program shows you how to use the basic functions of *π* the LIM Expanded Memory Specification. Since it does not *π* use any of the LIM EMS 4.0 function calls, you can also *π* use it on systems with EMS versions less than 4.0 *π************************************************************* }ππ{ Written by:πPeter Immarco.πThought DynamicsπManhattan Beach, CAπCompuserve ID# 73770,123π*** Public Domain ***ππUsed by permission of the author.π}ππ{ This program does the following:π+------------------------------------------------------------+π| * Makes sure the LIM Expanded Memory Manager (EMM) has |π| been installed in memory |π| * Displays the version number of the EMM present in memory |π| * Determines if there are enough pages (16k blocks) of |π| memory for our test program's usage. It then displays |π| the total number of EMS pages present in the system, |π| and how many are available for our usage |π| * Requests the desired number of pages from the EMM |π| * Maps a logical page onto one of the physical pages given |π| to us |π| * Displays the base address of our EMS memory page frame |π| * Performs a simple read/write test on the EMS memory given|π| to us |π| * Returns the EMS memory given to us back to the EMM, and |π| exits |π+------------------------------------------------------------|}πππ{ All the calls are structured to return the result or errorπcode of the Expanded Memory function performed as an integer.πIf the error code is not zero, which means the call failed,πa simple error procedure is called and the program terminates.}ππuses Crt, Dos;ππTypeπST3 = string[3];πST80 = string[80];πST5 = string[5];ππConstπEMM_INT = $67;πDOS_Int = $21;πGET_PAGE_FRAME = $41;πGET_UNALLOCATED_PAGE_COUNT= $42;πALLOCATE_PAGES = $43;πMAP_PAGES = $44;πDEALLOCATE_PAGES = $45;πGET_VERSION = $46;ππSTATUS_OK = 0;ππ{ We'll say we need 1 EMS page for our application }πAPPLICATION_PAGE_COUNT = 1;ππVarπRegs: Registers;πEmm_Handle,πPage_Frame_Base_Address,πPages_Needed,πPhysical_Page,πLogical_Page,πOffset,πError_Code,πPages_EMS_Available,πTotal_EMS_Pages,πAvailable_EMS_Pages: Word;πVersion_Number,πPages_Number_String: ST3;πVerify: Boolean;ππ{ * --------------------------------------------------------- * }π{ The function Hex_String converts an Word into a fourπcharacter hexadecimal number(string) with leading zeroes. }πFunction Hex_String(Number: Word): ST5;πFunction Hex_Char(Number: Word): Char;πBeginπIf Number<10 thenπHex_Char:=Char(Number+48)πelseπHex_Char:=Char(Number+55);πend; { Function Hex_Char }ππVarπS: ST5;πBeginπS:='';πS:=Hex_Char( (Number shr 1) div 2048);πNumber:=( ((Number shr 1) mod 2048) shl 1)+π(Number and 1) ;πS:=S+Hex_Char(Number div 256);πNumber:=Number mod 256;πS:=S+Hex_Char(Number div 16);πNumber:=Number mod 16;πS:=S+Hex_Char(Number);πHex_String:=S+'h';πend; { Function Hex_String }ππ{ * --------------------------------------------------------- * }ππ{ The function Emm_Installed checks to see if the ExpandedπMemory Manager (EMM) is loaded in memory. It does this byπlooking for the string 'EMMXXXX0', which should be locatedπat 10 bytes from the beginning of the code segment pointedπto by the EMM interrupt, 67h }πFunction Emm_Installed: Boolean;πVarπEmm_Device_Name : string[8];πInt_67_Device_Name : string[8];πPosition : Word;πRegs : registers;ππBeginπInt_67_Device_Name:='';πEmm_Device_Name :='EMMXXXX0';πwith Regs doπBeginπ{ Get the code segment pointed to by Interrupt 67h, the EMMπinterrupt by using DOS call $35, 'get interrupt vector' }πAH:=$35;πAL:=EMM_INT;πIntr(DOS_int,Regs);ππ{ The ES pseudo-register contains the segment address pointedπto by Interrupt 67h }π{ Create an 8 character string from the 8 successive bytesπpointed to by ES:$0A (10 bytes from ES) }πFor Position:=0 to 7 doπInt_67_Device_Name:=πInt_67_Device_Name+Chr(mem[ES:Position+$0A]);πEmm_Installed:=True;π{ Is it the EMM manager signature, 'EMMXXXX0'? then EMM isπinstalled and ready for use, if not, then the EMM managerπis not present }πIf Int_67_Device_Name<>Emm_Device_Nameπthen Emm_Installed:=False;πend; { with Regs do }πend; { Function Emm_Installed }ππ{ * --------------------------------------------------------- * }ππ{ This function returns the total number of EMS pages presentπin the system, and the number of EMS pages that areπavailable for our use }πFunction EMS_Pages_Availableπ(Var Total_EMS_Pages,Pages_Available: Word): Word;πVarπRegs: Registers;πBeginπwith Regs doπBeginπ{ Put the desired EMS function number in the AH pseudo-πregister }πAH:=Get_Unallocated_Page_Count;πintr(EMM_INT,Regs);π{ The number of EMS pages available is returned in BX }πPages_Available:=BX;π{ The total number of pages present in the system isπreturned in DX }πTotal_EMS_Pages:=DX;π{ Return the error code }πEMS_Pages_Available:=AHπend;πend; { EMS_Pages_Available }ππ{ * --------------------------------------------------------- * }ππ{ This function requests the desired number of pages from theπEMM }πFunction Allocate_Expanded_Memory_Pagesπ(Pages_Needed: Word; Var Handle: Word ): Word;πVarπRegs: Registers;πBeginπwith Regs doπBeginπ{ Put the desired EMS function number in the AH pseudo-πregister }πAH:= Allocate_Pages;π{ Put the desired number of pages in BX }πBX:=Pages_Needed;πintr(EMM_INT,Regs);π{ Our EMS handle is returned in DX }πHandle:=DX;π{ Return the error code }πAllocate_Expanded_Memory_Pages:=AH;πend;πend; { Function Allocate_Expanded_Memory_Pages }ππ{ * --------------------------------------------------------- * }ππ{ This function maps a logical page onto one of the physicalπpages made available to us by theπAllocate_Expanded_Memory_Pages function }πFunction Map_Expanded_Memory_Pagesπ(Handle,Logical_Page,Physical_Page: Word): Word;πVarπRegs: Registers;πBeginπwith Regs doπBeginπ{ Put the desired EMS function number in the AH pseudo-πregister }πAH:=Map_Pages;π{ Put the physical page number to be mapped into AL }πAL:=Physical_Page;π{ Put the logical page number to be mapped in BX }πBX:=Logical_Page;π{ Put the EMS handle assigned to us earlier in DX }πDX:=Handle;πIntr(EMM_INT,Regs);π{ Return the error code }πMap_Expanded_Memory_Pages:=AH;πend; { with Regs do }πend; { Function Map_Expanded_Memory_Pages }ππ{ * --------------------------------------------------------- * }ππ{ This function gets the physical address of the EMS pageπframe we are using. The address returned is the segmentπof the page frame. }πFunction Get_Page_Frame_Base_Addressπ(Var Page_Frame_Address: Word): Word;πVarπRegs: Registers;πBeginπwith Regs doπBeginπ{ Put the desired EMS function number in the AH pseudo-πregister }πAH:=Get_Page_Frame;πintr(EMM_INT,Regs);π{ The page frame base address is returned in BX }πPage_Frame_Address:=BX;π{ Return the error code }πGet_Page_Frame_Base_Address:=AH;πend; { Regs }πend; { Function Get_Page_Frame_Base_Address }ππ{ * --------------------------------------------------------- * }ππ{ This function releases the EMS memory pages allocated toπus, back to the EMS memory pool. }πFunction Deallocate_Expanded_Memory_Pagesπ(Handle: Word): Word;πVarπRegs: Registers;πBeginπwith Regs doπBeginπ{ Put the desired EMS function number in the AH pseudo-register }πAH:=DEALLOCATE_PAGES;π{ Put the EMS handle assigned to our EMS memory pages in DX }πDX:=Emm_Handle;πIntr(EMM_INT,Regs);π{ Return the error code }πDeallocate_Expanded_Memory_Pages:=AH;πend; { with Regs do }πend; { Function Deallocate_Expanded_Memory_Pages }ππ{ * --------------------------------------------------------- * }ππ{ This function returns the version number of the EMM asπa 3 character string. }πFunction Get_Version_Number(Var Version_String: ST3): Word;πVarπRegs: Registers;πWord_Part,Fractional_Part: Char;ππBeginπwith Regs doπBeginπ{ Put the desired EMS function number in the AH pseudo-register }πAH:=GET_VERSION;πIntr(EMM_INT,Regs);π{ See if call was successful }πIf AH=STATUS_OK thenπBeginπ{ The upper four bits of AH are the Word portion of theπversion number, the lower four bits are the fractionalπportion. Convert the Word value to ASCII by adding 48. }πWord_Part := Char( AL shr 4 + 48);πFractional_Part:= Char( AL and $F +48);πVersion_String:= Word_Part+'.'+Fractional_Part;πend; { If AH=STATUS_OK }π{ Return the function calls error code }πGet_Version_Number:=AH;πend; { with Regs do }πend; { Function Get_Version_Number }ππ{ * --------------------------------------------------------- * }ππ{ This procedure prints an error message passed by the caller,πprints the error code passed by the caller in hex, and thenπterminates the program with the an error level of 1 }ππProcedure Error(Error_Message: ST80; Error_Number: Word);πBeginπWriteln(Error_Message);πWriteln(' Error_Number = ',Hex_String(Error_Number) );πWriteln('EMS test program aborting.');πHalt(1);πend; { Procedure Error_Message }ππ{ * --------------------------------------------------------- * }ππ{ EMS_TEST }ππ{ This program is an example of the basic EMS functions that youπneed to execute in order to use EMS memory with Turbo Pascal }ππBeginπClrScr;πWindow(5,2,77,22);ππ{ Determine if the Expanded Memory Manager is installed, Ifπnot, then terminate 'main' with an ErrorLevel code of 1. }ππIf not (Emm_Installed) thenπBeginπWriteln('The LIM Expanded Memory Manager is not installed.');πHalt(1);πend;ππ{ Get the version number and display it }πError_Code:= Get_Version_Number(Version_Number);πIf Error_Code<>STATUS_OK thenπError('Error trying to get the EMS version number ',πError_code)πelseπWriteln('LIM Expanded Memory Manager, version ',πVersion_Number,' is ready for use.');πWriteln;ππ{ Determine if there are enough expanded memory pages for thisπapplication. }πPages_Needed:=APPLICATION_PAGE_COUNT;πError_Code:=πEMS_Pages_Available(Total_EMS_Pages,Available_EMS_Pages);πIf Error_Code<>STATUS_OK thenπError('Error trying to determine the number of EMS pages available.',πError_code);ππWriteln('There are a total of ',Total_EMS_Pages,π' expanded memory pages present in this system.');πWriteln(' ',Available_EMS_Pages,π' of those pages are available for your usage.');πWriteln;ππ{ If there is an insufficient number of pages for our application,πthen report the error and terminate the EMS test program }πIf Pages_Needed>Available_EMS_Pages thenπBeginπStr(Pages_Needed,Pages_Number_String);πError('We need '+Pages_Number_String+π' EMS pages. There are not that many available.',πError_Code);πend; { Pages_Needed>Available_EMS_Pages }ππ{ Allocate expanded memory pages for our usage }πError_Code:= Allocate_Expanded_Memory_Pages(Pages_Needed,Emm_Handle);πStr(Pages_Needed,Pages_Number_String);πIf Error_Code<>STATUS_OK thenπError('EMS test program failed trying to allocate '+Pages_Number_String+π' pages for usage.',Error_Code);πWriteln(APPLICATION_PAGE_COUNT,π' EMS page(s) allocated for the EMS test program.');πWriteln;ππ{ Map in the required logical pages to the physical pagesπgiven to us, in this case just one page }πLogical_Page :=0;πPhysical_Page:=0;πError_Code:=πMap_Expanded_Memory_Pages(πEmm_Handle,Logical_Page,Physical_Page);πIf Error_Code<>STATUS_OK thenπError('EMS test program failed trying to map '+π'logical pages onto physical pages.',Error_Code);ππWriteln('Logical Page ',Logical_Page,π' successfully mapped onto Physical Page ',πPhysical_Page);πWriteln;ππ{ Get the expanded memory page frame address }πError_Code:= Get_Page_Frame_Base_Address(Page_Frame_Base_Address);πIf Error_Code<>STATUS_OK thenπError('EMS test program unable to get the base Page'+π' Frame Address.',Error_Code);πWriteln('The base address of the EMS page frame is - '+πHex_String(Page_Frame_Base_Address) );πWriteln;ππ{ Write a test pattern to expanded memory }πFor Offset:=0 to 16382 doπMem[Page_Frame_Base_Address:Offset]:=Offset mod 256;ππ{ Make sure that what is in EMS memory is what we just wrote }πWriteln('Testing EMS memory.');ππOffset:=1;πVerify:=True;πwhile (Offset<=16382) and (Verify=True) doπBeginπIf Mem[Page_Frame_Base_Address:Offset]<>Offset mod 256 thenπVerify:=False;πOffset:=Succ(Offset);πend; { while (Offset<=16382) and (Verify=True) }ππ{ If it isn't report the error }πIf not Verify thenπError('What was written to EMS memory was not found during '+π'memory verification test.',0);πWriteln('EMS memory test successful.');πWriteln;ππ{ Return the expanded memory pages given to us back to theπEMS memory pool before terminating our test program }πError_Code:=Deallocate_Expanded_Memory_Pages(Emm_Handle);πIf Error_Code<>STATUS_OK thenπError('EMS test program was unable to deallocate '+π'the EMS pages in use.',Error_Code);πWriteln(APPLICATION_PAGE_COUNT,π' page(s) deallocated.');πWriteln;πWriteln('EMS test program completed.');πend.π 35 11-21-9309:30ALL SWAG SUPPORT TEAM FILL Memory Routines IMPORT 21 ä▒W≤ UNIT Fill;π(**) INTERFACE (**)π PROCEDURE FillWord(VAR Dest; Count, What : Word);π PROCEDURE FillOthr(VAR Dest; Count : Word; What : Byte);π PROCEDURE FillPatt(VAR Dest, Patt; Count, Siz : Word);π PROCEDURE FillPattOthr(VAR Dest, Patt; Count,π Siz : Word);ππ(**) IMPLEMENTATION (**)π PROCEDURE FillWord(VAR Dest; Count, What : Word);π Assembler;π ASMπ LES DI, Dest {ES:DI points to destination}π MOV CX, Count {count in CX}π MOV AX, What {word to fill with in AX}π CLD {forward direction}π REP STOSW {perform the fill}π END;ππ PROCEDURE FillOthr(VAR Dest; Count : Word; What : Byte);π Assembler;π ASMπ LES DI, Dest {ES:DI points to destination}π MOV CX, Count {count in CX}π MOV AL, What {byte to fill with in AL}π CLD {forward direction}π @TheLoop:π STOSB {store one byte}π INC DI {skip one byte}π Loop @TheLoopπ END;ππ PROCEDURE FillPatt(VAR Dest, Patt; Count, Siz : Word);π Assembler;π ASMπ MOV CX, Sizπ JCXZ @Outπ XCHG CX, DX {size of pattern in DX}π MOV CX, Count {count in CX}π JCXZ @Outπ PUSH DSπ LES DI, Dest {ES:DI points to destination}π LDS SI, Patt {DS:SI points to pattern}π MOV BX, SI {save SI in BX}π CLD {forward direction}π @PatLoop:π PUSH CX {save count for outer loop}π MOV CX, DX {put inner count in CX}π MOV SI, BX {DS:SI points to source}π REP MOVSB {make one copy of pattern}π POP CX {restore count for outer loop}π LOOP @PatLoopπ POP DSπ @Out:π END;ππ PROCEDURE FillPattOthr(VAR Dest, Patt; Count,π Siz : Word); Assembler;π ASMπ MOV CX, Sizπ JCXZ @Outπ XCHG CX, DX {size of pattern in DX}π MOV CX, Count {count in CX}π JCXZ @Outπ PUSH DSπ LES DI, Dest {ES:DI points to destination}π LDS SI, Patt {DS:SI points to pattern}π MOV BX, SI {save SI in BX}π CLD {forward direction}π @PatLoop:π PUSH CX {save count for outer loop}π MOV CX, DX {put inner count in CX}π MOV SI, BX {DS:SI points to source}π @TheLoop:π LODSB {get a byte from pattern..}π STOSB {.. and store in destination}π INC DI {skip a byte}π LOOP @TheLoopπ POP CX {restore count for outer loop}π LOOP @PatLoopπ POP DSπ @Out:π END;ππEND. 36 01-27-9411:58ALL WIM VAN DER VEGT DOS Memory IMPORT 21 ä▒å {πHere a small piece of code to determine the DOS memory (thatπwould be available at the DOS prompt) from within a TP program. Itπdoesn't account for UMB and heap limited programs (the $M directive).πIt returns (almost) the value chkdsk and mem return for largestπavailable block of dos memory.π}ππFUNCTION Dosmem : LONGINT;ππ{----Returns Largest Free DOS memory as seen on the dos prompt by }π{ CHKDSK and MEM. }ππ{----Records from The Programmer's PC Sourcebook by Thom Hogan, 1st Edition}ππ{ Only relevant field commented. Tuned by be equal to DR-DOS's 6.0}π{ MEM command. Works only if programs allocates all memory available}π{ so no max heaplimits to enable TP's Exec.}ππTypeπ MCBrec = RECORDπ location : Char; {----'M' is normal block, 'Z' is last block }π ProcessID,π allocation : WORD; {----Number of 16 Bytes paragraphs allocated}π reserved : ARRAY[1..11] OF Byte;π END;ππ PSPrec = RECORDπ int20h,π EndofMem : WORD;π Reserved1 : BYTE;π Dosdispatcher : ARRAY[1..5] OF BYTE;π Int22h,π Int23h,π INT24h : POINTER;π ParentPSP : WORD;π HandleTable : ARRAY[1..20] OF BYTE;π EnvSeg : WORD; {----Segment of Environment}π Reserved2 : LONGINT;π HandleTableSize : WORD;π HandleTableAddr : POINTER;π Reserved3 : ARRAY[1..23] OF BYTE;π Int21 : WORD;π RetFar : BYTE;π Reserved4 : ARRAY[1..9] OF BYTE;π DefFCB1 : ARRAY[1..36] OF BYTE;π DefFCB2 : ARRAY[1..20] OF BYTE;π Cmdlength : BYTE;π Cmdline : ARRAY[1..127] OF BYTE;π END;ππVarπ pmcb : ^MCBrec;π emcb : ^MCBrec;π psp : ^PSPrec;π dmem : LONGINT;ππBeginπ psp:=PTR(PrefixSeg,0); {----PSP given by TP var }π pmcb:=Ptr(PrefixSeg-1,0); {----Programs MCB 1 paragraph before PSP}π emcb:=Ptr(psp^.envseg-1,0); {----Environment MCB 1 paragraph beforeπ envseg }π dosmem:=LONGINT(pmcb^.allocation+emcb^.allocation+1)*16;πEnd; {of DOSmem}ππBeginπ Writeln(Dosmem,' Bytes available.');πEnd.π 37 01-27-9411:59ALL LAWRENCE JOHNSTONE Driver Memory Size IMPORT 34 ä▒Éh {π│>anybody know how I can determine the size of the driver inπ│>memory?π│ I would assume they take the Drivers name and search through theπ│ Memory Control Blocks maintained by DOS and seeing if the driverπ│ owns any of them. But there might be an easier way.ππThere is. An undocumented DOS function (52h) gives you the "list ofπlists", which contains the first device driver in a linked list, whichπyou can then traverse. (See Schulman's _Undocumented DOS_.)ππTake the address of the device driver header, and look at the 0 offsetπin the "segment" which is 1 segment address unit before the beginningπof the device driver header. For example, if the device driver headerπis at $1234:$0000, look at address $1233:0. If the byte at thatπaddress is "M", "Z", or "D", we have either a valid memory controlπblock header ("M" or "Z"), or a "device driver subheader" ("D") whichπfollows the same format. In either case, the word at <segment>:0003πgives the number of 16-byte paragraphs used by that memory block;πmultiply by 16 to get the size in bytes. The following TP code shouldπillustrate this (*only* HexW is used from OPString; substitute yourπown or any PD/Shareware hex conversion routine if you don't have OPro):π}ππUSES DOS, OPString;πTYPEπ PMCBhdr = ^TMCBhdr;π TMCBhdr = RECORDπ Signature: CHAR; { 'M', 'Z', or one of the valid 'subblock' letters}π OwnerSeg: WORD; { Segment of "owner" of this block }π SizeParas: WORD; { Size of block, in 16-byte paragraphs }π Unused: ARRAY [1..3] OF CHAR;π Name: ARRAY [1..8] OF CHAR; {Name of owner program (DOS 4+)}π END;π PDevHdr = ^TDevHdr;π TDevHdr = RECORDπ NextDriver: POINTER; { Next driver in device chain }π Attr: WORD; { Driver attribute word }π Strategy: WORD; { Offset within this segment }π Interrupt: WORD; { of the driver strategy & }π { interrupt routines. }π Name: ARRAY [1..8] OF CHAR; { Device name for char devs; }π { for block devices, first byte is # of logical }π { devices associated with this driver, others }π { are unused. }π END;ππPROCEDURE DisplayDeviceHeader( DevHdr: PDevHdr );π VARπ MCBptr: ^TMCBhdr;π Size: LONGINT;π BEGINπ { The line to be displayed will look something like this: }π { ssss:oooo dev_name mem_size owner_name }π { The last two columns are displayed only under DOS 4+, and }π { only when the information is found -- may fail under 386^Max }π Write( HexW( Seg( DevHdr^ ) ), ':', HexW( Ofs( DevHdr^ ) ), ' ' );ππ { See if it's a character device. If it is, then it has a name }π { to display. }π IF (DevHdr^.Attr AND $8000) <> 0 THENπ Write( DevHdr^.Name:12, ' ' )π ELSE { Block device -- write # of logical drives }π Write( Ord( DevHdr^.Name[1] ):3, ' drive(s) ' );ππ { See if the DOS version supports the 'sub-MCBs' introduced for }π { device drivers in the first MCB in DOS version 4, and/or the }π { Name field in the MCB introduced in v4. }π IF Lo( DosVersion ) >= 4 THEN BEGINπ MCBptr := Ptr( Seg( DevHdr^ ) - 1, 0 );ππ { Check for MCB sig., and make sure the MCB "owns itself" }π IF (MCBptr^.Signature IN ['M', 'Z', 'D']) ANDπ (MCBptr^.OwnerSeg = Seg( DevHdr^ ) ) THEN BEGINπ Size := MCBptr^.SizeParas * 16;π Write( Size:6, MCBptr^.Name:9 );π END; { IF MCB signature }π END; { IF DosVersion }π WriteLn;π END; {DisplayDeviceHeader}ππVARπ Regs: REGISTERS; CurDevice: PDevHdr;πBEGIN { main program }π Regs.AH := $52;π MSDos( Regs );π IF Lo( DosVersion ) < 3 THEN { Get first device in list; }π CurDevice := Ptr( Regs.ES, Regs.BX+$17 ) { location varies by DOS }π ELSE { version. }π CurDevice := Ptr( Regs.ES, Regs.BX+$22 );π REPEATπ DisplayDeviceHeader( CurDevice );π CurDevice := CurDevice^.NextDriver;π UNTIL Ofs( CurDevice^ ) = $FFFF;πEND.π 38 01-27-9411:59ALL PETER IMMARCO EMS IMPORT 110 ä▒ÿp program Ems_Test;ππ{ *************************************************************π * This program shows you how to use the basic functions of *π * the LIM Expanded Memory Specification. Since it does not *π * use any of the LIM EMS 4.0 function calls, you can also *π * use it on systems with EMS versions less than 4.0 *π ************************************************************* }ππ{ Written by:π Peter Immarco.π Thought Dynamicsπ Manhattan Beach, CAπ Compuserve ID# 73770,123π *** Public Domain ***ππ Used by permission of the author.π}ππ{ This program does the following:π +------------------------------------------------------------+π | * Makes sure the LIM Expanded Memory Manager (EMM) has |π | been installed in memory |π | * Displays the version number of the EMM present in memory |π | * Determines if there are enough pages (16k blocks) of |π | memory for our test program's usage. It then displays |π | the total number of EMS pages present in the system, |π | and how many are available for our usage |π | * Requests the desired number of pages from the EMM |π | * Maps a logical page onto one of the physical pages given |π | to us |π | * Displays the base address of our EMS memory page frame |π | * Performs a simple read/write test on the EMS memory given|π | to us |π | * Returns the EMS memory given to us back to the EMM, and |π | exits |π +------------------------------------------------------------|}πππ{ All the calls are structured to return the result or errorπ code of the Expanded Memory function performed as an integer.π If the error code is not zero, which means the call failed,π a simple error procedure is called and the program terminates.}ππusesπ Crt, Dos;ππTypeπ ST3 = string[3];π ST80 = string[80];π ST5 = string[5];ππConstπ EMM_INT = $67;π DOS_Int = $21;π GET_PAGE_FRAME = $41;π GET_UNALLOCATED_PAGE_COUNT = $42;π ALLOCATE_PAGES = $43;π MAP_PAGES = $44;π DEALLOCATE_PAGES = $45;π GET_VERSION = $46;ππ STATUS_OK = 0;ππ { We'll say we need 1 EMS page for our application }π APPLICATION_PAGE_COUNT = 1;ππVarπ Regs : Registers;π Emm_Handle,π Page_Frame_Base_Address,π Pages_Needed,π Physical_Page,π Logical_Page,π Offset,π Error_Code,π Pages_EMS_Available,π Total_EMS_Pages,π Available_EMS_Pages : Word;π Version_Number,π Pages_Number_String : ST3;π Verify : Boolean;ππ{ The function Hex_String converts an Word into a fourπ character hexadecimal number(string) with leading zeroes. }πFunction Hex_String(Number : Word) : ST5;ππ Function Hex_Char(Number : Word) : Char;π Beginπ If Number < 10 thenπ Hex_Char := Char(Number + 48)π elseπ Hex_Char := Char(Number + 55);π end;ππVarπ S : ST5;πBeginπ S := '';π S := Hex_Char((Number shr 1) div 2048);π Number := (((Number shr 1) mod 2048) shl 1) + (Number and 1);π S := S + Hex_Char(Number div 256);π Number := Number mod 256;π S := S + Hex_Char(Number div 16);π Number := Number mod 16;π S := S + Hex_Char(Number);π Hex_String := S + 'h';πend;ππ{ The function Emm_Installed checks to see if the Expandedπ Memory Manager (EMM) is loaded in memory. It does this byπ looking for the string 'EMMXXXX0', which should be locatedπ at 10 bytes from the beginning of the code segment pointedπ to by the EMM interrupt, 67h }πFunction Emm_Installed : Boolean;πVarπ Emm_Device_Name : string[8];π Int_67_Device_Name : string[8];π Position : Word;π Regs : registers;πBeginπ Int_67_Device_Name := '';π Emm_Device_Name := 'EMMXXXX0';π with Regs doπ Beginπ { Get the code segment pointed to by Interrupt 67h, the EMMπ interrupt by using DOS call $35, 'get interrupt vector' }π AH := $35;π AL := EMM_INT;π Intr(DOS_int, Regs);ππ { The ES pseudo-register contains the segment address pointedπ to by Interrupt 67h }π { Create an 8 character string from the 8 successive bytesπ pointed to by ES:$0A (10 bytes from ES) }π For Position := 0 to 7 doπ Int_67_Device_Name := Int_67_Device_Name + Chr(mem[ES : Position + $0A]);π Emm_Installed := True;π { Is it the EMM manager signature, 'EMMXXXX0'? then EMM isπ installed and ready for use, if not, then the EMM managerπ is not present }π If Int_67_Device_Name <> Emm_Device_Name thenπ Emm_Installed := False;π end;πend;πππ{ This function returns the total number of EMS pages presentπ in the system, and the number of EMS pages that areπ available for our use }πFunction EMS_Pages_Available(Var Total_EMS_Pages,Pages_Available : Word) : Word;πVarπ Regs : Registers;πBeginπ with Regs doπ Beginπ { Put the desired EMS function number in the AH pseudo-π register }π AH := Get_Unallocated_Page_Count;π intr(EMM_INT, Regs);π { The number of EMS pages available is returned in BX }π Pages_Available := BX;π { The total number of pages present in the system isπ returned in DX }π Total_EMS_Pages := DX;π { Return the error code }π EMS_Pages_Available := AH;π end;πend;ππ{ This function requests the desired number of pages from the EMM }πFunction Allocate_Expanded_Memory_Pages(Pages_Needed : Word;π Var Handle : Word) : Word;πVarπ Regs : Registers;πBeginπ with Regs doπ Beginπ { Put the desired EMS function number in the AH pseudo-π register }π AH := Allocate_Pages;π { Put the desired number of pages in BX }π BX := Pages_Needed;π intr(EMM_INT, Regs);π { Our EMS handle is returned in DX }π Handle := DX;π { Return the error code }π Allocate_Expanded_Memory_Pages := AH;π end;πend;ππ{ This function maps a logical page onto one of the physicalπ pages made available to us by theπ Allocate_Expanded_Memory_Pages function }πFunction Map_Expanded_Memory_Pages(Handle, Logical_Page,π Physical_Page : Word) : Word;πVarπ Regs : Registers;πBeginπ with Regs doπ Beginπ { Put the desired EMS function number in the AH pseudo-π register }π AH := Map_Pages;π { Put the physical page number to be mapped into AL }π AL := Physical_Page;π { Put the logical page number to be mapped in BX }π BX := Logical_Page;π { Put the EMS handle assigned to us earlier in DX }π DX := Handle;π Intr(EMM_INT, Regs);π { Return the error code }π Map_Expanded_Memory_Pages := AH;π end;πend;ππ{ This function gets the physical address of the EMS pageπ frame we are using. The address returned is the segmentπ of the page frame. }πFunction Get_Page_Frame_Base_Address(Var Page_Frame_Address : Word) : Word;πVarπ Regs : Registers;πBeginπ with Regs doπ Beginπ { Put the desired EMS function number in the AH pseudo-π register }π AH := Get_Page_Frame;π intr(EMM_INT, Regs);π { The page frame base address is returned in BX }π Page_Frame_Address := BX;π { Return the error code }π Get_Page_Frame_Base_Address := AH;π end;πend;ππ{ This function releases the EMS memory pages allocated toπ us, back to the EMS memory pool. }πFunction Deallocate_Expanded_Memory_Pages(Handle : Word) : Word;πVarπ Regs : Registers;πBeginπ with Regs doπ Beginπ { Put the desired EMS function number in the AH pseudo-register }π AH := DEALLOCATE_PAGES;π { Put the EMS handle assigned to our EMS memory pages in DX }π DX := Emm_Handle;π Intr(EMM_INT, Regs);π { Return the error code }π Deallocate_Expanded_Memory_Pages := AH;π end;πend;ππ{ This function returns the version number of the EMM asπ a 3 character string. }πFunction Get_Version_Number(Var Version_String : ST3) : Word;πVarπ Regs : Registers;π Word_Part,π Fractional_Part : Char;πBeginπ with Regs doπ Beginπ { Put the desired EMS function number in the AH pseudo-register }π AH := GET_VERSION;π Intr(EMM_INT, Regs);π { See if call was successful }π If AH=STATUS_OK thenπ Beginπ { The upper four bits of AH are the Word portion of theπ version number, the lower four bits are the fractionalπ portion. Convert the Word value to ASCII by adding 48. }π Word_Part := Char(AL shr 4 + 48);π Fractional_Part := Char(AL and $F + 48);π Version_String := Word_Part + '.' + Fractional_Part;π end;π { Return the function calls error code }π Get_Version_Number := AH;π end;πend;ππ{ This procedure prints an error message passed by the caller,π prints the error code passed by the caller in hex, and thenπ terminates the program with the an error level of 1 }πProcedure Error(Error_Message : ST80; Error_Number : Word);πBeginπ Writeln(Error_Message);π Writeln(' Error_Number = ', Hex_String(Error_Number));π Writeln('EMS test program aborting.');π Halt(1);πend;ππ{ EMS_TEST }ππ{ This program is an example of the basic EMS functions that youπ need to execute in order to use EMS memory with Turbo Pascal }ππBeginπ ClrScr;π Window(5,2,77,22);ππ { Determine if the Expanded Memory Manager is installed, Ifπ not, then terminate 'main' with an ErrorLevel code of 1. }π If not (Emm_Installed) thenπ Beginπ Writeln('The LIM Expanded Memory Manager is not installed.');π Halt(1);π end;ππ { Get the version number and display it }π Error_Code := Get_Version_Number(Version_Number);π If Error_Code <> STATUS_OK thenπ Error('Error trying to get the EMS version number ', Error_code)π elseπ Writeln('LIM Expanded Memory Manager, version ',π Version_Number, ' is ready for use.');π Writeln;ππ { Determine if there are enough expanded memory pages for thisπ application. }π Pages_Needed := APPLICATION_PAGE_COUNT;π Error_Code := EMS_Pages_Available(Total_EMS_Pages,Available_EMS_Pages);π If Error_Code <> STATUS_OK thenπ Error('Error trying to determine the number of EMS pages available.', Error_code);ππ Writeln('There are a total of ',Total_EMS_Pages,π ' expanded memory pages present in this system.');π Writeln(' ', Available_EMS_Pages,π ' of those pages are available for your usage.');π Writeln;ππ { If there is an insufficient number of pages for our application,π then report the error and terminate the EMS test program }π If Pages_Needed>Available_EMS_Pages thenπ Beginπ Str(Pages_Needed,Pages_Number_String);π Error('We need '+Pages_Number_String+π ' EMS pages. There are not that many available.', Error_Code);π end;ππ { Allocate expanded memory pages for our usage }π Error_Code := Allocate_Expanded_Memory_Pages(Pages_Needed, Emm_Handle);π Str(Pages_Needed, Pages_Number_String);π If Error_Code<>STATUS_OK thenπ Error('EMS test program failed trying to allocate ' + Pages_Number_String +π ' pages for usage.', Error_Code);π Writeln(APPLICATION_PAGE_COUNT,π ' EMS page(s) allocated for the EMS test program.');π Writeln;ππ { Map in the required logical pages to the physical pagesπ given to us, in this case just one page }π Logical_Page := 0;π Physical_Page := 0;π Error_Code := Map_Expanded_Memory_Pages(Emm_Handle, Logical_Page, Physical_Page);π If Error_Code <> STATUS_OK thenπ Error('EMS test program failed trying to map '+π 'logical pages onto physical pages.', Error_Code);ππ Writeln('Logical Page ', Logical_Page,π ' successfully mapped onto Physical Page ', Physical_Page);π Writeln;ππ { Get the expanded memory page frame address }π Error_Code := Get_Page_Frame_Base_Address(Page_Frame_Base_Address);π If Error_Code <> STATUS_OK thenπ Error('EMS test program unable to get the base Page' +π ' Frame Address.',Error_Code);π Writeln('The base address of the EMS page frame is - ' +π Hex_String(Page_Frame_Base_Address));π Writeln;ππ { Write a test pattern to expanded memory }π For Offset := 0 to 16382 doπ Mem[Page_Frame_Base_Address:Offset] := Offset mod 256;ππ { Make sure that what is in EMS memory is what we just wrote }π Writeln('Testing EMS memory.');ππ Offset := 1;π Verify := True;π while (Offset <= 16382) and (Verify = True) doπ Beginπ If Mem[Page_Frame_Base_Address:Offset] <> Offset mod 256 thenπ Verify := False;π Offset := Succ(Offset);π end;ππ { If it isn't report the error }π If not Verify thenπ Error('What was written to EMS memory was not found during '+π 'memory verification test.',0);π Writeln('EMS memory test successful.');π Writeln;ππ { Return the expanded memory pages given to us back to theπ EMS memory pool before terminating our test program }π Error_Code := Deallocate_Expanded_Memory_Pages(Emm_Handle);π If Error_Code<>STATUS_OK thenπ Error('EMS test program was unable to deallocate '+π 'the EMS pages in use.',Error_Code);π Writeln(APPLICATION_PAGE_COUNT,π ' page(s) deallocated.');π Writeln;π Writeln('EMS test program completed.');πend.π 39 01-27-9412:08ALL DJ MURDOCH DPMI Memory in WinAPI IMPORT 29 ä▒4Ä {π> Protected mode has the WinAPI unit that lets you deal withπ> huge memory blocks and other stuff. That is what is needed.ππ> In real mode all you can do is:ππHere's some stuff from a huge memory block unit I'm working on. It isn't fullyπdebugged yet, but I think these parts work. However, use at your own risk.πThere are a few routines called which I don't include; you should be able toπfigure those ones out, or pull them out of a standard library. "LH" is aπrecord with fields L and H for pulling the low and high words out of a pointerπor longint.ππ { This part works in both real and protected mode. }ππ procedure IncPtr(var p:pointer;count:word);π { Increments pointer }π beginπ inc(LH(p).L,count);π if LH(p).L < count thenπ inc(LH(p).H,SelectorInc);π end;ππ procedure DecPtr(var p:pointer;count:word);π { decrements pointer }π beginπ if count > LH(p).L thenπ dec(LH(p).H,SelectorInc);π dec(LH(p).L,Count);π end;ππ procedure IncPtrLong(var p:pointer;count:longint);π { Increments pointer; assumes count > 0 }π beginπ inc(LH(p).H,SelectorInc*LH(count).H);π inc(LH(p).L,LH(Count).L);π if LH(p).L < LH(count).L thenπ inc(LH(p).H,SelectorInc);π end;ππ procedure DecPtrLong(var p:pointer;count:longint);π { Decrements pointer; assumes count > 0 }π beginπ if LH(count).L > LH(p).L thenπ dec(LH(p).H,SelectorInc);π dec(LH(p).L,LH(Count).L);π dec(LH(p).H,SelectorInc*LH(Count).H);π end;π { The next section is for real mode only }ππ{$ifndef dpmi}ππ typeπ PFreeRec = ^TFreeRec;π TFreeRec = recordπ next: PFreeRec;π size: Pointer;π end;ππ procedure GetMemHuge(var p:HugePtr;size:Longint);π constπ blocksize = $FFF0;π varπ prev,free : PFreeRec;π save,temp : pointer;π block : word;π beginπ { Handle the easy cases first }π if size > maxavail thenπ p := nilπ else if size < 65521 thenπ getmem(p,size)π elseπ beginπ {$ifndef ver60}π {$ifndef ver70}π The code below is extremely version specific to the TP 6/7 heap manager!!π {$endif}π {$endif}π { Find the block that has enough space }π prev := PFreeRec(@freeList);π free := prev^.next;π while (free <> heapptr) and (PtrToLong(free^.size) < size) doπ beginπ prev := free;π free := prev^.next;π end;ππ { Now free points to a region with enough space; make it the first one andπ multiple allocations will be contiguous. }ππ save := freelist;π freelist := free;π { In TP 6, this works; check against other heap managers }π while size > 0 doπ beginπ block := minlong(blocksize,size);π dec(size,block);π getmem(temp,block);π end;ππ { We've got what we want now; just sort things out and restore theπ free list to normal }ππ p := free;π if prev^.next <> freelist thenπ beginπ prev^.next := freelist;π freelist := save;π end;π end;π end;ππ procedure FreeMemHuge(var p:HugePtr;size : longint);π constπ blocksize = $FFF0;π varπ block : word;π beginπ while size > 0 doπ beginπ block := minlong(blocksize,size);π dec(size,block);π freemem(p,block);π IncPtr(p,block);π p := Normalized(p);π end;π end;ππ{ The next section is the protected mode part }ππ {$else}ππ Procedure GetMemHuge(var p : HugePtr; Size: LongInt);π beginπ if Size < 65521 thenπ GetMem(p,size)π elseπ p := GlobalAllocPtr(gmem_moveable,Size);π end;ππ Procedure FreeMemHuge(var p : HugePtr; Size: Longint);π varπ h : THandle;π beginπ if Size < 65521 thenπ Freemem(p,size)π elseπ h := GlobalFreePtr(p);π end;ππ 40 01-27-9412:11ALL SEAN PALMER Line Memory IMPORT 14 ä▒ƒ? {π-> All you need to access flat memory is to make sure you get two segmenπ-> up against each other when you allocate them. The Windows API hasπ-> GlobalAllocPtr for this type of huge memory allocation, but I'm not sπ-> you'd go about it in DOS (non-protected) mode except to compare the sπ-> after GetMem() and see if they are linear/sequential. (and hope V86 mπ-> handle translation to actual physical memory!)ππ> If that is the case then look up the ABSOLUTE clause in your Pascalπ> manual. It will tell you how to make a second variables address beπ> Absolutely relative to the firstone; no matter what. The address forπ> the second one will be based on the address for the original.ππCorrect. Absolutely at the same address as the other variable.ππAt this time, BP won't let you add or subtract offsets from the address youπgive to the Absolute clause. Unless possibly it's a constant address. In anyπcase, it's not ACCESSING memory linearly that is the problem, it's getting theπoperating system or runtime library to ALLOCATE it linearly.ππProtected mode has the WinAPI unit that lets you deal with huge memory blocksπand other stuff. That is what is needed.ππIn real mode all you can do is:π}ππvar p,p2,tmp:pointer;ππbegin {make sure 2 memory blocks are linear}π getmem(p,$C000); {48K}π getmem(p2,$C000); {96K total}π while (seg(p2^)-seg(p^))*$1000+(ofs(p2^)-ofs(p^))<>$C000 do beginπ freeMem(p2,$C000);π freeMem(p,$C000);π writeln('Not linear... trying again.');π getmem(tmp,1);π getmem(p,$C000);π getmem(p2,$C000);π end;π end;π 41 01-27-9412:14ALL TODD HOLMES Testing Memory IMPORT 13 ä▒N└ {π> I have a rather irritating problem with TP:π>π> When I set my memory requirements ($M compile-time directive) toπ> 16384, 0, 655360 [stack, heapmin and heapmax, respectively] I can'tπ> shell to DOS as there's no heap free for it [and you can't change theπ> mem requirements on the fly] to do so, however, when my informationπ> screen displays itself, it correctly shows MemAvail. [a longintπ> containing the amount of RAM free] As I decrease heapmax, the MemAvailπ> output also decreases, which is not good, especially since shelling andπ> running MEM /C directly contradicts it. If somebody can make sense ofπ> this mess, can you fix my problem? Thanks a bunch...ππHave you checked out the Memory Unit that comes with TP 7 (maybe 6). It hasπseveral procs that may help you out, notable SetMemTop() which allows youπto decrease your heap on the fly. I haven't actually played with thisπcommands yet, but it may be worth your while to check'em out.}ππ{$A-,B-,D+,E-,F-,G+,I+,L+,N-,O-,P-,Q-,R+,S+,T-,V+,X+,Y+}π{$M 16384,0,655360}ππ{$Tested with TP 7}ππProgram TestMem;ππUses Memory,Dos;ππType PStruct = ^TStruct;π TStruct = Recordπ Name: String;π Age : Byte;π end;ππVarπ PS: PStruct;πbeginπ New(PS);π SetMemTop(HeapPtr); {Without this, the shell fails}π SwapVectors;π Exec(GetEnv('Comspec'),'');π SwapVectors;π SetMemTop(HeapEnd); {Restore your heap}π Dispose(PS);πend.π 42 01-27-9412:21ALL SEAN PALMER Linear Memory 2 IMPORT 13 ä▒╗º {π> Does anyone know how to access memory linearly as to do away with theπ> Segment:Offset standard? I've seen it done in a program called VOC 386π> yet it doesn't switch to protected mode(at least I'm pretty sure...)ππ> I need to load digital samples >64k and have a means of addressing themπ> with having to worry about crossing segment boundries and conventionalπ> memory just won't suffice... Any help would be appreciated...ππYou just need to trick GetMem into allocating the memory sequentially, and asπlong as you're in v86 mode it should wrap your indexes on to the next chunk ofπmemory if you use 32-bit addressingπ}πgetMem(p1,32768);πgetMem(p2,32768);πgetMem(p3,32768);πif (seg(p2^)-seg(p1^)<>$800)or(seg(p3^)-seg(p2^)<>$800) then exit;π {not seqential! They must be sequential!!} ifπ(ofs(p1^)<>0)or(ofs(p2^)<>0)or(ofs(p3^)<>0) then exit;π {keep them at zero offset also} {all that is aπlittle drastic (exiting and such) but you must somehow make sure they're trulyπlinear, at least according to your virtual 8086 machine.}π{πNow you need 386 assembly which pascal's BASM can't handle, but I'll post someπhere anyway.π}πasmπ db $66; xor si,si {xor esi,esi}π push dsπ mov ds,word ptr p1+2π db $66; mov cx,32768; dw 1 {mov ecx,$18000}π db $67; rep lodsb {get bytes using extended 32-addressing (ds:esi)}π pop dsπ end;π{πalthough this doesn't actually do anything with the data, it does access it.π(or should, this hasn't been tested yet)π}ππ 43 01-27-9412:22ALL KENT BRIGGS Total Memory IMPORT 9 ä▒y≈ {π> How would you go about displaying themount of total memory ramπ> installed in a computer.π> i have tried Intr($15,regs);π> with regs doπ> AH := $88;π> Writeln(regs.(AX);π> I read the above in Peter Nortons Programmers Bible but i get someπ> number that I'm sure what to do which;π> i was wondering if some one could help thanksππ Russ, you have to load AH with $88 before the Int 15 call, notπ after. However, HIMEM hooks this interrupt anyway and only showsπ available extended memory, not installed memory. Try the followingπ program instead:π}πprogram show_ram;πconstπ int15: longint = $f000f859;πvarπ baseram,extram: word;πbeginπ asmπ int 12hπ mov baseram,axπ mov ah,88hπ pushfπ call int15π mov extram,axπ end;π writeln('Base RAM = ',baseram,' Kbytes');π writeln('Extended RAM = ',extram,' KBytes');πend.ππ{πThis works on 286 cpu's and above since 8088/8086's don't haveπextended memory.π}π 44 01-27-9412:22ALL PER-ERIC LARSSON Stack Use 2 IMPORT 5 ä▒N {π> Does anyone know if there is any way to check how much of the stack yourπ> program is using at any given moment? I have Turbo Debugger if that makesπ> a difference.π}ππFunction Stackpos : word; assembler;πasmπ mov ax,spπend;ππ{πThis should give You a indication on how the stack is used - otherwise lookπat SP in the registers - It should start of at the size you stated for theπprogram and shrink down to zero as your program crashes :-)π} 45 01-27-9412:23ALL BOB SWART Stack Swapping IMPORT 21 ä▒ÿô {π> Also, can you tell me what the opro procedure SwapStackAndCallNear()π> does? Does it save registers, swap SP and do a near call, or what?ππFrom the description DJ gave, I reconstructed it for you:π}ππprocedure SwapStackAndCallNear(Routine: Word;π SP: Pointer;π var Regs);π{π Flags are saved (unchanged during routine),π Stack is restored after completion,π Registers AX,BX,CX,DX,SI,DI and ES destroyed.π}πInLine(π $9C/ { PUSHF }π $07/ { pop ES ; ES := flags }π $58/ { pop AX ; AX := Regs ofs }π $5B/ { pop BX ; BX := Regs seg }π $59/ { pop CX ; CX := SP ofs }π $5A/ { pop DX ; DX := SP seg }π $5F/ { pop DI ; DI := near routine }π { @SwapStack }π $8C/$D6/ { mov SI,SS ; SI := SS = stack seg }π $FA/ { cli ; disable interrupts }π $8E/$D2/ { mov SS,DX ; SS := DX = SP seg }π $87/$CC/ { xchg SP,CX ; CX := SP = stack ofs }π { ; SP := SP = SP ofs }π $06/ { PUSH ES ; push ES (= flags) }π $9D/ { POPF ; set flags again }π $9C/ { PUSHF ; push flags }π $56/ { PUSH SI ; SI = old stackseg SS }π $51/ { PUSH CX ; CX = old stackofs SP }π { @CallNear: }π $53/ { PUSH BX ; BX = ofs Regs var }π $50/ { PUSH AX ; AX = seg Regs var }π $FF/$15/ { CALL WORD PTR [DI] ; near call }π { @SwapBackStack: }π $FA/ { CLI ; disable interrupts }π $59/ { pop CX ; CX := old stackofs SP}π $5E/ { pop SI ; SI := old stackseg SS}π $07/ { pop ES ; pop flags in ES }π $8E/$D6/ { mov SS,SI ; stack seg back in SS }π $89/$CC/ { mov SP,CX ; stack ofs back in SP }π { @Exit: }π $06/ { PUSH ES ; push values of flags }π $9D); { POPF ; pop unchanged flags }ππ{π> I would like to write my own code to do this because I don't haveπ> opro, and I'm not going to buy it for one procedure... :)πPlease test my InLine macro, and tell me if this works. Sometime soon I'llπtry to experiment with PAUSEDEV myself (if I can find it again, that is ;-)π}π 46 01-27-9413:31ALL GREG ESTABROOKS DPMI Routines IMPORT 30 ä▒t UNIT DPMI; { DPMI routines, Last Updated Aug 7/93 }π { Copyright (C) 1993, Greg Estabrooks }πINTERFACEπ{***********************************************************************}πVARπ DPMIControl :POINTER;π ParNeeded :WORD;ππFUNCTION DPMI_Installed :BOOLEAN;π { Routine to Determine whether a DPMI API is }π { installed. If it is installed it loads the }π { address of the API into DPMIControl for later }π { program use. Loads ParaNeeded with paragraphs }π { needed for Host data area. }ππFUNCTION DPMIControlAdr :POINTER;π { This routine returns a pointer to the DPMI }π { control. }ππFUNCTION DPMIVer :WORD;π { This routine returns the Version of the DPMI }ππFUNCTION Processor :BYTE;π { Routine to return processor type as returned }π { by the DPMI API. }ππ{***********************************************************************}πIMPLEMENTATIONππFUNCTION DPMI_Installed :BOOLEAN; ASSEMBLER;π { Routine to Determine whether a DPMI API is }π { installed. If it is installed it loads the }π { address of the API into DPMIControl for later }π { program use. Loads ParaNeeded with paragraphs }π { needed for Host data area. }πASMπ Mov AX,$1687 { Function to check for DPMI. }π Int $2F { Call Int 2Fh. }π Cmp AX,0 { Compare Result to 0. }π Je @Installed { If its equal jump to Installed. }π Mov AL,0 { Else return FALSE. }π Jmp @Exit { Jump to end of routine. }ππ@Installed:π Mov DPMIControl.WORD,DI { Load pointer ES:DI into DPMIControl. }π Mov DPMIControl+2.WORD,ESπ Mov ParNeeded,SI { Load Paragraphs needed into ParNeeded.}π Mov AL,1 { Set true flag. }ππ@Exit:πEND;{DPMI_Installed}ππFUNCTION DPMIControlAdr :POINTER; ASSEMBLER;π { This routine returns a pointer to the DPMI }π { control. }πASMπ Mov AX,$1687 { Function to return point to API. }π Int $2F { Call Int 2Fh. }π Mov DX,ES { Pointer info is returned in ES:DI. }π Mov AX,DIπEND;{DPMIControlAdr}ππFUNCTION DPMIVer :WORD; ASSEMBLER;π { This routine returns the Version of the DPMI }πASMπ Mov AX,$1687 { Function to get version of DPMI API. }π Int $2F { Call int 2Fh. }π Mov AX,DX { Version is returned in DX. }πEND;{DPMIVer}ππFUNCTION Processor :BYTE; ASSEMBLER;π { Routine to return processor type as returned }π { by the DPMI API. }πASMπ Mov AX,$1687 { Function to get info from DPMI. }π Int $2F { Call Int 2Fh. }π Mov AL,CL { Processor type returned in CL. }πEND;{Processor}ππBEGINπEND. 47 01-27-9413:34ALL GREG ESTABROOKS XMS Memory routines IMPORT 204 ä▒t' UNIT XMS; { XMS Routines, Last Updated Dec 11/93 }π { Copyright (C) 1993, Greg Estabrooks }π { NOTE: Requires TP 6.0+ To compile. }πINTERFACEπ{**********************************************************************}πTYPEπ _32Bit = LONGINT;π XMSMovStruct = RECORDπ Amount :_32Bit; { 32 bit number of bytes to move}π SourceHandle:WORD; { Handle of Source Block. }π SourceOffset:_32Bit; { 32 bit offset to source. }π DestHandle :WORD; { Handle of destination. }π DestOffset :_32Bit; { 32 bit offset to destination}π END;π { If SourceHandle is 0 then SourceOffset}π { Is Interpereted as a SEGMENT:OFFSET }π { into conventional memory. }π { The Same applies to DestHandle. }π{ Potential XMS Error Codes: }π{ BL=80h if the function is not implemented }π{ 81h if a VDISK device is detected }π{ 82h if an A20 error occurs }π{ 8Eh if a general driver error occurs }π{ 8Fh if an unrecoverable driver error occurs }π{ 90h if the HMA does not exist }π{ 91h if the HMA is already in use }π{ 92h if DX is less than the /HMAMIN= parameter }π{ 93h if the HMA is not allocated }π{ 94h if the A20 line is still enabled }π{ A0h if all extended memory is allocated }π{ A1h if all available extended memory handles are in use }π{ A2h if the handle is invalid }π{ A3h if the SourceHandle is invalid }π{ A4h if the SourceOffset is invalid }π{ A5h if the DestHandle is invalid }π{ A6h if the DestOffset is invalid }π{ A7h if the Length is invalid }π{ A8h if the move has an invalid overlap }π{ A9h if a parity error occurs }π{ AAh if the block is not locked }π{ ABh if the block is locked }π{ ACh if the block's lock count overflows }π{ ADh if the lock fails }π{ B0h if a smaller UMB is available }π{ B1h if no UMBs are available }π{ B2h if the UMB segment number is invalid }ππVARπ XMSControl :POINTER; { Holds the address of the XMS API. }π XMSError :BYTE; { Holds any XMS error codes. }ππFUNCTION XMSDriver :BOOLEAN;π { Routine to determine if an XMS driver is installed. }π { If it is installed it loads XMSControl with the }π { location of the XMS API for the other routines. }ππFUNCTION XMSControlAdr :POINTER;π { This Routine returns a pointer to the XMS Controller.}ππFUNCTION XMSVer :WORD;π { This routine returns the version of the XMS driver }π { that is currently installed. }ππFUNCTION XMSRev :WORD;π { Returns XMS Revision Number. Usually used with XMSVer.}ππFUNCTION XMSGetFreeMem :WORD;π { Routine to Determine how much total XMS memory is }π { free. }ππFUNCTION XMSGetLargeBlock :WORD;π { Routine to Determine the size of the largest free }π { XMS is block. }ππFUNCTION XMSGetMem( Blocks:WORD ) :WORD;π { Routine to allocate XMS for program use. }π { Blocks = k's being requested, XMSErr = ErrorCode.}π { Returns 16 bit handle to mem allocated. }ππPROCEDURE XMSFreeMem( Handle:WORD );π { Routine to free previously allocated XMS Memory. }πPROCEDURE XMSMoveblock( VAR Movstruct :XMSMovStruct );π { Routine to move memory blocks around in XMS memory.}ππPROCEDURE XMSLockBlock( Handle :WORD );π { Routine to lock and XMS block. Locked blocks }π { are guarnteed not to move. }π { Locked Blocks should be unlocked as soon as }π { possible. }ππPROCEDURE XMSUnLockBlock( Handle :WORD );π { Routine to unlock a previously lock XMS block.}ππPROCEDURE XMSReallocate( Handle ,NewSize :WORD );π { Routine to reallocate and XMS Block so that it}π { becomes equal to NewSize. }ππFUNCTION HMAExists :BOOLEAN;π { This routine returns Whether or not HMA Exists. }ππPROCEDURE HMARequest( RequestType :WORD );π { Attempt to reserve the 64k HMA area for the caller.}π { NOTE: RequestType must be either FFFF = Application}π { OR If caller is a TSR the RequestType = Amount of }π { Space wanted. }ππPROCEDURE HMARelease;π { Routine to release previously allocated HMA. }π { NOTE: Any Code/Data store in that HMA Memory }π { Will become invalid and inaccessible. }ππPROCEDURE GlobaleEnableA20;π { Routine to Enable the A20 Line. Should only be }π { used by programs that have control of the HMA. }π { NOTE: Remeber to disable the Line before }π { releaseing control of the system. }ππPROCEDURE GlobaleDisableA20;π { Routine to Disable the A20 Line. On some systems}π { the Toggling of the A20 Line can take a long }π { time. }ππPROCEDURE LocalEnableA20;π { Routine to Enable the A20 Line for current Program}π { NOTE: Rember to so a LocalDisableA20 before }π { releasing system control. }ππPROCEDURE LocalDisableA20;π { Routine to Locally Disable the A20 Line. }ππFUNCTION QueryA20 :BOOLEAN;π { Routine to test whether the A20 is Physically }π { enabled or not. }ππFUNCTION PtrToLong( P:POINTER ) :LONGINT;π { Routine to convert a pointer to a 32 bit number. }ππIMPLEMENTATIONπ{**********************************************************************}ππFUNCTION XMSDriver :BOOLEAN; ASSEMBLER;π { Routine to determine if an XMS driver is installed. }π { If it is installed it loads XMSControl with the }π { location of the XMS API for the other routines. }πASMπ Mov AX,$4300 { Function to check for Driver. }π Int $2F { Call Dos Int 2Fh. }π Cmp AL,$80 { Check Result, if its 80h driver. }π Je @Installed { If It is return TRUE. }π Mov AL,0 { Else Return FALSE. }π Jmp @Exitπ@Installed:π Mov AX,$4310 { Function to return pointer to Driver.}π Int $2F { Call Interrupt. }π Mov XMSControl.WORD,BX { Pointer info returned in ES:BX. }π Mov XMSControl+2.WORD,ESπ Mov AL,1 { Set True Flag. }π@Exit:πEND;{XMSDriver}ππFUNCTION XMSControlAdr :POINTER; ASSEMBLER;π { This Routine returns a pointer to the XMS Controller.}πASMπ Push ES { Push ES onto the stack. }π Push BX { Push BX onto the stack. }π Mov AX,$4310 { Function to return pointer to Driver.}π Int $2F { Call Interrupt. }π Mov DX,ES { Pointer info returned in ES:BX so }π Mov AX,BX { move it into DX:AX. }π Pop BX { Pop BX Off the Stack. }π Pop ES { Pop ES Off the Stack. }πEND;{XMSControlAdr}ππFUNCTION XMSVer :WORD; ASSEMBLER;π { This routine returns the version of the xms driver }π { that is currently installed.Version is returned as a }π { 16 bit BCD number. }πASMπ Mov AH,0 { Function to return XMS version. }π Call [XMSControl] { Call XMS Api. }π { Possible returns are : }π { AX = XMS version , BX = driver revision number }π { DX = 1 if HMA exists, 0 if not. }πEND;{XMSVer}ππFUNCTION XMSRev :WORD; ASSEMBLER;π { Returns XMS Revision Number. Usually used with XMSVer.}πASMπ Push BX { Save BX. }π Mov AH,0 { Function to return XMS revision. }π Call [XMSControl] { Call XMS Api. }π Mov AX,BX { Move result into proper register. }π Pop BX { Restore BX. }πEND;{XMSRev}ππFUNCTION XMSGetFreeMem :WORD; ASSEMBLER;π { Routine to Determine how much total XMS memory is }π { free. }πASMπ Push DX { Save DX and BX. }π Push BXπ Mov XMSError,0 { Clear error flag. }π Mov AH,$08 { Function to get free XMS mem }π Call [XMSControl] { Call XMS Api }π Mov XMSError,BL { Return any error code to user. }π Mov AX,DX { Load AX with Total Free k'S }π Pop BX { Restore BX and DX. }π Pop DXπ { DX = Total Free in k's }π { AX = Largest free block in k's }π { BL = Err Code. }πEND;{XMSGetFreeMem}ππFUNCTION XMSGetLargeBlock :WORD; ASSEMBLER;π { Routine to Determine the size of the largest free }π { XMS is block. }πASMπ Push BX { Save BX. }π Mov XMSError,0 { Clear error flag. }π Mov AH,$08 { Function to get free XMS mem }π Call [XMSControl] { Call XMS Api }π Mov XMSError,BL { Return any error code to user. }π Pop BX { Restore BX. }π { DX = Total Free in k's }π { AX = Largest free block in k's }πEND;{XMSGetLargeBlock}ππFUNCTION XMSGetMem( Blocks:WORD ) :WORD; ASSEMBLER;π { Routine to allocate XMS for programs use }π { Blocks = k's being requested, XMSErr = ErrorCode }π { Returns 16 bit handle to mem allocated }πASMπ Push DX { Save DX and BX. }π Push BXπ Mov XMSError,0 { Clear error flag. }π Mov AH,9 { Function Allocate Extended Memory }π Mov DX,Blocks { Load k Blocks to be allocated }π Call [XMSControl] { Call XMS API }π Mov XMSError,BL { Return any error code to user. }π Mov AX,DX { Load 16 Bit Handle to allocated Mem }π Pop BX { Restore BX and DX. }π Pop DXπ {NOTE: If there was an Error then the handle is invalid. }πEND;{XMSGetMem}ππPROCEDURE XMSFreeMem( Handle:WORD ); ASSEMBLER;π { Routine to free previously allocated XMS Memory }πASMπ Push DX { Save DX and BX. }π Push BXπ Mov XMSError,0 { Clear error flag. }π Mov AH,$0A { Function Free Allocated Memory }π Mov DX,Handle { Load Handle of Memory to free }π Call [XMSControl] { Call API }π Mov XMSError,BL { Return any error code to user. }π Pop BX { Restore BX and DX. }π Pop DXπEND;{XMSFreeMem}ππPROCEDURE XMSMoveblock( VAR Movstruct :XMSMovStruct ); ASSEMBLER;π { Routine to move memory blocks around in XMS memory. }π { Length must be even. }πASMπ Push DS { Save DS and SI }π Push SIπ Push BXπ Mov XMSError,0 { Clear error flag. }π LDS SI,MovStruct { Point DS:SI to move Structure }π Mov AH,$0B { Function to Move Extended memory block}π Call [XMSControl] { Call XMS API }π Mov XMSError,BL { Save any error code for user. }π Pop BXπ Pop SI { Restore DS and SI }π Pop DSπEND;{XMSMoveBlock}ππPROCEDURE XMSLockBlock( Handle :WORD ); ASSEMBLER;π { Routine to lock and XMS block. Locked blocks }π { are guarnteed not to move. }π { Locked Blocks should be unlocked as soon as }π { possible. }πASMπ Push DX { Save DX and BX. }π Push BXπ Mov XMSError,0 { Clear Error Flag. }π Mov AH,$0C { Function to lock XMS Block. }π Mov DX,Handle { Handle of block to lock. }π Call [XMSControl] { Call XMS Api. }π Mov XMSError,BL { Save any error codes. }π Pop BX { Restore BX and DX. }π Pop DXπEND;{XMSLockBlock}ππPROCEDURE XMSUnLockBlock( Handle :WORD ); ASSEMBLER;π { Routine to unlock a previously lock XMS block.}πASMπ Push DX { Save DX and BX. }π Push BXπ Mov XMSError,0 { Clear Error Flag. }π Mov AH,$0D { Function to unlock XMS Block. }π Mov DX,Handle { Handle of block to unlock. }π Call [XMSControl] { Call XMS Api. }π Mov XMSError,BL { Save any error codes. }π Pop BX { Restore BX and DX. }π Pop DXπEND;{XMSUnLockBlock}ππPROCEDURE XMSReallocate( Handle ,NewSize :WORD ); ASSEMBLER;π { Routine to reallocate and XMS Block so that it}π { becomes equal to NewSize. }πASMπ Push DX { Save DX and BX. }π Push BXπ Mov XMSError,0 { Clear Error Flag. }π Mov BX,NewSize { Load New size of XMS Block. }π Mov DX,Handle { Handle of an unlocked XMS Block. }π Mov AH,$0F { Function to Reallocate XMS Block. }π Mov DX,Handle { Handle of block to lock. }π Call [XMSControl] { Call XMS Api. }π Mov XMSError,BL { Save any error codes. }π Pop BX { Restore BX and DX. }π Pop DXπEND;{XMSReallocate}ππFUNCTION HMAExists :BOOLEAN; ASSEMBLER;π { This routine returns Whether or not HMA Exists }πASMπ Push DX { Save DX. }π Mov AH,0 { Function to return HMA Status }π Call [XMSControl] { Call XMS Api }π Mov AL,DL { Mov Status into proper register }π Pop DX { Restore DX. }π { Possible returns are : }π { AX = XMS version , BX = driver revision number }π { DX = 1 if HMA exists, 0 if not }πEND;{HMAExists}ππPROCEDURE HMARequest( RequestType :WORD ); ASSEMBLER;π { Attempt to reserve the 64k HMA area for the caller.}π { NOTE: RequestType must be either FFFF = Application}π { OR If caller is a TSR the RequestType = Amount of }π { Space wanted. }πASMπ Push DX { Save DX. }π Push BXπ Mov AH,1 { Function to request HMA. }π Mov XMSError,0 { Clear error flag. }π Mov DX,RequestType { Load whether area is for an App or TSR.}π Call [XMSControl] { Call XMS API }π Mov XMSError,BL { Return any error code to user. }π Pop Bxπ Pop DX { Restore DX. }πEND;{HMARequest}ππPROCEDURE HMARelease; ASSEMBLER;π { Routine to release previously allocated HMA. }π { NOTE: Any Code/Data store in that HMA Memory }π { Will become invalid and inaccessible. }πASMπ Push DX { Save DX. }π Mov AH,2 { Function to release HMA. }π Mov XMSError,0 { Clear error flag. }π Call [XMSControl] { Call XMS API }π Mov XMSError,BL { Return any error code to user. }π Pop DX { Restore DX. }πEND;{HMARelease}ππPROCEDURE GlobaleEnableA20; ASSEMBLER;π { Routine to Enable the A20 Line. Should only be }π { used by programs that have control of the HMA. }π { NOTE: Remeber to disable the Line before }π { releaseing control of the system. }πASMπ Push BX { Push BX onto the Stack. }π Mov XMSError,0 { Clear Error flag. }π Mov AH,3 { Function to Enable A20 line. }π Call [XMSControl] { Call XMS Api. }π Mov XMSError,BL { Save any errors. }π Pop BX { Pop BX Off the Stack. }πEND;{GlobalEnableA20}ππPROCEDURE GlobaleDisableA20; ASSEMBLER;π { Routine to Disable the A20 Line. On some systems}π { the Toggling of the A20 Line can take a long }π { time. }πASMπ Push BX { Push BX onto the Stack. }π Mov XMSError,0 { Clear Error flag. }π Mov AH,4 { Function to Disable A20 line. }π Call [XMSControl] { Call XMS Api. }π Mov XMSError,BL { Save any errors. }π Pop BX { Pop BX Off the Stack. }πEND;{GlobalDisableA20}ππPROCEDURE LocalEnableA20; ASSEMBLER;π { Routine to Enable the A20 Line for current Program}π { NOTE: Rember to so a LocalDisableA20 before }π { releasing system control. }πASMπ Push BX { Push BX onto the Stack. }π Mov XMSError,0 { Clear Error flag. }π Mov AH,5 { Function to Enable A20 line. }π Call [XMSControl] { Call XMS Api. }π Mov XMSError,BL { Save any errors. }π Pop BX { Pop BX Off the Stack. }πEND;{LocalEnableA20}ππPROCEDURE LocalDisableA20; ASSEMBLER;π { Routine to Locally Disable the A20 Line. }πASMπ Push BX { Push BX onto the Stack. }π Mov XMSError,0 { Clear Error flag. }π Mov AH,6 { Function to Disable A20 line. }π Call [XMSControl] { Call XMS Api. }π Mov XMSError,BL { Save any errors. }π Pop BX { Pop BX Off the Stack. }πEND;{LocalDisableA20}ππFUNCTION QueryA20 :BOOLEAN; ASSEMBLER;π { Routine to test whether the A20 is Physically }π { enabled or not. }πASMπ Push BX { Push BX onto the Stack. }π Mov XMSError,0 { Clear Error flag. }π Mov AH,7 { Function to test the A20 line. }π Call [XMSControl] { Call XMS Api. }π Mov XMSError,BL { Save any errors. }π Pop BX { Pop BX Off the Stack. }πEND;{QueryA20}ππFUNCTION PtrToLong( P:POINTER ) :LONGINT; ASSEMBLER;π { Routine to convert a pointer to a 32 bit number. }πASMπ Mov AX,P.WORD[0] { Load low WORD into AX. }π Mov DX,P.WORD[2] { Load high WORD into DX. }πEND;{PtrToLong}ππBEGINπEND.ππ{---------------------------- CUT HERE FOR DEMO -------------------}π{***********************************************************************}πPROGRAM XMSDemo1; { Demonstration of the XMS Unit. }π { Last Updated Dec 10/93, Greg Estabrooks. }πUSES CRT, { IMPORT Clrscr,Writeln. }π XMS; { IMPORT XMSDriver,XMSVer,XMSGetFreeMem, }π { XMSGetLargeBlock,XMSGetMem,XMSMove, }π { XMSError,XMSMovStruct,XMSFreeMem. }πVARπ XMSHandle :WORD; { Holds the handle of our XMS Area. }π MovInf :XMSMovStruct; { Move Structure for Moving XMS Blocks. }πBEGINπ Clrscr; { Clear away any screen clutter. }π IF XMSDriver THEN { If XMS Driver installed do demo. }π BEGINπ Write('XMS Driver Version '); { Show Version Installed. }π Writeln(HI(XMSVer),'.',LO(XMSVer),'.',XMSRev,' Installed');π Writeln('Total Free XMS Memory : ',XMSGetFreeMem,'k');π Writeln('Largest Free XMS Block: ',XMSGetLargeBlock,'k');π Writeln;ππ Writeln('Attempting to Allocate 16k of XMS');π XMSHandle := XMSGetMem(16); { Attempt to allocate 16k of XMS. }π Writeln('ErrorCode Returned : ',XMSError);π Writeln('Current free XMS Memory : ',XMSGetFreeMem);π Writeln;ππ Writeln('Saving Screen to XMS.');π WITH MovInf DOπ BEGINπ Amount := 4000; { Length of the Video Screen. }π SourceHandle := 0; { If SourceHandle is 0 then SourceOffset}π { Is Interpereted as a SEGMENT:OFFSET }π { into conventional memory. }π SourceOffset := PtrToLong(Ptr($B800,0));π DestHandle := XMSHandle;{ Destination is our XMS block. }π DestOffset := 0;π END;π XMSMoveBlock(MovInf);π Writeln('Press <ENTER> to continue.');π Readln;ππ Clrscr;π Writeln('Press <ENTER> to Restore Screen.');π Readln;ππ WITH MovInf DOπ BEGINπ Amount := 4000; { Length of the Video Screen. }π SourceHandle := XMSHandle;π SourceOffset := 0;π DestHandle := 0;π DestOffset := PtrToLong(Ptr($B800,0));;π END;π XMSMoveBlock(MovInf);π GotoXY(1,11);π XMSFreeMem(XMSHandle); { Free allocate XMS. }π Writeln('Ending Free XMS Memory : ',XMSGetFreeMem,'k');π ENDπ ELSEπ Writeln('XMS Driver not Installed!',^G);π Readln;πEND.{XMSDemo1}π{***********************************************************************} 48 01-27-9417:39ALL ROB ROSENBERGER PhotoRAM IMPORT 15 ä▒╠1 {$A+,B-,D+,E+,F-,I-,L+,N-,O-,R+,S+,V+}π{$M 2048,0,0}πPROGRAM PhotoRAM(INPUT,OUTPUT);ππ {Rob Rosenberger VOX: (618) 632-7345π Barn Owl Software BBS: (618) 398-5703π P.O. Box #74 HST: (618) 398-2305π O'Fallon, IL 62269 CIS: 74017,1344ππ This program simply snapshots memory to disk. It was developed so a userπfrom across the country could take a snapshot of his memory configuration andπpresent it for inspection.ππ You'll need to change the "TotalRAM" constant if you have a system withπless than 640k of memory.ππVersion 1.00: released to the public domain on 27 August 1989.π See above for the reason why this program was created.}πππCONSTπ TotalRAM = 640; {total memory, in kilobytes}ππVARπ Index : WORD;π PhotoFile : FILE;ππBEGIN {PhotoRAM}π{Initialize.}πIndex := 0;πππ{Check for question mark, it means they want the help screen.}πIF ((PARAMSTR(1) = '')π OR (PARAMSTR(1) = '?'))π THEN {display a help screen}π BEGINπ WRITELN(OUTPUT,^M^J'Syntax: PHOTORAM filename'^M^J);π WRITELN(OUTPUT,'A public domain program by Rob Rosenberger (who?)'^M^J);π WRITELN(OUTPUT,'Takes a "snapshot" of RAM and sends it to the filename');π WRITELN(OUTPUT,'you specify. You must have at least 640k of free disk');π WRITELN(OUTPUT,'space for the snapshot file.'^M^J);π HALT(0)π END;ππ{If we get this far, PARAMSTR(1) contains a filename.}π{Open the file.}πASSIGN(PhotoFile,PARAMSTR(1));πREWRITE(PhotoFile,1);ππFOR Index := 0 TO ((TotalRAM DIV $40) - $1)π DO BEGINπ BLOCKWRITE(PhotoFile,PTR(Index,$0000)^,$8000);π BLOCKWRITE(PhotoFile,PTR(Index,$8000)^,$8000)π END;ππCLOSE(PhotoFile)π{And that's all he wrote!}πEND. {PhotoRAM}π 49 02-03-9409:24ALL DJ MURDOCH Clear ALL Memory IMPORT 30 ä▒╕█ (*ππCLEARMEM - A Turbo Pascal unit to automatically initialize the heap, stack, orπdata segment to a fixed value.ππWritten by D.J. Murdoch for the public domain.ππInterface:ππ constπ filler : byte = 0;ππThis byte is used as the initial value. A good choice for turning upπuninitialized variables is $FF - this will often cause a range check, and willπcause runtime error 207 if you try to use an uninitialized single, double orπextended.ππ procedure clear_heap;ππThis procedure fills the heap with filler bytes. Automatically called in theπinitialization section.ππ procedure clear_globals;ππThis procedure fills all global variables (except those in the system unit) withπfiller bytes. Very dangerous! *Not* called in the initialization sectionπ(unless you change it). Written for TP 6.0; the source code gives hints on howπto change it for other versions.ππ procedure clear_stack;ππThis procedure fills the unused part of the stack with filler bytes.ππSAFETYππIt's safe to call clear_heap any time; it'll fill all free blocks of 6 bytes orπmore on the heap with the filler byte. It won't necessarily do a perfect fillπif the heap is fragmented, because the free list will overwrite the filler.ππIt's also safe to call clear_stack any time, but is a bit less effective. Anyπinterrupts that happen after your call will mess up the stack that you've justπcleared, so local variables won't necessarily be properly initialized. Itπdoesn't touch anything already allocated.ππIt's definitely *NOT* safe to call clear_globals any time except at the veryπbeginning of your program, and only then from the initialization section of thisπunit, and only if this is the very first unit that you Use in the main program.ππ*)ππ unit clearmem;ππ { Unit to clear all memory to a fixed value at the start of the program }π { Written by D.J. Murdoch for the public domain. }ππ interfaceππ constπ filler : byte = 0;ππ procedure clear_heap;ππ procedure clear_globals;ππ procedure clear_stack;ππ implementationππ typeπ block_rec_ptr = ^block_rec;π block_rec = recordπ next : block_rec_ptr;π size : word;π end;ππ procedure clear_heap;π varπ prev,π current : block_rec_ptr;π howmuch : word;π beginπ { First grab as much as possible and link it into a list }π prev := nil;π while maxavail >= sizeof(block_rec) doπ beginπ if maxavail < 65520 thenπ howmuch := maxavailπ elseπ howmuch := 65520;π getmem(current,howmuch);π current^.next := prev;π current^.size := howmuch;π prev := current;π end;ππ { Now fill all those blocks with filler }π while prev <> nil doπ beginπ current := prev;π prev := current^.next;π howmuch := current^.size;π fillchar(current^,howmuch,filler);π freemem(current,howmuch);π end;π end;ππ procedure clear_globals;π varπ where : pointer;π howmuch : word;π beginπ where := @test8087; { The last const in the system unit }π inc(word(where),sizeof(test8087)); { Just past that }π howmuch := ofs(input) { The first var in the system unit }π - ofs(where^);π fillchar(where^,howmuch,filler);π end;ππ procedure clear_stack;π varπ where : pointer;π howmuch : word;π beginπ where := ptr(sseg,stacklimit);π howmuch := sptr-stacklimit-14; { leave room for the fillchar parametersπ and return address }π fillchar(where^,howmuch,filler);π end;ππ beginπ clear_heap;π clear_stack;π { clear_globals; } { Uncomment this only if this unit is the first oneπ in the main program's Uses list!!! }π end.π 50 05-25-9408:11ALL HELGE HELGESEN TStream for XMS SWAG9405 61 ä▒ π{$A+,B-,D+,E-,F-,G+,I+,L+,N-,O+,P+,Q+,R+,S+,T-,V-,X+,Y+}π{.$DEFINE OPRO}π{π This unit adds an XMS-memory stream to TStream or IdStreamπ depending on the define above.π (c) 1994 Helge Olav Helgesenπ If you have any comments, please leave them in the Pascalπ conference on Rime or U'NI, or on InterNet to me atπ helge.helgesen@midnight.powertech.noπ}π{$IFNDEF MSDOS}π !! This unit must be compiled under real mode !!π{$ENDIF}πUnit Xms;ππinterfaceππusesπ{$IFDEF OPRO}π OpRoot,π{$ELSE}π Objects,π{$ENDIF}π OpDos, OpXms;ππtypeπ PXmsStream = ^TXmsStream; { pointer to TXmsStream }π TXmsStream = object({$IFDEF OPRO}IdStream{$ELSE}TStream{$ENDIF})π XmsSizeInK, { allocated size in kilobytes }π XmsHandle: word; { XMS Handle }π TotalSize, { total size in bytes }π CurOfs, { current offset into the stream }π UsedSize: longint; { size of used stream }ππ constructor Init(MemNeeded: word); { allocate ext. memory and init vars }π destructor Done; virtual; { deallocate ext. memory }ππ procedure Seek(WhereTo: longint); virtual; { seek within stream }π function GetPos: longint; virtual; { get curret offset }π function GetSize: longint; virtual; { get used size of stream }π procedure SetPos(Ofs: longint; Mode: byte); virtual; { seek using POS modeπ }ππ procedure Truncate; virtual; { truncate stream to current size }ππ procedure Write(var Buf; Count: Word); virtual; { writes Buf to the streamπ }π procedure Read(var Buf; Count: Word); virtual; { reads Buf from the streamπ }π end; { TXmsStream }ππ{$IFNDEF OPRO}πvarπ InitStatus: byte; { detailed error code from last Init or Done }π{$ENDIF}ππconstπ RealMemHandle = 0; { handle for Real Memory }π{$IFNDEF OPRO}π PosAbs = 0; {Relative to beginning}π PosCur = 1; {Relative to current position}π PosEnd = 2; {Relative to end}π{$ENDIF}ππ{$IFDEF OPRO}πprocedure SaveStream(const FileName: string; var S: IdStream);π { Saves a stream to disk, old file is erased! }πprocedure LoadStream(const FileName: string; var S: IdStream);π { Loads a stream from disk }π{$ELSE}πprocedure SaveStream(const FileName: string; var S: TStream);π { Saves a stream to disk, old file is erased! }πprocedure LoadStream(const FileName: string; var S: TStream);π { Loads a stream from disk }π{$ENDIF}ππimplementationππconstructor TXmsStream.Init;π { You should already have tested if XMS is installed! }πbeginπ if not inherited Init then Fail;π InitStatus:=AllocateExtMem(MemNeeded, XmsHandle);π if InitStatus>0 then Fail;π XmsSizeInK:=MemNeeded;π TotalSize:=LongInt(MemNeeded)*LongInt(1024);π UsedSize:=0;π CurOfs:=0;πend; { TXmsStream }ππdestructor TXmsStream.Done;πbeginπ FreeExtMem(XmsHandle);π inherited Done;πend; { TXmsStream.Done }ππprocedure TXmsStream.Seek;πbeginπ{$IFDEF OPRO}π if idStatus=0 thenπ{$ELSE}π if Status=stOk thenπ{$ENDIF}π CurOfs:=WhereTo;πend; { TXmsStream }ππfunction TXmsStream.GetPos;πbeginπ{$IFDEF OPRO}π if idStatus=0 thenπ{$ELSE}π if Status=stOk thenπ{$ENDIF}π GetPos:=CurOfs else GetPos:=-1;πend; { TXmsStream.GetPos }ππfunction TXmsStream.GetSize;πbeginπ{$IFDEF OPRO}π if idStatus=0 thenπ{$ELSE}π if Status=stOk thenπ{$ENDIF}π GetSize:=UsedSize else GetSize:=-1;πend; { TXmsStream.GetSize }ππprocedure TXmsStream.Truncate;πbeginπ{$IFDEF OPRO}π if idStatus=0 thenπ{$ELSE}π if Status=stOk thenπ{$ENDIF}π UsedSize:=CurOfs;πend; { TXmsStream.Truncate }ππprocedure TXmsStream.Write;πvarπ NumberisOdd: boolean;π x: word;π Source, Dest: ExtMemPtr;πbeginπ{$IFDEF OPRO}π if idStatus<>0 thenπ{$ELSE}π if Status<>stOk thenπ{$ENDIF}π Exit;π if LongInt(Count)+LongInt(CurOfs)>LongInt(TotalSize) thenπ beginπ{$IFDEF OPRO}π Error(101); { disk write error }π{$ELSE}π Error(stWriteError, 0);π{$ENDIF}π Exit;π end; { if }π NumberIsOdd:=Odd(Count);π if NumberIsOdd then Dec(Count);π Source.RealPtr:=@Buf;π Dest.ProtectedPtr:=CurOfs;π if Count>0 thenπ x:=MoveExtMemBlock(Count, RealMemHandle, Source, { source data }π XmsHandle, Dest) { dest data }π else x:=0;π if x>0 then { new error }π beginπ{$IFDEF OPRO}π Error(101); { disk write error }π{$ELSE}π Error(stWriteError, x);π{$ENDIF}π Exit;π end; { if }π Inc(CurOfs, Count); { adjust current offset }π if CurOfs>UsedSize then UsedSize:=CurOfs;π if not NumberisOdd then Exit;π asm { get last byte to transfer }π les di, Bufπ mov bx, Countπ mov ax, es:[di+bx]π inc Countπ mov x, axπ end; { asm }π Source.RealPtr:=@x;π Inc(Dest.ProtectedPtr, Count-1);π Count:=2;π x:=MoveExtMemBlock(Count, RealMemHandle, Source, { source data }π XmsHandle, Dest); { dest data }π if x>0 then { new error }π beginπ{$IFDEF OPRO}π Error(101); { disk write error }π{$ELSE}π Error(stWriteError, x);π{$ENDIF}π Exit;π end; { if }π Inc(CurOfs);π if CurOfs>UsedSize then UsedSize:=CurOfs;πend; { TXmsStream.Write }ππprocedure TXmsStream.Read;πvarπ NumberisOdd: boolean;π x: word;π Source, Dest: ExtMemPtr;πbeginπ{$IFDEF OPRO}π if idStatus<>0 thenπ{$ELSE}π if Status<>stOk thenπ{$ENDIF}π Exit;π if LongInt(CurOfs)+LongInt(Count)>LongInt(UsedSize) thenπ begin { read error }π{$IFDEF OPRO}π Error(100); { read error }π{$ELSE}π Error(stReadError, 0);π{$ENDIF}π Exit;π end; { if }π NumberisOdd:=Odd(Count);π if NumberisOdd then Inc(Count);π Source.ProtectedPtr:=CurOfs;π Dest.RealPtr:=@Buf;π x:=MoveExtMemBlock(Count, XmsHandle, Source, { source data }π RealMemHandle, Dest); { dest data }π if x>0 thenπ beginπ{$IFDEF OPRO}π Error(100); { read error }π{$ELSE}π Error(stReadError, x);π{$ENDIF}π Exit;π end; { if }π if NumberisOdd then Dec(Count);π Inc(CurOfs, Count);πend; { TXmsStream.Read }ππprocedure TXmsStream.SetPos;πbeginπ case Mode ofπ PosAbs: Seek(Ofs);π PosCur: Seek(LongInt(Ofs)+LongInt(CurOfs));π PosEnd: Seek(LongInt(UsedSize)-LongInt(Ofs));π end; { case }πend; { TXmsStream.SetPos }ππprocedure SaveStream;π{π Saves the stream to disk. No errorchecking is doneπ}πvarπ Buf: pointer;π x, BufSize: word;π f: file;π OldPos, l: longint;πbeginπ Assign(f, FileName);π Rewrite(f, 1);π if S.GetSize=0 thenπ beginπ Close(f);π Exit;π end; { if }π if MaxAvail>65520 then BufSize:=65520 else BufSize:=MaxAvail;π GetMem(Buf, BufSize);π OldPos:=S.GetPos;π l:=S.GetSize;π S.Seek(0);π while l<>0 doπ beginπ if l>BufSize then x:=BufSize else x:=l;π S.Read(Buf^, x);π{$IFDEF OPRO}π if S.PeekStatus<>0 thenπ{$ELSE}π if S.Status<>0 thenπ{$ENDIF}π beginπ Close(f);π Exit;π end; { if }π BlockWrite(f, Buf^, x);π Dec(l, x);π end; { while }π Close(f);π FreeMem(Buf, BufSize);π S.Seek(OldPos);πend; { SaveStream }ππprocedure LoadStream;π{π Loads the stream from disk. No errorchecking is done, you must allocateπ enough memory yourself! Any old contents of the stream is erased.π}πvarπ f: file;π BufSize, x: word;π l: longint;π Buf: pointer;πbeginπ if not ExistFile(FileName) then Exit;π Assign(f, FileName);π Reset(f, 1);π S.Seek(0);π S.Truncate;π l:=FileSize(f);π if l>0 thenπ beginπ if MaxAvail>65520 then BufSize:=65520 else BufSize:=MaxAvail;π GetMem(Buf, BufSize);π while l<>0 doπ beginπ BlockRead(f, Buf^, BufSize, x);π S.Write(Buf^, x);π{$IFDEF OPRO}π if S.PeekStatus<>0 thenπ{$ELSE}π if S.Status<>0 thenπ{$ENDIF}π beginπ Close(f);π Exit;π end; { if }π Dec(l, x);π end; { while }π FreeMem(Buf, BufSize);π end; { if }π Close(f);π S.Seek(0);πend; { LoadStream }ππend.π 51 05-25-9408:23ALL ERIK DE NEVE Stack usage report sourceSWAG9405 25 ä▒ {πThe program StackUse below measures your EXACT stack usageπ(REAL mode only). Make sure the constant Ssize is equal to theπactual physical stack size as defined with the $M directive orπin the Turbo Pascal IDE settings (the Options/MemorySizes menu).ππFor your own programs, you just need to call Initstack at the veryπstart, then call StackReport whenever you want - or calculate forπyourself, (Ssize-(VirginStack-StackLimit)) equals the number ofπstack bytes actually used.ππSptr gives you the current stack pointer, and StackLimit isπa TP system variable (WORD) that contains the current bottom ofπof the stack. StackLimit is usually zero, but some 'sneaky'πprograms raise it so they can hide something there - for example,πc1;0compiling your program using the replacement run-time librariesπby Norbert Juffa can raise the StackLimit to 512.πThe stack is filled from top to bottom, so a stack overflowπmeans Sptr <= StackLimit.πUseStack is just an example of a procedure that makes heavyπuse of the stack.ππThis code can be freely included in any FAQ,πSNIPPETS, SWAG or what-have-you.ππ Erik de Neveπ Internet: 100121.1070@compuserve.comππ Last update: March 8, 1994ππ{ -*- CUT HERE -*- }ππProgram StackUse;ππ{$M 16384,0,0 }ππCONSTπ Ssize = 16384; {should match stack size as set by the $M directive }ππProcedure Initstack; { fills unused stack with marker value }π Assembler;π ASMπ PUSH SS { SS = the stack segment }π POP ESπ MOV DI,StackLimitπ MOV CX,SP { SP = stack pointer register }π SUB CX,DIπ MOV AL,77 { arbitrary marker value }π CLDπ REP STOSBπ END;ππFunction VirginStack:word; { finds highest unused byte on stack }π Assembler;π ASMπ PUSH SSπ POP ESπ MOV DI,StackLimit { is usually 0 }π MOV CX,SPπ SUB CX,DIπ MOV AL,77 { marker value, must be the same as in InitStack }π CLDπ REPE SCASB { scan empty stack }π DEC DI { adjust for last non-matching byte in the scan }π MOV AX,DIπ END;πππProcedure StackReport; { Reports all sizes in bytes and percentages }πbeginπ WriteLn('Stack Bottom : ',StackLimit:6);π WriteLn('Current SP : ',Sptr:6);π WriteLn('Total Stack : ',Ssize:6,π ' bytes = 100.00 %');π WriteLn(' Now used : ',Ssize-(Sptr-StackLimit):6,π ' bytes = ',(Ssize-(Sptr-StackLimit))/Ssize *100:6:2,' %');π WriteLn(' Ever used : ',Ssize-(VirginStack-StackLimit):6,π ' bytes = ',(Ssize-(VirginStack-StackLimit))/Ssize *100:6:2,' %');π WriteLn('Never used : ',(VirginStack-StackLimit):6,π ' bytes = ',(VirginStack-StackLimit)/Ssize *100:6:2,' %');πend;πππProcedure UseStack(CNT:WORD); Assembler; { example stack usage }π ASMπ MOV AX,0 {dummy value}π MOV CX,CNTπ@pushit: {perform CNT PUSHes}π PUSH AXπ LOOP @pushitπ MOV CX,CNTπ@poppit: {perform CNT POPs}π POP AXπ LOOP @poppitπ END;πππBEGINπ InitStack; { prepare stack }π UseStack(1000); { perform a number of PUSHes and POPs }π StackReport; { report stack usage }πEND.π 52 05-26-9406:14ALL JENS LARSSON Moving Memory 2 Memory IMPORT 4 ä▒ {This copies NumBytes from SourceOfs to DestOfs:}ππProcedure MoveGfxMem(NumBytes, SourceOfs, DestOfs : Word); Assembler;π Asmπ push dsπ mov ax,0a000hπ mov ds,axπ mov es,axπ mov si,SourceOfsπ mov di,DestOfsπ mov cx,NumBytesπ cldπ rep movsbπ pop dsπ End;ππ 53 05-26-9411:04ALL RICHARD SADOWSKY Compare areas of Memory IMPORT 16 ä▒ {$R-,S-,V-}π{π**π** CompMem - A routine to compare to areas of memory for equalityπ** by Richard S. Sadowsky [74017,1670]π** version 1.0 5/11/88π** released to the public domainπ** requires file MEMCOMP.OBJ to recompileπ**ππ}πunit MemComp;ππinterfaceππfunction CompMem(var Block1,Block2; Size : Word) : Word;π{ returns 0 if Block1 and Block2 are equal for Size bytes, otherwise }π{ returns position of first non matching byte }ππimplementationππfunction CompMem(var Block1,Block2; Size : Word) : Word; External;π{$L memcomp.Obj}ππend.ππ{ --------------------- XX3402 CODE --------------------- }π{ cut this out and save as MEMCOMP.XX execute :π{ XX3402 D MEMCOMP.XX to create MEMCOMP.OBJ }ππππ*XX3402-000108-110588--72--85-20839-----MEMCOMP.OBJ--1-OF--1πU+o+0qpZPKBjPL+iEJBBOtM5+++2Eox2FIGM-k+c7++0+E2FY+s+++25EoxBI2p3HE+++2m6π-+++cU5Fc0U++E++WxmAqXD+BchD-CAHBgJr0XP2TkPwwuNo-XO9FkEfkMvOmUc+9sc0++-oπ***** END OF BLOCK 1 *****ππ{ ------------- TEST PROGRAM --------------------- }ππ{$R-,S-}πprogram CompTest;πuses MemComp;ππtypeπ Tipe = array[1..128] of byte;ππvarπ Var1,Var2 : Tipe;π I,CompRes : Word;ππbeginπ FillChar(var2,SizeOf(Tipe),0); { init Var2 to all zeros }π for I := 1 to 128 do { set var1 = 1 2 3 4 5 ... 128 }π Var1[I] := I;π CompRes := CompMem(Var1,Var2,128); { compare, should return first }π { byte as non match }π WriteLn('While not equal, CompMem = ',CompRes); { show results }π Var2 := Var1; { make them equal }π CompRes := CompMem(Var1,Var2,128); { test again, should return 0 }π WriteLn('While equal, CompMem = ',CompRes);π Var2[128] := 0; { make all equal except last byte }π CompRes := CompMem(Var1,Var2,128); { test again, should return 128 }π WriteLn('While not equal, CompMem = ',CompRes);πend.π
