*****************************************************************
*                                                               *
*               UNIX Hardware Support Routines                  *
*                                                               *
*               Perkin-Elmer 7/32, 8/32, 3220, 3240             *
*                                                               *
*               (C) 1980, Richard Miller                        *
*                   University of Wollongong                    *
*                                                               *
*****************************************************************
track   equ 1   system state tracks.
	entry   u
	entry   start,idle,waitloc
	entry   initf,icode,szicode
	entry   fuword,fubyte,fuiword,fuibyte
	entry   suword,subyte,suiword,suibyte
	entry   save,resume
	entry   bcopy
	entry   copyin,copyout
	entry   kcopyi,kcopyo
	entry   clearseg,copyseg
	entry   addupc
	entry   spl0,spl1,spl4,spl5,spl6,spl7,splx
	entry   ss,oc,wd,wh,wdh,rd,rh,rdh
	entry   lra,lraddr
	extrn   kisa0,useg
	extrn   uisa,kisa
	extrn   memtop
	extrn   totmem
	extrn   dumpsw
	extrn   clockaddr
	extrn   ksp,maxsp
	extrn   addrsw
	extrn   main
	extrn   mm.npsw
	extrn   end,edata
    ifnz        PIC
	extrn   rdpic,sytim
    endc
*
* psw bit definitions
*
ps.wait equ     x'8000' wait state
ps.io   equ     x'4000' immediate interrupt mask
ps.mm   equ     x'2000' machine malfunction interrupt mask
ps.af   equ     x'1000' arith fault interrupt mask
ps.il   equ     x'0800' interrupt levels (8/32)
ps.rp   equ     x'0400' memory relocation / protection
ps.sq   equ     x'0200' system queue service mask
ps.prot equ     x'0100' protect mode
ps.ureg equ     x'00f0' user register set
*
* psw definitions
*
ps.user equ     ps.io+ps.mm+ps.af+ps.rp+ps.prot+ps.ureg
ps.idle equ     ps.wait+ps.io+ps.mm+ps.af+ps.rp+ps.ureg
ps.kern equ     ps.io+ps.mm+ps.af+ps.rp+ps.ureg
ps.disb equ     ps.mm+ps.af+ps.rp+ps.ureg
ps.trap equ     ps.mm+ps.af
ps.cold equ     ps.mm+ps.ureg

*
* register definitions
*
r0      equ     0
r1      equ     1
r2      equ     2
r3      equ     3
r4      equ     4
r5      equ     5
r6      equ     6
r7      equ     7
r8      equ     8
r9      equ     9
r10     equ     10
r11     equ     11
r12     equ     12
r13     equ     13
r14     equ     14
r15     equ     15
rf      equ     15
sp      equ     r7

    ifz M3240
CLICK   equ     256
CSHIFT  equ     8
    else
CLICK   equ     2048
CSHIFT  equ     11
    endc

*
*
	ifnz    M3240
*
* per-process data area for current process - always mapped to segment ff
*
u       equ     y'ff0000'
usize   equ     2048/CLICK*2     make room for 256 segmentation regs
	else
*
* per-process data area for current process - always mapped to segment f
*
u       equ     y'f0000'
usize   equ     2048/CLICK
	endc

*****************************************************************
*                                                               *
*  start:       System Initialization                           *
*                                                               *
*       Clear bss and user memory                               *
*       Establish kernel memory relocation and stack            *
*       Call 'main' to complete initialization                  *
*       Enter process 1 ('init') in user mode                   *
*                                                               *
*****************************************************************

	pure
	align   2
	entry   start
	extrn   trmask
	extrn   devmap,devint
	entry   state

	align   adc
state   dc      0
	dc      devmap,devint
start   equ     *

* on entry from bootstrap loader, disable mac & interrupts

	lis     r1,0            set mask to 0, no tracing
	st      r1,trmask       turn on tracing
	lhi     r1,ps.ureg      disable everything
	epsr    r0,r1
    ifnz        WCS
      ifz  M3240

* initialize writeable control store to vector to illegal instruction handler

	la      r2,wcs.ill      vector to illegal instruction handler
	li      r0,x'800'       wcs starts at word 800
wcslp   lis     r1,0            transfer one word
	wdcs    r2              write to wcs
	ais     r0,1            next wcs word
	ci      r0,x'1000'      total of 2k words
	bne     wcslp
	impur
	align   adc
wcs.ill dc      y'0e000070'     wcs branch to illegal instruction handler
	pure
      endc
    endc


* clear per-process data area and bss to zeroes
	lis     r0,0
	la      r5,end          end of kernel
	ahi     r5,CLICK-1              round up to 256 byte block
	nhi     r5,-CLICK
	la      r2,CLICK*usize(r5)      end of u area
	la      r1,edata                start of bss
