;Compiling with Devpac 3.18

                output  user:libs/

                opt d

callexe:        macro
                movem.l a6,-(sp)
                move.l  execbase.w,a6
                jsr     \1(a6)
                movem.l (sp)+,a6
                endm

supervisor      =-30
forbid          =-132
permit          =-138
freemem         =-210
availmem        =-216
typeofmem       =-534
allocvec        =-684
freevec         =-690
execbase        =4

dosentry:
                moveq   #-1,d0
                rts
resident:
                dc.w $4afc              ;ROMTAG identificator
                dc.l resident
                dc.l 0
                dc.b $80
                dc.b 1                  ;version
                dc.b 9                  ;node type (NT_LIBRARY)
                dc.b 0
                dc.l libname
                dc.l idstring
                dc.l init
init:
                dc.l liblen             ;length of LIB_NODE data area
                dc.l funcinit
                dc.l 0
                dc.l libinit
funcinit:
                dc.l libopen
                dc.l libclose
                dc.l libexpunge
                dc.l libextfunc

                dc.l allocmmu
                dc.l freemmu
                dc.l allocarea
                dc.l freearea
                dc.l readmmuregs
                dc.l writemmuregs
                dc.l testaddress
                dc.l -1
libinit:
                movem.l a1,-(sp)
                move.l  d0,a1
                moveq   #0,d0
                move.l  d0,lasttable(a1)
                move.l  d0,roottable(a1)
                move.w  d0,mmucounter(a1)
                move.l  a0,librarysegment(a1)
                sf      mmuflag(a1)
                move.l  a1,d0
                movem.l (sp)+,a1
                rts
libopen:
                bclr    #3,14(a6)
                addq.w  #1,32(a6)
                beq     dosentry 
                move.l  a6,d0
                rts
libclose:
                tst.w   32(a6)
                beq.s   libextfunc
                subq.w  #1,32(a6)
                btst    #3,14(a6)
                bne.s   libexpunge
libextfunc:
                moveq   #0,d0
                rts
libexpunge:
                bset    #3,14(a6)
                tst.w   32(a6)
                bne.s   libextfunc
                move.l  a6,a1
                move.l  (a1),a0
                move.l  4(a1),a1
                move.l  a0,(a1)
                move.l  a1,4(a0)
                move.l  a6,a1
                moveq   #0,d0
                move.w  16(a6),d0
                sub.l   d0,a1
                moveq   #0,d1
                move.w  18(a6),d1
                add.l   d1,d0
                move.l  a6,-(a7)
                move.l  execbase.w,a6
                jsr     freemem(a6)
                move.l  (a7)+,a6
                move.l  librarysegment(a6),d0
                rts
;***************************************
allocmmu:
                movem.l d1-d7/a0-a6,-(sp)
                tst.l   roottable(a6)
                bne     endallocmmu
                lea     mmuregs(a6),a0
                bsr     readmmuregs
                moveq   #0,d0
                btst    #7,10(a0)
                bne     noallocmmu
                btst    #7,14(a0)
                bne     noallocmmu
                btst    #7,18(a0)
                bne     noallocmmu
                btst    #7,22(a0)
                bne     noallocmmu
                addq.w  #1,mmucounter(a6)
                beq     noallocmmu
                btst    #7,24(a0)
                beq.s   allocmmu0
                st      mmuflag(a6)
                move.l  d0,lasttable(a6)
                move.l  4(a0),d1
                and.l   #$fffffe00,d1
                move.l  d1,roottable(a6)
                bra     endallocmmu
allocmmu0:
                move.l  #256,d0
                move.l  #$10001,d1
                callexe allocvec
                move.l  d0,membloclist(a6)
                beq     noallocmmu
                move.l  #$80004,d1
                callexe availmem
                move.l  d0,d2           ;total number of FAST memory
                move.l  membloclist(a6),a2
                move.l  #0,a1           ;with begin address area
                moveq   #4,d1           ;search blocs of FAST memory
allocmmu1:
                bsr     memblocinfo
                move.l  a0,(a2)+
                move.l  d0,(a2)+
                sub.l   d0,d2
                bgt.s   allocmmu1
                move.l  #512+512+16,d0
                moveq   #1,d1
                callexe allocvec
                tst.l   d0
                beq     noallocmmu
                move.l  d0,d1
                add.l   #511,d0
                and.l   #$fffffe00,d0
                move.l  d0,a0
                moveq   #0,d2
