* use -FE

rtl/dos/Makefile

@@ -1,22 +0,0 @@
-#
-# Minimalist version of a makefile, so make clean at least works.
-#
-
-# Warning: this file contains TAB (#9) characters that are required for
-# make. Make sure you use an editor that does not replace TABs with
-# spaces, or the makefile won't work anymore after you save.
-
-.PHONY: all clean install
-
-all:
-	-make -C go32v2 all
-	-make -C go32v1 all
-
-clean:
-	-make -C go32v2 clean
-	-make -C go32v1 clean
-
-install:
-	-make -C go32v2 install
-	-make -C go32v1 install
-

rtl/dos/go32v2/exceptn.as

@@ -1,427 +0,0 @@
-/* Copyright (C) 1994, 1995 Charles Sandmann ([email protected])
- * This file maybe freely distributed and modified as long as copyright remains.
- */
-/* Simply rewritten to be compiled directly by GNU as by Pierre Muller
-   for use in FPC the free pascal compiler */
-  EAX = 0
-  EBX = 4
-  ECX = 8
-  EDX = 12
-  ESI = 16
-  EDI = 20
-  EBP = 24
-  ESP = 28
-  EIP = 32
-  EFLAGS = 36
-  CS = 40
-  DS = 42
-  ES = 44
-  FS = 46
-  GS = 48
-  SS = 50
-  ERRCODE = 52
-  EXCEPNO = 56
-  PREVEXC = 60
-
-  /* Length 64 bytes plus non-used FPU */
-	.data
-	.align 4
-	.lcomm	exception_stack, 8000
-
-	.text
-	.align	4
-   .macro EXCEPTION_ENTRY number
-	pushl	\number
-	jmp	exception_handler
-   .endm
-
-	.global	___djgpp_exception_table
-___djgpp_exception_table:
-EXCEPTION_ENTRY $0
-EXCEPTION_ENTRY $1
-EXCEPTION_ENTRY $2
-EXCEPTION_ENTRY $3
-EXCEPTION_ENTRY $4
-EXCEPTION_ENTRY $5
-EXCEPTION_ENTRY $6
-EXCEPTION_ENTRY $7
-EXCEPTION_ENTRY $8
-EXCEPTION_ENTRY $9
-EXCEPTION_ENTRY $10
-EXCEPTION_ENTRY $11
-EXCEPTION_ENTRY $12
-EXCEPTION_ENTRY $13
-EXCEPTION_ENTRY $14
-EXCEPTION_ENTRY $15
-EXCEPTION_ENTRY $16
-EXCEPTION_ENTRY $17
-
-/*	This code is called any time an exception occurs in the 32 bit protected
-;*	mode code.  The exception number is pushed on the stack.  This is called
-;*	on a locked stack with interrupts disabled.  Don't try to terminate.
-;*
-;*	[   *	|   SS  ]	* Don't modify
-;*	[      ESP      ]
-;*	[    EFLAGS	]
-;*	[   *   |   CS	]	* Don't modify
-;*	[      EIP	]
-;*	[   ERR CODE	]
-;*	[   *   |RET CS*]	* Don't modify
-;*	[   RET EIP*	]	* Don't modify
-;*	[  EXCEPTION #	]	(And later EBP)
-;*/
-exception_handler:
-	pushl	%ebx
-	pushl	%ds
-   	.byte	0x2e				/* CS: */
-	cmpb	$0, forced
-	je	not_forced
-	call	limitFix
-   	.byte	0x2e				/* CS: */
-	movzbl	forced,%ebx
-	movl	%ebx,8(%esp)			/* replace EXCEPNO */
-not_forced:
-	movw	%cs:___djgpp_our_DS, %ds
-	movl	$0x10000, forced		/* its zero now, flag inuse */
-	movl	$exception_state, %ebx
-	popl	DS(%ebx)
-	popl	EBX(%ebx)
-	popl	EXCEPNO(%ebx)
-	movl	%esi, ESI(%ebx)
-	movl	%edi, EDI(%ebx)
-	movl	%ebp, EBP(%ebx)
-	movl	%eax, EAX(%ebx)
-	movl	%ecx, ECX(%ebx)
-	movl	%edx, EDX(%ebx)
-	movw	%es, ES(%ebx)
-	movw	%fs, FS(%ebx)
-	movw	%gs, GS(%ebx)
-	movl	___djgpp_exception_state_ptr, %eax
-	movl	%eax, PREVEXC(%ebx)
-
-/* Stack clean at this point, DS:[EBX] points to exception_state, all 
-   register information saved.  Now get the info on stack. */
-
-	pushl	%ebp
-	movl	%esp, %ebp	/* load ebp with stack for easy access */
-	
-	movl	12(%ebp), %eax
-	movl	%eax, ERRCODE(%ebx)
-	movl	16(%ebp), %eax
-	movl	%eax, EIP(%ebx)
-	movl	20(%ebp), %eax
-	movw	%ax, CS(%ebx)
-	movl	24(%ebp), %eax
-	movl	%eax, EFLAGS(%ebx)
-	andb	$0xfe, %ah			/* Clear trace flag */
-	movl	%eax, 24(%ebp)			/* and restore on stack */
-
-	movl	28(%ebp), %eax
-	movl	%eax, ESP(%ebx)
-	movl	32(%ebp), %eax
-	movw	%ax, SS(%ebx)
-
-	movl	$dpmi_exception_proc1, 16(%ebp)		/* where to return */
-	movw	%cs, 20(%ebp)
-
-/* Change to our local stack on return from exception (maybe stack exception) */
-	movw	%ds, %ax
-	cmpb	$12,EXCEPNO(%ebx)		/* Stack fault ? */
-	je	1f
-	cmpw	%ax,32(%ebp)
-	je	stack_ok
-1:	movl	$exception_stack+8000, 28(%ebp)
-	movw	%ax, 32(%ebp)
-stack_ok:
-/* Now copy the exception structure to the new stack before returning */
-	movw	%ax, %es
-	movl	%ebx,%esi
-	movl	28(%ebp), %edi
-	subl	$92, %edi			/* 64 plus extra for longjmp */
-	movl	%edi, 28(%ebp)
-	movl	%edi, ___djgpp_exception_state_ptr
-	movl	$16, %ecx
-	cld
-	rep
-	movsl
-
-	movl	EAX(%ebx), %eax				/* restore regs */
-	movl	ESI(%ebx), %esi
-	movl	EDI(%ebx), %edi
-	movl	ECX(%ebx), %ecx
-	movw	ES(%ebx), %es
-	popl	%ebp
-	pushl	EBX(%ebx)
-	pushl	DS(%ebx)
-	movb	$0, forced+2				/* flag non-use */
-	popl	%ds
-	popl	%ebx
-	lret
-
-/* Code to fix fake exception, EBX destroyed.  Note, app_DS may == our_DS! */
-	.align 4
-limitFix:
-	pushl	%eax
-	pushl	%ecx
-	pushl	%edx
-   	.byte	0x2e				/* CS: */
-	movl	___djgpp_app_DS, %ebx		/* avoid size prefix */
-   	.byte	0x2e				/* CS: */
-	movl	ds_limit, %edx
-	movl	%edx, %ecx
-	shrl	$16, %ecx
-	movw	$0x0008, %ax
-	int	$0x31				/* Set segment limit */
-	popl	%edx
-	popl	%ecx
-	popl	%eax
-	ret
-
-/* This local routine preprocesses a return request to the C code.  It checks
-   to make sure the DS & SS are set OK for C code.  If not, it sets them up */
-	.align	4
-dpmi_exception_proc1:
-	cld
-   	.byte	0x2e				/* CS: !!! */
-	movw	___djgpp_our_DS, %bx		/* to be sure */
-	movw	%bx, %ds
-	movw	%bx, %es
-	/* Note: SS:ESP should be set properly by exception routine */
-	jmp	___djgpp_exception_processor
-
-/*	This code is called by a user routine wishing to save an interrupt
-;*	state.  It will return with a clean stack, our DS,ES,SS.
-;*      Minor bug: uses static exception_state for a short window without
-;*      interrupts guaranteed disabled.
-;*
-;*	[    EFLAGS	]
-;*	[   *   |   CS	]
-;*	[      EIP	]
-;*	[  CALLING EIP  ]
-;*/
-
-	.align	4
-	.globl	___djgpp_save_interrupt_regs
-___djgpp_save_interrupt_regs:
-	pushl	%esi
-	pushl	%ds
-	movw	%cs:___djgpp_our_DS, %ds
-	movl	$exception_state, %esi
-	popl	DS(%esi)		/* Trashes ES but OK */
-	popl	ESI(%esi)
-	movl	%edi, EDI(%esi)
-	movl	%ebp, EBP(%esi)
-	movl	%eax, EAX(%esi)
-	movl	%ebx, EBX(%esi)
-	movl	%ecx, ECX(%esi)
-	movl	%edx, EDX(%esi)
-	popl	%edx			/* Save calling EIP */
-	popl	EIP(%esi)
-	popl	%eax
-	movw	%ax,CS(%esi)		/* Don't pop, nukes DS */
-	popl	EFLAGS(%esi)
-	movl	%esp, ESP(%esi)
-	movw	%es, ES(%esi)
-	movw	%fs, FS(%esi)
-	movw	%gs, GS(%esi)
-	movw	%ss, SS(%esi)
-	movl	___djgpp_exception_state_ptr, %eax
-	movl	%eax, PREVEXC(%esi)
-	cld
-	movw	%ds, %ax
-	movw	%ax, %es
-	movw	%ss, %bx
-	cmpw	%ax, %bx			/* is SS = DS ? */
-	je	Lss_ok
-	movw	%ax, %ss			/* set new SS:ESP */
-	movl	$exception_stack+8000, %esp
-Lss_ok:	subl	$92, %esp		/* 64 plus extra for longjmp */
-	movl	%esp, %edi
-	movl	$16, %ecx
-	movl	%edi, ___djgpp_exception_state_ptr
-	rep
-	movsl					/* Copy structure to stack */
-	jmp	*%edx				/* A "return" */
-
-	.align	4		/* We will touch this; it must be locked */
-	.global ___djgpp_hw_lock_start
-___djgpp_hw_lock_start:
-ds_limit:			.long	0
-forced:				.long	0
-	.global	___djgpp_cbrk_count
-___djgpp_cbrk_count:		.long	0
-	.global	___djgpp_timer_countdown
-___djgpp_timer_countdown:	.long	0
-	.global	___djgpp_our_DS
-___djgpp_our_DS:		.word	0
-	.global	___djgpp_app_DS
-___djgpp_app_DS:		.word	0
-	.global	___djgpp_dos_sel
-___djgpp_dos_sel:		.word	0
-	.global	___djgpp_hwint_flags
-___djgpp_hwint_flags:		.word	0
-	.global	___djgpp_old_kbd
-___djgpp_old_kbd:		.long	0,0
-	.global	___djgpp_old_timer
-___djgpp_old_timer:		.long	0,0
-	.global	___djgpp_exception_state_ptr
-___djgpp_exception_state_ptr:	.long	0
-exception_state:		.space	64
-	.global	___djgpp_ds_alias
-___djgpp_ds_alias:		.word	0	/* used in dpmi/api/d0303.s (alloc rmcb) */
-
-	.align 4
-	.global	___djgpp_npx_hdlr
-___djgpp_npx_hdlr:
-	pushl	%eax
-	xorl	%eax,%eax
-	outb	%al,$0x0f0
-	movb	$0x20,%al
-	outb	%al,$0x0a0
-	outb	%al,$0x020
-	movb	$0x75,%al
-hw_to_excp:
-	call	___djgpp_hw_exception
-	popl	%eax
-	sti
-	iret
-
-	.align 4
-	.global	___djgpp_kbd_hdlr
-___djgpp_kbd_hdlr:
-	pushl	%eax
-	pushl	%ds
-   	.byte	0x2e				/* CS: */
-	testb	$1, ___djgpp_hwint_flags	/* Disable? */
-	jne	Lkbd_chain
-/* Check CTRL state */
-	movw	%cs:___djgpp_dos_sel, %ds	/* Conventional mem selector */
-/*	movw	$0x7021,0xb0f00		*/	/* Test code - write to mono */
-	testb	$4,0x417			/* Test KB flags: CTRL down? */
-	je	Lkbd_chain
-	testb	$8,0x417			/* Test KB flags: ALT down? */
-	jne	Lkbd_chain			/* Don't capture ALT-CTRL-C */
-/* Check port for scan code */
-	inb	$0x60,%al
-	cmpb	$0x2e,%al
-	jne	Lkbd_chain
-/* Clear interrupt, (later: remove byte from controller?)
-	movb	$0x20,%al
-	outb	%al,$0x020	*/
-98:
-	movb	$0x79,%al
-	call	___djgpp_hw_exception
-Lkbd_chain:
-	popl	%ds
-	popl	%eax
-	ljmp	%cs:___djgpp_old_kbd
-
-	.align 4
-	.global	___djgpp_kbd_hdlr_pc98
-___djgpp_kbd_hdlr_pc98:
-	pushl	%eax
-	pushl	%ds
-   	.byte	0x2e				/* CS: */
-	testb	$1, ___djgpp_hwint_flags	/* Disable? */
-	jne	Lkbd_chain
-/* Check CTRL state */
-	movw	%cs:___djgpp_dos_sel, %ds	/* Conventional mem selector */
-	testb	$0x10,0x053a			/* Test KB flags: CTRL down? */
-	jz	Lkbd_chain
-/* Check for scan code */
-	testb	$0x08,0x052f			/* test KB "C" down for PC98 */
-	jz	Lkbd_chain
-	jmp	98b
-
-	.align 4
-	.global	___djgpp_timer_hdlr
-___djgpp_timer_hdlr:
-   	.byte	0x2e				/* CS: */
-	cmpl	$0,___djgpp_timer_countdown
-	je	4f
-	pushl	%ds
-	movw	%cs:___djgpp_ds_alias, %ds
-	decl	___djgpp_timer_countdown
-	popl	%ds
-	jmp	3f
-4:
-	pushl	%eax
-	movb	$0x78,%al
-	call	___djgpp_hw_exception
-	popl	%eax
-3:
-   	.byte	0x2e				/* CS: */
-	testb	$4, ___djgpp_hwint_flags	/* IRET or chain? */
-	jne	2f
-	ljmp	%cs:___djgpp_old_timer
-2:
-	pushl	%eax
-	movb	$0x20,%al			/* EOI the interrupt */
-	outb	%al,$0x020
-	popl	%eax
-	iret
-
-	/* On entry ES is the DS alias selector */
-	.align 4
-	.global	___djgpp_cbrk_hdlr		/* A RMCB handler for 0x1b */
-___djgpp_cbrk_hdlr:
-	cld
-	lodsl					/* EAX = DS:[esi] CS:IP */
-	movl	%eax, %es:0x2a(%edi)		/* store in structure */
-	lodsl					/* AX = FLAGS */
-	movw	%ax, %es:0x20(%edi)
-	addw	$6, %es:0x2e(%edi)		/* Adjust RM SP */
-	movb	$0x1b,%al
-
-   	.byte	0x2e				/* CS: */
-	testb	$2, ___djgpp_hwint_flags	/* Count, don't kill */
-	jne	1f
-
-	call	___djgpp_hw_exception
-	iret
-1:
-	incl	%es:___djgpp_cbrk_count
-	iret
-
-	.global	___djgpp_i24			/* Int 24 handler if needed */
-	.global	___djgpp_iret			/* Int 23 handler if needed */
-___djgpp_i24:
-	movb	$3,%al
-___djgpp_iret:
-	iret
-
-/* Code to stop execution ASAP, EAX destroyed.  Make DS/ES/SS invalid. 
-   Fake exception value is passed in AL and moved into the "forced" variable.
-   This is used to convert a HW interrupt into something we can transfer
-   control away from via longjmp or exit(), common with SIGINT, SIGFPE, or
-   if we want EIP information on timers. */
-
-	.align 4
-	.global	___djgpp_hw_exception
-___djgpp_hw_exception:
-   	.byte	0x2e				/* CS: */
-	cmpl	$0, forced			/* Already flagged? */
-	jne	already_forced
-	pushl	%ebx
-	pushl	%ecx
-	pushl	%edx
-	pushl	%ds
-	movw	%cs:___djgpp_our_DS, %ds
-	movl	___djgpp_app_DS, %ebx		/* avoid size prefix */
-	lsl	%ebx, %ecx
-	movl	%ecx, ds_limit			/* Save current limit */
-	movb	%al, forced			/* Indicate a fake exception */
-	xorl	%ecx, %ecx
-	movw	$0xfff, %dx			/* 4K limit is null page ! */
-	movw	$0x0008, %ax
-	int	$0x31				/* Set segment limit */
-5:	popl	%ds
-	popl	%edx
-	popl	%ecx
-	popl	%ebx
-already_forced:
-	ret
-
-	.global ___djgpp_hw_lock_end
-___djgpp_hw_lock_end:
-	ret					/* LD does weird things */

rtl/dos/go32v2/exit16.ah

@@ -1 +0,0 @@
-	.byte	0xb8,0x01,0x00,0xcd,0x31,0xb8,0x02,0x05,0xcd,0x31,0x88,0xd0,0xb4,0x4c,0xcd,0x21

rtl/dos/go32v2/exit16.asm

@@ -1,22 +0,0 @@
-; Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details
-;-----------------------------------------------------------------------------
-;  exit 16-bit helper
-;
-;  Used to clean up 32-bit arena on exit, so as to release as many
-;  selectors and as much memory as possible.
-;
-;  Call with:	BX = 32-bit CS to free
-;		SI:DI = 32-bit memory handle to free
-;		DL = exit status
-
-	.type	"bin"
-
-	mov	ax, 0x0001
-	int	0x31
-
-	mov	ax, 0x0502
-	int	0x31
-
-	mov	al, dl
-	mov	ah, 0x4c
-	int	0x21

rtl/dos/go32v2/fpu.as

@@ -1,49 +0,0 @@
-/* Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details */
-/* Translated from tasm to GAS by C. Sandmann */
-/* One comment displaced to get it compiled by as.exe directly  !!! */
-/* by Pierre Muller */
-
-/* This routine assumes DS == SS since [ESI] coding shorter than [EBP] coding */
-
-	.global	__detect_80387		/* direct from the Intel manual */
-__detect_80387:				/* returns 1 if 387 (or more), else 0 */
-	pushl	%esi
-	pushl	%eax			/* Dummy work area on stack */
-	movl	%esp,%esi
-	fninit
-	movw	$0x5a5a,(%esi)
-	fnstsw	(%esi)
-	cmpb	$0,(%esi)
-	jne	Lno_387
-	
-	fnstcw	(%esi)
-	movl	(%esi),%eax		/* Only ax significant */
-	andl	$0x103f,%eax
-	cmpl	$0x3f,%eax
-	jne	Lno_387
-	
-	fld1
-	fldz
-/*	fdiv				   GAS encodes this as 0xdcf1 !! BUG */
-	.byte	0xde,0xf9
-	fld	%st
-	fchs
-	fcompp
-	fstsw	(%esi)
-	movzwl	(%esi),%eax		/* Clears upper %eax */
-	sahf
-	je	Lno_387
-	fninit				/* 387 present, initialize. */
-	fnstcw	(%esi)
-	wait
-	andw	$0x0fffa,(%esi)		
-/* enable invalid operation exception */
-	fldcw	(%esi)
-	movw	$1,%eax
-	jmp	Lexit
-Lno_387:
-	xorl	%eax,%eax
-Lexit:
-	popl	%esi			/* Fix stack first */
-	popl	%esi
-	ret

rtl/dos/go32v2/sbrk16.ah

@@ -1,7 +0,0 @@
-	.byte	0x12,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x70,0x02,0x00,0x00,0x00,0x00,0x00,0x00
-	.byte	0x00,0x00,0x8c,0xd8,0x2e,0x8e,0x1e,0x06,0x00,0xa3,0x10,0x00,0x8c,0x16,0x0a,0x00
-	.byte	0x66,0x89,0x26,0x0c,0x00,0x8e,0x16,0x06,0x00,0x66,0xbc,0x70,0x02,0x00,0x00,0xb8
-	.byte	0x03,0x05,0xcd,0x31,0x72,0x24,0x89,0xca,0x89,0xd9,0x8b,0x1e,0x02,0x00,0xb8,0x07
-	.byte	0x00,0xcd,0x31,0x8b,0x1e,0x04,0x00,0xb8,0x07,0x00,0xcd,0x31,0x06,0x07,0x0f,0xa0
-	.byte	0x0f,0xa1,0x0f,0xa8,0x0f,0xa9,0x89,0xcb,0x89,0xd1,0x8e,0x16,0x0a,0x00,0x66,0x8b
-	.byte	0x26,0x0c,0x00,0x8e,0x1e,0x10,0x00,0x66,0xcb,0x90,0x90,0x90

rtl/dos/go32v2/sbrk16.asm

@@ -1,113 +0,0 @@
-; Copyright (C) 1994 DJ Delorie, see COPYING.DJ for details
-;
-; $Id$
-; $Log$
-; Revision 1.1  1998-03-25 11:18:42  root
-; Initial revision
-;
-; Revision 1.2  1997/11/27 16:28:13  michael
-; Change submitted by Pierre Muller.
-;
-; Revision 2.0  1994/03/14  00:47:04  dj
-; initial version
-;
-;
-
-;-----------------------------------------------------------------------------
-;  sbrk 16-bit helper
-;
-;  Transferred to 16-bit code segement to run in protected mode.
-;  Will make DPMI segment altering requests and update selectors
-;  as needed.  Image will always need to allocate an exact
-;  multiple of 16 bytes, load offset will always be zero.
-;  Number of bytes to copy will always be multiple of four.
-;
-;  Application must set cs_selector, ds_selector, and local_ds
-;  appropriately.  Application uses first word in image to find
-;  API entry point.  Call with FAR call.
-;
-;  Call with:	BX:CX = new size
-;		SI:DI = old handle
-;  Returns:	BX:CX = new base
-;		SI:DI = new handle
-;		all others trashed
-
-	.type	"bin"
-
-;-----------------------------------------------------------------------------
-;  Start of API header
-
-offset_of_api:			; offset of API function entry point
-	.dw	sbrk_16_helper
-cs_selector:			; code selector to be updated
-	.dw	0
-ds_selector:			; data selector to be updated
-	.dw	0
-local_ds:			; selector mapped to same as local cs
-	.dw	0
-bytes_to_allocate:		; number of bytes app allocates for this image
-	.dw	stack
-
-;-----------------------------------------------------------------------------
-;  Start of local data
-
-save_ss:
-	.dw	0
-save_esp:
-	.dd	0
-save_ds:
-	.dw	0
-
-;-----------------------------------------------------------------------------
-;  Start of code
-
-sbrk_16_helper:
-
-	mov	ax, ds			; switch to local data segment
-	mov	ds, cs:[local_ds]
-	mov	[save_ds], ax
-	mov	[save_ss], ss		; switch to local stack
-	mov	[save_esp], esp
-	mov	ss, [local_ds]
-	mov	esp, stack
-
-	mov	ax, 0x0503		; realloc memory
-	int	0x31
-	jc	error_return		; bx:cx = base address
-
-	mov	dx, cx
-	mov	cx, bx			; cx:dx = base address
-	mov	bx, [cs_selector]
-	mov	ax, 0x0007
-	int	0x31			; set cs to new base
-	mov	bx, [ds_selector]
-	mov	ax, 0x0007
-	int	0x31			; set ds to new base
-
-	push	es			; reload es
-	pop	es
-	push	fs			; reload fs
-	pop	fs
-	push	gs			; reload gs
-	pop	gs
-
-	mov	bx, cx
-	mov	cx, dx			; bx:cx = base address
-
-error_return:
-
-	mov	ss, [save_ss]		; return to old stack
-	mov	esp, [save_esp]
-	mov	ds, [save_ds]		; return to old data segment
-
-	.opsize				; 32-bit far return
-	retf
-
-;-----------------------------------------------------------------------------
-;  Start of stack
-
-	.align	4			; so that image size is longwords
-	.bss
-	.align	16			; so that alloc size is paragraphs
-	.db	512 .dup 0
-stack:

rtl/dos/go32v1/Makefile → rtl/go32v1/Makefile

@@ -52,13 +52,14 @@ OS_TARGET=go32v1
 CPU=i386
 
 # Where are the include files
-RTL=../..
+RTL=..
 CFG=$(RTL)/cfg
 INC=$(RTL)/inc
 PROCINC=$(RTL)/$(CPU)
 OBJPASDIR=$(RTL)/objpas
-# Where are the .ppi files.
-PPI=../ppi
+
+# Where are the results placed
+TARGETDIR=.
 
 
 #####################################################################
@@ -76,7 +77,8 @@ include $(CFG)/makefile.cfg
 SYSTEMPPU=system$(PPUEXT)
 OBJECTS=strings go32 \
 	dos crt objects printer \
-	cpu mmx mouse getopts heaptrc graph objpas sysutils
+        objpas sysutils typinfo \
+	cpu mmx getopts heaptrc mouse
 
 LOADERS=prt0
 
@@ -144,95 +146,58 @@ $(SYSTEMPPU) : system.pp $(SYSDEPS)
 	$(COMPILER) -Us -Sg system.pp $(REDIR)
 
 strings$(PPUEXT) : $(PROCINC)/strings.pp $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/strings.pp .
-	$(COMPILER) strings.pp $(REDIR)
-	$(DEL) strings.pp
+	$(COMPILER) $(PROCINC)/strings.pp $(REDIR)
 
-go32$(PPUEXT) : ../go32.pp $(SYSTEMPPU)
-	$(COPY) ../go32.pp .
+go32$(PPUEXT) : go32.pp $(SYSTEMPPU)
 	$(COMPILER) go32.pp $(REDIR)
-	$(DEL) go32.pp
 
 #
 # Delphi Object Model
 #
 
-objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp $(INC)/except.inc
-	$(COPY) $(OBJPASDIR)/objpas.pp .
-	$(COMPILER) -S2 -I$(OBJPASDIR) objpas $(REDIR)
-	$(DEL) objpas.pp
-
-SYSUTILINC = $(wildcard $(OBJPASDIR)/*.inc)
+include $(OBJPASDIR)/makefile.op
 
-sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(SYSUTILINC) filutil.inc disk.inc
-	$(COPY) $(OBJPASDIR)/sysutils.pp .
-	$(COMPILER) -S2 -I$(OBJPASDIR) sysutils $(REDIR)
-	$(DEL) sysutils.pp
 
 #
 # System Dependent Units
 #
 
+mouse$(PPUEXT) : mouse.pp $(SYSTEMPPU)
+	$(COMPILER) mouse.pp $(REDIR)
+
 
 #
 # TP7 Compatible RTL Units
 #
 
-dos$(PPUEXT) : ../dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
 	       go32$(PPUEXT) strings$(PPUEXT) $(SYSTEMPPU)
-	$(COPY) ../dos.pp .
-	$(COMPILER) dos $(REDIR)
-	$(DEL) dos.pp
+	$(COMPILER) dos.pp $(REDIR)
 
-crt$(PPUEXT) : ../crt.pp $(INC)/textrec.inc go32$(PPUEXT) $(SYSTEMPPU)
-	$(COPY) ../crt.pp .
-	$(COMPILER) crt $(REDIR)
-	$(DEL) crt.pp
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) $(SYSTEMPPU)
+	$(COMPILER) crt.pp $(REDIR)
 
 objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
-	$(COPY) $(INC)/objects.pp .
-	$(COMPILER) objects.pp $(REDIR)
-	$(DEL) objects.pp
+	$(COMPILER) $(INC)/objects.pp $(REDIR)
 
-printer$(PPUEXT) : ../printer.pp $(SYSTEMPPU)
-	$(COPY) ../printer.pp .
+printer$(PPUEXT) : printer.pp $(SYSTEMPPU)
 	$(COMPILER) printer.pp $(REDIR)
-	$(DEL) printer.pp
 
 #
 # Other RTL Units
 #
 
 cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/cpu.pp .
-	$(COMPILER) cpu.pp $(REDIR)
-	$(DEL) cpu.pp
+	$(COMPILER) $(PROCINC)/cpu.pp $(REDIR)
 
 mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/mmx.pp .
-	$(COMPILER) mmx.pp $(REDIR)
-	$(DEL) mmx.pp
-
-mouse$(PPUEXT) : ../mouse.pp $(SYSTEMPPU)
-	$(COPY) ../mouse.pp .
-	$(COMPILER) mouse.pp $(REDIR)
-	$(DEL) mouse.pp
+	$(COMPILER) $(PROCINC)/mmx.pp $(REDIR)
 
 getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
-	$(COPY) $(INC)/getopts.pp .
-	$(COMPILER) getopts.pp $(REDIR)
-	$(DEL) getopts.pp
+	$(COMPILER) $(INC)/getopts.pp $(REDIR)
 
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
-	$(COPY) $(INC)/heaptrc.pp .
-	$(COMPILER) heaptrc $(REDIR)
-	$(DEL) heaptrc.pp
-
-PPIFILES:=$(wildcard $(PPI)/*.ppi)
-graph$(PPUEXT) : ../graph.pp go32$(PPUEXT) $(SYSTEMPPU) mmx$(PPUEXT) $(PPIFILES)
-	$(COPY) ../graph.pp .
-	$(COMPILER) -I$(PPI) graph $(REDIR)
-	$(DEL) graph.pp
+	$(COMPILER) $(INC)/heaptrc $(REDIR)
 
 
 #####################################################################
@@ -268,7 +233,10 @@ include $(CFG)/makefile.def
 
 #
 # $Log$
-# Revision 1.9  1998-11-24 19:49:44  jonas
+# Revision 1.1  1998-12-21 13:07:02  peter
+#   * use -FE
+#
+# Revision 1.9  1998/11/24 19:49:44  jonas
 #   + added warning about TABs
 #
 # Revision 1.8  1998/10/12 08:36:29  pierre

rtl/dos/crt.pp → rtl/go32v1/crt.pp

@@ -16,8 +16,6 @@
 unit crt;
 interface
 
-{$I os.inc}
-
 const
 { CRT modes }
   BW40          = 0;            { 40x25 B/W on Color Adapter }
@@ -119,15 +117,7 @@ var
 ****************************************************************************}
 
 procedure setscreenmode(mode : byte);
-{$ifdef GO32V2}
-var
-  regs : trealregs;
-{$endif GO32V2}
 begin
-{$ifdef GO32V2}
-  regs.realeax:=mode;
-  realintr($10,regs);
-{$else GO32V2}
   asm
         movb    8(%ebp),%al
         xorb    %ah,%ah
@@ -135,43 +125,24 @@ begin
         int     $0x10
         popl    %ebp
   end;
-{$endif GO32V2}
 end;
 
 
 function GetScreenHeight : longint;
 begin
-{$ifdef GO32V2}
-  getscreenheight:=mem[$40:$84]+1;
-{$else}
   dosmemget($40,$84,getscreenheight,1);
   inc(getscreenheight);
-{$endif}
 end;
 
 
 function GetScreenWidth : longint;
 begin
-{$ifdef GO32V2}
-  getscreenwidth:=mem[$40:$4a];
-{$else}
   dosmemget($40,$4a,getscreenwidth,1);
-{$endif}
 end;
 
 
 procedure SetScreenCursor(x,y : longint);
-{$ifdef GO32V2}
-var
-  regs : trealregs;
-{$endif GO32V2}
 begin
-{$ifdef GO32V2}
-  regs.realeax:=$0200;
-  regs.realebx:=0;
-  regs.realedx:=(y-1) shl 8+(x-1);
-  realintr($10,regs);
-{$else GO32V2}
   asm
         movb    $0x02,%ah
         movb    $0,%bh
@@ -182,23 +153,17 @@ begin
         int     $0x10
         popl    %ebp
   end;
-{$endif GO32V2}
 end;
 
 
 procedure GetScreenCursor(var x,y : longint);
 begin
-{$ifdef Go32V2}
-  x:=mem[$40:$50]+1;
-  y:=mem[$40:$51]+1;
-{$else Go32V2}
   x:=0;
   y:=0;
   dosmemget($40,$50,x,1);
   dosmemget($40,$51,y,1);
   inc(x);
   inc(y);
-{$endif GO32V2}
 end;
 
 
@@ -424,9 +389,6 @@ function readkey : char;
 var
   char2 : char;
   char1 : char;
-{$ifdef GO32V2}
-  regs : trealregs;
-{$endif GO32V2}
 begin
   if is_last then
    begin
@@ -435,12 +397,6 @@ begin
    end
   else
    begin
-{$ifdef GO32V2}
-     regs.realeax:=$0000;
-     realintr($16,regs);
-     char1:=chr(regs.realeax and $ff);
-     char2:=chr((regs.realeax and $ff00) shr 8);
-{$else GO32V2}
      asm
         movb    $0,%ah
         pushl   %ebp
@@ -449,7 +405,6 @@ begin
         movb    %al,char1
         movb    %ah,char2
      end;
-{$endif GO32V2}
      if char1=#0 then
       begin
         is_last:=true;
@@ -461,10 +416,6 @@ end;
 
 
 function keypressed : boolean;
-{$ifdef GO32V2}
-var
-  regs : trealregs;
-{$endif GO32V2}
 begin
   if is_last then
    begin
@@ -473,11 +424,6 @@ begin
    end
   else
    begin
-{$ifdef GO32V2}
-     regs.realeax:=$0100;
-     realintr($16,regs);
-     keypressed:=((regs.realflags and zeroflag) = 0);
-{$else GO32V2}
      asm
         movb    $1,%ah
         pushl   %ebp
@@ -486,7 +432,6 @@ begin
         setnz   %al
         movb    %al,__RESULT
      end;
-{$endif GO32V2}
    end;
 end;
 
@@ -629,12 +574,7 @@ end;
 ****************************************************************************}
 
 procedure cursoron;
-{$ifdef GO32V2}
-var
-  regs : trealregs;
-{$endif GO32V2}
 begin
-{$ifndef GO32V2}
   asm
         movb    $1,%ah
         movb    $10,%cl
@@ -643,25 +583,11 @@ begin
         int     $0x10
         popl    %ebp
   end;
-{$else GO32V2}
-  regs.realeax:=$0100;
-  regs.realecx:=$90A;
-  realintr($10,regs);
-{$endif GO32V2}
 end;
 
 
 procedure cursoroff;
-{$ifdef GO32V2}
-var
-  regs : trealregs;
-{$endif GO32V2}
 begin
-{$ifdef GO32V2}
-  regs.realeax:=$0100;
-  regs.realecx:=$ffff;
-  realintr($10,regs);
-{$else GO32V2}
   asm
         movb    $1,%ah
         movb    $-1,%cl
@@ -670,21 +596,11 @@ begin
         int     $0x10
         popl    %ebp
   end;
-{$endif GO32V2}
 end;
 
 
 procedure cursorbig;
-{$ifdef GO32V2}
-var
-  regs : trealregs;
-{$endif GO32V2}
 begin
-{$ifdef GO32V2}
-  regs.realeax:=$0100;
-  regs.realecx:=$10A;
-  realintr($10,regs);
-{$else GO32V2}
   asm
         movb    $1,%ah
         movw    $110,%cx
@@ -692,7 +608,6 @@ begin
         int     $0x10
         popl    %ebp
   end;
-{$endif GO32V2}
 end;
 
 
@@ -705,11 +620,7 @@ var
 
 Procedure WriteChar(c:char);
 var
-{$ifdef GO32V2}
-  regs : trealregs;
-{$else}
   chattr : word;
-{$endif}
 begin
   case c of
    #10 : inc(CurrY);
@@ -719,20 +630,11 @@ begin
             dec(CurrX);
          end;
     #7 : begin { beep }
-{$ifdef GO32V2}
-           regs.dl:=7;
-           regs.ah:=2;
-           realintr($21,regs);
-{$endif}
          end;
   else
    begin
-{$ifdef GO32V2}
-     memw[$b800:((CurrY-1)*ScreenWidth+(CurrX-1))*2]:=(textattr shl 8) or byte(c);
-{$else}
      chattr:=(textattr shl 8) or byte(c);
      dosmemput($b800,((CurrY-1)*ScreenWidth+(CurrX-1))*2,chattr,2);
-{$endif}
      inc(CurrX);
    end;
   end;
@@ -896,13 +798,8 @@ begin
   WindMax:=(ScreenWidth-1) or ((ScreenHeight-1) shl 8);
 { Load TextAttr }
   GetScreenCursor(x,y);
-{$ifdef GO32V2}
-  TextAttr:=mem[$b800:((y-1)*ScreenWidth+(x-1))*2+1];
-  lastmode:=mem[$40:$49];
-{$else Go32V2}
   dosmemget($b800,((y-1)*ScreenWidth+(x-1))*2+1,TextAttr,1);
   dosmemget($40,$49,lastmode,1);
-{$endif Go32V2}
 { Redirect the standard output }
   assigncrt(Output);
   Rewrite(Output);
@@ -916,7 +813,10 @@ end.
 
 {
   $Log$
-  Revision 1.17  1998-12-15 22:42:49  peter
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.17  1998/12/15 22:42:49  peter
     * removed temp symbols
 
   Revision 1.16  1998/12/09 23:04:36  jonas

rtl/dos/go32v1/disk.inc → rtl/go32v1/disk.inc

@@ -4,7 +4,7 @@
     Copyright (c) 1998 by the Free Pascal development team
 
     Disk functions from Delphi's sysutils.pas
-        
+
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -53,7 +53,10 @@ end;
 
 {
  $Log$
- Revision 1.1  1998-10-11 13:42:55  michael
+ Revision 1.1  1998-12-21 13:07:02  peter
+   * use -FE
+
+ Revision 1.1  1998/10/11 13:42:55  michael
  Added disk functions
 
 }

rtl/go32v1/dos.pp

@@ -0,0 +1,867 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1993,97 by the Free Pascal development team.
+
+    Dos unit for BP7 compatible RTL
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit dos;
+interface
+Uses
+  Go32;
+
+Const
+  {Bitmasks for CPU Flags}
+  fcarry     = $0001;
+  fparity    = $0004;
+  fauxiliary = $0010;
+  fzero      = $0040;
+  fsign      = $0080;
+  foverflow  = $0800;
+
+  {Bitmasks for file attribute}
+  readonly  = $01;
+  hidden    = $02;
+  sysfile   = $04;
+  volumeid  = $08;
+  directory = $10;
+  archive   = $20;
+  anyfile   = $3F;
+
+  {File Status}
+  fmclosed = $D7B0;
+  fminput  = $D7B1;
+  fmoutput = $D7B2;
+  fminout  = $D7B3;
+
+
+Type
+  comstr  = string[127];        { command line string }
+  pathstr = string[79];         { string for a file path }
+  dirstr  = string[67];         { string for a directory }
+  namestr = string[8];          { string for a file name }
+  extstr  = string[4];          { string for an extension }
+
+{
+  filerec.inc contains the definition of the filerec.
+  textrec.inc contains the definition of the textrec.
+  It is in a separate file to make it available in other units without
+  having to use the DOS unit for it.
+}
+{$i filerec.inc}
+{$i textrec.inc}
+
+  DateTime = packed record
+    Year,
+    Month,
+    Day,
+    Hour,
+    Min,
+    Sec   : word;
+  End;
+
+  searchrec = packed record
+     fill     : array[1..21] of byte;
+     attr     : byte;
+     time     : longint;
+     reserved : word; { requires the DOS extender (DJ GNU-C) }
+     size     : longint;
+     name     : string[15]; { the same size as declared by (DJ GNU C) }
+  end;
+
+  registers = packed record
+    case i : integer of
+     0 : (ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,f8,flags,fs,gs : word);
+     1 : (al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh : byte);
+     2 : (eax,  ebx,  ecx,  edx,  ebp,  esi,  edi : longint);
+    end;
+
+Var
+  DosError : integer;
+
+{Interrupt}
+Procedure Intr(intno: byte; var regs: registers);
+Procedure MSDos(var regs: registers);
+
+{Info/Date/Time}
+Function  DosVersion: Word;
+Procedure GetDate(var year, month, mday, wday: word);
+Procedure GetTime(var hour, minute, second, sec100: word);
+procedure SetDate(year,month,day: word);
+Procedure SetTime(hour,minute,second,sec100: word);
+Procedure UnpackTime(p: longint; var t: datetime);
+Procedure PackTime(var t: datetime; var p: longint);
+
+{Exec}
+Procedure Exec(const path: pathstr; const comline: comstr);
+Function  DosExitCode: word;
+
+{Disk}
+Function  DiskFree(drive: byte) : longint;
+Function  DiskSize(drive: byte) : longint;
+Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
+Procedure FindNext(var f: searchRec);
+Procedure FindClose(Var f: SearchRec);
+
+{File}
+Procedure GetFAttr(var f; var attr: word);
+Procedure GetFTime(var f; var time: longint);
+Function  FSearch(path: pathstr; dirlist: string): pathstr;
+Function  FExpand(const path: pathstr): pathstr;
+Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
+
+{Environment}
+Function  EnvCount: longint;
+Function  EnvStr(index: integer): string;
+Function  GetEnv(envvar: string): string;
+
+{Misc}
+Procedure SetFAttr(var f; attr: word);
+Procedure SetFTime(var f; time: longint);
+Procedure GetCBreak(var breakvalue: boolean);
+Procedure SetCBreak(breakvalue: boolean);
+Procedure GetVerify(var verify: boolean);
+Procedure SetVerify(verify: boolean);
+
+{Do Nothing Functions}
+Procedure SwapVectors;
+Procedure GetIntVec(intno: byte; var vector: pointer);
+Procedure SetIntVec(intno: byte; vector: pointer);
+Procedure Keep(exitcode: word);
+
+implementation
+
+uses
+  strings;
+
+{$ASMMODE ATT}
+
+{******************************************************************************
+                           --- Dos Interrupt ---
+******************************************************************************}
+
+var
+  dosregs : registers;
+
+    procedure LoadDosError;
+      begin
+        if (dosregs.flags and carryflag) <> 0 then
+        { conversion from word to integer !!
+          gave a Bound check error if ax is $FFFF !! PM }
+         doserror:=integer(dosregs.ax)
+        else
+         doserror:=0;
+      end;
+
+
+{$ASMMODE DIRECT}
+    procedure intr(intno : byte;var regs : registers);
+
+      begin
+         asm
+            .data
+    int86:
+            .byte        0xcd
+    int86_vec:
+            .byte        0x03
+            jmp        int86_retjmp
+
+            .text
+            movl        8(%ebp),%eax
+            movb        %al,int86_vec
+
+            movl        10(%ebp),%eax
+            // do not use first int
+            addl        $2,%eax
+
+            movl        4(%eax),%ebx
+            movl        8(%eax),%ecx
+            movl        12(%eax),%edx
+            movl        16(%eax),%ebp
+            movl        20(%eax),%esi
+            movl        24(%eax),%edi
+            movl        (%eax),%eax
+
+            jmp        int86
+    int86_retjmp:
+            pushf
+            pushl       %ebp
+            pushl       %eax
+            movl        %esp,%ebp
+            // calc EBP new
+            addl        $12,%ebp
+            movl        10(%ebp),%eax
+            // do not use first int
+            addl        $2,%eax
+
+            popl        (%eax)
+            movl        %ebx,4(%eax)
+            movl        %ecx,8(%eax)
+            movl        %edx,12(%eax)
+            // restore EBP
+            popl        %edx
+            movl        %edx,16(%eax)
+            movl        %esi,20(%eax)
+            movl        %edi,24(%eax)
+            // ignore ES and DS
+            popl        %ebx        /* flags */
+            movl        %ebx,32(%eax)
+            // FS and GS too
+         end;
+      end;
+{$ASMMODE ATT}
+
+
+procedure msdos(var regs : registers);
+begin
+  intr($21,regs);
+end;
+
+
+{******************************************************************************
+                        --- Info / Date / Time ---
+******************************************************************************}
+
+function dosversion : word;
+begin
+  dosregs.ax:=$3000;
+  msdos(dosregs);
+  dosversion:=dosregs.ax;
+end;
+
+
+procedure getdate(var year,month,mday,wday : word);
+begin
+  dosregs.ax:=$2a00;
+  msdos(dosregs);
+  wday:=dosregs.al;
+  year:=dosregs.cx;
+  month:=dosregs.dh;
+  mday:=dosregs.dl;
+end;
+
+
+procedure setdate(year,month,day : word);
+begin
+   dosregs.cx:=year;
+   dosregs.dh:=month;
+   dosregs.dl:=day;
+   dosregs.ah:=$2b;
+   msdos(dosregs);
+   DosError:=0;
+end;
+
+
+procedure gettime(var hour,minute,second,sec100 : word);
+begin
+  dosregs.ah:=$2c;
+  msdos(dosregs);
+  hour:=dosregs.ch;
+  minute:=dosregs.cl;
+  second:=dosregs.dh;
+  sec100:=dosregs.dl;
+  DosError:=0;
+end;
+
+
+procedure settime(hour,minute,second,sec100 : word);
+begin
+  dosregs.ch:=hour;
+  dosregs.cl:=minute;
+  dosregs.dh:=second;
+  dosregs.dl:=sec100;
+  dosregs.ah:=$2d;
+  msdos(dosregs);
+  DosError:=0;
+end;
+
+
+Procedure packtime(var t : datetime;var p : longint);
+Begin
+  p:=(t.sec shr 1)+(t.min shl 5)+(t.hour shl 11)+(t.day shl 16)+(t.month shl 21)+((t.year-1980) shl 25);
+End;
+
+
+Procedure unpacktime(p : longint;var t : datetime);
+Begin
+  with t do
+   begin
+     sec:=(p and 31) shl 1;
+     min:=(p shr 5) and 63;
+     hour:=(p shr 11) and 31;
+     day:=(p shr 16) and 31;
+     month:=(p shr 21) and 15;
+     year:=(p shr 25)+1980;
+   end;
+End;
+
+
+{******************************************************************************
+                               --- Exec ---
+******************************************************************************}
+
+var
+  lastdosexitcode : word;
+
+procedure exec(const path : pathstr;const comline : comstr);
+var
+  i : longint;
+  b : array[0..255] of char;
+begin
+  doserror:=0;
+  for i:=1to length(path) do
+   if path[i]='/' then
+    b[i-1]:='\'
+   else
+    b[i-1]:=path[i];
+  b[i]:=' ';
+  inc(i);
+  move(comline[1],b[i],length(comline));
+  inc(i,length(comline));
+  b[i]:=#0;
+  asm
+        leal    b,%ebx
+        movw    $0xff07,%ax
+        int     $0x21
+        movw    %ax,LastDosExitCode
+  end;
+end;
+
+
+function dosexitcode : word;
+begin
+  dosexitcode:=lastdosexitcode;
+end;
+
+
+procedure getcbreak(var breakvalue : boolean);
+begin
+  DosError:=0;
+  dosregs.ax:=$3300;
+  msdos(dosregs);
+  breakvalue:=dosregs.dl<>0;
+end;
+
+
+procedure setcbreak(breakvalue : boolean);
+begin
+  DosError:=0;
+  dosregs.ax:=$3301;
+  dosregs.dl:=ord(breakvalue);
+  msdos(dosregs);
+end;
+
+
+procedure getverify(var verify : boolean);
+begin
+  DosError:=0;
+  dosregs.ah:=$54;
+  msdos(dosregs);
+  verify:=dosregs.al<>0;
+end;
+
+
+procedure setverify(verify : boolean);
+begin
+  DosError:=0;
+  dosregs.ah:=$2e;
+  dosregs.al:=ord(verify);
+  msdos(dosregs);
+end;
+
+
+{******************************************************************************
+                               --- Disk ---
+******************************************************************************}
+
+function diskfree(drive : byte) : longint;
+begin
+  DosError:=0;
+  dosregs.dl:=drive;
+  dosregs.ah:=$36;
+  msdos(dosregs);
+  if dosregs.ax<>$FFFF then
+   diskfree:=dosregs.ax*dosregs.bx*dosregs.cx
+  else
+   diskfree:=-1;
+end;
+
+
+function disksize(drive : byte) : longint;
+begin
+  DosError:=0;
+  dosregs.dl:=drive;
+  dosregs.ah:=$36;
+  msdos(dosregs);
+  if dosregs.ax<>$FFFF then
+   disksize:=dosregs.ax*dosregs.cx*dosregs.dx
+  else
+   disksize:=-1;
+end;
+
+
+{******************************************************************************
+                     --- DosFindfirst DosFindNext ---
+******************************************************************************}
+
+procedure dossearchrec2searchrec(var f : searchrec);
+var
+  len : longint;
+begin
+  len:=StrLen(@f.Name);
+  Move(f.Name[0],f.Name[1],Len);
+  f.Name[0]:=chr(len);
+end;
+
+
+procedure Dosfindfirst(path : pchar;attr : word;var f : searchrec);
+var
+   i : longint;
+begin
+   { allow slash as backslash }
+   for i:=0 to strlen(path) do
+     if path[i]='/' then path[i]:='\';
+   asm
+      movl f,%edx
+      movb $0x1a,%ah
+      int $0x21
+      movl path,%edx
+      movzwl attr,%ecx
+      movb $0x4e,%ah
+      int $0x21
+      jnc .LFF
+      movw %ax,DosError
+   .LFF:
+   end;
+  dossearchrec2searchrec(f);
+end;
+
+
+procedure Dosfindnext(var f : searchrec);
+begin
+   asm
+      movl 12(%ebp),%edx
+      movb $0x1a,%ah
+      int $0x21
+      movb $0x4f,%ah
+      int $0x21
+      jnc .LFN
+      movw %ax,DosError
+   .LFN:
+   end;
+  dossearchrec2searchrec(f);
+end;
+
+
+{******************************************************************************
+                     --- Findfirst FindNext ---
+******************************************************************************}
+
+procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
+var
+  path0 : array[0..256] of char;
+begin
+  doserror:=0;
+  strpcopy(path0,path);
+  Dosfindfirst(path0,attr,f);
+end;
+
+
+procedure findnext(var f : searchRec);
+begin
+  doserror:=0;
+  Dosfindnext(f);
+end;
+
+
+Procedure FindClose(Var f: SearchRec);
+begin
+  DosError:=0;
+end;
+
+
+procedure swapvectors;
+begin
+  DosError:=0;
+end;
+
+
+{******************************************************************************
+                               --- File ---
+******************************************************************************}
+
+procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
+var
+   p1,i : longint;
+begin
+  { allow slash as backslash }
+  for i:=1 to length(path) do
+   if path[i]='/' then path[i]:='\';
+  { get drive name }
+  p1:=pos(':',path);
+  if p1>0 then
+    begin
+       dir:=path[1]+':';
+       delete(path,1,p1);
+    end
+  else
+    dir:='';
+  { split the path and the name, there are no more path informtions }
+  { if path contains no backslashes                                 }
+  while true do
+    begin
+       p1:=pos('\',path);
+       if p1=0 then
+         break;
+       dir:=dir+copy(path,1,p1);
+       delete(path,1,p1);
+    end;
+  { try to find out a extension }
+    begin
+       p1:=pos('.',path);
+       if p1>0 then
+         begin
+            ext:=copy(path,p1,4);
+            delete(path,p1,length(path)-p1+1);
+         end
+       else
+         ext:='';
+       name:=path;
+    end;
+end;
+
+
+    function fexpand(const path : pathstr) : pathstr;
+       var
+         s,pa : pathstr;
+         i,j  : longint;
+       begin
+          getdir(0,s);
+          if LFNSupport then
+           begin
+             pa:=path;
+             { Always uppercase driveletter }
+             if (length(pa)>1) and (pa[2]=':') and (pa[1] in ['a'..'z']) then
+              pa[1]:=CHR(ORD(Pa[1])-32);
+           end
+          else
+           pa:=upcase(path);
+          { allow slash as backslash }
+          for i:=1 to length(pa) do
+           if pa[i]='/' then
+            pa[i]:='\';
+
+          if (length(pa)>1) and (pa[2]=':') and (pa[1] in ['A'..'Z']) then
+            begin
+               { we must get the right directory }
+               getdir(ord(pa[1])-ord('A')+1,s);
+               if (ord(pa[0])>2) and (pa[3]<>'\') then
+                 if pa[1]=s[1] then
+                   begin
+                     { remove ending slash if it already exists }
+                     if s[length(s)]='\' then
+                      dec(s[0]);
+                     pa:=s+'\'+copy (pa,3,length(pa));
+                   end
+                 else
+                   pa:=pa[1]+':\'+copy (pa,3,length(pa))
+            end
+          else
+            if pa[1]='\' then
+              pa:=s[1]+':'+pa
+            else if s[0]=#3 then
+              pa:=s+pa
+            else
+              pa:=s+'\'+pa;
+
+        { Turbo Pascal gives current dir on drive if only drive given as parameter! }
+        if length(pa) = 2 then
+         begin
+           getdir(byte(pa[1])-64,s);
+           pa := s;
+         end;
+
+        {First remove all references to '\.\'}
+          while pos ('\.\',pa)<>0 do
+           delete (pa,pos('\.\',pa),2);
+        {Now remove also all references to '\..\' + of course previous dirs..}
+          repeat
+            i:=pos('\..\',pa);
+            if i<>0 then
+             begin
+               j:=i-1;
+               while (j>1) and (pa[j]<>'\') do
+                dec (j);
+               if pa[j+1] = ':' then j := 3;
+               delete (pa,j,i-j+3);
+             end;
+          until i=0;
+
+          { Turbo Pascal gets rid of a \.. at the end of the path }
+          { Now remove also any reference to '\..'  at end of line
+            + of course previous dir.. }
+          i:=pos('\..',pa);
+          if i<>0 then
+           begin
+             if i = length(pa) - 2 then
+              begin
+                j:=i-1;
+                while (j>1) and (pa[j]<>'\') do
+                 dec (j);
+                delete (pa,j,i-j+3);
+              end;
+              pa := pa + '\';
+            end;
+          { Remove End . and \}
+          if (length(pa)>0) and (pa[length(pa)]='.') then
+           dec(byte(pa[0]));
+          { if only the drive + a '\' is left then the '\' should be left to prevtn the program
+            accessing the current directory on the drive rather than the root!}
+          { if the last char of path = '\' then leave it in as this is what TP does! }
+          if ((length(pa)>3) and (pa[length(pa)]='\')) and (path[length(path)] <> '\') then
+           dec(byte(pa[0]));
+          { if only a drive is given in path then there should be a '\' at the
+            end of the string given back }
+          if length(pa) = 2 then pa := pa + '\';
+          fexpand:=pa;
+       end;
+
+
+Function FSearch(path: pathstr; dirlist: string): pathstr;
+var
+  i,p1   : longint;
+  s      : searchrec;
+  newdir : pathstr;
+begin
+{ No wildcards allowed in these things }
+  if (pos('?',path)<>0) or (pos('*',path)<>0) then
+    fsearch:=''
+  else
+    begin
+       { allow slash as backslash }
+       for i:=1 to length(dirlist) do
+         if dirlist[i]='/' then dirlist[i]:='\';
+       repeat
+         p1:=pos(';',dirlist);
+         if p1<>0 then
+          begin
+            newdir:=copy(dirlist,1,p1-1);
+            delete(dirlist,1,p1);
+          end
+         else
+          begin
+            newdir:=dirlist;
+            dirlist:='';
+          end;
+         if (newdir<>'') and (not (newdir[length(newdir)] in ['\',':'])) then
+          newdir:=newdir+'\';
+         findfirst(newdir+path,anyfile,s);
+         if doserror=0 then
+          newdir:=newdir+path
+         else
+          newdir:='';
+       until (dirlist='') or (newdir<>'');
+       fsearch:=newdir;
+    end;
+end;
+
+
+{******************************************************************************
+                       --- Get/Set File Time,Attr ---
+******************************************************************************}
+
+procedure getftime(var f;var time : longint);
+begin
+  dosregs.bx:=textrec(f).handle;
+  dosregs.ax:=$5700;
+  msdos(dosregs);
+  loaddoserror;
+  time:=(dosregs.dx shl 16)+dosregs.cx;
+end;
+
+
+procedure setftime(var f;time : longint);
+begin
+  dosregs.bx:=textrec(f).handle;
+  dosregs.cx:=time and $ffff;
+  dosregs.dx:=time shr 16;
+  dosregs.ax:=$5701;
+  msdos(dosregs);
+  loaddoserror;
+end;
+
+
+procedure getfattr(var f;var attr : word);
+begin
+  dosregs.edx:=longint(@filerec(f).name);
+  dosregs.ax:=$4300;
+  msdos(dosregs);
+  LoadDosError;
+  Attr:=dosregs.cx;
+end;
+
+
+procedure setfattr(var f;attr : word);
+begin
+  dosregs.edx:=longint(@filerec(f).name);
+  dosregs.ax:=$4301;
+  dosregs.cx:=attr;
+  msdos(dosregs);
+  LoadDosError;
+end;
+
+
+{******************************************************************************
+                             --- Environment ---
+******************************************************************************}
+
+function envcount : longint;
+var
+  hp : ppchar;
+begin
+  hp:=envp;
+  envcount:=0;
+  while assigned(hp^) do
+   begin
+     inc(envcount);
+     hp:=hp+4;
+   end;
+end;
+
+
+function envstr(index : integer) : string;
+begin
+  if (index<=0) or (index>envcount) then
+   begin
+     envstr:='';
+     exit;
+   end;
+  envstr:=strpas(ppchar(envp+4*(index-1))^);
+end;
+
+
+Function  GetEnv(envvar: string): string;
+var
+  hp      : ppchar;
+  hs    : string;
+  eqpos : longint;
+begin
+  envvar:=upcase(envvar);
+  hp:=envp;
+  getenv:='';
+  while assigned(hp^) do
+   begin
+     hs:=strpas(hp^);
+     eqpos:=pos('=',hs);
+     if copy(hs,1,eqpos-1)=envvar then
+      begin
+        getenv:=copy(hs,eqpos+1,255);
+        exit;
+      end;
+     hp:=hp+4;
+   end;
+end;
+
+
+{******************************************************************************
+                             --- Not Supported ---
+******************************************************************************}
+
+Procedure keep(exitcode : word);
+Begin
+End;
+
+Procedure getintvec(intno : byte;var vector : pointer);
+Begin
+End;
+
+Procedure setintvec(intno : byte;vector : pointer);
+Begin
+End;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.19  1998/11/23 13:53:59  peter
+    * more fexpand fixes from marco van de voort
+
+  Revision 1.18  1998/11/23 12:48:02  peter
+    * fexpand('o:') fixed to return o:\ (from the mailinglist)
+
+  Revision 1.17  1998/11/22 09:33:21  florian
+    * fexpand bug (temp. strings were too shoort) fixed, was reported
+      by Marco van de Voort
+
+  Revision 1.16  1998/11/17 09:37:41  pierre
+   * explicit conversion from word dosreg.ax to integer doserror
+
+  Revision 1.15  1998/11/01 20:27:18  peter
+    * fixed some doserror settings
+
+  Revision 1.14  1998/10/22 15:05:28  pierre
+   * fsplit adapted to long filenames
+
+  Revision 1.13  1998/09/16 16:47:24  peter
+    * merged fixes
+
+  Revision 1.11.2.2  1998/09/16 16:16:04  peter
+    * go32v1 compiles again
+
+  Revision 1.12  1998/09/11 12:46:44  pierre
+    * range check problem with LFN attr removed
+
+  Revision 1.11.2.1  1998/09/11 12:38:41  pierre
+    * conversion from LFN attr to Dos attr did not respect range checking
+
+  Revision 1.11  1998/08/28 10:45:58  peter
+    * fixed path buffer in findfirst
+
+  Revision 1.10  1998/08/27 10:30:48  pierre
+    * go32v1 RTL did not compile (LFNsupport outside go32v2 defines !)
+      I renamed tb_selector to tb_segment because
+        it is a real mode segment as opposed to
+        a protected mode selector
+      Fixed it for go32v1 (remove the $E0000000 offset !)
+
+  Revision 1.9  1998/08/26 10:04:01  peter
+    * new lfn check from mailinglist
+    * renamed win95 -> LFNSupport
+    + tb_selector, tb_offset for easier access to transferbuffer
+
+  Revision 1.8  1998/08/16 20:39:49  peter
+    + LFN Support
+
+  Revision 1.7  1998/08/16 09:12:13  michael
+  Corrected fexpand behaviour.
+
+  Revision 1.6  1998/08/05 21:01:50  michael
+  applied bugfix from maillist to fsearch
+
+  Revision 1.5  1998/05/31 14:18:13  peter
+    * force att or direct assembling
+    * cleanup of some files
+
+  Revision 1.4  1998/05/22 00:39:22  peter
+    * go32v1, go32v2 recompiles with the new objects
+    * remake3 works again with go32v2
+    - removed some "optimizes" from daniel which were wrong
+
+  Revision 1.3  1998/05/21 19:30:47  peter
+    * objects compiles for linux
+    + assign(pchar), assign(char), rename(pchar), rename(char)
+    * fixed read_text_as_array
+    + read_text_as_pchar which was not yet in the rtl
+}
+

rtl/dos/go32v1/filutil.inc → rtl/go32v1/filutil.inc

@@ -4,7 +4,7 @@
     Copyright (c) 1998 by the Free Pascal development team
 
     File utility calls
-    
+
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -18,132 +18,135 @@
 Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
 
 Begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function FileCreate (Const FileName : String) : Longint;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function FileWrite (Handle : Longint; Var Buffer; Count : Longint) : Longint;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function FileSeek (Handle,Offset,Origin : Longint) : Longint;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Procedure FileClose (Handle : Longint);
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function FileAge (Const FileName : String): Longint;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function FileExists (Const FileName : String) : Boolean;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function FindNext (Var Rslt : TSearchRec) : Longint;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Procedure FindClose (Var F : TSearchrec);
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function FileGetDate (Handle : Longint) : Longint;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function FileSetDate (Handle,Age : Longint) : Longint;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function FileGetAttr (Const FileName : String) : Longint;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function DeleteFile (Const FileName : String) : Boolean;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function RenameFile (Const OldName, NewName : String) : Boolean;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 Function FileSearch (Const Name, DirList : String) : String;
 
 begin
-  //!! Needs implementing    
+  //!! Needs implementing
 end;
 
 
 {
   $Log$
-  Revision 1.2  1998-10-12 08:02:56  michael
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.2  1998/10/12 08:02:56  michael
   wrong file committed
 
   Revision 1.1  1998/10/11 12:21:01  michael

rtl/dos/go32.pp → rtl/go32v1/go32.pp

@@ -16,7 +16,6 @@
 unit go32;
 
 {$S-}{no stack check, used by DPMIEXCP !! }
-{$i os.inc}
   interface
 
     const
@@ -172,7 +171,6 @@ unit go32;
     procedure dpmi_dosmemfillword(seg,ofs : word;count : longint;w : word);
 
 
-{$ifndef VER0_99_5}
 type
    tport = class
       procedure writeport(p : word;data : byte);
@@ -198,7 +196,6 @@ var
    portb : tport;
    portw : tportw;
    portl : tportl;
-{$endif VER0_99_5}
 
     const
        { this procedures are assigned to the procedure which are needed }
@@ -212,8 +209,6 @@ var
 
   implementation
 
-{$ifndef go32v2}
-
     { the following procedures copy from and to DOS memory without DPMI,
       these are not necessary for go32v2, because that requires dpmi (PFV) }
 
@@ -247,7 +242,6 @@ var
          fillword(pointer($e0000000+seg*16+ofs)^,count,w);
       end;
 
-{$endif}
 
     { the following procedures copy from and to DOS memory using DPMI }
     procedure dpmi_dosmemput(seg : word;ofs : word;var data;count : longint);
@@ -511,8 +505,6 @@ var
       end;
 
 
-{$ifndef VER0_99_5}
-
 { to give easy port access like tp with port[] }
 
 procedure tport.writeport(p : word;data : byte);assembler;
@@ -559,8 +551,6 @@ asm
         inl     %dx,%eax
 end ['EAX','EDX'];
 
-{$endif VER0_99_5}
-
 
     function get_cs : word;assembler;
       asm
@@ -751,11 +741,7 @@ end ['EAX','EDX'];
             movl  pm_func,%esi
             movl  reg,%edi
             pushw %es
-{$ifdef GO32V2}
-            movw  ___v2prt0_ds_alias,%ax
-{$else GO32V2}
             movw  %ds,%ax
-{$endif GO32V2}
             movw  %ax,%es
             pushw %ds
             movw  %cs,%ax
@@ -1165,12 +1151,8 @@ end ['EAX','EDX'];
 
     function tb_segment : longint;
       begin
-{$ifdef go32v2}
-        tb_segment:=go32_info_block.linear_address_of_transfer_buffer shr 4;
-{$else  i.E. for go32v1}
         { all real mode memory is mapped to $E000000 location !! }
         tb_segment:=(go32_info_block.linear_address_of_transfer_buffer shr 4) and $FFFF;
-{$endif go32v2}
       end;
 
 
@@ -1190,11 +1172,7 @@ end ['EAX','EDX'];
        begin
           if len>tb_size then
             runerror(217);
-{$ifdef GO32V2}
-          seg_move(get_ds,longint(@addr),dosmemselector,transfer_buffer,len);
-{$else GO32V2}
           move(addr,pointer(transfer_buffer)^,len);
-{$endif GO32V2}
        end;
 
 
@@ -1202,18 +1180,13 @@ end ['EAX','EDX'];
        begin
           if len>tb_size then
             runerror(217);
-{$ifdef GO32V2}
-          seg_move(dosmemselector,transfer_buffer,get_ds,longint(@addr),len);
-{$else GO32V2}
           move(pointer(transfer_buffer)^,addr,len);
-{$endif GO32V2}
        end;
 
 
 
 begin
    int31error:=0;
-{$ifndef go32v2}
    if not (get_run_mode=rm_dpmi) then
      begin
         dosmemget:=@raw_dosmemget;
@@ -1223,7 +1196,6 @@ begin
         dosmemfillword:=@raw_dosmemfillword;
      end
    else
-{$endif}
      begin
        dosmemselector:=get_core_selector;
      end;
@@ -1231,7 +1203,10 @@ end.
 
 {
   $Log$
-  Revision 1.12  1998-08-27 10:30:50  pierre
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.12  1998/08/27 10:30:50  pierre
     * go32v1 RTL did not compile (LFNsupport outside go32v2 defines !)
       I renamed tb_selector to tb_segment because
         it is a real mode segment as opposed to

rtl/dos/mouse.pp → rtl/go32v1/mouse.pp

@@ -389,7 +389,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.5  1998-07-15 16:10:35  jonas
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.5  1998/07/15 16:10:35  jonas
   * new mouse uni
 
   Revision 1.3  1998/04/05 13:56:54  peter

rtl/dos/go32v1/objinc.inc → rtl/go32v1/objinc.inc

@@ -173,7 +173,10 @@ END;
 
 {
   $Log$
-  Revision 1.4  1998-07-06 12:26:19  carl
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.4  1998/07/06 12:26:19  carl
     * Glurbl.... now work perfectly! Do not change :)
 
   Revision 1.3  1998/07/02 12:25:27  carl

rtl/dos/go32v1/os.inc → rtl/go32v1/os.inc

@@ -19,7 +19,10 @@
 
 {
   $Log$
-  Revision 1.2  1998-05-22 00:39:31  peter
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.2  1998/05/22 00:39:31  peter
     * go32v1, go32v2 recompiles with the new objects
     * remake3 works again with go32v2
     - removed some "optimizes" from daniel which were wrong

rtl/dos/printer.pp → rtl/go32v1/printer.pp

@@ -5,7 +5,7 @@
     member of the Free Pascal development team
 
     Printer unit for BP7 compatible RTL
-    
+
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -16,21 +16,21 @@
  **********************************************************************}
 unit printer;
 interface
-  
+
 var
   lst : text;
-       
+
 implementation
-  
+
 var
   old_exit : pointer;
-  
+
 procedure printer_exit;
 begin
   close(lst);
   exitproc:=old_exit;
 end;
-    
+
 
 begin
   assign(lst,'PRN');
@@ -40,7 +40,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  1998-05-22 00:39:26  peter
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.2  1998/05/22 00:39:26  peter
     * go32v1, go32v2 recompiles with the new objects
     * remake3 works again with go32v2
     - removed some "optimizes" from daniel which were wrong

rtl/dos/go32v1/prt0.as → rtl/go32v1/prt0.as

@@ -177,7 +177,10 @@ __core_select:
         .short  0
 #
 # $Log$
-# Revision 1.4  1998-08-04 13:35:34  carl
+# Revision 1.1  1998-12-21 13:07:02  peter
+#   * use -FE
+#
+# Revision 1.4  1998/08/04 13:35:34  carl
 #   * stack size default is 256Kb! not 16K! as information stated by Pierre
 #
 # Revision 1.3  1998/05/22 00:39:32  peter

rtl/dos/go32v1/system.pp → rtl/go32v1/system.pp

@@ -612,7 +612,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.12  1998-12-15 22:42:51  peter
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.12  1998/12/15 22:42:51  peter
     * removed temp symbols
 
   Revision 1.11  1998/11/29 22:28:09  peter

rtl/dos/go32v2/Makefile → rtl/go32v2/Makefile

@@ -52,14 +52,15 @@ OS_TARGET=go32v2
 CPU=i386
 
 # Where are the include files
-RTL=../..
+RTL=..
 CFG=$(RTL)/cfg
 INC=$(RTL)/inc
 PROCINC=$(RTL)/$(CPU)
 OBJPASDIR=$(RTL)/objpas
-# Where are the .ppi files.
-PPI=../ppi
+PPI=ppi
 
+# Where to place the result files
+TARGETDIR=.
 
 #####################################################################
 # Include default makefile
@@ -78,7 +79,8 @@ SYSTEMPPU=system$(PPUEXT)
 OBJECTS=strings go32 \
 	dpmiexcp profile dxeload emu387 \
 	dos crt objects printer \
-	cpu mmx mouse getopts heaptrc graph objpas sysutils
+        objpas sysutils typinfo \
+	cpu mmx mouse getopts heaptrc graph
 
 LOADERS=prt0 exceptn fpu
 
@@ -152,30 +154,16 @@ $(SYSTEMPPU) : system.pp $(SYSDEPS)
 	$(COMPILER) -Us -Sg system.pp $(REDIR)
 
 strings$(PPUEXT) : $(PROCINC)/strings.pp $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/strings.pp .
-	$(COMPILER) strings.pp $(REDIR)
-	$(DEL) strings.pp
+	$(COMPILER) $(PROCINC)/strings.pp $(REDIR)
 
-go32$(PPUEXT) : ../go32.pp $(SYSTEMPPU)
-	$(COPY) ../go32.pp .
+go32$(PPUEXT) : go32.pp $(SYSTEMPPU)
 	$(COMPILER) go32.pp $(REDIR)
-	$(DEL) go32.pp
 
 #
 # Delphi Object Model
 #
 
-objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp $(INC)/except.inc
-	$(COPY) $(OBJPASDIR)/objpas.pp .
-	$(COMPILER) -S2 -I$(OBJPASDIR) objpas $(REDIR)
-	$(DEL) objpas.pp
-
-SYSUTILINC = $(wildcard $(OBJPASDIR)/*.inc)
-
-sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(SYSUTILINC) filutil.inc disk.inc
-	$(COPY) $(OBJPASDIR)/sysutils.pp .
-	$(COMPILER) -S2 -I$(OBJPASDIR) sysutils $(REDIR)
-	$(DEL) sysutils.pp
+include $(OBJPASDIR)/makefile.op
 
 
 #
@@ -186,75 +174,55 @@ sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(SYSUTILINC) filutil.inc disk.inc
 dpmiexcp$(PPUEXT) : dpmiexcp.pp exceptn$(OEXT) $(SYSTEMPPU)
 	$(COMPILER) -Sg -Sv dpmiexcp.pp $(REDIR)
 
-profile$(PPUEXT) : profile.pp dpmiexcp$(PPUEXT) go32$(PPUEXT) $(SYSTEMPPU)
+profile$(PPUEXT) : profile.pp dpmiexcp$(PPUEXT) go32$(PPUEXT)
 	$(COMPILER) profile.pp $(REDIR)
 
 dxeload$(PPUEXT) : dxeload.pp $(SYSTEMPPU)
 	$(COMPILER) dxeload.pp $(REDIR)
 
 emu387$(PPUEXT) : emu387.pp fpu$(OEXT) strings$(PPUEXT) dxeload$(PPUEXT) \
-		  dpmiexcp$(PPUEXT) $(SYSTEMPPU)
+		  dpmiexcp$(PPUEXT)
 	$(COMPILER) emu387.pp $(REDIR)
 
 #
 # TP7 Compatible RTL Units
 #
 
-dos$(PPUEXT) : ../dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
 	       go32$(PPUEXT) strings$(PPUEXT) $(SYSTEMPPU)
-	$(COPY) ../dos.pp .
-	$(COMPILER) dos $(REDIR)
-	$(DEL) dos.pp
+	$(COMPILER) dos.pp $(REDIR)
 
-crt$(PPUEXT) : ../crt.pp $(INC)/textrec.inc go32$(PPUEXT) $(SYSTEMPPU)
-	$(COPY) ../crt.pp .
-	$(COMPILER) crt $(REDIR)
-	$(DEL) crt.pp
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) $(SYSTEMPPU)
+	$(COMPILER) crt.pp $(REDIR)
 
 objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
-	$(COPY) $(INC)/objects.pp .
-	$(COMPILER) objects.pp $(REDIR)
-	$(DEL) objects.pp
+	$(COMPILER) $(INC)/objects.pp $(REDIR)
 
-printer$(PPUEXT) : ../printer.pp $(SYSTEMPPU)
-	$(COPY) ../printer.pp .
+printer$(PPUEXT) : printer.pp $(SYSTEMPPU)
 	$(COMPILER) printer.pp $(REDIR)
-	$(DEL) printer.pp
 
 #
 # Other RTL Units
 #
 
 cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/cpu.pp .
-	$(COMPILER) cpu.pp $(REDIR)
-	$(DEL) cpu.pp
+	$(COMPILER) $(PROCINC)/cpu.pp $(REDIR)
 
 mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/mmx.pp .
-	$(COMPILER) mmx.pp $(REDIR)
-	$(DEL) mmx.pp
+	$(COMPILER) $(PROCINC)/mmx.pp $(REDIR)
 
-mouse$(PPUEXT) : ../mouse.pp $(SYSTEMPPU)
-	$(COPY) ../mouse.pp .
+mouse$(PPUEXT) : mouse.pp $(SYSTEMPPU)
 	$(COMPILER) mouse.pp $(REDIR)
-	$(DEL) mouse.pp
 
 getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
-	$(COPY) $(INC)/getopts.pp .
-	$(COMPILER) getopts.pp $(REDIR)
-	$(DEL) getopts.pp
+	$(COMPILER) $(INC)/getopts.pp $(REDIR)
 
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
-	$(COPY) $(INC)/heaptrc.pp .
-	$(COMPILER) heaptrc $(REDIR)
-	$(DEL) heaptrc.pp
+	$(COMPILER) $(INC)/heaptrc.pp $(REDIR)
 
 PPIFILES:=$(wildcard $(PPI)/*.ppi)
-graph$(PPUEXT) : ../graph.pp go32$(PPUEXT) $(SYSTEMPPU) mmx$(PPUEXT) $(PPIFILES)
-	$(COPY) ../graph.pp .
-	$(COMPILER) -I$(PPI) graph $(REDIR)
-	$(DEL) graph.pp
+graph$(PPUEXT) : graph.pp go32$(PPUEXT) $(SYSTEMPPU) mmx$(PPUEXT) $(PPIFILES)
+	$(COMPILER) -I$(PPI) graph.pp $(REDIR)
 
 
 #####################################################################
@@ -290,7 +258,10 @@ include $(CFG)/makefile.def
 
 #
 # $Log$
-# Revision 1.12  1998-11-24 23:06:40  peter
+# Revision 1.1  1998-12-21 13:07:02  peter
+#   * use -FE
+#
+# Revision 1.12  1998/11/24 23:06:40  peter
 #   * removed platform.inc
 #
 # Revision 1.11  1998/11/24 19:50:01  jonas

rtl/go32v2/crt.pp

@@ -0,0 +1,843 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1993-98 by the Free Pascal development team.
+
+    Borland Pascal 7 Compatible CRT Unit for Go32V1 and Go32V2
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit crt;
+interface
+
+const
+{ CRT modes }
+  BW40          = 0;            { 40x25 B/W on Color Adapter }
+  CO40          = 1;            { 40x25 Color on Color Adapter }
+  BW80          = 2;            { 80x25 B/W on Color Adapter }
+  CO80          = 3;            { 80x25 Color on Color Adapter }
+  Mono          = 7;            { 80x25 on Monochrome Adapter }
+  Font8x8       = 256;          { Add-in for ROM font }
+
+{ Mode constants for 3.0 compatibility }
+  C40           = CO40;
+  C80           = CO80;
+
+{ Foreground and background color constants }
+  Black         = 0;
+  Blue          = 1;
+  Green         = 2;
+  Cyan          = 3;
+  Red           = 4;
+  Magenta       = 5;
+  Brown         = 6;
+  LightGray     = 7;
+
+{ Foreground color constants }
+  DarkGray      = 8;
+  LightBlue     = 9;
+  LightGreen    = 10;
+  LightCyan     = 11;
+  LightRed      = 12;
+  LightMagenta  = 13;
+  Yellow        = 14;
+  White         = 15;
+
+{ Add-in for blinking }
+  Blink         = 128;
+
+var
+
+{ Interface variables }
+  CheckBreak: Boolean;    { Enable Ctrl-Break }
+  CheckEOF: Boolean;      { Enable Ctrl-Z }
+  DirectVideo: Boolean;   { Enable direct video addressing }
+  CheckSnow: Boolean;     { Enable snow filtering }
+  LastMode: Word;         { Current text mode }
+  TextAttr: Byte;         { Current text attribute }
+  WindMin: Word;          { Window upper left coordinates }
+  WindMax: Word;          { Window lower right coordinates }
+
+{ Interface procedures }
+procedure AssignCrt(var F: Text);
+function KeyPressed: Boolean;
+function ReadKey: Char;
+procedure TextMode(Mode: Integer);
+procedure Window(X1,Y1,X2,Y2: Byte);
+procedure GotoXY(X,Y: Byte);
+function WhereX: Byte;
+function WhereY: Byte;
+procedure ClrScr;
+procedure ClrEol;
+procedure InsLine;
+procedure DelLine;
+procedure TextColor(Color: Byte);
+procedure TextBackground(Color: Byte);
+procedure LowVideo;
+procedure HighVideo;
+procedure NormVideo;
+procedure Delay(MS: Word);
+procedure Sound(Hz: Word);
+procedure NoSound;
+
+{Extra Functions}
+procedure cursoron;
+procedure cursoroff;
+procedure cursorbig;
+
+
+implementation
+
+uses
+  go32;
+
+
+{$ASMMODE ATT}
+
+var
+  DelayCnt,  { don't modify this var name, as it is hard coded }
+  ScreenWidth,
+  ScreenHeight : longint;
+
+
+{
+  definition of textrec is in textrec.inc
+}
+{$i textrec.inc}
+
+
+{****************************************************************************
+                           Low level Routines
+****************************************************************************}
+
+procedure setscreenmode(mode : byte);
+var
+  regs : trealregs;
+begin
+  regs.realeax:=mode;
+  realintr($10,regs);
+end;
+
+
+function GetScreenHeight : longint;
+begin
+  getscreenheight:=mem[$40:$84]+1;
+end;
+
+
+function GetScreenWidth : longint;
+begin
+  getscreenwidth:=mem[$40:$4a];
+end;
+
+
+procedure SetScreenCursor(x,y : longint);
+var
+  regs : trealregs;
+begin
+  regs.realeax:=$0200;
+  regs.realebx:=0;
+  regs.realedx:=(y-1) shl 8+(x-1);
+  realintr($10,regs);
+end;
+
+
+procedure GetScreenCursor(var x,y : longint);
+begin
+  x:=mem[$40:$50]+1;
+  y:=mem[$40:$51]+1;
+end;
+
+
+{****************************************************************************
+                              Helper Routines
+****************************************************************************}
+
+Function WinMinX: Byte;
+{
+  Current Minimum X coordinate
+}
+Begin
+  WinMinX:=(WindMin and $ff)+1;
+End;
+
+
+
+Function WinMinY: Byte;
+{
+  Current Minimum Y Coordinate
+}
+Begin
+  WinMinY:=(WindMin shr 8)+1;
+End;
+
+
+
+Function WinMaxX: Byte;
+{
+  Current Maximum X coordinate
+}
+Begin
+  WinMaxX:=(WindMax and $ff)+1;
+End;
+
+
+
+Function WinMaxY: Byte;
+{
+  Current Maximum Y coordinate;
+}
+Begin
+  WinMaxY:=(WindMax shr 8) + 1;
+End;
+
+
+
+Function FullWin:boolean;
+{
+  Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines
+}
+begin
+  FullWin:=(WindMax-WindMin=$184f);
+end;
+
+
+{****************************************************************************
+                             Public Crt Functions
+****************************************************************************}
+
+
+procedure textmode(mode : integer);
+begin
+  lastmode:=mode;
+  mode:=mode and $ff;
+  setscreenmode(mode);
+  screenwidth:=getscreenwidth;
+  screenheight:=getscreenheight;
+  windmin:=0;
+  windmax:=(screenwidth-1) or ((screenheight-1) shl 8);
+end;
+
+
+Procedure TextColor(Color: Byte);
+{
+  Switch foregroundcolor
+}
+Begin
+  TextAttr:=(Color and $8f) or (TextAttr and $70);
+End;
+
+
+
+Procedure TextBackground(Color: Byte);
+{
+  Switch backgroundcolor
+}
+Begin
+  TextAttr:=(Color shl 4) or (TextAttr and $0f);
+End;
+
+
+
+Procedure HighVideo;
+{
+  Set highlighted output.
+}
+Begin
+  TextColor(TextAttr Or $08);
+End;
+
+
+
+Procedure LowVideo;
+{
+  Set normal output
+}
+Begin
+  TextColor(TextAttr And $77);
+End;
+
+
+
+Procedure NormVideo;
+{
+  Set normal back and foregroundcolors.
+}
+Begin
+  TextColor(7);
+  TextBackGround(0);
+End;
+
+
+Procedure GotoXy(X: Byte; Y: Byte);
+{
+  Go to coordinates X,Y in the current window.
+}
+Begin
+  If (X>0) and (X<=WinMaxX- WinMinX+1) and
+     (Y>0) and (Y<=WinMaxY-WinMinY+1) Then
+   Begin
+     Inc(X,WinMinX-1);
+     Inc(Y,WinMinY-1);
+     SetScreenCursor(x,y);
+   End;
+End;
+
+
+Procedure Window(X1, Y1, X2, Y2: Byte);
+{
+  Set screen window to the specified coordinates.
+}
+Begin
+  if (X1>X2) or (X2>ScreenWidth) or
+     (Y1>Y2) or (Y2>ScreenHeight) then
+   exit;
+  WindMin:=((Y1-1) Shl 8)+(X1-1);
+  WindMax:=((Y2-1) Shl 8)+(X2-1);
+  GoToXY(1,1);
+End;
+
+
+Procedure ClrScr;
+{
+  Clear the current window, and set the cursor on 1,1
+}
+var
+  fil : word;
+  y   : longint;
+begin
+  fil:=32 or (textattr shl 8);
+  if FullWin then
+   DosmemFillWord($b800,0,ScreenHeight*ScreenWidth,fil)
+  else
+   begin
+     for y:=WinMinY to WinMaxY do
+      DosmemFillWord($b800,((y-1)*ScreenWidth+(WinMinX-1))*2,WinMaxX-WinMinX+1,fil);
+   end;
+  Gotoxy(1,1);
+end;
+
+
+Procedure ClrEol;
+{
+  Clear from current position to end of line.
+}
+var
+  x,y : longint;
+  fil : word;
+Begin
+  GetScreenCursor(x,y);
+  fil:=32 or (textattr shl 8);
+  if x<WinMaxX then
+   DosmemFillword($b800,((y-1)*ScreenWidth+(x-1))*2,WinMaxX-x+1,fil);
+End;
+
+
+
+Function WhereX: Byte;
+{
+  Return current X-position of cursor.
+}
+var
+  x,y : longint;
+Begin
+  GetScreenCursor(x,y);
+  WhereX:=x-WinMinX+1;
+End;
+
+
+
+Function WhereY: Byte;
+{
+  Return current Y-position of cursor.
+}
+var
+  x,y : longint;
+Begin
+  GetScreenCursor(x,y);
+  WhereY:=y-WinMinY+1;
+End;
+
+
+{*************************************************************************
+                            KeyBoard
+*************************************************************************}
+
+var
+   is_last : boolean;
+   last    : char;
+
+function readkey : char;
+var
+  char2 : char;
+  char1 : char;
+  regs : trealregs;
+begin
+  if is_last then
+   begin
+     is_last:=false;
+     readkey:=last;
+   end
+  else
+   begin
+     regs.realeax:=$0000;
+     realintr($16,regs);
+     char1:=chr(regs.realeax and $ff);
+     char2:=chr((regs.realeax and $ff00) shr 8);
+     if char1=#0 then
+      begin
+        is_last:=true;
+        last:=char2;
+      end;
+     readkey:=char1;
+   end;
+end;
+
+
+function keypressed : boolean;
+var
+  regs : trealregs;
+begin
+  if is_last then
+   begin
+     keypressed:=true;
+     exit;
+   end
+  else
+   begin
+     regs.realeax:=$0100;
+     realintr($16,regs);
+     keypressed:=((regs.realflags and zeroflag) = 0);
+   end;
+end;
+
+
+{*************************************************************************
+                                   Delay
+*************************************************************************}
+
+procedure Delayloop;assembler;
+asm
+.LDelayLoop1:
+        subl    $1,%eax
+        jc      .LDelayLoop2
+        cmpl    %fs:(%edi),%ebx
+        je      .LDelayLoop1
+.LDelayLoop2:
+end;
+
+
+procedure initdelay;assembler;
+asm
+        movl    $0x46c,%edi
+        movl    $-28,%edx
+        movl    %fs:(%edi),%ebx
+.LInitDel1:
+        cmpl    %fs:(%edi),%ebx
+        je      .LInitDel1
+        movl    %fs:(%edi),%ebx
+        movl    %edx,%eax
+        call    DelayLoop
+
+        notl    %eax
+        xorl    %edx,%edx
+        movl    $55,%ecx
+        divl    %ecx
+        movl    %eax,DelayCnt
+end;
+
+
+procedure Delay(MS: Word);assembler;
+asm
+        movzwl  MS,%ecx
+        jecxz   .LDelay2
+        movl    $0x400,%edi
+        movl    DelayCnt,%edx
+        movl    %fs:(%edi),%ebx
+.LDelay1:
+        movl    %edx,%eax
+        call    DelayLoop
+        loop    .LDelay1
+.LDelay2:
+end;
+
+
+procedure sound(hz : word);
+begin
+  if hz=0 then
+   begin
+     nosound;
+     exit;
+   end;
+  asm
+        movzwl  hz,%ecx
+        movl    $1193046,%eax
+        cltd
+        divl    %ecx
+        movl    %eax,%ecx
+        movb    $0xb6,%al
+        outb    %al,$0x43
+        movb    %cl,%al
+        outb    %al,$0x42
+        movb    %ch,%al
+        outb    %al,$0x42
+        inb     $0x61,%al
+        orb     $0x3,%al
+        outb    %al,$0x61
+  end ['EAX','ECX','EDX'];
+end;
+
+
+procedure nosound;
+begin
+  asm
+        inb     $0x61,%al
+        andb    $0xfc,%al
+        outb    %al,$0x61
+  end ['EAX'];
+end;
+
+
+
+{****************************************************************************
+                          HighLevel Crt Functions
+****************************************************************************}
+
+procedure removeline(y : longint);
+var
+  fil : word;
+begin
+  fil:=32 or (textattr shl 8);
+  y:=WinMinY+y-1;
+  While (y<WinMaxY) do
+   begin
+     dosmemmove($b800,(y*ScreenWidth+(WinMinX-1))*2,
+                $b800,((y-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1)*2);
+     inc(y);
+   end;
+  dosmemfillword($b800,((WinMaxY-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1),fil);
+end;
+
+
+procedure delline;
+begin
+  removeline(wherey);
+end;
+
+
+procedure insline;
+var
+  my,y : longint;
+  fil : word;
+begin
+  fil:=32 or (textattr shl 8);
+  y:=WhereY;
+  my:=WinMaxY-WinMinY;
+  while (my>=y) do
+   begin
+     dosmemmove($b800,(((WinMinY+my-1)-1)*ScreenWidth+(WinMinX-1))*2,
+                $b800,(((WinMinY+my)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1)*2);
+     dec(my);
+   end;
+  dosmemfillword($b800,(((WinMinY+y-1)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1),fil);
+end;
+
+
+
+
+{****************************************************************************
+                             Extra Crt Functions
+****************************************************************************}
+
+procedure cursoron;
+var
+  regs : trealregs;
+begin
+  regs.realeax:=$0100;
+  regs.realecx:=$90A;
+  realintr($10,regs);
+end;
+
+
+procedure cursoroff;
+var
+  regs : trealregs;
+begin
+  regs.realeax:=$0100;
+  regs.realecx:=$ffff;
+  realintr($10,regs);
+end;
+
+
+procedure cursorbig;
+var
+  regs : trealregs;
+begin
+  regs.realeax:=$0100;
+  regs.realecx:=$10A;
+  realintr($10,regs);
+end;
+
+
+{*****************************************************************************
+                          Read and Write routines
+*****************************************************************************}
+
+var
+  CurrX,CurrY : longint;
+
+Procedure WriteChar(c:char);
+var
+  regs : trealregs;
+begin
+  case c of
+   #10 : inc(CurrY);
+   #13 : CurrX:=WinMinX;
+    #8 : begin
+           if CurrX>WinMinX then
+            dec(CurrX);
+         end;
+    #7 : begin { beep }
+           regs.dl:=7;
+           regs.ah:=2;
+           realintr($21,regs);
+         end;
+  else
+   begin
+     memw[$b800:((CurrY-1)*ScreenWidth+(CurrX-1))*2]:=(textattr shl 8) or byte(c);
+     inc(CurrX);
+   end;
+  end;
+  if CurrX>WinMaxX then
+   begin
+     CurrX:=WinMinX;
+     inc(CurrY);
+   end;
+  while CurrY>WinMaxY do
+   begin
+     removeline(1);
+     dec(CurrY);
+   end;
+end;
+
+
+Function CrtWrite(var f : textrec):integer;
+var
+  i : longint;
+begin
+  GetScreenCursor(CurrX,CurrY);
+  for i:=0 to f.bufpos-1 do
+   WriteChar(f.buffer[i]);
+  SetScreenCursor(CurrX,CurrY);
+  f.bufpos:=0;
+  CrtWrite:=0;
+end;
+
+
+Function CrtRead(Var F: TextRec): Integer;
+
+  procedure BackSpace;
+  begin
+    if (f.bufpos>0) and (f.bufpos=f.bufend) then
+     begin
+       WriteChar(#8);
+       WriteChar(' ');
+       WriteChar(#8);
+       dec(f.bufpos);
+       dec(f.bufend);
+     end;
+  end;
+
+var
+  ch : Char;
+Begin
+  GetScreenCursor(CurrX,CurrY);
+  f.bufpos:=0;
+  f.bufend:=0;
+  repeat
+    if f.bufpos>f.bufend then
+     f.bufend:=f.bufpos;
+    SetScreenCursor(CurrX,CurrY);
+    ch:=readkey;
+    case ch of
+    #0 : case readkey of
+          #71 : while f.bufpos>0 do
+                 begin
+                   dec(f.bufpos);
+                   WriteChar(#8);
+                 end;
+          #75 : if f.bufpos>0 then
+                 begin
+                   dec(f.bufpos);
+                   WriteChar(#8);
+                 end;
+          #77 : if f.bufpos<f.bufend then
+                 begin
+                   WriteChar(f.bufptr^[f.bufpos]);
+                   inc(f.bufpos);
+                 end;
+          #79 : while f.bufpos<f.bufend do
+                 begin
+                   WriteChar(f.bufptr^[f.bufpos]);
+                   inc(f.bufpos);
+                 end;
+         end;
+    ^S,
+    #8 : BackSpace;
+    ^Y,
+   #27 : begin
+           f.bufpos:=f.bufend;
+           while f.bufend>0 do
+            BackSpace;
+         end;
+   #13 : begin
+           WriteChar(#13);
+           WriteChar(#10);
+           f.bufptr^[f.bufend]:=#13;
+           f.bufptr^[f.bufend+1]:=#10;
+           inc(f.bufend,2);
+           break;
+         end;
+   #26 : if CheckEOF then
+          begin
+            f.bufptr^[f.bufend]:=#26;
+            inc(f.bufend);
+            break;
+          end;
+    else
+     begin
+       if f.bufpos<f.bufsize-2 then
+        begin
+          f.buffer[f.bufpos]:=ch;
+          inc(f.bufpos);
+          WriteChar(ch);
+        end;
+     end;
+    end;
+  until false;
+  f.bufpos:=0;
+  SetScreenCursor(CurrX,CurrY);
+  CrtRead:=0;
+End;
+
+
+Function CrtReturn:Integer;
+Begin
+  CrtReturn:=0;
+end;
+
+
+Function CrtClose(Var F: TextRec): Integer;
+Begin
+  F.Mode:=fmClosed;
+  CrtClose:=0;
+End;
+
+
+Function CrtOpen(Var F: TextRec): Integer;
+Begin
+  If F.Mode=fmOutput Then
+   begin
+     TextRec(F).InOutFunc:=@CrtWrite;
+     TextRec(F).FlushFunc:=@CrtWrite;
+   end
+  Else
+   begin
+     F.Mode:=fmInput;
+     TextRec(F).InOutFunc:=@CrtRead;
+     TextRec(F).FlushFunc:=@CrtReturn;
+   end;
+  TextRec(F).CloseFunc:=@CrtClose;
+  CrtOpen:=0;
+End;
+
+
+procedure AssignCrt(var F: Text);
+begin
+  Assign(F,'');
+  TextRec(F).OpenFunc:=@CrtOpen;
+end;
+
+
+var
+  x,y : longint;
+begin
+{ Load startup values }
+  ScreenWidth:=GetScreenWidth;
+  ScreenHeight:=GetScreenHeight;
+  WindMax:=(ScreenWidth-1) or ((ScreenHeight-1) shl 8);
+{ Load TextAttr }
+  GetScreenCursor(x,y);
+  TextAttr:=mem[$b800:((y-1)*ScreenWidth+(x-1))*2+1];
+  lastmode:=mem[$40:$49];
+{ Redirect the standard output }
+  assigncrt(Output);
+  Rewrite(Output);
+  TextRec(Output).Handle:=StdOutputHandle;
+  assigncrt(Input);
+  Reset(Input);
+  TextRec(Input).Handle:=StdInputHandle;
+{ Calculates delay calibration }
+  initdelay;
+end.
+
+{
+  $Log$
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.17  1998/12/15 22:42:49  peter
+    * removed temp symbols
+
+  Revision 1.16  1998/12/09 23:04:36  jonas
+    * fixed bug in InsLine (changed "my" from "WinMaxY -1" to "WinMaxY - WinMinY")
+
+  Revision 1.15  1998/11/28 14:09:48  peter
+    * NOATTCDQ define
+
+  Revision 1.14  1998/11/26 23:14:52  jonas
+    * changed cdq to cltd in AT&T assembler block
+
+  Revision 1.13  1998/08/26 10:01:54  peter
+    * fixed readln cursor position
+
+  Revision 1.12  1998/08/19 17:57:55  peter
+    * fixed crtread with wrong cursor position
+
+  Revision 1.11  1998/08/19 14:55:44  peter
+    * fixed removeline which scrolled too much lines
+
+  Revision 1.10  1998/08/18 13:32:46  carl
+    * bugfix to make it work with FPC 0.99.5 (Delayloop is not correctly
+  converted by ATT parser)
+
+  Revision 1.9  1998/08/15 17:00:10  peter
+    * moved delaycnt from interface to implementation
+
+  Revision 1.8  1998/08/08 21:56:45  peter
+    * updated crt with new delay, almost like bp7 routine
+
+  Revision 1.5  1998/05/31 14:18:12  peter
+    * force att or direct assembling
+    * cleanup of some files
+
+  Revision 1.4  1998/05/28 10:21:38  pierre
+    * Handles of input and output restored
+
+  Revision 1.3  1998/05/27 00:19:16  peter
+    * fixed crt input
+
+  Revision 1.2  1998/05/21 19:30:46  peter
+    * objects compiles for linux
+    + assign(pchar), assign(char), rename(pchar), rename(char)
+    * fixed read_text_as_array
+    + read_text_as_pchar which was not yet in the rtl
+}
+
+

rtl/dos/go32v2/disk.inc → rtl/go32v2/disk.inc

@@ -80,7 +80,10 @@ end;
 
 {
  $Log$
- Revision 1.2  1998-10-30 14:13:13  michael
+ Revision 1.1  1998-12-21 13:07:02  peter
+   * use -FE
+
+ Revision 1.2  1998/10/30 14:13:13  michael
  + Implementation of functions by Gertjan Schouten
 
  Revision 1.1  1998/10/11 13:42:55  michael

rtl/dos/dos.pp → rtl/go32v2/dos.pp

@@ -14,11 +14,10 @@
 
  **********************************************************************}
 unit dos;
-
-{$I os.inc}
-
 interface
-Uses Go32;
+
+Uses
+  Go32;
 
 Const
   {Bitmasks for CPU Flags}
@@ -46,20 +45,12 @@ Const
 
 
 Type
-{$IFDEF GO32V2}
 { Needed for LFN Support }
   ComStr  = String[255];
   PathStr = String[255];
   DirStr  = String[255];
   NameStr = String[255];
   ExtStr  = String[255];
-{$ELSE}
-  comstr  = string[127];        { command line string }
-  pathstr = string[79];         { string for a file path }
-  dirstr  = string[67];         { string for a directory }
-  namestr = string[8];          { string for a file name }
-  extstr  = string[4];          { string for an extension }
-{$ENDIF}
 
 {
   filerec.inc contains the definition of the filerec.
@@ -79,8 +70,6 @@ Type
     Sec   : word;
   End;
 
-{$ifdef GO32V2}
-
   searchrec = packed record
      fill : array[1..21] of byte;
      attr : byte;
@@ -92,25 +81,6 @@ Type
 
   Registers = Go32.Registers;
 
-{$ELSE}
-
-  searchrec = packed record
-     fill     : array[1..21] of byte;
-     attr     : byte;
-     time     : longint;
-     reserved : word; { requires the DOS extender (DJ GNU-C) }
-     size     : longint;
-     name     : string[15]; { the same size as declared by (DJ GNU C) }
-  end;
-
-  registers = packed record
-    case i : integer of
-     0 : (ax,f1,bx,f2,cx,f3,dx,f4,bp,f5,si,f51,di,f6,ds,f7,es,f8,flags,fs,gs : word);
-     1 : (al,ah,f9,f10,bl,bh,f11,f12,cl,ch,f13,f14,dl,dh : byte);
-     2 : (eax,  ebx,  ecx,  edx,  ebp,  esi,  edi : longint);
-    end;
-{$endif GO32V1}
-
 Var
   DosError : integer;
 
@@ -178,81 +148,22 @@ uses
 var
   dosregs : registers;
 
-    procedure LoadDosError;
-      begin
-        if (dosregs.flags and carryflag) <> 0 then
-        { conversion from word to integer !!
-          gave a Bound check error if ax is $FFFF !! PM }
-         doserror:=integer(dosregs.ax)
-        else
-         doserror:=0;
-      end;
-
-{$ifdef GO32V2}
+procedure LoadDosError;
+begin
+  if (dosregs.flags and carryflag) <> 0 then
+  { conversion from word to integer !!
+    gave a Bound check error if ax is $FFFF !! PM }
+    doserror:=integer(dosregs.ax)
+  else
+    doserror:=0;
+end;
 
-    procedure intr(intno : byte;var regs : registers);
-      begin
-         realintr(intno,regs);
-      end;
 
-{$else GO32V2}
-{$ASMMODE DIRECT}
-    procedure intr(intno : byte;var regs : registers);
+procedure intr(intno : byte;var regs : registers);
+begin
+  realintr(intno,regs);
+end;
 
-      begin
-         asm
-            .data
-    int86:
-            .byte        0xcd
-    int86_vec:
-            .byte        0x03
-            jmp        int86_retjmp
-
-            .text
-            movl        8(%ebp),%eax
-            movb        %al,int86_vec
-
-            movl        10(%ebp),%eax
-            // do not use first int
-            addl        $2,%eax
-
-            movl        4(%eax),%ebx
-            movl        8(%eax),%ecx
-            movl        12(%eax),%edx
-            movl        16(%eax),%ebp
-            movl        20(%eax),%esi
-            movl        24(%eax),%edi
-            movl        (%eax),%eax
-
-            jmp        int86
-    int86_retjmp:
-            pushf
-            pushl       %ebp
-            pushl       %eax
-            movl        %esp,%ebp
-            // calc EBP new
-            addl        $12,%ebp
-            movl        10(%ebp),%eax
-            // do not use first int
-            addl        $2,%eax
-
-            popl        (%eax)
-            movl        %ebx,4(%eax)
-            movl        %ecx,8(%eax)
-            movl        %edx,12(%eax)
-            // restore EBP
-            popl        %edx
-            movl        %edx,16(%eax)
-            movl        %esi,20(%eax)
-            movl        %edi,24(%eax)
-            // ignore ES and DS
-            popl        %ebx        /* flags */
-            movl        %ebx,32(%eax)
-            // FS and GS too
-         end;
-      end;
-{$ASMMODE ATT}
-{$endif GO32V2}
 
 procedure msdos(var regs : registers);
 begin
@@ -345,8 +256,6 @@ End;
 var
   lastdosexitcode : word;
 
-{$ifdef GO32V2}
-
 procedure exec(const path : pathstr;const comline : comstr);
 type
   realptr = packed record
@@ -466,34 +375,6 @@ begin
    LastDosExitCode:=0;
 end;
 
-{$else GO32V2}
-
-procedure exec(const path : pathstr;const comline : comstr);
-var
-  i : longint;
-  b : array[0..255] of char;
-begin
-  doserror:=0;
-  for i:=1to length(path) do
-   if path[i]='/' then
-    b[i-1]:='\'
-   else
-    b[i-1]:=path[i];
-  b[i]:=' ';
-  inc(i);
-  move(comline[1],b[i],length(comline));
-  inc(i,length(comline));
-  b[i]:=#0;
-  asm
-        leal    b,%ebx
-        movw    $0xff07,%ax
-        int     $0x21
-        movw    %ax,LastDosExitCode
-  end;
-end;
-
-{$endif}
-
 
 function dosexitcode : word;
 begin
@@ -571,8 +452,6 @@ end;
                       --- LFNFindfirst LFNFindNext ---
 ******************************************************************************}
 
-{$ifdef GO32V2}
-
 type
   LFNSearchRec=packed record
     attr,
@@ -662,8 +541,6 @@ begin
   LoadDosError;
 end;
 
-{$endif GO32V2}
-
 
 {******************************************************************************
                      --- DosFindfirst DosFindNext ---
@@ -679,8 +556,6 @@ begin
 end;
 
 
-{$ifdef GO32V2}
-
 procedure DosFindfirst(path : pchar;attr : word;var f : searchrec);
 var
    i : longint;
@@ -719,48 +594,6 @@ begin
   dossearchrec2searchrec(f);
 end;
 
-{$else GO32V2}
-
-procedure Dosfindfirst(path : pchar;attr : word;var f : searchrec);
-var
-   i : longint;
-begin
-   { allow slash as backslash }
-   for i:=0 to strlen(path) do
-     if path[i]='/' then path[i]:='\';
-   asm
-      movl f,%edx
-      movb $0x1a,%ah
-      int $0x21
-      movl path,%edx
-      movzwl attr,%ecx
-      movb $0x4e,%ah
-      int $0x21
-      jnc .LFF
-      movw %ax,DosError
-   .LFF:
-   end;
-  dossearchrec2searchrec(f);
-end;
-
-
-procedure Dosfindnext(var f : searchrec);
-begin
-   asm
-      movl 12(%ebp),%edx
-      movb $0x1a,%ah
-      int $0x21
-      movb $0x4f,%ah
-      int $0x21
-      jnc .LFN
-      movw %ax,DosError
-   .LFN:
-   end;
-  dossearchrec2searchrec(f);
-end;
-
-{$endif GO32V2}
-
 
 {******************************************************************************
                      --- Findfirst FindNext ---
@@ -772,38 +605,28 @@ var
 begin
   doserror:=0;
   strpcopy(path0,path);
-{$ifdef Go32V2}
   if LFNSupport then
    LFNFindFirst(path0,attr,f)
   else
    Dosfindfirst(path0,attr,f);
-{$else}
-  Dosfindfirst(path0,attr,f);
-{$endif}
 end;
 
 
 procedure findnext(var f : searchRec);
 begin
   doserror:=0;
-{$ifdef Go32V2}
   if LFNSupport then
    LFNFindnext(f)
   else
    Dosfindnext(f);
-{$else}
-  Dosfindnext(f);
-{$endif}
 end;
 
 
 Procedure FindClose(Var f: SearchRec);
 begin
   DosError:=0;
-{$ifdef Go32V2}
   if LFNSupport then
    LFNFindClose(f);
-{$endif}
 end;
 
 
@@ -811,7 +634,6 @@ end;
 procedure swapvectors;
 begin
   DosError:=0;
-{$ifdef go32v2}
   asm
 { uses four global symbols from v2prt0.as to be able to know the current
   exception state without using dpmiexcp unit }
@@ -829,7 +651,6 @@ begin
             call *%eax
          .Lno_excep:
   end;
-{$endif go32v2}
 end;
 {$ASMMODE ATT}
 
@@ -865,7 +686,6 @@ begin
        delete(path,1,p1);
     end;
   { try to find out a extension }
-{$ifdef Go32V2}
   if LFNSupport then
     begin
        Ext:='';
@@ -884,7 +704,6 @@ begin
        Name:=Copy(Path,1,DotPos - 1);
     end
   else
-{$endif Go32V2}
     begin
        p1:=pos('.',path);
        if p1>0 then
@@ -1061,7 +880,6 @@ end;
 
 procedure getfattr(var f;var attr : word);
 begin
-{$ifdef GO32V2}
   copytodos(filerec(f).name,strlen(filerec(f).name)+1);
   dosregs.edx:=tb_offset;
   dosregs.ds:=tb_segment;
@@ -1071,9 +889,6 @@ begin
      dosregs.bx:=0;
    end
   else
-{$else}
-  dosregs.edx:=longint(@filerec(f).name);
-{$endif GO32V2}
    dosregs.ax:=$4300;
   msdos(dosregs);
   LoadDosError;
@@ -1083,7 +898,6 @@ end;
 
 procedure setfattr(var f;attr : word);
 begin
-{$ifdef GO32V2}
   copytodos(filerec(f).name,strlen(filerec(f).name)+1);
   dosregs.edx:=tb_offset;
   dosregs.ds:=tb_segment;
@@ -1093,9 +907,6 @@ begin
      dosregs.bx:=1;
    end
   else
-{$else}
-  dosregs.edx:=longint(@filerec(f).name);
-{$endif}
    dosregs.ax:=$4301;
   dosregs.cx:=attr;
   msdos(dosregs);
@@ -1175,7 +986,10 @@ End;
 end.
 {
   $Log$
-  Revision 1.19  1998-11-23 13:53:59  peter
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.19  1998/11/23 13:53:59  peter
     * more fexpand fixes from marco van de voort
 
   Revision 1.18  1998/11/23 12:48:02  peter

rtl/dos/go32v2/dpmiexcp.pp → rtl/go32v2/dpmiexcp.pp

@@ -833,7 +833,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  1998-11-17 09:42:50  pierre
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.11  1998/11/17 09:42:50  pierre
    * position check of signal handler was wrong
 
   Revision 1.10  1998/10/13 21:42:42  peter

rtl/dos/go32v2/dxeload.pp → rtl/go32v2/dxeload.pp

@@ -96,7 +96,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  1998-10-23 16:45:41  pierre
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.5  1998/10/23 16:45:41  pierre
    * check if file can be opened, returns nil if not
 
   Revision 1.4  1998/10/21 17:05:46  pierre

rtl/dos/go32v2/emu387.pp → rtl/go32v2/emu387.pp

@@ -212,7 +212,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  1998-10-26 14:49:45  pierre
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.9  1998/10/26 14:49:45  pierre
    * system debug info output to stderr
 
   Revision 1.8  1998/08/15 17:01:14  peter

rtl/go32v2/exceptn.as

@@ -0,0 +1,427 @@
+/* Copyright (C) 1994, 1995 Charles Sandmann ([email protected])
+ * This file maybe freely distributed and modified as long as copyright remains.
+ */
+/* Simply rewritten to be compiled directly by GNU as by Pierre Muller
+   for use in FPC the free pascal compiler */
+  EAX = 0
+  EBX = 4
+  ECX = 8
+  EDX = 12
+  ESI = 16
+  EDI = 20
+  EBP = 24
+  ESP = 28
+  EIP = 32
+  EFLAGS = 36
+  CS = 40
+  DS = 42
+  ES = 44
+  FS = 46
+  GS = 48
+  SS = 50
+  ERRCODE = 52
+  EXCEPNO = 56
+  PREVEXC = 60
+
+  /* Length 64 bytes plus non-used FPU */
+        .data
+        .align 4
+        .lcomm  exception_stack, 8000
+
+        .text
+        .align  4
+   .macro EXCEPTION_ENTRY number
+        pushl   \number
+        jmp     exception_handler
+   .endm
+
+        .global ___djgpp_exception_table
+___djgpp_exception_table:
+EXCEPTION_ENTRY $0
+EXCEPTION_ENTRY $1
+EXCEPTION_ENTRY $2
+EXCEPTION_ENTRY $3
+EXCEPTION_ENTRY $4
+EXCEPTION_ENTRY $5
+EXCEPTION_ENTRY $6
+EXCEPTION_ENTRY $7
+EXCEPTION_ENTRY $8
+EXCEPTION_ENTRY $9
+EXCEPTION_ENTRY $10
+EXCEPTION_ENTRY $11
+EXCEPTION_ENTRY $12
+EXCEPTION_ENTRY $13
+EXCEPTION_ENTRY $14
+EXCEPTION_ENTRY $15
+EXCEPTION_ENTRY $16
+EXCEPTION_ENTRY $17
+
+/*      This code is called any time an exception occurs in the 32 bit protected
+;*      mode code.  The exception number is pushed on the stack.  This is called
+;*      on a locked stack with interrupts disabled.  Don't try to terminate.
+;*
+;*      [   *   |   SS  ]       * Don't modify
+;*      [      ESP      ]
+;*      [    EFLAGS     ]
+;*      [   *   |   CS  ]       * Don't modify
+;*      [      EIP      ]
+;*      [   ERR CODE    ]
+;*      [   *   |RET CS*]       * Don't modify
+;*      [   RET EIP*    ]       * Don't modify
+;*      [  EXCEPTION #  ]       (And later EBP)
+;*/
+exception_handler:
+        pushl   %ebx
+        pushl   %ds
+        .byte   0x2e                            /* CS: */
+        cmpb    $0, forced
+        je      not_forced
+        call    limitFix
+        .byte   0x2e                            /* CS: */
+        movzbl  forced,%ebx
+        movl    %ebx,8(%esp)                    /* replace EXCEPNO */
+not_forced:
+        movw    %cs:___djgpp_our_DS, %ds
+        movl    $0x10000, forced                /* its zero now, flag inuse */
+        movl    $exception_state, %ebx
+        popl    DS(%ebx)
+        popl    EBX(%ebx)
+        popl    EXCEPNO(%ebx)
+        movl    %esi, ESI(%ebx)
+        movl    %edi, EDI(%ebx)
+        movl    %ebp, EBP(%ebx)
+        movl    %eax, EAX(%ebx)
+        movl    %ecx, ECX(%ebx)
+        movl    %edx, EDX(%ebx)
+        movw    %es, ES(%ebx)
+        movw    %fs, FS(%ebx)
+        movw    %gs, GS(%ebx)
+        movl    ___djgpp_exception_state_ptr, %eax
+        movl    %eax, PREVEXC(%ebx)
+
+/* Stack clean at this point, DS:[EBX] points to exception_state, all
+   register information saved.  Now get the info on stack. */
+
+        pushl   %ebp
+        movl    %esp, %ebp      /* load ebp with stack for easy access */
+
+        movl    12(%ebp), %eax
+        movl    %eax, ERRCODE(%ebx)
+        movl    16(%ebp), %eax
+        movl    %eax, EIP(%ebx)
+        movl    20(%ebp), %eax
+        movw    %ax, CS(%ebx)
+        movl    24(%ebp), %eax
+        movl    %eax, EFLAGS(%ebx)
+        andb    $0xfe, %ah                      /* Clear trace flag */
+        movl    %eax, 24(%ebp)                  /* and restore on stack */
+
+        movl    28(%ebp), %eax
+        movl    %eax, ESP(%ebx)
+        movl    32(%ebp), %eax
+        movw    %ax, SS(%ebx)
+
+        movl    $dpmi_exception_proc1, 16(%ebp)         /* where to return */
+        movw    %cs, 20(%ebp)
+
+/* Change to our local stack on return from exception (maybe stack exception) */
+        movw    %ds, %ax
+        cmpb    $12,EXCEPNO(%ebx)               /* Stack fault ? */
+        je      1f
+        cmpw    %ax,32(%ebp)
+        je      stack_ok
+1:      movl    $exception_stack+8000, 28(%ebp)
+        movw    %ax, 32(%ebp)
+stack_ok:
+/* Now copy the exception structure to the new stack before returning */
+        movw    %ax, %es
+        movl    %ebx,%esi
+        movl    28(%ebp), %edi
+        subl    $92, %edi                       /* 64 plus extra for longjmp */
+        movl    %edi, 28(%ebp)
+        movl    %edi, ___djgpp_exception_state_ptr
+        movl    $16, %ecx
+        cld
+        rep
+        movsl
+
+        movl    EAX(%ebx), %eax                         /* restore regs */
+        movl    ESI(%ebx), %esi
+        movl    EDI(%ebx), %edi
+        movl    ECX(%ebx), %ecx
+        movw    ES(%ebx), %es
+        popl    %ebp
+        pushl   EBX(%ebx)
+        pushl   DS(%ebx)
+        movb    $0, forced+2                            /* flag non-use */
+        popl    %ds
+        popl    %ebx
+        lret
+
+/* Code to fix fake exception, EBX destroyed.  Note, app_DS may == our_DS! */
+        .align 4
+limitFix:
+        pushl   %eax
+        pushl   %ecx
+        pushl   %edx
+        .byte   0x2e                            /* CS: */
+        movl    ___djgpp_app_DS, %ebx           /* avoid size prefix */
+        .byte   0x2e                            /* CS: */
+        movl    ds_limit, %edx
+        movl    %edx, %ecx
+        shrl    $16, %ecx
+        movw    $0x0008, %ax
+        int     $0x31                           /* Set segment limit */
+        popl    %edx
+        popl    %ecx
+        popl    %eax
+        ret
+
+/* This local routine preprocesses a return request to the C code.  It checks
+   to make sure the DS & SS are set OK for C code.  If not, it sets them up */
+        .align  4
+dpmi_exception_proc1:
+        cld
+        .byte   0x2e                            /* CS: !!! */
+        movw    ___djgpp_our_DS, %bx            /* to be sure */
+        movw    %bx, %ds
+        movw    %bx, %es
+        /* Note: SS:ESP should be set properly by exception routine */
+        jmp     ___djgpp_exception_processor
+
+/*      This code is called by a user routine wishing to save an interrupt
+;*      state.  It will return with a clean stack, our DS,ES,SS.
+;*      Minor bug: uses static exception_state for a short window without
+;*      interrupts guaranteed disabled.
+;*
+;*      [    EFLAGS     ]
+;*      [   *   |   CS  ]
+;*      [      EIP      ]
+;*      [  CALLING EIP  ]
+;*/
+
+        .align  4
+        .globl  ___djgpp_save_interrupt_regs
+___djgpp_save_interrupt_regs:
+        pushl   %esi
+        pushl   %ds
+        movw    %cs:___djgpp_our_DS, %ds
+        movl    $exception_state, %esi
+        popl    DS(%esi)                /* Trashes ES but OK */
+        popl    ESI(%esi)
+        movl    %edi, EDI(%esi)
+        movl    %ebp, EBP(%esi)
+        movl    %eax, EAX(%esi)
+        movl    %ebx, EBX(%esi)
+        movl    %ecx, ECX(%esi)
+        movl    %edx, EDX(%esi)
+        popl    %edx                    /* Save calling EIP */
+        popl    EIP(%esi)
+        popl    %eax
+        movw    %ax,CS(%esi)            /* Don't pop, nukes DS */
+        popl    EFLAGS(%esi)
+        movl    %esp, ESP(%esi)
+        movw    %es, ES(%esi)
+        movw    %fs, FS(%esi)
+        movw    %gs, GS(%esi)
+        movw    %ss, SS(%esi)
+        movl    ___djgpp_exception_state_ptr, %eax
+        movl    %eax, PREVEXC(%esi)
+        cld
+        movw    %ds, %ax
+        movw    %ax, %es
+        movw    %ss, %bx
+        cmpw    %ax, %bx                        /* is SS = DS ? */
+        je      Lss_ok
+        movw    %ax, %ss                        /* set new SS:ESP */
+        movl    $exception_stack+8000, %esp
+Lss_ok: subl    $92, %esp               /* 64 plus extra for longjmp */
+        movl    %esp, %edi
+        movl    $16, %ecx
+        movl    %edi, ___djgpp_exception_state_ptr
+        rep
+        movsl                                   /* Copy structure to stack */
+        jmp     *%edx                           /* A "return" */
+
+        .align  4               /* We will touch this; it must be locked */
+        .global ___djgpp_hw_lock_start
+___djgpp_hw_lock_start:
+ds_limit:                       .long   0
+forced:                         .long   0
+        .global ___djgpp_cbrk_count
+___djgpp_cbrk_count:            .long   0
+        .global ___djgpp_timer_countdown
+___djgpp_timer_countdown:       .long   0
+        .global ___djgpp_our_DS
+___djgpp_our_DS:                .word   0
+        .global ___djgpp_app_DS
+___djgpp_app_DS:                .word   0
+        .global ___djgpp_dos_sel
+___djgpp_dos_sel:               .word   0
+        .global ___djgpp_hwint_flags
+___djgpp_hwint_flags:           .word   0
+        .global ___djgpp_old_kbd
+___djgpp_old_kbd:               .long   0,0
+        .global ___djgpp_old_timer
+___djgpp_old_timer:             .long   0,0
+        .global ___djgpp_exception_state_ptr
+___djgpp_exception_state_ptr:   .long   0
+exception_state:                .space  64
+        .global ___djgpp_ds_alias
+___djgpp_ds_alias:              .word   0       /* used in dpmi/api/d0303.s (alloc rmcb) */
+
+        .align 4
+        .global ___djgpp_npx_hdlr
+___djgpp_npx_hdlr:
+        pushl   %eax
+        xorl    %eax,%eax
+        outb    %al,$0x0f0
+        movb    $0x20,%al
+        outb    %al,$0x0a0
+        outb    %al,$0x020
+        movb    $0x75,%al
+hw_to_excp:
+        call    ___djgpp_hw_exception
+        popl    %eax
+        sti
+        iret
+
+        .align 4
+        .global ___djgpp_kbd_hdlr
+___djgpp_kbd_hdlr:
+        pushl   %eax
+        pushl   %ds
+        .byte   0x2e                            /* CS: */
+        testb   $1, ___djgpp_hwint_flags        /* Disable? */
+        jne     Lkbd_chain
+/* Check CTRL state */
+        movw    %cs:___djgpp_dos_sel, %ds       /* Conventional mem selector */
+/*      movw    $0x7021,0xb0f00         */      /* Test code - write to mono */
+        testb   $4,0x417                        /* Test KB flags: CTRL down? */
+        je      Lkbd_chain
+        testb   $8,0x417                        /* Test KB flags: ALT down? */
+        jne     Lkbd_chain                      /* Don't capture ALT-CTRL-C */
+/* Check port for scan code */
+        inb     $0x60,%al
+        cmpb    $0x2e,%al
+        jne     Lkbd_chain
+/* Clear interrupt, (later: remove byte from controller?)
+        movb    $0x20,%al
+        outb    %al,$0x020      */
+98:
+        movb    $0x79,%al
+        call    ___djgpp_hw_exception
+Lkbd_chain:
+        popl    %ds
+        popl    %eax
+        ljmp    %cs:___djgpp_old_kbd
+
+        .align 4
+        .global ___djgpp_kbd_hdlr_pc98
+___djgpp_kbd_hdlr_pc98:
+        pushl   %eax
+        pushl   %ds
+        .byte   0x2e                            /* CS: */
+        testb   $1, ___djgpp_hwint_flags        /* Disable? */
+        jne     Lkbd_chain
+/* Check CTRL state */
+        movw    %cs:___djgpp_dos_sel, %ds       /* Conventional mem selector */
+        testb   $0x10,0x053a                    /* Test KB flags: CTRL down? */
+        jz      Lkbd_chain
+/* Check for scan code */
+        testb   $0x08,0x052f                    /* test KB "C" down for PC98 */
+        jz      Lkbd_chain
+        jmp     98b
+
+        .align 4
+        .global ___djgpp_timer_hdlr
+___djgpp_timer_hdlr:
+        .byte   0x2e                            /* CS: */
+        cmpl    $0,___djgpp_timer_countdown
+        je      4f
+        pushl   %ds
+        movw    %cs:___djgpp_ds_alias, %ds
+        decl    ___djgpp_timer_countdown
+        popl    %ds
+        jmp     3f
+4:
+        pushl   %eax
+        movb    $0x78,%al
+        call    ___djgpp_hw_exception
+        popl    %eax
+3:
+        .byte   0x2e                            /* CS: */
+        testb   $4, ___djgpp_hwint_flags        /* IRET or chain? */
+        jne     2f
+        ljmp    %cs:___djgpp_old_timer
+2:
+        pushl   %eax
+        movb    $0x20,%al                       /* EOI the interrupt */
+        outb    %al,$0x020
+        popl    %eax
+        iret
+
+        /* On entry ES is the DS alias selector */
+        .align 4
+        .global ___djgpp_cbrk_hdlr              /* A RMCB handler for 0x1b */
+___djgpp_cbrk_hdlr:
+        cld
+        lodsl                                   /* EAX = DS:[esi] CS:IP */
+        movl    %eax, %es:0x2a(%edi)            /* store in structure */
+        lodsl                                   /* AX = FLAGS */
+        movw    %ax, %es:0x20(%edi)
+        addw    $6, %es:0x2e(%edi)              /* Adjust RM SP */
+        movb    $0x1b,%al
+
+        .byte   0x2e                            /* CS: */
+        testb   $2, ___djgpp_hwint_flags        /* Count, don't kill */
+        jne     1f
+
+        call    ___djgpp_hw_exception
+        iret
+1:
+        incl    %es:___djgpp_cbrk_count
+        iret
+
+        .global ___djgpp_i24                    /* Int 24 handler if needed */
+        .global ___djgpp_iret                   /* Int 23 handler if needed */
+___djgpp_i24:
+        movb    $3,%al
+___djgpp_iret:
+        iret
+
+/* Code to stop execution ASAP, EAX destroyed.  Make DS/ES/SS invalid.
+   Fake exception value is passed in AL and moved into the "forced" variable.
+   This is used to convert a HW interrupt into something we can transfer
+   control away from via longjmp or exit(), common with SIGINT, SIGFPE, or
+   if we want EIP information on timers. */
+
+        .align 4
+        .global ___djgpp_hw_exception
+___djgpp_hw_exception:
+        .byte   0x2e                            /* CS: */
+        cmpl    $0, forced                      /* Already flagged? */
+        jne     already_forced
+        pushl   %ebx
+        pushl   %ecx
+        pushl   %edx
+        pushl   %ds
+        movw    %cs:___djgpp_our_DS, %ds
+        movl    ___djgpp_app_DS, %ebx           /* avoid size prefix */
+        lsl     %ebx, %ecx
+        movl    %ecx, ds_limit                  /* Save current limit */
+        movb    %al, forced                     /* Indicate a fake exception */
+        xorl    %ecx, %ecx
+        movw    $0xfff, %dx                     /* 4K limit is null page ! */
+        movw    $0x0008, %ax
+        int     $0x31                           /* Set segment limit */
+5:      popl    %ds
+        popl    %edx
+        popl    %ecx
+        popl    %ebx
+already_forced:
+        ret
+
+        .global ___djgpp_hw_lock_end
+___djgpp_hw_lock_end:
+        ret                                     /* LD does weird things */

rtl/go32v2/exit16.ah

@@ -0,0 +1 @@
+       .byte   0xb8,0x01,0x00,0xcd,0x31,0xb8,0x02,0x05,0xcd,0x31,0x88,0xd0,0xb4,0x4c,0xcd,0x21

rtl/go32v2/exit16.asm

@@ -0,0 +1,22 @@
+; Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details
+;-----------------------------------------------------------------------------
+;  exit 16-bit helper
+;
+;  Used to clean up 32-bit arena on exit, so as to release as many
+;  selectors and as much memory as possible.
+;
+;  Call with:   BX = 32-bit CS to free
+;               SI:DI = 32-bit memory handle to free
+;               DL = exit status
+
+        .type   "bin"
+
+        mov     ax, 0x0001
+        int     0x31
+
+        mov     ax, 0x0502
+        int     0x31
+
+        mov     al, dl
+        mov     ah, 0x4c
+        int     0x21

rtl/dos/go32v2/filutil.inc → rtl/go32v2/filutil.inc

@@ -4,7 +4,7 @@
     Copyright (c) 1998 by the Free Pascal development team
 
     File utility calls
-    
+
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -153,7 +153,7 @@ Var Sr : PSearchrec;
 
 begin
 //!! Sr := New(PSearchRec);
-getmem(sr,sizeof(searchrec)); 
+getmem(sr,sizeof(searchrec));
 Rslt.FindHandle := longint(Sr);
 DOS.FindFirst(Path, Attr, Sr^);
 result := -DosError;
@@ -229,7 +229,7 @@ end;
 
 
 Function FileGetAttr (Const FileName : String) : Longint;
- 
+
 var Regs: registers;
 
 begin
@@ -274,7 +274,7 @@ end;
 
 
 Function DeleteFile (Const FileName : String) : Boolean;
- 
+
 var Regs: registers;
 
 begin
@@ -293,7 +293,7 @@ end;
 
 
 Function RenameFile (Const OldName, NewName : String) : Boolean;
- 
+
 var Regs: registers;
 
 begin
@@ -321,7 +321,10 @@ end;
 
 {
   $Log$
-  Revision 1.4  1998-10-29 13:16:19  michael
+  Revision 1.1  1998-12-21 13:07:02  peter
+    * use -FE
+
+  Revision 1.4  1998/10/29 13:16:19  michael
   * Fix for fileseek by gertjan schouten
 
   Revision 1.3  1998/10/15 09:39:13  michael

rtl/go32v2/fpu.as

@@ -0,0 +1,49 @@
+/* Copyright (C) 1995 DJ Delorie, see COPYING.DJ for details */
+/* Translated from tasm to GAS by C. Sandmann */
+/* One comment displaced to get it compiled by as.exe directly  !!! */
+/* by Pierre Muller */
+
+/* This routine assumes DS == SS since [ESI] coding shorter than [EBP] coding */
+
+        .global __detect_80387          /* direct from the Intel manual */
+__detect_80387:                         /* returns 1 if 387 (or more), else 0 */
+        pushl   %esi
+        pushl   %eax                    /* Dummy work area on stack */
+        movl    %esp,%esi
+        fninit
+        movw    $0x5a5a,(%esi)
+        fnstsw  (%esi)
+        cmpb    $0,(%esi)
+        jne     Lno_387
+
+        fnstcw  (%esi)
+        movl    (%esi),%eax             /* Only ax significant */
+        andl    $0x103f,%eax
+        cmpl    $0x3f,%eax
+        jne     Lno_387
+
+        fld1
+        fldz
+/*      fdiv                               GAS encodes this as 0xdcf1 !! BUG */
+        .byte   0xde,0xf9
+        fld     %st
+        fchs
+        fcompp
+        fstsw   (%esi)
+        movzwl  (%esi),%eax             /* Clears upper %eax */
+        sahf
+        je      Lno_387
+        fninit                          /* 387 present, initialize. */
+        fnstcw  (%esi)
+        wait
+        andw    $0x0fffa,(%esi)
+/* enable invalid operation exception */
+        fldcw   (%esi)
+        movw    $1,%eax
+        jmp     Lexit
+Lno_387:
+        xorl    %eax,%eax
+Lexit:
+        popl    %esi                    /* Fix stack first */
+        popl    %esi
+        ret

rtl/go32v2/go32.pp

@@ -0,0 +1,1182 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    and implements some stuff for protected mode programming
+    Copyright (c) 1993,97 by the Free Pascal development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit go32;
+
+{$S-,R-,I-,Q-} {no stack check, used by DPMIEXCP !! }
+
+interface
+
+    const
+    { contants for the run modes returned by get_run_mode }
+       rm_unknown = 0;
+       rm_raw     = 1;     { raw (without HIMEM) }
+       rm_xms     = 2;     { XMS (for example with HIMEM, without EMM386) }
+       rm_vcpi    = 3;     { VCPI (for example HIMEM and EMM386) }
+       rm_dpmi    = 4;     { DPMI (for example DOS box or 386Max) }
+
+    { flags }
+       carryflag     = $001;
+       parityflag    = $004;
+       auxcarryflag  = $010;
+       zeroflag      = $040;
+       signflag      = $080;
+       trapflag      = $100;
+       interruptflag = $200;
+       directionflag = $400;
+       overflowflag  = $800;
+
+    type
+       tmeminfo = record
+          available_memory,
+          available_pages,
+          available_lockable_pages,
+          linear_space,
+          unlocked_pages,
+          available_physical_pages,
+          total_physical_pages,
+          free_linear_space,
+          max_pages_in_paging_file,
+          reserved0,
+          reserved1,
+          reserved2 : longint;
+       end;
+
+       tseginfo = record
+          offset  : pointer;
+          segment : word;
+       end;
+
+       trealregs = record
+         case integer of
+          1: { 32-bit } (EDI, ESI, EBP, Res, EBX, EDX, ECX, EAX: longint;
+                         Flags, ES, DS, FS, GS, IP, CS, SP, SS: word);
+          2: { 16-bit } (DI, DI2, SI, SI2, BP, BP2, R1, R2: word;
+                         BX, BX2, DX, DX2, CX, CX2, AX, AX2: word);
+          3: { 8-bit }  (stuff: array[1..4] of longint;
+                         BL, BH, BL2, BH2, DL, DH, DL2, DH2,
+                         CL, CH, CL2, CH2, AL, AH, AL2, AH2: byte);
+          4: { Compat } (RealEDI, RealESI, RealEBP, RealRES,
+                         RealEBX, RealEDX, RealECX, RealEAX: longint;
+                         RealFlags,
+                         RealES, RealDS, RealFS, RealGS,
+                         RealIP, RealCS, RealSP, RealSS: word);
+       end;
+
+      registers = trealregs;
+
+    { this works only with real DPMI }
+    function allocate_ldt_descriptors(count : word) : word;
+    function free_ldt_descriptor(d : word) : boolean;
+    function segment_to_descriptor(seg : word) : word;
+    function get_next_selector_increment_value : word;
+    function get_segment_base_address(d : word) : longint;
+    function set_segment_base_address(d : word;s : longint) : boolean;
+    function set_segment_limit(d : word;s : longint) : boolean;
+    function set_descriptor_access_right(d : word;w : word) : longint;
+    function create_code_segment_alias_descriptor(seg : word) : word;
+    function get_linear_addr(phys_addr : longint;size : longint) : longint;
+    function get_segment_limit(d : word) : longint;
+    function get_descriptor_access_right(d : word) : longint;
+    function get_page_size:longint;
+    function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean;
+    function realintr(intnr : word;var regs : trealregs) : boolean;
+
+    { is needed for functions which need a real mode buffer }
+    function global_dos_alloc(bytes : longint) : longint;
+    function global_dos_free(selector : word) : boolean;
+
+    var
+       { selector for the DOS memory (only usable if in DPMI mode) }
+       dosmemselector : word;
+       { result of dpmi call }
+       int31error : word;
+
+    { this procedure copies data where the source and destination }
+    { are specified by 48 bit pointers                            }
+    { Note: the procedure checks only for overlapping if          }
+    { source selector=destination selector                        }
+    procedure seg_move(sseg : word;source : longint;dseg : word;dest : longint;count : longint);
+
+    { fills a memory area specified by a 48 bit pointer with c }
+    procedure seg_fillchar(seg : word;ofs : longint;count : longint;c : char);
+    procedure seg_fillword(seg : word;ofs : longint;count : longint;w : word);
+
+    {************************************}
+    { this works with all PM interfaces: }
+    {************************************}
+
+    function get_meminfo(var meminfo : tmeminfo) : boolean;
+    function get_pm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
+    function set_pm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
+    function get_rm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
+    function set_rm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
+    function get_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
+    function set_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
+    function get_pm_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
+    function set_pm_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
+    function free_rm_callback(var intaddr : tseginfo) : boolean;
+    function get_rm_callback(pm_func : pointer;const reg : trealregs;var rmcb : tseginfo) : boolean;
+    function get_cs : word;
+    function get_ds : word;
+    function get_ss : word;
+
+    { locking functions }
+    function allocate_memory_block(size:longint):longint;
+    function free_memory_block(blockhandle : longint) : boolean;
+    function request_linear_region(linearaddr, size : longint;
+                                   var blockhandle : longint) : boolean;
+    function lock_linear_region(linearaddr, size : longint) : boolean;
+    function lock_data(var data;size : longint) : boolean;
+    function lock_code(functionaddr : pointer;size : longint) : boolean;
+    function unlock_linear_region(linearaddr, size : longint) : boolean;
+    function unlock_data(var data;size : longint) : boolean;
+    function unlock_code(functionaddr : pointer;size : longint) : boolean;
+
+    { disables and enables interrupts }
+    procedure disable;
+    procedure enable;
+
+    function inportb(port : word) : byte;
+    function inportw(port : word) : word;
+    function inportl(port : word) : longint;
+
+    procedure outportb(port : word;data : byte);
+    procedure outportw(port : word;data : word);
+    procedure outportl(port : word;data : longint);
+    function get_run_mode : word;
+
+    function transfer_buffer : longint;
+    function tb_segment : longint;
+    function tb_offset : longint;
+    function tb_size : longint;
+    procedure copytodos(var addr; len : longint);
+    procedure copyfromdos(var addr; len : longint);
+
+    procedure dpmi_dosmemput(seg : word;ofs : word;var data;count : longint);
+    procedure dpmi_dosmemget(seg : word;ofs : word;var data;count : longint);
+    procedure dpmi_dosmemmove(sseg,sofs,dseg,dofs : word;count : longint);
+    procedure dpmi_dosmemfillchar(seg,ofs : word;count : longint;c : char);
+    procedure dpmi_dosmemfillword(seg,ofs : word;count : longint;w : word);
+
+
+type
+   tport = class
+      procedure writeport(p : word;data : byte);
+      function  readport(p : word) : byte;
+      property pp[w : word] : byte read readport write writeport;default;
+   end;
+
+   tportw = class
+      procedure writeport(p : word;data : word);
+      function  readport(p : word) : word;
+      property pp[w : word] : word read readport write writeport;default;
+   end;
+
+   tportl = class
+      procedure writeport(p : word;data : longint);
+      function  readport(p : word) : longint;
+      property pp[w : word] : longint read readport write writeport;default;
+   end;
+var
+{ we don't need to initialize port, because neither member
+  variables nor virtual methods are accessed }
+   port,
+   portb : tport;
+   portw : tportw;
+   portl : tportl;
+
+    const
+       { this procedures are assigned to the procedure which are needed }
+       { for the current mode to access DOS memory                      }
+       { It's strongly recommended to use this procedures!              }
+       dosmemput      : procedure(seg : word;ofs : word;var data;count : longint)=dpmi_dosmemput;
+       dosmemget      : procedure(seg : word;ofs : word;var data;count : longint)=dpmi_dosmemget;
+       dosmemmove     : procedure(sseg,sofs,dseg,dofs : word;count : longint)=dpmi_dosmemmove;
+       dosmemfillchar : procedure(seg,ofs : word;count : longint;c : char)=dpmi_dosmemfillchar;
+       dosmemfillword : procedure(seg,ofs : word;count : longint;w : word)=dpmi_dosmemfillword;
+
+  implementation
+
+
+    { the following procedures copy from and to DOS memory using DPMI }
+    procedure dpmi_dosmemput(seg : word;ofs : word;var data;count : longint);
+
+      begin
+         seg_move(get_ds,longint(@data),dosmemselector,seg*16+ofs,count);
+      end;
+
+    procedure dpmi_dosmemget(seg : word;ofs : word;var data;count : longint);
+
+      begin
+         seg_move(dosmemselector,seg*16+ofs,get_ds,longint(@data),count);
+      end;
+
+    procedure dpmi_dosmemmove(sseg,sofs,dseg,dofs : word;count : longint);
+
+      begin
+         seg_move(dosmemselector,sseg*16+sofs,dosmemselector,dseg*16+dofs,count);
+      end;
+
+    procedure dpmi_dosmemfillchar(seg,ofs : word;count : longint;c : char);
+
+      begin
+         seg_fillchar(dosmemselector,seg*16+ofs,count,c);
+      end;
+
+    procedure dpmi_dosmemfillword(seg,ofs : word;count : longint;w : word);
+
+      begin
+         seg_fillword(dosmemselector,seg*16+ofs,count,w);
+      end;
+
+    function global_dos_alloc(bytes : longint) : longint;
+
+      begin
+         asm
+            movl bytes,%ebx
+            orl  $0x10,%ebx             // round up
+            shrl $0x4,%ebx              // convert to Paragraphs
+            movl $0x100,%eax            // function 0x100
+            int  $0x31
+            shll $0x10,%eax             // return Segment in hi(Result)
+            movw %dx,%ax                // return Selector in lo(Result)
+            movl %eax,__result
+         end;
+      end;
+
+    function  global_dos_free(selector : word) : boolean;
+
+      begin
+         asm
+            movw Selector,%dx
+            movl $0x101,%eax
+            int  $0x31
+            setnc %al
+            movb %al,__RESULT
+         end;
+      end;
+
+    function realintr(intnr : word;var regs : trealregs) : boolean;
+
+      begin
+         regs.realsp:=0;
+         regs.realss:=0;
+         asm
+            movw  intnr,%bx
+            xorl  %ecx,%ecx
+            movl  regs,%edi
+            { es is always equal ds }
+            movl  $0x300,%eax
+            int   $0x31
+            setnc %al
+            movb  %al,__RESULT
+         end;
+      end;
+
+    procedure seg_fillchar(seg : word;ofs : longint;count : longint;c : char);
+
+      begin
+         asm
+            movl ofs,%edi
+            movl count,%ecx
+            movb c,%dl
+            { load es with selector }
+            pushw %es
+            movw seg,%ax
+            movw %ax,%es
+            { fill eax with duplicated c }
+            { so we can use stosl        }
+            movb %dl,%dh
+            movw %dx,%ax
+            shll $16,%eax
+            movw %dx,%ax
+            movl %ecx,%edx
+            shrl $2,%ecx
+            cld
+            rep
+            stosl
+            movl %edx,%ecx
+            andl $3,%ecx
+            rep
+            stosb
+            popw %es
+         end ['EAX','ECX','EDX','EDI'];
+      end;
+
+    procedure seg_fillword(seg : word;ofs : longint;count : longint;w : word);
+
+      begin
+         asm
+            movl ofs,%edi
+            movl count,%ecx
+            movw w,%dx
+            { load segment }
+            pushw %es
+            movw seg,%ax
+            movw %ax,%es
+            { fill eax }
+            movw %dx,%ax
+            shll $16,%eax
+            movw %dx,%ax
+            movl %ecx,%edx
+            shrl $1,%ecx
+            cld
+            rep
+            stosl
+            movl %edx,%ecx
+            andl $1,%ecx
+            rep
+            stosw
+            popw %es
+         end ['EAX','ECX','EDX','EDI'];
+      end;
+
+    procedure seg_move(sseg : word;source : longint;dseg : word;dest : longint;count : longint);
+
+      begin
+         if count=0 then
+           exit;
+         if (sseg<>dseg) or ((sseg=dseg) and (source>dest)) then
+           asm
+              pushw %es
+              pushw %ds
+              cld
+              movl count,%ecx
+              movl source,%esi
+              movl dest,%edi
+              movw dseg,%ax
+              movw %ax,%es
+              movw sseg,%ax
+              movw %ax,%ds
+              movl %ecx,%eax
+              shrl $2,%ecx
+              rep
+              movsl
+              movl %eax,%ecx
+              andl $3,%ecx
+              rep
+              movsb
+              popw %ds
+              popw %es
+           end ['ESI','EDI','ECX','EAX']
+         else if (source<dest) then
+           { copy backward for overlapping }
+           asm
+              pushw %es
+              pushw %ds
+              std
+              movl count,%ecx
+              movl source,%esi
+              movl dest,%edi
+              movw dseg,%ax
+              movw %ax,%es
+              movw sseg,%ax
+              movw %ax,%ds
+              addl %ecx,%esi
+              addl %ecx,%edi
+              movl %ecx,%eax
+              andl $3,%ecx
+              orl %ecx,%ecx
+              jz .LSEG_MOVE1
+
+              { calculate esi and edi}
+              decl %esi
+              decl %edi
+              rep
+              movsb
+              incl %esi
+              incl %edi
+           .LSEG_MOVE1:
+              subl $4,%esi
+              subl $4,%edi
+              movl %eax,%ecx
+              shrl $2,%ecx
+              rep
+              movsl
+              cld
+              popw %ds
+              popw %es
+           end ['ESI','EDI','ECX'];
+      end;
+
+    procedure outportb(port : word;data : byte);
+
+      begin
+         asm
+            movw port,%dx
+            movb data,%al
+            outb %al,%dx
+         end ['EAX','EDX'];
+      end;
+
+    procedure outportw(port : word;data : word);
+
+      begin
+         asm
+            movw port,%dx
+            movw data,%ax
+            outw %ax,%dx
+         end ['EAX','EDX'];
+      end;
+
+    procedure outportl(port : word;data : longint);
+
+      begin
+         asm
+            movw port,%dx
+            movl data,%eax
+            outl %eax,%dx
+         end ['EAX','EDX'];
+      end;
+
+    function inportb(port : word) : byte;
+
+      begin
+         asm
+            movw port,%dx
+            inb %dx,%al
+            movb %al,__RESULT
+         end ['EAX','EDX'];
+      end;
+
+    function inportw(port : word) : word;
+
+      begin
+         asm
+            movw port,%dx
+            inw %dx,%ax
+            movw %ax,__RESULT
+         end ['EAX','EDX'];
+      end;
+
+    function inportl(port : word) : longint;
+
+      begin
+         asm
+            movw port,%dx
+            inl %dx,%eax
+            movl %eax,__RESULT
+         end ['EAX','EDX'];
+      end;
+
+
+{ to give easy port access like tp with port[] }
+
+procedure tport.writeport(p : word;data : byte);assembler;
+asm
+        movw    p,%dx
+        movb    data,%al
+        outb    %al,%dx
+end ['EAX','EDX'];
+
+
+function tport.readport(p : word) : byte;assembler;
+asm
+        movw    p,%dx
+        inb     %dx,%al
+end ['EAX','EDX'];
+
+
+procedure tportw.writeport(p : word;data : word);assembler;
+asm
+        movw    p,%dx
+        movw    data,%ax
+        outw    %ax,%dx
+end ['EAX','EDX'];
+
+
+function tportw.readport(p : word) : word;assembler;
+asm
+        movw    p,%dx
+        inw     %dx,%ax
+end ['EAX','EDX'];
+
+
+procedure tportl.writeport(p : word;data : longint);assembler;
+asm
+        movw    p,%dx
+        movl    data,%eax
+        outl    %eax,%dx
+end ['EAX','EDX'];
+
+
+function tportl.readport(p : word) : longint;assembler;
+asm
+        movw    p,%dx
+        inl     %dx,%eax
+end ['EAX','EDX'];
+
+
+    function get_cs : word;assembler;
+      asm
+            movw %cs,%ax
+      end;
+
+
+    function get_ss : word;assembler;
+      asm
+            movw %ss,%ax
+      end;
+
+
+    function get_ds : word;assembler;
+      asm
+            movw %ds,%ax
+      end;
+
+
+    procedure test_int31(flag : longint);[alias : 'test_int31'];
+      begin
+         asm
+            pushl %ebx
+            movw  $0,U_GO32_INT31ERROR
+            movl  flag,%ebx
+            testb $1,%bl
+            jz    1f
+            movw  %ax,U_GO32_INT31ERROR
+            xorl  %eax,%eax
+            jmp   2f
+            1:
+            movl  $1,%eax
+            2:
+            popl  %ebx
+         end;
+      end;
+
+    function set_pm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
+
+      begin
+         asm
+            movl intaddr,%eax
+            movl (%eax),%edx
+            movw 4(%eax),%cx
+            movl $0x205,%eax
+            movb vector,%bl
+            int $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+         end;
+      end;
+
+    function set_rm_interrupt(vector : byte;const intaddr : tseginfo) : boolean;
+
+      begin
+         asm
+            movl intaddr,%eax
+            movw (%eax),%dx
+            movw 4(%eax),%cx
+            movl $0x201,%eax
+            movb vector,%bl
+            int $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+         end;
+      end;
+
+    function set_pm_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
+
+      begin
+         asm
+            movl intaddr,%eax
+            movl (%eax),%edx
+            movw 4(%eax),%cx
+            movl $0x212,%eax
+            movb e,%bl
+            int $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+         end;
+      end;
+
+    function set_exception_handler(e : byte;const intaddr : tseginfo) : boolean;
+
+      begin
+         asm
+            movl intaddr,%eax
+            movl (%eax),%edx
+            movw 4(%eax),%cx
+            movl $0x203,%eax
+            movb e,%bl
+            int $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+         end;
+      end;
+
+    function get_pm_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
+
+      begin
+         asm
+            movl $0x210,%eax
+            movb e,%bl
+            int $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+            movl intaddr,%eax
+            movl %edx,(%eax)
+            movw %cx,4(%eax)
+         end;
+      end;
+
+    function get_exception_handler(e : byte;var intaddr : tseginfo) : boolean;
+
+      begin
+         asm
+            movl $0x202,%eax
+            movb e,%bl
+            int $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+            movl intaddr,%eax
+            movl %edx,(%eax)
+            movw %cx,4(%eax)
+         end;
+      end;
+
+    function get_pm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
+
+      begin
+         asm
+            movb vector,%bl
+            movl $0x204,%eax
+            int $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+            movl intaddr,%eax
+            movl %edx,(%eax)
+            movw %cx,4(%eax)
+         end;
+      end;
+
+    function get_rm_interrupt(vector : byte;var intaddr : tseginfo) : boolean;
+
+      begin
+         asm
+            movb vector,%bl
+            movl $0x200,%eax
+            int $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+            movl intaddr,%eax
+            movzwl %dx,%edx
+            movl %edx,(%eax)
+            movw %cx,4(%eax)
+         end;
+      end;
+
+    function free_rm_callback(var intaddr : tseginfo) : boolean;
+      begin
+         asm
+            movl intaddr,%eax
+            movw (%eax),%dx
+            movw 4(%eax),%cx
+            movl $0x304,%eax
+            int $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+         end;
+      end;
+
+    { here we must use ___v2prt0_ds_alias instead of from v2prt0.s
+    because the exception processor sets the ds limit to $fff
+    at hardware exceptions }
+
+    function get_rm_callback(pm_func : pointer;const reg : trealregs;var rmcb : tseginfo) : boolean;
+      begin
+         asm
+            movl  pm_func,%esi
+            movl  reg,%edi
+            pushw %es
+            movw  ___v2prt0_ds_alias,%ax
+            movw  %ax,%es
+            pushw %ds
+            movw  %cs,%ax
+            movw  %ax,%ds
+            movl  $0x303,%eax
+            int   $0x31
+            popw  %ds
+            popw  %es
+            pushf
+            call test_int31
+            movb %al,__RESULT
+            movl  rmcb,%eax
+            movzwl %dx,%edx
+            movl  %edx,(%eax)
+            movw  %cx,4(%eax)
+         end;
+      end;
+
+    function allocate_ldt_descriptors(count : word) : word;
+
+      begin
+         asm
+            movw count,%cx
+            xorl %eax,%eax
+            int $0x31
+            movw %ax,__RESULT
+         end;
+      end;
+
+    function free_ldt_descriptor(d : word) : boolean;
+
+      begin
+         asm
+            movw d,%bx
+            movl $1,%eax
+            int $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+         end;
+      end;
+
+    function segment_to_descriptor(seg : word) : word;
+
+      begin
+         asm
+            movw seg,%bx
+            movl $2,%eax
+            int $0x31
+            movw %ax,__RESULT
+         end;
+      end;
+
+    function get_next_selector_increment_value : word;
+
+      begin
+         asm
+            movl $3,%eax
+            int $0x31
+            movw %ax,__RESULT
+         end;
+      end;
+
+    function get_segment_base_address(d : word) : longint;
+
+      begin
+         asm
+            movw d,%bx
+            movl $6,%eax
+            int $0x31
+            xorl %eax,%eax
+            movw %dx,%ax
+            shll $16,%ecx
+            orl %ecx,%eax
+            movl %eax,__RESULT
+         end;
+      end;
+
+    function get_page_size:longint;
+      begin
+        asm
+           movl $0x604,%eax
+           int $0x31
+           shll $16,%ebx
+           movw %cx,%bx
+           movl %ebx,__RESULT
+        end;
+      end;
+
+    function request_linear_region(linearaddr, size : longint;
+                                   var blockhandle : longint) : boolean;
+      var
+         pageofs : longint;
+
+      begin
+         pageofs:=linearaddr and $3ff;
+         linearaddr:=linearaddr-pageofs;
+         size:=size+pageofs;
+         asm
+            movl $0x504,%eax
+            movl linearaddr,%ebx
+            movl size,%ecx
+            movl $1,%edx
+            xorl %esi,%esi
+            int $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+            movl blockhandle,%eax
+            movl %esi,(%eax)
+            movl %ebx,pageofs
+         end;
+         if pageofs<>linearaddr then
+           request_linear_region:=false;
+      end;
+
+    function allocate_memory_block(size:longint):longint;
+      begin
+        asm
+          movl  $0x501,%eax
+          movl  size,%ecx
+          movl  %ecx,%ebx
+          shrl  $16,%ebx
+          andl  $65535,%ecx
+          int   $0x31
+          jnc   .Lallocate_mem_block_err
+          xorl  %ebx,%ebx
+          xorl  %ecx,%ecx
+       .Lallocate_mem_block_err:
+          shll  $16,%ebx
+          movw  %cx,%bx
+          shll  $16,%esi
+          movw  %di,%si
+          movl  %ebx,__RESULT
+        end;
+     end;
+
+    function free_memory_block(blockhandle : longint) : boolean;
+      begin
+         asm
+            movl blockhandle,%esi
+            movl %esi,%edi
+            shll $16,%esi
+            movl $0x502,%eax
+            int  $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+         end;
+      end;
+
+    function lock_linear_region(linearaddr, size : longint) : boolean;
+
+      begin
+          asm
+            movl  $0x600,%eax
+            movl  linearaddr,%ecx
+            movl  %ecx,%ebx
+            shrl  $16,%ebx
+            movl  size,%esi
+            movl  %esi,%edi
+            shrl  $16,%esi
+            int   $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+          end;
+      end;
+
+    function lock_data(var data;size : longint) : boolean;
+
+      var
+         linearaddr : longint;
+
+      begin
+         if get_run_mode <> 4 then
+           exit;
+         linearaddr:=longint(@data)+get_segment_base_address(get_ds);
+         lock_data:=lock_linear_region(linearaddr,size);
+      end;
+
+    function lock_code(functionaddr : pointer;size : longint) : boolean;
+
+      var
+         linearaddr : longint;
+
+      begin
+         if get_run_mode<>rm_dpmi then
+           exit;
+         linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs);
+         lock_code:=lock_linear_region(linearaddr,size);
+      end;
+
+    function unlock_linear_region(linearaddr,size : longint) : boolean;
+
+      begin
+         asm
+            movl  $0x601,%eax
+            movl  linearaddr,%ecx
+            movl  %ecx,%ebx
+            shrl  $16,%ebx
+            movl  size,%esi
+            movl  %esi,%edi
+            shrl  $16,%esi
+            int   $0x31
+            pushf
+            call  test_int31
+            movb  %al,__RESULT
+         end;
+      end;
+
+    function unlock_data(var data;size : longint) : boolean;
+
+      var
+         linearaddr : longint;
+      begin
+         if get_run_mode<>rm_dpmi then
+           exit;
+         linearaddr:=longint(@data)+get_segment_base_address(get_ds);
+         unlock_data:=unlock_linear_region(linearaddr,size);
+      end;
+
+    function unlock_code(functionaddr : pointer;size : longint) : boolean;
+
+      var
+         linearaddr : longint;
+      begin
+         if get_run_mode <>rm_dpmi then
+           exit;
+         linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs);
+         unlock_code:=unlock_linear_region(linearaddr,size);
+      end;
+
+    function set_segment_base_address(d : word;s : longint) : boolean;
+
+      begin
+         asm
+            movw d,%bx
+            leal s,%eax
+            movw (%eax),%dx
+            movw 2(%eax),%cx
+            movl $7,%eax
+            int $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+         end;
+      end;
+
+    function set_descriptor_access_right(d : word;w : word) : longint;
+
+      begin
+         asm
+            movw d,%bx
+            movw w,%cx
+            movl $9,%eax
+            int $0x31
+            pushf
+            call test_int31
+            movw %ax,__RESULT
+         end;
+      end;
+
+    function set_segment_limit(d : word;s : longint) : boolean;
+
+      begin
+         asm
+            movw d,%bx
+            leal s,%eax
+            movw (%eax),%dx
+            movw 2(%eax),%cx
+            movl $8,%eax
+            int $0x31
+            pushf
+            call test_int31
+            movb %al,__RESULT
+         end;
+      end;
+
+    function get_descriptor_access_right(d : word) : longint;
+
+      begin
+         asm
+            movzwl d,%eax
+            lar %eax,%eax
+            jz .L_ok
+            xorl %eax,%eax
+         .L_ok:
+            movl %eax,__RESULT
+         end;
+      end;
+    function get_segment_limit(d : word) : longint;
+
+      begin
+         asm
+            movzwl d,%eax
+            lsl %eax,%eax
+            jz .L_ok2
+            xorl %eax,%eax
+         .L_ok2:
+            movl %eax,__RESULT
+         end;
+      end;
+
+    function create_code_segment_alias_descriptor(seg : word) : word;
+
+      begin
+         asm
+            movw seg,%bx
+            movl $0xa,%eax
+            int $0x31
+            pushf
+            call test_int31
+            movw %ax,__RESULT
+         end;
+      end;
+
+    function get_meminfo(var meminfo : tmeminfo) : boolean;
+
+      begin
+         asm
+            movl meminfo,%edi
+            movl $0x500,%eax
+            int $0x31
+            pushf
+            movb %al,__RESULT
+            call test_int31
+         end;
+      end;
+
+    function get_linear_addr(phys_addr : longint;size : longint) : longint;
+
+      begin
+         asm
+            movl phys_addr,%ebx
+            movl %ebx,%ecx
+            shrl $16,%ebx
+            movl size,%esi
+            movl %esi,%edi
+            shrl $16,%esi
+            movl $0x800,%eax
+            int $0x31
+            pushf
+            call test_int31
+            shll $16,%ebx
+            movw %cx,%bx
+            movl %ebx,__RESULT
+         end;
+      end;
+
+    procedure disable;assembler;
+
+      asm
+         cli
+      end;
+
+    procedure enable;assembler;
+
+      asm
+         sti
+      end;
+
+    function get_run_mode : word;
+
+      begin
+         asm
+            movw _run_mode,%ax
+            movw %ax,__RESULT
+         end ['EAX'];
+      end;
+
+    function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean;
+      begin
+         asm
+           movl device,%edx
+           movl handle,%esi
+           xorl %ebx,%ebx
+           movl pagecount,%ecx
+           movl $0x0508,%eax
+           int $0x31
+           pushf
+           setnc %al
+           movb %al,__RESULT
+           call test_int31
+         end;
+      end;
+
+    function get_core_selector : word;
+
+      begin
+         asm
+            movw _core_selector,%ax
+            movw %ax,__RESULT
+         end;
+      end;
+
+
+{*****************************************************************************
+                              Transfer Buffer
+*****************************************************************************}
+
+    function transfer_buffer : longint;
+      begin
+         transfer_buffer := go32_info_block.linear_address_of_transfer_buffer;
+      end;
+
+
+    function tb_segment : longint;
+      begin
+        tb_segment:=go32_info_block.linear_address_of_transfer_buffer shr 4;
+      end;
+
+
+    function tb_offset : longint;
+      begin
+        tb_offset:=go32_info_block.linear_address_of_transfer_buffer and $f;
+      end;
+
+
+    function tb_size : longint;
+      begin
+         tb_size := go32_info_block.size_of_transfer_buffer;
+      end;
+
+
+    procedure copytodos(var addr; len : longint);
+       begin
+          if len>tb_size then
+            runerror(217);
+          seg_move(get_ds,longint(@addr),dosmemselector,transfer_buffer,len);
+       end;
+
+
+    procedure copyfromdos(var addr; len : longint);
+       begin
+          if len>tb_size then
+            runerror(217);
+          seg_move(dosmemselector,transfer_buffer,get_ds,longint(@addr),len);
+       end;
+
+
+
+begin
+   int31error:=0;
+   dosmemselector:=get_core_selector;
+end.
+
+{
+  $Log$
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.12  1998/08/27 10:30:50  pierre
+    * go32v1 RTL did not compile (LFNsupport outside go32v2 defines !)
+      I renamed tb_selector to tb_segment because
+        it is a real mode segment as opposed to
+        a protected mode selector
+      Fixed it for go32v1 (remove the $E0000000 offset !)
+
+  Revision 1.11  1998/08/26 10:04:02  peter
+    * new lfn check from mailinglist
+    * renamed win95 -> LFNSupport
+    + tb_selector, tb_offset for easier access to transferbuffer
+
+  Revision 1.10  1998/08/11 00:07:17  peter
+    * $ifdef ver0_99_5 instead of has_property
+
+  Revision 1.9  1998/07/21 12:06:03  carl
+    * restored working version
+}

rtl/dos/graph.pp → rtl/go32v2/graph.pp

@@ -1009,7 +1009,10 @@ end.
 
 {
   $Log$
-  Revision 1.15  1998-12-15 22:42:50  peter
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.15  1998/12/15 22:42:50  peter
     * removed temp symbols
 
   Revision 1.14  1998/11/25 22:59:23  pierre

rtl/go32v2/mouse.pp

@@ -0,0 +1,425 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1993,97 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************
+}
+Unit Mouse;
+Interface
+
+{
+  Mouse support functions and procedures, with error checking: if mouse
+  isn't present then the routine ends. If you want to remove error checking,
+  remove the next define.
+}
+
+{$DEFINE MOUSECHECK}
+
+{initializes the mouse with the default values for the current screen mode}
+  Function InitMouse:Boolean;
+
+{shows mouse pointer,text+graphics screen support}
+  Procedure ShowMouse;
+
+{hides mouse pointer}
+  Procedure HideMouse;
+
+{reads mouse position in pixels (divide by 8 to get text position in standard
+ text mode) and reads the buttons state:
+    bit 1 set -> left button pressed
+    bit 2 set -> right button pressed
+    bit 3 set -> middle button pressed
+ Have a look at the example program in the manual to see how you can use this}
+  Procedure GetMouseState(var x,y, buttons :Longint);
+
+{returns true if the left button is pressed}
+  Function LPressed:Boolean;
+
+{returns true if the right button is pressed}
+  Function RPressed:Boolean;
+
+{returns true if the middle button is pressed}
+  Function MPressed:Boolean;
+
+{positions the mouse pointer}
+  Procedure SetMousePos(x,y:Longint);
+
+{returns at which position "button" was last pressed in x,y and returns the
+ number of times this button has been pressed since the last time this
+ function was called with "button" as parameter. For button you can use the
+ LButton, RButton and MButton constants for resp. the left, right and middle
+ button}
+  Function GetLastButtonPress(button:Longint;var x,y:Longint): Longint;
+
+{returns at which position "button" was last released in x,y and returns the
+ number of times this button has been re since the last time. For button
+ you can use the LButton, RButton and MButton constants for resp. the left,
+ right and middle button}
+Function GetLastButtonRelease (button : Longint; var x,y:Longint): Longint;
+
+{sets mouse's x range, with Min and Max resp. the higest and the lowest
+ column (in pixels) in between which the mouse cursor can move}
+  Procedure SetMouseXRange (Min,Max:Longint);
+
+{sets mouse's y range, with Min and Max resp. the higest and the lowest
+ row (in pixels) in between which the mouse cursor can move}
+  Procedure SetMouseYRange (Min,Max:Longint);
+
+{set the window coordinates in which the mouse cursor can move}
+  Procedure SetMouseWindow(x1,y1,x2,y2:Longint);
+
+{sets the mouse shape in text mode: background and foreground color and the
+ Ascii value with which the character on screen is XOR'ed when the cursor
+ moves over it. Set to 0 for a "transparent" cursor}
+  Procedure SetMouseShape(ForeColor,BackColor,Ascii:Byte);
+
+{sets the mouse ascii in text mode. The difference between this one and
+ SetMouseShape, is that the foreground and background colors stay the same
+ and that the Ascii code you enter is the character that you will get on
+ screen; there's no XOR'ing}
+  Procedure SetMouseAscii(Ascii:Byte);
+
+{set mouse speed in mickey's/pixel; default: horizontal: 8; vertical: 16}
+  Procedure SetMouseSpeed(Horizontal ,Vertical:Longint);
+
+{set a rectangle on screen that mouse will disappear if it is moved into}
+  Procedure SetMouseHideWindow(x1,y1,x2,y2:Longint);
+
+Const LButton = 1; {left button}
+      RButton = 2; {right button}
+      MButton = 4; {middle button}
+
+Var
+  MouseFound: Boolean;
+
+Implementation
+
+{$I386_ATT}
+
+Function InitMouse: Boolean;
+begin
+  asm
+        xorl    %eax,%eax
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+        cmpw    $0xffff,%ax
+        setz    %al
+        movb    %al,__RESULT
+  end;
+end;
+
+
+Procedure ShowMouse;
+begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        movl    $1,%eax
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+  end;
+end;
+
+Procedure HideMouse;
+begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        movl    $2,%eax
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+  end;
+end;
+
+Procedure GetMouseState(var x,y,buttons:Longint);
+begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        movl    $3,%eax
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+        andl    $0xffff,%ecx
+        andl    $0xffff,%edx
+        movl    x,%eax
+        movl    %ecx,(%eax)
+        movl    y,%eax
+        movl    %edx,(%eax)
+        movl    buttons,%eax
+        movw    %bx,(%eax)
+  end;
+end;
+
+Function LPressed:Boolean;
+Begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        movl    $3,%eax
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+        movl    %ebx,%eax
+        andl    $1,%eax
+        movb    %al,__RESULT
+  end;
+end;
+
+Function RPressed:Boolean;
+Begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        movl    $3,%eax
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+        movl    %ebx,%eax
+        shrl    $1,%eax
+        andl    $1,%eax
+        movb    %al,__RESULT
+  end;
+end;
+
+Function MPressed:Boolean;
+Begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        movl    $3,%eax
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+        movl    %ebx,%eax
+        shrl    $2,%eax
+        andl    $1,%eax
+        movb    %al,__RESULT
+  end;
+end;
+
+Procedure SetMousePos(x,y:Longint);
+Begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        movl    $4,%eax
+        movl    x,%ecx
+        movl    y,%edx
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+  End;
+End;
+
+Function GetLastButtonPress(Button: Longint;var x,y:Longint):Longint;
+Begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        movl    $5,%eax
+        movl    button,%ebx
+        shrl    $1, %ebx        {0 = left, 1 = right, 2 = middle}
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+        andl    $0xffff,%ebx
+        andl    $0xffff,%edx
+        andl    $0xffff,%ecx
+        movl    %ebx, __RESULT
+        movl    x,%eax
+        movl    %ecx,(%eax)
+        movl    y,%eax
+        movl    %edx,(%eax)
+  end;
+end;
+
+Function GetLastButtonRelease (button : Longint; var x,y:Longint): Longint;
+begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        movl    $6,%eax
+        movl    button,%ebx
+        shrl    $1, %ebx        {0 = left, 1 = right, 2 = middle}
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+        andl    $0xffff,%ebx
+        andl    $0xffff,%ecx
+        andl    $0xffff,%edx
+        movl    %ebx,__RESULT
+        movl    x,%eax
+        movl    %ecx,(%eax)
+        movl    y,%eax
+        movl    %edx,(%eax)
+  end;
+end;
+
+Procedure SetMouseXRange (Min,Max:Longint);
+begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        movl    $7,%eax
+        movl    min,%ecx
+        movl    max,%edx
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+  end;
+end;
+
+Procedure SetMouseYRange (min,max:Longint);
+begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        movl    $8,%eax
+        movl    min,%ecx
+        movl    max,%edx
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+  end;
+end;
+
+Procedure SetMouseWindow(x1,y1,x2,y2:Longint);
+Begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  SetMouseXRange(x1,x2);
+  SetMouseYRange(y1,y2);
+End;
+
+Procedure SetMouseShape(ForeColor,BackColor,Ascii:Byte);
+Begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        xorl    %ebx,%ebx
+        movl    $0xa,%eax
+        movl    $0xffff,%ecx
+        xorl    %edx,%edx
+        movb    BackColor,%dh
+        shlb    $4,%dh
+        addb    ForeColor,%dh
+        movb    Ascii,%dl
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+  End;
+End;
+
+Procedure SetMouseAscii(Ascii:byte);
+Begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        xorl    %ebx,%ebx
+        movl    $0xa,%eax
+        movl    $0xff00,%ecx
+        xorl    %edx,%edx
+        movb    Ascii,%dl
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+  End;
+End;
+
+Procedure SetMouseHideWindow(x1,y1,x2,y2:Longint);
+Begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        movl    $0x0010,%eax
+        movl    x1,%ecx
+        movl    y1,%edx
+        movl    x2,%esi
+        movl    y2,%edi
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+  end;
+End;
+
+Procedure SetMouseSpeed(Horizontal,Vertical:Longint);
+Begin
+{$IFDEF MOUSECHECK}
+  If (Not MouseFound) Then Exit;
+{$ENDIF}
+  asm
+        movl    $0x0f,%eax
+        movl    Horizontal,%ecx
+        movl    Vertical,%edx
+        pushl   %ebp
+        int     $0x33
+        popl    %ebp
+  end;
+End;
+
+Begin
+  MouseFound := InitMouse;
+End.
+{
+  $Log$
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.5  1998/07/15 16:10:35  jonas
+  * new mouse uni
+
+  Revision 1.3  1998/04/05 13:56:54  peter
+    - fixed mouse to compile with $i386_att
+    + linux crt supports redirecting (not Esc-codes anymore)
+
+  Revision 1.2  1998/03/26 12:25:22  peter
+    * integrated both mouse units
+
+  Revision 1.1.1.1  1998/03/25 11:18:41  root
+  * Restored version
+
+  Revision 1.4  1998/03/24 15:53:12  peter
+    * cleanup and doesn't give warnings when compiling
+
+  Revision 1.3  1998/01/26 11:56:24  michael
+  + Added log at the end
+
+  Revision 1.2
+  date: 1997/12/01 12:15:45;  author: michael;  state: Exp;  lines: +14 -12
+  + added copyright reference in header.
+
+  Revision 1.1
+  date: 1997/11/27 08:33:49;  author: michael;  state: Exp;
+  Initial revision
+
+  Revision 1.1.1.1
+  date: 1997/11/27 08:33:49;  author: michael;  state: Exp;  lines: +0 -0
+  FPC RTL CVS start
+}

rtl/dos/go32v2/objinc.inc → rtl/go32v2/objinc.inc

@@ -131,7 +131,10 @@ END;
 
 {
   $Log$
-  Revision 1.2  1998-05-31 14:18:26  peter
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.2  1998/05/31 14:18:26  peter
     * force att or direct assembling
     * cleanup of some files
 

rtl/dos/go32v2/os.inc → rtl/go32v2/os.inc

@@ -19,7 +19,10 @@
 
 {
   $Log$
-  Revision 1.2  1998-05-31 14:18:27  peter
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.2  1998/05/31 14:18:27  peter
     * force att or direct assembling
     * cleanup of some files
 

rtl/dos/ppi/arc.ppi → rtl/go32v2/ppi/arc.ppi

@@ -156,7 +156,10 @@
 
 {
   $Log$
-  Revision 1.6  1998-11-23 10:04:17  pierre
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.6  1998/11/23 10:04:17  pierre
     * pieslice and sector work now !!
     * bugs in text writing removed
     + scaling for defaultfont added
@@ -196,7 +199,7 @@
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/arc.ppi
   description:
   ----------------------------

rtl/dos/ppi/colors.ppi → rtl/go32v2/ppi/colors.ppi

@@ -121,7 +121,7 @@ begin
   truebackcolor:=color;
   aktbackcolor:=convert(Color);
 end;
-  
+
 function  GetMaxColor : longint;
 begin
   _graphresult:=grOk;
@@ -175,10 +175,13 @@ end;
             white := 15;
          end;
   end;
-    
+
 {
   $Log$
-  Revision 1.2  1998-11-18 09:31:31  pierre
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.2  1998/11/18 09:31:31  pierre
     * changed color scheme
       all colors are in RGB format if more than 256 colors
     + added 24 and 32 bits per pixel mode
@@ -194,7 +197,7 @@ end;
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/colors.ppi
   description:
   ----------------------------

rtl/dos/ppi/dpmi2raw.ppi → rtl/go32v2/ppi/dpmi2raw.ppi

@@ -24,17 +24,20 @@ begin
     movw  %si,_SWITCHSEG
   end;
 end;
-  
+
 {
   $Log$
-  Revision 1.1  1998-03-25 11:18:42  root
-  Initial revision
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.1.1.1  1998/03/25 11:18:42  root
+  * Restored version
 
   Revision 1.3  1998/01/26 11:57:47  michael
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/dpmi2raw.ppi
   description:
   ----------------------------

rtl/dos/ppi/ellipse.ppi → rtl/go32v2/ppi/ellipse.ppi

@@ -27,8 +27,8 @@
      abq:=aq * bq;
      yp:=YRadius;
      xp:=0;
-     count:=0; 
-     
+     count:=0;
+
       { Berechnung nach : X^2 / A^2 + Y^2 / B^2 = 1               }
       {      umgestellt : X^2 * Y^2 * A^2 * B^2 = A^2*B^2         }
       {      dadurch werden evtuelle Divisionen durch 0 vermieden }
@@ -59,20 +59,20 @@
       PWord(buffermem)[count+2]:=x - xp;
       PWord(buffermem)[count+3]:=y - yp;
       xq:=xp * xp; yq:=yp * yp;
-      if xq * bq + yq * aq >= abq then yp:=yp-1 else xp:=xp+1; 
+      if xq * bq + yq * aq >= abq then yp:=yp-1 else xp:=xp+1;
       Count:=Count+4;
     until yp < 0;
     CalcEllipse:=Count;
   end;
-    
-  Procedure _Ellipse(Count:Integer);  
+
+  Procedure _Ellipse(Count:Integer);
     const aq:Integer=0;
     begin
-    
+
     { Das Zeichnen der Ellipse erfolgt in zwei Schleifen, um systematisch }
     { von oben nach unten zu zeichnen und somit ein staendiges Bank-      }
     { umschalten zu verhindern }
-    
+
     while aq <> count do begin
       PutPixeli( PWord(buffermem)[aq]  ,PWord(buffermem)[aq+3],aktcolor);
       PutPixeli( PWord(buffermem)[aq+2],PWord(buffermem)[aq+3],aktcolor);
@@ -85,7 +85,7 @@
     end;
   end;
 
-  Procedure Fillellipse(x,y:Integer;XRadius,YRadius:word);    
+  Procedure Fillellipse(x,y:Integer;XRadius,YRadius:word);
     var Count,index:Word;
         Count8:Word;
         begin
@@ -102,21 +102,21 @@
     if Count=0 then exit;
     Count8:=Count-8;
     index:=0;
-    
+
     while index < count do begin
       while (PWord(buffermem)[index+1]=PWord(buffermem)[index+5]) and
             (index < count8) do Index:=Index+4;
       PatternLine(PWord(buffermem)[index],PWord(buffermem)[index+2],
-                  PWord(buffermem)[index+3]); 
+                  PWord(buffermem)[index+3]);
       Index:=Index+4;
     end;
-    
-    while index > 0 do begin   
-      index:=index-4;  
+
+    while index > 0 do begin
+      index:=index-4;
       PatternLine(PWord(buffermem)[index],PWord(buffermem)[index+2],
-                  PWord(buffermem)[index+1]); 
+                  PWord(buffermem)[index+1]);
       while (PWord(buffermem)[index+1]=PWord(buffermem)[index-3]) and
-            (index > 4 ) do Index:=Index-4; 
+            (index > 4 ) do Index:=Index-4;
     end;
 
     if (aktColor <> aktFillSettings.Color) or (aktFillSettings.Pattern<>1)
@@ -276,11 +276,14 @@
      XRadius:=(Radius*10000) div XAsp;
      YRadius:=(Radius*10000) div YAsp;
     _Ellipse(CalcEllipse(x,y,xradius,yradius));
-  end;  
- 
+  end;
+
 {
   $Log$
-  Revision 1.6  1998-11-23 10:04:18  pierre
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.6  1998/11/23 10:04:18  pierre
     * pieslice and sector work now !!
     * bugs in text writing removed
     + scaling for defaultfont added
@@ -320,7 +323,7 @@
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/ellipse.ppi
   description:
   ----------------------------

rtl/dos/ppi/fill.ppi → rtl/go32v2/ppi/fill.ppi

@@ -31,8 +31,8 @@ var bordercol     : longint;
 procedure fill(x,y:integer);
 var start,ende,xx : integer;
     col           : longint;
- 
-begin  
+
+begin
 {$ifdef GraphDebug}
   if (x>viewport.x2) or (x<viewport.x1) or
      (y>viewport.y2) or (y<viewport.y1) then
@@ -62,7 +62,7 @@ begin
   xx:=x;
   col:=getpixeli(xx,y);
   while (col<>bordercol) and (xx < viewport.x2) and (col<>fillcol)
-      and (not test_bkfill or (col<>fillbkcol)) 
+      and (not test_bkfill or (col<>fillbkcol))
     do begin
       xx:=xx+1; col:=getpixeli(xx,y);
     end;
@@ -80,14 +80,14 @@ begin
      Writeln(stderr,'Fill  after Patterline ',x,' ',y,' ',hexstr(getpixel(x,y),8));
 {$endif def GraphDebug}
   offset:=(y * _maxy + start) shr 8;
-  
+
   if (y > viewport.y1)
   then begin
     xx:=start;
     repeat
       col:=getpixeli(xx,y-1);
       if (col<>bordercol) and (col<>fillcol) and
-         (not test_bkfill or (col<>fillbkcol)) 
+         (not test_bkfill or (col<>fillbkcol))
       then begin
         fill(xx,y-1);
         break;
@@ -245,7 +245,7 @@ end;
 
 { this procedure is rather confuse
   but I admit that I wrote it by try-error !! PM }
-  
+
 procedure FillPoly(points : word;var polypoints);
 {$R-}
  type PointTypeArray = Array[0..0] of PointType;
@@ -261,7 +261,7 @@ procedure FillPoly(points : word;var polypoints);
                       use_in_line : boolean;
                     End;
      LineSegmentInfoArray = Array[0..0] of TLineSegmentInfo;
-     
+
  var
      xmin,xmax,ymin,ymax : longint;
      x1,x2,y1,y2,y,xdeb  : longint;
@@ -318,12 +318,12 @@ begin
        end;
    if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
    { reject invalid points !! }
- 
+
    viewport.x2:=viewport.x2-viewport.x1;
    viewport.y2:=viewport.y2-viewport.y1;
    viewport.x1:=0;
    viewport.y1:=0;
- 
+
 {$ifdef GraphDebug}
        Writeln(stderr,'Rectangle (',xmin,',',ymin,'),(',xmax,',',ymax,')');
 {$endif def GraphDebug}
@@ -398,7 +398,7 @@ begin
 {$endif def GraphDebug}
           end;
      end;
-       
+
    FreeMem(LineInfo,(points+1)*SizeOf(TlineSegmentInfo));
    { simply call drawpoly instead (PM) }
    DrawPoly(points,polypoints);
@@ -407,7 +407,10 @@ end;
 
 {
   $Log$
-  Revision 1.8  1998-11-25 22:59:24  pierre
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.8  1998/11/25 22:59:24  pierre
    * fillpoly works
 
   Revision 1.7  1998/11/25 13:04:44  pierre
@@ -453,7 +456,7 @@ end;
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/fill.ppi
   description:
   ----------------------------

rtl/dos/ppi/font.ppi → rtl/go32v2/ppi/font.ppi

@@ -22,7 +22,7 @@ function getfontpointer(b : byte):longint;
     dregs.RealEAX:=$1130;
     dregs.RealEBX:=longint(b shl 8);
     RealIntr($10,dregs);
-    getfontpointer:=(longint(dregs.RealES) shl 4) + dregs.RealEBP and $FFFF; 
+    getfontpointer:=(longint(dregs.RealES) shl 4) + dregs.RealEBP and $FFFF;
   end;
 
 procedure getdefaultfont;
@@ -53,17 +53,20 @@ procedure getdefaultfont;
       move(pointer(getfontpointer(4)+core)^,defaultfontdata[1024],1024);
     end;
   end;
- 
+
 {
   $Log$
-  Revision 1.1  1998-03-25 11:18:42  root
-  Initial revision
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.1.1.1  1998/03/25 11:18:42  root
+  * Restored version
 
   Revision 1.3  1998/01/26 11:58:02  michael
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/font.ppi
   description:
   ----------------------------

rtl/dos/ppi/global.ppi → rtl/go32v2/ppi/global.ppi

@@ -35,10 +35,10 @@
        { graphic drivers }
        CurrentDriver = -128;
        Detect = 0;
-     
+
        { graph modes }
        Default = 0;
-       
+
        { Farben f�r setpalette und setallpalette }
        black : longint = 0;
        blue  : longint = 1;
@@ -66,7 +66,7 @@
 
        NormWidth = 1;
        ThickWidth = 3;
- 
+
        { Set/GetTextStyle Konstanten: }
        DefaultFont = 0;
        TriplexFont = 1;
@@ -128,12 +128,12 @@
        RGBColor = record
          r,g,b,i : byte;
        end;
-       
+
        PaletteType = record
-          Size   : integer; 
+          Size   : integer;
           Colors : array[0..767]of Byte;
        end;
-       
+
        LineSettingsType = record
           linestyle : word;
           pattern : word;
@@ -169,7 +169,7 @@
           xstart,ystart : integer;
           xend,yend : integer;
        end;
-       
+
   const
        fillpattern : array[0..12] of FillPatternType = (
            ($00,$00,$00,$00,$00,$00,$00,$00),     { Hintergrundfarbe }
@@ -197,7 +197,7 @@
   G640x480x32K      = $110;
   G640x480x64K      = $111;
   G640x480x16M      = $112;
-  
+
   G800x600x32K      = $113;
   G800x600x64K      = $114;
   G800x600x16M      = $115;
@@ -218,7 +218,10 @@
 
 {
   $Log$
-  Revision 1.5  1998-11-19 15:09:38  pierre
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.5  1998/11/19 15:09:38  pierre
     * several bugfixes for sector/ellipse/floodfill
     + graphic driver mode const in interface G800x600x256...
     + added backput mode as in linux graph.pp
@@ -255,7 +258,7 @@
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/global.ppi
   description:
   ----------------------------

rtl/dos/ppi/ibm.ppi → rtl/go32v2/ppi/ibm.ppi

@@ -20,20 +20,18 @@ begin
      Seg:=word(Result_ shr 16);
      dregs.RealSP:=0;      dregs.RealSS:=0;
      dregs.RealES:=Seg;    dregs.RealEDI:=0;
-     dregs.RealEAX:=$4F00; RealIntr($10,dregs);  
-     if isDPMI 
+     dregs.RealEAX:=$4F00; RealIntr($10,dregs);
+     if isDPMI
        then MoveLong(sel,@VGAInfo,256)
        else Move(pointer((seg shl 4)+core)^,VGAInfo,256);
-  global_dos_free(sel); 
+  global_dos_free(sel);
   DetectVesa:=(dregs.RealEAX and $FF=$4F);
   isVESA2:=VGAInfo.VESAHiVersion=2;
 end;
 
 function GetVESAInfo( Mode : WORD ):Boolean;
 var Result_:longint;
-    Temp : longint;
     St : string;
-    w : word;
 begin
   Result_:=Global_dos_alloc($0200);
      Sel:=word(Result_);
@@ -42,7 +40,7 @@ begin
      dregs.RealSP:=0;      dregs.RealSS:=0;
      dregs.RealES:=Seg;    dregs.RealEDI:=0;
      dregs.RealEAX:=$4F01; RealIntr($10,dregs);
-     if isDPMI 
+     if isDPMI
        then MoveLong(sel,@VESAInfo,256)
        else Move(Pointer((seg shl 4)+core)^,VESAINFO,256);
   global_dos_free(sel);
@@ -111,14 +109,14 @@ begin
        128 : GranShift:=7;
         64 : GranShift:=6;
         32 : GranShift:=5;
-        16 : GranShift:=4; 
+        16 : GranShift:=4;
          8 : GranShift:=3;
          4 : GranShift:=2;
          2 : GranShift:=1;
          1 : GranShift:=0;
      end;
      (* { on my ATI rage pro card these field are zeroed !! (PM) }
-     
+
      if VesaInfo.rf_pos=VesaInfo.bf_pos then
        begin
          VesaInfo.rm_size:=VESAInfo.BitsPerPixel div 3;
@@ -128,7 +126,7 @@ begin
          VesaInfo.gf_pos:=VesaInfo.bm_size;
          VesaInfo.rf_pos:=VesaInfo.bm_size+VesaInfo.gm_size;
        end;   *)
-       
+
      if isDPMI then begin
        set_segment_base_address(seg_write,$A000 shl 4);
        set_segment_limit(seg_write,$FFFF);
@@ -173,7 +171,7 @@ begin
       else
 {$endif Test_linear}
         FrameBufferLinearAddress:=$A0000;
-        
+
 {$ifdef Test_linear}
       If isDPMI and LinearFrameBufferSupported and UseLinear then
         UseLinearFrameBuffer:=true
@@ -226,7 +224,7 @@ procedure SetDisplayPage(PageNum : word);
      dregs.RealEAX:=$0500+(PageNum and $FF);
      RealIntr($10,dregs);
   end;
-  
+
 function SetVESADisplayStart(PageNum : word;x,y : integer):Boolean;
 begin
   if PageNum>VesaInfo.NumberOfPages then
@@ -331,7 +329,10 @@ end;
 
 {
   $Log$
-  Revision 1.7  1998-11-25 13:04:46  pierre
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.7  1998/11/25 13:04:46  pierre
     + added multi page support
 
   Revision 1.6  1998/11/20 18:42:08  pierre
@@ -364,7 +365,7 @@ end;
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/ibm.ppi
   description:
   ----------------------------

rtl/dos/ppi/image.ppi → rtl/go32v2/ppi/image.ppi

@@ -23,7 +23,7 @@ begin
   begin
     _graphresult:=grnoinitgraph;
     exit;
-  end;         
+  end;
 
 x1:=x1+aktviewport.x1;
 y1:=y1+aktviewport.y1;
@@ -54,7 +54,7 @@ for i:=y1 to y2 do
         ScreenToMem(ofs1 and WinLoMask,target,diff-BytesPerPixel);
         Switchbank(bank2);
         ScreenToMem((ofs1+diff) and WinLoMask,target+diff,linesize-diff);
-      end; 
+      end;
     target:=target+linesize;
   end;
 end;
@@ -75,7 +75,7 @@ procedure PutImage(x,y : integer;var BitMap;BitBlt : word);
               _graphresult:=grnoinitgraph;
               exit;
            end;
-         
+
          source:=longint(@bitmap)+4;
          Width:=pinteger(@bitmap)^;
          Increment:=longint(Width);
@@ -83,15 +83,15 @@ procedure PutImage(x,y : integer;var BitMap;BitBlt : word);
          { wenn ausserhalb des Screens Procedur verlassen }
          x:=x+aktviewport.x1;
          y:=y+aktviewport.y1;
-         
-         if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen; 
-         if (x > viewport.x2 ) or 
+
+         if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
+         if (x > viewport.x2 ) or
              (y > viewport.y2 ) or
-              (x+Increment < viewport.x1) or 
+              (x+Increment < viewport.x1) or
                (y+height < viewport.y1) then exit;
-  
+
            { Clip oben }
-           if y < viewport.y1 then 
+           if y < viewport.y1 then
              begin
                diff:=viewport.y1-y;
                height:=height-diff;
@@ -99,28 +99,28 @@ procedure PutImage(x,y : integer;var BitMap;BitBlt : word);
                y:=viewport.y1;
              end;
            { Clip unten }
-           
+
            if y+height > viewport.y2 then
                height:=viewport.y2-y;
-           
+
            { Clip links }
-           if x < viewport.x1 then 
+           if x < viewport.x1 then
              begin
                diff:=viewport.x1-x;
                Width:=Increment-diff;
                source:=source+diff;
                x:=viewport.x1;
              end;
-           
+
            { clip rechts }
-           if x+width > viewport.x2 then 
+           if x+width > viewport.x2 then
              begin
                diff:=x+width-viewport.x2;
                Width:=Increment-diff;
              end;
-          
+
  Increment:=Increment*BytesPerPixel;
- Width:=Width*BytesPerPixel;  
+ Width:=Width*BytesPerPixel;
  for i:=y to y+height-1 do
    begin
      offset:=Y_ARRAY[i] + X_ARRAY[x];
@@ -131,7 +131,7 @@ procedure PutImage(x,y : integer;var BitMap;BitBlt : word);
          Switchbank(o1);
        end;
      if o1 = o2 then
-     begin  
+     begin
        case bitblt of
          normalput : MemToScreen (source,offset and WinLoMask,width);
          andput    : MemAndScreen(source,offset and WinLoMask,width);
@@ -176,8 +176,8 @@ procedure PutImage(x,y : integer;var BitMap;BitBlt : word);
  if is_mmx_cpu then
    emms;
 end;
-    
-    
+
+
     function ImageSize(x1,y1,x2,y2 : integer) : longint;
 
       begin
@@ -186,11 +186,14 @@ end;
          { 4 bytes for Height and width in words at the beginning }
       end;
 
- 
+
 
 {
   $Log$
-  Revision 1.2  1998-11-18 09:31:36  pierre
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.2  1998/11/18 09:31:36  pierre
     * changed color scheme
       all colors are in RGB format if more than 256 colors
     + added 24 and 32 bits per pixel mode
@@ -210,7 +213,7 @@ end;
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/image.ppi
   description:
   ----------------------------

rtl/dos/ppi/line.ppi → rtl/go32v2/ppi/line.ppi

@@ -24,7 +24,7 @@ begin
          inc(x1);
        end;
    end;
-   
+
   asm
     movswl x1,%ebx
     movswl x2,%ecx
@@ -37,7 +37,7 @@ begin
     andl   _WINLOMASK,%edi
     andl   $0x7,%edx                    // { y and $7                }
     shll   $0x5,%edx                    // { y * 8 * sizeof(longint) }
-    leal   _PATTERNBUFFER,%esi          // 
+    leal   _PATTERNBUFFER,%esi          //
     addl   %edx,%esi                    // { Offset in Patternbuffer }
     movl   $0x7,%edx
     addl   _WBUFFER,%edi
@@ -50,7 +50,7 @@ begin
     cmpw   $2,_BYTESPERPIXEL
     je     .Lpl_movdw
     jb     .Lpl_movdb
-    
+
 {$ifdef TEST_24BPP}
     cmpw   $3,_BYTESPERPIXEL
     je     .Lpl_movd24BPP
@@ -66,7 +66,7 @@ begin
     incl   %ebx
     decl   %ecx
     jnz    .Lpl_movd32BPP
-    jz     .Lpl_d_exit    
+    jz     .Lpl_d_exit
  .align 4,0x90
  .Lpl_movd24BPP:
     andl   $7,%ebx
@@ -82,7 +82,7 @@ begin
     incl   %ebx
     decl   %ecx
     jnz    .Lpl_movd24BPP
-    jz     .Lpl_d_exit    
+    jz     .Lpl_d_exit
 {$endif TEST_24BPP}
  .align 4,0x90
  .Lpl_movdb:
@@ -93,7 +93,7 @@ begin
     incl   %ebx
     decl   %ecx
     jnz    .Lpl_movdb
-    jz     .Lpl_d_exit    
+    jz     .Lpl_d_exit
 
  .align 4,0x90
  .Lpl_movdw:
@@ -104,7 +104,7 @@ begin
     incl   %ebx
     decl   %ecx
     jnz    .Lpl_movdw
-    jz     .Lpl_d_exit    
+    jz     .Lpl_d_exit
  .Lpl_xord:
     cmpw   $2,_BYTESPERPIXEL
     je     .Lpl_xordw
@@ -126,7 +126,7 @@ begin
     incl   %ebx
     decl   %ecx
     jnz    .Lpl_xord32BPP
-    jz     .Lpl_d_exit    
+    jz     .Lpl_d_exit
  .align 4,0x90
  .Lpl_xord24BPP:
     andl   $7,%ebx
@@ -141,7 +141,7 @@ begin
     incl   %ebx
     decl   %ecx
     jnz    .Lpl_xord24BPP
-    jz     .Lpl_d_exit    
+    jz     .Lpl_d_exit
 {$endif TEST_24BPP}
  .align 4,0x90
  .Lpl_xordb:
@@ -152,7 +152,7 @@ begin
     incl   %ebx
     decl   %ecx
     jnz    .Lpl_xordb
-    jz     .Lpl_d_exit 
+    jz     .Lpl_d_exit
  .align 4,0x90
  .Lpl_xordw:
     andl   %edx,%ebx
@@ -177,7 +177,7 @@ begin
   x1:= x1 + aktviewport.x1 ;
   y:=  y +  aktviewport.y1 ;
   x2:= x2 + aktviewport.x1 ;
-  
+
   if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
   if (y < viewport.y1) or (y > viewport.y2) then exit;
   if x1 > x2 then begin diff:=x2; x2:=x1; x1:=diff; end;
@@ -194,7 +194,7 @@ begin
     Switchbank(bank1);
   end;
   if bank1 <> bank2 then begin
-     diff:=(((bank2 shl winshift)-ofs1) div BytesPerPixel)+x1;  
+     diff:=(((bank2 shl winshift)-ofs1) div BytesPerPixel)+x1;
      DrawPattern(x1,diff-1,y);
      Switchbank(bank2);
      DrawPattern(diff,x2,y);
@@ -233,7 +233,7 @@ begin
       exit;
    end;
 {$endif TEST_24BPP}
-   
+
   asm
     movw   %es,%dx
     movzwl y,%ebx
@@ -248,9 +248,9 @@ begin
     andl   _WINLOMASK,%edi
     movl   _AKTCOLOR,%eax
     movzwl _AKTWRITEMODE,%esi
-    addl   _WBUFFER,%edi    
+    addl   _WBUFFER,%edi
     movw   _SEG_WRITE,%bx
-    movw   %bx,%es 
+    movw   %bx,%es
     testl  %esi,%esi                    // { Writemode ?       }
     jnz    .Lhl_xor
     shrl   %ecx
@@ -271,13 +271,13 @@ begin
     shrl   %ecx
     jnc    .Lhl_xorw
     xorb   %al,%es:(%edi)
-    incl   %edi 
+    incl   %edi
  .Lhl_xorw:
     shrl   %ecx
     jnc    .Lhl_xord
     xorw   %ax,%es:(%edi)
     addl   $2,%edi
- .Lhl_xord:   
+ .Lhl_xord:
     jecxz  .Lhl_exit
  .align 4,0x90
  .Lhl_xorloop:
@@ -292,54 +292,54 @@ end;
 
 procedure Line(x1,y1,x2,y2: integer);
 var dx,dy,d        : longint;
-    i,j            : integer; 
+    i,j            : integer;
     ofs,ofs2       : longint;
-    i1,i2,ix       : longint; 
-    x,y            : Integer; 
+    i1,i2,ix       : longint;
+    x,y            : Integer;
     flag,dontcheck : Boolean;
     viewport       : ViewPortType;
 begin
-  
+
   x1:= x1 + aktviewport.x1 ;
   y1:= y1 + aktviewport.y1 ;
   x2:= x2 + aktviewport.x1 ;
   y2:= y2 + aktviewport.y1 ;
   if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
-  
+
   { ************ Horizontalline ************** }
 
   if y1=y2 then begin
-    if x1>x2 then begin d:=x1; x1:=x2; x2:=d; end; 
+    if x1>x2 then begin d:=x1; x1:=x2; x2:=d; end;
     if aktlineinfo.thickness=3 then y1:=y1-1;
     i:=0;
     if x1 < viewport.x1 then x1:=viewport.x1;
     if x2 > viewport.x2 then x2:=viewport.x2;
     if (y1 > viewport.y2) or (x1 > x2 ) then exit;
-    repeat  
-      if (y1 >= viewport.y1) and (y1 <=viewport.y2) 
+    repeat
+      if (y1 >= viewport.y1) and (y1 <=viewport.y2)
       then begin
         ofs:= Y_ARRAY[y1];
         ofs2:=ofs+X_ARRAY[x2];
         ofs:= ofs+X_ARRAY[x1];
         i1:=ofs shr winshift; i2:=ofs2 shr winshift;
         if i1 <> a_bank then
-          begin 
-            switchbank(i1); 
+          begin
+            switchbank(i1);
           end;
         if i1=i2 then Horizontalline(x1,x2,y1)
-          else                             
-            begin 
+          else
+            begin
             dx:=((i2 shl winshift)-ofs) div BytesPerPixel;
             horizontalline(x1,x1+dx-1,y1);
             Switchbank(i2);
-            horizontalline(dx+x1,x2,y1); 
+            horizontalline(dx+x1,x2,y1);
           end;
       end;
       i:=i+1; y1:=y1+1;
-    until i=aktlineinfo.thickness;  
+    until i=aktlineinfo.thickness;
     exit;
-  end;  
-  
+  end;
+
   { *********** End Horizontalline *********** }
 
   if y1 > y2 then begin
@@ -378,47 +378,47 @@ begin
   i2:=(dx shl 1)-i1;
 
   { for 24BPP use slow checking code,easy and poor implementation ! PM }
-dontcheck:=(y1>=viewport.y1) and (y2<=viewport.y2) and 
+dontcheck:=(y1>=viewport.y1) and (y2<=viewport.y2) and
            (x1>=viewport.x1) and (x1<=viewport.x2) and
            (x2>=viewport.x1) and (x2<=viewport.x2) and
            (BytesPerPixel<3);
 
-if aktlineinfo.thickness=3 then 
+if aktlineinfo.thickness=3 then
 
     { *************************************** }
     { **** Thickness=3 with rangechecking *** }
-    { *************************************** } 
-    
+    { *************************************** }
+
 begin
   repeat
     for i:=y1-1 to y1+1 do
-      for j:=x1-1 to x1+1 do 
-      if (i>=viewport.y1) and (j>=viewport.x1) and 
+      for j:=x1-1 to x1+1 do
+      if (i>=viewport.y1) and (j>=viewport.x1) and
          (j<=viewport.x2) and (i<=viewport.y2) then pixel(X_ARRAY[j]+Y_ARRAY[i]);
     if d < 0
-    then begin 
+    then begin
       if Flag then y1:=y1+1 else x1:=x1+ix;
       d:=d+i1;
-    end  
+    end
     else begin
       d:=d-i2; x1:=x1+ix; y1:=y1+1;
-    end; 
+    end;
   dx:=dx-1;
   until ( dx=0 ) or ( y1 > viewport.y2 )
-end else 
+end else
   if dontcheck then
 
     { *************************************** }
     { ** Thickness=1 without rangechecking ** }
-    { *************************************** } 
-    
-    begin 
+    { *************************************** }
+
+    begin
     asm
      pushw  %gs
      movw   _SEG_WRITE,%ax
      movw   %ax,%gs                   // { ScreenSelector }
-  
-  // selfmodify to speedup Code   
+
+  // selfmodify to speedup Code
      xorl   %ebx,%ebx
      movl   ix,%eax
      testl  %eax,%eax
@@ -439,19 +439,19 @@ end else
      movb   %al,.Lwinshift
      movl   _WINLOMASK,%eax
      movl   %eax,.Lwinlomask
-     movb   $0x90,operandprefix       // Opcade nop  
+     movb   $0x90,operandprefix       // Opcade nop
      testw  $1,_AKTWRITEMODE
      jnz    line1XOR
      movb   $0x88,linemode            // Opcode movb
      jmp    linedepth
     line1XOR:
       movb   $0x30,linemode           // Opcode xorb
-    linedepth:  
+    linedepth:
       testw  $1,_BYTESPERPIXEL
       jnz    is_byte
       movb   $0x66,operandprefix      // Prefix for operandsize
       incb   linemode                 // incr. for wordacces
-    is_byte:      
+    is_byte:
       movl   dx,%ecx
       movl   _AKTCOLOR,%eax
       movzwl y1,%esi
@@ -459,9 +459,9 @@ end else
       movswl d,%edx
    //----------------//
    //  Linemainloop  //
-   //----------------//   
+   //----------------//
 .align 4,0x90
-line1_loop:  
+line1_loop:
       pushl  %ecx
       pushl  %eax
       movl   _Y_ARRAY(,%esi,4),%edi
@@ -473,14 +473,14 @@ line1_loop:
       .byte 0xc1,0xe8                 // shrl ..,%eax
     .Lwinshift:                         //
       .byte 0x88                      // _WINSHIFT
-      
+
       pushl  %edi
       cmpl   _A_BANK,%eax
       je     line1_dontswitch
-      
+
       pushl  %ebx
       pushl  %edx
-      pushl  %esi   
+      pushl  %esi
       pushl  %eax
       movl   _BANKSWITCHPTR,%eax
       call   %eax
@@ -501,55 +501,55 @@ line1_dontswitch:
     linemode:
      .byte   0x88,0x07                 // modified OpCode<movb,xorb...>,%edi
       decl   %ecx
-      jz     line1_end      
+      jz     line1_end
       testl  %edx,%edx                 // { if d < 0 then }
       jns    is_positive
       testb  $1,flag                   // { if flag then }
       jz     no_flag
-      incl   %esi                      // { y1:=y1+1  }   
+      incl   %esi                      // { y1:=y1+1  }
      .byte   0x81,0xc2
-    i1long1:   
+    i1long1:
      .long   0x88888888                // { d:=d+i1   }
       jmp    line1_loop
 .align 4,0x90
 no_flag:
-    inc_dec1: 
-     .byte   0x88                      // { x1:=x1+ix }   
+    inc_dec1:
+     .byte   0x88                      // { x1:=x1+ix }
      .byte   0x81,0xc2
-    i1long2:   
+    i1long2:
      .long   0x88888888                // { d:=d+i1   }
       jmp    line1_loop
 .align 4,0x90
 is_positive:
-    inc_dec2:  
+    inc_dec2:
      .byte   0x88                      // { x1:=x1+ix }
-      incl   %esi                      // { y1:=y1+1  }      
-     .byte   0x81,0xea 
-    i2long:  
+      incl   %esi                      // { y1:=y1+1  }
+     .byte   0x81,0xea
+    i2long:
      .long   0x88888888                // { d:=d-i2   }
       jmp    line1_loop
 line1_end:
       popw   %gs
     end;
   end else
-    
+
     { *************************************** }
     { **** Thickness=1 with rangechecking *** }
-    { *************************************** } 
-    
+    { *************************************** }
+
     begin
     repeat
       if y1 > viewport.y2 then exit;
-      if (y1>=viewport.y1) and (x1>=viewport.x1) and 
-         (x1<=viewport.x2) then pixel(Y_ARRAY[y1]+X_ARRAY[x1]);    
+      if (y1>=viewport.y1) and (x1>=viewport.x1) and
+         (x1<=viewport.x2) then pixel(Y_ARRAY[y1]+X_ARRAY[x1]);
       if d < 0
-      then begin 
+      then begin
         if Flag then y1:=y1+1 else x1:=x1+ix;
         d:=d+i1;
-      end  
+      end
       else begin
         d:=d-i2; x1:=x1+ix; y1:=y1+1;
-      end; 
+      end;
     dx:=dx-1;
     until  dx=0 ;
   end;
@@ -600,7 +600,7 @@ begin
      exit;
    end;
   Line(curx,cury,curx+dx,cury+dy);
-  curx:=curx+dx; 
+  curx:=curx+dx;
   cury:=cury+dy;
 end;
 
@@ -652,7 +652,10 @@ end;
 
 {
   $Log$
-  Revision 1.4  1998-11-18 13:23:35  pierre
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.4  1998/11/18 13:23:35  pierre
     * floodfill got into an infinite loop !!
     + added partial support for fillpoly
       (still wrong if the polygon is not convex)

rtl/dos/ppi/modes.ppi → rtl/go32v2/ppi/modes.ppi

@@ -43,7 +43,10 @@ const
 
 {
   $Log$
-  Revision 1.4  1998-11-19 15:09:39  pierre
+  Revision 1.1  1998-12-21 13:07:04  peter
+    * use -FE
+
+  Revision 1.4  1998/11/19 15:09:39  pierre
     * several bugfixes for sector/ellipse/floodfill
     + graphic driver mode const in interface G800x600x256...
     + added backput mode as in linux graph.pp
@@ -68,7 +71,7 @@ const
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/modes.ppi
   description:
   ----------------------------

rtl/dos/ppi/move.ppi → rtl/go32v2/ppi/move.ppi

@@ -14,7 +14,7 @@
 
 procedure MoveLong(selector:word;dst:pointer;cnt:longint);
 begin
-  asm 
+  asm
     movw    %fs,%dx
     movw    selector,%ax
     movw    %ax,%fs
@@ -256,8 +256,11 @@ end;
 
 {
   $Log$
-  Revision 1.1  1998-03-25 11:18:42  root
-  Initial revision
+  Revision 1.1  1998-12-21 13:07:04  peter
+    * use -FE
+
+  Revision 1.1.1.1  1998/03/25 11:18:42  root
+  * Restored version
 
   Revision 1.4  1998/03/03 22:48:43  florian
     + graph.drawpoly procedure
@@ -267,7 +270,7 @@ end;
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/move.ppi
   description:
   ----------------------------

rtl/dos/ppi/palette.ppi → rtl/go32v2/ppi/palette.ppi

@@ -18,7 +18,7 @@
 { funktionieren auch im TextModus }
 
 procedure SetAllPalette(var Palette:PaletteType);
-begin     
+begin
   asm
     movl  Palette,%esi
     movl  $767,%ecx
@@ -36,14 +36,14 @@ sp_loop:
     jnz   sp_loop
   end;
 end;
-        
+
 procedure SetRGBPalette(ColorNum,RedValue,GreenValue,BlueValue:byte);
-begin 
+begin
   asm
     movw  $0x3c8,%DX
     movb  ColorNum,%al
     outb  %AL,%DX
-    incw  %DX        
+    incw  %DX
     movb  RedValue,%al
     shrb  $2,%al
     outb  %AL,%DX
@@ -55,14 +55,14 @@ begin
     outb  %AL,%DX
   end;
 end;
-    
+
 procedure GetRGBPalette(ColorNum:byte; var RedValue,GreenValue,BlueValue:byte);
-begin 
+begin
   asm
     movw  $0x3c7,%DX
     movb  ColorNum,%ax
     outb  %AL,%DX
-    addw  $2,%DX         
+    addw  $2,%DX
     xorl  %eax,%eax
     inb   %DX,%AL
     shlb  $2,%al
@@ -110,7 +110,10 @@ procedure SetPalette(ColorNum:word;Color:byte);
 
 {
   $Log$
-  Revision 1.4  1998-11-19 09:48:51  pierre
+  Revision 1.1  1998-12-21 13:07:04  peter
+    * use -FE
+
+  Revision 1.4  1998/11/19 09:48:51  pierre
     + added some functions missing like sector ellipse getarccoords
       (the filling of sector and ellipse is still buggy
        I use floodfill but sometimes the starting point
@@ -138,7 +141,7 @@ procedure SetPalette(ColorNum:word;Color:byte);
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/palette.ppi
   description:
   ----------------------------

rtl/dos/ppi/pixel.ppi → rtl/go32v2/ppi/pixel.ppi

@@ -43,14 +43,14 @@ if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
       cmpw   6(%edx),%ax
       jg     p_exit                        // wenn y > y2 Ende
       movl   _Y_ARRAY(,%eax,4),%eax
-      addl   _X_ARRAY(,%ebx,4),%eax     
+      addl   _X_ARRAY(,%ebx,4),%eax
       movl   %eax,%esi
       movzbl _WINSHIFT,%ecx                // { offset / winsize        }
-      shrl   %cl,%eax                      // 
+      shrl   %cl,%eax                      //
       cmpl   _A_BANK,%eax                 // { same bank ?             }
-      je     p_dont_switch                 // { yep                     } 
+      je     p_dont_switch                 // { yep                     }
       pushl  %esi
-      pushl  %eax                          // 
+      pushl  %eax                          //
       movl   _BANKSWITCHPTR,%eax           // { switchbank              }
       call   %eax                          //
       popl   %esi
@@ -90,7 +90,7 @@ if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
       (* movw   %dx,%ds use %gs now
       does not need to be kept constant PM *)
   p_exit:
-  end; 
+  end;
 end; { proc }
 
 procedure putpixel(x,y:integer;colour:longint);
@@ -102,17 +102,17 @@ end;
 procedure pixel(offset:longint);
  { wird nur intern aufgerufen, umrechnung auf Viewport und Range- }
  { checking muessen von aufrufender Routine bereits erledigt sein }
- { Bankswitching wird durchgefuehrt }  
+ { Bankswitching wird durchgefuehrt }
  begin
    asm
-      movl   offset,%eax             
+      movl   offset,%eax
       movl   %eax,%esi
       movzbl _WINSHIFT,%ecx                // { offset / winsize        }
-      shrl   %cl,%eax                      // 
+      shrl   %cl,%eax                      //
       cmpl   _A_BANK,%eax                 // { same bank ?             }
-      je     dont_switch                   // { yep                     } 
+      je     dont_switch                   // { yep                     }
       pushl  %esi
-      pushl  %eax                          // 
+      pushl  %eax                          //
       movl   _BANKSWITCHPTR,%eax           // { switchbank              }
       call   %eax                          //
       popl   %esi
@@ -154,7 +154,7 @@ procedure pixel(offset:longint);
  dxor16BPP:
       xorw   %ax,%gs:(%esi)
       jmp    pd_exit
- dmove:      
+ dmove:
       cmpl   $2,%ebx
       je    dmove16BPP
       jb    dmove8BPP
@@ -181,7 +181,7 @@ procedure pixel(offset:longint);
  dmove16BPP:
       movw   %ax,%gs:(%esi)
  pd_exit:
-   end; 
+   end;
 end; { proc }
 
 function getpixeli(x,y:integer):longint;
@@ -214,14 +214,14 @@ if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
       cmpw   6(%edx),%ax
       jg     gp_eexit                        // wenn y > y2 Ende
       movl   _Y_ARRAY(,%eax,4),%eax
-      addl   _X_ARRAY(,%ebx,4),%eax     
+      addl   _X_ARRAY(,%ebx,4),%eax
       movl   %eax,%esi
       movzbl _WINSHIFT,%ecx                // { offset / winsize        }
-      shrl   %cl,%eax                      // 
+      shrl   %cl,%eax                      //
       cmpl   _A_BANK,%eax                  // { same bank ?             }
       je     g_dont_switch                 // { yep                     }
-      pushl  %esi                          // { save Offset             }       
-      pushl  %eax                          // 
+      pushl  %esi                          // { save Offset             }
+      pushl  %eax                          //
       movl   _BANKSWITCHPTR,%eax           // { switchbank              }
       call   %eax                          //
       popl   %esi                          // { restore Offset          }
@@ -230,7 +230,7 @@ if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
       andl   %eax,%esi
       xorl   %eax,%eax
       movzwl _BYTESPERPIXEL,%edx
-      addl   _WBUFFER,%esi   
+      addl   _WBUFFER,%esi
       movw   _SEG_READ,%bx
       movw   %bx,%gs
       cmpl   $2,%edx                       // { 1 or 2 BytesPerPixel ? }
@@ -266,13 +266,13 @@ if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
   g_16BPP:
       movzwl %gs:(%esi),%eax
       jmp    g_Result
-  g_8BPP:    
+  g_8BPP:
       movzbl %gs:(%esi),%eax
       jmp    g_Result
   gp_eexit:
       xorl   %eax,%eax
       jmp    gp_exit
-  g_Result:    
+  g_Result:
   gp_exit:
       movl   %eax,col
   end;
@@ -287,7 +287,10 @@ end; { proc }
 
 {
   $Log$
-  Revision 1.5  1998-11-20 18:42:09  pierre
+  Revision 1.1  1998-12-21 13:07:04  peter
+    * use -FE
+
+  Revision 1.5  1998/11/20 18:42:09  pierre
     * many bugs related to floodfill and ellipse fixed
 
   Revision 1.4  1998/11/18 13:23:36  pierre
@@ -316,7 +319,7 @@ end; { proc }
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/pixel.ppi
   description:
   ----------------------------

rtl/dos/ppi/stdcolor.ppi → rtl/go32v2/ppi/stdcolor.ppi

@@ -81,7 +81,10 @@ $FC000000,$FD000000,$FE000000,$FF000000
 
 {
   $Log$
-  Revision 1.2  1998-11-18 09:31:41  pierre
+  Revision 1.1  1998-12-21 13:07:04  peter
+    * use -FE
+
+  Revision 1.2  1998/11/18 09:31:41  pierre
     * changed color scheme
       all colors are in RGB format if more than 256 colors
     + added 24 and 32 bits per pixel mode
@@ -97,7 +100,7 @@ $FC000000,$FD000000,$FE000000,$FF000000
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/stdcolor.ppi
   description:
   ----------------------------

rtl/dos/ppi/text.ppi → rtl/go32v2/ppi/text.ppi

@@ -23,7 +23,7 @@
        maxfonts = 16;
        fontdivs:array[0..maxfonts]of integer=
        (1,4,3,4,4,4,4,4,4,3,3,1,1,1,1,1,1);
-    
+
     type
        pbyte = ^byte;
 
@@ -57,7 +57,7 @@
        fonts : array[1..maxfonts] of tfontrec;
        installedfonts : longint;
 
-{$I FONT.PPI}              
+{$I FONT.PPI}
 
     { gibt true zur�ck, wenn p auf eine g�ltige Fontdatei zeigt }
 
@@ -191,10 +191,10 @@
          { Grafikcursor nachf�hren }
          { if (akttextinfo.direction=HorizDir) and
            (akttextinfo.horiz=LeftText) then }
-               inc(x,textwidth(s));  
+               inc(x,textwidth(s));
          curx:=x; cury:=y;   { LineTo manipuliert den GrafikCursor !! }
     end;
-   
+
     procedure OutTextXY(x,y : integer;const TextString : string);
 
       var
@@ -203,7 +203,7 @@
          i,j,jj,k,l    : longint;
          oldvalues     : linesettingstype;
          nextpos       : word;
-         xpos,ypos,offs: longint;        
+         xpos,ypos,offs: longint;
          FontPtr       : Pointer;
       begin
          _graphresult:=grOk;
@@ -212,10 +212,10 @@
               _graphresult:=grnoinitgraph;
               exit;
            end;
- 
+
          { wirkliche x- und y-Startposition berechnen }
          if akttextinfo.direction=horizdir then
-         begin   
+         begin
            case akttextinfo.horiz of
                 centertext : XPos:=(textwidth(textstring) shr 1);
                 lefttext   : XPos:=0;
@@ -226,8 +226,8 @@
                bottomtext : YPos:=0;
                toptext    : YPos:=textheight(textstring);
            end;
-         end else  
-         begin   
+         end else
+         begin
            case akttextinfo.horiz of
                 centertext : XPos:=(textheight(textstring) shr 1);
                 lefttext   : XPos:=0;
@@ -237,12 +237,12 @@
                centertext : YPos:=(textwidth(textstring) shr 1);
                bottomtext : YPos:=0;
                toptext    : YPos:=textwidth(textstring);
-           end;     
-         end;         
+           end;
+         end;
          X:=X-XPos;
          Y:=Y+YPos;
          XPos:=X; YPos:=Y;
-         
+
          if akttextinfo.font=DefaultFont then begin
            if akttextinfo.direction=horizdir then
              ypos:=ypos-6*akttextinfo.charsize
@@ -281,9 +281,9 @@
                    mask:=mask shr 1;
                end;
              end;
-           end;        
+           end;
          end else
-           
+
            begin
               { Linienstil setzen }
               getlinesettings(oldvalues);
@@ -313,12 +313,12 @@
                          if akttextinfo.direction=VertDir then
                            begin
                              xpos:=x-((b2*aktmultx) div aktdivx);
-                             ypos:=y-((b1*aktmulty) div aktdivy); 
+                             ypos:=y-((b1*aktmulty) div aktdivy);
                            end
                          else
                            begin
                              xpos:=x+((b1*aktmultx) div aktdivx) ;
-                             ypos:=y-((b2*aktmulty) div aktdivy) ; 
+                             ypos:=y-((b2*aktmulty) div aktdivy) ;
                            end;
                          case instr of
                             0 : break;
@@ -329,10 +329,10 @@
                          end;
                      end;
                    if akttextinfo.direction=VertDir then
-                     y:=y-(fonts[akttextinfo.font].widths[c]*aktmultx div aktdivx)              
+                     y:=y-(fonts[akttextinfo.font].widths[c]*aktmultx div aktdivx)
                    else
-                     x:=x+(fonts[akttextinfo.font].widths[c]*aktmultx div aktdivx) ; 
-                end;  
+                     x:=x+(fonts[akttextinfo.font].widths[c]*aktmultx div aktdivx) ;
+                end;
               setlinestyle( oldvalues.linestyle, oldvalues.pattern, oldvalues.thickness);
            end;
       end;
@@ -343,7 +343,7 @@
       s:=charakter;
       outtextXY(x,y,s);
     end;
-   
+
     function TextHeight(const TextString : string) : word;
 
       begin
@@ -353,7 +353,7 @@
               _graphresult:=grnoinitgraph;
               exit;
            end;
-         if akttextinfo.font=DefaultFont 
+         if akttextinfo.font=DefaultFont
             then TextHeight:=6+akttextinfo.charsize
             else
               TextHeight:=(((fonts[akttextinfo.font].header^.dist_origin_top-
@@ -379,7 +379,7 @@
                    { definiertes Zeichen ? }
                    if (c<0) or (c>=fonts[akttextinfo.font].header^.nr_chars) then
                      continue;
-                   x:=x+fonts[akttextinfo.font].widths[c];                  
+                   x:=x+fonts[akttextinfo.font].widths[c];
                end;
             TextWidth:=((x * aktmultx) div aktdivx) ;
             end;
@@ -427,7 +427,7 @@
            direction:=HorizDir;
          akttextinfo.direction:=direction;
          akttextinfo.charsize:=charsize;
-         if (charsize <> usercharsize) then begin        
+         if (charsize <> usercharsize) then begin
             aktmultx:=charsize;
             aktdivx:=fontdivs[font];
             aktmulty:=charsize;
@@ -480,10 +480,13 @@
          aktdivy:=Divy;
       end;
 
- 
+
 {
   $Log$
-  Revision 1.3  1998-11-23 10:04:19  pierre
+  Revision 1.1  1998-12-21 13:07:05  peter
+    * use -FE
+
+  Revision 1.3  1998/11/23 10:04:19  pierre
     * pieslice and sector work now !!
     * bugs in text writing removed
     + scaling for defaultfont added
@@ -506,7 +509,7 @@
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/text.ppi
   description:
   ----------------------------

rtl/dos/ppi/triangle.ppi → rtl/go32v2/ppi/triangle.ppi

@@ -56,14 +56,17 @@ begin
 end;
 {
   $Log$
-  Revision 1.1  1998-03-25 11:18:42  root
-  Initial revision
+  Revision 1.1  1998-12-21 13:07:05  peter
+    * use -FE
+
+  Revision 1.1.1.1  1998/03/25 11:18:42  root
+  * Restored version
 
   Revision 1.3  1998/01/26 11:58:45  michael
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/triangle.ppi
   description:
   ----------------------------

rtl/dos/ppi/vesadeb.ppi → rtl/go32v2/ppi/vesadeb.ppi

@@ -25,10 +25,10 @@
     write('optional Informations : ');
       if (VESAInfo.ModeAttributes and 2)=0 then write('not '); writeln('available');
     write('BIOS Output           : ');
-      if (VESAInfo.ModeAttributes and 4)=0 then write('not '); writeln('supported');     
+      if (VESAInfo.ModeAttributes and 4)=0 then write('not '); writeln('supported');
     write('Mode                  : ');
-      if (VESAInfo.ModeAttributes and 8)<>0 then write('colour, ') else write('monochrom, ');     
-      if (VESAInfo.ModeAttributes and $10)<>0 then writeln('graphic') else writeln('text');     
+      if (VESAInfo.ModeAttributes and 8)<>0 then write('colour, ') else write('monochrom, ');
+      if (VESAInfo.ModeAttributes and $10)<>0 then writeln('graphic') else writeln('text');
     if VGAInfo.VESAhiVersion=2 then begin
       write('Mode VGA-compatible   : ');
       if (VESAInfo.ModeAttributes and $20)<>0 then writeln('no') else writeln('yes');
@@ -40,7 +40,7 @@
              Writeln('PhysBaseAddress at : 0x',HexStr(VESAInfo.PhysAddress,8));
              Writeln('LinearBase at      : 0x',Hexstr(Get_linear_addr(VESAInfo.PhysAddress,VGAInfo.TotalMem shl 16),8));
              Writeln('OffscreenOffset    : 0x',HexStr(VESAInfo.OffScreenPtr,8));
-             Writeln('OffscreenMem       : ',VESAInfo.OffScreenMem,'KB');           
+             Writeln('OffscreenMem       : ',VESAInfo.OffScreenMem,'KB');
        end;
       if (VESAInfo.ModeAttributes and $200)<>0 then
          write('(VBE/AF v1.0P) application must call EnableDirectAccess '+
@@ -73,10 +73,13 @@
 {$ifndef FPC_PROFILE}
     readln;
 {$endif not FPC_PROFILE}
- 
+
 {
   $Log$
-  Revision 1.4  1998-11-25 13:04:47  pierre
+  Revision 1.1  1998-12-21 13:07:05  peter
+    * use -FE
+
+  Revision 1.4  1998/11/25 13:04:47  pierre
     + added multi page support
 
   Revision 1.3  1998/11/18 13:23:37  pierre
@@ -102,7 +105,7 @@
   + Added log at the end
 
 
-  
+
   Working file: rtl/dos/ppi/vesadeb.ppi
   description:
   ----------------------------

rtl/go32v2/printer.pp

@@ -0,0 +1,51 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1993,98 by Florian Klaempfl
+    member of the Free Pascal development team
+
+    Printer unit for BP7 compatible RTL
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit printer;
+interface
+
+var
+  lst : text;
+
+implementation
+
+var
+  old_exit : pointer;
+
+procedure printer_exit;
+begin
+  close(lst);
+  exitproc:=old_exit;
+end;
+
+
+begin
+  assign(lst,'PRN');
+  rewrite(lst);
+  old_exit:=exitproc;
+  exitproc:=@printer_exit;
+end.
+{
+  $Log$
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.2  1998/05/22 00:39:26  peter
+    * go32v1, go32v2 recompiles with the new objects
+    * remake3 works again with go32v2
+    - removed some "optimizes" from daniel which were wrong
+
+}

rtl/dos/go32v2/profile.pp → rtl/go32v2/profile.pp

@@ -355,7 +355,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  1998-11-18 09:22:10  pierre
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.4  1998/11/18 09:22:10  pierre
     + added $error if compiled with -pg
     + all output to stderr
 

rtl/go32v2/sbrk16.ah

@@ -0,0 +1,7 @@
+       .byte   0x12,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x70,0x02,0x00,0x00,0x00,0x00,0x00,0x00
+        .byte   0x00,0x00,0x8c,0xd8,0x2e,0x8e,0x1e,0x06,0x00,0xa3,0x10,0x00,0x8c,0x16,0x0a,0x00
+        .byte   0x66,0x89,0x26,0x0c,0x00,0x8e,0x16,0x06,0x00,0x66,0xbc,0x70,0x02,0x00,0x00,0xb8
+        .byte   0x03,0x05,0xcd,0x31,0x72,0x24,0x89,0xca,0x89,0xd9,0x8b,0x1e,0x02,0x00,0xb8,0x07
+        .byte   0x00,0xcd,0x31,0x8b,0x1e,0x04,0x00,0xb8,0x07,0x00,0xcd,0x31,0x06,0x07,0x0f,0xa0
+        .byte   0x0f,0xa1,0x0f,0xa8,0x0f,0xa9,0x89,0xcb,0x89,0xd1,0x8e,0x16,0x0a,0x00,0x66,0x8b
+        .byte   0x26,0x0c,0x00,0x8e,0x1e,0x10,0x00,0x66,0xcb,0x90,0x90,0x90

rtl/go32v2/sbrk16.asm

@@ -0,0 +1,116 @@
+; Copyright (C) 1994 DJ Delorie, see COPYING.DJ for details
+;
+; $Id$
+; $Log$
+; Revision 1.1  1998-12-21 13:07:03  peter
+;   * use -FE
+;
+; Revision 1.1.1.1  1998/03/25 11:18:42  root
+; * Restored version
+;
+; Revision 1.2  1997/11/27 16:28:13  michael
+; Change submitted by Pierre Muller.
+;
+; Revision 2.0  1994/03/14  00:47:04  dj
+; initial version
+;
+;
+
+;-----------------------------------------------------------------------------
+;  sbrk 16-bit helper
+;
+;  Transferred to 16-bit code segement to run in protected mode.
+;  Will make DPMI segment altering requests and update selectors
+;  as needed.  Image will always need to allocate an exact
+;  multiple of 16 bytes, load offset will always be zero.
+;  Number of bytes to copy will always be multiple of four.
+;
+;  Application must set cs_selector, ds_selector, and local_ds
+;  appropriately.  Application uses first word in image to find
+;  API entry point.  Call with FAR call.
+;
+;  Call with:   BX:CX = new size
+;               SI:DI = old handle
+;  Returns:     BX:CX = new base
+;               SI:DI = new handle
+;               all others trashed
+
+        .type   "bin"
+
+;-----------------------------------------------------------------------------
+;  Start of API header
+
+offset_of_api:                  ; offset of API function entry point
+        .dw     sbrk_16_helper
+cs_selector:                    ; code selector to be updated
+        .dw     0
+ds_selector:                    ; data selector to be updated
+        .dw     0
+local_ds:                       ; selector mapped to same as local cs
+        .dw     0
+bytes_to_allocate:              ; number of bytes app allocates for this image
+        .dw     stack
+
+;-----------------------------------------------------------------------------
+;  Start of local data
+
+save_ss:
+        .dw     0
+save_esp:
+        .dd     0
+save_ds:
+        .dw     0
+
+;-----------------------------------------------------------------------------
+;  Start of code
+
+sbrk_16_helper:
+
+        mov     ax, ds                  ; switch to local data segment
+        mov     ds, cs:[local_ds]
+        mov     [save_ds], ax
+        mov     [save_ss], ss           ; switch to local stack
+        mov     [save_esp], esp
+        mov     ss, [local_ds]
+        mov     esp, stack
+
+        mov     ax, 0x0503              ; realloc memory
+        int     0x31
+        jc      error_return            ; bx:cx = base address
+
+        mov     dx, cx
+        mov     cx, bx                  ; cx:dx = base address
+        mov     bx, [cs_selector]
+        mov     ax, 0x0007
+        int     0x31                    ; set cs to new base
+        mov     bx, [ds_selector]
+        mov     ax, 0x0007
+        int     0x31                    ; set ds to new base
+
+        push    es                      ; reload es
+        pop     es
+        push    fs                      ; reload fs
+        pop     fs
+        push    gs                      ; reload gs
+        pop     gs
+
+        mov     bx, cx
+        mov     cx, dx                  ; bx:cx = base address
+
+error_return:
+
+        mov     ss, [save_ss]           ; return to old stack
+        mov     esp, [save_esp]
+        mov     ds, [save_ds]           ; return to old data segment
+
+        .opsize                         ; 32-bit far return
+        retf
+
+;-----------------------------------------------------------------------------
+;  Start of stack
+
+        .align  4                       ; so that image size is longwords
+        .bss
+        .align  16                      ; so that alloc size is paragraphs
+        .db     512 .dup 0
+stack:

rtl/dos/go32v2/system.pp → rtl/go32v2/system.pp

@@ -1227,7 +1227,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.25  1998-12-15 22:42:52  peter
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.25  1998/12/15 22:42:52  peter
     * removed temp symbols
 
   Revision 1.24  1998/11/29 22:28:10  peter

rtl/dos/go32v2/v2prt0.as → rtl/go32v2/v2prt0.as

@@ -848,7 +848,10 @@ __dos_ds:
 
 /*
   $Log$
-  Revision 1.4  1998-10-14 21:28:45  peter
+  Revision 1.1  1998-12-21 13:07:03  peter
+    * use -FE
+
+  Revision 1.4  1998/10/14 21:28:45  peter
     * initialize fpu so sigfpe is finally generated for fpu errors
 
   Revision 1.3  1998/08/19 10:56:35  pierre

rtl/linux/Makefile

@@ -110,6 +110,9 @@ INC=$(RTL)/inc
 PROCINC=$(RTL)/$(CPU)
 OBJPASDIR=$(RTL)/objpas
 
+# Where to place the resuts
+TARGETDIR=.
+
 # Get some defaults for Programs and OSes.
 # This will set the following variables :
 # inlinux indos COPY REPLACE DEL INSTALL INSTALLEXE MKDIR
@@ -140,8 +143,10 @@ SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
 # Define Linux Units
 SYSTEMPPU=syslinux$(PPUEXT)
 OBJECTS=strings linux \
-	dos crt objects printer \
-	getopts heaptrc errors sockets ports graph objpas sysutils
+	dos crt objects printer ports \
+	objpas sysutils typinfo \
+	cpu mmx getopts heaptrc ports \
+	errors sockets graph
 
 # Which units may be placed in the shared lib file
 SHAREDLIBFILES=syslinux strings linux objpas sysutils math \
@@ -198,7 +203,7 @@ install : all
 clean :
 	-$(DEL) *$(OEXT) *$(ASMEXT) *$(PPUEXT) $(PPAS) link.res log
 	-$(DELTREE) *$(SMARTEXT)
-	make -C $(OBJPASDIR) clean
+
 
 #####################################################################
 # Files
@@ -228,9 +233,7 @@ $(SYSTEMPPU) : syslinux.pp $(SYSLINUXDEPS) $(SYSDEPS)
 	$(COMPILER) -Us -Sg syslinux.pp $(REDIR)
 
 strings$(PPUEXT) : $(PROCINC)/strings.pp $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/strings.pp .
-	$(COMPILER) strings $(REDIR)
-	$(DEL) strings.pp
+	$(COMPILER) $(PROCINC)/strings.pp $(REDIR)
 
 linux$(PPUEXT) : linux.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
 		 syscalls.inc systypes.inc sysconst.inc $(SYSTEMPPU)
@@ -240,17 +243,7 @@ linux$(PPUEXT) : linux.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc
 # Delphi Object Model
 #
 
-objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp $(INC)/except.inc
-	$(COPY) $(OBJPASDIR)/objpas.pp .
-	$(COMPILER) -S2 -I$(OBJPASDIR) objpas $(REDIR)
-	$(DEL) objpas.pp
-
-SYSUTILINC = $(wildcard $(OBJPASDIR)/*.inc)
-
-sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(SYSUTILINC) filutil.inc disk.inc
-	$(COPY) $(OBJPASDIR)/sysutils.pp .
-	$(COMPILER) -S2 -I$(OBJPASDIR) sysutils $(REDIR)
-	$(DEL) sysutils.pp
+include $(OBJPASDIR)/makefile.op
 
 #
 # System Dependent Units
@@ -268,38 +261,38 @@ errors$(PPUEXT) : errors.pp strings$(PPUEXT) $(SYSTEMPPU)
 #
 
 dos$(PPUEXT) : $(DOSDEPS) $(SYSTEMPPU)
-	$(COMPILER) dos $(REDIR)
+	$(COMPILER) dos.pp $(REDIR)
 
 crt$(PPUEXT) : crt.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMPPU)
-	$(COMPILER) crt $(REDIR)
+	$(COMPILER) crt.pp $(REDIR)
 
 objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
-	$(COPY) $(INC)/objects.pp .
-	$(COMPILER) objects $(REDIR)
-	$(DEL) objects.pp
+	$(COMPILER) $(INC)/objects.pp $(REDIR)
 
 printer$(PPUEXT) : printer.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMPPU)
-	$(COMPILER) printer $(REDIR)
+	$(COMPILER) printer.pp $(REDIR)
 
 graph$(PPUEXT) : graph.pp linux$(PPUEXT) objects$(PPUEXT)
-	$(COMPILER) graph $(REDIR)
+	$(COMPILER) graph.pp $(REDIR)
 
 ports$(PPUEXT) : ports.pp linux$(PPUEXT) objpas$(PPUEXT)
-	$(COMPILER) ports $(REDIR)
+	$(COMPILER) ports.pp $(REDIR)
 
 #
 # Other RTL Units
 #
 
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
+	$(COMPILER) $(PROCINC)/cpu.pp $(REDIR)
+
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
+	$(COMPILER) $(PROCINC)/mmx.pp $(REDIR)
+
 getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
-	$(COPY) $(INC)/getopts.pp .
-	$(COMPILER) getopts $(REDIR)
-	$(DEL) getopts.pp
+	$(COMPILER) $(INC)/getopts.pp $(REDIR)
 
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
-	$(COPY) $(INC)/heaptrc.pp .
-	$(COMPILER) heaptrc $(REDIR)
-	$(DEL) heaptrc.pp
+	$(COMPILER) $(INC)/heaptrc $(REDIR)
 
 
 #####################################################################
@@ -343,7 +336,10 @@ include $(CFG)/makefile.def
 
 #
 # $Log$
-# Revision 1.11  1998-12-11 00:10:50  peter
+# Revision 1.12  1998-12-21 13:07:05  peter
+#   * use -FE
+#
+# Revision 1.11  1998/12/11 00:10:50  peter
 #   * use $mode directive
 #
 # Revision 1.10  1998/12/07 16:38:48  michael

rtl/objpas/math.pp

@@ -664,7 +664,10 @@ end;
 
 {
     $Log$
-    Revision 1.6  1998-11-02 12:52:46  michael
+    Revision 1.7  1998-12-21 13:07:06  peter
+      * use -FE
+
+    Revision 1.6  1998/11/02 12:52:46  michael
     Minimum/maximum functions
 
     Revision 1.5  1998/09/24 23:45:26  peter
@@ -678,4 +681,4 @@ end;
 
     Revision 1.2  1998/07/29 15:44:34  michael
      included sysutils and math.pp as target. They compile now.
-}
+}

rtl/win32/Makefile

@@ -58,6 +58,9 @@ INC=$(RTL)/inc
 PROCINC=$(RTL)/$(CPU)
 OBJPASDIR=$(RTL)/objpas
 
+# Where are the results placed
+TARGETDIR=.
+
 
 #####################################################################
 # Include default makefile
@@ -73,9 +76,10 @@ include $(CFG)/makefile.cfg
 # Define Win32 Units
 SYSTEMPPU=syswin32$(PPUEXT)
 LOADERS=wprt0 wdllprt0
-OBJECTS=strings dos \
-	windows objects \
-	cpu mmx getopts heaptrc objpas sysutils
+OBJECTS=strings windows \
+	dos objects \
+	objpas sysutils typinfo \
+	cpu mmx getopts heaptrc
 
 # Files used by windows.pp
 WINDOWS_FILES=base errors defines \
@@ -152,25 +156,13 @@ $(SYSTEMPPU) : syswin32.pp win32.inc $(SYSDEPS)
 	$(COMPILER) -Us -Sg syswin32.pp $(REDIR)
 
 strings$(PPUEXT) : $(PROCINC)/strings.pp $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/strings.pp .
-	$(COMPILER) strings $(REDIR)
-	$(DEL) strings.pp
+	$(COMPILER) $(PROCINC)/strings.pp $(REDIR)
 
 #
 # Delphi Object Model
 #
 
-objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp $(INC)/except.inc
-	$(COPY) $(OBJPASDIR)/objpas.pp .
-	$(COMPILER) -S2 -I$(OBJPASDIR) objpas $(REDIR)
-	$(DEL) objpas.pp
-
-SYSUTILINC = $(wildcard $(OBJPASDIR)/*.inc)
-
-sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(SYSUTILINC) filutil.inc disk.inc
-	$(COPY) $(OBJPASDIR)/sysutils.pp .
-	$(COMPILER) -S2 -I$(OBJPASDIR) sysutils $(REDIR)
-	$(DEL) sysutils.pp
+include $(OBJPASDIR)/makefile.op
 
 
 #
@@ -194,36 +186,26 @@ windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMPPU)
 #
 
 dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc $(SYSTEMPPU)
-	$(COMPILER) dos $(REDIR)
+	$(COMPILER) dos.pp $(REDIR)
 
 objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
-	 $(COPY) $(INC)/objects.pp .
-	 $(COMPILER) objects $(REDIR)
-	 $(DEL) objects.pp
+	 $(COMPILER) $(INC)/objects.pp $(REDIR)
 
 #
 # Other RTL Units
 #
 
 cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/cpu.pp .
-	$(COMPILER) cpu.pp $(REDIR)
-	$(DEL) cpu.pp
+	$(COMPILER) $(PROCINC)/cpu.pp $(REDIR)
 
 mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
-	$(COPY) $(PROCINC)/mmx.pp .
-	$(COMPILER) mmx.pp $(REDIR)
-	$(DEL) mmx.pp
+	$(COMPILER) $(PROCINC)/mmx.pp $(REDIR)
 
 getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
-	$(COPY) $(INC)/getopts.pp .
-	$(COMPILER) getopts.pp $(REDIR)
-	$(DEL) getopts.pp
+	$(COMPILER) $(INC)/getopts.pp $(REDIR)
 
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
-	$(COPY) $(INC)/heaptrc.pp .
-	$(COMPILER) heaptrc $(REDIR)
-	$(DEL) heaptrc.pp
+	$(COMPILER) $(INC)/heaptrc $(REDIR)
 
 
 #####################################################################
@@ -397,7 +379,10 @@ include $(CFG)/makefile.def
 
 #
 # $Log$
-# Revision 1.14  1998-11-30 13:13:40  pierre
+# Revision 1.15  1998-12-21 13:07:07  peter
+#   * use -FE
+#
+# Revision 1.14  1998/11/30 13:13:40  pierre
 #  * needs asw to link correctly wprt0 or wdllprt0 file
 #
 # Revision 1.13  1998/11/30 09:16:57  pierre