ttl Basic Operating System for Fred-Machine
 bin

version equ $070885

* This version drops all the FE00 event handling
* in favour of the FE02 scheme.
* Dummy entry points for the FE00 "extracodes" are retained.

* External references (to ROM code)
load  equ $408

* Device addresses
eths    equ $7fffc   * Status/Command register
ethd    equ $7fffd   * Data char reg
ethc    equ $7ffff   * Control char reg
vdus    equ $4000c1
vdud    equ $4000c3
ptm     equ $400100

* Device constants
vinit equ 3
viof  equ $11
vion  equ $91
eiof  equ 0
eion  equ $6

* ISO Characters
del equ 127
eot equ 4
bel equ 7
bs  equ 8
nl  equ 10
lf  equ 10
cr  equ 13
esc equ 27

* Ethernet control characters
opn equ $80
cls equ $90
rdy equ $10
stx equ $20
dtx equ $30
nak equ $50
ack equ $c0
etx equ $0b

* Filestore commands
uclose  equ 'H'<<8+'0'
close   equ 'K'<<8+'0'
openr   equ 'S'<<8+'0'
openw   equ 'T'<<8+'0'
reset   equ 'U'<<8+'0'
readsq  equ 'X'<<8+'0'
writesq equ 'Y'<<8+'0'
logmask equ 95<<8
logon   equ 'L'<<8
logoff  equ 'M'<<8

* Store addresses
sysbot  equ $1000   * const
* System code >= sysbot
* System stack < sysvars
sysvars equ $3400   * const
* System variables >= sysvars
freebot equ $3ff0   * set up by boot rom
freetop equ $3ff4
membot  equ $3ff8   * remembered by system
memtop  equ $3ffc
fsport  equ $3fa9

currentpb      equ $3f9c
processownarea equ a5 *$3f98

* VDU emulation stuff
screenrows equ $3fa0
screencols equ $3fa1
screenput  equ $3fa2
screenputa equ $3fa4

string macro
\* dc.b \@b-\@a
\@a dc.b \1
\@b equ *
   endm

text macro
\* dc.b \1,0
   endm

align macro
   ds.w 0
   endm

************************
* Supervisor variables *
************************

    org sysvars
    ds.l 4        former site of event,subevent,eventinfo,eventpc
    ds.b 252      former site of eventmess
processor  ds.l 1 68000 or 68010
*
* Kernel stuff for trace etc
*
    ds.l 16       former event context (16 regs)
    ds.l 5        former event handler context (PC,A4,A5,A6,A7)
rsave  ds.l 15    Trap context (16 regs + PC)
spsave ds.l 1
lastpc ds.l 1
breakpoint ds.w 3   * BP address (2w) and contents (1w)
watchpoint ds.l 2   * WP address and contents
targetline ds.w 1
    ds.w 6       old site of ether stuff, moved further down
*
* Stream stuff
*
* 4-longword control blocks PTR:LIM:SERVICE:EXTRA
*
userno ds.w 1                 * Filestore user number (or 0)
curin  ds.l 1
curout ds.l 1
in0    ds.l 16                * 4 streams, 4 longwords each
out0   ds.l 16
*
* Keyboard stuff
*
kbprom  ds.l 1          * Address of prompt string
kbmode  ds.w 1          * nobuf:notecho:noecho
vdiscard ds.w 1         * Non-zero after ^O
vquota  ds.w 1          * Number of lines left before freezing
kbin    ds.w 1
kbex    ds.w 1
lpos    ds.w 1
lend    ds.w 1
kbbeg   ds.b 100        * Raw keyboard buffer
kbend   equ *
lbeg    ds.b 92         * Current line buffer
llim    equ *
vep     ds.l 1          * Terminal output routine entry point
kexmask ds.l 1          * KB exemption mask
*
* Misc
*
millisecs ds.l 1        * 100 is added to this every decisec
cylock    ds.b 1        * =0 not locked
*                       * >0 locked (with nest count)
*                       * + byte sign bit if ^Y pending
    ds.b 1    former site of ether port used for filestore
*
* Ether stuff
*
station ds.w 1
etherr  ds.l 1                * error count
dtxin   ds.l 1  **order**     * set on hearing DTX
rdyin   ds.l 1  **order**     * set on hearing RDY
stxin   ds.l 1  **order**     * set on hearing STX
ackin   ds.l 1  **order**     * set on hearing ACK/NAK
nakin   ds.l 1  **order**     * set on hearing NAK
*
* Disq stuff?
*
dsqint ds.l 1  * int wait coroutine return address
dsqwai ds.l 1  * int wait coroutine address
*
* Ether DtxIn AST for G
dtxast ds.l 1
dtxa6  ds.l 1
dtxmask ds.l 1
*
*********************
* Exception vectors *
*********************
*
    org sysbot
nullstring equ 0
 dc.l sysvars     Reset SP
 dc.l begin       Reset PC
 dc.l berrexc     Bus error
 dc.l aerrexc     Address error
 dc.l illeexc     Illegal instruction
 dc.l zerodiv     Division by zero
 dc.l chkfail     CHK instruction failure
 dc.l overflow    TRAPV instruction failure
 dc.l privexc     Privilege violation
 dc.l tracexc     Trace interrupt
 dc.l illeexc     'A' emulation
 dc.l break       'F' emulation (FEED used as breakpoint)

 dc.l reserved      \
 dc.l reserved       \
 dc.l reserved        \
 dc.l reserved         \
 dc.l reserved          \
 dc.l reserved           \ reserved vectors
 dc.l reserved           /
 dc.l reserved          /
 dc.l reserved         /
 dc.l reserved        /
 dc.l reserved       /
 dc.l reserved      /

 dc.l spuint0     spurious interrupt
 dc.l spuint1     \
 dc.l spuint2      > unused auto-interrupts
 dc.l spuint3     /
 dc.l ethint      ether station interface interrupt
 dc.l kbint       ACIA interrupt
 dc.l timeint     PTM interrupt
 dc.l spuint7     NMI

 dc.l setsr       Trap 0: set SR=D0
 dc.l reserved
 dc.l reserved
 dc.l reserved
 dc.l reserved
 dc.l reserved
 dc.l reserved
 dc.l reserved
 dc.l reserved
 dc.l reserved
 dc.l reserved
 dc.l reserved
 dc.l reserved
 dc.l reserved
 dc.l reserved
 dc.l linetrap    Trap 15: line-break for Imp
*
* Old-style extracode entry points
*
 bra.w *  printsymbol
 bra.w *  printstring
 bra.w *  readsymbol
 bra.w *  nextsymbol
 bra.w printstring *  prompt
 bra.w  testsymbol
 bra.w  selectinput
 bra.w  selectoutput
 bra.w *  resetinput
 bra.w *  resetoutput
 bra.w *  closeinput
 bra.w *  closeoutput
 bra.w  openinput
 bra.w  openoutput
 bra.w  etheropen
 bra.w  etherclose
 bra.w  etherwrite
 bra.w  etherread
 bra.w  fcomm
 bra.w  fcommw
 bra.w  fcommr
 bra.w * absent oldsignal
 bra.w pdec
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w cputime
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w settermmode
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent  nhex
 bra.w * absent  bhex
 bra.w * absent  whex
 bra.w * absent  lhex
 bra.w * absent  rhex
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
 bra.w * absent
*
* New-style event handling
*
linenum     equ     d5
evlink      equ   0(a5)
event       equ  32(a5)
eventsub    equ  33(a5)
eventline   equ  34(a5)
eventextra  equ  36(a5)
eventmess   equ  40(a5)
eventregs   equ 296(a5)
eventsp     equ 356(a5) (=eventregs+60)
br0         equ     a6
br1         equ   4(a5)
br2         equ   8(a5)
br3         equ  12(a5)
br4         equ  16(a5)
br5         equ  20(a5)
br6         equ  24(a5)
br7         equ  28(a5)
*
unlink macro
\* move.l \1,a1
   bsr.s unlink
   move.l a1,\1
   endm
*  
* Signal Event
* D0 = EVENT & 15
*      + 16 if SUB present
*      + 32 if EXTRA present
*      + 64 if MESSAGE present
* D1 = SUB if present
* D2 = EXTRA if present
* A0 = MESSAGE if present

* Normal entry is to here

signalevent movem.l d0-d7/a0-a7,rsave

* But enter here if registers already saved

* Store away the event context in the event record
signoregs move.l processownarea,a5
* move.w d0,-(sp)
* move.w sr,d0
* or.w #$8000,d0
* trap #0
* move.w (sp)+,d0
   bclr #4,d0
   beq.s signosub
   move.b d1,eventsub
signosub bclr #5,d0
   beq.s signoextra
   move.l d2,eventextra
signoextra bclr #7,d0
   bne.s signoline
   move.w linenum,eventline
signoline bclr #6,d0
   beq.s signomess
   swap d0
   clr.w d0
   move.b (a0),d0
   lea eventmess,a1
sigmessloop move.b (a0)+,(a1)+
   dbra d0,sigmessloop
   swap d0
