ttl Basic Operating System for Fred-Machine
 bin
version macro
\* dc.b 'System version 04/10/90'
  endm

* Features:
* Single-Process environment,
* VDU handling,
* Ethernet handling,
* Filestore handling (via ethernet),
* Simple 4+4 stream IO package,
* Simple software front-panel.
* This system is loaded by the ROM bootstrap into local RAM
* starting at $1000.  The system then loads the EXEC (command
* interpreter) into main store and leaps off into it.

* 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 $15
vion  equ $95
vbrkbit equ 4
vrrfbit equ 0
vtbebit equ 1
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'
resetsq 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
* Initial User stack < systop
systop  equ $3f00   * const
comdict equ $3fb0
fildict equ $3fc0
extdict equ $3fd0
sysdict equ $3fe0
freebot equ $3ff0   * set up by boot rom
freetop equ $3ff4
membot  equ $3ff8   * remembered by system
memtop  equ $3ffc
xfsport equ $3fa9

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

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

    org sysvars
event      ds.l 1   **order**
subevent   ds.l 1   **order**
eventinfo  ds.l 1   **order**
eventpc    ds.l 1   **order**
eventmess  ds.b 256 **order**
*
* Kernel stuff for trace etc
*
evc   ds.l 16       * Event context (16 regs)
ehc   ds.l 5        * 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
* Former site of ether stuff, moved further down
processor ds.l 1
clibeg ds.l 1
 ds.w 2
*
* 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          * nopage:single:notecho:noecho
vdiscard ds.b 1         * Non-zero after ^O
vblank  ds.b 1          * Non-zero if current line non-blank
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
fsport    ds.b 1        * 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
*
ansi  ds.b 1
prev  ds.b 1
*
*********************
* Exception vectors *
*********************
*
    org sysbot
nullstring equ 0
linenum equ *          **provisional**
 dc.l sysvars
 dc.l begin
 dc.l berrexc
 dc.l aerrexc
 dc.l illeexc
 dc.l zerodiv
 dc.l chkfail
 dc.l overflow
 dc.l privexc
 dc.l tracexc
 dc.l illeexc
 dc.l illeexc
 dc.l resexc
 dc.l resexc
 dc.l resexc
 dc.l resexc
 dc.l resexc
 dc.l resexc
 dc.l resexc
 dc.l resexc
 dc.l resexc
 dc.l resexc
 dc.l resexc
 dc.l resexc
*               Autovectors
 dc.l spuint0
 dc.l spuint1
 dc.l spuint2
 dc.l spuint3
 dc.l ethint
 dc.l kbint
 dc.l timeint
 dc.l spuint7
*               Trap vectors
 dc.l break    * Trap 0: breakpoint or SETSR
 dc.l restrap  * Trap 1: (formerly unassvar)
 dc.l getcpu   * Trap 2: D0 = 68000 or 68010
 dc.l restrap
 dc.l restrap
 dc.l restrap
 dc.l restrap
 dc.l restrap
 dc.l restrap
 dc.l restrap
 dc.l restrap
 dc.l restrap
 dc.l restrap
 dc.l restrap
 dc.l restrap
 dc.l linetrap
*
* External entry points
*
   rorg *
disp set $100
braw macro
 bra.w *+disp
disp set disp+2
 endm
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
 braw
