home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / forst / actions.s next >
Encoding:
Text File  |  1993-10-23  |  2.6 KB  |  122 lines
  1. ; ACTIONS.S: top-level action and error words    16/04/90
  2. ; No user-available words.
  3. ; Copyright <C> John Redmond 1989, 1990
  4. ; Public domain for non-commercial use.
  5. ;
  6. ;*******************************************************;
  7. ;                            ;
  8. ; The main entry point for outer interpreter action    ;
  9. ;                            ;
  10. ;*******************************************************;
  11. ;
  12.     section    text
  13.     even
  14. ;
  15. action: bsr    stateat        ;execute or compile?
  16.     beq.s    .ex        ;execute state
  17.     move.l    (a6)+,d0    ;flag for word type
  18.     bpl.s    _atexec        ;immediate word
  19.     pop    a3        ;cfa
  20.     move.l    (a3),a0
  21.     adda.l    a5,a0        ;code address
  22.     move.l    -(a3),d2    ;length & macro flag
  23.     bra    call
  24. ;execute:
  25. .ex:    addq.l    #4,a6        ;drop word type flag
  26. _atexec: pop    a0
  27.     move.l    (a0),a1        ;get offset in cfa
  28.     adda.l    a5,a1        ;convert to an address
  29. ex1:    jsr    (a1)
  30.     bsr    chkstk
  31.     rts
  32. ;
  33. ;user entry point:
  34. ;
  35. _execute: pop    a1
  36.     bra.s    ex1
  37. ;
  38. ;*******************************************************;
  39. ;                            ;
  40. ; The error routines                    ;
  41. ;                            ;
  42. ;*******************************************************;
  43. ;
  44. chkstk: lea    dstack,a0
  45.     move.l    (a0),a1
  46.     cmpa.l    a6,a1
  47.     bcs    .chkerr
  48.     rts
  49. .chkerr: lea    serror,a0
  50.     bra    _error
  51. ;
  52. _error:    push    a0        ;message address
  53.     lea    pocket,a0
  54.     move.l    (a0),-(a6)
  55.     bsr    _string
  56.     bsr    _space
  57.     bsr    _message    ;print message passed on stack
  58.     bsr    cfiles        ;close all open files
  59.     bsr    stateat
  60.     bne    .e5
  61.     lea    locsused,a0
  62.     tst.w    (a0)
  63.     bne    .e5
  64.     bra    _abort
  65. .e5:    lea    headmark,a0
  66.     move.l    (a0),d0     
  67.     add.l    a5,d0        ;start of colon header
  68.     push    d0
  69.     push    #1
  70.     bsr    _traverse
  71.     add.l    #5,(a6)
  72.     bsr    discard
  73.     bsr    _bra
  74.     bra    _abort
  75. ;
  76. cfiles: lea    src,a0        ;close all files
  77.     move.l    (a0),d0        ;current source
  78.     beq    .cfx
  79.     push    d0
  80.     bsr    popin
  81.     bra    cfiles
  82. .cfx:    rts
  83. ;
  84. namerror: lea    nerror,a0
  85.     bra    _error
  86. ;
  87. lenerror: lea    lenerr,a0
  88.     bra    _error
  89. ;
  90. strerror: lea    strerr,a0
  91.     bra    _error
  92. ;
  93. regerror: lea    regerr,a0
  94.     bra    _error
  95. ;
  96. deferror: lea    deferr,a0
  97.     bra    _error
  98. ;
  99. apperror: lea    apperr,a0
  100.     bra    _error
  101. ;
  102. apperr: dc.b    18,'is too low to call'
  103. clerror: dc.b    16,'file close error'
  104. deferr:    dc.b    26,'is incorrect in definition'
  105. exerr:    dc.b    26,'used in a colon definition'
  106. fgerror: dc.b    12,'is protected'
  107. inserr:    dc.b    26,'overflowed the input stack'
  108. lenerr:    dc.b    22,'is too long for a name'
  109. locerr: dc.b    30,'gives a local definition error'
  110. nerror: dc.b    12,'needs a name'
  111. operror: dc.b    15,'file open error'
  112. prterr: dc.b    25,'printer is not responding'
  113. regerr:    dc.b    12,'is a pointer'
  114. serror: dc.b    19,'gives a stack error'
  115. strerr: dc.b    23,'gives a structure error'
  116. stterr: dc.b    19,'is a compiling word'
  117. werror: dc.b    10,'is unknown'
  118. wrerror: dc.b    16,'file write error'
  119. xserror: dc.b    19,'too many files open'
  120. ;
  121.     even
  122.