signomess move.b d0,event
   lea rsave,a0
   lea eventregs,a1
   moveq #15,d0
sigregloop move.l (a0)+,(a1)+
   dbra d0,sigregloop
* Now find the trap block
   moveq #1,d0
   move.b event,d1
   lsl.w d1,d0
   lea evlink,a0
huntloop move.l (a0),a0  ad of next trap block
   cmp #0,a0
   beq crash           nil =>
   move.l 4(a0),a1       PC
   move.w d0,d1
   and.w (a1),d1
   beq huntloop          not trapped ->
   move.l eventsp,a2
   move.l (a2),a2        event PC
   lea -2(a1),a1
   cmp.l a1,a2
   blo.s trapped
   add.w (a1),a1
   cmp.l a1,a2
   bls huntloop
* Found it
trapped move.l a0,sp
   move.l 8(a0),a4
   move.l a0,evlink
   unlink br0
   unlink br1
   unlink br2
   unlink br3
   unlink br4
   unlink br5
   unlink br6
   unlink br7
   clr.l d4
   move.l 4(a0),a1
   jmp 2(a1)
unlink move.l a1,d0
   and.l #$ff000001,d0
   bne.s ur9
   cmp.l eventsp,a1
   blo.s ur9
   cmp.l sp,a1
   bhs.s ur9
   move.l (a1),a1
ur9 rts
* No trap block found
crash move.w #$2700,d0
   trap #0
   lea crashmess,a0
   jsr vptext
   clr.l d0
   move.b event,d0
   jsr pdec
   jsr space
   clr.l d0
   move.b eventsub,d0
   jsr pdec
   jsr space
   move.l eventextra,d0
   jsr phex
   jsr space
   clr.l d0
   move.w eventline,d0
   jsr pdec
   jsr space
   lea eventmess,a0
   jsr vpstring
   stop #$2000
   bra *-4
crashmess text <nl,'*Crash* '>
   align
*
* Old extracode dummy routine
* Assume called by JSR.W xxxx
*
absent movem.l d0-d7/a0-a7,rsave
  move.l (sp),a0   return address
  clr.l d2
  move.w -2(a0),d2      xxxx
  ext.l d2
  moveq #9,d1
  lea absmess,a0
  moveq #$70,d0
  bra signoregs
absmess string <'Attempt to call absent extracode'>
  align
*
************************
* Exception processing *
************************
*
* Bus and Address errors
*
berrmess string <'Bus error'>
aerrmess string <'Address error'>
endmess equ *
   align
berrexc movem.l d0-d7/a0-a7,rsave
   moveq #2,d1
   moveq #aerrmess-berrmess,d2
   lea berrmess,a0
   bra.s aberror
aerrexc movem.l d0-d7/a0-a7,rsave
   moveq #3,d1
   moveq #endmess-aerrmess,d2
   lea aerrmess,a0
*
aberror move.l processownarea,a5
   lea eventmess,a1
   add d2,a1
   move.l processor,d2
   move.l d2,(a1)+
   cmp.l #68010,d2
   beq.s m68010
   move.w (sp)+,(a1)+ FC word
   move.l (sp)+,d2    Access address
   move.w (sp)+,(a1)+ IR
   moveq #$70,d0
   bra usignal
m68010 move.w (sp),$32(sp)  SR
   move.l 2(sp),$34(sp)     PC
   move.w 6(sp),$38(sp)     Format word
   and.w #$fff,$38(sp)      convert to normal
   move.w 8(sp),(a1)+       SSW
   move.l 10(sp),d2         Access address
   move.w $14(sp),(a1)+     Inst buffer
   lea $32(sp),sp
   moveq #$70,d0
   bra usignal
*
* Spurious interrupts
*
spuint0 rte
spuint1 rte
spuint2 rte
spuint3 rte
spuint7 rte
*
* Privilege violation exception
* Intercept violations caused in 68010 by
*      MOVE SR,-(SP)
* and  MOVE SR,Dn
*
privexc movem.l d0/a0/a1,-(sp)
  move.l 14(sp),a0             * Offending PC
  move.w (a0),d0               * Offending instruction
  addq.l #2,14(sp)
  cmp.w #$40e7,d0              * (MOVE.W SR,-(SP))
  beq canpush
  and.w #-8,d0
  cmp.w #$40c0,d0              * (MOVE.W SR,D?)
  beq canread
  subq.l #2,14(sp)
  movem.l (sp)+,d0/a0/a1       * Something else =>
  bra.s privviol

* Come here on detecting MOVE SR,-(SP)
canpush move.l usp,a0
  move.w 12(sp),-(a0)
  move.l a0,usp
  movem.l (sp)+,d0/a0/a1
  move.l #68010,processor
  rte