jump macro
 dc.w $4ef9
 dc.l \1
 endm
 jump printsymbol,        * $10c0
 jump printstring,        * $10c4
 jump readsymbol,         * $10c8
 jump nextsymbol,         * $10cc
 jump prompt,             * $10d0
 jump testsymbol,         * $10d4
 jump selectinput,        * $10d8
 jump selectoutput,       * $10dc
 jump resetinput,         * $10e0
 jump resetoutput,        * $10e4
 jump closeinput,         * $10e8
 jump closeoutput,        * $10ec
 jump openinput,          * $10f0
 jump openoutput,         * $10f4
 jump etheropen,          * $10f8
 jump etherclose,         * $10fc
 jump etherwrite,         * $1100
 jump etherread,          * $1104
 jump fcomm,              * $1108
 jump fcommw,             * $110c
 jump fcommr,             * $1110
 jump signal,             * $1114
 jump absent, read,               * $1118
 jump absent, write,              * $111c
 jump absent, mull,               * $1120
 jump absent, divl,               * $1124
 jump absent, scompu,             * $1128
 jump absent, scomp,              * $112c
 jump cputime,            * $1130
 jump absent, arraydef,           * $1134
 jump absent, arrayget,           * $1138
 jump absent, arrayref,           * $113c
 jump settermmode,        * $1140
 jump absent,  intpower   * $1144
 jump absent,  rplus      * $1148
 jump absent,  rminus     * $114c
 jump absent,  rmult      * $1150
 jump absent,  rdiv       * $1154
 jump absent,  rpower     * $1158
 jump absent,  rnegate    * $115c
 jump absent,  float      * $1160
 jump absent,  fracpt     * $1164
 jump absent,  intpt      * $1168
 jump absent,  sqrt       * $116c
 jump absent,  line3      * $1170
 jump absent,  trapeze3   * $1174
 jump absent,  triangle3  * $1178
 jump defname,            * $117c
 jump refname,            * $1180
 jump transname,          * $1184
 jump defineeh,           * $1188
 jump nhex,               * $118c
 jump bhex,               * $1190
 jump whex,               * $1194
 jump lhex,               * $1198
 jump rhex,               * $119c
 jump absent,  ?etherbits?* $11a0
 jump absent,  hline3     * $11a4
 jump absent,  fill3      * $11a8
 jump absent,  clear3     * $11ac
 jump absent,  vline3     * $11b0
 jump absent,  plot3      * $11b4
 jump absent,  undefined  * $11b8
 jump absent,  undefined  * $11bc
*
* External not loaded
*
absent move.l (sp),a0
  move.w -2(a0),d0
  ext.l d0
  move.l d0,eventinfo
  clr.w eventmess
  move.l #$90,d0
  bra signal
*
* Hex I/O
*
lhex move.w d0,-(sp)
  swap d0
  bsr.s whex
  move.w (sp)+,d0
whex move.w d0,-(sp)
  lsr.w #8,d0
  bsr.s bhex
  move.w (sp)+,d0
bhex move.w d0,-(sp)
  lsr.w #4,d0
  bsr.s nhex
  move.w (sp)+,d0
nhex and.l #15,d0
  cmp #9,d0
  ble.s nh1
  addq #7,d0
nh1 add #'0',d0
  bra printsymbol
*
rhex clr.l d1
  bsr nextsymbol
  cmp #' ',d0
  bgt.s rh1
  bsr readsymbol
  bra rhex
rh1 cmp #'0',d0
  blt.s rh9
  cmp #'9',d0
  ble.s rh2
  and #95,d0
  cmp #'A',d0
  blt.s rh9
  cmp #'F',d0
  bgt.s rh9
  subq #7,d0
rh2 sub #'0',d0
  lsl.l #4,d1
  add d0,d1
  bsr readsymbol
  bsr nextsymbol
  bra rh1
rh9 move.l d1,d0
  rts
*
* Included files
*
*  incl fmacs:impperm.asm
*  incl fmacs:extended.asm
   incl fmacs:dict.asm
*
************************
* Exception processing *
************************
*
* Bus and Address errors
*
berrexc move.l d0,eventmess+8
   moveq #$20,d0
   bra.s aberror
aerrexc move.l d0,eventmess+8
   moveq #$30,d0
*
aberror cmp.l #68000,processor
   beq.s aberr000
   move.w $18(sp),$30(sp)   Instruction
   move.w (sp),$32(sp)      SR
   move.l 2(sp),$34(sp)     PC
   move.l $a(sp),$2c(sp)    Address
   move.w 8(sp),$2a(sp)     Function codes
   clr.w $38(sp)            Format word
   lea $2a(sp),sp
