-- FILE:     DOSERROR.E
-- PURPOSE:  Critical-error handler routines for Euphoria 3.1.1.
-- AUTHOR:   Shian Lee
-- CREDIT:   Euphoria 3.1.1, demo\dos32\hardint.ex
-- VERSION:  1.01  February/9/2022
-- LANGUAGE: Euphoria version 3.1.1 (www.RapidEuphoria.com)
-- PLATFORM: DOS32  
-- LICENCE:  Free. Use at your own risk.
-- NOTE:     * critical-error handler interrupt vector, Int #24, prompts the
--             user for "Abort, Retry, Ignore, Fail?" on many unrecoverable 
--             hardware faults such as 'Drive not ready', 'Seek error', 
--             'Printer out of paper', 'General failure', etc.
--             - "Fail" used here is supported on MS-DOS 3.1 or later only.
--           * critical-errors are trapped in either real or protected mode.
--           * drive-map functions are supported on MS-DOS 3.2 or later.
--           * See the attached reference manual FILE2.DOC for details.
--           * Created using EDU 3.07 (www.RapidEuphoria311.com).
-- HISTORY:  v1.00 - initial version (February/3/2022).
--           v1.01 - set_drive_map() returns correct value on Win-XP
-----------------------------------------------------------------------------



--bookmark: include Euphoria 3.1.1 library files;
include misc.e      
include machine.e
include wildcard.e  -- upper()



--bookmark: Locals;
constant FALSE = 0, 
	 TRUE = 1, 
	 OS_DOS32 = (platform() = DOS32)


type boolean(integer b)
    return b = FALSE or b = TRUE
end type


-- PURPOSE: test if i is a drive letter
type drive(integer i)
    return (i >= 'A' and i <= 'Z') or
	   (i >= 'a' and i <= 'z')
end type



--bookmark: Critical-error Local Routines;

