← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to rtl/os2/system.pas

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/os2/system.pas
1
1
{
2
 
 $Id: system.pas,v 1.85 2005/05/03 22:17:26 hajny Exp $
3
2
 ****************************************************************************
4
3
 
5
4
    This file is part of the Free Pascal run time library.
6
 
    Copyright (c) 1999-2002 by Free Pascal development team
 
5
    Copyright (c) 1999-2005 by Free Pascal development team
7
6
 
8
7
    Free Pascal - OS/2 runtime library
9
8
 
16
15
 
17
16
****************************************************************************}
18
17
 
19
 
unit {$ifdef VER1_0}sysos2{$else}System{$endif};
 
18
unit system;
20
19
 
21
20
interface
22
21
 
50
49
  PathSeparator = ';';
51
50
{ FileNameCaseSensitive is defined separately below!!! }
52
51
  MaxExitCode = 65535;
53
 
 
 
52
  MaxPathLen = 256;
 
53
  
54
54
type    Tos=(osDOS,osOS2,osDPMI);
55
55
 
56
56
const   os_mode: Tos = osOS2;
133
133
(* for all threads, so the setting isn't declared as a threadvar and       *)
134
134
(* should be only changed at the beginning of the main thread if needed.   *)
135
135
  UseHighMem: boolean;
 
136
  StackTop : PtrUInt;
136
137
 
137
138
 
138
139
 
417
418
end;
418
419
 
419
420
 
420
 
{$ifdef HASTHREADVAR}
421
421
threadvar
422
 
{$else HASTHREADVAR}
423
 
var
424
 
{$endif HASTHREADVAR}
425
422
  DefaultCreator: ShortString;
426
423
  DefaultFileType: ShortString;
427
424
 
472
469
  envp[env_count]:=nil;
473
470
end;
474
471
 
 
472
var
 
473
(* Initialized by system unit initialization *)
 
474
    PIB: PProcessInfoBlock;
 
475
 
 
476
 
475
477
procedure InitArguments;
476
478
var
477
479
  arglen,
490
492
         oldargvlen:=argvlen;
491
493
         argvlen:=(idx+8) and (not 7);
492
494
         sysreallocmem(argv,argvlen*sizeof(pointer));
493
 
         fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0);
 
495
{         fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0);}
494
496
       end;
495
497
      { use realloc to reuse already existing memory }
496
498
      { always allocate, even if length is zero, since }
497
499
      { the arg. is still present!                     }
498
 
{      sysreallocmem(argv[idx],len+1);}
499
500
      ArgV [Idx] := SysAllocMem (Succ (Len));
500
501
    end;
501
502
 
502
503
begin
503
 
  count:=0;
504
 
  argv:=nil;
505
 
  argvlen:=0;
506
 
 
507
 
  // Get argv[0]
508
 
  pc:=cmdline;
509
 
  Arglen:=0;
510
 
  repeat
511
 
    Inc(Arglen);