aberr000 move.w (sp)+,eventmess+2
   move.l (sp)+,eventinfo
   move.w (sp)+,eventmess+4
   move.w (sp),eventmess+6
   clr.w eventmess
   bra signald0
*
* Spurious interrupts
*
spuint0 move.w #'0',-(sp)
   bra.s spuint
spuint1 move.w #'1',-(sp)
   bra.s spuint
spuint2 move.w #'2',-(sp)
   bra.s spuint
spuint3 move.w #'3',-(sp)
   bra.s spuint
spuint7 move.w #'7',-(sp)
spuint move.l a0,-(sp)
   lea intnum,a0
   move.b 5(sp),(a0)
   move.l (sp)+,a0
   addq.l #2,sp
   pea spint
   bra except
* 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
  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 move.l #68010,processor
  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
  rte

*
* Exception or trap generated signals
*
illeexc move.l #-$40,d0  * Illegal instruction: event 0,4
   bra.s signald0
privviol move.l #-$80,d0  * Privilege violation: event 0,8
   bra.s signald0
resexc equ *
restrap move.l #-$50,d0 * Reserved trap: event 0,5
   bra.s signald0
zerodiv moveq #-$41,d0 * Divide by zero: event 1,4
   bra.s signald0
chkfail moveq #-$26,d0 * Array bound fault: event 6,2
   bra.s signald0
overflow moveq #-$11,d0 * Integer overflow: event 1,1
*  bra.s signald0
*unassvar moveq #-$18,d0 * Unassigned variable: event 8,1
signald0 move.l 2(sp),eventpc
   move.l #signalx,2(sp)
   rte
*
*  Trap 2 - Acquire processor type to D0
*
getcpu move.l processor,d0
   rte
*
* Signal event
* If d0<0 then d0 is -(subevent<<4+event) and extra info is absent
* Otherwise d0 is subevent<<4+event and extra info is present
*
stop clr.l d0
signal move.l (sp)+,eventpc
signalx movem.l d0-d7/a0-a7,evc
   tst.l d0
   bpl.s signaly             * extra present ->
   clr.w eventmess
   clr.l eventinfo
   neg.l d0
signaly move.l d0,event
   lsr.l #4,d0
   move.l d0,subevent
   moveq #15,d0
   and.l d0,event
*
* Invoke event handler
*
signalz movem.l ehc,a3-a7
   move.l a3,(sp)
   rts
*
* Define event handler
*
defineeh move.l (sp),a3
   movem.l a3-a7,ehc
   rts
*
* Trap 0: Set SR=D0 (or breakpoint)
*
setsr move.w d0,(sp)          * Trap 0: Set SR = D0
   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)+,d0     * new line number
 bclr #14,d0
   move.w d0,linenum   * updated
   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
*
*  Trap 0 - Breakpoint or SetSR
*
break  tst.l breakpoint       * Breakpoint?
   beq setsr                  * No ->
   subq.l #2,2(sp)            * replace the instruction
   move.l a0,-(sp)
   move.l breakpoint,a0
   move.w breakpoint+4,(a0)
   clr.l breakpoint
   move.l (sp)+,a0
tracexc tst.l watchpoint
   bne.s guardduty
ftracexc pea nullstring
except movem.l d0-d7/a0-a6,rsave * Save registers
   move.w #-1,vquota
   moveq #0,d0
   bsr cursor
   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 hexlong
   dbra d3,dis1
   lea amess,a0
   bsr vptext
   moveq #7,d3                * Address registers
dis2 bsr space
   move.l (a3)+,d0
   bsr hexlong
   dbra d3,dis2
   bsr newline
   bsr clearline
   lea srmess,a0              * Status Register,
   bsr vptext
   move (sp),d0
   bsr hexword
   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
   clr.l d1
   bsr hexword *was:write
   move.l (sp)+,curout
dis25 lea pcmess,a0           * and Program Counter
   bsr vptext
   move.l 2(sp),d0
   bsr hexlong
   btst.b #7,(sp)             * If we are single-stepping,
   beq.s dis3
   bsr space                  * show previous PC also
   move.l lastpc,d0
   bsr hexlong
