ttl Software Front Panel for CS3 opsys exercise
* RWT November 1984
* revised January 1986 for ANSI terminals
 bin
*
* External references
*
phex equ $40c
whex equ $410
bhex equ $414
nhex equ $418
psym equ $41c
pstr equ $420
freebot equ $3ff0
freetop equ $3ff4
membot  equ $3ff8
memtop  equ $3ffc
*
* Device addresses
*
vdus    equ $4000c1
vdud    equ $4000c3
*
* Device constants
*
vinit equ 3
viof  equ $11
vion  equ $91
*
* ISO Characters
*
del equ 127
bs  equ 8
nl  equ 10
lf  equ 10
cr  equ 13
space equ ' '
esc equ 27

print macro
\* moveq #\1,d0
   jsr psym
   endm

space macro
\* print space
   endm

newline macro
\* print nl
   endm

pstring macro
\* lea \1,a0
   jsr pstr
   endm
*
at macro
\* move.w #(\1)<<8+(\2),d0
   bsr cursor
   endm

saveall macro
\* or.w #$700,sr
   movem.l d0-a6,xd0
   move.l usp,a1
   move.l a1,xusp
   bsr wipe
   move.l \1,a0
   pstring (a0)
   move.w (sp)+,xsr
   move.l (sp)+,xpc
   move.l sp,xssp
   endm

xsaveall macro
\* or.w #$700,sr
   movem.l d0-a6,xd0
   move.l usp,a1
   move.l a1,xusp
   move.w (sp)+,xsr
   move.l (sp)+,xpc
   move.l sp,xssp
   endm

return macro
\* move.l xssp,sp
   move.l xpc,-(sp)
   move.w xsr,-(sp)
   move.l xusp,a1
   move.l a1,usp
   movem.l xd0,d0-a6
   rte
   endm
*
* Supervisor variables
*
    org $3000
varstart equ *
xd0     ds.l 15  * Register save area
xssp    ds.l 1
xusp    ds.l 1
        ds.w 1   *(padding)
xsr     ds.w 1
xpc     ds.l 1
code    ds.w 1   * Bus/address error info
addr    ds.l 1
inst    ds.w 1
breakop equ $feed * Break "instruction"
lpoint  ds.w 8   * Imp break line numbers
bpoint  ds.w 24  * Break PC values + opcodes
wpoint  ds.l 16  * Watchpoint addresses + contents
vbase   ds.l 1   * View area base (ad of ad)
vdef    ds.l 1   * vbase=#vdef if const ad
voffset ds.l 1   * View area displacement
tbreak  ds.l 1   * Current breakpoint address
tflag   ds.w 1   * Trace: 0:single <0:watch/break
kput    ds.l 1   * Keyboard buffer insert pointer
kget    ds.l 1   * Keyboard buffer extract pointer
kbase   ds.b 80  * Keyboard buffer
klimit  equ *
varend  equ *
*
* Exception vectors
*
    org $1000
nullstring equ 0
linenum equ d5
 dc.l 0               * not used
 dc.l begin           * not used
 dc.l berr
 dc.l aerr
 dc.l ille
 dc.l zero
 dc.l chkf
 dc.l over
 dc.l begin           * later priv
 dc.l trac
 dc.l ille
 dc.l break
 dc.l rese
 dc.l rese
 dc.l rese
 dc.l rese
 dc.l rese
 dc.l rese
 dc.l rese
 dc.l rese
 dc.l rese
 dc.l rese
 dc.l rese
 dc.l rese
*               Autovectors
 dc.l int0
 dc.l int1
 dc.l int2
 dc.l int3
 dc.l int4
 dc.l int5
 dc.l int6
 dc.l int7
*               Trap vectors
 dc.l trap
 dc.l trap
 dc.l trap
 dc.l trap
 dc.l trap
 dc.l trap
 dc.l trap
 dc.l trap
 dc.l trap
 dc.l trap
 dc.l trap
 dc.l trap
 dc.l trap
 dc.l trap
 dc.l trap
 dc.l linetrap
*
* Put out ANSI lead-in
*
escape moveq #esc,d0
   jsr psym
   moveq #'[',d0
   jmp psym
*  
* Move cursor to top line and clear it
*
home jsr escape
   moveq #'H',d0
   jsr psym
   jsr escape
   moveq #'K',d0
   jsr psym
   rts