clp     equ     *
	st      r0,0(r1)        clear a word
	ais     r1,4            next word
	cr      r1,r2           finished?
	bl      clp             no - repeat

* Find out how much memory is available

	lcs     r1,1
	am      r1,memtop
	lr      r1,r2           end of u area
	li      r2,y'fedcba98'  test data value
memlp   equ     *
	st      r2,0(r1)        try storing word
	c       r2,0(r1)        did it work?
	bne     memend          no - end of memory
	ahi     r1,CLICK                yes - try next 256 byte block
	c       r1,memtop       reached upper limit?
	bl      memlp           no - keep looking
memend  equ     *
	sis     r1,1            highest valid address
	st      r1,memtop       save it
	l       r1,totmem       how much memory altogether
	ais     r1,1
	srl     r1,CSHIFT               max memory (in 256-byte blocks)

    ifz M3240

* initialize prototype mac registers for kernel address space:

* segments 0-n: map real low-core addressess (up to n*64k)
*           f : maps per-process data area for current process
* all others  : invalid

	la      r2,kisa0        kernel seg regs
	li      r0,y'0ff00010'  prototype seg reg value
seglp   equ     *
	chi     r1,CLICK                more than full segment left?
	bm      seglast         no - set last segment
	st      r0,0(r2)        set seg reg
	ais     r2,4
	ai      r0,y'10000'     origin of next segment
	shi     r1,CLICK                memory left
	b       seglp

seglast equ     *
	sis     r1,1            last segment length - 1
	bm      segx            no partial segment - skip
	sll     r1,20           move to seg length field
	ni      r0,y'fffff'
	or      r0,r1
	st      r0,0(r2)        set seg reg
	ais     r2,4

segx    equ     *
	la      r2,useg         per-process data segment
	lr      r0,r5           address of end of kernel
	oi      r0,usize*y'100000'+x'10'        size & protection
	st      r0,0(r2)        set as segment for pda

    else

* initialize kernel segment table:

* segments 0-n: map real low-core addressess (up to n*64k)
*          ff : maps per-process data area for current process
* all others  : invalid

	la      r2,kisa0        kernel seg regs
	li      r0,y'5c3e0000'  prototype seg reg: present, rd, wrt, exe, len=31
seglp   equ     *
	chi     r1,32           more than full segment left?
	bm      seglast         no - set last segment
	st      r0,0(r2)        set seg reg
	ais     r2,8
	ai      r0,512          origin of next segment (shifted <<4)
	shi     r1,32           memory left
	b       seglp

seglast equ     *
	sis     r1,1            last segment length - 1
	bm      segx            no partial segment - skip
	sll     r1,17           move to seg length field
	ni      r0,-1-y'3e0000' remove the length field from proto
	or      r0,r1
	st      r0,0(r2)        set seg reg
	ais     r2,8

segx    equ     *
	la      r2,useg         per-process data segment
	lr      r0,r5           address of end of kernel
	srl     r0,7
	oi      r0,usize*y'20000'+y'5c000000'   size, present, rd, wrt, exe
	st      r0,0(r2)        set as segment for pda
    endc


* start kernel stack pointer at top of per process area

	la      sp,CLICK*usize+u-4
	st      sp,ksp          save sp for interrupts
	st      sp,maxsp        save as 'empty stack' ptr

* load hardware mac registers from kernel prototypes, and enable
* memory relocation / protection and interrupts

	l       r1,kisa         kernel seg regs
	bal     r6,addrsw       load into mac regs
    ifnz    track
	lis     r1,2
	st      r1,state
    endc
	li      r1,ps.kern      enable mac & interrupts
	epsr    r0,r1
    ifnz    track
	lis     r1,3
	st      r1,state
    endc

* call main() c routine to complete initialization

	bal     rf,main

* on return from main, enter 'user state' at user address 0 to exec
*  init process

	epsr    r3,r3           disable the mac
	nhi     r3,x'ffff'-ps.rp
	epsr    r0,r3
	l       r1,uisa         user seg regs
	bal     r6,addrsw       switch address space
	lhi     r0,ps.user      user state psw
	lis     r1,0            address 0 in user space
	lpswr   r0              enter process 1

* Bootstrap program to load in init process:
*
*       exec("/etc/init", "/etc/init");
*       for (;;)
*               ;

	align   adc
icode   equ     *
	svc     0,11            * exec *
	dc      a(initf-icode)
	dc      a(initp-icode)
	b       *               didn't work -- loop forever
	align   adc
initp   dc      a(initf-icode)
	dc      0
	align   adc
initf   db      c'/etc/init',0
* extra patch space in case of emergency
	align   adc
	db      0,0,0,0,0,0,0,0,0,0
	align   adc             must be even words for copyout
szicode dc      *-icode         size of icode

