home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / PASCAL / PPAS80.LBR / ARGLIB.PQS / ARGLIB.PAS
Pascal/Delphi Source File  |  2000-06-30  |  5KB  |  124 lines
  1.  
  2.   (* ---------------------- begin argument module --------------------------- *)
  3.  
  4.   (* ArgLib.pas  11 October 84.              TURBO  PASCAL  version          *)
  5.  
  6.   (* Get arguments from CP/M or MS-DOS Command Line, using UNIX conventions. *)
  7.   (* Runs in 16-bit or 8-bit Turbo Pascal; must compile to disk (not memory) *)
  8.   (* Allows writing portable and/or UNIX-compatable programs on your micro.  *)
  9.   (* All compiler-dependencies are marked with the word "Turbo". *)
  10.  
  11.   (* CAUTION:  Under CP/M or MS-DOS, ALL argc and argv calls must be finished
  12.     before doing ANY file operations.  (Not required under UNIX.) *)
  13.   (* Most pascal systems will require this to be placed after the last variable
  14.     and before the first procedure of the main program. *)
  15.   (* Tradeoffs:  Execution speed sacrificed for compact code.  Standard Pascal
  16.     (ISO standard) used whenever possible (no 'string', etc.).     *)
  17.  
  18.   (* Example use: User calls program "cp" with two files:  CP FILEA FILEB
  19.    *
  20.    *  argc      -->   3
  21.    *  argv(1, ) --> 'FILEA           '
  22.    *  argv(2, ) --> 'FILEB           '
  23.    *
  24.    *   Note 1:  The last file is argc-1, not argc.  In the example,
  25.    *              argv(3, ) is undefined--returns all blanks.
  26.    *   Note 2:  Under UNIX, argv(0, ) would be 'CP', but  here it is blank.
  27.    *)
  28.   (* EXPORT:  ArgStrType, argc, argv, resetOK   *)
  29.  
  30.   (*   W. Kempton, Michigan State University *)
  31.  
  32. const
  33.   MaxArgStrLen = 16; (* maximum characters per argument *)
  34.  
  35. type 
  36.   ArgStrType = packed array [1..MaxArgStrLen] of char (* file name argument *);
  37.  
  38.  
  39.  
  40. procedure argv(     argn : integer;     (* requesting Nth argument *)
  41.                  var image : ArgStrType); (* returning its char image *)
  42. (* ARGument Value.   Valid argn for files are 1..(argc-1).  *)
  43. (* Note: argv(0, ) incorrectly returns blank; UNIX returns program name *)
  44.  
  45. const 
  46.   MaxCmdLineLength = 122; (* bug: 8-bit Turbo v1 & v2 chops to 31 chars *)
  47.  
  48. type 
  49.   CmdLineType = packed array [0..MaxCmdLineLength] of char;
  50. (* System command line. Zeroth position is size.*)
  51.   charset = set of char;
  52.  
  53. var 
  54.   i, nextch, Start, ArgLen, CmdLen : integer;
  55.   SYSdelim : charset; (* system file separators *)
  56.   CmdLine : CmdLineType
  57.       { 16-bit Turbo }    { absolute DSeg : $80 ; }
  58.       {  8-bit Turbo }      absolute        $80 ;
  59.  
  60. procedure skip (delims:charset);
  61. (* skip past (via advancing "nextch") either delimiters or arguments.  *)
  62. begin
  63.   while (CmdLine[nextch] in delims) and (nextch <= CmdLen) do
  64.     nextch := nextch + 1
  65. end (* skip *);
  66.  
  67. begin (* argv *)
  68.   CmdLen := ord(CmdLine[0]);  (* length of command line  *)
  69.   SYSdelim := 
  70. { CP/M   }    [' ',',',';','[',']','=','<','>' {,'/','_'} ];
  71. { MS-DOS } { [' ',',',';','[',']','=','<','>'  ]; } (* more?? *)
  72.   nextch := 1;
  73.   Start := 1;
  74.   for i := 1 to argn do
  75.     begin
  76.       skip(SYSdelim)    (* skip leading delimiters *);
  77.       Start := nextch   (* overwriting all but last value *);
  78.       skip([chr(0)..chr(127)]-SYSdelim) (* skip argument *);
  79. { Turbo bug prohibits [chr(0)..chr(255)]; thus 8-bit chars disallowed }
  80.     end;
  81.   ArgLen := nextch-Start;
  82. (* now use Start and ArgLen to set the string *)
  83.   if ArgLen > MaxArgStrLen
  84.     then ArgLen := MaxArgStrLen;
  85. (* image[0] := chr(ArgLen); *) (* only if string type *)
  86.   for i:= 1 to ArgLen do
  87.     image[i] := CmdLine[Start-1+i];
  88.   for i:= (ArgLen+1) to MaxArgStrLen do
  89.     image[i] := ' '; (* blank fill *)
  90. end (* argv *);
  91.  
  92.  
  93.   function argc : integer;
  94.     (* ARGument Count, the number of parameters on the command line. *)
  95.     (* This is slow, so call it just once and set an integer variable. *)
  96.  
  97.   var 
  98.     c: integer;
  99.     ArgStr: ArgStrType;
  100.    begin
  101.      c := 0;
  102.      repeat
  103.        c := c+1;
  104.        argv(c, ArgStr);
  105.      until (ArgStr[1] = ' ');
  106.      argc := c;
  107.    end (* argc *);
  108.  
  109.  
  110.   function resetOK (var f: text; name: ArgStrType) : boolean;
  111.     (* Associate name with file variable.  Return true if file is nonempty. *)
  112.     (* This parallels the Berkeley UNIX Pascal procedure:  reset(f, name).
  113.       This function is not needed for UNIX compatability, but allows keeping
  114.       this highly nonstandard Turbo garbage out of any programs. *)
  115.    begin
  116.      assign(f,name);   { Turbo, non-standard }
  117.     {$I-  Turbo: turn off I/O checks, or reset and eof() can cause crash. }
  118.      reset(f);
  119.      resetOK := (IOresult = 0);   { Turbo, non-standard }
  120.     {$I+  Turbo: restore I/O checks }
  121.    end (* resetOK *);
  122.  
  123.   (* ------------------------ end argument module ------------------------- *)
  124.