*
* Clear top 12 lines leaving cursor at top
*
wipe at 1,0
  moveq #10,d1
clear jsr escape
  moveq #'K',d0
  jsr psym
  newline
  dbra d1,clear
  bsr home
  rts
*
* Position cursor at row d0>>8 col d0&255
*
cursor move.w d0,-(sp)
  jsr escape
  move.w (sp),d0
  clr.b d0
  rol.w #8,d0
  addq.w #1,d0
  jsr pdec
  moveq #';',d0
  jsr psym
  move.w (sp)+,d0
  and.w #255,d0
  addq.w #1,d0
  jsr pdec
  moveq #'H',d0
  jmp psym
*
* Clear KB buffer and read unbuffered symbol
*
kzap move.l #kbase,d0
  move.l d0,kget
  move.l d0,kput
  rts
*
* Unbuffered readsymbol
*
gsym move.b #viof,vdus
gsym1 btst.b #0,vdus
  beq gsym1
  btst.b #1,vdus
  beq gsym1
  moveq #0,d0
  move.b vdud,d0
  move.b #vion,vdus
  tst.b d0 *?optional
  rts
*
* Buffered readsymbol
* with simple (DEL only) line-editing
*
rsym move.l a0,-(sp)
  move.l kget,a0
  cmp.l kput,a0
  bne.s kdone       * buffer not empty ->
  lea kbase,a0      * reset pointers
  move.l a0,kget
  move.l a0,kput
kloop bsr gsym      * get a symbol
  cmp.b #del,d0
  bne.s knodel
  cmp.l #kbase,a0   * delete
  beq kloop         * line empty ->
  print bs
  space
  print bs
  subq.l #1,a0
  bra kloop
knodel move.b d0,(a0)+  * insert into buffer
  jsr psym              * echo it
  cmp.b #' ',d0
  blo.s kfull           * any control terminates ->
  cmp.l #klimit,a0
  bne kloop             * keep going unless full
kfull move.l a0,kput
  move.l kget,a0
kdone moveq #0,d0       * Clean byte value
  move.b (a0)+,d0       * Extract character
  move.l a0,kget
  move.l (sp)+,a0
  rts
*
* Write D0.W in decimal without formatting
*
pdec and.l #$ffff,d0
  divu #10,d0
  beq.s pdec1        * quot zero ->
  swap d0
  move.w d0,-(sp)    * preserve rem
  swap d0
  bsr pdec           * recursive call
  move.w (sp)+,d0
  bra.s pdec2
pdec1 swap d0
pdec2 add.w #'0',d0
  jsr psym
  rts
*
* Read signed hex number to D0, setting CC
*
rhex move.l d1,-(sp)
  moveq #0,d1
rsloop bsr rsym
  cmp.b #'+',d0
  beq rsloop
  cmp.b #'-',d0
  beq.s rhneg        * Sign present ->
  sub.b #'0',d0
  bmi rsloop         * Skip any leading control
rhloop cmp.b #9,d0
  ble.s rh3
  cmp.b #'a'-'0',d0
  blt.s rh1
  sub.b #32,d0
rh1 sub.b #7,d0
  cmp.b #9,d0
  ble.s rh9
  cmp.b #15,d0
  bgt.s rh9
rh3 lsl.l #4,d1
  add.b d0,d1
  bsr rsym
  sub.b #'0',d0
  bpl rhloop
rh9 move.l d1,d0
  subq.l #1,kget    * Leave terminator around
  move.l (sp)+,d1
  tst.l d0          * set CC
  rts
rhneg move.l (sp)+,d1
  bsr rhex
  neg.l d0          * set CC
  rts
*
* Read signed decimal number to D0, setting CC
* (max magnitude 655359)
*
rdec move.l d1,-(sp)
  moveq #0,d1
rdsloop bsr rsym
  cmp.b #'+',d0
  beq rdsloop
  cmp.b #'-',d0
  beq rdneg
  sub.b #'0',d0
  bmi rdsloop
rdloop cmp.b #9,d0
  bgt.s rd9
  mulu #10,d1
  add.b d0,d1
  bsr rsym
  sub.b #'0',d0
  bpl rdloop
rd9 move.l d1,d0
  subq.l #1,kget
  move.l (sp)+,d1
  tst.l d0
  rts
rdneg move.l (sp)+,d1
  bsr rdec
  neg.l d0
  rts
