Roll Your Own DOS Extender: Part II

Al covers debugging and 80386 exceptions and takes you under his DOS extender's hood.


November 01, 1990
URL:http://www.drdobbs.com/tools/roll-your-own-dos-extender-part-ii/184408444

NOV90: ROLL YOUR OWN DOS EXTENDER: PART II

Under the hood

Al is a systems engineer on the space station Freedom project for Jackson and Associates. Look for an expanded version of PROT in his book DOS: A Developer's Guide, which will be available from M&T Books early in 1991. Al can be reached at 310 Ivy Glen Ct., League City, TX 77573, or via Compu-Serve at 72010,3574.


Last month, I discussed 80x86 protected mode in general and presented the basics of PROT, the DOS extender described in this two-part article. In this installment, I'll examine both 80386 debugging and exceptions, then take you under the DOS extender's hood. Listings One through Three were covered in Part I. In this installment, I cover Listings Four through Seven: STACKS.INC (Listing Four, page 122) contains the stack segments; INT386.INC (Listing Five, page 122) is for 386 interrupt handling; TSS.INC (Listing Six, page 126) contains the task state segment definitions; and CODE16.INC ( Listing Seven, page 126) is the 16-bit DOS entry/exit code.

Because most programs don't work right the first few hundred times you try them, PROT contains full debugging support. Of course, the 386 has many hardware debugging features built-in. Except for the single-step capability, these features are all available with PROT. In addition, EQUMAC.INC (see Listing Three in last month's installment) contains macros to set normal, conditional, and counter breakpoints. When a breakpoint or unexpected interrupt occurs, PROT will display a register and stack dump. You can also instruct PROT to dump a memory region along with the register dump.

Figure 3 shows the screen PROT displays when an unexpected interrupt occurs. This interrupt may be a break-point (INT 3) or an 80386 exception (refer to Table 4). Most likely, it will be INT ODH, the dreaded general-protection interrupt.

Figure 3: PROT interrupt/breakpoint display

  ES=0040           DS=0090       FS=0010       GS=0038
  EDI=00000000      ESI=00000000  EBP=00000000  ESP=00000FF0 EBX=00000000
  EDX=00000000      ECX=00000000  EAX=00000000  INT=03 TR=0070
  Stack Dump:
  0000002B 00000088 00000202

Table 4: 80386/80486 exceptions

  NAME            INT #    Type   Error Code      Possible causes
---------------------------------------------------------------------------

  Divide error    0        FAULT  No              DIV or IDIV
  Debug           1        N/A    No              Debug condition
  Breakpoint      3        TRAP   No              INT 3
  Overflow        4        TRAP   No              INTO
  Bounds check    5        FAULT  No              BOUND
  Bad opcode      6        FAULT  No              Illegal instruction
  No 80x87        7        FAULT  No              ESC, WAIT with no
                                                  coprocessor or when
                                                  coprocessor was last used
                                                  by another task
  Double fault    8        ABORT  Yes (always 0)  Any instruction that can
                                                  generate an exception
  NPX overrun     9        ABORT  No              Any operand of an ESC
                                                  that wraps around the end
                                                  of a segment.
  Invalid TSS    10        FAULT  Yes             JMP, CALL, IRET or
                                                  interrupt
  No segment     11        FAULT  Yes             Any reference to a
                                                  not-present segment
  Stack error    12        FAULT  Yes             Any reference with SS
                                                  register
  Gen'l protect  13        FAULT  Yes             Any memory reference
                                                  including code fetches
  Page fault     14        FAULT  Yes             Any memory reference
                                                  including code fetches
  NPX error      16        FAULT  No              ESC, WAIT

PROT prints the display on the screen using OUCH and its related routines. This means that if you have changed the video mode or the page in your program, you may have to modify the OUCH routine to accommodate those changes. You could, for instance, modify OUCH to output to a printer. Be careful, however, not to use any DOS or BIOS routines in OUCH; you can't be sure what state the system will be in when OUCH is called.

The display is largely self-explanatory. PROT displays the registers and the interrupt number at the top of the screen. Below the registers, PROT displays a stack dump, starting with the location at ESP and continuing to the end of the stack segment. If the location DUMP_SEL is non-zero, PROT also prints DUMP_CNT bytes starting at DUMP_SEL:DUMP_OFF. Note that the BREAKDUMPand NBREAKDUMP macros (see Table 5 for complete list of macros to set breakpoints) automatically set these values for you. After printing this screen, PROT returns to DOS with an error code of 7FH.

Table 5: Macros used to set breakpoints

  Macro        Description
--------------------------------------------------------------------------

  BREAKPOINT   Execution will stop at this point, causing a debug dump.
  BREAKON      Turns on conditional breakpoints.  If followed by an
               integer number, that number of conditional breakpoints must
               execute before the breakpoint actually occurs.
  BREAKOFF     Turns off conditional breakpoints.
  NBREAKPOINT  Conditional breakpoint macro.  Until a BREAKON command
               executes, this instruction will have no effect.
  BREAKDUMP    Causes an unconditional breakpoint and dumps a region of
               memory following the stack dump.
  NBREAKDUMP   Conditional breakpoint with the memory dump feature of
               BREAKDUMP added.

Some 80386 exceptions push an error code on the stack. For these exceptions, that will be the first word on the stack. The next two words will be the value of CS:EIP at the time of the interrupt. In Figure 3, for example, the value of CS:EIP is 88H:2BH. The next word will be the flags (202H in Figure 3). The stack dump displays the protected-mode stack, even if a VM86 mode program was interrupted. If you need to look at your VM86 stack, you can use the memory dump feature. When an interrupt occurs during a VM86 program, the words following the flags on the stack are the SS, ES, DS, FS, and GS registers, in that order. Any segment register values on the stack will have their top 16 bits set to unpredictable values by the 386.

80386 Exceptions

The 80386 defines 15 different exceptions that it generates internally to indicate certain conditions. Table 4 summarizes all of the possible exceptions and why they occur. Exceptions fall into three classes: faults, traps, and aborts. A fault is restartable; the offending instruction hasn't executed yet, and CS:EIP points to the instruction that faulted. In a trap exception, the offending instruction has already executed. CS:EIP then points to the instruction that will execute after the offending instruction. Aborts are exceptions so severe that you will usually terminate the program generating them. Table 6 presents these exceptions in detail.

Table 6: 80386 exceptions in detail

Exception  Description
---------------------------------------------------------------------------
  INT 0    Occurs if you ask the 80386 to divide by 0, or if a division
           gives a result that will not fit in the specified accumulator
           (AL, AX, or EAX).
  INT 1    Vector for a multitude of debugging interrupts.  Hardware data
           breakpoints, single-step breakpoints, and task-switch
           breakpoints are all considered traps.  Hardware code breakpoints
           and general detect exceptions are both faults.  Enabling any of
           these breakpoints requires manipulating the debug registers
           (DR0-DR7).
  INT 3    Occurs when an INT 3 instruction executes.  Convenient for
           placing breakpoints in your code.
  INT 4    Check arithmetic operations for overflow.  If an INTO
           instruction executes with the OF flag set, INT 4 occurs.
  INT 5    The BOUND instruction generates this interrupt if it finds an
           array index outside of the array's limits.  Real-mode
           programmers don't use the BOUND instruction because the ROM
           BIOS uses INT 5 for the print screen routine.
  INT 6    Occurs when the 80386 reads an unknown opcode or when a
           legitimate instruction receives a bad operand.
  INT 7    Occurs when: 1. A coprocessor instruction executed, but the
           system contains no coprocessor (as indicated by the EM flag in
           CR0); 2. A coprocessor instruction executed, but the last
           coprocessor operation occurred in another task.  This exception
           is only generated when the MP flag in CR0 equals one.  The
           second form of INT 7 is useful for maintaining the coprocessor's
           consistency when several different tasks are using the 80387.
  INT 8    One exception occurred while trying to begin service for another
           exception.  May require terminating the program.
  INT 9    Occurs when a coprocessor instruction runs over the end of a
           segment.
  INT 10   Occurs when a task switch occurs to an improperly formed
           TSS.  Handling this exception properly requires interrupt pass
           through a task gate.  PROT does not do this, however.  If you
           plan to do extensive multitasking with PROT, you should supply
           your own INT 10 handler to simplify debugging.
  INT 11   Occurs when the processor loads a not-present segment
           descriptor or uses a not-present gate descriptor.
  INT 12   Indicates that the stack has over- or under-run, or that the
           stack segment register (SS) was loaded with a not-present
           segment.
  INT 13   General protection fault is perhaps the most familiar interrupt
           for 80386 programmers.  This covers any error not handled by
           the other exceptions.
  INT 14   Occurs when a referenced memory page is absent, or a page's
           privilege is higher than the program that attempted to access
           it.  This is the primary vehicle used to implement virtual
           memory on the 80386.
  INT 16   Occurs when the 80387 detects an error.

The only exception that doesn't fall into one of these categories is INT 1, the debug exception. Some debug exceptions are faults and some are traps. Remember, PROT ends the running program and does a debug dump when any unexpected exception occurs, unless you reprogram the interrupt routines to do differently.

Some exceptions push an error code on the stack. Exception 14 has a special error code; but all the other exceptions simply push the segment selector that caused the fault onto the stack. The error code 0 means that the fault was caused by either the null selector or a selector which the 80386 was unable to determine.

What Went Wrong?

Real-mode debuggers, such as Code-View, Turbo Debugger, or DEBUG, won't help you troubleshoot PROT programs. When an exception display screen appears, you should note the CS:EIP (from the stack dump). By referring to the listing file generated by the assembler, you should be able to pinpoint the exact instruction that caused the exception.

Exceptions are commonly caused by referencing segment registers that contain zero (the null selector), addressing outside of a segment, or attempting to write into a code segment. Another common error stems from the linker's inability to generate 16-bit relative off-sets. For instance, consider the code fragment in Example 4. This code makes two conditional jumps, one if the value in EBX is above EAX and the other if it is below.

Example 4: 32-bit offset generation problems

  .386P
  SEGMENT EXAMPLE PARA 'CODE32' USE32
            .
  BACKWARD:
            .             .             .
            CMP EBX, EAX
            JA FORWARD         ; This jump is OK
            JB BACKWARD        ; This jump is improperly assembled
            .             .             .
  FORWARD:

Because the code contains the .386P (or .386) directive, all conditional jumps default to 32-bit relative jumps in a 32-bit segment. The first jump will be correct because it requires a positive offset less than 64K away. The second jump will probably cause a general-protection fault because the linker only generates 2 bytes of the 4-byte offset. For example, if the jump's offset is -10 (FFFFFFF6 hex), the linker will generate FFF6 hex, a 32-bit offset of 65,526. This is sure to cause an unexpected result. If you are lucky, the segment isn't that large and a general-protection fault occurs. Otherwise, the 386 will just jump to a new location. Sometimes, this location will not contain a valid instruction, which will cause an exception 6. Other times, your program will just start doing entirely unpredictable things. To prevent this, and for efficiency's sake, you should specify all jumps to be short, if possible. If not, you can use the JCC32 macro provided in Listing Three (Part I) to generate proper 32-bit conditional jumps.

Under the Hood

Most of the implementation of PROT is straight out of the Intel documentation. The program sets up the Global Descriptor Table (GDT), disables interrupts, and switches the machine into protected mode. In protected mode, PROT sets up the Interrupt Descriptor Table (IDT), reprograms the interrupt controllers, and reenables interrupts. PROT then calls the user's code. While running DOS or BIOS code, PROT emulates the PUSHF, POPF, STI, CLI, INT, and IRET instructions.

As mentioned earlier, software interrupts pose the single biggest problem for a DOS extender. The easy case occurs when a program calls an interrupt routine with INT, and the interrupt routine ends with IRET. Most of the DOS/ BIOS calls, however, return information in the flag register. Because IRET will restore the flags, these calls have to use some method of overriding the old flags. From a DOS extender's point of view, the right thing to do is modify the flags on the stack. This causes IRET to restore the flags we want instead of the original ones.

Unfortunately, most of the system calls don't do this. One common method of sending flags back to the caller is to return using a RETF 2 instruction instead of IRET. In real mode, this has the same effect as IRET, except for destroying the saved flags. Of course, a VM86 RETF instruction can't return to a protected-mode task, so a DOS extender has to find a way around this.

There is yet another way DOS handles flags: The absolute disk read and write interrupts (INT 25H and 26H) leave the original flags at the top of the stack. These interrupt routines accomplish this by executing RETF. This is similar to the previous case, and PROT handles it in the same way.

Another problem lies in the DOS and BIOS methods of calling interrupts. Most often, these routines use an INT instruction to start an interrupt routine. However, systems routines will sometimes push flags on the stack and then do a FAR CALL. In real mode, this is exactly equivalent to an INT. In protected mode, however, this will cause havoc in our attempts to emulate the IRET instruction. Luckily, the method we will use to handle the RETF 2 return also suggests a solution to this problem.

Finally, the system routines sometimes pass control by pushing the flags and an address on the stack and then executing an IRET instruction. This resembles the FAR CALL/IRET case, and PROT handles it in the same manner. These problem cases are detailed with the code fragments in Figure 4.

