home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / TASKING.ZIP / GETPSP.MOD < prev    next >
Encoding:
Modula Implementation  |  1986-04-05  |  2.5 KB  |  97 lines
  1. IMPLEMENTATION MODULE GetPSP;
  2.  
  3.   FROM SYSTEM IMPORT
  4.     BYTE, ADDRESS, SWI, RTSVECTOR, SETREG, GETREG, AX, BX, CX;
  5.  
  6.   PROCEDURE getarg(argnum: argno; VAR arg: ARRAY OF CHAR);
  7.     (*
  8.        returns empty string for arg(numberOfArgs+1)
  9.        returns a program name for arg(0) (may be phoney)
  10.        args are delimited by blanks
  11.     *)
  12.     VAR
  13.       i, j, len, cmd: CARDINAL;
  14.     BEGIN
  15.       WITH PSPptr^ DO
  16.     len := ORD(commTail[0]);
  17.     i := 1;
  18.     (* skip leading blank(s) *)
  19.     WHILE (i <= len) & (commTail[i] = ' ') DO INC(i) END;
  20.     (* skip to requested arg *)
  21.     j := 0;
  22.     WHILE (i <= len) & (j < argnum) DO
  23.       WHILE (i <= len) & (commTail[i] # ' ') DO INC(i) END;
  24.       WHILE (i <= len) & (commTail[i] = ' ') DO INC(i) END;
  25.       INC(j);
  26.     END;
  27.     (* copy requested arg *)
  28.     j := 0;
  29.     WHILE (i <= len) & (commTail[i] # ' ') & (j <= HIGH(arg)) DO
  30.       arg[j] := commTail[i];
  31.       INC(j);
  32.       INC(i);
  33.     END;
  34.       END; (* with *)
  35.       IF j <= HIGH(arg) THEN arg[j] := 0C END;
  36.     END getarg;
  37.  
  38.   PROCEDURE getenv(key: ARRAY OF CHAR; VAR val: ARRAY OF CHAR);
  39.     VAR
  40.       i, j, cnt: CARDINAL;
  41.       found: BOOLEAN;
  42.       match: BOOLEAN;
  43.  
  44.     PROCEDURE toupper(ch: CHAR): CHAR;
  45.       BEGIN
  46.     IF (ch >= 'a') & (ch <= 'z') THEN
  47.       ch := CAP(ch);
  48.     END;
  49.     RETURN ch;
  50.       END toupper;
  51.  
  52.     BEGIN (* getenv *)
  53.       i := 0;
  54.       cnt := 0;
  55.       WHILE ENVIRptr^[cnt] # 0C DO (* while not last string *)
  56.     j := 0;
  57.     match := TRUE;
  58.     REPEAT
  59.       IF match THEN (* still matching ?*)
  60.         IF ((j > HIGH(key)) OR (key[j] = 0C)) THEN (* end of key string ? *)
  61.           IF ENVIRptr^[cnt] = '=' THEN (* end of env name ? *)
  62.             j := 0; (* copy env to result string *)
  63.             REPEAT
  64.           INC(cnt);
  65.           val[j] := ENVIRptr^[cnt];
  66.           INC(j);
  67.             UNTIL ENVIRptr^[cnt] = 0C;
  68.             RETURN; (* found *)
  69.           ELSE
  70.             match := FALSE;
  71.           END;
  72.         ELSE (* still comparing *)
  73.           match := toupper(key[j]) = ENVIRptr^[cnt];
  74.         END;
  75.         INC(j);
  76.       END; (* if match *)
  77.       INC(cnt);
  78.     UNTIL ENVIRptr^[cnt] = 0C; (* end of one env string *)
  79.     INC(cnt);
  80.       END; (* while *)
  81.       val[0] := 0C; (* no match *)
  82.     END getenv;
  83.  
  84.   VAR
  85.     tmpPtr: ADDRESS;
  86.  
  87.   BEGIN
  88.     SETREG(AX, 0026H); (* RTS(38) - get Program Segment Prefix Pointer *)
  89.     SWI(RTSVECTOR);   (* rts call *)
  90.     GETREG(BX, tmpPtr.OFFSET);
  91.     GETREG(CX, tmpPtr.SEGMENT);
  92.     PSPptr := tmpPtr;
  93.     tmpPtr.SEGMENT := PSPptr^.EnvironmentSeg;
  94.     tmpPtr.OFFSET := 0;
  95.     ENVIRptr := tmpPtr;
  96.   END GetPSP.
  97.