*
* Long multiply
*
* In:  D0=A.B, D1=C.D
* Out: D0=(A*D+B*C).B*D
* Where .=<<16+
mull movem.l d2/d3,-(sp)
  move.w d0,d2
  move.w d1,d3
  mulu d0,d3    * d3=BD
  swap d1
  mulu d1,d2    * d2=BC
  swap d0
  swap d1
  mulu d1,d0    * d0=AD
  add.l d2,d0
  swap d0
  clr.w d0
  add.l d3,d0
  movem.l (sp)+,d2/d3
  rts
*
* 32-bit divide  d0 by d1, d0=quot, d1=rem
*
divl     movem.l d2-d4,-(sp)
         clr     d4
         move.l  d1,d2
         beq.s   zdivoflow
         bpl.s   divpos1
         neg.l   d2
         or      #2,d4
divpos1  move.l  d0,d1
         bpl.s   divpos2
         neg.l   d1
         eor.l   #3,d4
divpos2  clr.l   d0
         move.l  #1,d3
         bra.s   divsulps
divsulp  lsl.l   #1,d2
         lsl.l   #1,d3
divsulps cmp.l   d2,d1
         bcc     divsulp
         bra.s   divnosub
divlp    cmp.l   d2,d1
         bcs.s   divnosub
         add.l   d3,d0
         sub.l   d2,d1
divnosub lsr.l   #1,d2
         lsr.l   #1,d3
         bne     divlp
         lsr     #1,d4
         bcc.s   nonegrem
         neg.l   d1
nonegrem tst     d4
         beq.s   nonegquo
         neg.l   d0
nonegquo tst.l   d0
         movem.l (sp)+,d2-d4
         rts
zdivoflow movem.l (sp)+,d2-d4
         divu #0,d0
         bra *
*
* Identify a reference
* Return with A0=refbase, D0=offset
*
identify bsr rsym
  cmp.b #'@',d0   * Pointer in store
  beq.s idat
  or.b #32,d0
  cmp.b #'p',d0   * PC-relative
  beq.s idp
  cmp.b #'u',d0   * USP-relative
  beq.s idu
  cmp.b #'a',d0   * Address-register-relative
  beq.s ida
  cmp.b #'r',d0   * Register (not as pointer)
  beq.s idr
  cmp.b #'9',d0
  bgt review      * Error =>
  cmp.b #'0',d0
  blt review      * Error =>
  subq.l #1,kget  * Constant pointer
  lea vdef,a0
iddone bsr rhex   * Read displacement
  rts
idat bsr rhex
  move.l d0,a0
  bra.s iddone
idp lea xpc,a0
  bra iddone
idu lea xusp,a0
  bra iddone
ida bsr rhex
  and.l #7,d0
  lsl.w #2,d0
  add.l #xd0+32,d0
  move.l d0,a0
  bra iddone
idr bsr rhex
  cmp.l #18,d0
  bls.s idr1
  clr.l d0
idr1 lsl.w #2,d0
  add.l #xd0,d0
  lea vdef,a0
  rts
*
* Bus and Address error exceptions
*
berr or.w #$700,sr
   move.l (sp)+,code
   move.l (sp)+,code+4
   saveall #berrmess
   bra.s aberror
aerr or.w #$700,sr
   move.l (sp)+,code
   move.l (sp)+,code+4
   saveall #aerrmess
aberror moveq #31,d0
   and.w code,d0
   jsr bhex
   space
   move.l addr,d0
   jsr phex
   space
   move.w inst,d0
   jsr whex
   bra exception1
*
* IMP Line number trace exception
*
linetrap or.w #$700,sr
  movem.l d0/d1/a0,xd0
  move.l 2(sp),a0        * Update line number
  move.w (a0)+,linenum
  and.w #$3fff,linenum
  move.l a0,2(sp)
  lea lpoint,a0
  moveq #7,d0
lloop move.w (a0)+,d1
  bmi.s lbreak           * <0: break at any line
  beq.s lnobreak         * end of list ->
  cmp.w linenum,d1
  dbeq d0,lloop
  beq.s lbreak           * line number matches ->
lnobreak movem.l xd0,d0/d1/a0
  tst.w tflag
  bmi trace1             * Watching ->
  rte
lbreak movem.l xd0,d0/d1/a0
  saveall #blinemess
  bra exception1
