{ This file is part of the Free Pascal run time library. Copyright (c) 2001 by Free Pascal development team This file implements all the base types and limits required for a minimal POSIX compliant subset required to port the compiler to a new OS. 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. **********************************************************************} const carryflag = 1; type tseginfo=packed record offset : pointer; segment : word; end; var old_int00 : tseginfo;cvar; old_int75 : tseginfo;cvar; {$asmmode ATT} {***************************************************************************** Go32 Helpers *****************************************************************************} function far_strlen(selector : word;linear_address : longint) : longint;assembler; asm movl linear_address,%edx movl %edx,%ecx pushl %gs movw selector,%gs .Larg19: movb %gs:(%edx),%al testb %al,%al je .Larg20 incl %edx jmp .Larg19 .Larg20: popl %gs movl %edx,%eax subl %ecx,%eax end; function tb : longint; begin tb:=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; function dos_selector : word; begin dos_selector:=go32_info_block.selector_for_linear_memory; end; function get_ds : word;assembler; asm movw %ds,%ax end; function get_cs : word;assembler; asm movw %cs,%ax end; procedure sysseg_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 pushl %esi pushl %edi 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 popl %edi popl %esi end else if (source tb_size then HandleError(217); sysseg_move(get_ds,addr,dos_selector,tb,len); end; procedure syscopyfromdos(addr : longint; len : longint); begin if len > tb_size then HandleError(217); sysseg_move(dos_selector,tb,get_ds,addr,len); end; procedure sysrealintr(intnr : word;var regs : trealregs); begin regs.realsp:=0; regs.realss:=0; regs.realres:=0; { spec says so, play it safe } asm pushl %ebx pushl %edi pushl %fs // Go32.RealIntr does it too (NTVDM bug), // "pushl" to avoid size prefix movw intnr,%bx xorl %ecx,%ecx movl regs,%edi movw $0x300,%ax int $0x31 popl %fs popl %edi popl %ebx end; end; procedure set_pm_interrupt(vector : byte;const intaddr : tseginfo); begin asm pushl %ebx movl intaddr,%eax movl (%eax),%edx movw 4(%eax),%cx movl $0x205,%eax movb vector,%bl int $0x31 popl %ebx end; end; procedure get_pm_interrupt(vector : byte;var intaddr : tseginfo); begin asm pushl %ebx movb vector,%bl movl $0x204,%eax int $0x31 movl intaddr,%eax movl %edx,(%eax) movw %cx,4(%eax) popl %ebx end; end; procedure getinoutres(def : word); var regs : trealregs; begin regs.realeax:=$5900; regs.realebx:=$0; sysrealintr($21,regs); InOutRes:=lo(regs.realeax); case InOutRes of 19 : InOutRes:=150; 21 : InOutRes:=152; 32 : InOutRes:=5; end; if InOutRes=0 then InOutRes:=Def; end;