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