allocmmu2:
                move.l  d2,(a0)+
                add.l   #$2000000,d2
                bne     allocmmu2
                move.l  d2,(a0)         ;previous table pointer
                move.l  a0,lasttable(a6)
                move.l  a0,roottable(a6)
                move.l  d1,4(a0)        ;this table pointer
                move.l  d2,8(a0)        ;address of descriptor
                                        ;from previous table
                move.l  d2,12(a0)       ;old descriptor
                sub.l   a0,a0
                move.l  #$1000000,d0
                bsr     freearea
                move.l  membloclist(a6),a1
allocmmu3:
                move.l  (a1)+,a0
                move.l  (a1)+,d0
                beq.s   allocmmu4
                cmp.l   #$1000000,a0
                bcs.s   allocmmu3
                bsr     freearea
                bra.s   allocmmu3
allocmmu4:
                move.l  membloclist(a6),a1
                callexe freevec
                lea     mmuoffdata,a0
                move.l  d0,4(a0)
                move.l  d0,12(a0)
                lea     mmuondata,a0
                move.l  d0,4(a0)
                move.l  d0,12(a0)
                bsr     writemmuregs
endallocmmu:
                move.l  roottable(a6),d0
noallocmmu:
                movem.l (sp)+,d1-d7/a0-a6
                rts
;d0.l=root table pointer or 0 for error
;***************************************
memblocinfo:
                movem.l a6,-(sp)
                move.l  execbase.w,a6
mbi0:
                add.l   #$40000,a1
                movem.l d1,-(sp)
                jsr     typeofmem(a6)
                movem.l (sp)+,d1
                and.l   d1,d0
                beq.s   mbi0
                move.l  a1,d0
                and.l   #$fff80000,d0
                move.l  d0,a0
mbi1:
                add.l   #$40000,a1
                movem.l d1/a0,-(sp)
                jsr     typeofmem(a6)
                movem.l (sp)+,d1/a0
                and.l   d1,d0
                bne.s   mbi1
                move.l  a1,d0
                and.l   #$fff80000,d0
                sub.l   a0,d0
                movem.l (sp)+,a6
                rts
;***************************************
freemmu:
                movem.l d0-d7/a0-a6,-(sp)
                subq.w  #1,mmucounter(a6)
                bne     nofreemmu
                tst.l   lasttable(a6)
                beq.s   endfreemmu
                tst.b   mmuflag(a6)
                bne.s   freemmu0
                lea     mmuoffdata,a0
                bsr     writemmuregs
freemmu0:
                move.l  lasttable(a6),a0
freemmu1:
                move.l  (a0),-(sp)
                move.l  8(a0),a1
                tst.l   a1
                beq.s   freemmu2
                move.l  12(a0),(a1)
freemmu2:
                move.l  (sp)+,a0
                tst.l   a0
                bne.s   freemmu1
                move.l  lasttable(a6),a0
freemmu3:
                move.l  (a0),-(sp)
                move.l  4(a0),a1
                callexe freevec
                move.l  (sp)+,a0
                tst.l   a0
                bne.s   freemmu3
                clr.l   lasttable(a6)
endfreemmu:
                clr.l   roottable(a6)
nofreemmu:
                movem.l (sp)+,d0-d7/a0-a6
                rts
;***************************************
;a0=pointer of MMU registers table
writemmuregs:
                movem.l d0-d7/a0-a6,-(sp)
                movem.l a0,-(sp)
                move.l  execbase.w,a6
                jsr     forbid(a6)
                movem.l (sp),a0
                lea     writemmu,a5
                move.l  execbase.w,a6
                jsr     supervisor(a6)
                move.l  execbase.w,a6
                jsr     permit(a6)
                movem.l (sp)+,a0
                movem.l (sp)+,d0-d7/a0-a6
                rts
;***************************************
writemmu:
                move.l  (a0),d0
                movec   d0,urp
                move.l  4(a0),d0
                movec   d0,srp
                move.l  8(a0),d0
                movec   d0,dtt0
                move.l  12(a0),d0
                movec   d0,dtt1
                move.l  16(a0),d0
                movec   d0,itt0
                move.l  20(a0),d0
                movec   d0,itt1
                move.w  24(a0),d0
                movec   d0,tc
                pflusha
                rte
