home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / encorsrc.lha / encore_sources / sys / aem68kernel.t < prev    next >
Encoding:
Text File  |  1988-05-02  |  13.8 KB  |  346 lines
  1. (herald aem68kernel
  2.   (env tsys))
  3.  
  4. ;;; Copyright (c) 1985 Yale University
  5. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  6. ;;; This material was developed by the T Project at the Yale University Computer 
  7. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  8. ;;; and to use it for any purpose is granted, subject to the following restric-
  9. ;;; tions and understandings.
  10. ;;; 1. Any copy made of this software must include this copyright notice in full.
  11. ;;; 2. Users of this software agree to make their best efforts (a) to return
  12. ;;;    to the T Project at Yale any improvements or extensions that they make,
  13. ;;;    so that these may be included in future releases; and (b) to inform
  14. ;;;    the T Project of noteworthy uses of this software.
  15. ;;; 3. All materials developed as a consequence of the use of this software
  16. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  17. ;;;    of acknowledging credit in academic research.
  18. ;;; 4. Yale has made no warrantee or representation that the operation of
  19. ;;;    this software will be error-free, and Yale is under no obligation to
  20. ;;;    provide any services, by way of maintenance, update, or otherwise.
  21. ;;; 5. In conjunction with products arising from the use of this material,
  22. ;;;    there shall be no use of the name of the Yale University nor of any
  23. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  24. ;;;    without prior written consent from Yale in each case.
  25. ;;;
  26. (comment
  27. (define-constant boot/heap1_name 7)
  28. (define-constant boot/heap1_nameL 8)
  29. (define-constant boot/heap1 9)
  30. (define-constant boot/heap2_name 10)
  31. (define-constant boot/heap2_nameL 11)
  32. (define-constant boot/heap2 12)
  33. (define-constant boot/heap-size 13)
  34. (define-constant boot/interrupt-xenoid 3)
  35. (define-constant %%boot-args-size 14)
  36. )
  37.  
  38. ;;; The procedure big_bang MUST come first in this file.     boot-arg-offset
  39. ;;; Arglist start_address (ignored)          4                   +2
  40. ;;;         datasection_address (ignored)    8
  41. ;;;         interrupt_xenoid                 12
  42. ;;;         stack_low                        16
  43. ;;;         guard1                           20
  44. ;;;         guard2                           24
  45. ;;;         heap1_name                       28
  46. ;;;         heap1_nameL                      32
  47. ;;;         heap1_address                    36
  48. ;;;         heap2_name                       40
  49. ;;;         heap2_nameL                      44
  50. ;;;         heap2_address                    48
  51. ;;;         heap_size                        52
  52. ;;;         debug?                           56
  53.  
  54.  
  55. (define (big_bang) 
  56.   (lap (*boot* *the-slink* m68-big-bang interrupt-dispatcher)
  57.  
  58.     ;; set up global-constants
  59.     (move .l SP A1)  ; save argument pointer we have 14 boot-args
  60.     (move .l ($ (fx+ (fixnum-ashl 14 8) header/general-vector)) (@-r SP))
  61.     (lea (d@r SP 2) A2)                                    ; second arg to boot
  62.     (move .l (d@static P (static '*the-slink*)) nil-reg)
  63.     (move .l A2 (d@nil slink/boot-args))                 ; set up boot-args
  64.  
  65.     ;; make interrupt handlers accessible from assembly 
  66.     (move .l  (d@static P (static 'interrupt-dispatcher)) 
  67.               (d@nil slink/interrupt-handler))
  68.     (move .l (d@static P (static 'm68-big-bang)) P)
  69.     (move .l (d@r P -2) A2)
  70.     (lea (label big-bang-return) TP)
  71. ;;; note that nil-reg is in AN and pointer to boot args in A1
  72.     (jmp (@r A2))                  
  73. big-bang-return
  74.     ;; initialize area,area-frontier and area-limit
  75.     (move .l (d@r A1 (fx* 9 4)) S0)         ; get address of heap boot/heap1
  76.     (move .l S0 (d@r TASK task/area-begin))          
  77.     (move .l S0 (d@r TASK task/area-frontier))       
  78.     (add .l (d@r A1 (fx* 13 4)) S0)      ; add size to base boot/heap-size
  79.     (move .l S0 (d@r TASK task/area-limit))          
  80.  
  81.     ;; Set up the procedure register P and call boot,
  82.     ;; never to return. (note: arg 2 (*boot-args*) setup above)
  83.     (move .l nil-reg A3)
  84.     (tst .b (d@r A1 56))
  85.     (j= %debug)
  86.     (move .l ($ header/true) A3)
  87. %debug
  88.     (lea (d@r TASK %%task-header-offset) A1)          ; root-process
  89.     (move .l  ($ 4) NARGS)                            ; 3 args
  90.     (move .l  (d@static P (static '*boot*)) P)
  91.     (move .l  (d@r P -2) TP)
  92.     (jmp   (@r TP))))
  93.  
  94.  
  95. (define (call-fault-handler) 
  96.   (lap (fault-entry)
  97.  
  98.     (equate t_fault_$quit                   (fixnum-ashl #x120010 2))
  99.     (equate t_time_$itimer_real             (fixnum-ashl #xD0007 2))
  100.  
  101.     (move .l ($ t_fault_$quit) A1)
  102.     (btst ($ 1) (d@r TASK task/critical-count))                   
  103.     (jn= %call-fault)
  104.     (move .l ($ t_time_$itimer_real) A1)
  105. %call-fault        
  106.     (lea (d@r SP 6) A2)                          ; frame is 2nd arg
  107.     (move .l (d@static P (static 'fault-entry)) P)
  108.     (move .l (d@r P -2) TP)
  109.     (clr .b (d@r TASK task/critical-count))
  110.     (jmp (@r TP))))                                
  111.  
  112. (define (exit-and-dheap)
  113.   (lap ()
  114.     (move .l (d@nil slink/boot-args) a1)
  115.     (lea (d@r a1 2) sp)
  116.     (rts)))
  117.  
  118. ;;;; Low-level exception handling
  119.  
  120. ;;; Fault frame at time we get control:  See aegis_fault.t
  121. ;;;
  122.  
  123.  
  124. (lap-template (0 0 -1 t stack %fault-frame-handler)
  125. %fault-frame-template
  126.     (bset ($ 6) (d@r task task/critical-count))
  127.     (move .l (d@r SP 4) S0)                    ; fault header
  128.     (asr .l ($ 8) S0)
  129.     (add .l ($ 2) S0)                          ; 2 for header and template
  130.     (asl .l ($ 2) S0)
  131.     (tst .l (d@r SP 12))
  132.     (j= foobar)
  133.     (move .l (d@r SP 12) (index (@r SP) S0))   ; restore hacked top of stack
  134. foobar
  135.     (add .w ($ 16) sp)        ; pop template,header,pointers on stack,hack top
  136.     (lea (d@r SP (* (+ *pointer-temps* *scratch-temps* 9) 4)) A1)  
  137.     (add .l (@r A1) A1)                        ; diag frame
  138.     (move .l (@r+ SP) (d@r A1 %%df_pc))
  139.     (move .l (@r+ SP) (d@r A1 (fx+ %%df_d0 32)))    ; P
  140.     (move .l (@r+ SP) (d@r A1 (fx+ %%df_d0 36)))    ; A1
  141.     (move .l (@r+ SP) (d@r A1 (fx+ %%df_d0 40)))    ; A2
  142.     (move .l (@r+ SP) (d@r A1 (fx+ %%df_d0 44)))    ; A3
  143.     (move .l (@r+ SP) (d@r A1 (fx+ %%df_d0 48)))    ; AN
  144.     (move .l (@r+ SP) (d@r A1 (fx+ %%df_d0 52)))    ; TP
  145.  
  146.     (move .l ($ -8) S0)
  147. %fault-restore-loop                                  ; restore temps
  148.     (move .l (@r+ SP) (index (@r TASK) S0))
  149.     (add .l ($ 4) S0)
  150.     (cmp .l ($ temp-block-size) S0)          
  151.     (j< %fault-restore-loop)
  152.  
  153.     (jbr %return-from-fault)
  154. %fault-frame-handler
  155.     (move .l nil-reg an)
  156.     (rts))
  157.  
  158. (lap-template (0 0 -1 nil stack handle-foreign-return)
  159. %foreign-return
  160.     (add .w ($ 8) sp)                         ; pop template,header
  161.     (move .l (@r+ SP) (d@r TASK task/foreign-call-cont))
  162.     (jbr %return-from-fault)
  163. handle-foreign-return
  164.     (move .l nil-reg AN)
  165.     (rts))
  166.                  
  167.  
  168. (lap-template (0 0 -1 nil stack handle-enable-return)
  169. %re-enabled
  170.     (add .w ($ 4) sp)                         ; pop return address
  171.     (jbr %return-from-fault)
  172. handle-enable-return
  173.     (move .l nil-reg AN)
  174.     (rts))
  175.  
  176. (lap-template (0 0 -1 nil stack handle-doing-gc-return)
  177. %doing-gc-return
  178.     (add .w ($ 4) sp)                         ; pop return address
  179.     (jbr %return-from-fault)
  180. handle-doing-gc-return
  181.     (move .l nil-reg AN)
  182.     (rts)
  183.  
  184.     
  185. %return-from-fault                                
  186.     (bclr ($ 6) (d@r task task/critical-count))      ; what to do?
  187.     (move .l (d@r sp %%old-sp-offset) sp)     ; get old SP
  188.     (move .l (@r+ sp) tp)       ; DB is A5/TP; SB is A6/TASK
  189.     (move .l (@r+ sp) task)
  190.     (move .l ($ 1) .d0)         ; pfm_$return_to_faulting_code
  191.     (rts))
  192.                                                  
  193.  
  194.  
  195. ;;; Interrupts can be deferred.   
  196. ;;; the task/critical count byte has
  197. ;;; bit 7 -- interrupts deferred
  198. ;;; bit 6 -- ignore interrupts
  199. ;;; bit 1 -- quit pending
  200. ;;; bit 0 -- timer interrupt pending
  201.  
  202. (define (interrupt-dispatcher)     ; s5 is status code
  203.   (lap (fault-entry re-enable-faults gc_interrupt)
  204.  
  205.     (equate %%old-sp-offset 4)
  206.     (equate %%fault-sp-offset 8)
  207.     (equate %%df_d0       #x6)
  208.     (equate %%df_pc       #x5c)
  209.     (equate fault_$process_interrupt      #x12001f)
  210.     (equate fault_$quit                   #x120010)
  211.     (equate time_$itimer_real             #xD0007)
  212.  
  213.     (move .l (d@nil slink/current-task) task)    ; restore task
  214.     (btst ($ 6) (d@r task task/critical-count))  ; ignore interrupts?
  215.     (jn= %ignore-interrupt)
  216.     (cmp .l ($ time_$itimer_real) S5)             ; is this a timer interrupt?
  217.     (j= %timer)                                   
  218.     (cmp .l ($ fault_$quit) S5)                   ; is this a ^q?
  219.     (jn= %fault)                                  ; if so ..
  220.     (cmp .l (d@r TASK task/doing-gc?) nil-reg)    ; are we doing gc?
  221.     (jn= %doing-gc)                               ; if not ...
  222.     (tst .l (d@r TASK task/foreign-call-cont))
  223.     (jn= %fault)
  224.     (btst ($ 1) (d@r TASK task/critical-count))   ; is this the second one?                
  225.     (j= %set-interrupt-flag)                      ; if not, defer interrupt
  226.     (bclr ($ 1) (d@r TASK task/critical-count))
  227.     (tst .b (d@r TASK task/critical-count))       ; are interrupts deferred?
  228.     (j= %fault)             
  229. %set-interrupt-flag                      ; if so ...
  230.     (or .b ($ 2) (d@r TASK task/critical-count))  ; set quit bit 
  231.     (jbr %ignore-interrupt)
  232. %timer
  233.     (cmp .l (d@r TASK task/doing-gc?) nil-reg)    ; are we doing gc?
  234.     (jn= %ignore-interrupt)
  235.     (tst .b (d@r TASK task/critical-count))
  236.     (j= %fault) 
  237.     (or .b ($ 1) (d@r TASK task/critical-count))  ; set timer bit 
  238. %ignore-interrupt 
  239.     (pea (label %re-enabled))                     ; re-enable interrupts
  240.     (move .l (d@static p (static 're-enable-faults)) p)    ; DON'T CONS!!!
  241.     (move .l (d@r p -2) tp)
  242.     (jmp (@r tp))                                                       
  243.  
  244. %doing-gc
  245.     (pea (label %doing-gc-return))
  246.     (move .l (d@static p (static 'gc_interrupt)) p)   
  247.     (move .l (d@r p -2) tp)
  248.     (jmp (@r tp))                                                       
  249.  
  250.  
  251. ;;; Interrupts should be disabled here.
  252. %fault
  253.     (move .l (d@r task task/foreign-call-cont) S1)
  254.     (j=  %t-code-interrupt)
  255.  
  256.     ;; Interrupted out of foreign code.
  257.     (move .l SP AN)
  258.     (add .l (@r SP) AN)              ; diag frame in AN
  259.     (clr .l (d@r task task/foreign-call-cont))     
  260.     (move .l s1 (@-r sp))            ; push foreign continuation
  261.     (sub .l sp s1)                   ; compute frame size
  262.     (asl .l ($ 6) S1)
  263.     (move .b ($ (fx+ header/fault-frame 128)) S1)
  264.     (move .l s1 (@-r sp))            ; push frame size 
  265.     (pea (label %foreign-return))
  266.     (jbr %fault-done)
  267.                                  
  268. ;;; registers s0=fault-sp  aN=diag-frame 
  269. %t-code-interrupt
  270.     (move .l (d@r sp %%fault-sp-offset) S0)        ; get fault SP in S0
  271.     (move .l S0 A1)                        ; save fault sp
  272.     (move .l SP AN)                                
  273.     (add .l (@r SP) AN)                  ; save pointer to diagnostic frame AN
  274.  
  275.     (move .l ($ (fx+ temp-block-size 4)) S2)
  276. %fault-save-loop                              ; save temps and extra p and s
  277.     (move .l (index (d@r TASK -8) S2) (@-r SP))
  278.     (sub .l ($ 4) S2)
  279.     (j>= %fault-save-loop)
  280.                                                                          
  281.     (move .l (d@r AN (fx+ %%df_d0 52)) (@-r SP))        ; TP (a5)
  282.     (move .l (d@r AN (fx+ %%df_d0 48)) (@-r SP))        ; AN (a4)
  283.     (move .l (d@r AN (fx+ %%df_d0 44)) (@-r SP))        ; A3 
  284.     (move .l (d@r AN (fx+ %%df_d0 40)) (@-r SP))        ; A2 
  285.     (move .l (d@r AN (fx+ %%df_d0 36)) (@-r SP))        ; A1 
  286.     (move .l (d@r AN (fx+ %%df_d0 32)) (@-r SP))        ; P  (a0)
  287.     (move .l (d@r AN %%df_pc) S1)
  288.     (move .l S1 (@-r SP))
  289.     (cmp .l (d@nil slink/kernel-begin) S1)
  290.     (j< %not-in-kernel)
  291.     (cmp .l (d@nil slink/kernel-end) S1)
  292.     (j> %not-in-kernel)
  293.     (move .l (@r A1) (@-r SP))             ; save hack top of stack
  294.     (clr .l (@-r SP))                      ; no pointers on top
  295.     (jbr %t-code-done)
  296.  
  297. %not-in-kernel
  298.     (clr .l (@-r SP))                      ; no hacked stack top
  299.  
  300. ;;; find how many pointers on top of stack
  301.     (move .l ($ -4) s1)                    ; pointer slot counter as fixnum
  302.  
  303. %find-last-template-loop
  304.     (add .l ($ 4) s1)                      ; incr # pointer counter
  305.     (move .l (@r+ a1) s2)                  ; load next word
  306.     (cmp .b ($ header/vframe) s2)          ; vframe?
  307.     (j= %found-frame)                         ; .. if so, done looking
  308.  
  309.     (move .w s2 s3)                        ; copy for extend test
  310.     (and .b ($ 3) s3)
  311.     (cmp .b ($ tag/extend) s3)             ; extend?
  312.     (jn=  %find-last-template-loop)        ; .. if not, keep looking
  313.     (move .l s2 a3)                        ; copy extend pointer to fetch tem
  314.     (move .l (d@r a3 -2) s3)               ; fetch template 
  315.     (jpos %find-last-template-loop)        ; .. if high bit is 0, keep looking
  316.  
  317. %found-frame
  318.     (move .l s1 (@-r sp))                  ; push number of pointers on stack
  319. %t-code-done
  320.     (sub .l sp s0)                         ; compute total size of frame
  321.     (asl .l ($ 6) s0)
  322.     (move .b ($ header/fault-frame) s0)
  323.     (move .l s0 (@-r SP))                  ; push fault header
  324.     (pea (label %fault-frame-template))         ; call fault handler
  325.  
  326. %fault-done                                            
  327.     (asl .l ($ 2) S5)
  328.     (move .l s5 a1)                             ; 1st argument is status
  329.     (lea (d@r SP 6) a2)                         ; 2nd argument is frame
  330.     (move .l (d@static p (static 'fault-entry)) p)   ; ...
  331.     (move .l (d@r p -2) tp)                     ; ...
  332.     (jmp (@r tp))                               ; ...
  333.  
  334.     ))                           
  335.  
  336. (define (local-machine)
  337.   (object nil                               
  338.       ((machine-type self)          'apollo)
  339.       ((machine-suspend-file self)  '(link aem68suspend))
  340.       ((page-size self)             1024)
  341.       ((object-file-type self)      'mo)
  342.       ((information-file-type self) 'mi)
  343.       ((noise-file-type self)       'mn)
  344.       ((print-type-string self)     "Machine")))
  345.  
  346. (define (nan? x) (ignore x) '#f)