*****************************************************************
*                                                               *
* dump:         Memory dump to disk or magtape                  *
*                                                               *
*       Save register sets 0 and F so they will appear in dump  *
*       Call (*dumpsw)() to dump all of memory                  *
*                                                               *
*****************************************************************

	pure
	align   2
	entry   dump
dump    equ     *
	lpsw    dump.ps1        reg set F, disabled
dump1   stm     r0,uregs        save reg set F
	lpsw    dump.ps2        reg set 0, disabled
dump2   stm     r0,eregs        save reg set 0

dloop   equ     *
	l       sp,memtop       start stack pointer at top of physical memory
	ni      sp,-4
	l       r1,dumpsw       address of dump routine
	balr    rf,r1
	lpsw    dump.ps3        wait
dump3   b       dloop           if restarted, dump again

	align   adc*2
dump.ps1 dc     y'000f',dump1
dump.ps2 dc     y'0000',dump2
dump.ps3 dc     y'8000',dump3

	entry   uregs,eregs
	impur
	align   adc
uregs   das     16
eregs   das     16

*****************************************************************
*                                                               *
* display:      Display Panel Driver  ( 7/32 and 8/32 only )    *
*                                                               *
* Called by clock() at each tick to read display switch         *
* register, and display value addressed by csw on display panel *
*                                                               *
*****************************************************************

	pure
	align   2
	entry   display,csw
display equ     *
    ifz M3200
*
* read console switch register
*
	lis     r1,1            display address always 01
	oc      r1,dis.norm     set 'normal' mode
	rhr     r1,r2           read halfword
	exbr    r2,r2           reverse bytes
	st      r2,csw          save for getswit()
*
* if switches are zero, display pc
*
	lr      r2,r2           zero?
	bnz     disp.ad         no - use as address
	l       r2,0(sp)        yes - display parm (pc)
	b       disp.wr
*
* use switch contents as an address in kernel space
*
disp.ad equ     *
	thi     r2,1            odd address ?
	bz      disp.ev         no - skip
	ai      r2,y'10000'     yes - use segment 1
disp.ev equ     *
	ni      r2,-4           make sure of word boundary
	l       r2,0(r2)        load value
*
* display *(csw) on display panel
*
disp.wr equ     *
	oc      r1,dis.incr     set 'incremental' mode
	exbr    r2,r2           reverse first two bytes
	whr     r1,r2           write lower two bytes
	exhr    r2,r2           get upper two bytes
	exbr    r2,r2           reverse them
	whr     r1,r2           write upper two bytes
    endc
	br      rf              return
*
* commands for display panel
*
	align   adc
dis.norm        db      x'80'   set normal mode
dis.incr        db      x'40'   set incremental mode
*
* saved switch value
*
	impur
	align   adc
csw     dc      0

*****************************************************************
*                                                               *
* clkstart:     Clock Initialization                            *
*                                                               *
* Called only once, by main(), to enable interrupts from the    *
* precision clock, which generates interrupts every 10 ms.      *
*                                                               *
*****************************************************************


	pure
	align   2
	entry   clkstart
clkstart equ    *
	lb      r1,clockaddr    pic address
	oc      r1,clk.disb     disarm interrupts
clkloop wh      r1,clk.intv     set interval
	ssr     r1,r0           check overflow
	btc     8,clkloop       if overflow, do it again
	oc      r1,clk.enab     enable clock interrupts
	br      rf              return
	align   adc
clk.intv        dc      x'2000'+z(1000)         interval = 10us * 1000
	align   adc
clk.disb        db      x'c0'           disarm
clk.enab        db      x'60'           enable + start

*****************************************************************
*                                                               *
*       Inter-address-space Transfer Routines                   *
*                                                               *
* fubyte(i) - fetch a byte from user address <i>                *
* fuword(i) - fetch a word from user address <i>                *
* subyte(i,a) - store byte <a> at user address <i>              *
* suword(i,a) - store word <a> at user address <i>              *
*                                                               *
*   - if <i> is an illegal address (or write-protected for      *
*     subyte or suword) the routine returns (-1)                *
*                                                               *
*****************************************************************

	pure
	align   2
fubyte  equ     *
fuibyte equ     *
	l       r1,0(sp)        user address
	bal     r6,lrau         relocate
	btc     x'c',illaddr    illegal address
	lb      r0,0(r1)        fetch byte
	br      rf

fuword  equ     *
fuiword equ     *
	l       r1,0(sp)        user address
	bal     r6,lrau         relocate
	btc     x'c',illaddr    illegal address - exit
	lhl     r0,0(r1)        fetch word as 2 halfwords
	exhr    r0,r0           ... in case not on word boundary
	lhl     r1,2(r1)        ... (8/32)
	or      r0,r1
	br      rf

subyte  equ     *
suibyte equ     *
	l       r1,0(sp)        user address
	bal     r6,lrau         relocate
	btc     x'e',illaddr    illegal or protected address - exit
	l       r0,4(sp)        byte to be stored
	stb     r0,0(r1)        store it
	lis     r0,0            normal return
	br      rf