*
* Break instruction exception
*
break xsaveall
  move.l xpc,a0
  cmp.w #breakop,(a0)
  beq.s break1        * all is well
nobreak bsr wipe
  pstring illemess
  bra exception1
break1 moveq #7,d0    * scan list
  lea bpoint,a1
bloop cmp.l (a1)+,a0
  beq.s bfound
  addq.l #2,a1
  dbra d0,bloop
  bra nobreak
bfound move.w (a1),(a0)    * restore the opcode
  move.l a0,tbreak         * prepare to execute it
  move.l #afterbreak,$1024
  or.w #$8000,xsr
  return
afterbreak saveall #breakmess
  move.l #trac,$1024       * restore trace vector
  move.l tbreak,a0
  move.w #breakop,(a0)     * replace break opcode
  bra exception1
*
* Trace exception
*
trac tst.w tflag
  bne.s trace1         * Watch mode ->
  saveall #nullstring
  bra exception1       * Single-step ->
trace1 xsaveall
  lea wpoint,a0        * Watch all the watch-points
  moveq #7,d2
wloop move.l (a0)+,d1  * Address of point
  beq.s excret         * end of list ->
  move.l d1,a1
  move.l (a1),d1       * current value
  cmp.l (a0)+,d1       * compare with original
  dbne d2,wloop
  beq.s excret         * no change ->
  move.l d1,-(a0)
  move.l a0,-(sp)
  bsr wipe
  pstring watchmess
  move.l (sp)+,a0
  move.l -4(a0),d0
  jsr phex
  space
  move.l (a0),d0
  jsr phex
  bra exception1
excret return
*
* Miscellaneous Exceptions
*
exc macro
\1 pea \1mess
   bra exception
   endm
*
 exc ille
 exc zero
 exc chkf
 exc over
 exc priv
 exc rese
 exc trap
 exc int0
 exc int1
 exc int2
 exc int3
 exc int4
 exc int5
 exc int6
 exc int7
*
exception saveall (sp)+
exception1 equ *
*
* Display registers D0/A0 to D7/A7
*
  move.w #$0100+56,d1
  move.w #7,d2
  lea xd0,a0
regloop move.w d1,d0
  add.w #$100,d1
  bsr cursor
  moveq #'D',d0
  jsr psym
  moveq #'7',d0
  sub.w d2,d0
  jsr psym
  space
  move.l (a0),d0
  jsr phex
  space
  space
  moveq #'A',d0
  jsr psym
  moveq #'7',d0
  sub.w d2,d0
  jsr psym
  space
  move.l 32(a0),d0
  jsr phex
  lea 4(a0),a0
  dbra d2,regloop
*
* Display SR,PC,USP
*
  at 9,56
  pstring srmess
  move.w xsr,d0
  jsr whex
  at 9,69
  pstring pcmess
  move.l xpc,d0
  jsr phex
  at 10,68
  pstring uspmess
  move.l xusp,d0
  jsr phex
*
* Display selected view area
*
review move.w #$0100+37,d1
  moveq #7,d2
  move.l vbase,a0
  move.l (a0),a0
  add.l voffset,a0
  move.l a0,d0        * Prevent address error
  and.l #-2,d0
  move.l d0,a0
vloop move.w d1,d0
  bsr cursor
  move.l a0,d0
  jsr phex
  space
  addq.l #2,a0         * Prevent bus error
  cmp.l $3ffc,a0
  subq.l #2,a0
  bhs.s vno
  cmp.l $3ff8,a0
  bhs.s vyes
  cmp.l #$3ffe,a0
  bhs.s vno
vyes move.l (a0),d0
  jsr phex
  bra.s vdone
vno move.l a0,a1
  pstring sp8
  move.l a1,a0
vdone add.w #256,d1
  addq.l #4,a0
  dbra d2,vloop
*
* Display Imp line number if any
*
  tst.w linenum
  beq.s cloop
  at 10,56
  pstring linemess
  move.w linenum,d0
  and.w #$3fff,d0
  bsr pdec
  bra.s cloop
no bsr home
  pstring nomess