Figure 4: Problem cases associated with software interrupts. Case 1, normal interrupt routine call and return; case 2, returning from an interrupt using FAR RETURN 2; case 3, returning from an interrupt using a FAR RETURN; case 4, simulating an interrupt with a FAR CALL; case 5, using IRET to transfer control to an arbitrary address.

  Case 1

           Normal INT/IRET
                        *
                        *
                        *
                 INT 10H          ;perform interrupt
                        *
                        *
                        *
        ISR:                      ;Interrupt 10H service routine
                        *
                        *
                        *
                 IRET

  Case 2

                 INT/RETF 2
                        *
                        *
                        *
                 INT 10H          ;perform interrupt
                        *
                        *
                        *
        ISR:                      ;Interrupt 10H service routine
                        *
                        *
                        *
                 RETF 2

  Case 3

           INT/RETF (only used by INT 25H and 26H)
                        *
                        *
                        *
                 INT 10H          ;perform interrupt
                        *
                        *
                        *
        ISR:                      ;Interrupt 10H service routine
                        *
                        *
                        *
                 RETF

  Case 4

           PUSHF/FAR CALL
                        *
                        *
                        *
                 PUSHF            ;simulate interrupt

                 CALL FAR ISR
                        *
                        *
                        *
        ISR:                      ;Interrupt 10H service routine
                        *
                        *
                        *
                 IRET

  Case 5

           PUSHF/PUSH ADDRESS/IRET
                        *
                        *
                        *
                 PUSHF            ;Jump to address TARGET
                 PUSH SEG TARGET
                 PUSH OFFSET TARGET
                 IRET
                        *
                        *
                        *
        TARGET:                   ;Destination of IRET
                        *
                        *
                        *
  -or-
                        *
                        *
                        *
                 PUSHF            ;Simulate interrupt
                 PUSH SEG RETAD
                 PUSH OFFSET RETAD
                 JMP FAR ISR

        RETAD:
                        *
                        *
        ISR:                      ;Interrupt routine
                        *
                        *
                 IRET

The Seven Percent Solution

