← Back to branch summary

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

« back to all changes in this revision

Viewing changes to rtl/go32v2/dos.pp

  • 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/go32v2/dos.pp
1
1
{
2
 
    $Id: dos.pp,v 1.23 2005/02/14 17:13:22 peter Exp $
3
2
    This file is part of the Free Pascal run time library.
4
3
    Copyright (c) 1999-2000 by the Free Pascal development team.
5
4
 
170
169
    comtail   : realptr;
171
170
    firstFCB  : realptr;
172
171
    secondFCB : realptr;
173
 
    iniStack  : realptr;
174
 
    iniCSIP   : realptr;
 
172
{    iniStack  : realptr;
 
173
    iniCSIP   : realptr;}
175
174
  end;
176
175
var
177
176
  current_dos_buffer_pos,
182
181
  execblock       : texecblock;
183
182
  c,p             : string;
184
183
 
185
 
  function paste_to_dos(src : string) : boolean;
 
184
  function paste_to_dos(src : string;cr : boolean) : boolean;
186
185
  var
187
 
    c : array[0..255] of char;
 
186
    c : pchar;
 
187
    CLen : cardinal;
188
188
  begin
189
189
     paste_to_dos:=false;
190
 
     if current_dos_buffer_pos+length(src)+1>transfer_buffer+tb_size then
 
190
     if current_dos_buffer_pos+length(src)+3>transfer_buffer+tb_size then
191
191
      RunError(217);
192
 
     move(src[1],c[0],length(src));
193
 
     c[length(src)]:=#0;
194
 
     seg_move(get_ds,longint(@c),dosmemselector,current_dos_buffer_pos,length(src)+1);
195
 
     current_dos_buffer_pos:=current_dos_buffer_pos+length(src)+1;
 
192
     getmem(c,length(src)+3);
 
193
     move(src[0],c^,length(src)+1);
 
194
     if cr then
 
195
      begin 
 
196
        c[length(src)+1]:=#13;
 
197
        c[length(src)+2]:=#0;
 
198
      end
 
199
     else
 
200
      c[length(src)+1]:=#0;
 
201
     CLen := StrLen (C) + 1;
 
202
     seg_move(get_ds,longint(c),dosmemselector,current_dos_buffer_pos,CLen);
 
203
     current_dos_buffer_pos:=current_dos_buffer_pos+CLen;
 
204
     freemem(c,length(src)+3);
196
205
     paste_to_dos:=true;
197
206
  end;
198
207
 
199
208
begin
200
209
{ create command line }
201
 
  move(comline[0],c[1],length(comline)+1);
202
 
  c[length(comline)+2]:=#13;
203
 
  c[0]:=char(length(comline)+2);
 
210
  c:=comline;
204
211
{ create path }
205
212
  p:=path;
 
213
{ allow slash as backslash }
206
214
  for i:=1 to length(p) do
207
215
   if p[i]='/' then
208
216
    p[i]:='\';
215
223
  current_dos_buffer_pos:=la_env;
216
224
{ copy environment }
217
225
  for i:=1 to envcount do
218
 
   paste_to_dos(envstr(i));
219
 
  paste_to_dos(''); { adds a double zero at the end }
 
226
   paste_to_dos(envstr(i),false);
 
227
  paste_to_dos(chr(0),false); { adds a double zero at the end }
220
228
{ allow slash as backslash }
221
229
  la_p:=current_dos_buffer_pos;
222
 
  paste_to_dos(p);
 
230
  paste_to_dos(p,false);
223
231
  la_c:=current_dos_buffer_pos;
224
 
  paste_to_dos(c);
 
232
  paste_to_dos(c,true);
225
233
  la_e:=current_dos_buffer_pos;
226
234
  fcb1_la:=la_e;
227
235
  la_e:=la_e+16;
229
237
  la_e:=la_e+16;
230
238
{ allocate FCB see dosexec code }
231
239
  arg_ofs:=1;
232
 
  while (c[arg_ofs] in [' ',#9]) do
233
 
   inc(arg_ofs);
 
240
  while (c[arg_ofs] in [' ',#9]) and
 
241
   (arg_ofs<length(c)) do
 
242
    inc(arg_ofs);
234
243
  dosregs.ax:=$2901;
235
244
  dosregs.ds:=(la_c+arg_ofs) shr 4;
236
245
  dosregs.esi:=(la_c+arg_ofs) and 15;
238
247
  dosregs.edi:=fcb1_la and 15;
239
248
  msdos(dosregs);
240
249
{ allocate second FCB see dosexec code }
241
 
  repeat
242
 
    inc(arg_ofs);
243
 
  until (c[arg_ofs] in [' ',#9,#13]);
244
 
  if c[arg_ofs]<>#13 then
245
 
   begin
246
 
     repeat
247
 
       inc(arg_ofs);
248
 
     until not (c[arg_ofs] in [' ',#9]);
249
 
   end;
250
250
  dosregs.ax:=$2901;
251
251
  dosregs.ds:=(la_c+arg_ofs) shr 4;
252
 
  dosregs.si:=(la_c+arg_ofs) and 15;
 
252
  dosregs.esi:=(la_c+arg_ofs) and 15;
253
253
  dosregs.es:=fcb2_la shr 4;
254
 
  dosregs.di:=fcb2_la and 15;
 
254
  dosregs.edi:=fcb2_la and 15;
255
255
  msdos(dosregs);
256
256
  with execblock do
257
257
   begin
264
264
     secondFCB.ofs:=fcb2_la and 15;
265
265
   end;
266
266
  seg_move(get_ds,longint(@execblock),dosmemselector,la_e,sizeof(texecblock));
267
 
  dosregs.edx:=la_p and 15;
 
267
  dosregs.edx:=la_p and 15+1;
268
268
  dosregs.ds:=la_p shr 4;
269
 
  dosregs.ebx:=la_e and 15;
270
 
  dosregs.es:=la_e shr 4;
 
269
  dosregs.ebx:=la_p and 15+la_e-la_p;
 
270
  dosregs.es:=la_p shr 4;
271
271
  dosregs.ax:=$4b00;
272
272
  msdos(dosregs);
273
273
  LoadDosError;
274
 
  if DosError=0 then
 
274
  if DosError<>0 then
275
275
   begin
276
276
     dosregs.ax:=$4d00;
277
277
     msdos(dosregs);
339
339
  S    : String;
340
340
  Rec  : ExtendedFat32FreeSpaceRec;
341
341
BEGIN
342
 
 if (swap(dosversion)>=$070A) AND LFNSupport then
 
342
 if {(swap(dosversion)>=$070A) AND} LFNSupport then
343
343
  begin
344
344
   S:='C:\'#0;
345
345
   if Drive=0 then
687
687
  LoadDosError;
688
688
  if DosError=0 then
689
689
   begin
690
 
     copyfromdos(c,255);
 
690
     copyfromdos(c,256);
691
691
     move(c[0],p[1],strlen(c));
692
692
     p[0]:=char(strlen(c));
693
693
     GetShortName:=true;
715
715
  LoadDosError;
716
716
  if DosError=0 then
717
717
   begin
718
 
     copyfromdos(c,255);
 
718
     copyfromdos(c,256);
719
719
     move(c[0],p[1],strlen(c));
720
720
     p[0]:=char(strlen(c));
721
721
     GetLongName:=true;
807
807
function envstr (Index: longint): string;
808
808
begin
809
809
  if (index<=0) or (index>envcount) then
810
 
   begin
811
 
     envstr:='';
812
 
     exit;
813
 
   end;
814
 
  envstr:=strpas(ppchar(pointer(envp)+4*(index-1))^);
 
810
    envstr:=''
 
811
  else
 
812
    envstr:=strpas(ppchar(pointer(envp)+SizeOf(PChar)*(index-1))^);
815
813
end;
816
814
 
817
815
 
818
816
Function  GetEnv(envvar: string): string;
819
817
var
820
 
  hp      : ppchar;
 
818
  hp    : ppchar;
821
819
  hs    : string;
822
820
  eqpos : longint;
823
821
begin
830
828
     eqpos:=pos('=',hs);
831
829
     if upcase(copy(hs,1,eqpos-1))=envvar then
832
830
      begin
833
 
        getenv:=copy(hs,eqpos+1,255);
834
 
        exit;
 
831
        getenv:=copy(hs,eqpos+1,length(hs)-eqpos);
 
832
        break;
835
833
      end;
836
834
     inc(hp);
837
835
   end;
839
837
 
840
838
 
841
839
end.
842
 
{
843
 
  $Log: dos.pp,v $
844
 
  Revision 1.23  2005/02/14 17:13:22  peter
845
 
    * truncate log
846
 
 
847
 
}