mmuondata:
                dc.l 0 ;urp
                dc.l 0 ;srp
                dc.l $00ff4000 ;dtt0
                dc.l $00ff4000 ;dtt1
                dc.l $00ff4000 ;dtt0
                dc.l $00ff4000 ;dtt1
                dc.w $8000 ;tc
mmuoffdata:
                dc.l 0 ;urp
                dc.l 0 ;srp
                dc.l $00ff4000 ;dtt0
                dc.l $00ff4000 ;dtt1
                dc.l $00ff4000 ;dtt0
                dc.l $00ff4000 ;dtt1
                dc.w 0 ;tc
;***************************************
;a0=logical address of area
;a1=phisical address of area
;d0.l=length of area
;d1=address translation flags
;   bit0 - acces protection
;   bit1 - cache inhibit
;   bit2 - write protection
allocarea:
                tst.l   roottable(a6)
                beq     noallocarea
                movem.l d0-d7/a0-a1/a3-a6,-(sp)
                move.l  a1,d2
                and.l   #$fffff000,d2
                move.b  d1,d3
                lsl.b   #5,d3
                and.b   #$40,d3
                add.b   d3,d2
                move.b  d1,d3
                lsl.b   #4,d3
                and.b   #$20,d3
                add.b   d3,d2
                move.b  d1,d3
                and.b   #4,d3
                add.b   d3,d2
                not.b   d1
                and.b   #1,d1
                add.b   d1,d2
                move.l  d2,a1           ;a1=page descriptor
                move.l  roottable(a6),a2
                tst.b   mmuflag(a6)
                bne.s   allocarea0
                move.l  4(a2),d1
                add.l   #511,d1
                and.l   #$fffffe00,d1
                move.l  d1,a2           ;a2=pointer of descriptor table
                                        ;of level 1
allocarea0:
                move.l  a0,d1
                rol.l   #7,d1
                and.w   #$7f,d1         ;d1=displacement for descriptor table
                                        ;of level 1
                move.l  (a2,d1.w*4),d2
                and.l   #$fffffe00,d2   ;d2=pointe of descriptor table
                move.l  d2,a3
                btst    #1,3(a2,d1.w*4) ;pege descriptor?
                bne     allocarea2
                movem.l d0-d1/a0-a2,-(sp) ;yes
                move.l  #512+512+16,d0   ;creat new descriptor table
                move.l  #1,d1
                callexe allocvec
                move.l  d0,d2           ;d2=pointer of new table
                movem.l (sp)+,d0-d1/a0-a2
                beq     noallocarea
                move.l  d2,a5
                add.l   #511,d2
                and.l   #$fffffe00,d2   ;address justification for modulo 16
                move.l  d2,a3
                moveq   #127,d3
                move.l  (a2,d1.w*4),d4
                and.l   #$fffc0000,d4
allocarea1:
                move.l  d4,(a3)+
                add.l   #$40000,d4
                dbra    d3,allocarea1
                move.l  lasttable(a6),(a3) ;previous table pointer
                move.l  a3,lasttable(a6)
                move.l  a5,4(a3)        ;this table pointer
                lea     (a2,d1.w*4),a5
                move.l  a5,8(a3)        ;address of descriptor
                                        ;from previous table
                move.l  (a2,d1.w*4),12(a3) ;old descriptor
                                        ;from previous table
                move.l  d2,a3           ;a3=pointer of descriptor table
                addq.l  #2,d2           ;d2=descriptor of new descriptor table
                move.l  d2,(a2,d1.w*4)  ;attach new descriptor table of level 2
allocarea2:
                move.l  a0,d1
                rol.l   #7,d1
                rol.l   #7,d1
                and.w   #$7f,d1         ;d1=displacement for descriptor table
                                        ;of level 2
                move.l  (a3,d1.w*4),d2
                and.l   #$fffffe00,d2   ;d2=pointer of descriptor table
                move.l  d2,a4
                btst    #1,3(a3,d1.w*4) ;pege descriptor?
                bne     allocarea4
                movem.l d0-d1/a0-a2,-(sp) ;yes
                move.l  #256+256+16,d0   ;creat new descriptor table
                move.l  #1,d1
                callexe allocvec
                move.l  d0,d2           ;d2=pointer of new table
                movem.l (sp)+,d0-d1/a0-a2
                beq     noallocarea
                move.l  d2,a5
                add.l   #255,d2
                and.l   #$ffffff00,d2   ;address justification for modulo 16
                move.l  d2,a4
                moveq   #63,d3
                move.l  (a3,d1.w*4),d4
                and.l   #$fffff000,d4
