1{ 2 3} 4// this is generally go32 unit from go32v2 target. 5// maybe these units should be merged into one ( uses dpmi ? ) 6 7// not yet finished 8 9unit watcom; 10 11{$S-,R-,I-,Q-} {no stack check, used by DPMIEXCP !! } 12 13interface 14 15 const 16 { contants for the run modes returned by get_run_mode } 17 rm_unknown = 0; 18 rm_raw = 1; { raw (without HIMEM) } 19 rm_xms = 2; { XMS (for example with HIMEM, without EMM386) } 20 rm_vcpi = 3; { VCPI (for example HIMEM and EMM386) } 21 rm_dpmi = 4; { DPMI (for example DOS box or 386Max) } 22 23 { flags } 24 carryflag = $001; 25 parityflag = $004; 26 auxcarryflag = $010; 27 zeroflag = $040; 28 signflag = $080; 29 trapflag = $100; 30 interruptflag = $200; 31 directionflag = $400; 32 overflowflag = $800; 33 34 type 35 tmeminfo = record 36 available_memory, 37 available_pages, 38 available_lockable_pages, 39 linear_space, 40 unlocked_pages, 41 available_physical_pages, 42 total_physical_pages, 43 free_linear_space, 44 max_pages_in_paging_file, 45 reserved0, 46 reserved1, 47 reserved2 : longint; 48 end; 49 50 tseginfo = record 51 offset : pointer; 52 segment : word; 53 end; 54 55 trealregs = record 56 case integer of 57 1: { 32-bit } (EDI, ESI, EBP, Res, EBX, EDX, ECX, EAX: longint; 58 Flags, ES, DS, FS, GS, IP, CS, SP, SS: word); 59 2: { 16-bit } (DI, DI2, SI, SI2, BP, BP2, R1, R2: word; 60 BX, BX2, DX, DX2, CX, CX2, AX, AX2: word); 61 3: { 8-bit } (stuff: array[1..4] of longint; 62 BL, BH, BL2, BH2, DL, DH, DL2, DH2, 63 CL, CH, CL2, CH2, AL, AH, AL2, AH2: byte); 64 4: { Compat } (RealEDI, RealESI, RealEBP, RealRES, 65 RealEBX, RealEDX, RealECX, RealEAX: longint; 66 RealFlags, 67 RealES, RealDS, RealFS, RealGS, 68 RealIP, RealCS, RealSP, RealSS: word); 69 end; 70 71 registers = trealregs; 72 73 { this works only with real DPMI } 74 function allocate_ldt_descriptors(count : word) : word; 75 function free_ldt_descriptor(d : word) : boolean; 76 function segment_to_descriptor(seg : word) : word; 77 function get_next_selector_increment_value : word; 78 function get_segment_base_address(d : word) : longint; 79 function set_segment_base_address(d : word;s : longint) : boolean; 80 function set_segment_limit(d : word;s : longint) : boolean; 81 function set_descriptor_access_right(d : word;w : word) : longint; 82 function create_code_segment_alias_descriptor(seg : word) : word; 83 function get_linear_addr(phys_addr : longint;size : longint) : longint; 84 function get_segment_limit(d : word) : longint; 85 function get_descriptor_access_right(d : word) : longint; 86 function get_page_size:longint; 87 function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean; 88 function realintr(intnr : word;var regs : trealregs) : boolean; 89 90 { is needed for functions which need a real mode buffer } 91 function global_dos_alloc(bytes : longint) : longint; 92 function global_dos_free(selector : word) : boolean; 93 94 var 95 { selector for the DOS memory (only usable if in DPMI mode) } 96 dosmemselector : word; 97 { result of dpmi call } 98 int31error : word; 99 100 { this procedure copies data where the source and destination } 101 { are specified by 48 bit pointers } 102 { Note: the procedure checks only for overlapping if } 103 { source selector=destination selector } 104 procedure seg_move(sseg : word;source : longint;dseg : word;dest : longint;count : longint); 105 106 { fills a memory area specified by a 48 bit pointer with c } 107 procedure seg_fillchar(seg : word;ofs : longint;count : longint;c : char); 108 procedure seg_fillword(seg : word;ofs : longint;count : longint;w : word); 109 110 {************************************} 111 { this works with all PM interfaces: } 112 {************************************} 113 114 function get_meminfo(var meminfo : tmeminfo) : boolean; 115 function get_pm_interrupt(vector : byte;var intaddr : tseginfo) : boolean; 116 function set_pm_interrupt(vector : byte;const intaddr : tseginfo) : boolean; 117 function get_rm_interrupt(vector : byte;var intaddr : tseginfo) : boolean; 118 function set_rm_interrupt(vector : byte;const intaddr : tseginfo) : boolean; 119 function get_exception_handler(e : byte;var intaddr : tseginfo) : boolean; 120 function set_exception_handler(e : byte;const intaddr : tseginfo) : boolean; 121 function get_pm_exception_handler(e : byte;var intaddr : tseginfo) : boolean; 122 function set_pm_exception_handler(e : byte;const intaddr : tseginfo) : boolean; 123 function free_rm_callback(var intaddr : tseginfo) : boolean; 124 function get_rm_callback(pm_func : pointer;const reg : trealregs;var rmcb : tseginfo) : boolean; 125 function get_cs : word; 126 function get_ds : word; 127 function get_ss : word; 128 129 { locking functions } 130 function allocate_memory_block(size:longint):longint; 131 function free_memory_block(blockhandle : longint) : boolean; 132 function request_linear_region(linearaddr, size : longint; 133 var blockhandle : longint) : boolean; 134 function lock_linear_region(linearaddr, size : longint) : boolean; 135 function lock_data(var data;size : longint) : boolean; 136 function lock_code(functionaddr : pointer;size : longint) : boolean; 137 function unlock_linear_region(linearaddr, size : longint) : boolean; 138 function unlock_data(var data;size : longint) : boolean; 139 function unlock_code(functionaddr : pointer;size : longint) : boolean; 140 141 { disables and enables interrupts } 142 procedure disable; 143 procedure enable; 144 145 function inportb(port : word) : byte; 146 function inportw(port : word) : word; 147 function inportl(port : word) : longint; 148 149 procedure outportb(port : word;data : byte); 150 procedure outportw(port : word;data : word); 151 procedure outportl(port : word;data : longint); 152 function get_run_mode : word; 153 154 procedure copytodos(var addr; len : longint); 155 procedure copyfromdos(var addr; len : longint); 156 157 procedure dpmi_dosmemput(seg : word;ofs : word;var data;count : longint); 158 procedure dpmi_dosmemget(seg : word;ofs : word;var data;count : longint); 159 procedure dpmi_dosmemmove(sseg,sofs,dseg,dofs : word;count : longint); 160 procedure dpmi_dosmemfillchar(seg,ofs : word;count : longint;c : char); 161 procedure dpmi_dosmemfillword(seg,ofs : word;count : longint;w : word); 162 163 164 165 const 166 { this procedures are assigned to the procedure which are needed } 167 { for the current mode to access DOS memory } 168 { It's strongly recommended to use this procedures! } 169 dosmemput : procedure(seg : word;ofs : word;var data;count : longint)=@dpmi_dosmemput; 170 dosmemget : procedure(seg : word;ofs : word;var data;count : longint)=@dpmi_dosmemget; 171 dosmemmove : procedure(sseg,sofs,dseg,dofs : word;count : longint)=@dpmi_dosmemmove; 172 dosmemfillchar : procedure(seg,ofs : word;count : longint;c : char)=@dpmi_dosmemfillchar; 173 dosmemfillword : procedure(seg,ofs : word;count : longint;w : word)=@dpmi_dosmemfillword; 174 175 implementation 176 177{$asmmode ATT} 178 179 180 { the following procedures copy from and to DOS memory using DPMI } 181 procedure dpmi_dosmemput(seg : word;ofs : word;var data;count : longint); 182 183 begin 184 seg_move(get_ds,longint(@data),dosmemselector,seg*16+ofs,count); 185 end; 186 187 procedure dpmi_dosmemget(seg : word;ofs : word;var data;count : longint); 188 189 begin 190 seg_move(dosmemselector,seg*16+ofs,get_ds,longint(@data),count); 191 end; 192 193 procedure dpmi_dosmemmove(sseg,sofs,dseg,dofs : word;count : longint); 194 195 begin 196 seg_move(dosmemselector,sseg*16+sofs,dosmemselector,dseg*16+dofs,count); 197 end; 198 199 procedure dpmi_dosmemfillchar(seg,ofs : word;count : longint;c : char); 200 201 begin 202 seg_fillchar(dosmemselector,seg*16+ofs,count,c); 203 end; 204 205 procedure dpmi_dosmemfillword(seg,ofs : word;count : longint;w : word); 206 207 begin 208 seg_fillword(dosmemselector,seg*16+ofs,count,w); 209 end; 210 211 212 procedure test_int31(flag : longint); stdcall; { flag is pushed on stack } 213 begin 214 asm 215 pushl %ebx 216 movw $0,INT31ERROR 217 movl flag,%ebx 218 testb $1,%bl 219 jz .Lti31_1 220 movw %ax,INT31ERROR 221 xorl %eax,%eax 222 jmp .Lti31_2 223 .Lti31_1: 224 movl $1,%eax 225 .Lti31_2: 226 popl %ebx 227 end; 228 end; 229 230 function global_dos_alloc(bytes : longint) : longint; 231 232 begin 233 asm 234 pushl %ebx 235 movl bytes,%ebx 236 addl $0xf,%ebx // round up 237 shrl $0x4,%ebx // convert to Paragraphs 238 movl $0x100,%eax // function 0x100 239 int $0x31 240 jnc .LDos_OK 241 movw %ax,INT31ERROR 242 xorl %eax,%eax 243 jmp .LDos_end 244 .LDos_OK: 245 shll $0x10,%eax // return Segment in hi(Result) 246 movw %dx,%ax // return Selector in lo(Result) 247 .LDos_end: 248 movl %eax,__result 249 popl %ebx 250 end; 251 end; 252 253 function global_dos_free(selector : word) : boolean; 254 255 begin 256 asm 257 movw Selector,%dx 258 movl $0x101,%eax 259 int $0x31 260 setnc %al 261 movb %al,__RESULT 262 end; 263 end; 264 265 function realintr(intnr : word;var regs : trealregs) : boolean; 266 267 begin 268 regs.realsp:=0; 269 regs.realss:=0; 270 asm 271 pushl %ebx 272 pushl %edi 273 { save all used registers to avoid crash under NTVDM } 274 { when spawning a 32-bit DPMI application } 275 pushw %fs 276 movw intnr,%bx 277 xorl %ecx,%ecx 278 movl regs,%edi 279 { es is always equal ds } 280 movl $0x300,%eax 281 int $0x31 282 popw %fs 283 setnc %al 284 movb %al,__RESULT 285 popl %edi 286 popl %ebx 287 end; 288 end; 289 290 procedure seg_fillchar(seg : word;ofs : longint;count : longint;c : char); 291 292 begin 293 asm 294 pushl %edi 295 movl ofs,%edi 296 movl count,%ecx 297 movb c,%dl 298 { load es with selector } 299 pushw %es 300 movw seg,%ax 301 movw %ax,%es 302 { fill eax with duplicated c } 303 { so we can use stosl } 304 movb %dl,%dh 305 movw %dx,%ax 306 shll $16,%eax 307 movw %dx,%ax 308 movl %ecx,%edx 309 shrl $2,%ecx 310 cld 311 rep 312 stosl 313 movl %edx,%ecx 314 andl $3,%ecx 315 rep 316 stosb 317 popw %es 318 popl %edi 319 end; 320 end; 321 322 procedure seg_fillword(seg : word;ofs : longint;count : longint;w : word); 323 324 begin 325 asm 326 pushl %edi 327 movl ofs,%edi 328 movl count,%ecx 329 movw w,%dx 330 { load segment } 331 pushw %es 332 movw seg,%ax 333 movw %ax,%es 334 { fill eax } 335 movw %dx,%ax 336 shll $16,%eax 337 movw %dx,%ax 338 movl %ecx,%edx 339 shrl $1,%ecx 340 cld 341 rep 342 stosl 343 movl %edx,%ecx 344 andl $1,%ecx 345 rep 346 stosw 347 popw %es 348 popl %edi 349 end; 350 end; 351 352 procedure seg_move(sseg : word;source : longint;dseg : word;dest : longint;count : longint); 353 354 begin 355 if count=0 then 356 exit; 357 if (sseg<>dseg) or ((sseg=dseg) and (source>dest)) then 358 asm 359 pushl %edi 360 pushl %esi 361 pushw %es 362 pushw %ds 363 cld 364 movl count,%ecx 365 movl source,%esi 366 movl dest,%edi 367 movw dseg,%ax 368 movw %ax,%es 369 movw sseg,%ax 370 movw %ax,%ds 371 movl %ecx,%eax 372 shrl $2,%ecx 373 rep 374 movsl 375 movl %eax,%ecx 376 andl $3,%ecx 377 rep 378 movsb 379 popw %ds 380 popw %es 381 popl %esi 382 popl %edi 383 end 384 else if (source<dest) then 385 { copy backward for overlapping } 386 asm 387 pushl %edi 388 pushl %esi 389 pushw %es 390 pushw %ds 391 std 392 movl count,%ecx 393 movl source,%esi 394 movl dest,%edi 395 movw dseg,%ax 396 movw %ax,%es 397 movw sseg,%ax 398 movw %ax,%ds 399 addl %ecx,%esi 400 addl %ecx,%edi 401 movl %ecx,%eax 402 andl $3,%ecx 403 orl %ecx,%ecx 404 jz .LSEG_MOVE1 405 406 { calculate esi and edi} 407 decl %esi 408 decl %edi 409 rep 410 movsb 411 incl %esi 412 incl %edi 413 .LSEG_MOVE1: 414 subl $4,%esi 415 subl $4,%edi 416 movl %eax,%ecx 417 shrl $2,%ecx 418 rep 419 movsl 420 cld 421 popw %ds 422 popw %es 423 popl %esi 424 popl %edi 425 end; 426 end; 427 428 procedure outportb(port : word;data : byte); 429 430 begin 431 asm 432 movw port,%dx 433 movb data,%al 434 outb %al,%dx 435 end ['EAX','EDX']; 436 end; 437 438 procedure outportw(port : word;data : word); 439 440 begin 441 asm 442 movw port,%dx 443 movw data,%ax 444 outw %ax,%dx 445 end ['EAX','EDX']; 446 end; 447 448 procedure outportl(port : word;data : longint); 449 450 begin 451 asm 452 movw port,%dx 453 movl data,%eax 454 outl %eax,%dx 455 end ['EAX','EDX']; 456 end; 457 458 function inportb(port : word) : byte; 459 460 begin 461 asm 462 movw port,%dx 463 inb %dx,%al 464 movb %al,__RESULT 465 end ['EAX','EDX']; 466 end; 467 468 function inportw(port : word) : word; 469 470 begin 471 asm 472 movw port,%dx 473 inw %dx,%ax 474 movw %ax,__RESULT 475 end ['EAX','EDX']; 476 end; 477 478 function inportl(port : word) : longint; 479 480 begin 481 asm 482 movw port,%dx 483 inl %dx,%eax 484 movl %eax,__RESULT 485 end ['EAX','EDX']; 486 end; 487 488 489 490 function get_cs : word;assembler; 491 asm 492 movw %cs,%ax 493 end; 494 495 496 function get_ss : word;assembler; 497 asm 498 movw %ss,%ax 499 end; 500 501 502 function get_ds : word;assembler; 503 asm 504 movw %ds,%ax 505 end; 506 507 508 function set_pm_interrupt(vector : byte;const intaddr : tseginfo) : boolean; 509 510 begin 511 asm 512 pushl %ebx 513 movl intaddr,%eax 514 movl (%eax),%edx 515 movw 4(%eax),%cx 516 movl $0x205,%eax 517 movb vector,%bl 518 int $0x31 519 pushf 520 call test_int31 521 movb %al,__RESULT 522 popl %ebx 523 end; 524 end; 525 526 function set_rm_interrupt(vector : byte;const intaddr : tseginfo) : boolean; 527 528 begin 529 asm 530 pushl %ebx 531 movl intaddr,%eax 532 movw (%eax),%dx 533 movw 4(%eax),%cx 534 movl $0x201,%eax 535 movb vector,%bl 536 int $0x31 537 pushf 538 call test_int31 539 movb %al,__RESULT 540 popl %ebx 541 end; 542 end; 543 544 function set_pm_exception_handler(e : byte;const intaddr : tseginfo) : boolean; 545 546 begin 547 asm 548 pushl %ebx 549 movl intaddr,%eax 550 movl (%eax),%edx 551 movw 4(%eax),%cx 552 movl $0x212,%eax 553 movb e,%bl 554 int $0x31 555 pushf 556 call test_int31 557 movb %al,__RESULT 558 popl %ebx 559 end; 560 end; 561 562 function set_exception_handler(e : byte;const intaddr : tseginfo) : boolean; 563 564 begin 565 asm 566 pushl %ebx 567 movl intaddr,%eax 568 movl (%eax),%edx 569 movw 4(%eax),%cx 570 movl $0x203,%eax 571 movb e,%bl 572 int $0x31 573 pushf 574 call test_int31 575 movb %al,__RESULT 576 popl %ebx 577 end; 578 end; 579 580 function get_pm_exception_handler(e : byte;var intaddr : tseginfo) : boolean; 581 582 begin 583 asm 584 pushl %ebx 585 movl $0x210,%eax 586 movb e,%bl 587 int $0x31 588 pushf 589 call test_int31 590 movb %al,__RESULT 591 movl intaddr,%eax 592 movl %edx,(%eax) 593 movw %cx,4(%eax) 594 popl %ebx 595 end; 596 end; 597 598 function get_exception_handler(e : byte;var intaddr : tseginfo) : boolean; 599 600 begin 601 asm 602 pushl %ebx 603 movl $0x202,%eax 604 movb e,%bl 605 int $0x31 606 pushf 607 call test_int31 608 movb %al,__RESULT 609 movl intaddr,%eax 610 movl %edx,(%eax) 611 movw %cx,4(%eax) 612 popl %ebx 613 end; 614 end; 615 616 function get_pm_interrupt(vector : byte;var intaddr : tseginfo) : boolean; 617 618 begin 619 asm 620 pushl %ebx 621 movb vector,%bl 622 movl $0x204,%eax 623 int $0x31 624 pushf 625 call test_int31 626 movb %al,__RESULT 627 movl intaddr,%eax 628 movl %edx,(%eax) 629 movw %cx,4(%eax) 630 popl %ebx 631 end; 632 end; 633 634 function get_rm_interrupt(vector : byte;var intaddr : tseginfo) : boolean; 635 636 begin 637 asm 638 pushl %ebx 639 movb vector,%bl 640 movl $0x200,%eax 641 int $0x31 642 pushf 643 call test_int31 644 movb %al,__RESULT 645 movl intaddr,%eax 646 movzwl %dx,%edx 647 movl %edx,(%eax) 648 movw %cx,4(%eax) 649 popl %ebx 650 end; 651 end; 652 653 function free_rm_callback(var intaddr : tseginfo) : boolean; 654 begin 655 asm 656 movl intaddr,%eax 657 movw (%eax),%dx 658 movw 4(%eax),%cx 659 movl $0x304,%eax 660 int $0x31 661 pushf 662 call test_int31 663 movb %al,__RESULT 664 end; 665 end; 666 667 { here we must use ___v2prt0_ds_alias instead of from v2prt0.s 668 because the exception processor sets the ds limit to $fff 669 at hardware exceptions } 670 671//!!!! var 672//!!!! ___v2prt0_ds_alias : word; external name '___v2prt0_ds_alias'; 673 var ___v2prt0_ds_alias : word; 674 675 function get_rm_callback(pm_func : pointer;const reg : trealregs;var rmcb : tseginfo) : boolean; 676 begin 677 asm 678 pushl %esi 679 pushl %edi 680 movl pm_func,%esi 681 movl reg,%edi 682 pushw %es 683 movw ___v2prt0_ds_alias,%ax 684 movw %ax,%es 685 pushw %ds 686 movw %cs,%ax 687 movw %ax,%ds 688 movl $0x303,%eax 689 int $0x31 690 popw %ds 691 popw %es 692 pushf 693 call test_int31 694 movb %al,__RESULT 695 movl rmcb,%eax 696 movzwl %dx,%edx 697 movl %edx,(%eax) 698 movw %cx,4(%eax) 699 popl %edi 700 popl %esi 701 end; 702 end; 703 704 function allocate_ldt_descriptors(count : word) : word; 705 706 begin 707 asm 708 movw count,%cx 709 xorl %eax,%eax 710 int $0x31 711 movw %ax,__RESULT 712 end; 713 end; 714 715 function free_ldt_descriptor(d : word) : boolean; 716 717 begin 718 asm 719 pushl %ebx 720 movw d,%bx 721 movl $1,%eax 722 int $0x31 723 pushf 724 call test_int31 725 movb %al,__RESULT 726 popl %ebx 727 end; 728 end; 729 730 function segment_to_descriptor(seg : word) : word; 731 732 begin 733 asm 734 pushl %ebx 735 movw seg,%bx 736 movl $2,%eax 737 int $0x31 738 movw %ax,__RESULT 739 popl %ebx 740 end; 741 end; 742 743 function get_next_selector_increment_value : word; 744 745 begin 746 asm 747 movl $3,%eax 748 int $0x31 749 movw %ax,__RESULT 750 end; 751 end; 752 753 function get_segment_base_address(d : word) : longint; 754 755 begin 756 asm 757 pushl %ebx 758 movw d,%bx 759 movl $6,%eax 760 int $0x31 761 xorl %eax,%eax 762 movw %dx,%ax 763 shll $16,%ecx 764 orl %ecx,%eax 765 movl %eax,__RESULT 766 popl %ebx 767 end; 768 end; 769 770 function get_page_size:longint; 771 begin 772 asm 773 pushl %ebx 774 movl $0x604,%eax 775 int $0x31 776 shll $16,%ebx 777 movw %cx,%bx 778 movl %ebx,__RESULT 779 popl %ebx 780 end; 781 end; 782 783 function request_linear_region(linearaddr, size : longint; 784 var blockhandle : longint) : boolean; 785 var 786 pageofs : longint; 787 788 begin 789 pageofs:=linearaddr and $3ff; 790 linearaddr:=linearaddr-pageofs; 791 size:=size+pageofs; 792 asm 793 pushl %esi 794 pushl %ebx 795 movl $0x504,%eax 796 movl linearaddr,%ebx 797 movl size,%ecx 798 movl $1,%edx 799 xorl %esi,%esi 800 int $0x31 801 pushf 802 call test_int31 803 movb %al,__RESULT 804 movl blockhandle,%eax 805 movl %esi,(%eax) 806 movl %ebx,pageofs 807 popl %ebx 808 popl %esi 809 end; 810 if pageofs<>linearaddr then 811 request_linear_region:=false; 812 end; 813 814 function allocate_memory_block(size:longint):longint; 815 begin 816 asm 817 pushl %esi 818 pushl %edi 819 pushl %ebx 820 movl $0x501,%eax 821 movl size,%ecx 822 movl %ecx,%ebx 823 shrl $16,%ebx 824 andl $65535,%ecx 825 int $0x31 826 jnc .Lallocate_mem_block_err 827 xorl %ebx,%ebx 828 xorl %ecx,%ecx 829 .Lallocate_mem_block_err: 830 shll $16,%ebx 831 movw %cx,%bx 832 shll $16,%esi 833 movw %di,%si 834 movl %ebx,__RESULT 835 popl %ebx 836 popl %edi 837 popl %esi 838 end; 839 end; 840 841 function free_memory_block(blockhandle : longint) : boolean; 842 begin 843 asm 844 pushl %esi 845 pushl %edi 846 movl blockhandle,%esi 847 movl %esi,%edi 848 shll $16,%esi 849 movl $0x502,%eax 850 int $0x31 851 pushf 852 call test_int31 853 movb %al,__RESULT 854 popl %edi 855 popl %esi 856 end; 857 end; 858 859 function lock_linear_region(linearaddr, size : longint) : boolean; 860 861 begin 862 asm 863 pushl %esi 864 pushl %edi 865 pushl %ebx 866 movl $0x600,%eax 867 movl linearaddr,%ecx 868 movl %ecx,%ebx 869 shrl $16,%ebx 870 movl size,%esi 871 movl %esi,%edi 872 shrl $16,%esi 873 int $0x31 874 pushf 875 call test_int31 876 movb %al,__RESULT 877 popl %ebx 878 popl %edi 879 popl %esi 880 end; 881 end; 882 883 function lock_data(var data;size : longint) : boolean; 884 885 var 886 linearaddr : longint; 887 888 begin 889 if get_run_mode<>rm_dpmi then 890 exit; 891 linearaddr:=longint(@data)+get_segment_base_address(get_ds); 892 lock_data:=lock_linear_region(linearaddr,size); 893 end; 894 895 function lock_code(functionaddr : pointer;size : longint) : boolean; 896 897 var 898 linearaddr : longint; 899 900 begin 901 if get_run_mode<>rm_dpmi then 902 exit; 903 linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs); 904 lock_code:=lock_linear_region(linearaddr,size); 905 end; 906 907 function unlock_linear_region(linearaddr,size : longint) : boolean; 908 909 begin 910 asm 911 pushl %esi 912 pushl %edi 913 pushl %ebx 914 movl $0x601,%eax 915 movl linearaddr,%ecx 916 movl %ecx,%ebx 917 shrl $16,%ebx 918 movl size,%esi 919 movl %esi,%edi 920 shrl $16,%esi 921 int $0x31 922 pushf 923 call test_int31 924 movb %al,__RESULT 925 popl %ebx 926 popl %edi 927 popl %esi 928 end; 929 end; 930 931 function unlock_data(var data;size : longint) : boolean; 932 933 var 934 linearaddr : longint; 935 begin 936 if get_run_mode<>rm_dpmi then 937 exit; 938 linearaddr:=longint(@data)+get_segment_base_address(get_ds); 939 unlock_data:=unlock_linear_region(linearaddr,size); 940 end; 941 942 function unlock_code(functionaddr : pointer;size : longint) : boolean; 943 944 var 945 linearaddr : longint; 946 begin 947 if get_run_mode<>rm_dpmi then 948 exit; 949 linearaddr:=longint(functionaddr)+get_segment_base_address(get_cs); 950 unlock_code:=unlock_linear_region(linearaddr,size); 951 end; 952 953 function set_segment_base_address(d : word;s : longint) : boolean; 954 955 begin 956 asm 957 pushl %ebx 958 movw d,%bx 959 leal s,%eax 960 movw (%eax),%dx 961 movw 2(%eax),%cx 962 movl $7,%eax 963 int $0x31 964 pushf 965 call test_int31 966 movb %al,__RESULT 967 popl %ebx 968 end; 969 end; 970 971 function set_descriptor_access_right(d : word;w : word) : longint; 972 973 begin 974 asm 975 pushl %ebx 976 movw d,%bx 977 movw w,%cx 978 movl $9,%eax 979 int $0x31 980 pushf 981 call test_int31 982 movw %ax,__RESULT 983 popl %ebx 984 end; 985 end; 986 987 function set_segment_limit(d : word;s : longint) : boolean; 988 989 begin 990 asm 991 pushl %ebx 992 movw d,%bx 993 leal s,%eax 994 movw (%eax),%dx 995 movw 2(%eax),%cx 996 movl $8,%eax 997 int $0x31 998 pushf 999 call test_int31 1000 movb %al,__RESULT 1001 popl %ebx 1002 end; 1003 end; 1004 1005 function get_descriptor_access_right(d : word) : longint; 1006 1007 begin 1008 asm 1009 movzwl d,%eax 1010 lar %eax,%eax 1011 jz .L_ok 1012 xorl %eax,%eax 1013 .L_ok: 1014 movl %eax,__RESULT 1015 end; 1016 end; 1017 function get_segment_limit(d : word) : longint; 1018 1019 begin 1020 asm 1021 movzwl d,%eax 1022 lsl %eax,%eax 1023 jz .L_ok2 1024 xorl %eax,%eax 1025 .L_ok2: 1026 movl %eax,__RESULT 1027 end; 1028 end; 1029 1030 function create_code_segment_alias_descriptor(seg : word) : word; 1031 1032 begin 1033 asm 1034 pushl %ebx 1035 movw seg,%bx 1036 movl $0xa,%eax 1037 int $0x31 1038 pushf 1039 call test_int31 1040 movw %ax,__RESULT 1041 popl %ebx 1042 end; 1043 end; 1044 1045 function get_meminfo(var meminfo : tmeminfo) : boolean; 1046 1047 begin 1048 asm 1049 pushl %edi 1050 movl meminfo,%edi 1051 movl $0x500,%eax 1052 int $0x31 1053 pushf 1054 movb %al,__RESULT 1055 call test_int31 1056 popl %edi 1057 end; 1058 end; 1059 1060 function get_linear_addr(phys_addr : longint;size : longint) : longint; 1061 1062 begin 1063 asm 1064 pushl %esi 1065 pushl %edi 1066 pushl %ebx 1067 movl phys_addr,%ebx 1068 movl %ebx,%ecx 1069 shrl $16,%ebx 1070 movl size,%esi 1071 movl %esi,%edi 1072 shrl $16,%esi 1073 movl $0x800,%eax 1074 int $0x31 1075 pushf 1076 call test_int31 1077 shll $16,%ebx 1078 movw %cx,%bx 1079 movl %ebx,__RESULT 1080 popl %ebx 1081 popl %edi 1082 popl %esi 1083 end; 1084 end; 1085 1086 procedure disable;assembler; 1087 1088 asm 1089 cli 1090 end; 1091 1092 procedure enable;assembler; 1093 1094 asm 1095 sti 1096 end; 1097 1098 1099// var 1100// _run_mode : word;external name '_run_mode'; 1101 1102 function get_run_mode : word; 1103 1104 begin 1105// get_run_mode:=_run_mode; !!!!!!!!!! 1106 get_run_mode:=rm_unknown; 1107 end; 1108 1109 function map_device_in_memory_block(handle,offset,pagecount,device:longint):boolean; 1110 begin 1111 asm 1112 pushl %esi 1113 pushl %edi 1114 pushl %ebx 1115 movl device,%edx 1116 movl handle,%esi 1117 movl offset,%ebx 1118 movl pagecount,%ecx 1119 movl $0x0508,%eax 1120 int $0x31 1121 pushf 1122 setnc %al 1123 movb %al,__RESULT 1124 call test_int31 1125 popl %ebx 1126 popl %edi 1127 popl %esi 1128 end; 1129 end; 1130 1131{***************************************************************************** 1132 Transfer Buffer 1133*****************************************************************************} 1134 1135 procedure copytodos(var addr; len : longint); 1136 begin 1137 if len>tb_size then 1138 runerror(217); 1139 seg_move(get_ds,longint(@addr),dosmemselector,tb,len); 1140 end; 1141 1142 1143 procedure copyfromdos(var addr; len : longint); 1144 begin 1145 if len>tb_size then 1146 runerror(217); 1147 seg_move(dosmemselector,tb,get_ds,longint(@addr),len); 1148 end; 1149 1150 1151begin 1152 int31error:=0; 1153 dosmemselector:=get_ds; 1154end. 1155