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 / ENTERPRS / CPM / UTILS / A / ARC20.ARC / ARCMISC.INC < prev    next >
Text File  |  1989-11-22  |  6KB  |  181 lines
  1. (* ARCMISC.INC TR 221189 *)
  2.  
  3. const rmask : array[0..16] of integer
  4.             = ($0,$1,$3,$7,$F,$1F,$3F,$7F,$FF,
  5.                $1FF,$3FF,$7FF,$FFF,$1FFF,$3FFF,$7FFF,$FFFF);
  6.  
  7. (* Basisoperationen mit 32-Bit-Variablen (Longword) *)
  8.  
  9. procedure inc_long(var lw:longword);
  10. begin
  11.   inline($2A/LW/$06/$03/$34/$C0/$23/$10/$FB/$34);
  12.   end;
  13.  
  14. procedure dec_long(var lw:longword);
  15. begin
  16.   inline($2A/LW/$06/$03/$35/$7E/$3C/$C0/$23/$10/$F9/$35);
  17.   end;
  18.  
  19. procedure add_long(var lw1,lw2:longword);
  20. begin
  21.   inline($2A/LW1/$ED/$5B/LW2/$B7/$06/$04/$1A/$8E/$77/$23/$13/$10/$F9);
  22.   end;
  23.  
  24. procedure add_long_int(var lw:longword; n:integer);
  25. begin                  (* nur fuer positive N ! *)
  26.   inline($2A/LW/$ED/$5B/N/$7E/$83/$77/$23/$7E/$8A/$77/$D0/$23/$34/
  27.   $C0/$23/$34);
  28.   end;
  29.  
  30. (* Produkt aus Langwort und Byte zu Langwort addieren *)
  31.  
  32. procedure add_long_mult(var sum,lw:longword; m:byte);
  33. begin
  34.   inline($DD/$2A/SUM/$2A/LW/$5E/$23/$56/$23/$D5/$5E/$23/$56/$E1/$3A/M/
  35.   $CB/$3F/$30/$1E/$F5/$DD/$7E/$00/$85/$DD/$77/$00/$DD/$7E/$01/$8C/
  36.   $DD/$77/$01/$DD/$7E/$02/$8B/$DD/$77/$02/$DD/$7E/$03/$8A/$DD/$77/$03/
  37.   $F1/$C8/$CB/$25/$CB/$14/$CB/$13/$CB/$12/$18/$D3);
  38.   end;
  39.  
  40. (* Langwort um 0..+-31 Bit schieben (pos=links, neg=rechts) *)
  41.  
  42. procedure shift_long(var lw:longword; n:integer);
  43. begin
  44.   inline($DD/$2A/LW/$DD/$6E/$00/$DD/$66/$01/$DD/$5E/$02/$DD/$56/$03/
  45.   $ED/$4B/N/$78/$B1/$C8/$CB/$78/$20/$16/$04/$05/$20/$29/$79/$E6/$E0/
  46.   $20/$24/$41/$CB/$25/$CB/$14/$CB/$13/$CB/$12/$10/$F6/$18/$1D/$04/
  47.   $20/$14/$79/$ED/$44/$47/$E6/$E0/$20/$0C/$CB/$3A/$CB/$1B/$CB/$1C/
  48.   $CB/$1D/$10/$F6/$18/$06/$11/$00/$00/$21/$00/$00/$DD/$72/$03/$DD/$73/$02/
  49.   $DD/$74/$01/$DD/$75/$00);
  50.   end;
  51.  
  52. (* Langwort in REAL bzw. Integer wandeln *)
  53.  
  54. function long_to_real(var lw:longword):real;
  55. begin
  56.   inline($2A/LW/$5E/$23/$56/$23/$4E/$23/$46/$21/$00/$00/$78/$B1/$B2/
  57.   $B3/$C8/$2E/$A0/$CB/$78/$20/$0B/$CB/$23/$CB/$12/$CB/$11/$CB/$10/
  58.   $2D/$18/$F1/$CB/$B8/$C9);
  59.   end;
  60.  
  61. function long_to_integer(var lw:longword):integer;
  62. begin
  63.   inline($2A/LW/$5E/$23/$56/$CB/$7A/$20/$08/$23/$7E/$23/$B6/$20/$02/
  64.   $EB/$C9/$21/$FF/$7F/$C9);
  65.   end;
  66.  
  67. (* String von C- nach Pascal-Konvention wandeln *)
  68.  
  69. function pstring(st:filenam):filenam;
  70. begin
  71.   inline($21/ST/$06/$FF/$23/$04/$7E/$B7/$20/$FA/$78/$32/ST);
  72.   pstring:=st;
  73.   end;
  74.  
  75. (* Dateiname von String- in Array-Form wandeln *)
  76.  
  77. procedure astring(var st:filenam);
  78. var help : filenam;
  79. begin
  80.   inline($21/HELP/$06/$0B/$70/$23/$36/$20/$10/$FB/$2A/ST/$7E/$B7/$28/$37/
  81.   $47/$EB/$21/HELP/$23/$0E/$01/$13/$1A/$FE/$2E/$28/$11/$FE/$2A/$28/$16/
  82.   $FE/$61/$38/$02/$E6/$5F/$77/$23/$0C/$10/$EB/$18/$18/$79/$FE/$09/
  83.   $30/$F7/$23/$0C/$18/$F7/$36/$3F/$23/$0C/$79/$FE/$0C/$30/$EA/$FE/$09/
  84.   $28/$E6/$18/$F1/$21/HELP/$ED/$5B/ST/$01/$0C/$00/$ED/$B0);
  85.   end;
  86.  
  87. (* Dateinamen und Maske (beide String) auf Uebereinstimmung pruefen *)
  88.  
  89. function match(s,mask:filenam):boolean;
  90. begin
  91.   astring(s); astring(mask);
  92.   inline($21/S/$11/MASK/$06/$0B/$23/$13/$1A/$FE/$3F/$28/$03/$BE/$20/$02/
  93.   $10/$F4/$21/$00/$00/$C0/$2C/$C9);
  94.   end;
  95.  
  96. (* Extension an Dateinamen anfuegen *)
  97.  
  98. procedure makefnam(nam:filenam; ext:str4; var erg:filenam);
  99. var col : byte;
  100. begin
  101.   col:=pos('.',nam);
  102.   if col>0 then nam[0]:=chr(pred(col));
  103.   erg:=nam+ext;
  104.   end;
  105.  
  106. (* Integer-Wert hexadezimal ausgeben *)
  107.  
  108. procedure writehex(n:integer);
  109. begin
  110.   inline($CD/$04AF);
  111.   end;
  112.  
  113. (* Umrechnungen fuer verschiedene Datum- und Uhrzeitformate *)
  114.  
  115. var cpmdat  : array[0..4] of byte;   (* CP/M-Plus Format *)
  116.     datum   : array[0..2] of byte;   (* Tag,Monat,Jahr *)
  117.     uhrzeit : array[0..2] of byte;   (* Stunde,Minute,Sekunde *)
  118.  
  119. procedure cpm_date(var inarray,datout,timout); (* CP/M --> Binaer-Arrays *)
  120. begin
  121.   inline($DD/$2A/INARRAY/$FD/$2A/DATOUT/$DD/$6E/$00/$DD/$66/$01/$11/$6D/$01/
  122.   $06/$22/$3E/$4E/$CB/$00/$ED/$52/$38/$05/$28/$03/$3C/$18/$F5/$CB/$08/
  123.   $ED/$5A/$FD/$77/$02/$CB/$78/$11/*+58/$28/$03/$11/*+65/$3E/$01/$06/$00/
  124.   $EB/$4E/$23/$EB/$B7/$ED/$42/$38/$05/$28/$03/$3C/$18/$F2/$09/$FD/$77/$01/
  125.   $FD/$75/$00/$2A/TIMOUT/$06/$03/$DD/$56/$02/$7A/$E6/$0F/$5F/$7A/$93/
  126.   $0F/$0F/$82/$83/$1F/$77/$DD/$23/$23/$10/$EC/$C9/$1F/$1C/$1F/$1E/
  127.   $1F/$1E/$1F/$1F/$1E/$1F/$1E/$1F/$1F/$1D/$1F/$1E/$1F/$1E/$1F/$1F/
  128.   $1E/$1F/$1E/$1F);
  129.   end;
  130.  
  131. function calc_date(var dat):integer;           (* BinArray --> Wort-Datum *)
  132. begin
  133.   inline($ED/$5B/DAT/$13/$13/$1A/$D6/$50/$30/$01/$AF/$67/$1B/$1A/$E6/$0F/
  134.   $07/$07/$07/$07/$6F/$29/$1B/$1A/$E6/$1F/$B5/$6F/$C9);
  135.   end;
  136.  
  137. function calc_time(var zeit):integer;          (* BinArray --> Wort-Uhrzeit *)
  138. begin
  139.   inline($ED/$5B/ZEIT/$1A/$67/$13/$1A/$E6/$3F/$07/$07/$6F/$29/$29/
  140.   $29/$13/$1A/$0F/$E6/$1F/$B5/$6F/$C9);
  141.   end;
  142.  
  143. (* Datum und Uhrzeit ermitteln und in ARCDATE/ARCTIME ablegen *)
  144.  
  145. procedure get_global_datetime;
  146. var eingabe : filenam;
  147.  
  148.   procedure datestr(var output; default:byte);
  149.   begin
  150.     inline($AF/$11/EINGABE/$13/$2A/EINGABE/$67/$19/$77/$DD/$2A/OUTPUT/
  151.     $DD/$77/$00/$DD/$77/$01/$DD/$77/$02/$EB/$1E/$03/$0E/$00/$7E/$23/
  152.     $B7/$28/$19/$D6/$30/$FE/$0A/$30/$0A/$47/$79/$87/$87/$81/$87/$80/
  153.     $4F/$18/$EB/$DD/$71/$00/$DD/$23/$1D/$20/$E1/$C9/$DD/$71/$00/$2A/OUTPUT/
  154.     $7E/$B7/$C8/$ED/$4B/DEFAULT/$06/$03/$7E/$B7/$20/$01/$71/$23/$10/$F8);
  155.     end;
  156.  
  157. begin
  158.   if time then begin                            (* CP/M 3 *)
  159.     cpmdat[4]:=bdos(105,addr(cpmdat));
  160.     cpm_date(cpmdat,datum,uhrzeit);
  161.     end
  162.   else begin                                    (* CP/M 2 oder Switch T *)
  163.     write('Enter date (dd.mm.yy) : '); readln(eingabe);
  164.     datestr(datum,1);
  165.     if length(eingabe)>0 then begin
  166.       write('Enter time (hh:mm:ss) : '); readln(eingabe);
  167.       end;
  168.     datestr(uhrzeit,0);
  169.     end;
  170.   arcdate:=calc_date(datum);
  171.   arctime:=calc_time(uhrzeit);
  172.   end;
  173.  
  174. (* Meldung ueber unbearbeitete Parameter *)
  175.  
  176. procedure note_notfound;
  177. begin
  178.   if note then for gi:=1 to pcount do
  179.     if not did[gi] then writeln('File not found: ',arg[gi]);
  180.   end;
  181.