*
* Front panel command loop
*
cloop at 1,0
  pstring comess
  bsr kzap
  bsr gsym
  cmp.b #'Y'-64,d0
  beq reload
  cmp.b #esc,d0
  beq cursorkey
  cmp.b #' ',d0
  blt cloop
  move.w d0,-(sp)
  bsr home
  move.w (sp)+,d0
  or.b #32,d0
  cmp.b #'s',d0
  beq step
  cmp.b #'r',d0
  beq run
  cmp.b #'g',d0
  beq go
  cmp.b #'v',d0
  beq view
  cmp.b #'b',d0
  beq setbreak
  cmp.b #'p',d0
  beq poke
  cmp.b #'w',d0
  beq setwatch
  cmp.b #'l',d0
  beq setline
*
* Unknown command: help
*
  at 2,0
  pstring helpmess
  bra cloop
*
* Set break line
*
setline pstring lineprom
  lea lpoint,a0
  moveq #7,d1
  bsr rdec
  bgt.s laddloop    * >0: add line D0
  neg d0
  bgt.s lsubloop    * <0: remove line -D0
  moveq #-1,d0      * =0: add line -1 (any line)
laddloop tst.w (a0)+
  dble d1,laddloop
  bgt no
  move.w d0,-(a0)
  bra cloop
lsubloop cmp.w (a0)+,d0
  dbeq d1,lsubloop
  bne no
lcopyloop move.w (a0),-2(a0)
  addq.l #2,a0
  dbra d1,lcopyloop
  move.w #0,-2(a0)
  bra cloop
*
* Set watch point
*
setwatch pstring watchprom
  bsr identify
  add.l (a0),d0
  move.l d0,d2
  lea wpoint,a0
  moveq #7,d1
  bsr rsym
  cmp.b #'-',d0
  exg d0,d2
  beq.s wsubloop
waddloop tst.l (a0)  * add watchpoint
  addq.l #8,a0
  dbeq d1,waddloop
  bne no
  move.l d0,-8(a0)
  move.l d0,a1
  move.l (a1),-4(a0)
  bra cloop
wsubloop cmp.l (a0),d0 * remove watchpoint
  addq.l #8,a0
  dbeq d1,wsubloop
  bne no
wcopyloop move.l (a0),-8(a0)
  move.l 4(a0),-4(a0)
  addq.l #8,a0
  dbra d1,wcopyloop
  move.l #0,-8(a0)
  bra cloop
*
* Set breakpoint
*
setbreak pstring brkprom
  lea bpoint,a0
  moveq #7,d1
  bsr rhex
  bmi.s bsubloop
baddloop tst.l (a0)
  addq.l #6,a0
  dbeq d1,baddloop
  bne no
  move.l d0,-6(a0)
  move.l d0,a1
  move.w (a1),-2(a0)
  move.w #breakop,(a1)
  bra cloop
bsubloop cmp.l (a0),d0
  addq.l #6,a0
  dbeq d1,bsubloop
  bne no
  move.l d0,a1
  move.w -2(a0),(a1)
bcopyloop move.l (a0),-6(a0)
  move.w 4(a0),-2(a0)
  addq.l #6,a0
  dbra d1,bcopyloop
  clr.l -6(a0)
  bra cloop
*
* Reload system
*
reload reset
  move.l #100000,d0
wait subq.l #1,d0
  bne wait
  move.l 0,sp
  move.l 4,-(sp)
  move.w #$2700,sr
  rts
*
* Single step
*
step or.w #$8000,xsr
  move.w #0,tflag
  bra excret
*
* Run fast
*
run and.w #$7fff,xsr
  move.w #0,tflag
  bra excret
*
* Go slow
*
go or.w #$8000,xsr
  move.w #-1,tflag
  bra excret
*
* Change view area base address and offset
*
view pstring viewprom
  bsr identify
  move.l a0,vbase
  move.l d0,voffset
  bra review
*
* Cursor key: change view area
*
cursorkey bsr gsym
  cmp.b #'[',d0
  beq cursorkey
  cmp.b #'O',d0
  beq cursorkey
  moveq #16,d1
* cmp.b #'?',d0
* bne.s cur1
* bsr gsym           * Ignore nasty control sequence
* bra cloop
cur1 cmp.b #'A',d0
  beq.s curup
  cmp.b #'B',d0
  beq.s curdown
  moveq #2,d1
  cmp.b #'D',d0
  beq.s curup
  cmp.b #'C',d0
  bne cloop
curdown sub.l d1,voffset
  bra review
curup add.l d1,voffset
  bra review
*
* Poke
*
poke pstring pokeprom
  bsr identify
  add.l (a0),d0
  move.l d0,a0
  lea pokelong,a1    * default mode .L
  bsr rsym
  cmp.b #'.',d0
  bne.s pokeloop