suword  equ     *
suiword equ     *
	l       r1,0(sp)        user address
	bal     r6,lrau         relocate
	btc     x'e',illaddr    illegal or write protected - exit
	l       r0,4(sp)        word to be stored
	sth     r0,2(r1)        store it as 2 halfwords
	exhr    r0,r0           ... in case not on word boundary
	sth     r0,0(r1)        ... (8/32)
	lis     r0,0    normal return
	br      rf

*****************************************************
* For the many variants of memory copy that follow:

src     equ r1                  a(first src byte)
dst     equ r2                  a(first dst byte)
cnt     equ r3                  number of bytes to move

********
* copy n bytes from user space to kernel space
* n must be a multiple of wordsize
* if segflg == 1 then source is kernel, not user
*
* kcopyi (uaddr, kaddr, n, segflg)
* caddr_t uaddr;
* caddr_t kaddr;
* int n;
* int segflg;
*
kcopyi  equ     *
	l       src,0(sp)        user source address
	l       dst,12(sp)       get u.u_segflg
	ci      dst,1    check if move is kernel to kernel
	be      copyin.a        it is, no address relocation needed.
*       fall through to copyin
********
* copy n bytes from user space to kernel space
* n must be a multiple of wordsize
*
* copyin (uaddr, kaddr, n)
* caddr_t uaddr;
* caddr_t kaddr;
* int n;
*
copyin  equ     *
	l       src,0(sp)        user source address
	bal     r6,lrau
	btc     x'c',illaddr    illegal address - exit
copyin.a        equ     *
	l       dst,4(sp)        kernel target address
	b       copy

********
* copy n bytes from kernel space to user space
* n must be a multiple of wordsize
* if segflg == 1 then destination is kernel, not user
*
* kcopyo (kaddr, uaddr, n, segflg)
* caddr_t kaddr;
* caddr_t uaddr;
* int n;
* int segflg;
*
kcopyo  equ     *
	l       src,4(sp)        user target address
	l       dst,12(sp)       get u.u_segflg
	ci      dst,1    check if move is kernel to kernel
	be      copyot.a        it is, no address relocation needed.
*       fall through to copyout
********
* copy n bytes from kernel space to user space
* n must be a multiple of wordsize
*
* copyout (kaddr, uaddr, n)
* caddr_t kaddr;
* caddr_t uaddr;
* int n;
*
copyout equ     *
	l       src,4(sp)        user target address
	bal     r6,lrau
	btc     x'e',illaddr    illegal address - exit
copyot.a        equ     *
	lr      dst,src
	l       src,0(sp)        kernel source address
copy    equ     *
	l       cnt,8(sp)       number of bytes to move
	b       bcopy.a
********************************
* copy n bytes
* if source and dest areas overlap, dest must be < source
* For less than six bytes, a simple byte at a time loop is used.
* For six or more bytes, a general algorithm which moves fullwords
* at a time is used.
* Load-multiple/store-multiple is used if possible.
*
* bcopy (source, dest, n)
* caddr_t source;
* caddr_t dest;
* int n;
*
* bcopy.a assembler-callable version:
* parameters:   (in registers) entry value         returned value
*              src           a(source)              src+cnt
*              dst           a(destination)         dst+cnt
*              cnt            number to move        0
*
* assembler calling sequence                                                     *
*        bal   link,bcopy.a                                           *
*                                                                     *
* registers tmpa,tmpb are saved if used
* src, dst, and cnt (r1, r2, and r3) are destroyed
* r0 may be used for work and destroyed.
*                                                                     *
link    equ   r15
tmpa    equ   r14
tmpb    equ   r15

bcopy   equ     *
*       sai     sp,64           **save regs
*       stm     r4,0(sp)
*       l       src,64+0(sp)       source address
*       l       dst,64+4(sp)       destination address
*       l       cnt,64+8(sp)       number of bytes to move
	l       src,0(sp)       source address
	l       dst,4(sp)       destination address
	l       cnt,8(sp)       number of bytes to move
	b       moveresid
*
bcopy.a equ *
*       sai     sp,64           **save all regs
*       stm     r4,0(sp)
moveresid equ *
	ci    cnt,6             moving enough to do it fancy ?
	bnp   bytemove          b if no
* go for optimum move -- valid for count >= 6
	sai     sp,NBYTES       save r14 and r15 but make room for r8-r15
	stm     r14,0(sp)
	lr    tmpa,src
	nhi   tmpa,3            fetch source alignment
	slls  tmpa,4
	lr    tmpb,dst
	nhi   tmpb,3            fetch destination alignment
	slls  tmpb,2
