home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / useful / dev / obero / oberon-a / source / oberonsys / oberonsys.asm < prev    next >
Encoding:
Assembly Source File  |  1994-08-08  |  15.6 KB  |  492 lines
  1. ****************************************************************************
  2. *
  3. *    $RCSfile: OberonSys.asm $
  4. * Description: Runtime support for the Oberon-A compiler
  5. *
  6. *  Created by: fjc (Frank Copeland)
  7. *   $Revision: 1.3 $
  8. *     $Author: fjc $
  9. *       $Date: 1994/07/24 18:26:38 $
  10. *
  11. * Copyright © 1994, Frank Copeland.
  12. * This file is part of the Oberon-A Library.
  13. * See Oberon-A.doc for conditions of use and distribution.
  14. *
  15. * Log entries are at the end of the file.
  16. *
  17. ****************************************************************************
  18. *
  19. * This file contains the MC68000 source code for part of the runtime
  20. * support library of the Oberon-A compiler.  It contains the program
  21. * startup and exit code and the variables used by the runtime system.
  22. *
  23. * Other parts of the runtime system may be found in the other files in
  24. * this directory.  The object files resulting from assembling these
  25. * files are concatenated to create OberonSys.lib.
  26. *
  27. * This code is by definition *not* re-entrant and is not suitable for
  28. * creating shared-code libraries.
  29. *
  30. * Acknowledgements
  31. * ----------------
  32. *
  33. * The startup and exit code is based on the standard Commodore startup
  34. * code provided with the Native Developers kit for Kickstart 2.04.
  35. *
  36. **********************************************************************
  37.  
  38. ;---------------------------------------------------------------------
  39. ;    Program unit hunk name
  40.  
  41.      TTL OberonSys
  42.  
  43. ;---------------------------------------------------------------------
  44. ;    Imports
  45.  
  46. ABSEXECBASE    EQU  4
  47.  
  48. FindTask       EQU  -294
  49. Forbid         EQU  -132
  50. FreeMem        EQU  -210
  51. GetMsg         EQU  -372
  52. ReplyMsg       EQU  -378
  53. WaitPort       EQU  -384
  54. OpenLibrary    EQU  -552
  55. CloseLibrary   EQU  -414
  56.  
  57. tcTrapData     EQU  46
  58. tcTrapCode     EQU  50
  59. prMsgPort      EQU  92
  60. prCLI          EQU  172
  61.  
  62. OS_MathFail    EQU  21
  63.  
  64. ;---------------------------------------------------------------------
  65. ;    Macros
  66.  
  67. CALLSYS MACRO
  68.         JSR \1(A6)
  69.         ENDM
  70.  
  71. ;---------------------------------------------------------------------
  72.  
  73. ;---------------------------------------------------------------------
  74. ; PROCEDURE OberonSys_INIT (
  75. ;   dosCmdLen {D0} : LONGINT;
  76. ;   dosCmdBuf {A0} : LONGINT;
  77. ;   initialSP {A6} : LONGINT)
  78. ;
  79. ; This procedure is called by the code prologue of the main
  80. ; program module.  A6 contains the initial stack pointer, put
  81. ; there by the code prologue of the main program module. A0 and
  82. ; D0 contain the parameters passed by AmigaDOS.
  83. ;---------------------------------------------------------------------
  84.  
  85.      SECTION OberonSys,CODE
  86.  
  87.      XDEF      OberonSys_INIT
  88.  
  89. OberonSys_INIT:
  90.  
  91.      LEA       OberonSys_VAR,A5    ; Get base pointer for variables
  92.      MOVE.L    A6,(A5)             ; Save initialSP
  93.      MOVE.L    D0,OS_argLen(A5)    ; Save dosCmdLen
  94.      MOVE.L    A0,OS_args(A5)      ; Save dosCmdBuf
  95.  
  96.      MOVE.L    ABSEXECBASE,A6      ; Get Exec library base pointer
  97.  
  98.      ; Get pointer to our task
  99.  
  100.      SUBA.L    A1,A1               ; Clear A1
  101.      CALLSYS   FindTask
  102.      MOVE.L    D0,A4               ; Store it in A4
  103.  
  104.      ; Check if program started from CLI or Workbench
  105.  
  106.      MOVE.L    prCLI(A4),D0
  107.      BNE.S     continueINIT        ; CLI, branch around Workbench code
  108.  
  109. ;---------------------------------------------------------------------
  110. ; Workbench startup code
  111. ;
  112. ; Inputs
  113. ;
  114. ; A4 : Task
  115. ; A5 : OberonSys_VAR
  116. ; A6 : ABSEXECBASE
  117.  
  118.      ; Indicate this is a Workbench program
  119.      MOVEQ     #-1,D0
  120.      MOVE.L    D0,OS_argLen(A5)
  121.  
  122.      ; Get the startup message
  123.  
  124.      LEA       prMsgPort(A4),A0    ; Process message port
  125.      CALLSYS   WaitPort
  126.      LEA       prMsgPort(A4),A0    ; Process message port
  127.      CALLSYS   GetMsg
  128.  
  129.      ; Save it
  130.  
  131.      MOVE.L    D0,OS_args(A5)
  132.  
  133. continueINIT:
  134.  
  135.      CLR.L     OS_returnCode(A5)   ; Lets be optimistic about this
  136.      CLR.L     OS_cleanupProc(A5)  ; Set cleanupProc to NIL
  137.  
  138.      ; Install trap handler.  Task base is still in A4 (I hope)
  139.  
  140.      MOVE.L    tcTrapData(A4),OS_oldTrapData(A5)
  141.      MOVE.L    tcTrapCode(A4),OS_oldTrapCode(A5)
  142.      CLR.L     tcTrapData(A4)
  143.      LEA       OberonSys_TrapHandler,A0
  144.      MOVE.L    A0,tcTrapCode(A4)
  145.  
  146.      ; Open mathffp.library
  147.  
  148.      LEA       mathName(PC),A1
  149.      MOVEQ     #33,D0
  150.      CALLSYS   OpenLibrary         ; Exec.OpenLibrary (mathName,33)
  151.      MOVE.L    D0,OS_mathBase(A5)  ; Save math base pointer
  152.  
  153.      TST.L     D0                  ; If open OK, exit
  154.      BNE.S     exitINIT
  155.  
  156.      ; If open failed, abort program
  157.  
  158.      MOVE.L    #OS_MathFail,OS_returnCode(A5)
  159.      BRA       OberonSys_CLEANUP
  160.  
  161. exitINIT:
  162.      RTS                           ; Back to the module
  163.  
  164. ;---------------------------------------------------------------------
  165. ; PC relative data
  166.  
  167. mathName  DC.B "mathffp.library",0
  168.  
  169. ;---------------------------------------------------------------------
  170. ; PROCEDURE OberonSys_CLEANUP ()
  171. ;
  172. ; This procedure is called by the code prologue of the main
  173. ; program module.  It is the last code to be executed and it
  174. ; returns to the program's calling process.  D0 contains
  175. ; the program's return code.
  176. ;---------------------------------------------------------------------
  177.  
  178.      SECTION OberonSys,CODE
  179.  
  180.      XDEF      OberonSys_CLEANUP
  181.  
  182. OberonSys_CLEANUP:
  183.  
  184.      LEA       OberonSys_VAR,A5    ; Get base pointer for variables
  185.      MOVE.L    (A5),A7             ; Restore initial stack pointer
  186.  
  187.      ; Execute cleanup procedures
  188.  
  189.      TST.L     OS_cleanupProc(A5)  ; Is there a cleanup procedure?
  190.      BEQ.S     1$                  ; If not, branch around
  191.      MOVEA.L   OS_cleanupProc(A5),A3 ; Get the first node
  192.      CLR.L     OS_cleanupProc(A5)  ; NIL the list, to avoid loops
  193. 3$
  194.      MOVE.L    A3,-(A7)            ; save the node pointer
  195.      MOVE.L    4(A3),A3            ; call the procedure
  196.      JSR       (A3)
  197.      MOVE.L    (A7)+,A3            ; restore the node pointer
  198.      TST.L     (A3)                ; is there another procedure?
  199.      BEQ.S     1$                  ; no
  200.      MOVE.L    (A3),A3             ; get the next node
  201.      BRA.S     3$                  ; loop
  202.  
  203. 1$
  204.      MOVE.L    ABSEXECBASE,A6      ; Get Exec library base pointer
  205.  
  206.      ; Free allocated memory blocks
  207.  
  208.      MOVE.L    OS_untraced(A5),A2
  209.      JSR       OberonSys_FreeMem
  210.      MOVE.L    OS_memList(A5),A2
  211.      JSR       OberonSys_FreeMem
  212.  
  213.      ; Close math library
  214.  
  215.      MOVE.L    OS_mathBase(A5),A1
  216.      CALLSYS   CloseLibrary
  217.  
  218.      ; Get pointer to our task
  219.  
  220.      SUBA.L    A1,A1               ; Clear A1
  221.      CALLSYS   FindTask
  222.      MOVE.L    D0,A4               ; Store it in A4
  223.  
  224.      ; Restore default trap handler
  225.      MOVE.L    OS_oldTrapCode(A5),tcTrapCode(A4)
  226.      MOVE.L    OS_oldTrapData(A5),tcTrapData(A4)
  227.  
  228.      ; Check if program started from CLI or Workbench
  229.      CMPI.L    #-1,OS_argLen(A5)
  230.      BNE.S     2$                  ; CLI, branch around Workbench code
  231.  
  232.      ; Workbench cleanup code
  233.  
  234.      CALLSYS   Forbid              ; Stop Workbench unloading us
  235.      MOVE.L    OS_args(A5),A1      ; Get startup message
  236.      CALLSYS   ReplyMsg
  237.  
  238. 2$
  239.      MOVE.L    OS_returnCode(A5),D0; Set return code
  240.  
  241.      RTS                           ; Back to the calling process
  242.  
  243.  
  244. ;---------------------------------------------------------------------
  245. ; PROCEDURE OberonSys_FreeMem
  246. ;
  247. ; This procedure traverses a list of allocated memory blocks and
  248. ; frees them using the Exec function FreeMem ().
  249. ;
  250. ; Inputs
  251. ;
  252. ; A2 : memory list
  253. ; A6 : ABSEXECBASE
  254. ;
  255. ; Variables
  256. ;
  257. ; A0 : tag
  258. ; A1 : mem
  259. ; A2 : next
  260. ; D0 : size
  261. ; D1 : tag
  262. ; D2 : NIL
  263. ;---------------------------------------------------------------------
  264.  
  265.      SECTION OberonSys,CODE
  266.  
  267. OberonSys_FreeMem:
  268.  
  269.      MOVEQ.L   #0,D2               ; D2 = NIL
  270. 1$
  271.      CMPA.L    D2,A2               ; WHILE next # NIL DO
  272.      BEQ.S     5$
  273.      MOVE.L    A2,A1               ;   mem := next
  274.      MOVE.L    (A2),A2             ;   next := next.link
  275.      MOVE.L    4(A1),D1
  276.      BTST      #0,D1               ;   IF 0 IN mem.tag THEN
  277.      BEQ.S     2$
  278.      MOVE.L    D1,D0               ;     size := mem.tag + 7
  279.      ADDQ      #7,D0
  280.      BRA.S     4$
  281. 2$
  282.      BTST      #1,D1               ;   ELSIF 1 IN mem.tag THEN
  283.      BEQ.S     3$
  284.      SUBQ.L    #8,A1               ;     DEC (mem, 12);
  285.      SUBQ.L    #4,A1
  286.      MOVE.L    8(A1),D0            ;     size := mem.size + 20
  287.      ADDI.L    #20,D0
  288.      BRA.S     4$
  289. 3$                                 ;   ELSE
  290.      MOVEA.L   4(A1),A0            ;     size := mem.tag.size + 8
  291.      MOVE.L    (A0),D0
  292.      ADDQ.L    #8,D0
  293. 4$                                 ;   END;
  294.      CALLSYS   FreeMem             ;   FreeMem(mem,size)
  295.      BRA.S     1$                  ; END
  296. 5$
  297.      RTS
  298.  
  299. ;---------------------------------------------------------------------
  300. ; PROCEDURE OberonSys_TrapHandler ()
  301. ;
  302. ; This procedure is installed as the task's trap handler routine
  303. ; by OberonSys_INIT.  It's job is to get the trap number, then
  304. ; exit Supervisor mode as soon as possible.  If the trap number
  305. ; is one it understands, it passes control to OberonSys_Traps,
  306. ; otherwise it passes it on to the default trap handler.
  307. ;
  308. ; This is loosely based on the example in the RKM:Libraries,
  309. ; Ch 21.
  310. ;---------------------------------------------------------------------
  311.  
  312.      SECTION OberonSys,CODE
  313.  
  314.      XDEF      OberonSys_TrapHandler
  315.  
  316. OberonSys_TrapHandler:
  317.  
  318.      MOVE.L    (SP)+,D0            ; Recover the trap number and
  319.                                    ; adjust the stack.
  320.  
  321.      LEA       OberonSys_Traps,A0  ; Con the CPU into thinking it came
  322.      MOVE.L    A0,2(SP)            ; from OberonSys_Traps
  323.  
  324.      RTE                           ; Return to OberonSys_Traps
  325.  
  326. ;---------------------------------------------------------------------
  327. ; PROCEDURE OberonSys_Traps
  328. ;   ( trapNo {D0} : LONGINT )
  329. ;
  330. ; This carries out the actual processing of traps in User mode.
  331. ; The default action is to jump to OberonSys_CLEANUP with a
  332. ; return code of trapNo + 100.  If a trap handler routine has
  333. ; been defined, it will be called instead.
  334. ;
  335. ; The trap number is passed by OberonSys_TrapHandler in D0.
  336. ;---------------------------------------------------------------------
  337.  
  338.      SECTION OberonSys,CODE
  339.  
  340.      XDEF      OberonSys_Traps
  341.  
  342. OberonSys_Traps:
  343.  
  344.      ADDI.L    #100,D0
  345.      LEA       OberonSys_VAR,A5
  346.      MOVE.L    D0,OS_returnCode(A5)
  347.      JMP       OberonSys_CLEANUP   ; HALT (trapNo + 100)
  348. ;    RTS                           ; never reached
  349.  
  350.  
  351. ;---------------------------------------------------------------------
  352. ; The following section defines a generic type descriptor which
  353. ; describes a record with a single pointer field.  This is passed to
  354. ; OberonSys_NEW when allocating a POINTER TO ARRAY OF POINTER TO ...
  355. ; variable.
  356. ;---------------------------------------------------------------------
  357.  
  358.      SECTION OberonSys,DATA
  359.  
  360.      XDEF      OberonSys_TYPE_0
  361.  
  362. OberonSys_TYPE_0:
  363.  
  364.      DC.L      4                   ; size of type
  365.      DC.L      0,0,0,0,0,0,0,0     ; type tag table, set to NILs
  366.      DC.L      0                   ; offset of pointer field
  367.      DC.L      -40                 ; offset to start of descriptor
  368.      DC.B      0                   ; empty string for type name
  369.  
  370. ;---------------------------------------------------------------------
  371.  
  372.      SECTION OberonSys,BSS
  373.  
  374.      XDEF      OberonSys_VAR
  375.      XDEF      OS_initialSP
  376.      XDEF      OS_argLen
  377.      XDEF      OS_args
  378.      XDEF      OS_returnCode
  379.      XDEF      OS_cleanupProc
  380.      XDEF      OS_memList
  381.      XDEF      OS_mathBase
  382.      ;XDEF      OS_lmathBase
  383.      XDEF      OS_untraced
  384.      XDEF      OS_GCVars
  385.  
  386. OberonSys_VAR:      ; Start of OberonSys variables
  387.  
  388. OS_initialSP   EQU  0
  389.      DS.L      1    ; Initial stack pointer on entry to program.
  390.                     ; Initialised by OberonSys_INIT.
  391.  
  392. OS_argLen      EQU  4
  393.      DS.L      1    ; Length of the Command line passed to the program
  394.                     ; by DOS in D0.  Initialised by OberonSys_INIT. A
  395.                     ; value of -1 indicates that the program was
  396.                     ; started by Workbench.  Returned by
  397.                     ; SYSTEM.ARGLEN ().
  398.  
  399. OS_args        EQU  8
  400.      DS.L      1    ; If argLen >= 0, the command line passed to the
  401.                     ; program by DOS in A5.  Otherwise, the address of
  402.                     ; the message sent to the program by Workbench.
  403.                     ; Initialised by OberonSys_INIT.  Returned by.
  404.                     ; SYSTEM.ARGS ().
  405.  
  406. OS_returnCode  EQU  12
  407.      DS.L      1    ; Value returned by the program in D0 on exit.
  408.                     ; Initialised to 0 by OberonSys_INIT.  Set by the
  409.                     ; HALT standard procedure.
  410.  
  411. OS_cleanupProc EQU  16
  412.      DS.L      1    ; Contains the address of a procedure to be
  413.                     ; executed as part of the cleanup when the program
  414.                     ; exits.  Initialised to NIL by OberonSys_INIT.
  415.                     ; Set by SYSTEM.SETCLEANUP ().  Returned by
  416.                     ; SYSTEM.GETCLEANUP ().
  417.  
  418. OS_memList     EQU  20
  419.      DS.L      1    ; Contains a pointer to the head of a linked list
  420.                     ; of memory blocks used by the garbage collector in
  421.                     ; its sweep phase.  Initialised to NIL by
  422.                     ; OberonSys_INIT.  The list is traversed by
  423.                     ; OberonSys_CLEANUP and all the memory blocks are
  424.                     ; freed.
  425.  
  426. OS_mathBase    EQU  24
  427.      DS.L      1    ; Contains the base pointer of mathffp.library.
  428.                     ; This library is used for all floating point
  429.                     ; arithmetic and is automatically opened and
  430.                     ; closed by OberonSys_INIT and OberonSys_CLEANUP.
  431.  
  432. OS_lmathBase   EQU  28
  433.      DS.L      1    ; Not used yet.  It will eventually be used to
  434.                     ; hold the base pointer for
  435.                     ; mathieeedoubbas.library to be used for long
  436.                     ; floating point math.
  437.  
  438. OS_oldTrapCode EQU  32
  439.      DS.L      1    ; Stores the default trap handler on entry to the
  440.                     ; program.  Restored on exit.
  441.  
  442. OS_oldTrapData EQU  36
  443.      DS.L      1    ; Stores the default trap data on entry to the
  444.                     ; program.  Restored on exit.
  445.  
  446. OS_untraced    EQU  40
  447.      DS.L      1    ; Contains a pointer to the head of a linked list
  448.                     ; of memory blocks ignored by the garbage collector
  449.                     ; in its sweep phase.  Initialised to NIL by
  450.                     ; OberonSys_INIT.  The list is traversed by
  451.                     ; OberonSys_CLEANUP and all the memory blocks are
  452.                     ; freed.
  453.  
  454. OS_GCVars      EQU  44
  455.      DS.L      1    ; Contains a pointer to the head of a linked list
  456.                     ; of hunks containing the offsets of global
  457.                     ; pointer variables.
  458.  
  459. ;---------------------------------------------------------------------
  460.  
  461.      END  ; OberonSys
  462.  
  463. ****************************************************************************
  464. *
  465. * $Log: OberonSys.asm $
  466. * Revision 1.3  1994/07/24  18:26:38  fjc
  467. * - Changed initialisation code.
  468. * - Changed code for calling HALT().
  469. * - Changed code for calling cleanup procedures.
  470. *
  471. * Revision 1.2  1994/05/12  20:31:15  fjc
  472. * - Prepared for release
  473. *
  474. * Revision 1.1  1994/01/15  18:31:52  fjc
  475. * Start of revision control
  476. *
  477. * (12 Jan 1994) Modified to handle change in ArrayBlk (elemSize added)
  478. *               Modified to assemble with PhxAss instead of A68K
  479. * ( 5 Jan 1994) Defined generic pointer type descriptor.
  480. * ( 4 Jan 1994) Made modifications required by changes to the memory
  481. *               management system.
  482. * (28 Aug 1993) Added trap handling code.
  483. * ( 9 Jul 1993) Added code to open and close mathffp.library.
  484. * (28 Jun 1993) Changed memory deallocation on exit in line with
  485. *               changes made in OberonSys_NEW and OberonSys_DISPOSE.
  486. * (29 May 1993) Split OberonSys.asm into several files to create
  487. *               OberonSys.lib.
  488. * ( 2 May 1993) First stab at it.
  489. *
  490. ****************************************************************************
  491.  
  492.