512
 
  until (pc[Arglen] = #0);
513
 
  allocarg(count,arglen);
514
 
  move(pc^,argv[count]^,arglen);
515
 
 
516
 
  { ReSetup cmdline variable }
517
 
  repeat
518
 
    Inc(Arglen);
519
 
  until (pc[Arglen]=#0);
520
 
  Inc(Arglen);
521
 
  pc:=GetMem(ArgLen);
522
 
  move(cmdline^, pc^, arglen);
523
 
  Arglen:=0;
524
 
  repeat
525
 
    Inc(Arglen);
526
 
  until (pc[Arglen]=#0);
527
 
  pc[Arglen]:=' '; // combine argv[0] and command line
528
 
  CmdLine:=pc;
 
504
  CmdLine := SysAllocMem (MaxPathLen);
 
505
 
 
506
  ArgV := SysAllocMem (8 * SizeOf (pointer));
 
507
 
 
508
  ArgLen := StrLen (PChar (PIB^.Cmd));
 
509
  Inc (ArgLen);
 
510
 
 
511
  if DosQueryModuleName (PIB^.Handle, MaxPathLen, CmdLine) = 0 then
 
512
   ArgVLen := Succ (StrLen (CmdLine))
 
513
  else
 
514
(* Error occurred - use program name from command line as fallback. *)
 
515
   begin
 
516
    Move (PIB^.Cmd^, CmdLine, ArgLen);
 
517
    ArgVLen := ArgLen;
 
518
   end;
 
519
 
 
520
{ Get ArgV [0] }
 
521
  ArgV [0] := SysAllocMem (ArgVLen);
 
522
  Move (CmdLine^, ArgV [0]^, ArgVLen);
 
523
  Count := 1;
 
524
 
 
525
(* PC points to leading space after program name on command line *)
 
526
  PC := PChar (PIB^.Cmd) + ArgLen;
 
527
 
 
528
(* ArgLen contains size of command line arguments including leading space. *)
 
529
  ArgLen := Succ (StrLen (PC));
 
530
 
 
531
  SysReallocMem (CmdLine, ArgVLen + ArgLen);
 
532
 
 
533
  Move (PC^, CmdLine [ArgVLen], Succ (ArgLen));
 
534
 
 
535
(* ArgV has space for 8 parameters from the first allocation. *)
 
536
  ArgVLen := 8;
529
537
 
530
538
  { process arguments }
531
 
  pc:=cmdline;
532
 
{$IfDef DEBUGARGUMENTS}
533
 
  Writeln(stderr,'GetCommandLine is #',pc,'#');
534
 
{$EndIf }
535
539
  while pc^<>#0 do
536
540
   begin
537
541
     { skip leading spaces }
684
688
                                                 else GetFileHandleCount := L2;
685
689
end;
686
690
 
 
691
function CheckInitialStkLen (StkLen: SizeUInt): SizeUInt;
 
692
begin
 
693
  CheckInitialStkLen := StkLen;
 
694
end;
 
695
 
687
696
var TIB: PThreadInfoBlock;
688
 
    PIB: PProcessInfoBlock;
689
697
    RC: cardinal;
690
698
    ErrStr: string;
691
699
    P: pointer;
697
705
    FileHandleCount := GetFileHandleCount;
698
706
    DosGetInfoBlocks (@TIB, @PIB);
699
707
    StackBottom := TIB^.Stack;
 
708
    StackTop := PtrUInt (TIB^.StackLimit);
 
709
    StackLength := CheckInitialStkLen (InitialStkLen);
700
710
 
701
711
    {Set type of application}
702
712
    ApplicationType := PIB^.ProcType;
739
749
    Environment := pointer (PIB^.Env);
740
750
    InitEnvironment;
741
751
 
742
 
    CmdLine := pointer (PIB^.Cmd);
743
752
    InitArguments;
 
753
 
744
754
    DefaultCreator := '';
745
755
    DefaultFileType := '';
746
756
 
747
757
    InitSystemThreads;
748
 
{$ifdef HASVARIANT}
749
 
    initvariantmanager;
750
 
{$endif HASVARIANT}
 
758
    InitVariantManager;
 
759
 
 
760
{$ifdef HASWIDESTRING}
 
761
    InitWideStringManager;
 
762
{$endif HASWIDESTRING}
751
763
 
752
764
{$IFDEF EXTDUMPGROW}
753
765
{    Int_HeapSize := high (cardinal);}
764
776
       begin
765
777
        Str (RC, ErrStr);
766
778
        ErrStr := 'Error during heap initialization (DosAllocMem - ' + ErrStr + ')!!'#13#10;
767
 
        DosWrite (2, @ErrStr [1], Length (ErrStr), RC);
 
779
        if IsConsole then
 
780
         DosWrite (2, @ErrStr [1], Length (ErrStr), RC);
768
781
        HandleError (204);
769
782
       end
770
783
      else
771
784
       DosFreeMem (P);
772
785
     end;
773
786
end.
774
 
{
775
 
  $Log: system.pas,v $
776
 
  Revision 1.85  2005/05/03 22:17:26  hajny
777
 
    * SysAllocMem used for ArgV [Idx] allocation again
778
 
 
779
 
  Revision 1.84  2005/05/01 13:01:03  peter
780
 
  use fillchar after reallocmem, fix taken from win32
781
 
 
782
 
  Revision 1.83  2005/04/03 21:10:59  hajny
783
 
    * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453)
784
 
 
785
 
  Revision 1.82  2005/03/27 20:50:35  hajny
786
 
    * correction of previous mistyping
787
 
 
788
 
  Revision 1.81  2005/03/27 20:40:54  hajny
789
 
    * fix for allocarg
790
 
 
791
 
  Revision 1.80  2005/03/01 21:59:14  hajny
792
 
    * compilation fix
793
 
 
794
 
  Revision 1.79  2005/02/14 17:13:31  peter
795
 
    * truncate log
796
 
 
797
 
  Revision 1.78  2005/02/06 16:57:18  peter
798
 
    * threads for go32v2,os,emx,netware
799
 
 
800
 
}