*       lr      r0,tmpa         use r0 as a tmp for these two lines
*       ar      r0,tmpb
*       bz      mulmove         fullword aligned try multiple move
*
	l     tmpb,algnbtab(tmpa,tmpb)  vector according to 1 of 16 cases
	br    tmpb
	align   adc
algnbtab equ   *                initial condition vector table
	dc    mulmove
	dc    src0dst1
	dc    src0dst2
	dc    src0dst3
	dc    src1dst0
	dc    src1dst1
	dc    src1dst2
	dc    src1dst3
	dc    src2dst0
	dc    src2dst1
	dc    src2dst2
	dc    src2dst3
	dc    src3dst0
	dc    src3dst1
	dc    src3dst2
	dc    src3dst3
*
*         title src and dst on same boundary
src1dst1 equ   *                move one byte to halfword bound
	lb    tmpa,0(src)
	stb   tmpa,0(dst)
	ais   src,1
	ais   dst,1
	sis   cnt,1

src2dst2 equ   *                move one halfword to fullword bound
	lh    tmpa,0(src)
	sth   tmpa,0(dst)
	ais   src,2
	ais   dst,2
	sis   cnt,2
	b       mulmove
*
src3dst3 equ   *                move one byte to fullword bound
	lb    tmpa,0(src)
	stb   tmpa,0(dst)
	ais   src,1
	ais   dst,1
	sis   cnt,1
	b       mulmove
*
*  fullword to fullword move loop
*
f2floop  equ   *
	l     tmpa,0(src)
	st    tmpa,0(dst)
	ais   src,4
	ais   dst,4
src0dst0 equ   *
	sis   cnt,4             at least four bytes left
	bnm   f2floop           b if yes, move four
	b     moveend
*         title dst bound one greater than src
src0dst1 equ   *                move 3 to right, save fourth
	l     tmpa,0(src)       tmpa(1,2,3,0)
	rll   tmpa,8
	stb   tmpa,0(dst)
	exhr  tmpa,tmpa         tmpa(3,0,1,2)
	sth   tmpa,1(dst)
	ais   src,4             bump pointers to fullword
	ais   dst,3
	sis   cnt,4
	b     m1right
*
src1dst2 equ   *                move 1 byte to equal src2dst3
	lb    tmpa,0(src)
	stb   tmpa,0(dst)
	ais   src,1
	ais   dst,1
	sis   cnt,1
*
src2dst3 equ   *
	lhl   tmpa,0(src)       tmpa(x,x,2,3)
	rrl   tmpa,8            tmpa(3,x,x,2)
	stb   tmpa,0(dst)
	ais   src,2             bump pointers to fullword
	ais   dst,1
	sis   cnt,2
	b     m1right
*
src3dst0 equ   *
	lb    tmpa,0(src)       tmpa(x,x,x,3)
	rrl   tmpa,8            tmpa(3,x,x,x)
	ais   src,1
	sis   cnt,1
	b     m1right
*
*  move one byte to right, enter with tmpa(3,x,x,x)
*
m1rloop  l     tmpb,0(src)
	rrl   tmpb,8            tmpb(3,0,1,2)
	xr    tmpa,tmpb
	ni    tmpa,y'ff000000'
	xr    tmpa,tmpb
	st    tmpa,0(dst)       tmpa(tmpa3,tmpb0,tmpb1,tmpb2)
	lr    tmpa,tmpb
	ais   src,4
	ais   dst,4
m1right  equ   *
	sis   cnt,4             at least four bytes left
	bnm   m1rloop           b if yes
	rll   tmpa,8
	stb   tmpa,0(dst)       set down the leftover byte
	ais   dst,1
	b     moveend
*         title dst bound two greater than src
src3dst1 equ   *                3 bytes 2 to right, save 2 and 3
	lb    tmpa,0(src)
	stb   tmpa,0(dst)
	ais   src,1
	ais   dst,1
	sis   cnt,1
*
src0dst2 equ   *                2 bytes 2 to right, save 2 and 3
	l     tmpa,0(src)
	exhr  tmpa,tmpa         tmpa(2,3,0,1)
	sth   tmpa,0(dst)
	ais   src,4
	ais   dst,2
	sis   cnt,4
	b     m2right
*
src1dst3 equ   *                1 byte 2 to right, save 2 and 3
	lb    tmpa,0(src)
	stb   tmpa,0(dst)
	ais   src,1
	ais   dst,1
	sis   cnt,1
*
src2dst0 equ   *                pick up 2 and 3 for loop
	lhl   tmpa,0(src)
	exhr  tmpa,tmpa
	ais   src,2
	sis   cnt,2
	b     m2right
*
*  move two bytes to right, enter with tmpa(2,3,x,x)
*
m2rloop  l     tmpb,0(src)
	exhr  tmpb,tmpb         tmpb(2,3,0,1)
	xr    tmpa,tmpb
	ni    tmpa,y'ffff0000'
	xr    tmpa,tmpb
	st    tmpa,0(dst)       tmpa(tmpa2,tmpa3,tmpb0,tmpb1)
	lr    tmpa,tmpb
	ais   src,4
	ais   dst,4
