home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / modula / process.mod < prev    next >
Encoding:
Modula Implementation  |  1993-10-23  |  13.7 KB  |  345 lines
  1. IMPLEMENTATION MODULE Process[7];
  2.  
  3.   FROM SYSTEM IMPORT
  4.     ADDRESS, WORD, BYTE, REG, SETREG, ADR, TSIZE, VAL, INLINE;
  5. (*FROM InOut IMPORT
  6.     WriteString, WriteLn, WriteLongHex, Read;
  7.  *)
  8.  
  9.   CONST
  10.     ModuleBase   = 12;
  11.     ProcessBase  = 13;
  12.     FramPointer  = 14;
  13.     StackPointer = 15;
  14.  
  15.  
  16.   CONST
  17.     InitialStatus    = M68000StatusRegister{sbIntMask0, sbIntMask1};
  18.  (* Special for ATARI: all Processes are running on Interrupt Level 3 *) 
  19.     MinimumStackSize = 256; (* ??? *)
  20.  
  21.   TYPE
  22.     InitialStack =
  23.       RECORD
  24.         Context           : M68000Context;
  25.         SavedReturnPC     : PROC;
  26.       END; (* InitialStack *)
  27.  
  28.   PROCEDURE LISTEN;
  29.   (*
  30.   LISTEN:       move.w  sr,d0
  31.                 trap    #11             * switch to supervisormode
  32.                 move.w  #$0300,sr       * interrupt allowed, usermode
  33.                 nop
  34.                 nop
  35.                 trap    #11
  36.                 move.w  d0,sr           * restore old SR
  37.   *)
  38.   BEGIN
  39.     INLINE( 040C0H,04E4BH,046FCH,00300H,04E71H,04E71H,04E4BH,046C0H );
  40.   END LISTEN;
  41.  
  42.   PROCEDURE CoRoutineEnd();
  43.   BEGIN
  44.     (* This Procedure is never called directly. An illegally terminating
  45.        process will enter this procedure loading a return address from its
  46.        stack, which has been saved there by NEWPROCESS
  47.      *)
  48.     IF MainPROCESSPtr <> NIL THEN
  49.       TRANSFER( ErrorPROCESS, MainPROCESSPtr^ );
  50.     ELSE HALT; END;
  51.   END CoRoutineEnd;
  52.  
  53.  
  54.   PROCEDURE NEWPROCESS (ProcessCode   : PROC;
  55.                         WorkSpaceBase : ADDRESS;
  56.                         WorkSpaceSize : LONGCARD;
  57.                     VAR ProcessDesc   : PROCESS   );
  58.     TYPE
  59.       InitialStackPointer = POINTER TO InitialStack;
  60.       LongIntPtr          = POINTER TO LONGINT;
  61.  
  62.     VAR
  63.       InitialStackPtr : InitialStackPointer;
  64.       WorkSpacePtr,
  65.       WorkSpaceEnd    : LongIntPtr;
  66.       savemask        : CARDINAL;    
  67.  
  68.   BEGIN
  69.     (* Check process workspace *)
  70.     IF ODD( WorkSpaceBase ) THEN HALT; END;
  71.     IF WorkSpaceSize < VAL( LONGCARD, MinimumStackSize ) THEN HALT; END;
  72.     IF ProcessDesc = NIL THEN (* Clear workspace for size and access test *)
  73.       WorkSpacePtr := VAL( LongIntPtr, WorkSpaceBase );
  74.       WorkSpaceEnd := 
  75.         VAL( LongIntPtr, VAL( LONGCARD, WorkSpaceBase ) 
  76.                        + WorkSpaceSize 
  77.                        - VAL( LONGCARD, 3 )            );
  78.       WHILE VAL( LONGCARD, WorkSpacePtr ) < VAL( LONGCARD, WorkSpaceEnd ) DO
  79.         WorkSpacePtr^ := 0;
  80.         INC( VAL( LONGINT, WorkSpacePtr ), 4 );
  81.       END; (* FOR *)
  82.     END; (* IF *) 
  83.     InitialStackPtr := VAL( InitialStackPointer,
  84.                               VAL( LONGCARD, WorkSpaceBase)
  85.                             + WorkSpaceSize 
  86.                             - VAL( LONGCARD, TSIZE(InitialStack)) 
  87.                             );
  88.     WITH InitialStackPtr^ DO
  89.       WITH Context DO
  90.         ModuleBaseA4   := REG(ModuleBase);
  91.         (* ProcessBase auf das obere Ende, (MODEP-Process-Descriptor) *)
  92.         Valid := NIL; (*DS*)
  93.         ProcessBaseA5  := WorkSpaceBase+VAL(ADDRESS,WorkSpaceSize); (*DS*)
  94.         FramePointerA6 := NIL;
  95.         StackPointerA7 := NIL;
  96.         StatusRegister := InitialStatus;
  97.         ProgramCounter := ProcessCode;
  98.       END; (* WITH *)
  99.       SavedReturnPC  := CoRoutineEnd; 
  100.     END; (* WITH *)
  101.     ProcessDesc := VAL( PROCESS, InitialStackPtr );
  102.   END NEWPROCESS;
  103.  
  104.   PROCEDURE InstallTrap();
  105.   (* Calling this Routine installs all Assembler routines *)
  106. (*
  107.  
  108. *
  109. *       - der SUPERVISORMODE ist nicht erlaubt (in MODEB nicht nötig)
  110. *
  111. * dadurch ergibt sich daß TRANSFER,IOTRANSFER nur vom Usermode aufgerufen
  112. * werden. Beim INT muß ein Unterscheidung sttatfinden und beim Übergangen
  113. * S -> U der USP bzw. bei U -> S der SSP gerettet werden. Der letzter Fall
  114. * kommt aber eigentlich nie vor. Sämtliche load's speicheren den zusätzs-
  115. * lichen Stackpointer gegebenenfalls zurück.
  116.        
  117.  
  118. trap3           = $8c                   * TRANSFER
  119. trap4           = $90                   * IOTRANSFER
  120.  
  121. call            = $4eb9
  122. stop_int        = $46fc2700
  123.  
  124. magic           = $04091964
  125.  
  126. INIT:           move.w  sr,d0           * save old mode
  127.                 trap    #11             * Supervisormode
  128.                 lea     TRANSFER-*-2(pc),a0
  129.                 move.l  a0,trap3
  130.                 lea     IOTRANSFER-*-2(pc),a0
  131.                 move.l  a0,trap4
  132.                 move.w  d0,sr           * now old mode again
  133.                 bra     exit
  134.  
  135. *       in Usermode:            
  136. *
  137. *  (A0) USP -> ^To.l   (A1)     
  138. *              ^From.l (A2)     
  139. *              :                
  140. *                               
  141. *       SSP -> Sr.w    (D0)     
  142. *              Pc.l
  143. *              :
  144. * only A4,A5,A6 must be saved !
  145.  
  146. TRANSFER:       move.w  #$2700,sr       * no interrupt allowed
  147.                 move.w  (a7)+,d0        * get SR
  148.  
  149. utrans:         move.l  usp,a0          * get USP
  150.                 move.l  (a0)+,a1        * pointer to "to"
  151.                 move.l  (a0),a2         * pointer to "from", USP now clean
  152.                 move.l  (a7)+,(a0)      * PC, SSP now clean
  153.                 move.w  d0,-(a0)        * SR
  154.                 clr.l   -(a0)           * Stack=NIL
  155.                 movem.l a4-a6,-(a0)     * save important registers
  156.                 lea     -$30(a0),a0     * rest of registers
  157.                 move.l  #magic,-(a0)    * MAGIC setzen
  158.                 move.l  a0,usp          * set new USP
  159.                 move.l  (a1),a6         * load "to"
  160.                 move.l  a0,(a2)         * save "from"
  161.                 btst.b  #5,$44(a6)      * new process in supervisormode ?
  162.                 bne     sload
  163.  
  164. uload:          lea     $4a(a6),a0      * top of context
  165.                 move.l  a0,usp          * set new USP to "to"
  166.                 move.l  $40(a6),d1      * get stack
  167.                 beq     ul_nil          * NIL, don't load
  168.                 move.l  d1,a7           * load SSP
  169. ul_nil:         move.l  -(a0),-(a7)     * PC
  170.                 move.w  -(a0),-(a7)     * SR
  171.                 clr.l   (a6)+           * MAGIC löschen
  172.                 movem.l (a6)+,d0-a5     * restore registers
  173.                 move.l  (a6),a6         * A6
  174.                 rte
  175.  
  176. sload:          move.l  a6,a7           * set new SSP to "to"
  177.                 move.l  $40(a7),d1      * get stack
  178.                 beq     sl_nil          * NIL, don't load
  179.                 move.l  d1,a1
  180.                 move.l  a1,usp          * load USP
  181. sl_nil:         clr.l   (a7)+           * MAGIC löschen
  182.                 movem.l (a7)+,d0-a6     * restore registers
  183.                 tst.l   (a7)+           * discharge stack
  184.                 rte
  185.  
  186.  
  187. *       in Usermode:           
  188. *
  189. *  (A0) USP -> Vector.l (A1)   
  190. *              ^To.l    (A2)   
  191. *              ^From.l  (A3)   
  192. *              :               
  193. *                              
  194. *       SSP -> Sr.w    (D0)    
  195. *              Pc.l
  196. *              :
  197.  
  198. IOTRANSFER:     move.w  #$2700,sr       * no interrupt allowed
  199.                 move.w  (a7)+,d0        * get SR
  200.  
  201. uiotrans:       move.l  usp,a0          * get USP
  202.                 movem.l (a0)+,a1-a3     * clean up USP
  203.                 move.l  (a7)+,-(a0)     * PC, SSP now clean
  204.                 move.w  d0,-(a0)        * SR
  205.                 clr.l   -(a0)           * stack=NIL
  206.                 movem.l a4-a6,-(a0)     * save important registers
  207.                 move.l  a2,-(a0)        * A3: Pointer to "to"
  208.                 lea     -$2c(a0),a0     * rest of registers
  209.                 move.l  #magic,-(a0)    * MAGIC setzen
  210.                 move.l  (a2),a6         * load "to"
  211.                 move.l  a0,(a3)         * save "from"
  212.                 lea     INT-*-2(pc),a2  * interrupt routine
  213.                 move.l  a2,-(a0)        * push
  214.                 move.w  #call,-(a0)     * push JSR opcode
  215.                 move.l  #stop_int,-(a0) * push MOVE.W #$2700,SR opcode
  216.                 move.l  a0,(a1)         * set vector
  217.                 move.l  a0,usp          * set new USP
  218.                 btst.b  #5,$44(a6)      * new process in supervisormode ?
  219.                 bne     sioload
  220.  
  221. uioload:        lea     $4a(a6),a0      * top of context
  222.                 move.l  a0,usp          * set new USP to "to"
  223.                 move.l  $40(a6),d1      * get stack
  224.                 beq     uio_nil         * NIL, don't load
  225.                 move.l  d1,a7           * load SSP
  226. uio_nil:        move.l  -(a0),-(a7)     * PC
  227.                 move.w  -(a0),-(a7)     * SR
  228.                 clr.l   (a6)+           * MAGIC löschen
  229.                 movem.l (a6)+,d0-a5     * restore registers
  230.                 move.l  (a6),a6         * A6
  231.                 rte
  232.  
  233. sioload:        move.l  a6,a7           * set new SSP to "to"
  234.                 move.l  $40(a7),d1      * get stack
  235.                 beq     sio_nil         * NIL, don't load
  236.                 move.l  d1,a1
  237.                 move.l  a1,usp          * load USP
  238. sio_nil:        clr.l   (a7)+           * MAGIC löschen
  239.                 movem.l (a7)+,d0-a6     * resore registers
  240.                 tst.l   (a7)+           * discharge stack
  241.                 rte
  242.  
  243. *       SSP -> address of context to load (only A4-A6 important)
  244. *              Sr.w
  245. *              Pc.l
  246.  
  247.  
  248. INT:            btst.b  #5,4(a7)        * process in supervisor mode ?
  249.                 bne     sint
  250.  
  251. uint:           move.l  a6,-(a7)        * save A6
  252.                 move.l  a5,-(a7)        * save A5
  253.                 move.l  usp,a6          * get USP
  254.                 lea     -$12(a6),a6     * skip space for PC,SR,stack,A6,A5
  255.                 movem.l d0-a4,-(a6)     * save registers
  256.                 move.l  #magic,-(a6)    * MAGIC setzen
  257.                 move.l  a6,d0           * save context address
  258.                 move.l  a6,usp          * new USP
  259.                 lea     $38(a6),a1      * get address for A5 in context
  260.                 move.l  (a7)+,(a1)+     * A5
  261.                 move.l  (a7)+,(a1)+     * A6
  262.                 clr.l   (a1)+           * stack=NIL
  263.                 move.l  (a7)+,a6        * context
  264.                 move.w  (a7)+,(a1)+     * SR
  265.                 move.l  (a7)+,(a1)      * PC, SSP clean
  266.                 btst.b  #5,$44(a6)      * process in supervisormode ?
  267.                 beq     uiload
  268.                 move.l  a7,-6(a1)       * save SSP  
  269.                 bra     siload
  270.  
  271. uiload:         lea     $4a(a6),a0      * top of context
  272.                 move.l  a0,usp          * set USP
  273.                 clr.l   (a6)            * MAGIC löschen
  274.                 lea     $30(a6),a1      * address of A3
  275.                 movem.l (a1)+,a3-a6     * restore registers
  276.                 move.l  (a1),d1         * get stack
  277.                 beq     ui_nil          * NIL, don't load
  278.                 move.l  d1,a7           * load SSP
  279. ui_nil:         move.l  d0,(a3)         * save context in "to"
  280.                 move.l  -(a0),-(a7)     * PC
  281.                 move.w  -(a0),-(a7)     * SR
  282.                 rte
  283.  
  284. sint:           movem.l d0-a6,-(a7)     * save registers
  285.                 move.l  #magic,-(a7)    * MAGIC setzen
  286.                 move.l  a7,d0           * save context address
  287.                 move.l  $40(a7),a6      * context to load
  288.                 clr.l   $40(a7)         * stack=NIL
  289.                 btst.b  #5,$44(a6)      * process in supervisormode ?
  290.                 bne     siload
  291.                 move.l  usp,a1
  292.                 move.l  a1,$40(a7)      * save USP
  293.                 bra     uiload
  294.  
  295. siload:         lea     $30(a6),a7      * address of A3
  296.                 clr.l   (a6)            * MAGIC löschen
  297.                 movem.l (a7)+,a3-a6     * restore registers
  298.                 move.l  (a7)+,d1        * get stack
  299.                 beq     si_nil          * NIL, don't load
  300.                 move.l  d1,a1
  301.                 move.l  a1,usp          * load USP
  302. si_nil:         move.l  d0,(a3)         * save context in "to"
  303.                 rte
  304.  
  305. exit:           nop
  306.  
  307. *)
  308.   BEGIN
  309.   INLINE( 040C0H,04E4BH,041FAH,018H,023C8H,00H,08CH,041FAH );
  310.   INLINE( 06EH,023C8H,00H,090H,046C0H,06000H,016CH,046FCH );
  311.   INLINE( 02700H,0301FH,04E68H,02258H,02450H,0209FH,03100H,042A0H );
  312.   INLINE( 048E0H,0EH,041E8H,0FFD0H,0213CH,0409H,01964H,04E60H );
  313.   INLINE( 02C51H,02488H,082EH,05H,044H,0661CH,041EEH,04AH );
  314.   INLINE( 04E60H,0222EH,040H,06702H,02E41H,02F20H,03F20H,0429EH );
  315.   INLINE( 04CDEH,03FFFH,02C56H,04E73H,02E4EH,0222FH,040H,06704H );
  316.   INLINE( 02241H,04E61H,0429FH,04CDFH,07FFFH,04A9FH,04E73H,046FCH );
  317.   INLINE( 02700H,0301FH,04E68H,04CD8H,0E00H,0211FH,03100H,042A0H );
  318.   INLINE( 048E0H,0EH,0210AH,041E8H,0FFD4H,0213CH,0409H,01964H );
  319.   INLINE( 02C52H,02688H,045FAH,04CH,0210AH,0313CH,04EB9H,0213CH );
  320.   INLINE( 046FCH,02700H,02288H,04E60H,082EH,05H,044H,0661CH );
  321.   INLINE( 041EEH,04AH,04E60H,0222EH,040H,06702H,02E41H,02F20H );
  322.   INLINE( 03F20H,0429EH,04CDEH,03FFFH,02C56H,04E73H,02E4EH,0222FH );
  323.   INLINE( 040H,06704H,02241H,04E61H,0429FH,04CDFH,07FFFH,04A9FH );
  324.   INLINE( 04E73H,082FH,05H,04H,06654H,02F0EH,02F0DH,04E6EH );
  325.   INLINE( 04DEEH,0FFEEH,048E6H,0FFF8H,02D3CH,0409H,01964H,0200EH );
  326.   INLINE( 04E66H,043EEH,038H,022DFH,022DFH,04299H,02C5FH,032DFH );
  327.   INLINE( 0229FH,082EH,05H,044H,06706H,0234FH,0FFFAH,06042H );
  328.   INLINE( 041EEH,04AH,04E60H,04296H,043EEH,030H,04CD9H,07800H );
  329.   INLINE( 02211H,06702H,02E41H,02680H,02F20H,03F20H,04E73H,048E7H );
  330.   INLINE( 0FFFEH,02F3CH,0409H,01964H,0200FH,02C6FH,040H,042AFH );
  331.   INLINE( 040H,082EH,05H,044H,06608H,04E69H,02F49H,040H );
  332.   INLINE( 060BEH,04FEEH,030H,04296H,04CDFH,07800H,0221FH,06704H );
  333.   INLINE( 02241H,04E61H,02680H,04E73H ); 
  334.   END InstallTrap;
  335.  
  336.  
  337. BEGIN
  338.   SETREG(ProcessBase, NIL); (* ProcessBase A5 for Main not yet used *)
  339.   (* In Klevel register A5 for MainProcess and its KProcessDesc 
  340.      should be initialized for consistent process management        *)
  341.   MainPROCESSPtr := NIL;
  342.   InstallTrap();
  343. END Process.
  344.  
  345.