pokeswitch bsr rsym
  or.b #32,d0
  cmp.b #'l',d0
  beq.s pokeloop
  lea pokeword,a1    * mode .W
  cmp.b #'w',d0
  beq.s pokeloop
  lea pokebyte,a1    * mode .B
  cmp.b #'b',d0
  bne cloop
pokeloop bsr rhex
  jsr (a1)
  move.l d0,d1
  bsr rsym
  cmp.b #' ',d0
  blt cloop          * finished =>
  cmp.b #'*',d0
  bne.s pokeloop     * no repetition ->
  bsr rhex
  subq.w #2,d0
  cmp.w #-1,d0
  beq cloop
  exg d0,d1
repokeloop jsr (a1)
  dbra d1,repokeloop
  bsr rsym
  cmp.b #' ',d0
  blt cloop          * finished =>
  bra pokeloop
pokelong move.l d0,(a0)+
  rts
pokeword move.w d0,(a0)+
  rts
pokebyte move.b d0,(a0)+
  rts
*
* Absent Extracode routine
*
absent move.l (sp),a0
  moveq #0,d2
  move.w -2(a0),d2
  lea absmess,a0
  moveq #$6a,d0
*
*+Signal Event
*
eve equ 32
evs equ 33
evl equ 34
evx equ 36
evm equ 40
evr equ 296
signalevent movem.l d0-d7/a0-d7,evr(a5)
  move.w d5,evl(a5)
  moveq #15,d3
  and.b d0,d3
  move.b d3,eve(a5)
  btst #4,d0
  beq.s s0     _sub absent ->
  move.b d1,evs(a5)
s0 btst #5,d0
  beq.s s1     _extra absent ->
  move.l d2,evx(a5)
s1 btst #6,d0
  beq.s s3     _message absent ->
  clr.w d0
  move.b (a0),d0
s2 move.b (a0,d0.w),evm(a5,d0.w)
  subq.w #1,d0
  bpl s2
s3 moveq #1,d1
  move.b eve(a5),d0
  lsl.w d0,d1   event bit
  move.l a5,a0
nextblock move.l (a0),a0
  bsr.s check
  beq fail
  move.l 4(a0),a1  PC component
  move.w (a1)+,d2  Event mask
  and.w d1,d2
  beq nextblock
  move.l (sp),d2   Event PC
  cmp.l a1,d2
  blo.s yes
  lea -4(a1),a2    BRA displacement
  add.w (a2),a2
  cmp.l a2,d2
  bls nextblock
yes move.l a0,sp
  move.l a0,(a5)
  move.l a1,-(sp)
  move.l 8(a0),a4
**move.l 12(a0),d6
  move.l evr+56(a5),a6
unwind macro
  move.l \1,a0
  bsr.s unwind
  move.l a0,\1
  endm
  unwind a6
  unwind 4(a5)
  unwind 8(a5)
  unwind 12(a5)
  unwind 16(a5)
  unwind 20(a5)
  unwind 24(a5)
  unwind 28(a5)
  rts
check move.l a0,d0
  tst.l d0
  ble.s checkno
  btst #0,d0
  bne.s checkno
  cmp.l membot,d0
  blo.s checkno
  cmp.l memtop,d0
  bhs.s checkno
  rts              ** CC NZ **
checkno clr.l d0   ** CC Z **
  rts
unwind bsr check
  beq.s unwound
  cmp.l sp,a0
  bhs.s done
  move.l (a0),a0
  bra unwind
unwound lea 3,a0
done rts
fail pstring event
  clr.l d0
  move.b eve(a5),d0
  jsr pdec
  btst.b #4,evr+3(a5)
  beq.s nosub
  print <','>
  clr.l d0
  move.b evs(a5),d0
  jsr pdec
nosub btst.b #5,evr+3(a5)
  beq.s noextra
  print <','>
  move.l evx(a5),d0
  jsr phex
noextra btst.b #6,evr+3(a5)
  beq.s nomessage
  space
  pstring evm(a5)
nomessage pstring line
  clr.l d0
  move.w evl(a5),d0
  jsr pdec
  print nl
  and.w #$f8ff,sr
  bra *
*
* Initial entry (via priv vector), A0 = entry point
*
begin move.l #priv,$1020  * close door behind us
*
* Initialise VDU
*
  move.b #vinit,vdus
  move.b #vion,vdus