*
*********************************
* Trace mode command processing *
*********************************
*
dis3 bsr line5
   lea whatmess,a0
   bsr vptext
exccom bsr kbrsym
exc2 cmp.b #'Y'-64,d0         * ^Y - Kill
   beq kill
   cmp.b #32,d0
   blo 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
   bsr line5
   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 #$4e40,(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)
   moveq #$10,d0    * %signal 0,1,0
   bra signald0
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 equ *
   btst.b #vrrfbit,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 cmp.b #32,d0            * if not control
   bhs vpsym                  * then echo
   rts
*
*
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 bsr line5
   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 bsr line5
spy3 move a3,d1
   and #15,d1
   bne.s spy4
   bsr newline
   move.l a3,d0
   bsr hexlong
   moveq #':',d0
   bsr vpsym
spy4 bsr space
   move.b (a3)+,d0
   bsr hexbyte                * 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 ethnps
ethi0 equ *
   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 hexbyte
   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 hexbyte
   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
   jsr (a0)                  * Call the AST
   movem.l (sp)+,d2-d7/a1-a6 * and return from int
   bra ethiret
*
* Disk interrupt handler
*
dsqtry move.l dsqint,-(sp)
   rts
dsqwait move.l (sp)+,dsqint
   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
   btst #vrrfbit,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, etc
   beq kbctrly
   cmp.b #'T'-64,d0
   beq kbctrlt
   cmp.b #'P'-64,d0
   beq kbctrlp
   cmp.b #'S'-64,d0
   beq kbctrls
   cmp.b #'Q'-64,d0
   beq kbctrlq
   cmp.b #'O'-64,d0
   beq kbctrlo
   cmp.b #'X'-64,d0
   beq kbctrlx
   cmp.b #'F'-64,d0
   beq kbctrlf
kbbung tst.w vquota           * Test for freeze-mode
   beq.s frozen
*kbbung was HERE before
  move.b d0,(a0)+             * Attempt to insert into buffer
  cmp.b #'[',d0
  bne.s bung1
  cmp.b #esc,prev
  bne.s bung1
  move.b d0,ansi
bung1 move.b d0,prev
   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
   jsr screenput
   bra kbiret
frozen move.w #1,vquota
   cmp.b #nl,d0               * NL feeds a line,
   beq kbiret                 * other controls feed a page.
   bsr screenquota
   bra kbiret
line5 move.w #$500,d0         * move to col 0 row 5
   bsr cursor
clearline jsr escape
   move.b #'K',d0
   jmp screenput
screenbot move.b screenrows,d0
   subq.b #1,d0
   lsl.w #8,d0
cursor move.w d0,-(sp)
   jsr escape
   tst.b ansi
   bne.s ansicursor
   moveq #'Y',d0
   jsr screenput
   move.w (sp),d0
   clr.b d0
   rol.w #8,d0
   add.b #' ',d0
   jsr screenput
   move.w (sp)+,d0
   add.b #' ',d0
   jmp screenput
ansicursor move.w (sp),d0
   clr.b d0
   rol.w #8,d0
   addq.w #1,d0
   jsr screendec
   moveq #';',d0
   jsr screenput
   move.w (sp)+,d0
   and.w #255,d0
   addq.w #1,d0
   jsr screendec
   moveq #'H',d0
   jmp screenput
screendec and.l #$ffff,d0
  divu #10,d0
  beq.s screendec1   * quot zero ->
  swap d0
  move.w d0,-(sp)    * preserve rem
  swap d0
  bsr screendec      * recursive call
  move.w (sp)+,d0
  bra.s screendec2
screendec1 swap d0
screendec2 add.w #'0',d0
  jmp screenput
escape moveq #esc,d0
  tst.b ansi
  bne.s ansiesc
  jmp screenput
ansiesc jsr screenput
  moveq #'[',d0
  jmp screenput
