[Back to DOS SWAG index] [Back to Main SWAG index] [Original]

    {
    From: MARIUS ELLEN
    Subj: DOS Environment
    }

    Program Environment;
    {$M $1000,32776,32776 }
    {    1K stack, 32k+8 bytes heap }
    {$T- No @ Typed checking}
    {$X+ Extended function syntax}
    {$Q- No overflow checking}
    {$A+ Word align data}
    {$S+ Stack checking}

    uses

        dos,
        strings;

    type

        PJFTRec = ^TJFTRec;
        TJFTRec = record
          JFTtable : array[1..20] of byte;
        end;

        PMCBrec = ^TMCBrec;
        TMCBrec = record
          Next     : char;      {4d "M", of 5a "Z"}
          PSPOwner : word;
          Length   : word;
          Filler   : array[0..10] of byte;
        end;

        PPSPrec = ^TPSPrec;
        TPSPrec = record       {ofs, length }
          INT20   :word;       {00h  2 BYTEs   INT 20 instruction for CP/M CALL 0
                                               program termination the CDh 20h
                                               here is often used as a signature
                                               for a valid PSP }
          FreeSeg :word;       {02h    WORD    segment of first byte beyond
                                               memory allocated to program}
          UnUsed04:byte;       {04h    BYTE    unused filler }
          CMPCall :byte;       {05h    BYTE    CP/M CALL 5 service request
                                               (FAR JMP to 000C0h) BUG: (DOS 2+)
                                               PSPs created by INT 21/AH=4Bh
                                               point at 000BEh}
          CPMSize :word;       {06h    WORD    CP/M compatibility--size of
                                               first segment for .COM files}
          CPMrem  :word;       {08h  2 BYTEs   remainder of FAR JMP at 05h}
          INT22   :pointer;    {0Ah    DWORD   stored INT 22 termination address}
          INT23   :pointer;    {0Eh    DWORD   stored INT 23 control-Break addr.}
          INT24   :pointer;    {12h    DWORD   DOS 1.1+ stored INT 24 address}
          ParPSP  :word;       {16h    WORD    segment of parent PSP}
          JFT     :TJFTRec;    {18h 20 BYTEs   DOS 2+ Job File Table, one byte
                                               per file handle, FFh = closed}
          SEGEnv  :word;       {2Ch    WORD    DOS 2+ segment of environment
                                               for process}
          SSSP    :pointer;    {2Eh    DWORD   DOS 2+ process's SS:SP on entry
                                               to last INT 21 call}
          JFTCount:word;       {32h    WORD    DOS 3+ number of entries in JFT
                                               (default is 20)}
          JFTPtr  :pointer;    {34h    DWORD   DOS 3+ pointer to JFT
                                               (default PSP:0018h)}
          PrevPSP :pointer;    {38h    DWORD   DOS 3+ pointer to previous PSP
                                               (default FFFFFFFFh in 3.x)
                                               used by SHARE in DOS 3.3}
          UnUsed3c:byte;       {3Ch    BYTE    apparently unused by DOS
                                               versions <= 6.00}
          UnUsed3d:byte;       {3Dh    BYTE    apparently used by some versions
                                               of APPEND}
          NovFlag :byte;       {3Eh    BYTE    (Novell NetWare) flag: next byte
                                               initialized if CEh}
          NovTask :byte;       {3Fh    BYTE    (Novell Netware) Novell task
                                               number if previous byte is CEh}
          DosVers :word;       {40h  2 BYTEs   DOS 5+ version to return on
                                               INT 21/AH=30h}
          NextPSP :word;       {42h    WORD    (MSWin3) selector of next PSP
                                               (PDB) in linked list. Windows
                                               keeps a linked list of Windows
                                               programs only}
          UnUsed44:pointer;    {44h  4 BYTEs   unused by DOS versions <= 6.00}
          WinFlag :byte;       {48h    BYTE    (MSWindows3) bit 0 set if non-
                                               Windows application (WINOLDAP)}
          UnUsed49:string[6];  {49h  7 BYTEs   unused by DOS versions <= 6.00}
          RETF21  :string[2];  {50h  3 BYTEs   DOS 2+ service request (INT
                                               21/RETF instructions)}
          UnUsed53:word;       {53h  2 BYTEs   unused in DOS versions <= 6.00}
          UnUsed55:string[6];  {55h  7 BYTEs   unused in DOS versions <= 6.00;
                                               can be used to make first FCB
                                               into an extended FCB }
          FCB1    :string[15]; {5Ch 16 BYTEs   first default FCB, filled in
                                               from first commandline argument
                                               overwrites second FCB if opened}
          FCB2    :string[15]; {6Ch 16 BYTEs   second default FCB, filled in
                                               from second commandline
                                               argument, overwrites beginning
                                               of commandline if opened}
          UnUsed7c:pointer;    {7Ch  4 BYTEs   unused}
          DTAArea :string[127];{80h 128 BYTEs  commandline / default DTA
                                               command tail is BYTE for length
                                               of tail, N BYTEs for the tail,
                                               followed by a BYTE containing
                                               0Dh}
        end;

        PMCBPSPrec = ^TMCBPSPrec;
        TMCBPSPrec = record
          MCB :TMCBRec;
          PSP :TPSPRec;
        end;

    var

        MainEnvSeg:word;
        MainEnvSize:word;

    {$ifndef TryAssembler}
        {Find DOS master environment, command/4dos etc...}
        procedure GetMainEnvironment(var envseg,envsize:word);
        var R:PMCBPSPrec;
          Rrec:array[0..1] of word absolute R;
        begin
          asm
            mov     ah,52h            {Get First MCB, }
            int     $21               {DOS Memory Control Block (MCB)}
            mov     ax,es:[bx-2]      {Bevind zich 2 terug}
            mov     R.word[0],0       {Offset is altijd 0}
            mov     R.word[2],ax      {MCB:=first DOS mcb}
          end;

          while true do begin
            if pos(R^.mcb.next,'MZ')=0
            then halt(7);             {Memory control block destroyed}

            if R^.mcb.PSPOwner=R^.PSP.ParPSP then begin {found}
              EnvSeg :=R^.PSP.SegEnv;
              R:=Ptr(EnvSeg-1,0);
              EnvSize:=R^.mcb.length shl 4;
              if EnvSize>32767
              then halt(10);          {Environment invalid (usually >32K)}
              exit;
            end;
            if R^.mcb.next='Z'
            then halt(9);             {Memory block address invalid}
                                      {Er moet een environment zijn!}
            R:=ptr((Rrec[1]+(R^.mcb.length)+1),0);
          end;
        end;

    {$else}
        procedure HaltIndirect(error:word);
        begin
          halt(error);
        end;

        {Find DOS master environment, command/4dos etc...}
        procedure GetMainEnvironment(var envsegP,envsizeP:word);
        assembler;
        var mcb:pointer;
        asm
            mov     ah,52h            {Get First MCB, }
            int     $21               {DOS Memory Control Block (MCB)}
            sub     bx,2
            xor     dx,dx             {offset altijd 0000}
            mov     ax,es:[bx]
            mov     mcb.word[0],dx
            mov     mcb.word[2],ax    {MCB:=first DOS mcb}

        @repeat:
            les     di,mcb
            mov     bl,es:[di]
            cmp     bl,4dH
            je      @MCBOk
            cmp     bl,5aH            {was het de laatste MCB}
            jne     @MCBError         {zo ja dan halt(9)}
        @MCBOk:
            mov     ax,es:[01h]       {is segment v/h prg bij deze MCB}
            cmp     ax,es:[26h]       {gelijk aan EnvSegment van het prg}
            je      @found            {zo ja dan is ie gevonden}

            cmp     bl,5ah            {is dit de laatste mcb ?}
            je      @MCBMissing       {!?!? MCB main env weg!?!?}
            les     di,mcb            {volgende MCB zit op}
            mov     ax,es             {oude MCB+next}
            add     ax,es:[3]         {+volgende}
            inc     ax                {+1}
            mov     mcb.word[2],ax
            jmp     @repeat           {herhaal tot gevonden}

        @MCBError:
            mov     al,7              {Memory control block destroyed}
            db      0a9h              {skip next mov al,xx=opcode test ax,w}
        @MCBMissing:
            mov     al,9              {Memory block address invalid}
            db      0a9h              {kan ook environment not found zijn!}
        @SizeErr:
            mov     al,10             {Environment invalid (usually >32K)}
            push    ax
            call    HaltIndirect

        @found:
            mov     ax,es:[3ch]       {Get segment environment}
            mov     dx,es             {save es}
            les     di,EnvSegP        {ptr van VAR parameter}
            mov     es:[di],ax        {Store environment segment}
            mov     es,dx             {rest es}

            dec     ax                {MCB van env. is 1 paragraaf terug}
            mov     es,ax             {Get Size van env. uit MCB}
            mov     ax,es:[3]         {deze is in paragrafen}
            mov     cl,4              {en wordt geconverteerd}
            shl     ax,cl             {naar bytes..}

            les     di,EnvSizeP       {ptr van VAR parameter}
            mov     es:[di],ax        {Store environment size}
            cmp     ax,32768          {size moet <32k}
            jae     @SizeErr          {anders een foutmelding}
        end;
    {$endif}

        {Seperate Variable and return parameters}
        function StripEnvVariable(Variable:pchar):pchar;
        const stop='='#32#0;
        begin
          While pos(Variable^,stop)=0 do inc(Variable);
          StripEnvVariable:=Variable+1;
          Variable^:=#0;
        end;

        {like bp's getenv, this time removing spaces}
        function GetMainEnv(variable:string):string;
        var MainPtr,Params:pchar;
          data:array[0..512] of char;
        begin
          MainPtr:=ptr(MainEnvSeg,0);
          StrPCopy(@variable,variable);
          StrUpper(@variable);
          StripEnvVariable(@variable);

          if variable[0]<>#0 then begin
            while (MainPtr^<>#0) do begin
              StrCopy(Data,MainPtr);
              Params:=StripEnvVariable(data);
              if StrComp(Data,@Variable)=0 then begin
                GetMainEnv:=StrPas(Params);
                exit;
              end;
              MainPtr:=StrEnd(MainPtr)+1;
            end;
          end;
          GetMainEnv:='';
        end;

        {like bp's EnvCount}
        function MainEnvCount:integer;
        var MainPtr:pchar;
          index:integer;
        begin
          index:=0;
          MainPtr:=ptr(MainEnvSeg,0);
          while (MainPtr^<>#0) do begin
            MainPtr:=StrEnd(MainPtr)+1;
            inc(index);
          end;
          MainEnvCount:=index;
        end;

        {like bp's EnvStr}
        function MainEnvStr(index:integer):string;
        var MainPtr:pchar;
        begin
          MainPtr:=ptr(MainEnvSeg,0);
          while (MainPtr^<>#0) do begin
            dec(index);
            if index=0 then begin
              MainEnvStr:=StrPas(MainPtr);
              exit;
            end;
            MainPtr:=StrEnd(MainPtr)+1;
          end;
          MainEnvStr:='';
        end;

        {change environment "variable", returning succes}
        function MainEnvChange(variable:string; param:string):boolean;
        var data:array[0..512] of char;
          Mem,MainPtr,EnvPtr:pchar;
          NewSize:word absolute EnvPtr;
          EnvPtrLong:^Longint absolute EnvPtr;

          procedure EnvStrCopy(src:pchar);
          begin
            if NewSize+StrLen(src)<=MainEnvSize-4
            then begin
              StrCopy(EnvPtr,Src);
              EnvPtr:=StrEnd(EnvPtr)+1;
            end
            else MainEnvChange:=false;
          end;

          procedure PutVariable;
          begin
            if (Variable[0]<>#0) and (param[0]<>#0) then begin
              StrCopy(Data,@variable);
              StrCat(Data,'=');
              StrCat(Data,@param);
              EnvStrCopy(Data);
              variable[0]:=#0;
            end;
          end;

        begin
          getmem(Mem,MainEnvSize);
          MainPtr:=ptr(MainEnvSeg,0);
          EnvPtr:=Mem;

          StrPCopy(@variable,variable);
          StrUpper(@variable);
          StripEnvVariable(@variable);
          StrPCopy(@param,param);
          MainEnvChange:=variable[0]<>#0;

          while MainPtr^<>#0 do begin
            StrCopy(Data,MainPtr);
            StripEnvVariable(data);
            if StrComp(Data,@Variable)=0
            then PutVariable
            else EnvStrCopy(MainPtr);
            MainPtr:=StrEnd(MainPtr)+1;
          end;

          if variable[0]<>#0
          then PutVariable;

          EnvPtrLong^:=0; {4 terminating zero's}
          {1 byte terminating environment}
          {2 word counting trailing strings}
          {1 byte terminating the strings}
          {. last three disables paramstr(0)}
          move(Mem^,Ptr(MainEnvSeg,0)^,NewSize+4);
          freeMem(Mem,MainEnvSize);
        end;

    var oldprmp:string;
    begin
      GetMainEnvironment(MainEnvSeg,MainEnvSize);
      memw[prefixseg:$2c]:=MainEnvSeg;

      oldprmp:=GetMainEnv('fprompt');
      MainEnvChange('prompt','Please type EXIT!'#13#10+'$p$g');

      swapvectors;
      exec(GetMainEnv('comspec'),'');
      swapvectors;

      MainEnvChange('prompt',oldprmp);
    end.

[Back to DOS SWAG index] [Back to Main SWAG index] [Original]