home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / program / m2posx02 / dossyste.ipp < prev    next >
Encoding:
Modula Implementation  |  1993-10-23  |  6.8 KB  |  298 lines
  1. IMPLEMENTATION MODULE DosSystem;
  2. (*__NO_CHECKS__*)
  3. (*****************************************************************************)
  4. (* 11-Feb-93, Holger Kleinschmidt                                            *)
  5. (* --------------------------------------------------------------------------*)
  6. (* STATUS: OK                                                                *)
  7. (*****************************************************************************)
  8.  
  9. VAL_INTRINSIC
  10. CAST_IMPORT
  11. OSCALL_IMPORT
  12.  
  13. FROM SYSTEM IMPORT
  14. (* TYPE *) ADDRESS,
  15. (* PROC *) ADR;
  16.  
  17. FROM types IMPORT
  18. (* CONST*) NULL,
  19. (* TYPE *) SIGNEDWORD, UNSIGNEDWORD, SIGNEDLONG, UNSIGNEDLONG;
  20.  
  21. #if LPRM2
  22. IMPORT GEMX;
  23. #elif SPCM2
  24. IMPORT GEMDOS;
  25. #elif MM2
  26. IMPORT PrgCtrl;
  27. #elif HM2
  28. IMPORT System;
  29. #elif TDIM2
  30. IMPORT GEMX;
  31. #elif FTLM2
  32. IMPORT LOADER;
  33. #endif
  34.  
  35. #include "oscalls.m2h"
  36.  
  37. #if HM2 || TDIM2 || MM2 || LPRM2 || SPCM2 || FTLM2
  38. #define JSRA0 4E90H/* jsr (a0) */
  39. #define CALLSHELL(_CMD,_SHELL)\
  40.  SETREG(0,_CMD);SETREG(8,_SHELL);CODE(PSHL,JSRA0,ADDQ4)
  41. #endif
  42.  
  43. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  44.  
  45. CONST
  46.   USER = LC(0);
  47.  
  48. TYPE
  49.   ULongPtr = POINTER TO UNSIGNEDLONG;
  50.  
  51. VAR
  52.   MiNT      : CARDINAL;
  53.   FLK       : BOOLEAN;
  54.   OS        : UNSIGNEDWORD;
  55.   OSP       : OsPtr;
  56.   BASEP     : BasePtr;
  57.   SHELL     : UNSIGNEDLONG;
  58.   STARTTIME : UNSIGNEDLONG;
  59.   ssp       : UNSIGNEDLONG;
  60.   state     : UNSIGNEDLONG;
  61.  
  62. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  63.  
  64. PROCEDURE GetOsHeader ((* -- /AUS *) VAR osp : ADDRESS );
  65. (*T*)
  66. BEGIN
  67.  osp := OSP;
  68. END GetOsHeader;
  69.  
  70. (*--------------------------------------------------------------------------*)
  71.  
  72. PROCEDURE GetBasePage ((* -- /AUS *) VAR basep : ADDRESS );
  73. (*T*)
  74. BEGIN
  75.  basep := BASEP;
  76. END GetBasePage;
  77.  
  78. (*--------------------------------------------------------------------------*)
  79.  
  80. PROCEDURE MiNTVersion ( ): CARDINAL;
  81. (*T*)
  82. BEGIN
  83.  RETURN(MiNT);
  84. END MiNTVersion;
  85.  
  86. (*---------------------------------------------------------------------------*)
  87.  
  88. PROCEDURE FileLocking ( ): BOOLEAN;
  89. (*T*)
  90. BEGIN
  91.  RETURN(FLK);
  92. END FileLocking;
  93.  
  94. (*---------------------------------------------------------------------------*)
  95.  
  96. PROCEDURE ProcessDomain ((* EIN/ -- *) dom : INTEGER ): INTEGER;
  97. (*T*)
  98. VAR res : SIGNEDWORD;
  99.  
  100. BEGIN
  101.  IF MiNT > 0 THEN
  102.    Pdomain(dom, res);
  103.    RETURN(INT(res));
  104.  ELSE
  105.    RETURN(0); (* TOS-Domain *)
  106.  END;
  107. END ProcessDomain;
  108.  
  109. (*---------------------------------------------------------------------------*)
  110.  
  111. PROCEDURE DosVersion ( ): CARDINAL;
  112. (*T*)
  113. BEGIN
  114.  RETURN(VAL(CARDINAL,OS));
  115. END DosVersion;
  116.  
  117. (*---------------------------------------------------------------------------*)
  118.  
  119. PROCEDURE ReadHz200 ( ): UNSIGNEDLONG;
  120. (*T*)
  121. VAR Hz200 : ULongPtr;
  122.     TIME  : UNSIGNEDLONG;
  123.  
  124. BEGIN
  125.  Hz200 := CAST(ULongPtr,VAL(UNSIGNEDLONG,4BAH));
  126.  Super(LC(1), state);
  127.  IF state = USER THEN
  128.    Super(LC(0), ssp);
  129.  END;
  130.  TIME := Hz200^;
  131.  IF state = USER THEN
  132.    Super(ssp, ssp);
  133.  END;
  134.  RETURN(TIME);
  135. END ReadHz200;
  136.  
  137. (*---------------------------------------------------------------------------*)
  138.  
  139. PROCEDURE SysClock ( ): UNSIGNEDLONG;
  140. (*T*)
  141. BEGIN
  142.  RETURN(ReadHz200() - STARTTIME);
  143. END SysClock;
  144.  
  145. (*---------------------------------------------------------------------------*)
  146.  
  147. PROCEDURE ShellInstalled ( ): Shell;
  148. (*T*)
  149. CONST GulamMAGIC = 00420135H;
  150.       XBRAID     = 58425241H; (* 'XBRA' *)
  151.       MasterID   = 4D415354H; (* 'MAST' *)
  152.       MupfelID   = 4D555046H; (* 'MUPF' *)
  153.       GeminiID   = 474D4E49H; (* 'GMNI' *)
  154.  
  155. TYPE xbraidp = POINTER TO ARRAY[0..1] OF UNSIGNEDLONG;
  156.      magicp  = ULongPtr;
  157.  
  158. VAR xbraid : xbraidp;
  159.     magic  : magicp;
  160.     val    : UNSIGNEDLONG;
  161.     ShellP : ULongPtr;
  162.  
  163. BEGIN
  164.  ShellP := CAST(ULongPtr,VAL(UNSIGNEDLONG,4F6H));
  165.  Super(LC(1), state);
  166.  IF state = USER THEN
  167.    Super(LC(0), ssp);
  168.  END;
  169.  SHELL := ShellP^;
  170.  IF state = USER THEN
  171.    Super(ssp, ssp);
  172.  END;
  173.  
  174.  IF SHELL = LC(0) THEN
  175.    RETURN(None);
  176.  END;
  177.  xbraid := CAST(xbraidp,SHELL - LC(12));
  178.  IF xbraid^[0] = XBRAID THEN
  179.    IF xbraid^[1] = MupfelID THEN
  180.      RETURN(Mupfel);
  181.    ELSIF xbraid^[1] = GeminiID  THEN
  182.      RETURN(Gemini);
  183.    ELSIF xbraid^[1] = MasterID THEN
  184.      RETURN(Master);
  185.    END;
  186.  END;
  187.  magic := CAST(magicp,SHELL - LC(10));
  188.  IF magic^ = GulamMAGIC THEN
  189.    RETURN(Gulam);
  190.  END;
  191.  RETURN(Unknown);
  192. END ShellInstalled;
  193.  
  194. (*---------------------------------------------------------------------------*)
  195.  
  196. PROCEDURE CallShell ((* EIN/ -- *) VAR cmd : ARRAY OF CHAR ): INTEGER;
  197. (*T*)
  198. VAR retCode : SIGNEDWORD;
  199.  
  200. BEGIN
  201.  cmd[HIGH(cmd)] := 0C;
  202.  IF ShellInstalled() = None THEN
  203.    RETURN(-1);
  204.  ELSE
  205.    CALLSHELL(ADR(cmd), SHELL);
  206.    GETSWREG(0,retCode);
  207.    RETURN(INT(retCode));
  208.  END;
  209. END CallShell;
  210.  
  211. (*===========================================================================*)
  212.  
  213. CONST
  214.   MiNTCk = 4D694E54H; (* "MiNT" *)
  215.   FLKCk  = 5F464C4BH; (* _FLK *)
  216.  
  217. TYPE
  218.   Cookie = RECORD
  219.     id  : UNSIGNEDLONG;
  220.     val : UNSIGNEDLONG;
  221.   END;
  222.  
  223.   CookieRange = [0..1000]; (* beliebig *)
  224.   CookiePtr   = POINTER TO ARRAY CookieRange OF Cookie;
  225.   CookiePPtr  = POINTER TO CookiePtr;
  226.  
  227. TYPE
  228.   OsPPtr = POINTER TO OsPtr;
  229.  
  230. VAR
  231.   Sysbase  : OsPPtr;
  232.   bptr     : BasePPtr;
  233.   res      : SIGNEDWORD;
  234.   vers     : UNSIGNEDLONG;
  235.   PCookies : CookiePPtr;
  236.   pcookie  : CookiePtr;
  237.   i        : CookieRange;
  238.  
  239. BEGIN (* DosSystem *)
  240.  STARTTIME := ReadHz200();
  241.  
  242.  Sysbase  := CAST(OsPPtr,VAL(UNSIGNEDLONG,4F2H));
  243.  PCookies := CAST(CookiePPtr,VAL(UNSIGNEDLONG,5A0H));
  244.  
  245.  Super(LC(1), state);
  246.  IF state = USER THEN Super(LC(0), ssp); END;
  247.    OSP     := Sysbase^;
  248.    OSP     := OSP^.osBeg;
  249.    pcookie := PCookies^;
  250.  IF state = USER THEN Super(ssp, ssp); END;
  251.  
  252. #if HM2
  253.   BASEP := BasePtr(System.BasePage);
  254. #elif LPRM2
  255.   BASEP := VAL(BasePtr,GEMX.BasePagePtr);
  256. #elif SPCM2
  257.   BASEP := VAL(BasePtr,GEMDOS.BasePagePtr);
  258. #elif MM2
  259.   PrgCtrl.GetBasePageAddr(BASEP);
  260. #elif TDIM2
  261.   BASEP := BasePtr(GEMX.BasePageAddress);
  262. #elif FTLM2
  263.   BASEP := BasePtr(LOADER.ProgPrefixAddress);
  264. #else
  265.   IF VAL(CARDINAL,OSP^.osEntry) >= 0102H THEN
  266.     bptr := OSP^.pRun; (* erst ab Blitter-TOS 1.02 *)
  267.   ELSIF CAST(UNSIGNEDWORD,OSP^.osConf) DIV 2 = 4 THEN
  268.     (* Spanisches TOS 1.0 *)
  269.     bptr := CAST(BasePPtr,VAL(UNSIGNEDLONG,873CH));
  270.   ELSE
  271.     bptr := CAST(BasePPtr,VAL(UNSIGNEDLONG,602CH));
  272.   END;
  273.   BASEP := bptr^;
  274. #endif
  275.  
  276.  MiNT := 0;
  277.  FLK  := FALSE;
  278.  IF pcookie <> NULL THEN
  279.    i := 0;
  280.    WHILE pcookie^[i].id <> LC(0) DO
  281.      WITH pcookie^[i] DO
  282.        IF id = MiNTCk THEN
  283.          Pdomain(1, res);
  284.          MiNT := VAL(CARDINAL,val);
  285.        ELSIF id = FLKCk THEN
  286.          FLK  := TRUE;
  287.        END;
  288.      END;
  289.      INC(i);
  290.    END;
  291.  END;
  292.  
  293.  Sversion(OS);
  294.  
  295.  PID  := INT((CAST(UNSIGNEDLONG,BASEP) DIV LC(256)) MOD LC(32768));
  296.  PPID := INT((CAST(UNSIGNEDLONG,BASEP^.pParent) DIV LC(256)) MOD LC(32768));
  297. END DosSystem.
  298.