m2right  equ   *                at least four bytes left
	sis   cnt,4
	bnm   m2rloop           b if yes
	exhr  tmpa,tmpa
	sth   tmpa,0(dst)       set down leftover halfword
	ais   dst,2
	b     moveend
*         title dst bound 3 greater (1 less) than src
src1dst0 equ   *
	l     tmpa,-1(src)      tmpa(x,1,2,3)
	rll   tmpa,8            tmpa(1,2,3,x)
	ais   src,3
	sis   cnt,3
	b     m1left
*
src2dst1 equ   *                reduce this case to src3dst2
	lb    tmpa,0(src)
	stb   tmpa,0(dst)
	ais   src,1
	ais   dst,1
	sis   cnt,1
*
src3dst2 equ   *                reduce this case to src0dst3
	lb    tmpa,0(src)
	stb   tmpa,0(dst)
	ais   src,1
	ais   dst,1
	sis   cnt,1
*
src0dst3 equ   *
	l     tmpa,0(src)       tmpa(0,1,2,3)
	rll   tmpa,8            tmpa(1,2,3,0)
	stb   tmpa,0(dst)
	ais   src,4
	ais   dst,1
	sis   cnt,4
	b     m1left
*
*  move 1 byte to left, or 3 to right. enter with tmpa(1,2,3,x)
*
m1lloop  l     tmpb,0(src)
	rll   tmpb,8            tmpb(1,2,3,0)
	xr    tmpa,tmpb
	ni    tmpa,y'ffffff00'
	xr    tmpa,tmpb
	st    tmpa,0(dst)       tmpa(tmpa1,tmpa2,tmpa3,tmpb0)
	lr    tmpa,tmpb
	ais   src,4
	ais   dst,4
m1left   equ   *
	sis   cnt,4             at least four bytes left
	bnm   m1lloop           b if yes
	exhr  tmpa,tmpa
	sth   tmpa,0(dst)       put down leftover 3 bytes
	rll   tmpa,8
	stb   tmpa,2(dst)
	ais   dst,3
*       b     moveend
*       fall through

*         title termination and byte loop
*  move 0 to 3 bytes to terminate.
*    initial conditions:
*        src   tmpa(next src byte), always on fullword bound
*        dst   tmpa(next dst byte)
*        cnt   (number bytes to move) - 4.
*
moveend  equ   *
	lm    r14,0(sp)         restore tmpa and tmpb
	ai    sp,NBYTES
	ais   cnt,4             positive count for general loop
*
*  byte move loop.  enter with positive count.
bytemove equ *
	lr    cnt,cnt
	bnp   movedone
byteloop equ *
	lb   r0,0(src)
	stb   r0,0(dst)
	ais   src,1
	ais   dst,1
	sis   cnt,1
	bp    byteloop
movedone equ   *
*       lm    r4,0(sp)          **restore all regs
*       ai    sp,64
	lis   r0,0
	br    link
*
*       move lotsa bytes at a time using lm-stm
*
STREG   equ     r8              r8 thru r15
NBYTES  equ     16-STREG*4
STREG4  equ     r12             r12 thru r15
NBYTES4 equ     16-STREG4*4
mulmove equ *
	ci      cnt,NBYTES4     check if this is worth doing
	bm      src0dst0        finish with little moves
	lm      r14,0(sp)       get back the two we saved earlier
	stm     STREG,0(sp)     push regs onto stack
	b       mulmov2
*
mulmov1 equ *
	lm      STREG,0(src)    get NBYTES bytes
	stm     STREG,0(dst)    put NBYTES bytes
	ai      src,NBYTES
	ai      dst,NBYTES
	si      cnt,NBYTES
mulmov2 ci      cnt,NBYTES      is there enough left?
	bnm     mulmov1         yes, go back
	b       mulmov4
*
mulmov3 lm      STREG4,0(src)   get NBYTES bytes
	stm     STREG4,0(dst)   put NBYTES bytes
	ai      src,NBYTES4
	ai      dst,NBYTES4
	si      cnt,NBYTES4
mulmov4 ci      cnt,NBYTES4     is there enough left?
	bnm     mulmov3         yes, go back
*
muldone equ     *
	lm      STREG,0(sp)       restore regs off stack
	ai      sp,NBYTES
	b       moveresid
********************************

* Illegal or write-protected address - return (-1)

illaddr equ     *
	lcs     r0,1    return -1
	br      rf

* clearseg(i) : clear block number <i> in kernel space to zeroes

clearseg        equ     *
	l       r1,0(sp)        block no.
	sll     r1,CSHIFT               block origin address
	lis     r0,0
	lhi     r2,CLICK        start at last word
	si      sp,32   push regs 8-15 onto stack
	stm     r8,0(sp)