allocarea3:
                move.l  d4,(a4)+
                add.l   #$1000,d4
                dbra    d3,allocarea3
                move.l  lasttable(a6),(a4) ;previous table pointer
                move.l  a4,lasttable(a6)
                move.l  a5,4(a4)        ;this table pointer
                lea     (a3,d1.w*4),a5
                move.l  a5,8(a4)        ;address of descriptor
                                        ;from previous table
                move.l  (a3,d1.w*4),12(a4) ;old descriptor
                                        ;from previous table
                move.l  d2,a4           ;a4=pointer of descriptor table
                addq.l  #2,d2           ;d2=descriptor of new descriptor table
                move.l  d2,(a3,d1.w*4)  ;attach new descriptor table of level 3
allocarea4:
                move.l  a0,d1
                ror.l   #8,d1
                ror.l   #4,d1
                and.w   #$3f,d1         ;d1=displacement for descriptor table
                                        ;of level 3
allocarea5:
                cmp.l   #$1000,d0
                bcs.s   allocarea6
                move.l  a1,(a4,d1.w*4)
                add.l   #$1000,a1
                add.l   #$1000,a0
                sub.l   #$1000,d0
                beq.s   allocarea6
                addq.w  #1,d1
                cmp.w   #$40,d1
                bcc     allocarea0
                bra.s   allocarea5
allocarea6:
                move.l  a4,a2
endallocarea:
                movem.l (sp)+,d0-d7/a0-a1/a3-a6
                rts
noallocarea:
                sub.l   a2,a2
                bra.s   endallocarea
;a2=pointer of lowlevel descriptor table or 0 for error
;***************************************
;a0=logical address of area
;d0.l=length of area
freearea:
                movem.l d1/a1,-(sp)
                move.l  a0,a1
                clr.l   d1
                bsr     allocarea
                movem.l (sp)+,d1/a1
                rts
;***************************************
;a0=logical address
testaddress:
                tst.l   roottable(a6)
                beq.s   notestaddress
                movem.l d1-d7/a0-a6,-(sp)
                movem.l a0,-(sp)
                move.l  execbase.w,a6
                jsr     forbid(a6)
                movem.l (sp),a0
                lea     testmmu,a5
                move.l  execbase.w,a6
                jsr     supervisor(a6)
                movem.l d0,-(sp)
                move.l  execbase.w,a6
                jsr     permit(a6)
                movem.l (sp)+,d0
                and.l   #$fffff000,d0
                movem.l (sp)+,d1
                and.l   #$fff,d1
                add.l   d1,d0
                movem.l (sp)+,d1-d7/a0-a6
notestaddress:
                rts
;d0=value of corresponded page descriptor
;***************************************
testmmu:
                moveq   #1,d0
                movec   d0,dfc
                ptestw  (a0)
                movec   mmusr,d0
                rte
;***************************************
;a0=pointer of MMU registers table
readmmuregs:
                movem.l d0-d7/a0-a6,-(sp)
                movem.l a0,-(sp)
                move.l  execbase.w,a6
                jsr     forbid(a6)
                movem.l (sp),a0
                lea     readmmu,a5
                move.l  execbase.w,a6
                jsr     supervisor(a6)
                move.l  execbase.w,a6
                jsr     permit(a6)
                movem.l (sp)+,a0
                movem.l (sp)+,d0-d7/a0-a6
                rts
;***************************************
readmmu:
                movec   urp,d0
                move.l  d0,(a0)
                movec   srp,d0
                move.l  d0,4(a0)
                movec   dtt0,d0
                move.l  d0,8(a0)
                movec   dtt1,d0
                move.l  d0,12(a0)
                movec   itt0,d0
                move.l  d0,16(a0)
                movec   itt1,d0
                move.l  d0,20(a0)
                movec   tc,d0
                move.w  d0,24(a0)
                movec   mmusr,d0
                move.l  d0,26(a0)
                rte
libname:        dc.b 'memorymanage.library',0
                dc.b '$VER:'
idstring:
                dc.b 'memorymanage 1.01 (c) 2000',0
                rsreset
                rs.b 34
librarysegment: rs.l 1
roottable:      rs.l 1
lasttable:      rs.l 1
membloclist:    rs.l 1
mmuregs:        rs.b 30
mmucounter:     rs.w 1
mmuflag:        rs.b 1
liblen:         rs.b 0