Our DOS extender must have a VM86 mode segment (I've called it QISR), that contains the code shown in Example 5. When the DOS extender detects an INT instruction being executed from real mode, it emulates it much as outlined in the Intel documentation. The 80386 places the actual flags and return address on the Privilege Level 0 (PL0) stack via the general-protection fault caused by the INT. The secret to managing DOS's odd interrupt handling lies in manipulating the VM86 stack. You can push a 16-bit copy of the flags on the VM86 stack, followed by the address of qiret. Then the DOS extender transfers control (in VM86 mode) to the real-mode interrupt handler.

Example 5: QISR code for the VM86 mode segment

  qisr segment para 'CODE16' use16
            assume cs:qisr
       qiret:
            push 0
            push 0
            push 0
            iret
       qisr ends

When an IRET executes, another general-protection fault occurs. We can determine which case happened by examining the top of the VM86 stack. If the top three words of the stack are all zeros, we have found case 2 or 3 in Figure 4. If the address on the top of the stack is qiret's, then the normal case (case 1) occurred. Any other address at the top of the stack indicates case 4 or 5.

Now that we know what case caused the IRET, what action does the DOS extender take? PROT uses the following logic:

In case 1, merge the 16-bit flags on the VM86 stack with the top 16 bits of the flags pushed on the PL0 stack during the INT handling. This may seem redundant, but the system routines may modify these flags, and the caller will expect the modified flags. Balance the VM86 stack and restore the return address from the PL0 stack; cases 2 and 3 are much the same as case 1, except that PROT restores the current flags (which are on the PL0 stack) instead of the flags on the VM86 stack. Cases 4 and 5 don't go through the INT logic just described. Therefore, the DOS extender must build an artificial PL0 stack frame that looks as though the INT logic executed earlier. The execution then continues as in case 1.

When a protected-mode program needs to call a DOS or BIOS service, it calls the call86 routine. This routine uses PROT's INT 30H function to build a stack frame much like the one used in cases 4 and 5 and simulates the DOS (or BIOS) interrupt.

Hardware Interrupts

INT 30H directly handles hardware interrupts. Because hardware interrupts can occur at any time, PROT examines the flags of the interrupted program. If the interrupted program is a VM86 program, PROT uses the VM86 stack to handle the interrupt. If the program is a protected-mode program, PROT switches to a special stack for hardware interrupt processing.

The PC's first interrupt controller is reprogrammed to generate different interrupts than normal. PROT translates these interrupts to the correct service routines. This prevents hardware interrupts from being confused with 80386 exceptions. Also, the interrupts from the second controller (on AT-style machines only) are reprogrammed to simplify constructing the interrupt table.

Future Directions

While PROT is a complete protected-mode environment, there are still some interesting enhancements you may want to try. For completeness, PROT should emulate IRETD, PUSHFD, and POPFD in VM86 mode. Adding a scheduler that would run off the PC's timer interrupt would make PROT more useful in multitasking applications. Additional support for memory paging would be helpful as well.

PROT's most noticeable shortcoming is it's inability to work with other 386-specific programs. Standards such as the Virtual Control Program Interface (VCPI) and the DOS Protected Mode Interface (DPMI) allow programs like PROT to share the 386 with other programs that also use the processor's special features. Adding VCPI or DPMI support to PROT should not be very difficult. The specification for VCPI is available, free of charge, from Phar Lap Software Inc., 60 Aberdeen Ave., Cambridge, MA 02138, 617-661-1510. The DPMI spec can be ordered free of charge from Intel Literature Sales, P.O. Box 58130, Santa Clara, CA 95052, 800-548-4725 (Intel part # 240763-001).

DOS extenders provide a way for today's developers to launch sophisticated applications now, and with a much larger potential market than any other option. By using PROT, you will be able to learn more about developing protected-mode software. The experience you gain will not only help you expand your DOS applications today, it will also give you a headstart on the operating systems of the future.

_ROLL YOUR OWN DOS EXTENDER_ by Al Williams

[LISTING ONE]



;********************************************************************
;* PROT - A 386 protected mode DOS extender                         *
;* Copyright (C) 1989, by Al Williams  All rights reserved.         *
;* Permission is granted for non-commercial use of this software.   *
;* You are expressly prohibited from selling this software,         *
;* distributing it with another product, or removing this notice.   *
;* If you distribute this software to others in any form, you must  *
;* distribute all of the files that are listed below:               *
;* PROT.ASM     - The main routines and protected mode support.     *
;* EQUMAC.INC   - Equates and macros.                               *
;* STACKS.INC   - Stack segments.                                   *
;* GDT.INC      - Global descriptor table.                          *
;* INT386.INC   - Protected mode interrupt handlers.                *
;* PMDEMO.PM    - Example user code.                                *
;* PMPWD.PM     - Alternate example code.                           *
;* FBROWSE.PM   - Complete sample application.                      *
;* TSS.INC      - Task state segments.                              *
;* CODE16.INC   - 16 bit DOS code (entry/exit).                     *
;* PMASM.BAT    - MASM driver for assembling PROT programs.         *
;* To assemble:    MASM /DPROGRAM=pname PROT.ASM,,PROT.LST;         *
;* To link:        LINK PROT;                                       *
;*      pname is the program name (code in pname.PM)                *
;*      if pname is ommited, USER.PM is used                        *
;* The resulting .EXE file is executable from the DOS prompt.       *
;* This file is: PROT.ASM, the main protected mode code.            *
;********************************************************************

.XLIST
.LALL

.386P

; Name program if PROGRAM is defined
IFDEF        PROGRAM
VTITLE       MACRO    PNAME        ; temporary macro to title program
             TITLE    PNAME
             ENDM
             VTITLE   %PROGRAM
             PURGE    VTITLE       ; delete macro
; equates and macros
INCLUDE      EQUMAC.INC

; stack segments
INCLUDE      STACKS.INC

; Global descriptor table definitons
INCLUDE      GDT.INC

; interrupt code

INCLUDE      INT386.INC

; this is required to find out how large PROT is
ZZZGROUP     GROUP    ZZZSEG

;********************************************************************
; 32 bit data segment
DAT32        SEGMENT  PARA PUBLIC 'DATA32' USE32
DAT32BEG     EQU      $

; 32 bit stack values
SLOAD        DD       OFFSET SSEG321-1
SSLD         DW       SEL_STACK

; This location will hold the address for the PMODE IDT
NEWIDT       EQU      THIS FWORD
             DW       (IDTEND-IDTBEG)-1
IDTB         DD       0            ; filled in at runtime

; PSP segment address
_PSP         DW       0

; video variables for the OUCH and related routines
CURSOR       DD       0            ; cursor location
COLOR        DB       7            ; display cursor

; temp vars for some non reentrant interrupt routines
STO1         DD       0
STO2         DD       0
STO3         DD       0
STO4         DD       0
SAV_DS       DD       0
SAV_ES       DD       0
SAV_GS       DD       0
SAV_FS       DD       0

BPON         DB       0            ; Enables conditional breakpoints

; Debug Dump variables
DUMP_SEG     DW       0            ; if zero don't dump memory
DUMP_OFF     DD       0            ; Offset to start at
DUMP_CNT     DD       0            ; # of bytes to dump

; Break & critical error handler variables
BREAKKEY     DB       0            ; break key occurred
CRITICAL     DB       0            ; critical error occured
CRITAX       DW       0            ; critical error ax
CRITDI       DW       0            ; critical error di
CRITBP       DW       0            ; critical error bp
CRITSI       DW       0            ; critical error si

; Address of user's break handler
BREAK_HANDLE EQU      THIS FWORD
BRK_OFF      DD       0
BRK_SEG      DW       0

; Address of user's critical error handler
CRIT_HANDLE  EQU      THIS FWORD
CRIT_OFF     DD       OFFSET DEF_CRIT
CRIT_SEG     DW       SEL_CODE32

; Message for default critical error handler
CRITMSG      DB       'A critical error has occured.',13,10
             DB       '<A>bort, <R>etry, <F>ail? $'

; here is where vm86 int's stack up pl0 esp's
INTSP        DD       $+PVSTACK+4
             DB       PVSTACK DUP (0)

; Default VM86CALL parameter block
PINTFRAME    VM86BLK  <>

; interface block for critical error handler
CINTFRAME    VM86BLK  <>

; hardware interrupt vm86 block
HINTFRAME    VM86BLK  <>

; storage for the original PIC interrupt mask registers
INTMASK      DB       0
INTMASKAT    DB       0

DAT32END     EQU      $
DAT32        ENDS

;********************************************************************
; Begin 32 bit code segment

SEG32        SEGMENT  PARA PUBLIC 'CODE32' USE32
             ASSUME   CS:SEG32, DS:DAT32
PCODE        PROC
SEG32BEG     EQU      $

; Start of protected mode code. We jump here from inside CODE16.INC
SEG32ENT:    MOV      AX,SEL_DATA  ; 1st order of business:
             MOV      DS,AX        ; load up segment registers
             LSS      ESP, FWORD PTR SLOAD
             MOV      AX,SEL_VIDEO
             MOV      ES,AX
             MOV      AX,SEL_DATA0
             MOV      FS,AX
             MOV      AX,SEL_GDT
             MOV      GS,AX
; set up IDT
             CALL32S  MAKIDT
; reprogram pic(s)
             IN       AL,21H
             MOV      INTMASK,AL
IF           ATCLASS
             IN       AL,0A1H
             MOV      INTMASKAT,AL
             MOV      AL,11H
             OUT      0A0H,AL
             OUT      20H,AL
             IDELAY
             MOV      AL,28H
             OUT      0A1H,AL
             MOV      AL,20H
             OUT      21H,AL
             IDELAY
             MOV      AL,2
             OUT      0A1H,AL
             MOV      AL,4
             OUT      21H,AL
             IDELAY
             MOV      AL,1
             OUT      0A1H,AL
             OUT      21H,AL
             IDELAY
             MOV      AL,INTMASKAT
             OUT      0A1H,AL
             MOV      AL,INTMASK
             OUT      21H,AL
ELSE
; INBOARD PC Code
             MOV      AL,13H
             OUT      20H,AL
             MOV      AL,20H
             OUT      21H,AL
             MOV      AL,9
             OUT      21H,AL
             MOV      AL,INTMASK
             OUT      21H,AL
ENDIF
             STI                   ; enable interrupts

; *** Start user code with TSS (req'd for vm86 op's etc.)
             MOV      AX,TSS0
             LTR      AX
             JMPABS32 TSS1,0
PCODE        ENDP

;*** 32 bit support routines
; This routine creates the required IDT. This is only a subroutine to keep
; from cluttering up the main code, since you aren't likely to call it again.
; Assumes that all ISR routines are of fixed length and in sequence. After
; makidt has built the table, you can still replace individual INT gates with
; your own gates (see make_gate)
MAKIDT       PROC     NEAR
             PUSH     ES
             MOV      AX,IDTABLE
             MOVZX    EAX,AX
             SHL      EAX,4
             ADD      EAX,OFFSET IDTBEG
             MOV      IDTB,EAX
             MOV      AX,SEL_IDT
             MOV      ES,AX
             XOR      AL,AL
; Make all interrupt gates DPL=3
             MOV      AH,INTR_GATE OR DPL3
             MOV      CX,SEL_ICODE
             MOV      EDX,OFFSET IDTBEG
             XOR      SI,SI
             MOV      EBX,OFFSET INT0
IDTLOOP:     CALL32F  SEL_CODE32,MAKE_GATE
             ADD      EBX,INT1-INT0
             ADD      SI,8
; loop form max # of interrupts
             CMP      SI,(TOPINT+1)*8
             JB       SHORT IDTLOOP
             LIDT     NEWIDT
             POP      ES
             RET
MAKIDT       ENDP

; This routine is just like the real mode make_desc
; EBX=base  ECX=limit   AH=ARB  AL=0 or 1 for 16 or 32 bit
; SI=selector (TI&RPL ignored) and ES:EDX is the table base address
MAKE_SEG     PROC     FAR
             PUSH     ESI
             PUSH     EAX
             PUSH     ECX
             MOVZX    ESI,SI
             SHR      SI,3         ; adjust to slot #
             SHL      AL,6         ; shift size to right bit position
             CMP      ECX,0FFFFFH  ; see if you need to set G bit
             JLE      OKLIM
             SHR      ECX,12       ; div by 4096
             OR       AL,80H       ; set G bit
OKLIM:       MOV      ES:[EDX+ESI*8],CX
             SHR      ECX,16
             OR       CL,AL
             MOV      ES:[EDX+ESI*8+6],CL
             MOV      ES:[EDX+ESI*8+2],BX
             SHR      EBX,16
             MOV      ES:[EDX+ESI*8+4],BL
             MOV      ES:[EDX+ESI*8+5],AH
             MOV      ES:[EDX+ESI*8+7],BH
             POP      ECX
             POP      EAX
             POP      ESI
             RET
MAKE_SEG     ENDP

; This routine make gates -- AL=WC if applicable -- AH=ARB  -- EBX=offset
; CX=selector  -- ES:EDX=table base  --  SI= selector (TI&RPL ignored)
MAKE_GATE    PROC     FAR
             PUSH     ESI
             PUSH     EBX
             SHR      SI,3
             MOVZX    ESI,SI
             MOV      ES:[EDX+ESI*8],BX
             MOV      ES:[EDX+ESI*8+2],CX
             MOV      ES:[EDX+ESI*8+4],AX
             SHR      EBX,16
             MOV      ES:[EDX+ESI*8+6],BX
             POP      EBX
             POP      ESI
             RET
MAKE_GATE    ENDP

; Routine to call BIOS/DOS. NOT REENTRANT (but so what? DOS isn't either)
CALL86       PROC     FAR
             PUSH     DS
             PUSH     GS
             PUSH     FS
RETRY86:
             PUSHAD
             PUSHFD
             PUSH     ES:[EBX+40]  ; save new ebx
             PUSH     EBX
             PUSH     ES
             INT      30H          ; call PROT
             PUSH     SEL_DATA
             POP      DS
             POP      ES
             XCHG     EBX,[ESP]
             POP      ES:[EBX+40]
             PUSHFD
             CMP      BREAKKEY,0   ; see if break occured
             JZ       SHORT NOBRKCHECK
             CMP      BRK_SEG,0    ; see if user has brk handler
             JZ       SHORT NOBRKCHECK
                                   ; call user's break handler
             MOV      BREAKKEY,0
             CALL     FWORD PTR BREAK_HANDLE
NOBRKCHECK:
             CMP      CRITICAL,0   ; see if critical error
             JZ       SHORT NOCRITCK
             CMP      CRIT_SEG,0   ; see if critical error handler
             JZ       SHORT NOCRITCK
                                   ; call critical error handler
             PUSH     EAX
             XOR      AL,AL
             MOV      CRITICAL,AL
             CALL     FWORD PTR CRIT_HANDLE
             OR       AL,AL        ; AL=0? FAIL
             JNZ      SHORT RETRY?
             POP      EAX
             POPFD
             STC                   ; make sure carry is set
             PUSHFD
             JMP      SHORT NOCRITCK
RETRY?:      DEC      AL           ; AL=1? RETRY
             JNZ      SHORT CABORT
; To retry an error, we set up everything the way it was and
; redo the interrupt. This is cheating (a little), and may not
; work in every possible case, but it seems to work in all the cases tried.
             POP      EAX
             POPFD
             POP      ES:[EBX+40]
             POPFD
             POPAD
             JMP      SHORT RETRY86
CABORT:      POP      EAX          ; ABORT
             POPFD
             LEA      ESP,[ESP+40] ; balance stack
             MOV      AL,7FH       ; DOS error=7FH
             BACK2DOS
NOCRITCK:
             POPFD
             LEA      ESP,[ESP+40] ; balance stack
             PUSHFD
; see if segment save requested
             CMP      BYTE PTR ES:[EBX],0
             JZ       NOSEGS
; load parameter block from static save area
             PUSH     EAX
             MOV      EAX,SAV_FS
             MOV      ES:[EBX+28],EAX
             MOV      EAX,SAV_DS
             MOV      ES:[EBX+24],EAX
             MOV      EAX,SAV_ES
             MOV      ES:[EBX+20],EAX
             MOV      EAX,SAV_GS
             MOV      ES:[EBX+32],EAX
             POP      EAX
NOSEGS:
             POPFD
             POP      FS
             POP      GS
             POP      DS
             MOV      EBX,ES:[EBX+40]
             RET
CALL86       ENDP

; Directly clear page 0 of the screen
CLS          PROC     FAR
             PUSHFD
             PUSH     DS
             PUSH     ES
             PUSH     EDI
             PUSH     ECX
             PUSH     EAX
             MOV      CX,SEL_VIDEO
             MOV      ES,CX
             MOV      CX,SEL_DATA
             MOV      DS,CX
             CLD
             MOV      EDI,0
             MOV      ECX,2000
             MOV      AX,0720H
             REP      STOSW
             XOR      ECX,ECX
             MOV      CURSOR,ECX
             POP      EAX
             POP      ECX
             POP      EDI
             POP      ES
             POP      DS
             POPFD
             RET
CLS          ENDP

; Outputs message to screen -- ASCIIZ pointer in ds:ebx - modifies ebx
MESSOUT      PROC     FAR
             PUSH     EAX
NXT:         MOV      AL,[EBX]
             INC      EBX
             OR       AL,AL
             JNZ      SHORT SKIP
             POP      EAX

             RET
SKIP:        CALL32F  SEL_CODE32, OUCH
             JMP      SHORT NXT
MESSOUT      ENDP

; Performs CR/LF sequence to screen using OUCH
CRLF         PROC     FAR
             PUSH     EAX
             MOV      AL,13
             CALL32F  SEL_CODE32,OUCH
             MOV      AL,10
             CALL32F  SEL_CODE32,OUCH
             POP      EAX
             RET
CRLF         ENDP

; Character and digit output routines
; hexout4 - print longword in EAX in hex
; hexout2 - print word in AX in hex
; hexout  - print byte in AL in hex
; ouch    - print ASCII character in AL
OUTPUT       PROC     FAR
; print longword in eax
HEXOUT4      LABEL    FAR
             PUSH     EAX
             SHR      EAX,16
             CALL32F  SEL_CODE32,HEXOUT2
             POP      EAX
; print word in ax
HEXOUT2      LABEL    FAR
             PUSH     EAX
             MOV      AL,AH
             CALL32F  SEL_CODE32, HEXOUT
             POP      EAX
; print a hex byte in al
HEXOUT       LABEL    FAR
             MOV      BL,AL
             AND      AX,0F0H
             SHL      AX,4
             MOV      AL,BL
             AND      AL,0FH
             ADD      AX,'00'
             MOV      BL,AL
             MOV      AL,AH
             CALL32F  SEL_CODE32, HEX1DIG
             MOV      AL,BL
HEX1DIG:     CMP      AL,'9'
             JBE      SHORT H1DIG
             ADD      AL,'A'-'0'-0AH
H1DIG:
OUCH         LABEL    FAR
             PUSH     EDI
             PUSH     EAX
             PUSH     DS
             PUSH     ES
             PUSH     ECX
             MOV      CX,SEL_VIDEO
             MOV      ES,CX
             MOV      CX,SEL_DATA
             MOV      DS,CX
             POP      ECX
             MOV      AH,COLOR
             MOV      EDI,CURSOR
             CMP      EDI,2000     ; rolling off the screen?
             JB       NOSCROLL
; scroll screen if required
             PUSH     DS
             PUSH     ES
             POP      DS
             PUSH     ESI
             PUSH     ECX
             PUSH     EDI
             CLD
             MOV      ECX,960
             XOR      EDI,EDI
             MOV      ESI,160
             REP      MOVSD
             POP      EDI
             SUB      EDI,80
             POP      ECX
             POP      ESI
             POP      DS
NOSCROLL:    CMP      AL,0DH
             JZ       SHORT CR
             CMP      AL,0AH
             JZ       SHORT LF
; write to screen
             MOV      ES:[EDI*2],AX
             INC      EDI
             JMP      SHORT OUCHD
CR:          PUSH     EDX
             PUSH     ECX
             MOV      EAX,EDI
             XOR      EDX,EDX
             MOV      ECX,80
             DIV      ECX
             SUB      EDI,EDX
             POP      ECX
             POP      EDX
             JMP      SHORT OUCHD
LF:          ADD      EDI,50H
OUCHD:       MOV      CURSOR,EDI   ; update cursor
             POP      ES
             POP      DS
             POP      EAX
             POP      EDI
             RET
OUTPUT       ENDP
; Default critical error handler
DEF_CRIT     PROC     FAR
             PUSH     ES
             PUSH     EBX
             PUSH     EDX
             MOV      BX,SEL_DATA
             MOV      ES,BX
             ASSUME   DS:NOTHING, ES:DAT32
; load critical error handler's private stack
             MOV      BX,CSTACK
             MOV      CINTFRAME.VMSS,EBX
             MOV      EBX,OFFSET CSTACK
             MOV      CINTFRAME.VMESP,EBX
             MOV      BX,DAT32
             MOV      CINTFRAME.VMDS,EBX
             MOV      BX,21H
             MOV      CINTFRAME.VMINT,EBX
             MOV      EBX, OFFSET CINTFRAME
             MOV      EDX,OFFSET CRITMSG
             MOV      AH,9
             PUSH     EBX
             VM86CALL              ; print message
             POP      EBX
CLOOP:
             MOV      AH,7
             PUSH     EBX
             VM86CALL              ; get keystroke
             POP      EBX
; ignore function keys
             OR       AL,AL
             JZ       SHORT CRITFNKEY
             MOV      AH,AL
             OR       AL,20H       ; convert to lower case
             CMP      AL,'a'
             JNZ      SHORT CFAIL?
             MOV      AL,2
             JMP      SHORT CREXIT
CFAIL?:      CMP      AL,'f'
             JNZ      SHORT CRETRY?
             XOR      AL,AL
             JMP      SHORT CREXIT
CRETRY?:
             CMP      AL,'r'
             MOV      AL,1
             JNZ      SHORT CRITBAD
CREXIT:      MOV      DL,AH        ; echo letter + CRLF
             MOV      AH,2
             PUSH     EAX
             PUSH     EBX
             VM86CALL
             POP      EBX
             MOV      AH,2
             MOV      DL,0DH
             PUSH     EBX
             VM86CALL
             POP      EBX
             MOV      AH,2
             MOV      DL,0AH
             VM86CALL
             POP      EAX
             POP      EDX
             POP      EBX
             POP      ES
             RET
CRITFNKEY:
             MOV      AH,7
             PUSH     EBX
             VM86CALL              ; ignore fn key/alt-key
             POP      EBX
CRITBAD:
             MOV      DL,7
             MOV      AH,2
             PUSH     EBX
             VM86CALL              ; unknown input - ring bell
             POP      EBX
             JMP      SHORT CLOOP
DEF_CRIT     ENDP

SEG32END     EQU      $
SEG32        ENDS

;********************************************************************
; user program - PROT includes the file defined by the variable PROGRAM.
; convoluted method to make MASM take a string equate for an include filename

TEMPINCLUDE  MACRO    FN           ; ; temporary macro
             INCLUDE  &FN&.PM
             ENDM
TEMPINCLUDE  %PROGRAM

PURGE        TEMPINCLUDE           ; delete macro

; task state segments
INCLUDE      TSS.INC

; 16 bit code (DOS entry/exit)
INCLUDE      CODE16.INC

; Segment to determine the last memory address
ZZZSEG       SEGMENT  PARA PUBLIC 'ZZZ' USE16
ZZZSEG       ENDS
ELSE
IF2
             %OUT     You must specify a program title
             %OUT     use: MASM /DPROGRAM=PNAME PROT.ASM...
ENDIF
             .ERR
ENDIF
             END      ENTRY




[LISTING TWO]


;********************************************************************
;* PROT - A 386 protected mode DOS extender                         *
;* Copyright (C) 1989, by Al Williams -- All rights reserved.       *
;* Permission is granted for non-commercial use of this software    *
;* subject to certain conditions (see PROT.ASM).                    *
;* This file is: GDT.INC, the Global Descriptor Table definitions.  *
;********************************************************************
; See EQUMAC.INC for an explanation of the DESC macro
GDTSEG       SEGMENT  PARA PUBLIC 'CODE32' USE32
GDT          EQU      $            ; GDT space
             DESC     SEL_NULL     ; DUMMY NULL SELECTOR
             DESC     SEL_CODE16   ; 16 BIT CODE SEGMENT
             DESC     SEL_DATA0    ; 4GB SEGMENT
             DESC     SEL_CODE32   ; 32 BIT CODE SEGMENT
             DESC     SEL_STACK    ; 32 BIT STACK
             DESC     SEL_RDATA    ; REAL MODE LIKE DATA SEG
             DESC     SEL_GDT      ; GDT ALIAS
             DESC     SEL_VIDEO    ; VIDEO MEMORY
             DESC     SEL_DATA     ; 32 BIT DATA
             DESC     SEL_IDT      ; IDT ALIAS
             DESC     SEL_ICODE    ; ISR SEGMENT
             DESC     SEL_TSS0     ; DUMMY TASK BLOCK
             DESC     TSS0         ; SAME (MUST FOLLOW SEL_TSS0)
             DESC     SEL_TSS1     ; MAIN TASK BLOCK
             DESC     TSS1         ; SAME (MUST FOLLOW SEL_TSS1)
             DESC     SEL_UCODE    ; USER CODE
             DESC     SEL_UDATA    ; USER DATA
             DESC     SEL_PSP      ; DOS PSP
             DESC     SEL_FREE     ; FREE DOS MEMORY
             DESC     SEL_EXT      ; EXTENDED MEMORY
             DESC     SEL_ENV      ; ENVIROMENT
GDTEND       =        $
GDTSEG       ENDS





[LISTING THREE]


;********************************************************************
;* PROT - A 386 protected mode DOS extender                         *
;* Copyright (C) 1989, by Al Williams -- All rights reserved.       *
;* Permission is granted for non-commercial use of this software    *
;* subject to certain conditions (see PROT.ASM).                    *
;* This file is: EQUMAC.INC, assorted macros and equates.           *
;********************************************************************
; EQUates the user may wish to change
ATCLASS      EQU      1            ; 1=AT/386  0=INBOARD 386/PC
DOSSTACK     EQU      200H         ; stack size for DOS startup
VM86STACK    EQU      200H         ; stack size for VM86 int calls
CRITSTACK    EQU      30H          ; stack size for crit err handler
PMSTACK      EQU      1000H        ; stack size for p-mode stack
PVSTACK      EQU      260          ; pl0/vm86 psuedo stack size
; Maximum protected mode interrupt # defined
             TOPINT   EQU 30H
; The critical error handler works different for DOS 2.X than for other DOS
; versions. In 99% of the cases it won't make any difference if you compile
; with DOS=2.... major dos version number (2, 3 or 4)
             DOS      EQU 3

; parameter block to interface for int 30H (call86 & VM86CALL)
VM86BLK      STRUC
VMSEGFLAG    DD       0            ; restore segment registers (flag)
VMINT        DD       0            ; interrupt number
VMFLAGS      DD       0            ; EFLAGS
VMESP        DD       0            ; ESP
VMSS         DD       0            ; SS
VMES         DD       0            ; ES
VMDS         DD       0            ; DS
VMFS         DD       0            ; FS
VMGS         DD       0            ; GS
VMEBP        DD       0            ; EBP
VMEBX        DD       0            ; EBX
VM86BLK      ENDS

; Access rights equates. Use these with make_desc or make_seg
RO_DATA      EQU      90H          ; r/o data
RW_DATA      EQU      92H          ; r/w data
RO_STK       EQU      94H          ; r/o stack
RW_STK       EQU      96H          ; r/w stack
EX_CODE      EQU      98H          ; exec only code
ER_CODE      EQU      9AH          ; read/exec code
CN_CODE      EQU      9CH          ; exec only conforming code
CR_CODE      EQU      9EH          ; read/exec conforming code
LDT_DESC     EQU      82H          ; LDT entry
TSS_DESC     EQU      89H          ; TSS entry

; use these with make_gate
CALL_GATE    EQU      8CH          ; call gate
TRAP_GATE    EQU      8FH          ; trap gate
INTR_GATE    EQU      8EH          ; int gate
TASK_GATE    EQU      85H          ; task gate

; dpl equates
DPL0         EQU      0
DPL1         EQU      20H
DPL2         EQU      40H
DPL3         EQU      60H

; macro definitons

; other macros use this to error check parameters
; Give an error if last is blank or toomany is not blank
ERRCHK       MACRO    LAST,TOOMANY
IFNB         <TOOMANY>
IF2
             %OUT     Too many parameters
ENDIF
             .ERR
ENDIF
IFB          <LAST>
IF2
             %OUT     Not enough parameters
ENDIF
             .ERR
ENDIF
             ENDM

; Perform absolute 16 bit jump (in a 16 bit segment)
JMPABS       MACRO    A,B,ERRCK
             ERRCHK   B,ERRCK
             DB       0EAH         ; ; absoulte 16 bit jump
             DW       OFFSET B
             DW       A
             ENDM

; Peform absolute 32 bit jump (in a 32 bit segment)
JMPABS32     MACRO    A,B,ERRCK
             ERRCHK   B,ERRCK
             DB       0EAH         ; ; absolute 32 bit jump
             DD       OFFSET B
             DW       A
             ENDM
; this generates a correct 32 bit offset for a proc call
; since MASM doesn't sign extend 32 bit relative items
CALL32S      MACRO    LBL,ERRCK    ; ; short call
             ERRCHK   LBL,ERRCK
             DB       0E8H
             DD       LBL-($+4)
             ENDM

CALL32F      MACRO    SG,LBL,ERRCK ; ; far call
             ERRCHK   LBL,ERRCK
             DB       9AH
             DD       OFFSET LBL
             DW       SG
             ENDM

JMP32S       MACRO    LBL,ERRCK    ; ; short jump
             ERRCHK   LBL,ERRCK
             DB       0E9H
             DD       LBL-($+4)
             ENDM

; jcc32 uses condition codes used in Intel literature conditional jump macro
JCC32        MACRO    CONDX,LBL,ERRCK
             ERRCHK   LBL,ERRCK
             DB       0FH
IFIDNI       <CONDX>,<A>
             DB       87H
ELSEIFIDNI   <CONDX>,<NBE>
             DB       87H
ELSEIFIDNI   <CONDX>, <AE>
             DB       83H
ELSEIFIDNI   <CONDX>, <C>
             DB       82H
ELSEIFIDNI   <CONDX>, <NAE>
             DB       82H
ELSEIFIDNI   <CONDX>, <B>
             DB       82H
ELSEIFIDNI   <CONDX>, <BE>
             DB       86H
ELSEIFIDNI   <CONDX>, <E>
             DB       84H
ELSEIFIDNI   <CONDX>, <Z>
             DB       84H
ELSEIFIDNI   <CONDX>, <G>
             DB       8FH
ELSEIFIDNI   <CONDX>, <GE>
             DB       8DH
ELSEIFIDNI   <CONDX>, <L>
             DB       8CH
ELSEIFIDNI   <CONDX>, <LE>
             DB       8EH
ELSEIFIDNI   <CONDX>, <NA>
             DB       86H
ELSEIFIDNI   <CONDX>, <NB>
             DB       83H
ELSEIFIDNI   <CONDX>, <NC>
             DB       83H
ELSEIFIDNI   <CONDX>, <NGE>
             DB       8CH
ELSEIFIDNI   <CONDX>, <NL>
             DB       8DH
ELSEIFIDNI   <CONDX>, <NO>
             DB       81H
ELSEIFIDNI   <CONDX>, <NP>
             DB       8BH
ELSEIFIDNI   <CONDX>, <NS>
             DB       89H
ELSEIFIDNI   <CONDX>, <NZ>
             DB       85H
ELSEIFIDNI   <CONDX>, <O>
             DB       80H
ELSEIFIDNI   <CONDX>, <P>
             DB       8AH
ELSEIFIDNI   <CONDX>, <PE>
             DB       8AH
ELSEIFIDNI   <CONDX>, <PO>
             DB       8BH
ELSEIFIDNI   <CONDX>, <S>
             DB       88H
ELSE
             %OUT     JCC32: Unknown condition code
             .ERR
ENDIF
             DD       LBL-($+4)
             ENDM

; Override default operand size
OPSIZ        MACRO    NOPARM       ; ; op size overide
             ERRCHK   X,NOPARM
             DB       66H
             ENDM
; Override default address size
ADSIZ        MACRO    NOPARM       ; ; address size overide
             ERRCHK   X,NOPARM
             DB       67H
             ENDM
; delay macro for interrupt controller access
IDELAY       MACRO    NOPARM
             LOCAL    DELAY1,DELAY2
             ERRCHK   X,NOPARM
             JMP      SHORT DELAY1
DELAY1:      JMP      SHORT DELAY2
DELAY2:
             ENDM

; BREAKPOINT MACROS

; MACRO to turn on NBREAKPOINTS. If used with no arguments (or a 1), this
; macro makes NBREAKPOINT active if used with an argument > 1, NBREAKPOINT
; will break after that many passes
BREAKON      MACRO    ARG,ERRCK
             ERRCHK   X,ERRCK
             PUSH     DS
             PUSH     SEL_DATA
             POP      DS
             PUSH     EAX
             IFB      <ARG>
             MOV      AL,1
             ELSE
             MOV      AL,&ARG
             ENDIF
             MOV      BPON,AL
             POP      EAX
             POP      DS
             ENDM
; Turns off NBREAKPOINT
BREAKOFF     MACRO    NOPARAM
             ERRCHK   X,NOPARAM
             PUSH     DS
             PUSH     SEL_DATA
             POP      DS
             PUSH     EAX
             XOR      AL,AL
             MOV      BPON,AL
             POP      EAX
             POP      DS
             ENDM
BREAKPOINT   MACRO    NOPARM
             ERRCHK   X,NOPARM
             INT      3
             ENDM
; Counter breakpoint - use BREAKON to set count control

; BREAKPOINT with memory dump.
; usage: BREAKDUMP seg_selector, offset, number_of_words
BREAKDUMP    MACRO    SEG,OFF,CNT,ERRCK
             ERRCHK   CNT,ERRCK
             PUSH     EAX
             PUSH     DS
             MOV      AX,SEL_DATA
             MOV      DS,AX
             MOV      AX,&SEG
             MOV      DUMP_SEG,AX
             MOV      EAX,OFFSET &OFF
             MOV      DUMP_OFF,EAX
             MOV      EAX,&CNT
             MOV      DUMP_CNT,EAX
             POP      DS
             POP      EAX
             BREAKPOINT
             ENDM
NBREAKDUMP   MACRO    SEG,OFF,CNT,ERRCK
             ERRCHK   CNT,ERRCK
             LOCAL    NONBP
             PUSH     DS
             PUSH     SEL_DATA
             POP      DS
             PUSHFD
             OR       BPON,0
             JZ       NONBP
             DEC      BPON
             JNZ      NONBP
             POPFD
             POP      DS
             BREAKDUMP SEG,OFF,CNT
NONBP:
             POPFD
             POP      DS
             ENDM

; determine linear address of first free byte of memory (to nearest paragraph)
LOADFREE     MACRO    REG,ERRCK
             ERRCHK   REG,ERRCK
             XOR      E®,E®
             MOV      ®,SEG ZZZGROUP
             SHL      E®,4
             ENDM

; Set up PINTFRAME  (uses eax). Loads vmstack & vmdata to the ss:esp and
; ds slots in pintframe  -- default ss:esp=ssint1 -- default ds=userdata
PROT_STARTUP MACRO    VMSTACK,VMDATA,ERRCK
             ERRCHK   X,ERRCK
IFB          <VMSTACK>
             MOV      AX,SEG SSINT1
ELSE
             MOV      AX,SEG VMSTACK
ENDIF
             MOV      PINTFRAME.VMSS,EAX
IFB          <VMSTACK>
             MOV      EAX, OFFSET SSINT1
ELSE
             MOV      EAX, OFFSET VMSTACK
ENDIF
             MOV      PINTFRAME.VMESP,EAX
IFB          <VMDATA>
             MOV      AX,SEG USERDATA
ELSE
             MOV      AX,SEG VMDATA
ENDIF
             MOV      PINTFRAME.VMDS,EAX
             ENDM

; start PROT user segments
PROT_CODE    MACRO    NOPARM
             ERRCHK   X,NOPARM
USERCODE     SEGMENT  PARA PUBLIC 'CODE32' USE32
USERCODEBEG  EQU      $
             ASSUME   CS:USERCODE, DS:USERDATA, ES:DAT32
             ENDM

PROT_DATA    MACRO    NOPARM
             ERRCHK   X,NOPARM
USERDATA     SEGMENT  PARA PUBLIC 'DATA32' USE32
USERDATABEG  EQU      $
             ENDM

PROT_CODE_END MACRO   NOPARM
             ERRCHK   X,NOPARM
USERCODEEND  EQU      $
USERCODE     ENDS
             ENDM

PROT_DATA_END MACRO   NOPARM
             ERRCHK   X,NOPARM
USERDATAEND  EQU      $
USERDATA     ENDS
             ENDM

; Simplfy programs with no data segment
NODATA       MACRO    NOPARM
             ERRCHK   X,NOPARM
             PROT_DATA
             PROT_DATA_END
             ENDM

; Mnemonic for call86 call
VM86CALL     MACRO    NOPARM
             ERRCHK   X,NOPARM
             CALL32F  SEL_CODE32,CALL86
             ENDM

; Mnemonic for dos return
BACK2DOS     MACRO    RC,ERRCK
             ERRCHK   X,ERRCK
IFNB         <RC>
             MOV      AL,RC
ENDIF
             JMPABS32 SEL_CODE16,BACK16
             ENDM

; Variables and macro to create GDT/LDT/IDT entries
C_GDT        =        0
C_LDT        =        0
C_IDT        =        0

; create "next" descriptor with name in table. If no table specified, use GDT
DESC         MACRO    NAME,TABLE,ERRCK
             DQ       0
IFB          <TABLE>
             NAME     = C_GDT
C_GDT        =        C_GDT+8
ELSE
IFIDNI       <TABLE>,<LDT>
; For LDT selectors, set the TI bit to one
             NAME     = C_&TABLE OR 4
ELSE
             NAME     = C_&TABLE
ENDIF
C_&TABLE     =        C_&TABLE+8
ENDIF
             ENDM




[LISTING FOUR]


;********************************************************************
;*                                                                  *
;* PROT - A 386 protected mode DOS extender                         *
;* Copyright (C) 1989, by Al Williams                               *
;* All rights reserved.                                             *
;*                                                                  *
;* Permission is granted for non-commercial use of this software    *
;* subject to certain conditions (see PROT.ASM).                    *
;*                                                                  *
;* This file is: STACKS.INC, which contains all the stack segments. *
;*                                                                  *
;********************************************************************
; 16 bit stack segment (for CODE16)
SSEG         SEGMENT  PARA STACK 'STACK' USE16
SSEG0        DB       DOSSTACK DUP (?)
SSEG1        EQU      $
SSEG         ENDS

; 16 bit stack segment for vm86 int (both hardware & INT 30)
SSINT        SEGMENT  PARA STACK 'STACK' USE16
SSINT0       DB       VM86STACK DUP (?)
SSINT1       EQU      $
SSINT        ENDS

; private stack for default critical error handler dos calls
CSTACK       SEGMENT  PARA STACK 'STACK' USE16
             DB       CRITSTACK DUP (?)
CSTACK       ENDS


; 32 bit stack segment
SS32         SEGMENT  PARA PUBLIC 'STACK' USE32
SSEG32       DB       PMSTACK DUP (?)
SSEG321      EQU      $
SS32         ENDS





[LISTING FIVE]


;********************************************************************
;*                                                                  *
;* PROT - A 386 protected mode DOS extender                         *
;* Copyright (C) 1989, by Al Williams                               *
;* All rights reserved.                                             *
;*                                                                  *
;* Permission is granted for non-commercial use of this software    *
;* subject to certain conditions (see PROT.ASM).                    *
;*                                                                  *
;* This file is: INT386.INC                                         *
;*                                                                  *
;********************************************************************

; Peculiarities
; 1 - We don't emulate lock, IRETD, PUSHFD, POPFD yet
; 2 - When calling INT 25 or INT 26 from protected mode
;     flags are destroyed (not left on stack as in VM86, real mode)
; 3 - For now I don't support adding offsets to the return address
;     on your vm86 stack to change where IRET goes to. That could be
;     fixed, but I don't know of any PC software that does that


; fake segment for far ret interrupts
; (this segment has no descriptor in GDT/LDT)
QISR         SEGMENT  PARA PUBLIC 'CODE16' USE16
             ASSUME   CS:QISR
; push sacrifical words for IRET to eat.
; PL0 stack controls return anyway
QIRET:
             PUSH     0
             PUSH     0
             PUSH     0
             IRET
QISR         ENDS

; IDT segment
IDTABLE      SEGMENT  PARA PUBLIC 'DATA32' USE32
IDTBEG       EQU      $
             DQ       TOPINT+1 DUP (0)
IDTEND       EQU      $
IDTABLE      ENDS


;ISR segment
DEFINT       MACRO    N
INT&N        LABEL    FAR
             PUSH     &N
             JMP      NEAR PTR INTDUMP
             ENDM


ISR          SEGMENT  PARA PUBLIC 'CODE32' USE32
             ASSUME   CS:ISR
ISRBEG       EQU      $
; This code defines interrupt handlers from 0 to TOPINT
; (TOPINT is defined in EQUMAC.INC)
INTNO        =        0
             REPT     TOPINT+1
             DEFINT   %INTNO
INTNO        =        INTNO + 1
             ENDM

; Debug dump messages
MESSAREA     DB       'INT=',0
STKM         DB       'Stack Dump:',0
TASKM        DB       ' TR=',0
RTABLE       DB       'G'
             DB       'F'
             DB       'D'
             DB       'E'
GTABLE       DB       'DISIBPSPBXDXCXAX'
MEMMESS      DB       'Memory Dump:',0

; All interrupts come here
; We check for the interrupt # pushed on the stack and
; vector accordingly. This adds some interrupt latency,
; but simplifies IDT construction.
INTDUMP      LABEL    NEAR
; check for GP error
             CMP      BYTE PTR [ESP],0DH
             JZ       NEAR PTR INT13H
NOT13:
; check for vm86 psuedo-int
             CMP      BYTE PTR [ESP],30H
             JZ       NEAR PTR INT30H
; hardware interrupt?
             CMP      BYTE PTR [ESP],20H
             JB       SHORT NOTIO
IF           ATCLASS
             CMP      BYTE PTR [ESP],2FH
ELSE
             CMP      BYTE PTR [ESP],27H
ENDIF
             JA       SHORT NOTIO
             JMP      NEAR PTR HWINT
NOTIO:
; if we made it here, we have an unexpected interrupt
; so crank out a debug dump and exit to dos
             PUSHAD
             PUSH     GS
             PUSH     FS
             PUSH     DS
             PUSH     ES
             MOV      AX,SEL_VIDEO
             MOV      ES,AX
             MOV      AX,CS
             MOV      DS,AX
; do dump
             MOV      ECX,4
INTL1:
             MOV      AL,[RTABLE-1+ECX]
             CALL32F  SEL_CODE32,OUCH
             MOV      AL,'S'
             CALL32F  SEL_CODE32,OUCH
             MOV      AL,'='
             CALL32F  SEL_CODE32,OUCH
             POP      EAX
             CALL32F  SEL_CODE32,HEXOUT2
             PUSH     ECX
             MOV      ECX,6
LSP1:        MOV      AL,' '
             CALL32F  SEL_CODE32,OUCH
             LOOP     LSP1
             POP      ECX
             LOOP     INTL1
             CALL32F  SEL_CODE32,CRLF
             XOR      ECX,ECX
INTL2:       CMP      CL,5
             JNZ      SHORT NOCRINT
             CALL32F  SEL_CODE32,CRLF
NOCRINT:
             MOV      AL,'E'
             CALL32F  SEL_CODE32,OUCH
             MOV      AL,[GTABLE+ECX*2]
             CALL32F  SEL_CODE32,OUCH
             MOV      AL,[GTABLE+1+ECX*2]
             CALL32F  SEL_CODE32,OUCH
             MOV      AL,'='
             CALL32F  SEL_CODE32,OUCH
             POP      EAX
             CALL32F  SEL_CODE32,HEXOUT4
             MOV      AL,' '
             CALL32F  SEL_CODE32,OUCH
             INC      CL
             CMP      CL,8
             JNE      SHORT INTL2
             MOV      EBX,OFFSET MESSAREA
             CALL32F  SEL_CODE32,MESSOUT
             POP      EAX
             CALL32F  SEL_CODE32,HEXOUT
             MOV      EBX,OFFSET TASKM
             CALL32F  SEL_CODE32,MESSOUT
             STR      AX
             CALL32F  SEL_CODE32,HEXOUT2
             CALL32F  SEL_CODE32,CRLF

; stack dump
             XOR      EAX,EAX
             MOV      AX,SS
             LSL      EDX,EAX
             JNZ      SHORT INTABT
             MOV      EBX,OFFSET STKM
             CALL32F  SEL_CODE32,MESSOUT
             XOR      CL,CL
INTL3:       CMP      ESP,EDX
             JAE      SHORT INTABT
             TEST     CL,7
             JNZ      SHORT NOSCR
             CALL32F  SEL_CODE32,CRLF
NOSCR:       POP      EAX
             CALL32F  SEL_CODE32,HEXOUT4
             INC      CL
             MOV      AL,' '
             CALL32F  SEL_CODE32,OUCH
             JMP      SHORT INTL3

INTABT:
; Check for memory dump request
             MOV      AX,SEL_DATA
             MOV      DS,AX
             ASSUME   DS:DAT32
             MOV      AX,WORD PTR DUMP_SEG
             OR       AX,AX
             JZ       SHORT NOMEMDUMP
; come here to do memory dump
             CALL32F  SEL_CODE32,CRLF
             PUSH     DS
             PUSH     CS
             POP      DS
             MOV      EBX,OFFSET MEMMESS
             CALL32F  SEL_CODE32,MESSOUT
             CALL32F  SEL_CODE32,CRLF
             POP      DS
             MOV      AX,WORD PTR DUMP_SEG
             MOV      ES,AX
             CALL32F  SEL_CODE32,HEXOUT2
             MOV      AL,':'
             CALL32F  SEL_CODE32,OUCH
             MOV      EDX,DUMP_OFF
             MOV      EAX,EDX
             CALL32F  SEL_CODE32,HEXOUT4
             MOV      ECX,DUMP_CNT
DUMPLOOP:
             MOV      AL,' '
             CALL32F  SEL_CODE32,OUCH
             MOV      EAX,ES:[EDX] ; get word
             CALL32F  SEL_CODE32,HEXOUT4
             ADD      EDX,4
             SUB      ECX,4
             JA       SHORT DUMPLOOP
             CALL32F  SEL_CODE32,CRLF
NOMEMDUMP:



             MOV      AL,20H       ; Send EOI signal
IF           ATCLASS
             OUT      0A0H,AL
ENDIF
             OUT      20H,AL       ; just in case hardware did it
             MOV      AL,7FH       ; return 7f to DOS
             BACK2DOS

; Here we check the GP fault
; if the mode isn't VM86 we do a debug dump
; Otherwise we try and emulate an instruction
; If the instruction isn't known, we do a debug dump
INT13H:
             ADD      ESP,4        ; balance stack (remove intno)
             TEST     [ESP+12],20000H
             JZ       SHORT SIM13A ; wasn't a vm86 interrupt!
             ADD      ESP,4        ; remove error code
             PUSH     EAX
             PUSH     EBX
             PUSH     DS
             PUSH     EBP
             MOV      EBP,ESP      ; point to stack frame
             ADD      EBP,10H
             MOV      AX,SEL_DATA0
             MOV      DS,AX
             MOV      EBX,[EBP+4]  ; get cs
             AND      EBX,0FFFFH
             SHL      EBX,4
             ADD      EBX,[EBP]    ; get eip
             XOR      EAX,EAX      ; al = OPCODE byte
                                   ; ah = # of bytes skipped over
                                   ; bit 31 of eax=1 if OPSIZ prefix
                                   ; encountered
             JMP      SHORT INLOOP

; set sign bit of eax if OPSIZ
FSET:        OR       EAX,80000000H
INLOOP:      MOV      AL,[EBX]
             INC      AH
             INC      EBX
             CMP      AL,66H       ; opsize prefix
             JZ       SHORT FSET
; scan for instructions
             CMP      AL,9DH
             JZ       SHORT DOPOPF
             CMP      AL,9CH
             JZ       SHORT DOPUSHF
             CMP      AL,0FAH
             JZ       NEAR PTR DOCLI
             CMP      AL,0FBH
             JZ       NEAR PTR DOSTI
             CMP      AL,0CDH
             JZ       NEAR PTR DOINTNN
             CMP      AL,0CFH
             JZ       NEAR PTR DOIRET
             CMP      AL,0F0H
             JZ       NEAR PTR DOLOCK
; Whoops! What the $#$%$#! is that?
             POP      EBP
             POP      DS
             POP      EBX
             POP      EAX
SIM13:
             PUSH     0            ; simulate error
SIM13A:
             PUSH     13           ; simulate errno
             JMP32S   NOT13

;********************************************************************
; The following routines emulate VM86 instructions. Their conditions
; on entry are:
; eax[31]=1 iff opsiz preceeded instruction
; ah=count to adjust eip on stack
; al=instruction
; [EBX] next opcode byte
; ds: zerobase segment


; This routine emulates a popf
DOPOPF:
             MOV      BX, [EBP]    ; fix IP
             ADD      BL,AH
             ADC      BH,0
             MOV      [EBP],BX
; get ss*10H, add esp fetch top of stack
             MOVZX    EBX,WORD PTR [EBP+10H]
             SHL      EBX,4
             ADD      EBX,[EBP+0CH]
             MOVZX    EAX,WORD PTR [EBX]
             MOV      EBX,[EBP+8]  ; get his real flags
             AND      BX,07000H    ; only preserve NT,IOPL
             AND      AX,08FFFH    ; wipe NT,IOPL in new flags
             OR       EAX,EBX
             MOV      [EBP+8],EAX  ; save his real flag image
             MOV      EBX,2
             ADD      [EBP+0CH],EBX
             MOV      EBX,0FFFEFFFFH
             AND      [EBP+8],EBX
             POP      EBP
             POP      DS
             POP      EBX
             POP      EAX
             IRETD

; Routine to emulate pushf
DOPUSHF:
             MOV      BX, [EBP]    ; Fix ip
             ADD      BL,AH
             ADC      BH,0
             MOV      [EBP],BX
             MOV      EAX,[EBP+8]  ; get his flags
; get ss, add esp and "push" flags
             MOVZX    EBX,WORD PTR [EBP+10H]
             SHL      EBX,4
             ADD      EBX,[EBP+0CH]
             MOV      [EBX-2],AX
             MOV      EBX,2
; adjust stack
             SUB      [EBP+0CH],EBX
; mask out flag bits
             MOV      EBX,0FFFEFFFFH
             AND      [EBP+8],EBX
             POP      EBP
             POP      DS
             POP      EBX
             POP      EAX
             IRETD

; Emulate CLI
DOCLI:
             MOV      BX, [EBP]    ; Fix ip
             ADD      BL,AH
             ADC      BH,0
             MOV      [EBP],BX
             MOV      EAX,[EBP+8]  ; get flags
             OR       EAX,20000H   ; set vm, clr RF & IOPL
             AND      EAX,0FFFECDFFH
             MOV      [EBP+8],EAX  ; replace flags
             POP      EBP
             POP      DS
             POP      EBX
             POP      EAX
             IRETD

; Emulate STI
DOSTI:
             MOV      BX, [EBP]    ; Fix ip
             ADD      BL,AH
             ADC      BH,0
             MOV      [EBP],BX
             MOV      EAX,[EBP+8]  ; get flags
             OR       EAX,20200H   ; set vm, clr RF & IOPL
             AND      EAX,0FFFECFFFH
             MOV      [EBP+8],EAX  ; replace flags
             POP      EBP
             POP      DS
             POP      EBX
             POP      EAX
             IRETD


; This routine emulates an INT nn instruction
DOINTNN:
             PUSH     EDX
             PUSH     ECX
; get ss
             MOVZX    EDX,WORD PTR [EBP+10H]
             SHL      EDX,4
; add esp
             ADD      EDX,[EBP+0CH]
; move flags, qsir address to vm86 stack & correct esp
; ... flags
             MOV      CX, [EBP+08H]
             MOV      [EDX-2],CX
             MOV      WORD PTR [EDX-4],SEG QIRET
             MOV      WORD PTR [EDX-6],OFFSET QIRET
             SUB      DWORD PTR [EBP+0CH],6
             MOV      CX, [EBP]    ; ip
             INC      AH           ; adjust ip by # of bytes to skip
             ADD      CL,AH
             ADC      CH,0
             MOV      [EBP],CX
; get tss alias (always directly above TSS in GDT)
             STR      DX           ; get our task #
             SUB      DX,8         ; alias is one above
             MOV      ES,DX
             MOV      DX,SEL_DATA
             MOV      DS,DX
             ASSUME   DS:DAT32
; get pl0 esp from TSS & push to local stack
             MOV      EDX,INTSP
             SUB      EDX,4
             MOV      INTSP,EDX
             MOV      ECX,ES:[4]   ; esp0
             MOV      [EDX],ECX
; get int vector
             MOV      DX,SEL_DATA0
             MOV      DS,DX
             MOV      ECX,ESP      ; adjust stack for int 30H
             ADD      ECX,60
             MOV      ES:[4],ECX
; test for zero; if so called from int 30H
             OR       AH,AH
             MOVZX    EDX,AL
             JZ       SHORT FROM30
; otherwise get int vector from CS:EIP stream
             MOVZX    EDX,BYTE PTR [EBX]
             MOV      ECX,ESP
             ADD      ECX,24
             MOV      ES:[4],ECX   ; adjust stack for non-int 30H
FROM30:
; interrupt vector*4 = VM86 interrupt vector address
             SHL      EDX,2
; try to clean up mess on stack
             MOV      AX,SEL_DATA
             MOV      DS,AX
             MOV      STO2,EDX
             POP      ECX
             POP      EDX
             XCHG     STO2,EDX
             MOV      STO1,ECX
             MOV      STO3,EBP
             POP      EBP
             XCHG     STO3,EBP
             POP      ECX
             MOV      BX,SEL_DATA
             MOV      DS,BX
             MOV      STO4,ECX
             POP      EBX
             POP      EAX
             MOV      CX,SEL_DATA0
             MOV      DS,CX
; copy segment registers & esp for vm86 int
             PUSH     [EBP+20H]
             PUSH     [EBP+1CH]
             PUSH     [EBP+18H]
             PUSH     [EBP+14H]
             PUSH     [EBP+10H]
             PUSH     [EBP+0CH]
             MOV      ECX,[EBP+08]
; push flags (with vm=1,iopl=0),cs, eip, rf=0
             OR       ECX,20000H
; clear iopl, rf, tf, if and push flags
             AND      ECX,0FFFECCFFH
             PUSH     ECX
; read new cs/ip from 8086 idt
; ... push CS
             MOVZX    ECX,WORD PTR [EDX+2]
             PUSH     ECX
; ... push IP
             MOVZX    ECX,WORD PTR [EDX]
             PUSH     ECX
             MOV      CX,SEL_DATA
             MOV      DS,CX
             PUSH     STO4
             MOV      ECX,STO1
             MOV      EDX,STO2
             MOV      EBP,STO3
             POP      DS
             IRETD                 ; go on to vm86 land

; Emulate IRET instruction
DOIRET:
; vm86 stack
             MOVZX    EAX,WORD PTR[EBP+10H]
             SHL      EAX,4
             ADD      EAX,[EBP+0CH]
             MOV      EBX,[EAX]    ; get cs:ip
; If top of stack=0:0 than a RETF or RETF 2 was detected
             OR       EBX,EBX
             JZ       SHORT FARRETINT
             PUSH     ECX
             XOR      ECX,ECX
; compare return address with QIRET
             MOV      CX, SEG QIRET
             SHL      ECX,16
             MOV      CX,OFFSET QIRET
             CMP      EBX,ECX
             POP      ECX
; if equal than "normal" IRET
             JZ       SHORT NORMIRET

; Not equal then that vm86 jerk is "faking" an IRET to pass control
; We must build a "fake" pl0 frame
; adjust sp
             ADD      DWORD PTR [EBP+0CH],6
; get ip
             MOVZX    EBX,WORD PTR [EAX]
             MOV      [EBP],EBX
; get cs
             MOVZX    EBX,WORD PTR [EAX+2]
             MOV      [EBP+4],EBX
; get new flags
             MOVZX    EBX,WORD PTR [EAX+4]
             OR       EBX,20000H   ; set vm, clr RF & IOPL
             AND      EBX,0FFFECFFFH
             MOV      [EBP+8],EBX
             POP      EBP
             POP      DS
             POP      EBX
             POP      EAX
             IRETD                 ; go on

; this means qiret caught a FAR RET instead of an IRET
; we must preserve our current flags!
FARRETINT:
             MOV      EAX,EBP
             POP      EBP
             POP      DS
             PUSH     EBP
             PUSH     EAX
             MOV      BX,DS
             MOV      AX,SEL_DATA
             MOV      DS,AX
             MOV      STO3,EBX
             POP      EBP          ; ISR's ebp
             MOV      EAX,[EBP+0CH]
             ADD      EAX,6        ; skip pushes from qiret
             MOV      STO4,EAX
; get flags
             MOV      EAX,[EBP+08H]
             MOV      STO2,EAX
             JMP      SHORT NIRET

; This handles the "normal" case
NORMIRET:
             MOV      BX,[EAX+4]   ; get flags
             MOV      EAX,EBP
             POP      EBP
             POP      DS
             PUSH     EBP
             PUSH     EAX
             MOV      AX,BX
             MOV      BX,DS
             PUSH     SEL_DATA
             POP      DS
             MOV      STO2,EAX
             MOV      STO3,EBX
             POP      EBP          ; ISR's ebp
             XOR      EAX,EAX
             MOV      STO4,EAX
NIRET:
             PUSH     ESI
             XOR      ESI,ESI
             OR       DWORD PTR [EBP+28H],0
; if CS=0 then int 30H asked  for segment save
             JNZ      SHORT V86IRET
             MOV      EAX,[EBP+14H]
             MOV      SAV_ES,EAX
             MOV      EAX,[EBP+18H]
             MOV      SAV_DS,EAX
             MOV      EAX,[EBP+1CH]
             MOV      SAV_FS,EAX
             MOV      EAX,[EBP+20H]
             MOV      SAV_GS,EAX
             MOV      ESI,8

V86IRET:
             MOV      AX,ES
             MOV      STO1,EAX
             POP      EBP
             XCHG     EBP,[ESP]
; get tss alias
             STR      AX
             SUB      AX,8
             MOV      ES,AX
             ASSUME   DS:DAT32
             MOV      EAX,ES:[4]   ; get our current stack begin
; see if we have to balance the VM86 stack
             TEST     SS:[EAX+ESI+8],20000H
             JZ       SHORT STKADJD
             MOV      EBX,STO4
             OR       EBX,EBX
             JZ       SHORT ADJSTK
; balance vm86 stack
             MOV      SS:[EAX+ESI+0CH], EBX
             JMP      SHORT STKADJD
ADJSTK:      ADD      DWORD PTR SS:[EAX+ESI+0CH],6
STKADJD:
; get quasi flags
             MOV      EBX,STO2
; get real flags
             PUSH     SS:[EAX+ESI+8]
; preserve flags
             MOV      DWORD PTR SS:[EAX+ESI+8],EBX
LEAVEFLAGS:
; only let 8086 part of flags stay
             AND      DWORD PTR SS:[EAX+ESI+08],01FFFH
             POP      EBX          ; load real flags into ebx
; save 386 portion of old flags (AND IP)
             AND      EBX,0FFFFE200H
             OR       SS:[EAX+ESI+8],EBX
             POP      ESI
             XCHG     EAX,[ESP]
             PUSH     EAX          ; stack = ebx, new sp
             MOV      EBX,INTSP
; get prior pl0 esp from local stack
             MOV      EAX,[EBX]
             ADD      EBX,4
             MOV      INTSP,EBX
             MOV      ES:[4],EAX   ; restore to TSS
; restore registers
             POP      EBX
             MOV      ES,WORD PTR STO1
             MOV      DS,WORD PTR STO3
             POP      EAX          ; restore "real" eax
             XCHG     EAX,[ESP]
             POP      ESP          ; set up new top stack
             XCHG     EAX,[ESP+4]
             OR       EAX,EAX      ; test cs
             XCHG     EAX,[ESP+4]
             JNZ      SHORT GOIRET
             ADD      ESP,8        ; skip fake CS/IP from INT 30H
GOIRET:
; reset resume flag
             AND      DWORD PTR [ESP+8],0FFFECFFFH
             IRETD




; Emulate lock prefix
DOLOCK:

             POP      EBP
             POP      DS
             POP      EBX
             POP      EAX
             PUSH     0FFFFH
             PUSH     13           ; simulate errno
             JMP32S   NOT13


; This is the interface routine to allow a protected mode
; program call VM86 interrupts.
; Call with es:ebx pointing to a parameter block
; +00 flag - if 1 then resave ES, DS, FS & GS
;            into parameter block after call
; +04 int number (0-255)   (required)
; +08 eflags
; +12 vm86 esp    (required)
; +16 vm86 ss     (required)
; +20 vm86 es
; +24 vm86 ds
; +28 vm86 fs
; +32 vm86 gs
; +36 vm86 ebp  ( to replace that used in call )
; +40 vm86 ebx  ( to replace that used in call )
;
; all other registers will be passed to vm86 routine
;
; This routine depends on the dointnn routine

INT30H:
             ADD      ESP,4        ; remove intno
             CMP      BYTE PTR ES:[EBX],0
             JZ       SHORT NOSEGSAV
; dummy CS/IP to signal IRET to save segments
             PUSH     0
             PUSH     0
NOSEGSAV:
             PUSH     ES:[EBX+32]  ; stack up registers
             PUSH     ES:[EBX+28]
             PUSH     ES:[EBX+24]
             PUSH     ES:[EBX+20]
             PUSH     ES:[EBX+16]
             PUSH     ES:[EBX+12]
; force VM86=1 in EFLAGS
             XCHG     EAX,ES:[EBX+8]
             OR       EAX,20000H
             AND      EAX,0FFFECFFFH
             PUSH     EAX
             XCHG     EAX,ES:[EBX+8]
             PUSH     0            ; don't care cs
             PUSH     0            ; don't care eip
             MOV      EBP,ESP
             PUSH     EAX
             PUSH     ES:[EBX+40]  ; vm86 ebx
             PUSH     DS
             PUSH     ES:[EBX+36]  ; vm86 ebp
             MOV      AX,SEL_DATA0
             MOV      DS,AX
; get user's intno
             MOV      AL,ES:[EBX+4]
; set flag to dointnn not to check cs:ip for int #
             MOV      AH,0FFH
; go ahead.... make my interrupt
             JMP32S   DOINTNN

; handle hardware int!
; This routine uses INT 30 to handle HW interrupts
; If interrupted in protected mode, a special stack
; is used. If in VM86 mode, the current VM86 stack is used
HWINT:
             XCHG     EAX,[ESP]    ; swap eax & int #
             PUSH     DS
             PUSH     ES
             PUSH     EBX
             MOV      BX,SEL_DATA
             MOV      DS,BX
             MOV      ES,BX
             CMP      EAX,28H
             JB       SHORT IRQ07
             ADD      EAX,48H      ; vector IRQ8-F to INT 70-77
             JMP      SHORT IRQSET
IRQ07:
             SUB      EAX,24       ; vector IRQ0-7 to INT 8-0F
IRQSET:
; set up special interrupt frame
             MOV      HINTFRAME.VMINT,EAX
             MOV      HINTFRAME.VMEBP,EBP
             POP      EBX
             MOV      HINTFRAME.VMEBX,EBX
             PUSH     EBX
             MOV      EAX,020000H  ; model flags
             MOV      HINTFRAME.VMFLAGS,EAX
             MOV      EAX,OFFSET SSINT1
             MOV      HINTFRAME.VMESP,EAX
             MOV      AX,SEG SSINT1
             MOV      HINTFRAME.VMSS,EAX
             MOV      EAX,[ESP+24] ; get flags
             TEST     EAX,20000H   ; check vm
             JZ       SHORT NOTVMHW
             MOV      EAX,[ESP+28] ; get vm86's esp
             MOV      HINTFRAME.VMESP,EAX
             MOV      EAX,[ESP+32]
             MOV      HINTFRAME.VMSS,EAX
NOTVMHW:
             MOV      EBX,OFFSET HINTFRAME
             PUSH     FS
             PUSH     GS
             INT      30H          ; Do interrupt
             POP      GS
             POP      FS
             POP      EBX
             POP      ES
             POP      DS
             POP      EAX
             IRETD

ISREND       EQU      $
ISR          ENDS






[LISTING SIX]


;********************************************************************
;*                                                                  *
;* PROT - A 386 protected mode DOS extender                         *
;* Copyright (C) 1989, by Al Williams                               *
;* All rights reserved.                                             *
;*                                                                  *
;* Permission is granted for non-commercial use of this software    *
;* subject to certain conditions (see PROT.ASM).                    *
;*                                                                  *
;* This file is: TSS.INC, the Task State Segment definitions.       *
;*                                                                  *
;********************************************************************
; define TSS structure
; for more details refer to the Intel documentation
; remember, the defined values are only defaults, and
; can be changed when a value is defined
TSSBLK       STRUC
BLINK        DD       0
ESPP0        DD       OFFSET SSEG321
SSP0         DD       SEL_STACK
ESPP1        DD       0
SSP1         DD       SEL_STACK
ESPP2        DD       0
SSP2         DD       SEL_STACK
CR31         DD       0
EIP1         DD       OFFSET USER
EF1          DD       200H
EAX1         DD       0
ECX1         DD       0
EDX1         DD       0
EBX1         DD       0
ESP1         DD       OFFSET SSEG321
EBP1         DD       0
ESI1         DD       0
EDI1         DD       0
ES1          DD       SEL_DATA
CS1          DD       SEL_UCODE
SS1          DD       SEL_STACK
DS1          DD       SEL_UDATA
FS1          DD       SEL_DATA0
GS1          DD       SEL_VIDEO
LDT1         DD       0
             DW       0
IOT          DW       $+2-OFFSET BLINK
IOP          DB       8192 DUP (0)
             DB       0FFH
TSSBLK       ENDS


TSSSEG       SEGMENT  PARA PUBLIC 'DATA32' USE16
             ORG      0
; Dummy TSS that stores the original machine state
TSS0BEG      TSSBLK   <>
TSS0END      EQU      $

; TSS to run the USER task
TSS1BEG      TSSBLK   <>
TSS1END      EQU      $

TSSSEG       ENDS





[LISTING SEVEN]


;********************************************************************
;*                                                                  *
;* PROT - A 386 protected mode DOS extender                         *
;* Copyright (C) 1989, by Al Williams                               *
;* All rights reserved.                                             *
;*                                                                  *
;* Permission is granted for non-commercial use of this software    *
;* subject to certain conditions (see PROT.ASM).                    *
;*                                                                  *
;* This file is: CODE16.INC, the 16 bit DOS entry/exit code.        *
;*                                                                  *
;********************************************************************

CSEG         SEGMENT  PARA PUBLIC 'CODE16' USE16
             ASSUME   CS:CSEG, DS:CSEG
BEG16        EQU      $
IDTSAV       DF       0            ; space to save old real mode IDT
XZRO         DF       0            ; Zero constant for inhibiting IDT

TEMP         EQU      THIS FWORD   ; Space to load GDT
TLIM         DW       (GDTEND-GDT)-1
TEMD         DD       0

; area to save stack pointer
SOFFSAV      DW       0
SSEGSAV      DW       0

; old keyboard interrupt vector -- we have to catch reboot requests
KEYCHAIN     EQU      THIS DWORD
KEYOFF       DW       ?
KEYSEG       DW       ?

INTM         DB       0            ; interrupt mask - pic 1
IF           ATCLASS
INTMAT       DB       0            ; interrupt mask - pic 2 (AT ONLY)
ENDIF

;psp
PSP          DW       0

; error messages
NOT386M      DB       'Error: this program requires an 80386 or 80486'
             DB       ' processor.',13,10,'$'
VM86M        DB       'Error: this program will not execute '
             DB       'in VM86 mode.'
             DB       13,10,'$'

; 16 bit ss/sp for return to real mode
LOAD16       DD       OFFSET SSEG1-1
             DW       SEL_RDATA

;****** Begin program
ENTRY        LABEL    FAR
START        PROC     NEAR
             PUSH     CS           ; set up DS segment, save PSP
             POP      DS
             MOV      AX,ES
             MOV      PSP,AX       ; save PSP
             MOV      BX,DAT32
             MOV      ES,BX
             MOV      ES:_PSP,AX
; check to see if we are running on a 386/486
             XOR      AX,AX
             PUSH     AX
             POPF
             PUSHF
             POP      AX
             AND      AX,0F000H
             CMP      AX,0F000H
             JNZ      SHORT NOT86
NOT386:
             MOV      DX, OFFSET NOT386M
NOT386EXIT:
             MOV      AH,9
             INT      21H
             MOV      AX,4C80H
             INT      21H          ; exit
NOT86:
             MOV      AX,0F000H
             PUSH     AX
             POPF
             PUSHF
             POP      AX
             AND      AX,0F000H
             JZ       SHORT NOT386
; If we got here we are on an 80386.
; Check PM flag
             SMSW     AX
             AND      AX,1         ; are we in protected mode?
             MOV      DX,OFFSET VM86M
             JNZ      SHORT NOT386EXIT
; OK.. we are clear to proceed

; Set up new ^C, keyboard and Critical error handlers
             MOV      AX,3509H
             INT      21H
             MOV      AX,ES
             MOV      KEYSEG,AX
             MOV      KEYOFF,BX
             MOV      AX,2509H
             MOV      DX,OFFSET REBOOT
             INT      21H
             MOV      AX,2523H
             MOV      DX,OFFSET CTRLC
             INT      21H
             MOV      AX,2524H
             MOV      DX,OFFSET CRITERR
             INT      21H
; * Create segments
             PUSH     GDTSEG
             POP      ES
             MOV      EDX, OFFSET GDT
             MOV      EBX,CS
             SHL      EBX,4        ; calc segment base address
             MOV      ECX,0FFFFH   ; 64 K limit (don't change)
             MOV      AH,ER_CODE   ; read/exec code seg
             XOR      AL,AL        ; size
             PUSH     GDTSEG
             POP      ES
             MOV      EDX, OFFSET GDT
             MOV      SI,SEL_CODE16
             CALL     MAKE_DESC    ; make code seg (16 bit/real)
             MOV      ECX,0FFFFFH
             XOR      EBX,EBX
             MOV      SI,SEL_DATA0
             XOR      ECX,ECX
             DEC      ECX          ; ecx=ffffffff
             MOV      AL,1
             MOV      AH,RW_DATA
             CALL     MAKE_DESC    ; make data  ( 4G @ zero base )
             XOR      EAX,EAX
             INT      12H
             MOVZX    ECX,AX
             SHL      ECX,10
             LOADFREE BX           ; get free memory segment
             SUB      ECX,EBX
             DEC      ECX
             MOV      SI,SEL_FREE
             MOV      AL,1
             MOV      AH,RW_DATA
             CALL     MAKE_DESC
             XOR      EAX,EAX
             MOV      AH,88H       ; get top of extended memory
             INT      15H
             SHL      EAX,10       ; * 1024
             OR       EAX,EAX      ; any extended present?
             MOV      ECX,EAX
             JNZ      SHORT EXTPRES
             MOV      ECX,1
EXTPRES:
             DEC      ECX
             MOV      EBX,100000H
             MOV      SI,SEL_EXT   ; 0 limit segment if no ext.
             MOV      AL,1
             MOV      AH,RW_DATA
             CALL     MAKE_DESC
             XOR      EBX,EBX
             MOV      BX,SEG SEG32ENT
             SHL      EBX,4
             MOV      ECX,(SEG32END-SEG32BEG)-1
             MOV      AH,ER_CODE
             MOV      AL,1
             MOV      SI,SEL_CODE32
             CALL     MAKE_DESC    ; 32 bit code segment
             XOR      EBX,EBX
             MOV      BX,USERCODE
             SHL      EBX,4
             MOV      ECX,(USERCODEEND-USERCODEBEG)-1
             MOV      AH,ER_CODE
             MOV      AL,1
             MOV      SI,SEL_UCODE
             CALL     MAKE_DESC
             XOR      EBX,EBX
             MOV      BX,USERDATA
             SHL      EBX,4
             MOV      ECX,(USERDATAEND-USERDATABEG)-1
             MOV      AH,RW_DATA
             MOV      AL,1
             MOV      SI,SEL_UDATA
             CALL     MAKE_DESC
             XOR      EBX,EBX
             MOV      BX,SS32
             SHL      EBX,4        ; always para align stacks!
             MOV      ECX,(SSEG321-SSEG32)-1
             MOV      AH,RW_DATA   ; stack seg is data type
             MOV      AL,1
             MOV      SI,SEL_STACK
             CALL     MAKE_DESC
             XOR      EBX,EBX
             MOV      BX, SSEG
             SHL      EBX,4
             MOV      ECX,0FFFFH   ; real mode limit (don't change)
             XOR      AL,AL
             MOV      AH,RW_DATA
             MOV      SI,SEL_RDATA
             CALL     MAKE_DESC    ; 16 bit data for return to r/m
             XOR      EBX,EBX
             MOV      BX,SEG GDT
             SHL      EBX,4
             ADD      EBX,OFFSET GDT
             MOV      ECX,(GDTEND-GDT)-1
             MOV      AL,1
             MOV      AH,RW_DATA
             MOV      SI,SEL_GDT
             CALL     MAKE_DESC
             MOV      AX,500H      ; set video to page 0
             INT      10H
             MOV      AH,0FH
             INT      10H          ; get mode
             MOV      EBX,0B0000H  ; monochrome
             CMP      AL,7         ; check for mono
             JZ       SHORT VIDEOCONT
             MOV      EBX,0B8000H
VIDEOCONT:
             MOV      ECX,3999     ; limit for text page
             MOV      AL,1
             MOV      AH,RW_DATA
             MOV      SI,SEL_VIDEO
             CALL     MAKE_DESC    ; make video segment
             XOR      EBX,EBX
             MOV      BX,DAT32
             SHL      EBX,4
             MOV      ECX,(DAT32END-DAT32BEG)-1
             MOV      AH,RW_DATA
             MOV      AL,1
             MOV      SI,SEL_DATA
             CALL     MAKE_DESC
             XOR      EBX,EBX
             MOV      BX,IDTABLE
             SHL      EBX,4
             MOV      ECX,(IDTEND-IDTBEG)-1
             MOV      AH,RW_DATA
             MOV      AL,1
             MOV      SI,SEL_IDT
             CALL     MAKE_DESC
             XOR      EBX,EBX
             MOV      BX,ISR
             SHL      EBX,4
             MOV      ECX,(ISREND-ISRBEG)-1
             MOV      AH,ER_CODE
             MOV      AL,1
             MOV      SI,SEL_ICODE
             CALL     MAKE_DESC
             XOR      EBX,EBX
             MOV      BX,TSSSEG
             SHL      EBX,4
; compute TSS length
             MOV      ECX,(TSS0END-TSS0BEG)-1
             MOV      AH,RW_DATA
             MOV      AL,1
             MOV      SI,SEL_TSS0
             CALL     MAKE_DESC
             MOV      AH,TSS_DESC
             MOV      SI,TSS0
             CALL     MAKE_DESC
             ADD      EBX,OFFSET TSS1BEG
             MOV      SI,TSS1
; compute TSS length
             MOV      ECX,(TSS1END-TSS1BEG)-1
             CALL     MAKE_DESC
             MOV      SI,SEL_TSS1
             MOV      AH,RW_DATA
             CALL     MAKE_DESC
             MOVZX    EBX,PSP
             SHL      EBX,4
             MOV      ECX,255
             MOV      AH,RW_DATA
             MOV      AL,1
             MOV      SI,SEL_PSP
             CALL     MAKE_DESC
             PUSH     ES
             MOV      AX,PSP
             MOV      ES,AX
             XOR      EBX,EBX
             MOV      BX,ES:[2CH]
             MOV      AX,BX
             SHL      EBX,4
             DEC      AX
             MOV      ES,AX
             XOR      ECX,ECX
             MOV      CX,ES:[3]
             SHL      ECX,4
             DEC      ECX          ; get limit
             MOV      SI,SEL_ENV
             POP      ES
             MOV      AL,1
             MOV      AH,RW_DATA
             CALL     MAKE_DESC    ; make envrioment segment

; turn on A20
             MOV      AL,1
             CALL     SETA20
             CLI                   ; no interrupts until prot mode
             MOV      SSEGSAV,SS
; save sp for triumphant return to r/m
             MOV      SOFFSAV,SP
             SIDT     IDTSAV
             LIDT     XZRO         ; save and load IDT
             XOR      EBX,EBX
             MOV      BX,SEG GDT
             SHL      EBX,4
             ADD      EBX,OFFSET GDT
             MOV      TEMD,EBX
             LGDT     TEMP         ; set up GDT
             MOV      EAX,CR0
             OR       EAX,1        ; switch to prot mode!
             MOV      CR0,EAX
; jump to load CS and flush prefetch
             JMPABS   SEL_CODE16,PROT1

PROT1:
             OPSIZ
             JMPABS32 SEL_CODE32,SEG32ENT



; Jump here to return to real mode DOS.
; If desired AL can be set to a DOS exit code
BACK16       LABEL    FAR
             MOV      BL,AL        ; save exit code
             CLI
             XOR      EAX,EAX
             MOV      DR7,EAX      ; turn off debug (just in case)
; restore stack
             LSS      ESP,FWORD PTR CS:LOAD16
             MOV      AX,SEL_RDATA
             MOV      DS,AX
             MOV      ES,AX
             MOV      FS,AX
             MOV      GS,AX
             MOV      EAX,CR0
; return to real mode
             AND      EAX,07FFFFFF2H
             MOV      CR0,EAX
; jump to load CS and clear prefetch
             JMPABS   CSEG,NEXTREAL
NEXTREAL     LABEL    FAR
             MOV      AX,CS
             MOV      DS,AX
             LIDT     IDTSAV       ; restore old IDT 0(3ff)
             IN       AL,21H
             MOV      INTM,AL
; reprogram PIC's
IF           ATCLASS
             IN       AL,0A1H
             MOV      INTMAT,AL
             MOV      AL,11H
             OUT      0A0H,AL
             OUT      20H,AL
             IDELAY
             MOV      AL,70H
             OUT      0A1H,AL
             MOV      AL,8
             OUT      21H,AL
             IDELAY
             MOV      AL,2
             OUT      0A1H,AL
             MOV      AL,4
             OUT      21H,AL
             IDELAY
             MOV      AL,1
             OUT      0A1H,AL
             OUT      21H,AL
             IDELAY
             MOV      AL,INTMAT
             OUT      0A1H,AL
             MOV      AL,INTM
             OUT      21H,AL

ELSE

             MOV      AL,13H
             OUT      20H,AL
             MOV      AL,8
             OUT      21H,AL
             INC      AL
             OUT      21H,AL
             MOV      AL,INTM
             OUT      21H,AL
ENDIF
; clean up to go back to DOS
             LSS      SP,DWORD PTR SOFFSAV
             STI                   ; resume interupt handling
; turn a20 back off
             XOR      AL,AL
             CALL     SETA20
; restore keyboard interrupt
             MOV      DX,KEYOFF
             MOV      AX,KEYSEG
             PUSH     DS
             MOV      DS,AX
             MOV      AX,2509H
             INT      21H
             POP      DS
             MOV      AH,4CH       ; blow this joint!
             MOV      AL,BL        ; get return code
             INT      21H          ; return to the planet of MSDOS
START        ENDP


; Routine to control A20 line
; AL=1 to turn A20 on (enable)
; AL=0 to turn A20 off (disable)
; returns ZF=1 if error; AX destroyed
IF           ATCLASS
SETA20       PROC     NEAR
             PUSH     CX
             MOV      AH,0DFH      ; A20 On
             OR       AL,AL
             JNZ      SHORT A20WAIT1
             MOV      AH,0DDH      ; A20 Off
A20WAIT1:
             CALL     KEYWAIT
             JZ       SHORT A20ERR
             MOV      AL,0D1H
             OUT      64H,AL
             CALL     KEYWAIT
             MOV      AL,AH
             OUT      60H,AL
             CALL     KEYWAIT
             JZ       SHORT A20ERR
             MOV      AL,0FFH
             OUT      64H,AL
             CALL     KEYWAIT
A20ERR:      POP      CX
             RET
SETA20       ENDP

; Wait for keyboard controller ready. Returns ZF=1 if timeout
; destroys CX and AL
KEYWAIT      PROC     NEAR
             XOR      CX,CX        ; maximum time out
KWAITLP:
             DEC      CX
             JZ       SHORT KEYEXIT
             IN       AL,64H
             AND      AL,2
             JNZ      KWAITLP
KEYEXIT:     OR       CX,CX
             RET
KEYWAIT      ENDP

ELSE
; INBOARD PC Code for A20
SETA20       PROC     NEAR
             OR       AL,AL
             MOV      AL,0DFH
             JNZ      A20SET
             MOV      AL,0DDH
A20SET:      OUT      60H,AL
             OR       AL,AL        ; make sure ZF is set for
             RET                   ; compatibilty with AT routines
SETA20       ENDP
ENDIF


; This routine makes a descriptor
; ebx=base
; ecx=limit in bytes
; es:edx=GDT address
; al= size (0=16bit 1=32bit)
; ah=AR byte
; SI=descriptor (TI & DPL not important!)
; Auto sets and calculates G and limit
MAKE_DESC    PROC     NEAR
             PUSHAD
             MOVZX    ESI,SI
             SHR      SI,3         ; adjust to slot #
             SHL      AL,6         ; shift size to right bit position
             CMP      ECX,0FFFFFH  ; see if you need to set G bit
             JBE      SHORT OKLIMR
             SHR      ECX,12       ; div by 4096
             OR       AL,80H       ; set G bit
OKLIMR:      MOV      ES:[EDX+ESI*8],CX
             SHR      ECX,16
             OR       CL,AL
             MOV      ES:[EDX+ESI*8+6],CL
             MOV      ES:[EDX+ESI*8+2],BX
             SHR      EBX,16
             MOV      ES:[EDX+ESI*8+4],BL
             MOV      ES:[EDX+ESI*8+5],AH
             MOV      ES:[EDX+ESI*8+7],BH
             POPAD
             RET
MAKE_DESC    ENDP

; This is the routine that disables ^C interrupts
; You could place your own code here if desired
; NOTE: THIS IS VM86 CODE!
CTRLC        PROC     FAR
             PUSH     DS
             PUSH     AX
             MOV      AX,DAT32
             MOV      DS,AX
             ASSUME   DS:DAT32
             MOV      AL,1
             MOV      BREAKKEY,AL  ; set flag
             POP      AX
             POP      DS
             IRET
CTRLC        ENDP

; Reboot handler (VM86 code)
REBOOT       PROC     FAR
             STI
             PUSH     AX
             IN       AL,60H
             CMP      AL,53H       ; delete key?
             JNZ      SHORT NOREBOOT
             XOR      AX,AX
             PUSH     DS
             MOV      DS,AX
             MOV      AL,DS:[417H] ; get shift status
             POP      DS
             TEST     AL,8         ; check for cntl/alt
             JZ       SHORT NOREBOOT
             TEST     AL,4
             JZ       SHORT NOREBOOT
; If detected a ^ALT-DEL then eat it and return
             IN       AL,61H
             MOV      AH,AL
             OR       AL,80H
             OUT      61H,AL
             MOV      AL,AH
             OUT      61H,AL
             MOV      AL,20H
             OUT      20H,AL
             POP      AX
             IRET
; not a ^ALT-DEL, resume normal keyboard handler
NOREBOOT:    POP      AX
             JMP      CS:[KEYCHAIN]
REBOOT       ENDP

; Critical error handler (always fail/ignore)
CRITERR      PROC     FAR
             PUSH     DS
             PUSH     DAT32
             POP      DS
             ASSUME   DS:DAT32
             MOV      CRITAX,AX
             MOV      AL,1
             MOV      CRITICAL,AL
             MOV      CRITDI,DI
             MOV      CRITBP,BP
             MOV      CRITSI,SI
IF           DOS      LT 3
             XOR      AL,AL
ELSE
             MOV      AL,3
ENDIF
             POP      DS
             IRET
CRITERR      ENDP

LAST16       EQU      $
CSEG         ENDS



[Example 1: A simple PROT program.]


File: USER.INC
; SET UP EMPTY DATA SEGMENT
          NODATA

; SET UP CODE SEGMENT - PROGRAM RETURNS TO DOS
          PROT_CODE
USER      PROC NEAR
          BACK2DOS
USER      ENDP
          PROT_CODE_END



[Example 2: DOS and PROT code fragments to print a message using
DOS service 9.]


Real Mode Program
REALPGM   PROC
          MOV AX,SEG STACKAREA
          MOV SS,AX
          MOV SP,OFFSET STACKAREA        ; SET UP STACK
          MOV AX,SEG DATSEG
          MOV DS,AX                      ; SET UP DATA SEGMENT
          MOV DX,OFFSET MESSAGE          ; LOAD POINTER TO MESSAGE
          MOV AH,9
          INT 21H                        ; PRINT MESSAGE
          MOV AH,4CH
          INT 21H                        ; RETURN TO DOS
REALPGM   ENDP



PROT Equivalent
USER      PROC
          PROT_STARTUP                   ; SET UP STACK/DS
          MOV AX,21H
          MOV PINTFRAME.VMINT,EAX
          MOV EDX,OFFSET MESSAGE         ; LOAD POINTER TO MESSAGE
          MOV AH,9
          MOV EBX,OFFSET PINTFRAME
          VM86CALL                       ; PRINT MESSAGE
          BACK2DOS                       ; RETURN TO DOS
USER      ENDP




[Example 3: Maintaining the caller's flags on  the  stack  when
returning in protected mode.]

MOV EAX,25H
     MOV PINTFRAME.VMINT,EAX
     PUSHF                     ; (Or PUSHFD)
     VM86CALL                  ; Call INT 25 or 26
       .
       .



[Example 4: 32-bit offset generation problems]

 .386P
 SEGMENT   EXAMPLE PARA 'CODE32' USE32
          .
 BACKWARD:
          .
          .
          .
          CMP EBX,EAX
          JA FORWARD           ; This jump is OK
          JB BACKWARD          ; This jump is improperly assembled
          .
          .
          .
FORWARD:


[Example 5: QISR code for the VM86 mode segment
qisr segment para 'CODE16' use16]

          assume cs:qisr
     qiret:
          push 0
          push 0
          push 0
          iret
     qisr ends


[Figure 1: Parameter block for call86 routine.]

Address                                   Member name

BLOCK+0        |------------------------------------|    VMSEGFLAG
               | Segment register flag (see text)   |
BLOCK+4        |------------------------------------|    VMINT
               | Interrupt number                   |
BLOCK+8        |------------------------------------|    VMFLAGS
               | EFLAGS                             |
BLOCK+12       |------------------------------------|    VMESP
               | ESP                                |
BLOCK+16       |------------------------------------|    VMSS
               | SS                                 |
BLOCK+20       |------------------------------------|    VMES
               | ES                                 |
BLOCK+24       |------------------------------------|    VMDS
               | DS                                 |
BLOCK+28       |------------------------------------|    VMFS
               | FS                                 |
BLOCK+32       |------------------------------------|    VMGS
               | GS                                 |
BLOCK+36       |------------------------------------|    VMEBP
               | EBP                                |
BLOCK+40       |------------------------------------|    VMEBX
               | EBX                                |
               |------------------------------------|



[Figure 2: Batch file used to compile a PROT program]

echo off
if X%1==X goto :errexit
if NOT X%2==X goto :errexit
masm /DPROGRAM=%1 PROT.ASM,%1.OBJ,%1.LST;
if ERRORLEVEL 1 goto :exit
link %1;
goto :exit
:errexit
echo PMASM - An MASM driver for the PROT 386 DOS Extender
echo usage: PMASM progname
echo        Assembles the file progname.pm into progname.exe
echo        The PROT system is copyright (C), 1989 by Al Williams.
echo        Please see the file "PROT.ASM" for more details.
:exit



[Figure 3: PROT interrupt/breakpoint display]

ES=0040      DS=0090      FS=0010      GS=0038
EDI=00000000 ESI=00000000 EBP=00000000 ESP=00000FF0 EBX=00000000
EDX=00000000 ECX=00000000 EAX=00000000 INT=03 TR=0070
Stack Dump:
0000002B 00000088 00000202




[Figure 4: Problem cases associated with software interrupts]


Case 1: Normal INT/IRET
            ...

          INT 10H         ; perform interrupt

            ...
     ISR:                 ; Interrupt 10H service routine
            ...
          IRET


Case 2: INT/RETF 2
            ...

          INT 10H         ; perform interrupt
            ...
     ISR:                 ; Interrupt 10H service routine
            ...

          RETF 2


Case 3: INT/RETF (only used by INT 25H and 26H)
            ...

          INT 10H         ; perform interrupt
            ...
     ISR:                 ; Interrupt 10H service routine
            ...

          RETF


Case 4: PUSHF/FAR CALL
            ...

          PUSHF           ; simulate interrupt
          CALL FAR ISR
            ...

     ISR:                 ;Interrupt 10H service routine
            ...

          IRET


Case 5: PUSHF/PUSH ADDRESS/IRET

             ...

          PUSHF           ; Jump to address TARGET
          PUSH SEG TARGET
          PUSH OFFSET TARGET
          IRET
            ...
     TARGET:              ; Destination of IRET
            ...

 -or-

          PUSHF           ; Simulate interrupt
          PUSH SEG RETAD
          PUSH OFFSET RETAD
          JMP FAR ISR
     RETAD:
            ...

     ISR:                 ; Interrupt routine
            ...

          IRET











Terms of Service | Privacy Statement | Copyright © 2024 UBM Tech, All rights reserved.