*
*       clear 8-15
*
	lis     8,0
	lis     r9,0
	lis     r10,0
	lis     r11,0
	lis     r12,0
	lis     r13,0
	lis     r14,0
	lis     r15,0
clearlp equ     *
	stm     r8,0(r1)        clear 32 bytes
	ai      r1,32
	si      r2,32
	bp      clearlp
	lm      r8,0(sp)        restore regs 8-15
	ai      sp,32
	br      rf

* copyseg (i,j) : copy kernel block number <i> into kernel block <j>

copyseg equ     *
	l       dst,4(sp)        target block no.
	sll     dst,CSHIFT               block origin
	l       src,0(sp)        source block no.
	sll     src,CSHIFT
	lhi     cnt,CLICK        number of bytes to move
	b       bcopy.a use fast copy

*****************************************************************
*                                                               *
*       User - kernel Address Space Mapping Routines            *
*                                                               *
*                                                               *
*****************************************************************

* lraddr - C interface to lra

* lraddr(aaddr, seg)
* char **addr;          /* pointer to unrelocated address */
* int seg[];            /* pointer to segment table descriptor */
*
*       - replaces *addr by relocated address
*       - returns condition code from lra instruction

lraddr  equ     *
	l       r5,0(sp)        pointer to virtual addr
	l       r1,0(r5)        virtual address
	l       r2,4(sp)        pointer to seg regs
	bal     r6,lra          relocate
	st      r1,0(r5)        change virtual to real address
    ifnz        LRA!M3200
	epsr    r0,r0           real lra doesn't leave psw in r0
    endc
	nhi     r0,15           isolate cond code in new psw
	br      rf

* lra: load 'real' address
*  input:       r1 - address in user program space
*               r2 - address of segmentation regs
*  output:      r1 - corresponding address in kernel space
*               cc - condition code set as in real lra instruction
* uses:         r0

* lrau : entry point using user seg regs (uisa)

lrau    equ     *
	l       r2,uisa         use uisa for seg regs
lra     equ     *
    ifz M3240
	l       r2,0(r2)        extra level of indirection
	ni      r2,y'fffff'
    endc

    ifnz        LRA!M3200
	lra     r1,0(r2)        use hardware translation
	br      r6
    else
	lr      r0,r1           save input addr
	srl     r1,14           seg no. * 4
	ni      r1,x'3c'        clear extra bits
	l       r1,0(r1,r2)     user seg reg
	thi     r1,x'10'        check 'present' bit
	bz      lrabad          zero - illegal address
	lr      r2,r1
	srl     r2,12           seg limit * 256
	ahi     r2,x'100'       seg length in bytes
	ni      r2,y'fff00'     clear extra bits
	ni      r0,y'ffff'      offset in segment
	cr      r0,r2           within range?
	bnl     lrabad          no - illegal address
	lis     r2,0
	thi     r1,x'60'                write-protected?
	bz      lranwp          no - skip
	lis     r2,2            set G bit in cc
lranwp  equ     *
	ni      r1,y'fff00'     segment origin
	ar      r1,r0           add offset
	b       lraset
* unmapped address
lrabad  equ     *
	lis     r2,8            set C bit
* set condition code
lraset  equ     *
	epsr    r0,r0           current psw
	nhi     r0,-16          mask off old cond code
	or      r0,r2           set new cond code
	epsr    r2,r0           set new psw
	br      r6
    endc


*****************************************************************
*                                                               *
*               Kernel Process-switching Routines               *
*                                                               *
*                                                               *
*****************************************************************

* save(a)
*       - save current kernel process stack environment
*         in location <a>

save    equ     *
	l       r1,0(sp)        location
	stm     sp,0(r1)        save context
	lis     r0,0            return zero
	br      rf

* resume(p, a)
*       - reset kernel seg reg f to map to block <a>, thus
*         switching the 'current process'
*       - restore previously-saved kernel process stack environment
*         from address <a> in new process


    ifz M3240
resume  equ     *
	l       r3,4(sp)        address of saved regs
	si      r3,u            offset in u segment
	l       r0,0(sp)        block number for u segment
	sll     r0,CSHIFT               convert to address
	ar      r3,r0           physical address of saved regs
	oi      r0,usize*y'100000'+x'10'        length = usize
    else
resume  equ     *
	l       r0,0(sp)        block number for u segment
	lr      r3,r0
	sll     r3,CSHIFT               get phys address
	a       r3,4(sp)        address of saved regs
	si      r3,u            offset in u segment
	sll     r0,4            relocation field
	oi      r0,usize*y'20000'+x'5c000000'   length = usize
    endc

	li      r1,ps.disb-ps.rp        disable the mac
	epsr    r2,r1
	lm      sp,0(r3)        restore environment
	st      r0,useg         set new kernel ppd segment