screenquota move.w d0,-(sp)
   move.w #0,d0
   move.b screenrows,d0
   move.w d0,vquota
   move.w (sp)+,d0
   rts
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
   moveq #'^',d0
   jsr screenput
   moveq #'Y',d0
   jsr screenput
   bra kbiret
firenow movem.l (sp)+,d0-d1/a0
   bclr.b #7,(sp)
   moveq #$10,d0
   bra signald0
kbctrlp move.w kbin,a0
   move.b #$80,(a0)            * Note pointer does not move
   bra kbiret
kbctrls move.w #0,vquota
   bra kbiret
kbctrlf move.w #-1,vquota
   moveq #' ',d0
   jsr screenput
   moveq #bs,d0
   jsr screenput
   bchg.b #3,kbmode+1
   beq kbiret
   move.w #1,vquota
   moveq #'P',d0
   jsr screenput
   moveq #bs,d0
   jsr screenput
   bra kbiret
kbctrlq bsr screenquota
   btst.b #3,kbmode+1
   beq kbiret
   move.w #-1,vquota
   bra kbiret
kbctrlo eor.b #1,vdiscard
   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
   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.b vdiscard         * Test for ^O
   bne return
   bsr.s vpsym
   bra return
*
space moveq #' ',d0
vpsym cmp.b #nl,d0
   beq.s newline              * NL ->
   move.b #1,vblank
vps0 tst.w vquota             * Wait while xoffed
   beq.s vps0
   jmp screenput
aciascreenput btst.b #vtbebit,vdus   * Wait for TXBE
   beq aciascreenput
   move.b d0,vdud
   rts
newline tst.w vquota          * Test for page mode
   beq newline                * (Xoffed)
   bmi.s nl2                  * Free mode ->
   sub.w #1,vquota
   bgt.s nl2                  * still OK ->
   move.w #1,vquota
   move.b vblank,d0
   beq.s nl0
   moveq #bs-' ',d0
nl0 add #' ',d0
   bsr vps0
   clr.w vquota
nl1 tst.w vquota              * Wait
   beq nl1
nl2 moveq #cr,d0              * Newline -> CR,LF
   bsr vps0
   moveq #lf,d0
   bsr vps0
   moveq #nl,d0
   clr.b vblank
   rts
*
* VDU print text (uses 0-termination)
*
vptext move.b (a0)+,d0
   beq ret
   bsr vpsym
   bra vptext
*
* VDU print hex routines for kernel
*
hexlong move d0,-(sp)
   swap d0
   bsr hexword
   move (sp)+,d0
hexword move d0,d2
   lsr #8,d0
   bsr hexbyte
   move d2,d0
hexbyte move d0,d1
   lsr #4,d0
   bsr hexnibble
   move d1,d0
hexnibble and.b #15,d0
   cmp.b #9,d0
   ble.s hn1
   add.b #7,d0
hn1 add.b #'0',d0
   bra vpsym
*
* %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 #-$19,d0
   bra signal
*
* 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
   add.l #24,sp
   moveq #-$19,d0        * And %signal 9,1
   bra signal
*
* 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.b 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
  bra signal
kbesc moveq #esc,d0
  bsr insert
  bsr getsymbol
  bsr insert
  cmp.b #'[',d0
  beq.s kbansi
  cmp.b #'O',d0
  beq.s kbmore
  cmp.b #'?',d0
  beq.s kbmore
  bra kbfree
kbansi move.b d0,ansi
kbmore 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.b vdiscard
   move.w #-1,vquota
   btst #3,d0
   beq screenquota
   rts
*
* %Routine selectinput(D0=stream)
*
selectinput tst.l d0
   bmi.s si1
   cmp.l #3,d0
   ble.s si2
si1 move.l d0,eventinfo
   clr.w eventmess
   moveq #$76,d0
   bra signal
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 #resetsq,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 *
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 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?
   bne.s difile               * Does not start with ':' ->