-- PURPOSE: get Euphoria segment addresses
-- NOTE:    useful for *any* interrupt handler (demo\dos32\hardint.ex)
-- RETURN:  sequence; {code segment, data segment} 16-bit addresses
function euphoria_segments()
    atom save, seg_ad
    sequence mach
    integer code_ad, data_ad
    
    if not OS_DOS32 then
	return {0, 0}
    end if

    -- machine code for saving code and data segments addresses
    seg_ad = allocate(4)
    lock_memory(seg_ad, 4)
    
    mach = {
	#53,    -- push ebx
	#0E,    -- push cs (or #1E, -- push ds) -- 16-bit value only
	#5B,    -- pop ebx
	#89, #1D} & int_to_bytes(seg_ad) & -- mov seg_ad, ebx
	{#5B,   -- pop ebx  -- (there's no "pop cs" instruction)
	#C3     -- ret  
    }           
    
    save = allocate(length(mach))

    -- get code segment 16-bit address
    poke(save, mach)    -- (push cs)
    call(save)          
    code_ad = and_bits(peek4u(seg_ad), #FFFF)
    
    -- get data segment 16-bit address
    poke(save + 1, #1E) -- (push ds)
    call(save)
    data_ad = and_bits(peek4u(seg_ad), #FFFF)
    
    free(seg_ad)
    free(save)
    return {code_ad, data_ad}
end function

constant EU_CODE_DATA_SEG = euphoria_segments()



-- PURPOSE: Euphoria Int #24 handler's error-flag address
-- NOTE:    allocate flag on *any* platform to speedup check_error()
constant INT24_FLAG = allocate(4)
poke4(INT24_FLAG, FALSE) -- reset flag (no error)
if OS_DOS32 then                
    lock_memory(INT24_FLAG, 4)
end if



-- PURPOSE: return DOS Int #24 handler address
-- RETURN:  sequence; {segment, offset}
function int24_usual_addr()
    if OS_DOS32 then
	return get_vector(#24)
    end if
    return {0, 0}
end function



-- PURPOSE: return Euphoria Int #24 handler address
-- RETURN:  atom; memory address of handler
function int24_euphoria_addr()
    sequence mach
    atom addr
    
    if not OS_DOS32 then
	return 0
    end if
    
    -- machine code of Euphoria critical-error handler
    mach = {
	-- save registers
	#1E,    -- push ds      
	#53,    -- push ebx
	
	-- restore the data segment value
	#BB} &
	int_to_bytes(EU_CODE_DATA_SEG[2]) &  -- mov ebx, data segment value
	{#53,   -- push ebx
	#1F} &  -- pop ds

	-- set flag on a critical error
	#BB & {TRUE,0,0,0} &    -- mov ebx, non-zero-value
	{#89, #1D} & int_to_bytes(INT24_FLAG) & -- mov flag_ad, ebx

	-- acknowledge the interrupt with #03, "Fail" (MS-DOS 3.1 or later)
	{#B0, #03} & -- mov al, #03 (#01, "Ignore", keeps floppy running, etc)

	-- restore registers
	{#5B,   -- pop ebx
	#1F,    -- pop ds

	-- return from interrupt back to DOS to re-check for a *fatal* error
	#CF     -- iretd
    }

    -- load handler
    addr = allocate(length(mach))
    poke(addr, mach)
    lock_memory(addr, length(mach))
    
    return addr
end function

constant DOS_INT24_ADDR = int24_usual_addr(),
	  EU_INT24_ADDR = int24_euphoria_addr()



--bookmark: Critical-error Global Routines;

-- PURPOSE: allow critical-error to terminate your program or not (DOS32)
-- DETAILS: allow is FALSE/TRUE
global procedure allow_error(boolean allow)
    if not OS_DOS32 then
	return
    elsif allow then -- use DOS Int #24 handler
	set_vector(#24, DOS_INT24_ADDR)
    else -- use Euphoria Int #24 handler
	set_vector(#24, {EU_CODE_DATA_SEG[1], EU_INT24_ADDR})
    end if
    poke4(INT24_FLAG, FALSE) -- clear flag
end procedure



-- PURPOSE: check if critical-error has occurred (DOS32)
-- RETURN:  boolean; FALSE/TRUE (no error/error)
global function check_error()
    if peek4u(INT24_FLAG) then
	poke4(INT24_FLAG, FALSE) -- clear flag
	return TRUE
    end if
    return FALSE
end function



--bookmark: Set/Get Drive Map;

-- PURPOSE:  get or set the letter to reference a mapped drive (DOS32)
-- NOTE:     * mapped drives are similar to DOS treatment of a single physical
--             floppy drive as both A: and B:.
--           * use it to avoid DOS prompt "Insert diskette in drive B:"...
-- DETAILS:  d is drive letter a..z or A..Z
--           set is 0/1 (get/set)
-- RETURN:   integer; 'A'..'Z' (the last letter used to reference the drive)
function drive_map(integer d, boolean set)
    sequence r
    integer c
    
    if not OS_DOS32 then
	return d 
    end if
    
    -- AH=#44; AL=#0E/#0F - IOCTL: Get/Set Logical Drive Map function
    d = upper(d)
    r = repeat(0, REG_LIST_SIZE)
    r[REG_AX] = #440E + (set = TRUE)   
    r[REG_BX] = d - '@'             -- BL=drive # (0=default, 1=A, 2=B, etc)
    r = dos_interrupt(#21, r)
    c = and_bits(r[REG_AX], #FF) + '@'  -- AL=mapping code (1=A, 2=B, etc)
    if and_bits(r[REG_FLAGS], 1) then   -- carry flag set on error
    elsif c >= 'A' and c <= 'Z' then    -- AL=#00 if drive not mapped
	return c
    end if
    return d -- error or not mapped
end function



-- PURPOSE: return the letter to reference a mapped drive (DOS32)
global function get_drive_map(drive d)
    return drive_map(d, FALSE)
end function



-- PURPOSE: change the letter to reference a mapped drive (DOS32)
-- NOTE:    set-map returns 'O' on Windows-XP (ex.exe), so return get-map value
global function set_drive_map(drive d)
    integer nul
    
    nul = drive_map(d, TRUE)   
    return drive_map(d, FALSE)
end function



-- End of file.