* switch to new ppd segment

	l       r1,kisa         set new seg regs into
	bal     r6,addrsw       hardware mac regs
	epsr    r0,r2           enable mac again
	br      rf              NOTE: r0 is nonzero

* addupc (pc, prof, n)
* struct \(
*   int base;  int length;  int offset;  int scale;
* \) *prof;
*
*  - called from clock interrupt handler to update user execution profile

addupc  equ     *
	l       r4,4(sp)        base of prof
	l       r3,0(sp)        current program counter
	s       r3,8(r4)        subtract offset
	bmr     rf              < 0 : not within buffer

* scale pc into buffer

	m       r2,12(r4)       scale pc
	ais     r2,1            round to fullword
	slls    r2,1
	nhi     r2,x'fffc'
	c       r2,4(r4)        within buffer?
	bnlr    rf              no : return
	a       r2,0(r4)        address = base + offset

* get physical address of buffer location

	lr      r1,r2           program address
	bal     r6,lrau         get physical address
	btc     x'e',incupcx    illegal or write-protected -- error

* increment profile counter

	l       r0,8(sp)        increment
	am      r0,0(r1)        increment counter in buffer
	br      rf

* memory fault -- turn off profiling

incupcx equ     *
	lis     r0,0            zero prof scale
	st      r0,12(r4)       to turn off profiling
	br      rf

*****************************************************************
*                                                               *
*               PSW Manipulation Routines                       *
*                                                               *
*****************************************************************

* splN()
*  - sets 'processor level' to N (i.e. only devices with
*    priority >N may interrupt
*  - returns previous psw status
*
* splx(p)
*  - restores psw status to <p>
*
*  Note:
*    As currently implemented, spl0 enables interrupts, and any
*    nonzero processor level disables all interrupts.  Eventually
*    the PDP-11 processor level mechanism should be emulated more
*    closely, probably by using Interdata system queue.

spl1    equ     *
spl4    equ     *
spl5    equ     *
spl6    equ     *
spl7    equ     *
	epsr    r1,r1           current psw status
	nhi     r1,x'ffff'-ps.io        mask off immediate interrupts
	epsr    r0,r1           load new psw status
	br      rf

spl0    equ     *
	epsr    r1,r1           current psw status
	ohi     r1,ps.io        turn on immediate interrupts
	epsr    r0,r1           load new psw status
	br      rf

splx    equ     *
	l       r1,0(sp)        new psw status
	epsr    r0,r1           set in psw
	br      rf

* idle():       go into enabled wait state

	align   adc*2
waitloc dcf     a(wait)
	align   adc
idle    equ     *
    ifnz        PIC
	bal     r6,rdpic        read and update system time
	am      r5,sytim
    endc
	li      r1,ps.idle      load 'wait' psw
	epsr    r0,r1
wait    equ     *
	epsr    r1,r0           restore previous psw
	br      rf              return to caller

*****************************************************************
*                                                               *
*               I/O Instruction Routines                        *
*               Perkin-Elmer 7/32, 8/32, 3220, 3240             *
*                                                               *
*****************************************************************

ss      equ     *       sense status
	l       r1,0(sp)
	ssr     r1,r0
	br      rf

oc      equ     *       output command
	l       r1,0(sp)
	lb      r0,7(sp)        *** do ocr instead of oc
	ocr     r1,r0           *** because of timing bug on 7/32
	br      rf

	entry sgo
sgo	equ	*	special oc for selch's (ints must be REALLY off)
	l	r1,0(sp)
	lb	r0,7(sp)
	l	r2,8(sp)	3rd arg is device to be started
	epsr	r3,r3
	nhi	r3,-1-ps.io-ps.il-ps.sq
	epsr	r4,r3
	ssr	r2,r3
	ocr	r1,r0
	epsr	r3,r4
	br	rf

wd      equ     *       write data
	l       r1,0(sp)
	wd      r1,7(sp)
	br      rf

wh      equ     *       write halfword
	l       r1,0(sp)
	wh      r1,6(sp)
	br      rf

wdh     equ     *       write 3 bytes
	l       r1,0(sp)
	wd      r1,5(sp)
	wh      r1,6(sp)
	br      rf

rd      equ     *       read data
	l       r1,0(sp)
	rdr     r1,r0
	br      rf

rh      equ     *       read halfword
	l       r1,0(sp)
	rhr     r1,r0
	br      rf

rdh     equ     *       read 3 bytes
	l       r1,0(sp)
	rdr     r1,r2
	rhr     r1,r0
	exhr    r2,r2
	or      r0,r2
	br      rf

	align   adc
tmpcold dc      0,0
	db      c'@(#)mch.s	3.20',0
	pure
	align adc*2
	impur
	align adc*2
	end     start
