home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / jsage / zsus / progpack / tmsinst.lbr / M2Z3INS1.MOD < prev    next >
Encoding:
Text File  |  1992-05-13  |  10.1 KB  |  295 lines
  1. (***************************************************************)
  2. (* Copyright 1987 by Edward Jackson.  This program is released *)
  3. (* into the public domain and may be freely distributed by     *)
  4. (* others in commercial or non-comercial situations provided   *)
  5. (* proper credit is given to the author.               *)
  6. (*                                   *)
  7. (* M2Z3INS  version 1.                           *)
  8. (*                                   *)
  9. (* This program "installs" Turbo Modula2 programs which have   *)
  10. (* been linked into .COM files in a ZCPR3 environment, ZCPR3.3 *)
  11. (* environment, or CP/M environment.  This is accomplished by  *)
  12. (* patching the GetEnv procedure which MUST be included in the *)
  13. (* root segment of the TM2 .COM file.  A subsequent call to    *)
  14. (* this procedure will return the address of the resident      *)
  15. (* environment descriptor or, for CP/M, a NIL address and a    *)
  16. (* string of up to 16 characters.  The string is intended to   *)
  17. (* be used as a file name for TCAP information but can be used *)
  18. (* for any other purpose desired.                              *)
  19. (*                                                             *)
  20. (* In a ZCPR3 environment the address of the environment       *)
  21. (* descriptor is obtained from the *.ENV file that is peculiar *)
  22. (* to the target system.                                       *)
  23. (*                                                             *)
  24. (* In a ZCPR3.3 environment the address of the environment     *)
  25. (* descriptor is placed in register HL by the loader after     *)
  26. (* loading the .COM file.  The .COM file is patched by this    *)
  27. (* installation program so that register HL is saved in the    *)
  28. (* GetEnv procedure.                                           *)
  29. (*                                                             *)
  30. (* In a CP/M environment there is no environment descriptor    *)
  31. (* so this instalation program patches the environment des-    *)
  32. (* criptor address to NIL and the 16 char string to the value  *)
  33. (* specified at installation time.                             *)
  34. (*                                                             *)
  35. (* NOTES: Where an environment descriptor is available, the    *)
  36. (*        16 char string is empty.                             *)
  37. (*                                                 *)
  38. (*      Since many ZCPR systems place the environmen des-    *)
  39. (*      criptor at 0FE00h, this is used as the default       *)
  40. (*      value in GetEnv.                       *)
  41. (*                                   *)
  42. (* Special thanks to Steve Cohen for sugesting the basic       *)
  43. (* approach.                               *)
  44. (***************************************************************)
  45.  
  46. MODULE M2Z3INS1;
  47. FROM STORAGE     IMPORT ALLOCATE;
  48. FROM InOut       IMPORT WriteHex;
  49. FROM SYSTEM      IMPORT ADDRESS,
  50.                         FILL,
  51.                         ADR;
  52. FROM ComLine     IMPORT PromptFor;
  53. FROM Files       IMPORT FILE,
  54.                         ReadBytes,
  55.                         ReadByte,
  56.                         WriteBytes,
  57.                         WriteByte,
  58.                         SetPos,
  59.                         NextPos,
  60.                         Open,
  61.                         Close,
  62.                         EOF;
  63. FROM Strings     IMPORT Append,
  64.                         Pos,
  65.                         Length,
  66.                         CAPS,
  67.                         Delete;
  68. FROM Terminal    IMPORT ReadChar;
  69.  
  70. CONST Version = 1;  (* Version number *)
  71.  
  72. EXCEPTION FileErr;
  73. TYPE
  74.   SysType            = (CPM, Z3, Z33);
  75. VAR
  76.   EnvName, Tm2Name   : ARRAY [0..15] OF CHAR;
  77.   TCAPName           : ARRAY [0..15] OF CHAR;
  78.   Environment,
  79.   Tm2File            : FILE;
  80.   EnvAdr             : POINTER TO ADDRESS;
  81.   InstallType        : CHAR;
  82.   Nbytes, i          : CARDINAL;
  83.   TestStr, Target    : ARRAY [0..6] OF CHAR;
  84.   Switch             : SysType;
  85.   OK                 : BOOLEAN;
  86.   c                  : CHAR;
  87.   C                  : ARRAY [0..0] OF CHAR;
  88.   SwitchStr          : ARRAY [0..2] OF CHAR;
  89.   EnvAdrLoc,
  90.   JmpBackLoc,
  91.   TCAPFNLoc,
  92.   InstallTypeLoc     : LONGINT;
  93.   JmpToAdr,
  94.   JmpBackAdr         : POINTER TO CARDINAL;
  95.  
  96. BEGIN
  97. (* Sign on legend *)
  98.   FOR i := 1 TO 24  DO
  99.     WRITELN ();
  100.     END;
  101.   WRITELN ('                       TM2/ZCPR3 Installation Program');
  102.   WRITELN ('                Copyright 1987 by Edward Jackson, Gilroy, CA');
  103.   WRITELN ('                Released into the Public Domain by the Author');
  104.   WRITELN ();
  105.   WRITELN ('Version ', Version:1);
  106.   WRITELN ();
  107.   WRITELN
  108.   ('          Patches .COM files generated by Turbo Modula2 so that the');
  109.   WRITELN
  110.   ('          address of the resident environment descriptor is available');
  111.   WRITELN
  112.   ('          for use by the program in a ZCPR3 or ZCPR3.3 system.  For');
  113.   WRITELN
  114.   ('          CP/M systems, a 16 char file name is patched in for use as');
  115.   WRITELN
  116.   ('          desired.');
  117.   WRITELN ();
  118.   WRITELN ('          Press any key to continue... ');
  119.   WRITELN (); WRITELN (); WRITELN (); WRITELN ();
  120.   ReadChar (c);
  121.   
  122.   NEW (EnvAdr);
  123.   NEW (JmpToAdr);
  124.   NEW (JmpBackAdr);
  125.  
  126. (* Get target system type *)
  127.   PromptFor ("Patch for CP/M, ZCPR3 or ZCPR3.3? [C, 3 or 3.3] ", SwitchStr);
  128.   IF SwitchStr = "C" THEN
  129.     Switch := CPM;
  130.   ELSIF SwitchStr = "3" THEN
  131.     Switch := Z3;
  132.   ELSIF SwitchStr = "3.3" THEN
  133.     Switch := Z33;
  134.   ELSE
  135.     WRITELN ("Invalid system designation!");
  136.     HALT;
  137.   END;
  138.  
  139.   FILL (ADR (TCAPName), 16, 0);
  140.  
  141. (* get the arguments required for the target system type *)
  142.   IF Switch = Z3 THEN
  143.     PromptFor ("Enter name of Environment Descriptor File: ", EnvName);
  144.     PromptFor ('Enter name of TM2 "COM" file to be installed: ', Tm2Name);
  145.     CAPS (EnvName);
  146.   ELSIF Switch = CPM THEN
  147.     PromptFor ('Enter 16 character name of TCAP file: ', TCAPName);
  148.     CAPS (TCAPName);
  149.     PromptFor ('Enter name of TM2 "COM" file to be installed: ', Tm2Name);
  150.   ELSE
  151.     PromptFor ('Enter name of TM2 "COM" file to be installed: ', Tm2Name);
  152.     END;
  153.  
  154. (* do some error checking on the arguments *)
  155.   CAPS (Tm2Name);
  156.   IF Pos (".COM", Tm2Name) <> (Length (Tm2Name) - 4) THEN
  157.     WRITELN ('Can only install "COM" files.');
  158.     HALT;
  159.     END;
  160.  
  161.   IF Switch = Z3 THEN
  162.     OK := Open (Environment, EnvName);
  163.     IF NOT OK THEN
  164.       WRITELN ("Can't find environment file!");
  165.       HALT;
  166.       END;
  167.     END;
  168.  
  169.   OK := Open (Tm2File, Tm2Name);
  170.   IF NOT OK THEN
  171.     WRITELN ("Can't find TM2 file!");
  172.     HALT;
  173.     END;
  174.  
  175. (* Search for "Z3.3ENV" string in the .COM file *)
  176. (* It is embedded in the GetEnv procedure *)
  177.   SetPos (Tm2File, 7000L); (* start near end of TM2 Run Time routines *)
  178.   TestStr := '';
  179.   Target := 'Z3.3ENV';
  180.  
  181.   LOOP
  182.     IF EOF (Tm2File) THEN (* "Z3.3ENV" not found *)
  183.       WRITELN ("Can't install this program");
  184.       Close (Tm2File);
  185.       HALT;
  186.       END;
  187.  
  188. (* Read a char at a time and add to test string.  If test string length > 0 *)
  189. (* and a partial match is not found at front of string, discard the first   *)
  190. (* char in test string and continue.  EXIT Loop when test string =          *)
  191. (* "Z3.3ENV"  *)
  192.     ReadByte (Tm2File, c);
  193.     C [0] := c;
  194.     Append (C, TestStr);
  195.     WHILE (Length (TestStr) > 0) AND (Pos (TestStr, Target) <> 0) DO
  196.       Delete (TestStr, 0, 1);
  197.       END;
  198.     IF TestStr = Target THEN
  199.       EXIT;
  200.       END
  201.     END;
  202.  
  203. (* record important locations in Tm2File *)
  204.   EnvAdrLoc := NextPos (Tm2File);
  205.   JmpToAdr^ := CARD (EnvAdrLoc) + 19 + 256; (* corrected for load at 100h *)
  206.   JmpBackLoc := EnvAdrLoc + 23L;
  207.   InstallTypeLoc := EnvAdrLoc + 18L;
  208.   TCAPFNLoc := EnvAdrLoc + 2L;
  209.  
  210. (* save current jumpback address *)
  211.   SetPos (Tm2File, JmpBackLoc);
  212.   Nbytes := ReadBytes (Tm2File, JmpBackAdr, 2);
  213.   IF Nbytes <> 2 THEN
  214.     RAISE FileErr;
  215.   END;
  216.  
  217. (* Get current installation type (0 = CPM, 1 = ZCPR3, 2 = ZCPR3.3) *)
  218.   SetPos (Tm2File, InstallTypeLoc);
  219.   ReadByte (Tm2File, InstallType);
  220.  
  221.  
  222. (* If current install type ZCPR3.3 then must unpatch first *)
  223.   IF InstallType = 2C THEN
  224.     SetPos (Tm2File, 1L);
  225.     WriteBytes (Tm2File, JmpBackAdr, 2);
  226.     END;
  227.  
  228. (* Always set the TCAP File name buffer with nulls if target not CP/M *)
  229.   SetPos (Tm2File, TCAPFNLoc);
  230.   WriteBytes (Tm2File, ADR (TCAPName), 16);
  231.  
  232. (* If target is ZCPR3 Get Environment descriptor address from *.ENV file *)
  233.   IF Switch = Z3 THEN
  234.     SetPos (Environment, 27L);
  235.     Nbytes := ReadBytes (Environment, EnvAdr, 2);
  236.     Close (Environment);
  237.  
  238.     IF Nbytes <> 2 THEN
  239.       RAISE FileErr;
  240.     END;
  241.  
  242.     WRITE ('Environment Descriptor Address is: ');
  243.     WriteHex (CARDINAL (EnvAdr^), 0);
  244.     WRITELN ();
  245.  
  246. (* Patch the .COM file for target system = ZCPR3 *)
  247.     SetPos (Tm2File, EnvAdrLoc);
  248.     WriteBytes (Tm2File, EnvAdr, 2);
  249.     InstallType := CHR (ORD (Switch)); (* Mark as installed for ZCPR3 *)
  250.     SetPos (Tm2File, InstallTypeLoc);
  251.     WriteByte (Tm2File, InstallType);
  252.  
  253.   ELSIF Switch = CPM THEN
  254.     EnvAdr^ := 0;
  255.  
  256. (* Patch the .COM file for target system = CP/M *)
  257.     SetPos (Tm2File, EnvAdrLoc);
  258.     WriteBytes (Tm2File, EnvAdr, 2);
  259.     InstallType := CHR (ORD (Switch)); (* Mark as installed for CP/M *)
  260.     SetPos (Tm2File, InstallTypeLoc);
  261.     WriteByte (Tm2File, InstallType);
  262.  
  263.   ELSE
  264.  
  265. (* Patch the .COM file for target system = ZCPR3.3 *)
  266.     SetPos (Tm2File, 1L);
  267.     Nbytes := ReadBytes (Tm2File, JmpBackAdr, 2);
  268.     IF Nbytes <> 2 THEN
  269.       RAISE FileErr;
  270.     END;
  271.     SetPos (Tm2File, InstallTypeLoc); (* mark target system type *)
  272.     InstallType := CHR (ORD (Switch));
  273.     WriteByte (Tm2File, InstallType);
  274.     SetPos (Tm2File, 1L);
  275.     WriteBytes (Tm2File, JmpToAdr, 2); (* Patch to code that saves HL *)
  276.     SetPos (Tm2File, JmpBackLoc);
  277.     WriteBytes (Tm2File, JmpBackAdr, 2); (* Patch return Tm2 Init code *)
  278.     WRITELN ();
  279.     WRITELN (Tm2Name, ' is now patched so that the Environment Descriptor');
  280.     WRITELN ('will be saved inside the GetEnv procedure when the file is');
  281.     WRITELN ('loaded by ZCPR3.3');
  282.   END;
  283.  
  284.   Close (Tm2File);
  285.  
  286.   WRITELN ();
  287.   WRITELN ('Installation complete.');
  288.  
  289. EXCEPTION
  290.   | FileErr : Close (Tm2File);
  291.               WRITELN ('Error reading Tm2 file');
  292.               HALT;
  293.  
  294. END M2Z3INS1.
  295.