home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / MODBASE.I < prev    next >
Encoding:
Modula Implementation  |  1995-04-11  |  25.3 KB  |  837 lines
  1. IMPLEMENTATION MODULE ModBase; (* V#236 *)
  2. (*$Y+,V+,P-,C+,R-*)
  3.  
  4. (*
  5.  * 11.10.87: Release erweitert: Setzt Init-Zustand bei Loaded-Mods zurück
  6.  * 15.04.88: CallEnvelopes: kein LinkOut, wenn INTEGER(level) negativ.
  7.  * 14.05.88: ModLoaded: Kann Namen > 8 Zeichen erkennen. Einzige Macke:
  8.  *           Moduldateinamen ohne Suffix sind nicht ladbar. Abhilfe:
  9.  *           Von SplitModName ausgehend muß der 'sfx' immer incl. dem
  10.  *           Punkt verwendet werden und AppendSfx darf in dem Fall
  11.  *           nix anhängen.
  12.  * 08.06.88: Body: Abfrage, ob Link-Daten vorhanden sind, sonst Abbruch.
  13.  * 10.06.88: Wenn keine Link-Daten, Terminate-Aufruf
  14.  * 28.08.88: Remove-Routine v. installiertem Modul wird nicht aufgerufen,
  15.  *           wenn dieses gelinkt ist.
  16.  * 30.09.88: CreateList mit Sys; DeleteList nur, wenn Prg nicht resident
  17.  * 21.10.88: Auch ModRefs werden bei Programmende freigegeben
  18.  * 25.10.88: termWsp-Stack von 2000 auf 1000 reduziert; CatchRemoval-Aufruf
  19.  *           und Removal-Info bei Release
  20.  * 05.11.88: Release nach Loader ausgelagert.
  21.  * 09.12.88: RemoveInfo-Aufruf verhindert erneuten ReleaseModule-Aufruf
  22.  * 21.12.88: FreeMod gibt bei Programmende (removal) auch geladene, gelinkte,
  23.  *           Programme vollständig frei.
  24.  * 05.06.89: FreeMod ruft nicht mehr DEALLOCATE für 'client^.codeAddr' auf, da
  25.  *           diese bei Modulen kein eigener Blockanfang ist.
  26.  * 04.07.89: Release / removal überarbeitet
  27.  * 27.07.89: Clear nun schnell
  28.  * 12.01.90: AppendSfx & SplitModName nicht mehr exportiert - ModLoaded
  29.  *           verbessert, sodaß nun hoffentlich Probleme mit Laden von
  30.  *           Modulen mit IMP-Suffix behoben sind
  31.  * 25.11.90: Envelopes mit level = -1 werden nun nie automatisch entfernt;
  32.  *           ModLoaded: Beim importierten Modulen wird der Filename nicht
  33.  *           mehr gesucht, sondern nur der echte Name.
  34.  * 04.02.92: 'prepare' erwartet p_bbase/p_dbase nicht mehr in A4/A5 sondern
  35.  *           holt sie nun auf offizielle Art aus der Base Page.
  36.  * 12.12.93: CreateBasePage: 'prgFlags'-Parm neu. Wird ab GEMDOS $19 benutzt.
  37.  * 11.04.95: ExecProcess: Caches werden geflushed. Ist nötig bei 68040 nach
  38.  *           Relozierung vom Loader.
  39.  *)
  40.  
  41. FROM SYSTEM IMPORT ASSEMBLER, ADR, WORD, ADDRESS, TSIZE, LONGWORD;
  42.  
  43. FROM Strings IMPORT Assign, Upper, StrEqual, Length, Append, Empty;
  44.  
  45. FROM Storage IMPORT SysAlloc, DEALLOCATE;
  46.  
  47. FROM MOSConfig IMPORT DftSfx, ImpSfx;
  48.  
  49. FROM MOSCtrl IMPORT PtrPDB, GetPDB, PushPDB, PopPDB, PDB, TermList, EnvList,
  50.   ProcessID, BaseResident, SetProcessState, EnvEntry,
  51.   ActPDB, EnvRoot, CallSub;
  52.  
  53. FROM SysTypes IMPORT PtrBP;
  54.  
  55. FROM ResCtrl IMPORT RemovalCarrier, CatchRemoval;
  56.  
  57. FROM PrgCtrl IMPORT TermCarrier, CatchProcessTerm, TermProcess;
  58.  
  59. FROM MOSGlobals IMPORT IllegalState, IllegalCall, MemArea, OutOfMemory,
  60.         OutOfStack;
  61.  
  62. FROM Lists IMPORT SysCreateList, ResetList, AppendEntry, RemoveEntry,
  63.   FindEntry, List, ScanEntries, CurrentEntry, NextEntry, DeleteList,
  64.   PrevEntry, LDir, LCarrier;
  65.  
  66. IMPORT SystemError;
  67.  
  68. IMPORT SysInfo;
  69.  
  70. FROM MOSSupport IMPORT ToSuper, ToUser;
  71.  
  72. FROM Block IMPORT Clear;
  73.  
  74. (*
  75.   FROM Terminal IMPORT WriteLn, WriteString, Read;
  76. *)
  77.  
  78. CONST Trace = FALSE;
  79.       Trace2 = FALSE;
  80.  
  81. (*$ ? Trace OR Trace2:
  82.   VAR inch: CHAR;
  83. *)
  84.  
  85. TYPE RemList = POINTER TO RemField;
  86.      RemField = RECORD
  87.                   Call : PROC;
  88.                   Next : RemList
  89.                 END;
  90.  
  91. VAR  error, ok: BOOLEAN;
  92.      termwsp: MemArea;
  93.      pro: ADDRESS;
  94.      LinkedModList: POINTER TO ARRAY [1..65000] OF ModEntry;
  95.      rCarrier: RemovalCarrier;
  96.      tCarrier: TermCarrier;
  97.  
  98.  
  99. PROCEDURE callSub2 ( subRoutine: PROC; v,w:WORD; VAR code:INTEGER; VAR wsp: MemArea );
  100.   (*$L-*)
  101.   BEGIN
  102.     ASSEMBLER
  103.         MOVEM.L D3/D4,-(A7)
  104.         MOVE.L  -(A3),A0                ; ^wsp
  105.         MOVE.L  -(A3),D4                ; ^code
  106.         MOVE.W  -(A3),D3                ; w
  107.         MOVE.W  -(A3),D1                ; v
  108.         MOVE.L  -(A3),A1                ; subRoutine
  109.         
  110.         MOVE.L  A3,-(A7)                ; A3 retten
  111.         MOVE.L  A7,A2                   ; alten SP laden zum Retten
  112.         
  113.         MOVE.L  MemArea.bottom(A0),D0   ; neuen SP-Bottom
  114.         BEQ     useOld                  ; alten SP verwenden
  115.         MOVE.L  MemArea.length(A0),D2
  116.         BEQ     useOld                  ; alten SP verwenden
  117.         
  118.         CMPI.L  #20,D2
  119.         BCS     noStack                 ; Stack zu klein
  120.         
  121.         ; neuen SP verwenden
  122.         MOVE.L  D0,A3
  123.         ADD.L   D2,D0
  124.         MOVE.L  D0,A7
  125.         
  126.       useOld
  127.         MOVE.L  A2,-(A7)                ; alten SP retten
  128.         
  129.         MOVE    D1,(A3)+
  130.         MOVE    D3,(A3)+
  131.         MOVE.L  D4,(A3)+
  132.         MOVE.L  D4,A0
  133.         CLR.W   (A0)
  134.         JSR     (A1)
  135.         
  136.         MOVE.L  (A7)+,A7
  137.       rtn0
  138.         MOVE.L  (A7)+,A3
  139.         MOVEM.L (A7)+,D3/D4
  140.         RTS
  141.         
  142.       noStack
  143.         TRAP    #6
  144.         DC.W    OutOfStack       ; out of stack space
  145.         MOVEQ   #OutOfStack,D0
  146.         BRA     rtn0
  147.     END
  148.   END callSub2;
  149.   (*$L+*)
  150.  
  151.  
  152. PROCEDURE SplitModName ( REF source: ARRAY OF CHAR;
  153.                          VAR name, sfx: ARRAY OF CHAR ): BOOLEAN;
  154.           (* -> TRUE: Name enthielt Path oder Suffix *)
  155.   (*$L-*)
  156.   BEGIN
  157.     ASSEMBLER
  158.         LINK    A5,#0
  159.         MOVEM.W D3/D4/D5,-(A7)
  160.         
  161.         MOVE    -(A3),D2
  162.         MOVE.L  -(A3),A2        ; ADR (sfx)
  163.         MOVE    -(A3),D1
  164.         MOVE.L  -(A3),A1        ; ADR (name)
  165.         MOVE    -(A3),D0
  166.         MOVE.L  -(A3),A0        ; ADR (source)
  167.         
  168.         MOVEQ   #1,D5
  169.         
  170.         MOVE.L  A0,(A3)+
  171.         MOVE.W  D0,(A3)+
  172.         MOVEM.L D0-D2/A0-A2,-(A7)
  173.         JSR     Length
  174.         MOVEM.L (A7)+,D0-D2/A0-A2
  175.         MOVE    -(A3),D3
  176.         BEQ     ende0
  177.       lupo:
  178.         MOVE.B  -1(A0,D3.W),D4
  179.         CMPI.B  #':',D4
  180.         BEQ     ende0
  181.         CMPI.B  #'\',D4
  182.         BEQ     ende0
  183.         SUBQ    #1,D3
  184.         BNE     lupo
  185.         MOVEQ   #0,D5           ; bisher kein Path o. Suffix
  186.       ende0:
  187.         
  188.         ADDQ    #1,D0
  189.         SUB     D3,D0
  190.         ADDA.W  D3,A0           ; A0 hinter Path
  191.         
  192.         ADDQ    #1,D1
  193.         
  194.         CMPI    #2,D2           ; HIGH (sfx)
  195.         BEQ     OK4
  196.         BHI     OK5
  197.         ADDQ    #1,D2
  198.         BRA     OK6
  199.       OK5:
  200.         CLR.B   3(A2)
  201.       OK4:
  202.         MOVEQ   #3,D2
  203.       OK6:
  204.         
  205.       L1:
  206.         SUBQ    #1,D0
  207.         BCS     EMPTY0
  208.         MOVE.B  (A0)+,D3
  209.         BEQ     EMPTY0
  210.         CMPI.B  #'.',D3
  211.         BEQ     POINT
  212.         SUBQ    #1,D1
  213.         BMI     L1
  214.         MOVE.B  D3,(A1)+        ; Name füllen
  215.         BRA     L1
  216.         
  217.       POINT:
  218.         MOVEQ   #1,D5           ; suffix im Namen enthalten
  219.         SUBQ    #1,D0
  220.         BCS     EMPTY0
  221.         MOVE.B  (A0)+,D3
  222.         BEQ     EMPTY0
  223.         SUBQ    #1,D2
  224.         BCS     EMPTY0
  225.         MOVE.B  D3,(A2)+
  226.         BRA     POINT
  227.         
  228.       EMPTY0:
  229.         TST     D1
  230.         BLE     EM1
  231.         CLR.B   (A1)
  232.       EM1:
  233.         TST     D2
  234.         BLE     EM2
  235.         CLR.B   (A2)
  236.       EM2:
  237.         
  238.         MOVE    D5,(A3)+
  239.         MOVEM.W (A7)+,D3/D4/D5
  240.         UNLK    A5
  241.     END
  242.   END SplitModName;
  243.   (*$L=*)
  244.  
  245. PROCEDURE ModLoaded (REF fname: ARRAY OF CHAR; import: BOOLEAN;
  246.                      VAR mname: ARRAY OF CHAR; VAR ref: ModRef): BOOLEAN;
  247.   (*
  248.    * Erkennt, ob 'fname' schon geladen ist.
  249.    * 'fname' kann entw. Modulname sein; dann darf aber kein Suffix dran sein.
  250.    * Sowas immer kommt vor, wenn importierte module nachgeladen werden und
  251.    * es kann vorkommen bei Call/Load/UnloadModule.
  252.    * Wenn 'fname' einen Suffix enthält, kann dies nur von Call/Load/UnloadModule
  253.    * kommen; dann wird angenommen, daß das Modul, falls es schon geladen ist,
  254.    * auch vorher schon unter diesem Namen geladen wurde - dann wird es unter
  255.    * seinem Dateinamen, aber ohne Suffix, gesucht.
  256.    * In 'mname' wird der echte Modulname geliefert, falls Modul
  257.    * gefunden, sonst der Dateiname, der zum Laden geeignet ist.
  258.    *)
  259.   VAR sfx: ARRAY [0..2] OF CHAR; search: SearchDesc;
  260.   BEGIN
  261.     IF NOT SplitModName (fname,mname,sfx) THEN
  262.                                       (* ...Modulname hat keinen Path/Suffix *)
  263.       (* Nach echtem Modnamen (case-less) suchen *)
  264.       search.mname:= ADR (mname);
  265.       search.mode:= modName;
  266.       GetModRef (search,ref);
  267.       IF ref # NIL THEN
  268.         Assign (ref^.codeName^, mname, ok); (* Name m. richtiger G/K-Schreibung *)
  269.         RETURN TRUE
  270.       END;
  271.     END;
  272.     (* bei Importen nicht noch extra nach Dateinamen suchen, weil
  273.      * dies 1. sowieso nicht vorkommen dürfte und 2. sonst ggf. beim
  274.      * Start von "MM2Shell" der Import "MM2ShellRsc" hier über die
  275.      * Filename-Suche "MM2SHELL" finden würde, was aber das Hauptmodul
  276.      * und nicht etwa das Rsc-Modul wäre (passiert bei ModLoad: Test,
  277.      * indem MM2Shell gestartet wird. Dann würde die Meldung kommen,
  278.      * daß der Key von "MM2Shell" beim import in "MM2Shell" nicht paßt. *)
  279.     IF NOT import THEN
  280.       (* 'mname' enthält nun Dateinamen ohne Path/Suffix *)
  281.       (* Nach Filename (ohne Suffix) suchen *)
  282.       IF HIGH (mname) >= 8 THEN mname [8]:= 0C END;
  283.       search.mode:= fileName;
  284.       search.fname:= ADR (mname);
  285.       GetModRef (search,ref);
  286.       IF ref # NIL THEN
  287.         (* Name des Moduls ermitteln *)
  288.         Assign (ref^.codeName^, mname, ok);
  289.         RETURN TRUE
  290.       END;
  291.     END;
  292.     (* Modul nicht geladen -> in 'mname' Dateinamen zum Laden liefern *)
  293.     IF mname[0] # 0C THEN
  294.       Assign (fname, mname, ok); (* Pfad mit übernehmen *)
  295.       IF sfx[0] = 0C THEN
  296.         (* wenn kein Suffix dran war, dann nun "MOD" bzw. "IMP" anhängen *)
  297.         Append ('.',mname,ok);
  298.         IF import THEN
  299.           Append (ImpSfx,mname,ok)
  300.         ELSE
  301.           Append (DftSfx,mname,ok)
  302.         END
  303.       END
  304.     END;
  305.     RETURN FALSE
  306.   END ModLoaded;
  307.  
  308.  
  309. PROCEDURE LinkOutEnvlp (p:EnvList);
  310.   BEGIN
  311.     ASSEMBLER
  312.         ; next^.prev:= prev;
  313.         ; prev^.next:= next
  314.         MOVE.L  p(A6),A0
  315.         MOVE.L  EnvEntry.next(A0),A1
  316.         MOVE.L  EnvEntry.prev(A0),A2
  317.         MOVE.L  A2,EnvEntry.prev(A1)
  318.         MOVE.L  A1,EnvEntry.next(A2)
  319.     END
  320.   END LinkOutEnvlp;
  321.  
  322. PROCEDURE CallEnvelopes (start:BOOLEAN;new:BOOLEAN):INTEGER;
  323.   VAR p, pn: EnvList; res: INTEGER;
  324.   BEGIN
  325.     IF start THEN
  326.       p:= EnvRoot.next;
  327.       WHILE p # ADR(EnvRoot) DO
  328.         WITH p^ DO
  329.           IF INTEGER (level) >= 0 THEN INC (level) END;
  330.           callSub2 (call,TRUE,new,res,wsp);
  331.           IF res#0 THEN RETURN res END;
  332.           p := next
  333.         END
  334.       END
  335.     ELSE
  336.       (*$? Trace2: WriteLn; WriteString ('CallEnv '); IF new THEN WriteString ('in') ELSE WriteString ('out') END; *)
  337.       p:= EnvRoot.prev;
  338.       WHILE p # ADR(EnvRoot) DO
  339.         WITH p^ DO
  340.           pn:= prev;
  341.           IF level = 0 THEN
  342.             (*$? Trace2: WriteLn; WriteString ('  LinkOut'); *)
  343.             (* Level der Anmeldung wird beendet *)
  344.             LinkOutEnvlp (p)
  345.           ELSE
  346.             (* das darf nicht gemacht werden, weil sonst ModLoad seine
  347.                Envelopes beim 2. Mal verliert:
  348.               IF level < 0 THEN
  349.                 IF ~new THEN level:= 0 END
  350.               ELSE...
  351.             *)
  352.             (*$? Trace2: WriteLn; WriteString ('  call...'); *)
  353.             (* Env.-Start war aufgerufen worden *)
  354.             callSub2 (call,FALSE,new,res,wsp);
  355.             IF INTEGER (level) > 0 THEN DEC (level) END;
  356.             IF res#0 THEN RETURN res END;
  357.           END;
  358.           p:= pn
  359.         END
  360.       END
  361.     END;
  362.     RETURN 0
  363.   END CallEnvelopes;
  364.  
  365. PROCEDURE MarkState ( client: ModRef; pen: ModState );
  366.   (*$L-*)(*!!! nicht mehr benzutzt:
  367.   VAR j: ModRef; n: CARDINAL;
  368.   BEGIN
  369.     IF client^.imports # NIL THEN
  370.       n:=0;
  371.       LOOP
  372.         j:= client^.imports^[n];
  373.         IF j=NIL THEN EXIT END;
  374.         IF ~(linked IN j^.state) & ~(pen IN j^.state) THEN
  375.           INCL (j^.state,pen);
  376.           MarkState (j,pen)
  377.         END;
  378.         INC (n)
  379.       END
  380.     END
  381.   *)
  382.   (*$L+*)END MarkState;
  383.  
  384.  
  385. PROCEDURE FreeMod (VAR client: ModRef);
  386.   VAR bp: PtrBP;
  387.   BEGIN
  388.     IF client # NIL THEN
  389.       IF program IN client^.state THEN
  390.         DEALLOCATE (client^.varRef,0);  (* Data-Save-Bereich freigeben *)
  391.         bp:= client^.codeStart;
  392.         DEALLOCATE (bp^.p_env,0); (* Environment freigeben *)
  393.         DEALLOCATE (bp,0);        (* TPA / Prg. *)
  394.         DEALLOCATE (client,0L)
  395.       ELSIF NOT (linked IN client^.state) THEN
  396.         (*!!!ist unnötig DEALLOCATE (client^.codeAddr,0L); *)
  397.         DEALLOCATE (client,0L) (* Zuletzt ! Sonst ist Importliste weg *)
  398.       END
  399.     END
  400.   END FreeMod;
  401.  
  402.  
  403. PROCEDURE SimpleRelease (VAR client: ModRef; unload, deinstall: BOOLEAN);
  404.   BEGIN
  405.     ASSEMBLER
  406.         TRAP    #6
  407.         DC.W    IllegalState    ; darf nur noch in Loader aufgerufen werden!
  408.     END
  409.   END SimpleRelease;
  410.  
  411.  
  412. PROCEDURE FindRef ( ad: ADDRESS; VAR ref: ModRef );
  413.   VAR s:SearchDesc;
  414.   BEGIN
  415.     s.mode:= codeAddr;
  416.     s.addr:= ad;
  417.     GetModRef (s,ref)
  418.   END FindRef;
  419.  
  420.  
  421. (*
  422. PROCEDURE IllCall (s:ARRAY OF CHAR);
  423.   (*$L-*)
  424.   BEGIN
  425.     ASSEMBLER
  426.         MOVE    -(A3),D0
  427.         MOVE.L  -(A3),A0
  428.         BRA     c
  429.         
  430.       m ACZ     'ModCtrl'
  431.       n ACZ     'Illegal call'
  432.       o
  433.       c LEA     m(PC),A1
  434.         MOVE.L  A1,(A3)+
  435.         MOVE    #n-m-1,(A3)+
  436.         MOVE.L  A0,(A3)+
  437.         MOVE    D0,(A3)+
  438.         LEA     n(PC),A1
  439.         MOVE.L  A1,(A3)+
  440.         MOVE    #o-n-1,(A3)+
  441.         JSR     SystemError
  442.     END;
  443.   END;
  444.   (*$L+*)
  445. *)
  446.  
  447. (*
  448.         Criterion = ( modName,     (* Suche nach Modulname *)
  449.                       codeAddr,    (* Suche bez. einer Code-Adresse *)
  450.                       varAddr,     (* Suche bez. Adr. einer globalen Variablen *)
  451.                       user,        (* Suche nach allen, die "ref" importieren *)
  452.                       loadedMod ); (* Suche nach 'geladenen' Moduln *)
  453.  
  454.         SearchInfo = RECORD
  455.                        CASE mode: Criterion OF
  456.                           modName:            name: POINTER TO ModStr|
  457.                           codeAddr, varAddr:  addr: ADDRESS|
  458.                           user:               uCnt: ADDRESS;
  459.                                               ref : ModRef|
  460.                           loadedMod:          lCnt: ADDRESS
  461.                         END
  462.                       END;
  463. *)
  464.  
  465. PROCEDURE Imported (mod0, main: ModRef): BOOLEAN;
  466.   VAR r:ModRef; i:CARDINAL;
  467.   BEGIN
  468.     i:=0;
  469.     IF main^.imports=NIL THEN RETURN FALSE END;
  470.     LOOP
  471.       r:= main^.imports^[i];
  472.       IF r=NIL THEN RETURN FALSE END;
  473.       IF r=mod0 THEN RETURN TRUE END;
  474.       INC (i)
  475.     END
  476.   END Imported;
  477.  
  478.  
  479. VAR what: POINTER TO SearchDesc; entry: ModRef;
  480.  
  481. PROCEDURE scanMod (e, w:ADDRESS): BOOLEAN;
  482.   (*$L-*)
  483.   BEGIN
  484.     ASSEMBLER
  485.         MOVE.L  -(A3),A2        ; what
  486.         MOVE.L  -(A3),A1        ; entry
  487.         CMPI    #modName,SearchDesc.mode(A2)
  488.         BNE     notName
  489.         ; modul-name prüfen
  490.         MOVE.L  SearchDesc.mname(A2),A0
  491.         MOVE.B  (A0),D0
  492.         CMP.B   ModRef.codeNameUp(A1),D0
  493.         BNE     false
  494.         MOVE.L  A0,(A3)+
  495.         MOVE    #39,(A3)+
  496.         LEA     ModRef.codeNameUp(A1),A0
  497.         MOVE.L  A0,(A3)+
  498.         MOVE    #39,(A3)+
  499.         JMP     StrEqual
  500.       notName
  501.         CMPI    #fileName,SearchDesc.mode(A2)
  502.         BNE     notFile
  503.         ; file-name prüfen
  504.         MOVE.L  SearchDesc.fname(A2),A0
  505.         MOVE.B  (A0),D0
  506.         CMP.B   ModRef.fileName(A1),D0
  507.         BNE     false
  508.         MOVE.L  A0,(A3)+
  509.         MOVE    #7,(A3)+
  510.         LEA     ModRef.fileName(A1),A0
  511.         MOVE.L  A0,(A3)+
  512.         MOVE    #7,(A3)+
  513.         JMP     StrEqual
  514.       false
  515.         CLR     (A3)+
  516.         RTS
  517.       notFile
  518.         MOVE.L  A2,what
  519.         MOVE.L  A1,entry
  520.     END;
  521.     CASE what^.mode OF
  522.       (* modName:  RETURN StrEqual (entry^.codeNameUp,what^.mname^)| *)
  523.       (* fileName: RETURN StrEqual (entry^.fileName,what^.fname^)| *)
  524.       codeAddr: ok:=  (what^.addr >= entry^.codeStart)
  525.                     & (what^.addr < entry^.codeStart + entry^.codeLen)|
  526.       varAddr:  ok:=  (what^.addr >= entry^.varRef)
  527.                     & (what^.addr < entry^.varRef + entry^.varLen)|
  528.       user: ok:= Imported (what^.ref,entry)|
  529.       loadedMod: ok:= loaded IN entry^.state
  530.     END;
  531.     ASSEMBLER
  532.         MOVE    ok,(A3)+
  533.     END
  534.   END scanMod;
  535.   (*$L=*)
  536.  
  537. PROCEDURE GetModRef ( VAR what: SearchDesc; VAR ref: ModRef );
  538.   VAR cnt:BOOLEAN; l:List; s:ModStr;
  539.   BEGIN
  540.     cnt:= FALSE;
  541.     l:= ModLst;
  542.     ResetList (l);
  543.     IF (what.mode = user) OR (what.mode = loadedMod) THEN
  544.       cnt:= TRUE;
  545.       IF what.uCnt # NIL THEN
  546.         l.current:= LCarrier (what.uCnt)
  547.       END
  548.     ELSIF (what.mode = modName) OR (what.mode = fileName) THEN
  549.       IF (what.mode = fileName) THEN
  550.         Assign (what.fname^,s,ok)
  551.       ELSE
  552.         Assign (what.mname^,s,ok)
  553.       END;
  554.       Upper (s);
  555.       IF s[0] = 0C THEN
  556.         ref:= NIL;
  557.         RETURN
  558.       END;
  559.       what.mname:= ADR(s)
  560.     END;
  561.     ScanEntries (l, forward, scanMod, ADR (what), ok);
  562.     IF cnt THEN what.uCnt:= ADDRESS (l.current) END;
  563.     ref:= CurrentEntry (l)
  564.   END GetModRef;
  565.  
  566.  
  567. PROCEDURE pexec ( mode: CARDINAL; path, com: LONGWORD ): LONGINT;
  568.   (*$L-*)
  569.   BEGIN
  570.     ASSEMBLER
  571.         CLR.L   -(A7)           ; env
  572.         MOVE.L  -(A3),-(A7)     ; com
  573.         MOVE.L  -(A3),-(A7)     ; path / prgflags
  574.         MOVE.W  -(A3),-(A7)     ; mode
  575.         MOVE    #$4B,-(A7)
  576.         TRAP    #1
  577.         ADDA.W  #16,A7
  578.         MOVE.L  D0,(A3)+
  579.     END
  580.   END pexec;
  581.   (*$L=*)
  582.  
  583. PROCEDURE prepare;
  584.   (*$L-*)
  585.   CONST tpa_hi = 4;
  586.         datastart = 16;
  587.         bssstart  = 24;
  588.   BEGIN
  589.     ASSEMBLER
  590.         MOVE.L  4(A7),A4                ; A4: base page
  591.         MOVE.L  datastart(A4),A5        ; p_dbase = ADDRESS (call)
  592.         MOVE.L  bssstart(A4),A3         ; p_bbase = workSpace.bottom
  593.         
  594.         MOVE.L  #tCarrier,(A3)+
  595.         LEA     termLocal(PC),A0
  596.         MOVE.L  A0,(A3)+
  597.         LEA     termwsp,A0
  598.         MOVE.L  (A0)+,(A3)+
  599.         MOVE.L  (A0),(A3)+
  600.         JSR     CatchProcessTerm
  601.         
  602.         MOVE    #1,(A3)+
  603.         JSR     SetProcessState
  604.         
  605.         MOVE    #1,(A3)+
  606.         MOVE    #1,(A3)+
  607.         JSR     CallEnvelopes
  608.         MOVE    -(A3),D0
  609.         BNE     err2
  610.         
  611.         MOVE    #2,(A3)+
  612.         JSR     SetProcessState
  613.         
  614.         JSR     (A5)    ; p_dbase
  615.         
  616.         CLR     (A3)+
  617.         JMP     TermProcess
  618.       err
  619.         MOVEQ   #OutOfMemory,D0
  620.       err2
  621.         MOVE    D0,(A3)+
  622.         JMP     TermProcess
  623.         
  624.       termLocal
  625.         CLR     (A3)+
  626.         MOVE    #1,(A3)+
  627.         JSR     CallEnvelopes
  628.         MOVE    -(A3),D0
  629.         BNE     err2            ; rekursiver TermProcess-Aufruf
  630.     END
  631.   END prepare;
  632.   (*$L=*)
  633.  
  634. PROCEDURE Mshrink (addr: ADDRESS; newAmount: LONGCARD): INTEGER;
  635.   (*$L-*)
  636.   BEGIN
  637.     ASSEMBLER
  638.         MOVE.L  -(A3),-(A7)
  639.         MOVE.L  -(A3),-(A7)
  640.         CLR.W   -(A7)
  641.         MOVE    #$4A,-(A7)
  642.         TRAP    #1
  643.         ADDA.W  #12,A7
  644.         MOVE.W  D0,(A3)+
  645.     END
  646.   END Mshrink;
  647.   (*$L=*)
  648.  
  649. PROCEDURE Mfree (addr: ADDRESS);
  650.   (*$L-*)
  651.   BEGIN
  652.     ASSEMBLER
  653.         MOVE.L  -(A3),-(A7)
  654.         MOVE    #$49,-(A7)
  655.         TRAP    #1
  656.         ADDQ.L  #6,A7
  657.     END
  658.   END Mfree;
  659.   (*$L=*)
  660.  
  661. PROCEDURE CreateBasePage (VAR bp: PtrBP; stacksize: LONGCARD;
  662.                           name: ADDRESS; prgFlags: LONGWORD): BOOLEAN;
  663.   VAR noStr: CHAR; n, vers: CARDINAL;
  664.   BEGIN
  665.     IF stacksize = 0 THEN
  666.       stacksize:= 64;  (* wg. MiNT 0.92 *)
  667.     END;
  668.     noStr:= 0C;
  669.     bp:= PtrBP (pexec (7, prgFlags, ADR (noStr)));
  670.     IF LONGINT (bp) = -32 THEN
  671.       bp:= PtrBP (pexec (5, name, ADR (noStr)));
  672.     END;
  673.     IF LONGINT (bp)>0L THEN
  674.       IF Mshrink (bp, 256 + stacksize) >= 0 THEN
  675.         WITH bp^ DO
  676.           p_lowtpa:= ADDRESS(bp)+256; (* Ist nur wg. MiNT nötig *)
  677.           p_hitpa:= p_lowtpa+stacksize; (* hitpa stand am Ende vor Mshrink *)
  678.           Clear (p_lowtpa, stacksize)
  679.         END;
  680.         RETURN TRUE
  681.       ELSE
  682.         Mfree (bp^.p_env);
  683.         Mfree (bp)
  684.       END;
  685.     END;
  686.     RETURN FALSE
  687.   END CreateBasePage;
  688.  
  689. (*$X+*)
  690. PROCEDURE FlushCPUCache ();
  691.   BEGIN
  692.     ASSEMBLER
  693.         JSR     SysInfo.CPU
  694.         SUBQ.L  #4,A7
  695.         JSR     ToSuper
  696.         MOVE.L  -(A3),D0
  697.         CMPI.L  #68020,D0
  698.         BCS     ende
  699.         CMPI.L  #68040,D0
  700.         BCS     fl30
  701.         NOP
  702.         DC.W    $F4F8           ; CPUSHA BC
  703.         BRA     ende
  704.   fl30: MOVEC   CACR,D0
  705.         ORI     #$0808,D0
  706.         MOVEC   D0,CACR
  707.   ende: JSR     ToUser
  708.         ADDQ.L  #4,A7
  709.     END
  710.   END FlushCPUCache;
  711. (*$X=*)
  712.  
  713. PROCEDURE ExecProcess (bp: PtrBP; call: PROC; name: ADDRESS; prgFlags: LONGWORD;
  714.                        VAR termState: CARDINAL; VAR exitCode: INTEGER);
  715.   VAR pdb0: PDB; ec: INTEGER; oldCarrier: TermCarrier;
  716.   BEGIN
  717.     WITH bp^ DO
  718.       p_tbase := ADDRESS (prepare);
  719.       p_tlen  := 0L;
  720.       p_dbase := ADDRESS (call);
  721.       p_dlen  := 0L;
  722.       p_bbase := p_lowtpa;
  723.       p_blen  := p_hitpa - p_lowtpa;
  724.       p_parent:= ProcessID^;
  725.     END;
  726.     FlushCPUCache ();
  727.     (*$ ? Trace: WriteLn; WriteString ('CallEnvelopes (TRUE,FALSE)'); *)
  728.     exitCode:= CallEnvelopes (TRUE,FALSE);
  729.     IF exitCode # 0 THEN
  730.       termState:= 0;
  731.     ELSE
  732.       Clear (ADR (pdb0), SIZE (pdb0));
  733.       pdb0.layout:= ActPDB^.layout;
  734.       pdb0.basePageAddr:= bp;
  735.       pdb0.bottomOfStack:= LONGWORD (bp^.p_lowtpa);
  736.       pdb0.topOfStack:= LONGWORD (bp^.p_hitpa);
  737.       oldCarrier:= tCarrier;
  738.       PushPDB (ADR (pdb0), bp);
  739.       (*$R-*)
  740.       (*$ ? Trace: WriteLn; WriteString ('pexec (4,name,bp)'); *)
  741.       exitCode:= SHORT (pexec (4, name, bp));
  742.       (*$R=*)
  743.       tCarrier:= oldCarrier;
  744.       termState:= pdb0.termState; (* 1..3 *)
  745.       PopPDB
  746.     END;
  747.     (*$ ? Trace: WriteLn; WriteString ('CallEnvelopes (FALSE,FALSE)'); *)
  748.     ec:= CallEnvelopes (FALSE,FALSE);
  749.     IF (termState=2) & (ec#0) THEN exitCode:= ec END;
  750.   END ExecProcess;
  751.  
  752.  
  753. PROCEDURE removal;
  754.   VAR i:ModRef;
  755.   BEGIN
  756.     ResetList (ModLst);
  757.     LOOP
  758.       i:= PrevEntry (ModLst);
  759.       IF i=NIL THEN EXIT END;
  760.       IF installed IN i^.state THEN
  761.         EXCL (i^.state,installed); (* Falls ReleaseModule aufger. wird *)
  762.         (*
  763.          * Module, die sich mit ReleaseModule installiert haben,
  764.          * über ihre zwangsweise Freigabe informieren:
  765.          *)
  766.         CallSub (i^.removeInfo,i^.removeWsp);
  767.       END
  768.     END;
  769.     ResetList (ModLst);
  770.     i:= PrevEntry (ModLst);
  771.     REPEAT
  772.       i:= CurrentEntry (ModLst);
  773.       FreeMod (i);
  774.       RemoveEntry (ModLst,error)  (* Alle Entries löschen *)
  775.     UNTIL error;
  776.     DEALLOCATE (LinkedModList,0L);
  777.     DeleteList (ModLst,error)     (* Nun Liste freigeben *)
  778.   END removal;
  779.  
  780. VAR pdbp : PtrPDB;
  781.     i: CARDINAL;
  782.     siz: LONGCARD;
  783.     pl: POINTER TO LONGCARD;
  784.  
  785. BEGIN (* ModBase *)
  786.   CatchRemoval (rCarrier,removal,termwsp);
  787.   Release:= SimpleRelease;
  788.   SysCreateList (ModLst,error);
  789.   IF error THEN SystemError.OutOfMemory END;
  790.   GetPDB (pdbp,pro);
  791.   IF pdbp^.modNo > 0 THEN
  792.     (* Modlst der residenten Moduln erstellen *)
  793.     siz:= TSIZE (ModEntry) * LONG (pdbp^.modNo);
  794.     SysAlloc (LinkedModList,siz);
  795.     IF LinkedModList=NIL THEN SystemError.OutOfMemory END;
  796.     Clear (LinkedModList,siz);
  797.     ResetList (ModLst);
  798.     FOR i:=1 TO pdbp^.modNo DO
  799.       AppendEntry(ModLst, ADR (LinkedModList^[i]),error);
  800.       IF error THEN SystemError.OutOfMemory END;
  801.       WITH pdbp^.modLst^ [i] DO
  802.         WITH LinkedModList^[i] DO
  803.           header:= head0;
  804.           varRef:= var0;
  805.           varLen:= varlen0;
  806.           codeName:= ADDRESS (header) + header^.codeName;
  807.           codeNameUp:= codeName^;
  808.           Upper (codeNameUp);
  809.           Assign (codeNameUp, fileName, ok);
  810.           codeStart:= ADDRESS (header) + header^.codeStart;
  811.           codeLen:= header^.modEnd - header^.codeStart;
  812.           state:= ModStates {initialized,linked,running};
  813.           IF 0 IN flags THEN INCL (state, procSym) END;
  814.           IF 1 IN flags THEN INCL (state, crunched) END;
  815.           IF NOT (2 IN flags) THEN INCL (state, reentrant) END;
  816.           IF 3 IN flags THEN INCL (state, mainMod) END;
  817.           (*
  818.            * Importliste aufbauen:
  819.            * Vom Linker wurden die Index-Nummern übergeben, nun werden sie
  820.            * in ModRef-Ptr umgewandelt.
  821.            *)
  822.           IF header^.importList # 0 THEN
  823.             imports:= ADDRESS (header) + header^.importList;
  824.             pl:= ADDRESS (imports);
  825.             WHILE pl^ # 0 DO
  826.               pl^:= ADR (LinkedModList^[SHORT(pl^)]);
  827.               INC (pl, 4)
  828.             END;
  829.           END;
  830.         END
  831.       END
  832.     END
  833.   END
  834. END ModBase.
  835. ə
  836. (* $FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$00000C37$FFAD4838$000062B6$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838Ç$00000000T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838$FFAD4838ÇÇü*)
  837.