*
* Initialise variables
*
  lea varstart,a1
  moveq #(varend-varstart)>>2,d0
clrloop move.l #0,(a1)+
  dbra d0,clrloop
  move.l #-16,voffset
  move.l #xpc,vbase
  move.l #4+256,d6    * Set up D6 for Imp
  add.l a0,d6
  sub.l a1,a1         * Clear USP
  move.l a1,usp
  move.l $3ffc,sp     * Set SSP to top of store
*
* Initialise jump table
*
define macro
  move.l #\1,$3f02\2
 endm
  moveq #63,d0
  lea $3f00,a0
  lea absent,a1
iloop move.l a1,-(a0)
  move.w #$4ef9,-(a0)
  dbra d0,iloop
  define rsym,-138
  define psym,-144
  define pstr,-150
  define mull,-12
  define divl,-18
  define signalevent,-6
*
* Set up environment for Imp
*
  move.l membot,a0    * Address of file header
  move.l memtop,sp    * End of global data area
  move.w #511,d0
gc clr.l -(sp)
  dbra d0,gc
  lea 384(sp),a5      * Global Base
  sub.l 16(a0),sp     * Allocate static data area
  move.l sp,a4
  lea 32(a0),a1       * End of header
  add.w 4(a0),a1      * Skip exports
  add.w 6(a0),a1      * Skip imports (should be zero)
  lea 0,a2
  move.w 12(a0),a2
  add.l a2,a2
  add.l a1,a2         * reset entry
  lea 0,a3
  move.w 14(a0),a3
  add.l a3,a3
  add.l a1,a3         * main entry offset
  add.l 8(a0),a1      * end of code
  move.l a1,freebot
  lea -4096(sp),a0    * optional
  move.l a0,freetop   * optional
  move.l a1,d6        * Set up D6 for Imp
  add.l #3+256,d6
  and.b #$fc,d6
  clr.l d4
  clr.l d5
  move.l #$80808080,d7
  lea 1,a1            * Invalidate USP
  move.l a1,usp
  move.l a3,-(sp)
  clr.l eve(a5)
  clr.l evx(a5)
  clr.l evm(a5)
  jsr (a2)            * Call reset routine
  move.l (sp)+,a3
  or.w #$8000,sr      * Freeze
  jsr (a3)            * Call main program
  moveq #0,d0         * Not reached ?
  jsr $3f00-6
  stop #0
*
* Text strings
*
string macro
\* dc.b \@-*-1,\1
\@ equ *
   endm
*
event    string <nl,'Event '>
line     string <' at line '>
illemess string <'Illegal instruction'>
zeromess string <'Divide by zero'>
chkfmess string <'Bounds exceeded'>
overmess string 'Overflow'
privmess string <'Privilege violation'>
resemess string <'Reserved exception'>
trapmess string <'Trap exception'>
int0mess string <'Spurious interrupt'>
int1mess string <'Level 1 interrupt'>
int2mess string <'Level 2 interrupt'>
int3mess string <'Level 3 interrupt'>
int4mess string <'Level 4 interrupt'>
int5mess string <'Level 5 interrupt'>
int6mess string <'Level 6 interrupt'>
int7mess string <'Level 7 interrupt'>
berrmess string <'Bus error '>
aerrmess string <'Address error '>
srmess   string <'SR     '>
pcmess   string <'PC '>
linemess string <'Line '>
uspmess  string <'USP '>
watchprom string 'Watch:'
lineprom string 'Line:'
brkprom  string 'Break:'
viewprom string 'View:'
refprom  string <'ref '>
pokeprom string 'Poke:'
breakmess string 'Breakpoint'
blinemess string 'Breakline'
watchmess string <'Watched location has changed '>
comess   string 'SFP>'
nomess   string 'No'
sp8      string <'        '>
absmess  string <'Missing extracode'>
helpmess dc.b 255,'^Y Reload standard system',nl
         dc.b 'S  Single instruction',nl
         dc.b 'G  Go (slowly, watching)',nl
         dc.b 'R  Run (fast)',nl
         dc.b 'V  change View area address',nl
         dc.b 'P  poke',nl
         dc.b 'B  Set breakpoint',nl
         dc.b 'W  Set watchpoint',nl
         dc.b 'L  Set break line',nl
         dc.b 0
   end