di3 cmp.b #1,d0               * Just ":"?
   beq.s divdu                * Yes ->
   cmp.b #2,d0       **
   bne.s difile      **       * Not two chars: file ->
   move.b 2(a1),d0            * second char of name
   or.b #32,d0                * To lower case
   cmp.b #'n',d0
   beq dinull                 * ":N" is null
   cmp.b #'t',d0
   bne.s difile               * ":T" is terminal
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
*
* %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)
   bne.s dofile
do3 cmp.b #1,d0
   beq dovdu
   cmp.b #2,d0     **
   bne.s dofile    **
   move.b 2(a1),d0
   or.b #32,d0
   cmp.b #'n',d0
   beq return
   cmp.b #'t',d0
   bne.s dofile
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
   bra signal
*
* 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"
   lea eventmess,a1
   clr d0
   move.b (a0),d0
hang1 move.b (a0)+,(a1)+
   dbra d0,hang1
   clr.l eventinfo
   moveq #$33,d0
   bra signal
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,d1         * error digit
   sub.b #'0',d1
   move.l d1,eventinfo
   cmp.b #7,d1            * error 7 is invalid userno,
   bne.s res57
   clr.w userno           * so invalidate it
res57 clr.l d1
   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 #$33,d0
   bra signal
res8 btst.b #2,eths
   beq res8
   move.b ethd,d1
   cmp.b #nl,d1
   bne res8
res9 rts
*
*
*************************
* E n t r y   P o i n t *
*************************
*
* Initialise system variables
*
begin move.l #68000,processor
   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
   move.b #80,screencols
   move.l #aciascreenput,screenputa
   clr.l d0
   bsr settermmode
   clr.b vblank
   clr.l kexmask
   clr.l breakpoint
   clr.w targetline
   clr.l watchpoint
   move.l 0,watchpoint+4
   move.w #$4ef9,screenput
   clr.l etherr           * ether stuff
   clr.l stxin
   clr.l dtxin
   clr.l nakin
   move.l #$ffffffff,ackin
   clr.l rdyin
   move.b xfsport,fsport
   clr.b ansi
   clr userno              * not logged on
   move.l #dsqspu,dsqint
   move.l #dsqwait,dsqwai
   clr.l dtxmask
   clr.l dtxast
*
* Remember main store particulars
*
   move.l freebot,membot
   move.l freetop,memtop
*
* 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
*
* Define streams 0 as .t and select them
*
   clr.l d0
   lea tty,a0
   bsr openinput
   clr.l d0
   lea tty,a0
   bsr openoutput
   clr.l d0
   bsr selectinput
   bsr selectoutput
*
* Terminal and Ethernet interface have already
* been initialised, and the filestore ether port
* has been opened, by the ROM firmware.
* Now set up timer 3 of the PTM.
* 10MHz CPU clock
* -> 1MHz E clock -> prescaler
* -> 125 kHz -> low-order byte
* -> 1 kHz -> high-order byte
* -> 10Hz interrupt rate.
*
   clr.l millisecs
   lea ptm,a0
   move.w #99<<8+124,d0        * Dual mode, div by 125 and 100
   movep.w d0,12(a0)
   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
*
* Create the System/External/File/Command dictionaries
*
credict macro
   move.l freebot,d0
   lea \1,a0
   move.l d0,(a0)+
   move.l d0,(a0)+
   add.l #\2*4,d0
   move.l d0,(a0)+
   clr.l (a0)+
   move.l d0,freebot
   move.l d0,a0
   move.w #\2-1,d0
\@a clr.l -(a0)
   dbra d0,\@a
   endm
   credict sysdict,500
   credict extdict,8
   credict fildict,2200,*3000,*2000
   credict comdict,2000,*1000
*
* Load the CLI
*
   move.l freebot,d0
   move.l d0,clibeg
   lea cli,a0
   jsr $408
   add.l d0,freebot
*
* Enable vdu and ether interrupts
*
   move.b #vion,vdus
   move.b #eion,eths
*
* Shed privilege and non-interruptability
* and identify the system
*
   and.w #0,sr
   move #systop,sp
   lea sysver,a0
   bsr vptext