* Come here on detecting MOVE SR,Dn
* Stack layout
*  0(SP)  D0H      retadH
*  2(SP)  D0L      retadL
*  4(SP)  A0H      (A0H)
*  6(SP)  A0L      MOVE.W ?(SP),Dn
*  8(SP)  (A1H)    ?=12
* 10(SP)  (A1L)    RTS
* 12(SP)  SR       (SR)
* 14(SP)  PCH      (PCH)
* 16(SP)  PCL      (PCL)
* Note A1 was saved to get the sites right for the rest,
* not to protect it (we don't corrupt it here)
canread moveq #7,d0
  and.w (a0),d0            * register number
  move.l 4(sp),a0          * (restore A0)
  lsl.w #5,d0
  lsl.w #4,d0
  add.w #$302f,d0          * Generate MOVE.W 12(SP),Dn
  move.w d0,6(sp)
  move.l (sp)+,d0          * (restore D0)
  move.w #12,4(sp)         * displacement for above
  move.w #$4e75,6(sp)      * RETURN instruction
  jsr 2(sp)
  addq.l #8,sp             * skip former A0/A1
  move.l #68010,processor
  rte

*
* Exception or trap generated signals
*
convert macro
\* movem.l d0-d7/a0-a7,rsave
   moveq #\2,d1
   moveq #$50+\1,d0
   lea \@,a0
   bra * usignal
\@ string <\3>
   align
   endm
illeexc convert 0,4,<'Illegal instruction'>
privviol convert 0,8,<'Privilege violation'>
reserved convert 0,5,<'Reserved exception'>
zerodiv convert 1,4,<'Division by zero'>
chkfail convert 6,2,<'Out of bounds (CHK)'>
overflow convert 1,1,<'Overflow (TRAPV)'>
*
*  Convert exception into signal (on User Stack)
*
usignal move.l usp,a1
   move.l 2(sp),-(a1)
   move.l a1,rsave+60
   move.l a1,usp
   lea signoregs,a1
   move.l a1,2(sp)
   rte
*
* Trap 0: Set SR=D0
*
setsr move.w d0,(sp)
   rte
*
* Trap 15: Line break
*
linetrap movem.l d0/a0,-(sp)
   move.l watchpoint,a0  * Guard-duty
   move.l (a0),d0
   cmp.l watchpoint+4,d0
   bne.s changed         Watched loc has changed ->
   move.l 10(sp),a0      PC
   move.w (a0)+,linenum  update line number
   move.l a0,10(sp)      update PC
   move.w targetline,d0
   bmi.s lt9             single-line mode ->
   cmp.w linenum,d0
   beq.s lt9             target line found ->
lt8 movem.l (sp)+,d0/a0
   rte
lt9 movem.l (sp)+,d0/a0
   bra.s tracexc
guardduty movem.l d0/a0,-(sp)
   move.l watchpoint,a0
   move.l (a0),d0
   cmp.l watchpoint+4,d0
   beq lt8
changed move.l d0,watchpoint+4
   movem.l (sp)+,d0/a0
   pea protmess
   bra.s except
*
*  Breakpoint trap
*
break tst.l breakpoint       Known breakpoint?
   beq.s newbreak            No ->
   move.l a0,-(sp)           replace instruction
   move.l breakpoint,a0
   move.w breakpoint+4,(a0)
   clr.l breakpoint
   move.l (sp)+,a0
   bra.s tracexc
newbreak move.l a0,-(sp)
   move.l 6(sp),a0
   cmp.w #$feed,(a0)
   move.l (sp)+,a0
   bne illeexc
   addq.l #2,2(sp)
tracexc tst.l watchpoint
   bne.s guardduty
ftracexc pea nullstring
except movem.l d0-d7/a0-a6,rsave * Save registers
   move.w #-1,vquota
   bsr vdureset
   bsr home
   move.l (sp)+,a0            * Print message
   bsr vptext
exc0 lea 6(sp),a0             * Save "stack pointer"
   btst.b #5,(sp)
   bne.s exc1
   move.l usp,a0
exc1 move.l a0,spsave
   or #$500,sr                * Allow non-interruptable KB input
   move.w #-1,vquota          * ^Q (for now)
   bsr newline                * Display saved registers
   bsr space
   moveq #7,d3                * register numbers
   lea sp10,a0
dis0 bsr vptext
   moveq #'7',d0
   sub.b d3,d0
   bsr vpsym
   lea sp8,a0
   dbra d3,dis0
   lea dmess,a0
   bsr vptext
   moveq #7,d3                * Data registers
   lea rsave,a3
dis1 bsr space
   move.l (a3)+,d0
   bsr phex
   dbra d3,dis1
   lea amess,a0
   bsr vptext
   moveq #7,d3                * Address registers
dis2 bsr space
   move.l (a3)+,d0
   bsr phex
   dbra d3,dis2
   lea srmess,a0              * Status Register,
   bsr vptext
   move (sp),d0
   bsr phex4
   move.w linenum,d0          * Line number,
   beq.s dis25
   move.l curout,-(sp)
   lea out0,a0
   move.l a0,curout
   lea linemess,a0
   bsr vptext
   clr.l d0
   move.w linenum,d0
   bsr pdec
   move.l (sp)+,curout
dis25 lea pcmess,a0           * and Program Counter
   bsr vptext
   move.l 2(sp),d0
   bsr phex
   btst.b #7,(sp)             * If we are single-stepping,
   beq.s dis3
   bsr space                  * show previous PC also
   move.l lastpc,d0
   bsr phex
*
*********************************
* Trace mode command processing *
*********************************
*
dis3 lea whatmess,a0
   bsr vptext
exccom bsr kbrsym
exc2 cmp.b #'Y'-64,d0         * ^Y - Kill
   beq kill
   cmp.b #'S'-64,d0
   beq exccom
   cmp.b #'Q'-64,d0
   beq exccom
   or.b #32,d0
   cmp.b #'x',d0              * X - Spy
   beq spy
   cmp.b #'s',d0              * S - Single Step
   beq step
   cmp.b #'b',d0              * B - run to PC Breakpoint
   beq.s setbreak
   cmp.b #'l',d0              * L - run to line breakpoint
   beq.s linebreak
   cmp.b #'n',d0              * N - execute Next statement
   beq.s nextline
   cmp.b #'p',d0              * P - protect location
   beq.s setwatch
   cmp.b #'c',d0              * C - continue
   beq.s continue
   cmp.b #'r',d0              * R - Reset everything
   beq restart
   lea helpmess,a0
   bsr vptext
   bra exccom
nextline moveq #-1,d0
   bra.s lb1
linebreak bsr kbrdec
   bvs dis3
lb1 move.w d0,targetline
   bra.s co1
continue clr.w targetline
co1 bclr.b #7,(sp)
   bsr unbreak
   bra.s excret
setwatch bsr kbrhex
   bvs dis3
   bclr.l #0,d0
   move.l d0,a0
   move.l a0,watchpoint
   move.l (a0),watchpoint+4
   bset.b #7,(sp)
   bra.s excret
setbreak bclr.b #7,(sp)
   bsr unbreak
   bsr kbrhex
   bvs dis3
   move.l d0,breakpoint
   beq.s excret
   move.l d0,a0
   move.w (a0),breakpoint+4
   move.w #$feed,(a0)
   bra.s excret
step bset.b #7,(sp)
excret bsr screenbot
   movem.l rsave,d0-d7/a0-a6
   move.l 2(sp),lastpc
   rte
kill tst.b cylock
   beq.s killnow     * not locked out ->
   bset.b #7,cylock
   bra exccom
killnow bsr screenbot
   bsr unbreak
   movem.l rsave,d0-d7/a0-a6
   bclr.b #7,(sp)
   movem.l d0-d7/a0-a7,rsave
   moveq #1,d1
   moveq #$10,d0    * %signal 0,1,0
   bra usignal
restart move.w #-1,d0
   dbra d0,*
   move.w #$2700,sr
   move.l 0,sp
   move.l 4,a0
   jmp (a0)
unbreak move.l breakpoint,d0
   bne.s unb1
   rts
unb1 move.l d0,a0
   move.w breakpoint+4,(a0)
   clr.l breakpoint
   rts
*
* Trace mode command processing routines
*
kbrsym btst.b #0,vdus         * UNbuffered
   beq kbrsym
   clr.l d0
   move.b vdud,d0
   and.b #127,d0
   cmp.b #cr,d0
   bne.s kbrs1
   moveq #nl,d0
kbrs1 bra vpsym               * to echo
*
*
kbrhex bsr kbrsym
   clr.l d1
kbrhex2 cmp.b #del,d0
   beq.s kbrhex5
   cmp.b #bs,d0
   beq.s kbrhex5
   cmp.b #'X'-64,d0
   beq.s kbrhex5
   cmp.b #'0',d0
   blt.s kbrhex4
   cmp.b #'9',d0
   ble.s kbrhex3
   and.b #95,d0
   cmp.b #'A',d0
   blt.s kbrhex4
   cmp.b #'F',d0
   bgt.s kbrhex4
   subq #7,d0
kbrhex3 and #15,d0
   lsl.l #4,d1
   add.l d0,d1
   bsr kbrsym
   bra kbrhex2
kbrhex4 move.l d1,d0
   rts
kbrhex5 move.l d1,d0
   or.b #2,ccr
   rts
kbrdec bsr kbrsym
   clr.l d1
kbrdec1 cmp.b #del,d0
   beq.s kbrhex5
   cmp.b #bs,d0
   beq.s kbrhex5
   cmp.b #'X'-64,d0
   beq.s kbrhex5
   cmp.b #'0',d0
   blt.s kbrhex4
   cmp.b #127,d0
   beq.s kbrdec
   cmp.b #'9',d0
   bgt.s kbrhex4
   and.l #15,d0
   mulu #10,d1
   add.l d0,d1
   bsr kbrsym
   bra kbrdec1
*
*******
* Spy *
*******
*
spy lea spyprom,a0
   bsr vptext
   bsr kbrhex                 * Read address
   bvs spy
   move.l d0,a3
spy1 bsr kbrhex               * and count
   bvs spy
   subq #1,d0
   and #$ff,d0                * in range 1-256
   move d0,d4
   move d0,d3
spy2 lea spyline,a0
   bsr vptext
spy3 move a3,d1
   and #15,d1
   bne.s spy4
   lea freshline,a0           * show address at 16-byte boundaries
   bsr vptext
   move.l a3,d0
   bsr phex
   moveq #':',d0
   bsr vpsym
spy4 bsr space
   move.b (a3)+,d0
   bsr phex2                * show one byte at a time
   dbra d3,spy3
   bsr kbrsym
   cmp.b #'=',d0              * '=' overwrites last shown byte
   beq.s spy5
   cmp.b #nl,d0               * NL displays next batch
   bne exc2                   * anything else gets you out
   move d4,d3                 * anything else reads new address
   bra spy2
spy5 bsr kbrhex
   move.b d0,-1(a3)           * overwrite, then show next location
   clr d3
   clr d4
   bra spy2
*
*
* Timer interrupt
* Counter 3 is set to interrupt every decisecond.
* when this happens, add 100 to millisec counter.
*
timeint movem.l d0-d1/a0,-(sp)
   lea ptm,a0
   moveq #4,d1              * Counter-3-interrupting bit
   and.b 2(a0),d1           * Read status register
   beq.s ti1                * not counter 3 ->
   moveq #100,d1
ti1 movep.l 4(a0),d0        * Read counters 1, 2,
   movep.w 12(a0),d0        * and 3 to placate PTM
   add.l d1,millisecs       * update time if relevant
   movem.l (sp)+,d0-d1/a0
   rte
*
* Ether receiver interrupt
*
ethint movem.l d0-d1/a0,-(sp)
   move.b eths,d0             * Read status of ether interface
*  moveq #1,d1
*  and d0,d1                  * Is it responsible?
*  beq dsqtry                 * No ->
   bpl dsqtry                 * Not ether interrupting ->
   and.w #2,d0                * Data or Control?
   beq.s ethdat               * Data ->
   move.b ethc,d1             * Read the control character
   move.b #$f0,d0
   and.b d1,d0
   beq.s ethnps
ethi0 btst.b #0,eths
   beq.s ethi0
   moveq #31,d1
   and.b ethd,d1
   swap d0
   move.w d1,d0
   lsr.w #3,d0
   and.w #3,d0
   eor.w #3,d0
   lea dtxin,a0             * Point at flag array element
   add.w d0,a0
   swap d0
   cmp.b #dtx,d0
   beq ethdtx               * DTX ->
   addq #4,a0
   cmp.b #rdy,d0
   beq ethset               * RDY ->
   addq #4,a0
   cmp.b #stx,d0
   beq ethstx               * STX ->
   addq #4,a0
   cmp.b #ack,d0
   beq ethset               * ACK ->
   cmp.b #nak,d0
   bne.s ethunk               * Unknown ->
   addq.l #1,etherr           * NAK: count as error,
   bset.b d1,4(a0)            * and set both NAK and ACK bits
   bra.s ethset
ethdat equ *
   move.b ethd,d0
   bsr phex2
   moveq #nl,d0
   bsr vpsym
   addq.l #1,etherr
   bra.s ethiret
ethnps cmp.b #etx,d1          * Non port-specific char
   beq.s ethiret              * ETX: ignore
   cmp.b #7,d1
   bne.s ethunk
ethi1 btst.b #0,eths
   beq ethi1
   moveq #0,d1
   move.b ethd,d1
   move.w d1,station
   bra.s ethiret
ethunk or d0,d1
   moveq #nl,d0
   bsr vpsym
   moveq #'^',d0
   bsr vpsym
   move d1,d0
   bsr phex2
   addq.l #1,etherr
   bra.s ethiret
ethstx move.b #eiof,eths
ethset bset.b d1,(a0)
ethiret movem.l (sp)+,d0-d1/a0
   rte
ethdtx bset.b d1,(a0)
   move.l d1,d0              * remember port number
   move.l dtxast,d1          * AST enabled?
   beq ethiret               * No ->
   move.l d1,a0
   move.l dtxmask,d1         * Interested in this port?
   btst d0,d1
   beq ethiret               * No ->
   movem.l d2-d7/a1-a6,-(sp)
   move.l dtxa6,a6
**dtxagain move.l a0,-(sp)
**   clr.l dtxast
**   move.w #$2300,sr
   jsr (a0)                  * Call the AST
**   move.w #$2400,sr
**   move.l (sp)+,a0
**   move.l a0,dtxast
**   move.l dtxin,d1
**   bne.s ethdtxagain
   movem.l (sp)+,d2-d7/a1-a6 * and return from int
   bra ethiret
**ethdtxagain moveq #-1,d0
**edl addq.l #1,d0
**   ror.l d1
**   bcc edl
**   bra dtxagain
*
* Disk interrupt handler
*
dsqtry move.l dsqint,-(sp)
   rts
dsqwait move.l (sp)+,dsqint
   bra ethiret
*dsqspu moveq #bel,d0
*   bsr vpsym
*   bra ethiret
dsqspu bra ethiret
*
* VDU Keyboard Interrupt
*
kbint movem.l d0-d1/a0,-(sp)
   move.w kbin,a0
   move.b vdus,d1
   moveq #127,d0
   and.b vdud,d0
   and #1,d1                  * Data there?
   beq.s kbiret               * No ->
   moveq #-32,d1
   and d0,d1
   bne.s kbbung               * not control ->
   moveq #1,d1
   lsl.l d0,d1
   and.l kexmask,d1
   bne.s kbbung               * exempted ->
   cmp.b #cr,d0               * Swap CR and LF
   beq.s kbflip
   cmp.b #lf,d0
   bne.s kbok
kbflip eor.b #cr!!lf,d0
   bra.s kbok
kbiret movem.l (sp)+,d0-d1/a0 * False alarm
   rte
kbok tst.b (a0)               * After DLE?
   bmi.s kbbung               * Yes ->
   cmp.b #'Y'-64,d0           * Pick off ^Y,
   beq kbctrly
   cmp.b #'T'-64,d0           * and ^T,
   beq kbctrlt
   cmp.b #'P'-64,d0           * and DLE,
   beq kbctrlp
   cmp.b #'S'-64,d0           * and ^S,
   beq kbctrls
   cmp.b #'Q'-64,d0           * and ^Q,
   beq kbctrlq
   cmp.b #'O'-64,d0           * and ^O,
   beq kbctrlo
   cmp.b #'X'-64,d0           * and ^X.
   beq kbctrlx
   tst.w vquota               * Test for freeze-mode
   beq.s frozen
kbbung move.b d0,(a0)+        * Attempt to insert into buffer
   cmp.w #kbend,a0
   bne.s kbnowrap
   lea kbbeg,a0
kbnowrap cmp.w kbex,a0
   beq.s kbreject             * Buffer full ->
   move.w a0,kbin
   clr.b (a0)                 * ?Safety for DLE test?
   bra kbiret
kbreject moveq #bel,d0
*   move.w vquota,-(sp)
*   move.w #1,vquota
*   bsr vpsym
*   move.w (sp)+,vquota
   jsr screenput
   bra kbiret
frozen cmp.b #bs,d0
   beq.s melt
   cmp.b #cr,d0
   beq.s melt
   cmp.b #lf,d0
   beq.s defrost
   cmp.b #'Q'-64,d0
   bne.s kbreject
   move.w #-1,vquota
   bra kbiret
defrost move.w #1,vquota
   bra kbiret
screenbot moveq #esc,d0
   jsr screenput
   moveq #'Y',d0
   jsr screenput
   moveq #' '-1,d0
   add.b screenrows,d0
   jsr screenput
   moveq #' ',d0
   jsr screenput
   rts
screenquota move.w d0,-(sp)
   moveq #0,d0
   move.b screenrows,d0
   subq.b #1,d0
   move.w d0,vquota
   move.w (sp)+,d0
   rts
melt bsr screenquota
   bra kbiret
kbctrlt movem.l (sp)+,d0-d1/a0
   clr.b cylock
   bra ftracexc
kbctrlx move.w a0,kbex
   bra kbbung
kbctrly move.w a0,kbex
   tst.b cylock
   beq.s firenow
   bset.b #7,cylock
*   move.w vquota,-(sp)
*   move.w #1,vquota
   moveq #'^',d0
   jsr screenput
*   bsr vpsym
   moveq #'Y',d0
   jsr screenput
*   bsr vpsym
*   move.w (sp)+,vquota
   bra kbiret
firenow movem.l (sp)+,d0-d1/a0
   bclr.b #7,(sp)
   movem.l d0-d7/a0-a7,rsave
   moveq #1,d1
   moveq #$10,d0
   bra usignal
kbctrlp move.w kbin,a0
   move.b #$80,(a0)            * Note pointer does not move
   bra kbiret
kbctrls move.w #0,vquota
   bclr.b #3,kbmode+1
   bra kbiret
kbctrlq move.w #-1,vquota
   bset.b #3,kbmode+1
   bra kbiret
kbctrlo eor.w #1,vdiscard
   bne kbiret
   tst.w vquota
   bmi kbiret
   bsr screenquota
   bra kbiret

*
* %integerfn cputime {real time in milliseconds since system startup}
*
cputime move.w d1,-(sp)
   move.w sr,d1
   move.w #$2600,d0        * Interrupts off
   trap #0
   moveq.l #99,d0
   sub.b ptm+12,d0        * ms since last timer int
*  cmp.b  #99,d0
*  beq.s  cputimex
   bne.s cputimex
   btst.b #2,ptm+2
   beq.s cputimex
   add.l #100,d0
cputimex add.l millisecs,d0
   move.w d1,sr
   move.w (sp)+,d1
   rts
*
*  Return with result in D0
*  From routines which preserved d0-d2/a0-a2
*
result move.l d0,(sp)
*
* + Return without result
* (Also null output routine)
*
return movem.l (sp)+,d0-d2/a0-a2
   rts
*
* %Routine printstring(A0=string)
*
printstring movem.l d0-d2/a0-a2,-(sp)
   clr.w d1
   move.b (a0)+,d1           * Size of string
   beq return                * Null =>
   subq.w #1,d1              * Adjusted for DBRA
pst1 move.b (a0)+,d0
   bsr printsymbol
   dbra d1,pst1
   bra return
*
* %Routine printsymbol(D0=sym)
*
printsymbol movem.l d0-d2/a0-a2,-(sp)
    move.l curout,a0          * Point at CB
    move.l 8(a0),a1           * Get output routine address
    jmp (a1)                  * and go there
*
* File output routine
*
fo0 move.l curout,a0
fileout move.l (a0),a1
   cmp.l 4(a0),a1
   beq.s fo1                  * Buffer full ->
   move.b d0,(a1)+
   move.l a1,(a0)
   bra return
fo1 bsr flush                 * Flush output buffer,
   move.l (sp),d0             * restore sym and try again.
   bra fo0
*
* VDU output routines (VPSYM non-destructive)
*
vduout tst.w vdiscard         * Test for ^O
   bne return
   bsr.s vpsym
   bra return
*
space moveq #' ',d0
vpsym cmp.b #nl,d0
   beq.s newline              * NL ->
vps0 tst.w vquota
   beq.s vps0
   jmp screenput
aciascreenput btst.b #1,vdus   * Wait for TXBE
   beq aciascreenput
   move.b d0,vdud
   rts
newline tst.w vquota          * Test for ^S
   bmi.s nl2                  * Free mode ->
   bne.s nl1                  * still OK ->
nl0 tst.w vquota              * Wait
   beq nl0
nl1 sub.w #1,vquota
nl2 moveq #cr,d0              * Newline -> CR,LF
   jsr screenput
   moveq #lf,d0
   jsr screenput
   moveq #nl,d0
   rts
*
* Reset all weird Visual 200 modes
*
vdureset lea vdusetup,a0
vdur1 move.b (a0)+,d0
   beq.s vdur2
   jsr screenput
vdur2 rts
*
* Home cursor
*
home bsr space
   bsr space
   bsr space
   moveq #esc,d0
   jsr screenput
   moveq #'H',d0
   jsr screenput
   rts
*
* VDU print text (uses 0-termination)
*
vptext move.b (a0)+,d0
   beq ret
   bsr vpsym
   bra vptext
* and length-prefixed for good measure
vpstring move.b (a0)+,d1
vps1 beq ret
   move.b (a0)+,d0
   bsr vpsym
   subq.b #1,d1
   bra vps1
*
* VDU print hex routines for kernel
*
phex move d0,-(sp)
   swap d0
   bsr phex4
   move (sp)+,d0
phex4 move d0,d2
   lsr #8,d0
   bsr phex2
   move d2,d0
phex2 move d0,d1
   lsr #4,d0
   bsr phex1
   move d1,d0
phex1 and.b #15,d0
   cmp.b #9,d0
   ble.s hn1
   add.b #7,d0
hn1 add.b #'0',d0
   bra vpsym
*
* VDU print decimal D0 (range 0..655359)
pdec movem.l d0-d1,-(sp)
   moveq #-1,d1
pd1 divu #10,d0
   swap d0
   move.w d0,-(sp)
   clr.w d0
   addq #1,d1
   swap d0
   bne pd1
pd2 moveq #'0',d0
   add.w (sp)+,d0
   bsr vpsym
   dbra d1,pd2
   movem.l (sp)+,d0-d1
   rts
*
* %Routine prompt(A0=string)
*
prompt move.l a0,kbprom
   rts
*
* %Integerfn readsymbol / nextsymbol
*
nextsymbol movem.l d0-d2/a0-a2,-(sp)
   clr.l d1
   bra.s rs0
readsymbol movem.l d0-d2/a0-a2,-(sp)
   moveq #1,d1
rs0 move.l curin,a0           * Descriptor
   move.l 8(a0),a1
   jmp (a1)
*
* Null input routine
*
nullin add #24,sp
   moveq #$49,d0
   lea eof,a0
   bra signalevent
eof string <'End of file reached'>
   align
*
* File input routine
*
filein move.l (a0),a1
   cmp.l 4(a0),a1
   beq.s fi1                  * Buffer empty ->
   clr.l d0
   move.b (a1),d0
   add.l d1,a1
   move.l a1,(a0)
   bra result
fi1 move.l d1,d2              * Rsym:1 / Nsym:0
   move.l 12(a0),d0           * Transaction number etc
   add #readsq,d0             * for FcommR
   move.l 4(a0),a1
   move.l a1,d1
   and.l #511,d1
   bne nullin                 * Previous was last block ->
   move.l #512,d1             * Maxsize for FcommR
   sub.l d1,a1                * end-512=startad for FcommR
   lea nullstring,a0
   bsr fcommr
   tst d0
   ble nullin                 * End of file
   move.l curin,a0
   move.l 4(a0),a1            * End of buffer -512=
   sub.l #512,a1              * Start of buffer
   add.l d2,a1
   move.l a1,(a0)             * +1 or +0
   sub.l d2,a1
   add.l a1,d0                * Actual end of data in buffer
   move.l d0,4(a0)
   clr.l d0
   move.b (a1),d0             * Extract 1st char
   bra result
fi2 move.l curin,a0           * Zero-size block or Fs Err:
   move.l 4(a0),d0            * note EOF status
   add.l #511,d0
   and.l #$fffffe00,d0
   move.l d0,4(a0)
   bra nullin
*
* VDU input routine
*
vduin move.w lend,a0
   cmp.w #lbeg,a0
   beq.s refresh         * Line buffer empty ->
   move.w lpos,a0
   cmp.w lend,a0
   beq.s refresh         * Line buffer exhausted ->
   clr.l d0
   move.b (a0),d0        * Extract character
   add.w d1,a0           * Bump unless nextsymbol
   move.w a0,lpos
   cmp.b #eot,d0         * End of file?
   bne result            * No ->
   move.w #lbeg,lpos     * Reset pointers
   move.w #lbeg,lend
   bra nullin            * signal end of input
*
* Line buffering and echo handler, which maintains
* a single linear line buffer, and takes its input
* from the circular keyboard buffer.
*
refresh lea lbeg,a0      * Reset line buffer pointers
   move.w a0,lpos
   move.w a0,lend
   clr.w vdiscard        * Re-enable output
   tst.w vquota          * If in page-mode, reset quota
   bmi.s ref0
   bsr screenquota
ref0 move.l kbprom,a0    * Emit prompt string
   clr.l d0
   clr.l d2
   move.b (a0)+,d2
   subq #1,d2
   bmi.s ref2
ref1 move.b (a0)+,d0
   bsr vpsym
   dbra d2,ref1
ref2 bsr getsymbol
   btst.b #2,kbmode+1
   bne result            * No buffering =>
   cmp.b #del,d0
   beq kbdel
   cmp.w #32,d0
   blt.s kbcontrol
   bsr insert
   bsr echo
   bra ref2
kbfree move.w a0,lend
   move.w #lbeg,lpos
   bra vduin
kbcontrol add.l d0,d0
   move.l d0,a0
   move.w kbtable(a0),a0
   jmp (a0)
insert move.w lpos,a0
   cmp.w #llim,a0
   beq.s full
   move.b d0,(a0)+
   move.w a0,lpos
   rts
full moveq #bel,d0
   bsr vpsym
   addq.l #4,sp
   bra ref2
echo btst.b #0,kbmode+1
   beq vpsym
   rts
delete move.w lpos,a0
   cmp.w #lbeg,a0
   beq.s del1
   subq #1,a0
   move.w a0,lpos
   btst #0,kbmode+1
   bne.s del1
   moveq #bs,d0
   bsr vpsym
   moveq #' ',d0
   bsr vpsym
   moveq #bs,d0
   bra vpsym
del1 rts
kbtable equ *
  dc.w kbignore
  dc.w kbignore
  dc.w kbignore
  dc.w kbctrlc
  dc.w kbeof
  dc.w kbignore
  dc.w kbignore
  dc.w kbignore
  dc.w kbcan
  dc.w kbtab
  dc.w kblf
  dc.w kbignore
  dc.w kbignore
  dc.w kbcr
  dc.w kbignore
  dc.w kbignore
  dc.w kbignore
  dc.w kbignore
  dc.w kbignore
  dc.w kbignore
  dc.w kbignore
  dc.w kbcan
  dc.w kbignore
  dc.w kbignore
  dc.w kbcan
  dc.w kbignore
  dc.w kbeof
  dc.w kbesc
  dc.w kbignore
  dc.w kbignore
  dc.w kbignore
  dc.w kbignore
kbignore moveq #bel,d0
  bsr vpsym
  bra ref2
kbdel bsr delete
  bra ref2
kbcan bsr delete
  move.w lpos,a0
  cmp.w #lbeg,a0
  bne kbcan
  bra ref2
kbtab moveq #' ',d0
  moveq #2,d2
kbtabs bsr insert
  bsr echo
  dbra d2,kbtabs
  bra ref2
kbeof moveq #eot,d0
  bsr insert
  bra kbfree
kbcr moveq #cr,d0
  bra.s kbnl
kblf moveq #lf,d0
kbnl bsr insert
  btst #1,kbmode+1
  bne kbfree
  bsr vpsym
  bra kbfree
kbctrlc clr.l d0
  add.l #24,sp
  clr.l d0
  bra signalevent
kbesc moveq #esc,d0
  bsr insert
  bsr getsymbol
  bsr insert
  cmp.b #'?',d0
  bne kbfree
  bsr getsymbol
  bsr insert
  bra kbfree
getsymbol bsr ts0
  tst.l d0
  bmi.s getsymbol
  rts
*
* %Integerfn testsymbol
* Result -1 of no input available,
* else return (and read) first character from buffer
*
testsymbol move.l a0,-(sp)
   clr.l d0
   move.w lend,a0
   cmp.w #lbeg,a0
   beq.s ts1           * Line buff empty ->
   move.w lpos,a0
   cmp.w lend,a0
   beq.s ts1           * Line buff exhausted ->
   move.b (a0)+,d0
   move.w a0,lpos      * Extract from line buff
   move.l (sp)+,a0
   rts
ts0 move.l a0,-(sp)    * Alternative entry point
   clr.l d0            * for line buffer handler
ts1 move.w kbex,a0
   cmp.w kbin,a0
   beq.s ts3           * kb buff empty ->
   move.b (a0)+,d0     * Extract from kb buff
   cmp.w #kbend,a0
   bne.s ts2
   lea kbbeg,a0        * wrap-round
ts2 move.w a0,kbex
   move.l (sp)+,a0
   rts
ts3 move.l (sp)+,a0
   moveq #-1,d0
   rts
*
* %Routine set terminal mode(%integer bits)
* Bit 0: suppress echo
* Bit 1: suppress terminator echo
* Bit 2: suppress line buffering
* Bit 3: cancel page-mode
*
settermmode move.w d0,kbmode
   clr.w vdiscard
   bsr screenquota
   btst #3,d0
   beq set1
   move.w #-1,vquota
set1 rts
*
* %Routine selectinput(D0=stream)
*
selectinput tst.l d0
   bmi.s si1
   cmp.l #3,d0
   ble.s si2
si1 move.l d0,d2
   moveq #7,d1
   moveq #$76,d0
   lea badstream,a0
   bra signalevent
badstream string <'Illegal stream'>
   ds.w 0
si2 move.l d0,-(sp)
   lsl.l #4,d0
   add.l #in0,d0
   move.l d0,curin
   move.l (sp)+,d0
   rts
*
* %Routine selectoutput(D0=stream)
*
selectoutput tst.l d0
   bmi.s so1
   cmp.l #3,d0
   bgt.s si1
   move.l d0,-(sp)
   lsl.l #4,d0
   add.l #out0,d0
   move.l d0,curout
   move.l (sp)+,d0
   move.w #$6000,$10c0
   rts
so1 move.w #$4e75,$10c0
   rts
*
* %Routine resetinput
*
resetinput movem.l d0-d2/a0-a2,-(sp)
   move.l curin,a0
   move.l 4(a0),d0            * Tidy buffer pointers
   add.l #511,d0
   and.l #$fffffe00,d0
   move.l d0,4(a0)
   move.l d0,(a0)
   cmp.l #vduin,8(a0)         * If keyboard, purge buffer
   bne.s re1
   move #lbeg,lpos
   move #lbeg,lend
   move kbin,kbex
re1 move.l 12(a0),d0          * Transaction number
   beq return                 * 0 for VDU or NULL
   add #reset,d0
   lea nullstring,a0
   bsr fcomm
   bra return
*
* %Routine resetoutput
*
resetoutput movem.l d0-d2/a0-a2,-(sp)
   move.l curout,a0
   move.l 4(a0),d0
   sub.l #512,d0
   move.l d0,(a0)
   bra re1
*
* %Routine closeinput
*
closeinput movem.l d0-d2/a0-a2,-(sp)
   move.l curin,a0
   move.l 4(a0),d0          * Tidy pointers
   add.l #511,d0
   and.l #$fffffe00,d0
   move.l d0,4(a0)
   move.l d0,(a0)
   move.l #nullin,8(a0)
   move.l 12(a0),d0
   beq.s cli1
   clr.l 12(a0)
   add #close,d0
   lea nullstring,a0
   bsr fcomm
   move.l curin,a0
cli1 equ *
*cli1 cmp.l #vduin,8(a0)      * Purge buffer if keyboard
*   bne.s dinull
*   move #lbeg,lpos
*   move #lbeg,lend
*   move kbin,kbex
dinull move.l 4(a0),(a0)
   move.l #nullin,8(a0)
   clr.l 12(a0)
   clr.l d0
   bra return
*
* %Routine closeoutput
*
closeoutput movem.l d0-d2/a0-a2,-(sp)
   move.l curout,a0
   bsr flush
   move.l curout,a0
   move.l #return,8(a0)
   move.l 12(a0),d0
   beq return
   clr.l 12(a0)
   add #close,d0
   lea nullstring,a0
   bsr fcomm
   bra return
*
* %Routine openinput(D0=stream,A0=filename)
* NB side-effect of selecting specified stream
* and of closing it first
*
openinput bsr selectinput
   movem.l d0-d2/a0-a2,-(sp)
   move.l curin,a0            * descriptor to A0
   move.l 4(a0),d0            * Tidy up pointers
   add.l #511,d0
   and.l #$fffffe00,d0
   move.l d0,4(a0)
   move.l d0,(a0)
   move.l 12(a0),d0           * Transaction number
   beq.s di1                  * Zero: file not open ->
   add #uclose,d0
   lea nullstring,a0
   bsr fcomm
   move.l curin,a0
*di1 cmp.l #vduin,8(a0)        * VDU?
*   bne.s di2
*   move #lbeg,lpos            * purge buffer if so
*   move #lbeg,lend
*   move kbin,kbex
*di2
di1 clr.l 12(a0)
   move.l 12(sp),a1           * filename string
   move.b (a1),d0             * Length of filename
   beq dinull                 * "" means ":N"
   cmp.b #':',1(a1)           * Device name?
   beq.s di3                  * Starts with ':' ->
   cmp.b #'.',1(a1)
   bne.s difile               * Does not start with '.' ->
di3 cmp.b #1,d0               * Just {"." or} ":"?
   beq.s divdu                * Yes ->
   move.b 2(a1),d0            * second char of name
   or.b #32,d0                * To lower case
   cmp.b #'`',d0              * Test for ":@"
   beq.s dispecial
   cmp.b #'n',d0              * Test for ":N"
   beq dinull                 * Everything else is VDU
divdu move.l #vduin,8(a0)
   bra return
difile move.l #nullin,8(a0)
   move userno,d0
   add #openr,d0
   move.l a1,a0
   bsr fcomm
   move.l curin,a0
   move.l #filein,8(a0)
   move.l d0,12(a0)
   bra return
dispecial move.l #nullin,8(a0)
   movem.l (sp)+,d0-d2
   addq.l #4,sp
   movem.l (sp)+,a1-a2
   rts
*
* %Routine openoutput(D0=stream,A0=filename)
* NB side-effect of selecting specified stream
*
openoutput bsr selectoutput
   movem.l d0-d2/a0-a2,-(sp)
   move.l curout,a0
   bsr flush
   move.l curout,a0
do1 move.l 12(a0),d0          * Transaction number
   beq.s do2                  * Not file ->
   add #uclose,d0
   lea nullstring,a0
   bsr fcomm
   move.l curout,a0
do2 clr.l 12(a0)
   move.l #return,8(a0)
   move.l 12(sp),a1           * filename string
   move.b (a1),d0
   beq return
   cmp.b #':',1(a1)
   beq.s do3
   cmp.b #'.',1(a1)
   bne.s dofile
do3 cmp.b #1,d0
   beq dovdu
   move.b 2(a1),d0
   or.b #32,d0
   cmp.b #'`',d0
   beq dispecial
   cmp.b #'n',d0
   beq return
dovdu move.l vep,8(a0)
   bra return
dofile move userno,d0
   add #openw,d0
   ext.l d0
   move.l a1,a0
   bsr fcomm
   move.l curout,a0
   move.l #fileout,8(a0)
   move.l d0,12(a0)
   bra return
*
* Auxiliary routines for Ether
*
* Prepare for 32-bit BTST
* and lock out ^Y
*
portbit move.l d0,a2
   not.w d0
   lsr.w #3,d0
   and.w #3,d0
   exg d0,a2
   addq.b #1,cylock
   and.l #31,d0
   rts
*
* Unlock ^Y and fire any pending one
*
unlock tst.b cylock
   beq.s unl1         * ?error: not locked
   subq.b #1,cylock
   bpl.s unl1         * nothing pending ->
   eor.b #$80,cylock
   beq.s unl2         * fire off ->
   eor.b #$80,cylock  * keep pending bit
unl1 rts
unl2 moveq #$10,d0
   moveq #1,d1
   bra signalevent
*
* Macros to replace hang-mode calls
*
ethtwait macro
\@ btst.b #3,eths
   beq \@
   endm
scontrol macro
\* move.b \1,ethc
   ethtwait
   endm
sdata macro
\* move.b \1,ethd
   ethtwait
   endm
*
* %Routine etheropen(D0=port,D1=station<<8+port)
*
etheropen movem.l d0-d2/a0-a2,-(sp)
   bsr portbit
   beq return
   bclr d0,rdyin(a2)
   bclr d0,dtxin(a2)
   bset d0,ackin(a2)
   bclr d0,nakin(a2)
   bclr d0,stxin(a2)
   scontrol #opn
   sdata d0
eo2 bclr d0,rdyin(a2)
   beq eo2
   scontrol #stx
   sdata d0
   ror #8,d1
   sdata d1
   rol #8,d1
   sdata d1
   scontrol #etx
   bsr unlock
   bra return
*
* %Routine etherclose(D0=port)
*
etherclose movem.l d0-d2/a0-a2,-(sp)
   bsr portbit
   bclr d0,rdyin(a2)
   scontrol #cls
   sdata d0
   bsr unlock
   bra return
*
* %Routine etherwrite(D0=port,D1=len,A0=buff)
*
etherwrite movem.l d0-d2/a0-a2,-(sp)
   bsr portbit
   bclr d0,rdyin(a2)          * Permission already obtained?
   bne.s ew15                 * Yes ->
ew0 bclr d0,ackin(a2)         * Wait for previous ACK
   beq ew0
   scontrol #dtx
   sdata d0
ew1 bclr d0,rdyin(a2)         * Wait for RDY
   beq ew1
ew15 scontrol #stx
   sdata d0
ew2 subq #1,d1                * Send data
   bmi ew3
   move.b (a0)+,ethd
ew25 btst.b #3,eths
   bne ew2
   bra ew25
ew3 scontrol #etx
   bsr unlock
   bra return
*
* %Integerfn etherread(D0=port,D1=maxlen,A0=buff)
*
etherread movem.l d0-d2/a0-a2,-(sp)
   bsr portbit
er1 bclr d0,dtxin(a2)         * Wait for DTX
   beq er1
   scontrol #rdy
   sdata d0
er2 bclr d0,stxin(a2)         * Wait for STX
   beq er2
   moveq #-1,d0               * Count (adjusted for ETX)
   lea eths,a2
er3 subq #1,d1                * Adjust quota
   bmi.s er4                  * Limit exceeded ->
er35 move.b (a2),d2           * Wait for any character
   btst #0,d2
   beq er35
   move.b (a2),d2             * Make sure ?????
   addq.l #1,d0               * Count it
   btst #1,d2
   bne.s er5                  * Control ->
   move.b ethd-eths(a2),(a0)+ * Read data character
   bra er3
er4 move.b (a2),d2
   btst #0,d2
   beq er4
   move.b (a2),d2             * Make sure ?????
   addq.l #1,d0
   btst #1,d2
   bne.s er5
   move.b ethd-eths(a2),d2    * Discard excess data
   bra er4
er5 move.b #eion,(a2)         * Re-enable interrupts
   bsr unlock
   bra result
*
* %Integerfn fcomm(D0=CN,A0=string)
*
fcomm movem.l d0-d2/a0-a2,-(sp)
   tst.b d0                   * intercept logoff user 0
   bne.s fc0                  * n#0 ->
   and #logmask,d0
   cmp #logoff,d0
   bne.s fc0
   move.b userno+1,d0
   add.b #'0',d0
   clr.w userno
   tst.b d0
   bne.s fc0                  * We were logged on ->
   clr.l d0
   bra result                 * Ignore spurious logoff request
fc0 bsr prolog                * start packet, send CN and string
   sdata #nl
   bsr response               * Send ETX, Get response line
   move.b #eion,eths          * re-enable ER interrupts
   move.l (sp),d1             * Was it LOGON?
   and #logmask,d1
   cmp #logon,d1
   beq.s fc4                  * Yes ->
   bsr unlock
   bra result
fc3 clr d0
fc4 tst d0
   bmi fc3
   move d0,userno
   bsr unlock
   bra result
*
* %Integerfn fcommw(D0=CN,A0=params,D1=size,A1=buffer)
*
fcommw movem.l d0-d2/a0-a2,-(sp)
   bsr prolog                 * Send CN and params
   ror #4,d1                  * High-order Hdnibble
   add #'0',d1                * Send high nibble
   sdata d1
   rol #4,d1                  * restore low-order nibble
   and.b #15,d1
   add #'0',d1                * Send low nibble
   sdata d1
   sdata #nl
* Send data portion
* D2 = TXBE bit number in ETHS
* D1 = size of (rest of) data portion
* A2 = address of ETHD
* A1 = address of (next byte in) data buffer
* A0 = address of ETHS
   moveq #3,d2
   lea ethd,a2
   lea eths,a0
   moveq #-1,d1
   add.l 4(sp),d1
   bmi.s fcw2
fcw1 btst.b d2,(a0)    * 4 inst loop
   beq fcw1
   move.b (a1)+,(a2)
   dbra d1,fcw1
fcw2 bsr response
   move.b #eion,eths
   bsr unlock
   bra result
*
* %Integerfn fcommr(D0=CN,D1=maxsize,
*                   A0=parm,A1=buffer)
*
fcommr movem.l d0-d2/a0-a2,-(sp)
   bsr prolog
   sdata #nl
   bsr response
   move.l 4(sp),d1            * restore limit
   move.l d0,(sp)             * save size (as result)
* Read data portion
* D2 = CRF bit number in ETHS
* D1 = DRF bit number in ETHS
* D0 = number of bytes (left) to be read
* A2 = address of ETHD
* A1 = address of (next byte in) data buffer
* A0 = address of ETHS
   exg d1,d0
   sub.l d0,d1              * actual-maximum size
   bmi.s fcr1               * (won't fit: use max) ->
   move.l (sp),d0           * use actual size
fcr1 moveq #1,d1
   moveq #2,d2
   lea eths,a0
   lea ethd,a2
   subq.l #1,d0
   bpl.s fcr3
   bra.s fcr4
fcr2 btst.b d1,(a0)         * Outer 6 inst loop
   bne.s fcr5               * Got control ->
fcr3 btst.b d2,(a0)         * Inner 4 inst loop
   beq fcr2
   move.b (a2),(a1)+
   dbra d0,fcr3
* Data count exhausted or buffer full
* Scan to ETX (or next control character)
fcr4 btst.b d2,(a0)
   bne.s fcr7               * skip data char ->
   btst.b d1,(a0)
   beq fcr4
fcr5 move.b (a2),d0         * inspect control char
   cmp.b #etx,d0
   bne.s fcr6
   move.b ethc-eths(a0),d0  * skip ETX to avoid interrupt
fcr6 move.b #eion,(a0)
   bsr unlock
   bra return
fcr7 move.b (a2),d0
   bra fcr4
*
* Flush output buffer (used by fileout)
* placed here because of its stack frame size,
* to fit in with the event mechanism
* (reason has since disappeared)
flush move.l 4(a0),d2         * buffer limit address
   sub.l #512,d2              * buffer start address
   move.l (a0),d1             * current end of buffer
   sub.l d2,d1                * size of contents
   beq.s ret                  * empty block ->
   move.l d2,(a0)             * reset insert pointer
   move.l 12(a0),d0           * Transaction number
   beq.s ret                  * None ->
   add #writesq,d0
   move.l d2,a1
   lea nullstring,a0
   bsr fcommw
ret rts
*
* Auxiliary filestore routines
*
* Routine Magic(/D2=fsport,A2=\fsport>>3&3)
*
magic exg d0,d2
   clr.l d0
   move.b fsport,d0
   bsr portbit
   exg d0,d2
   rts
*
* %routine prolog(D0=CN,A0=string)
*
prolog bsr magic
pro0 bclr d2,ackin(a2)        * flush previous packet
   beq pro0
   bclr d2,nakin(a2)
   bne hangup                 * Filestore dead =>
   scontrol #dtx
   sdata d2
pro1 bclr d2,rdyin(a2)        * wait for RDY
   beq pro1
   scontrol #stx
   sdata d2
   ror #8,d0                  * send command letter
   sdata d0
   rol #8,d0
   tst.b d0
   bne.s pro15                * userno/xno supplied ->
   add userno,d0
   add.b #'0',d0
pro15 sdata d0
   move.b (a0)+,d2            * string length
pro2 sub.b #1,d2
   bmi ret
   move.b (a0)+,ethd
pro3 btst.b #3,eths
   bne pro2
   bra pro3
*
*
* %integerfn response
*
response bsr magic            * NB nests an extra lock
   bsr unlock                 * cancel nested extra lock
   scontrol #etx
res0 bclr d2,dtxin(a2)        * Wait for DTX or ACK/NAK
   bne.s res2                 * Got DTX ->
   btst d2,ackin(a2)
   beq res0                   * No ACK/NAK yet ->
   bclr d2,nakin(a2)
   beq.s res0                 * Not NAK ->
hangup lea fsdead,a0          * %signal 9,3,0,"Filestore dead"
   moveq #4,d1
   moveq #$53,d0
   bra signalevent
res2 scontrol #rdy
   sdata d2
res3 bclr d2,stxin(a2)        * wait for STX
   beq res3
   clr.l d0                   * hdhex accumulator
res4 btst.b #2,eths
   beq res4
   move.b ethd,d1
   cmp.b #nl,d1
   beq res9
   cmp.b #'-',d1
   beq res5
   sub.b #'0',d1
   bmi.s res8                 * Mod for OPENR/W ->xno,blocks,unused
   lsl.l #4,d0
   add.b d1,d0
   bra res4
* Filestore error: put error message into event message
* and %signal 9,3,errornumber,errormessage
res5 clr.l d1
res55 btst.b #2,eths
   beq res55
   move.b ethd,d2         * error digit
   sub.b #'0',d2
   cmp.b #7,d2            * error 7 is invalid userno,
   bne.s res57
   clr.w userno           * so invalidate it
res57 clr.l d1
   move.l processownarea,a5
   lea eventmess,a0
res6 move.b d1,(a0)
res65 btst.b #2,eths
   beq res65
   move.b ethd,d0
   cmp.b #nl,d0
   beq.s res7
   addq #1,d1
   move.b d0,0(a0,d1)
   bra res6
res7 move.b #eion,eths
   bsr unlock
   moveq #4,d1
   moveq #$53,d0
   lea eventmess,a0
   bra signalevent
res8 btst.b #2,eths
   beq res8
   move.b ethd,d1
   cmp.b #nl,d1
   bne res8
res9 rts
*

* 32x32 bit integer signed multiply to 32 bit result
* D0 := D0 * D1
* Overflow is reflected in SR on exit,
* but full mutiplication is done anyway.

imul movem.l d1-d4,-(sp)
   moveq #0,d4
   move.l d0,d2
   bpl.s m1
   neg.l d0
   moveq #1,d4
   move.l d0,d2
m1 swap d2
   move.l d1,d3
   bpl.s m2
   neg.l d1
   eor.w #1,d4
   move.l d1,d3
m2 swap d3
   tst.w d2
   beq.s maz     * A>>16=0 ->
   tst.w d3
   beq.s mbz     * B>>16=0 ->
   mulu d0,d3
   mulu d1,d2
   mulu d1,d0
   add.l d3,d2
   swap d0
   add.w d2,d0
   swap d0
   bra.s mv      * mandatory overflow ->
maz tst.w d3
   beq.s mabz    * A>>16=B>>16=0 ->
   mulu d0,d3
   mulu d1,d0
   swap d0
   add.w d3,d0
   swap d0
   swap d3
   tst.w d3
   bne.s mv      * certain overflow ->
   bra.s mvt     * possible overflow ->
mbz mulu d1,d2
   mulu d1,d0
   swap d0
   add.w d2,d0
   swap d0
   swap d2
   tst.w d2
   bne.s mv
   bra.s mvt
mabz mulu d1,d0
mvt tst.l d0
   bmi.s mv
   btst #0,d4
   beq.s m8
   neg.l d0
m8 tst.l d0
   movem.l (sp)+,d1-d4
   rts
mv btst #0,d4
   beq.s m9
   neg.l d0
m9 tst.l d0
   movem.l (sp)+,d1-d4
   or.b #2,ccr
   rts

* Divide 32 bit integer D0 by 32 bit D1
* D0 := quot, D1 := rem

idiv     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
         bhi.s   divsulp
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
         divs #0,d0            * invoke trap
         rts                   * never reached

*
*
*************************
* E n t r y   P o i n t *
*************************
*
* Initialise system variables
*
begin lea kbbeg,a0      * Keyboard buffer stuff
   move a0,kbin
   move a0,kbex
   clr.b (a0)
   clr.b cylock
   move.l #vduout,vep
   move.l #nullstring,kbprom
   move #lbeg,lpos
   move #lbeg,lend
   move.b #24,screenrows  * VDU emulation stuff
   move.b #80,screencols
   move.w #$4ef9,screenput
   move.l #aciascreenput,screenputa
   clr.w kbmode         * echo on, buffering on
   clr.l kexmask        * no KB exemptions
   bsr screenquota      * page mode
   move.w #-1,vquota    * On second thought, NOPAGE
   clr.w vdiscard       * output enabled
   clr.l breakpoint     * no breakpoints
   clr.w targetline
   clr.l watchpoint
   move.l 0,watchpoint+4
   clr.l etherr           * ether stuff
   clr.l stxin
   clr.l dtxin
   clr.l nakin
   move.l #$ffffffff,ackin
   clr.l rdyin
*  move.b fsport,ofsport
   clr userno              * not logged on
   move.l #dsqspu,dsqint
   move.l #dsqwait,dsqwai
   clr.l dtxmask
   clr.l dtxast
   move.l #68000,processor
*
* Initialise new-style extracode entry points
*
   moveq #63,d0
   lea $3f00,a0
** lea absent,a1
   move.w #$4ef9,d1
xcloop move.l a1,-(a0)
 move.l a0,(a0) **
   move.w d1,-(a0)
   dbra d0,xcloop
extracode macro
\* move.l #\2,\1+2
   endm
 extracode   $3f00-6,signalevent
 extracode  $3f00-12,imul
 extracode  $3f00-18,idiv
*extracode $3f00-120,new
*extracode $3f00-126,dispose
 extracode $3f00-132,nextsymbol
 extracode $3f00-138,readsymbol
 extracode $3f00-144,printsymbol
 extracode $3f00-150,printstring
 extracode $3f00-168,selectinput
 extracode $3f00-174,selectoutput
 extracode $3f00-192,closeinput
 extracode $3f00-198,closeoutput
*
* Remember main store particulars
*
   move.l freebot,membot
   move.l freetop,memtop
   move.l freetop,a0
   move.l a0,usp
*
* Initialise stream descriptors
* (Define all 4 input and all 4 output
*  streams as the null file)
*
   move.l freebot,d1
   sub.l a0,a0
   moveq #3,d0
buloop add.l #512,d1
   move.l d1,in0(a0)
   move.l d1,in0+4(a0)
   move.l #nullin,in0+8(a0)
   clr.l in0+12(a0)
   move.l d1,out0(a0)
   add.l #512,d1
   move.l d1,out0+4(a0)
   move.l #return,out0+8(a0)
   clr.l out0+12(a0)
   add.l #16,a0
   dbra d0,buloop
   move.l d1,freebot
*
* (Terminal and Ethernet interface have already
* been initialised, and the filestore ether port
* has been opened.  Now set up the timer to interrupt
* at 10Hz and to count milliseconds, driven from the
* prescaled E clock, i.e. 100kHz.
*
   clr.l millisecs
   lea ptm,a0
   move.w #99<<8+99,d0         * For dual mode, initialise both
   movep.w d0,12(a0)           * bytes of counter 3 to 100
   moveq #1,d0
   move.b d0,2(a0)             * select cr1
   move.b d0,(a0)              * reset counters
   clr.b 2(a0)                 * select cr3
   move.b #$47,(a0)            * int,contin,dual,internal,prescale
   move.b d0,2(a0)             * select cr1
   clr.b (a0)                  * start counters
*
* Shed privilege and identify the system
*
   move.b #vion,vdus
   move.b #eiof,eths
   move.w #$700,sr
   lea identity,a0
   bsr vptext
   lea terminal,a0
   clr.l d0
   bsr openoutput
   lea terminal,a0
   clr.l d0
   bsr openinput
   clr.l d0
   bsr selectoutput
   clr.l d0
   bsr selectinput
   move.w sr,d0     find out whether 68000 or 68010
   move.l processor,d0
   jsr pdec
   bsr newline
*
* Read in the system configurer
*
   lea main,a0
   move.l freebot,d0
   jsr load
   addq.l #3,d0
   and.b #$fc,d0
   move.l freebot,a0
   add.l d0,freebot
   move.b #eion,eths
   move.w #0,d0
   trap #0
*
* Enter it
*
   clr.l d0
   clr.l d1
   move.w 12(a0),d0  Reset offset
   add.l d0,d0
   move.w 14(a0),d1  Main offset
   add.l d1,d1
   move.w 4(a0),d2   Export size
   add.w 6(a0),d2    + (Import size, should be 0)
   move.l 16(a0),d3  MOA (module own area) size
   move.l #1024+512,d4
   add.l d3,d4       Clear POA(1k)+PCB(512)+MOA
zloop clr.l -(sp)
   subq.l #4,d4
   bgt zloop
   move.l sp,a4
   lea 0(a4,d3),a6
   lea 512(a6),a5
   move.l a5,processownarea
   move.l a6,currentpb
   sub.l a3,a3
   sub.l a2,a2
   sub.l a1,a1
   pea 32(a0,d1.l)
   lea 32(a0,d0.l),a0
   move.l #$80808080,d7
   move.l freebot,d6
   clr.l d5
   clr.l d4
   clr.l d3
   clr.l d2
   clr.l d1
   clr.l d0
   jsr (a0)
   move.l (sp)+,a0
   jsr (a0)
   clr.l d0
   jsr signalevent
   bra *
*
* Miscellaneous strings and texts
*
vdusetup   dc.b '  ',bs,bs,esc,'G',esc,'3',esc,'x',esc,'l'
           dc.b esc,'X',esc,'k',esc,'j',esc,'b',esc,'K',0
spyprom    dc.b esc,'Y% ',esc,'KSpy>',0
spyline    dc.b esc,'Y% '
freshline  dc.b nl,esc,'K',0
helpmess   dc.b esc,'Y% '
           dc.b nl,esc,'K^Y           Stop'
           dc.b nl,esc,'KR            Reload system'
           dc.b nl,esc,'KX addr size  eXamine store (SPY)'
           dc.b nl,esc,'KC            Continue freely'
           dc.b nl,esc,'KB addr       Continue to specified Breakpoint (PC)'
           dc.b nl,esc,'KS            Execute next Single instruction'
           dc.b nl,esc,'KL num        Continue to specified Line'
           dc.b nl,esc,'KN            Execute Next statement'
           dc.b nl,esc,'KP addr       Protect (watch) specified longword'
whatmess   text <esc,'Y% Now what? ',esc,'K'>
protmess   text <'Protege has changed'>
fsdead     string <'No ACK from filestore'>
disast     text <nl,'*Untrapped event '>
sp10       dc.b '  '
sp8        text <'        '>
dmess      text <nl,' D:'>
amess      text <nl,' A:'>
srmess     text <nl,'SR: '>
linemess   text <' Line '>
pcmess     text <esc,'K PC: '>
identity   dc.b 'System: '
           dc.b version>>20&15+'0'
           dc.b version>>16&15+'0'
           dc.b '/'
           dc.b version>>12&15+'0'
           dc.b version>>8&15+'0'
           dc.b '/'
           dc.b version>>4&15+'0'
           dc.b version&15+'0'
           text <nl,'CPU: '>
main       string <'system:lfs.mob'>
terminal   string ':'
   end