*ansiloop jsr testsymbol
*   tst.l d0
*   bge ansiloop
*
* Establish processor type
*
   move.w sr,d0
*
* Set event trap
*
   move.l #-1,event
   bsr defineeh
   tst.l event
   bge ohno
   clr.l event

* FE02 header offsets etc

export    equ 4
import    equ 6
codesize  equ 8
resetep   equ 12
mainep    equ 14
ownsize   equ 16
hdrsize   equ 32
poasize   equ 1024 ?

*
* Enter loaded CLI.  Allocate space for
* process-own and module-own areas, clear this,
* set up registers, call reset then main routine.
*
   move.l freetop,sp
   move.l clibeg,a0
   move.l #poasize+3,d0      (rounding up to 4n)
   add.l ownsize(a0),d0      bytes needed
   lsr.l #2,d0               now longwords
   subq #1,d0                adjust for DBRA
   moveq #0,d1
loop move.l d1,-(sp)         clear allocated space
   dbra d0,loop
   move.l sp,a4              module own area base
   move.l ownsize(a0),d0     MOA size
   add.l #3,d0
   and.b #$fc,d0             rounded up to 4n
   lea 0(a4,d0.l),a5         process own area base
   move.l #$80808080,d7      unassigned pattern
   moveq #0,d4               byte extender
   lea 0,a6                  optional
   lea 0,a3                     "
   lea 0,a2                     "
   moveq #0,d6                  "
   moveq #0,d5                  "
   moveq #0,d2
   move.w resetep(a0),d2
   add.l d2,d2               reset routine offset
   moveq #0,d3
   move.w mainep(a0),d3
   add.l d3,d3               entry point offset
   moveq #0,d0
   move.w export(a0),d0      size of export section
   moveq #0,d1
   move.w import(a0),d1      size of import section
   bne.s ohno                (should be 0)
   add.l d1,d0               + export section size
   lea hdrsize(a0,d0.l),a0   start of code section
   pea 0(a0,d3.l)            save entry point addr
   jsr 0(a0,d2.l)            call reset routine
   move.l (sp)+,a1           restore main e p a
   move.l clibeg,a0          pass header address
   jsr (a1)                  call main program
   jmp *                     ?? should not return
*
* Error of some sort
*
ohno lea disast,a0
   bsr vptext
   move.l event,d0
   bsr hexlong
   bsr space
   move.l subevent,d0
   bsr hexlong
   bsr space
   move.l eventinfo,d0
   bsr hexlong
   bsr space
   move.l eventpc,d0
   bsr hexlong
   bsr newline
   lea eventmess,a0
   clr.l d0
   move.b (a0)+,d0
   clr.b 0(a0,d0)
   bsr vptext
   bsr newline
   bra.w *

*
* Miscellaneous strings and texts
*
tty        dc.b 2,':t'
spyprom    dc.b 'Spy>',0
helpmess   dc.b nl,'^Y           Stop                '
           dc.b nl,'R            Reload system       '
           dc.b nl,'X addr size  eXamine store (SPY) '
           dc.b nl,'C            Continue freely     '
           dc.b nl,'B addr       Continue to PC      '
           dc.b nl,'S            Single instruction  '
           dc.b nl,'L num        Continue to Line    '
           dc.b nl,'N            Next statement      '
           dc.b nl,'P addr       Protect longword    '
           dc.b nl
whatmess   dc.b 'Now what? ',0
protmess   dc.b 'Protege has changed',0
fsdead     dc.b 21,'No ACK from filestore',0
disast     dc.b nl,'*Untrapped event ',0
spint      dc.b '*Spurious auto-interrupt '
intnum     dc.b '0',0
sp10       dc.b '  '
sp8        dc.b '        ',0
dmess      dc.b nl,' D:',0
amess      dc.b nl,' A:',0
srmess     dc.b 'SR: ',0
linemess   dc.b ' Line ',0
pcmess     dc.b ' PC: ',0
sysver     version
           dc.b nl,esc,'Z',0
cli        dc.b 14,'fmacs:xcli.mob'
           ds.w 0
   end