memory.bas

Memory.bas关于模拟操作系统内存分配

Attribute VB_Name = "Memory"


Public mmu(1 To 512) As String * 1         '用数组模拟内存

Public Type mcbdef                         '定义一个表示内存的对象
 flag As Boolean                           '标志位
 Start As Integer                          '起始地址
 big As Integer                            '大小
 numpcb As Integer                         'PCB号
 prior As Integer
 next As Integer
End Type
                                           '用结构体数组管理内存控制表
Public mcbu(1 To 11) As mcbdef             '已用分区表
Public mcbe(1 To 11) As mcbdef             '可用分区表
Public emptym As Integer                   '可用内存指针
Public usedm As Integer                    '已用内存指针


Public Function reqmm(big2 As Integer) As Integer
'申请内存
Dim i As Integer, sum As Integer
Dim j As Integer
i = reqmm1(big2)
If i = -1 Then
   reqmm = -1
   Exit Function
End If
If i <> 0 Then
   reqmm = i
Else
   sum = 0
   j = emptym
   Do While j <> 0
      sum = mcbe(j).big + sum
      j = mcbe(j).next
   Loop
   If sum >= big2 Then
      j = MsgBox("内存紧凑将花费一定时间，确定紧凑吗", 1 + 32, "error")
      If j = 1 Then
         Call jincou(big2)
         MsgBox ("内存紧凑成功"), 1 + 32, "成功"
         i = reqmm1(big2)
         reqmm = i
         If i = -1 Then
            Exit Function
         End If
      Else
         reqmm = 0
         Exit Function
      End If
   Else
     reqmm = 0
     Exit Function
   End If
End If
If i >= 1 Then
   sum = mcbu(i).big + mcbu(i).Start - 1
   sum = sum \ 4 - 1
   For i = (mcbu(i).Start - 1) \ 4 To sum Step 1
       frmmain.mmview(i).BackColor = frmmain.yiyong.BackColor
   Next i
End If
End Function

Public Function reqmm1(big1 As Integer) As Integer       '申请内存 返回值为已用MCBU号
Dim i As Integer, j As Integer, k As Integer, num As Integer, total As Integer
num = emptym
If num = 0 Then
   reqmm1 = 0
   Exit Function
End If
total = 0
Do While num <> 0                                 '在mcbe表中寻找可用块
    total = total + 1
    If total = 12 Then
       reqmm1 = -1
       MsgBox ("reqmm1错误 在mcbe中找可用块"), 0, "error"
       Exit Function
    End If
    If mcbe(num).big < big1 Then
       num = mcbe(num).next
    Else
       Exit Do
    End If
Loop
If num = 0 Then
   reqmm1 = 0
   Exit Function
End If
                                        '找到  摘下mcbe的块
If mcbe(num).big = big1 Then                               '等于请求块则摘下
   If mcbe(num).prior = 0 And mcbe(num).next <> 0 Then      '有后继 无前驱
      emptym = mcbe(num).next
      mcbe(emptym).prior = 0
   Else
      If mcbe(num).prior <> 0 And mcbe(num).next = 0 Then    '有前驱 无后继
         mcbe(mcbe(num).prior).next = 0
      Else
         If mcbe(num).prior <> 0 And mcbe(num).next <> 0 Then  '有前驱 有后继
            mcbe(mcbe(num).prior).next = mcbe(num).next
            mcbe(mcbe(num).next).prior = mcbe(num).prior
         Else                                              '无前驱 无后继
            emptym = 0
         End If
      End If
   End If
   mcbe(num).next = 0
   mcbe(num).prior = 0
   mcbe(num).flag = False                                    '修改状态位
End If
If usedm = 0 Then                                            '插入到mcbu中
   mcbu(1).prior = 0: mcbu(1).next = 0
   usedm = 1
   i = 1
   mcbu(i).flag = True                                       '修改状态 大小 首地址
   mcbu(i).Start = mcbe(num).Start
   mcbu(i).big = big1
   mcbe(num).Start = mcbe(num).Start + big1
   mcbe(num).big = mcbe(num).big - big1
Else
   i = 1
   total = 0
   Do While mcbu(i).flag = True                            '在mcbu中找可用块
      total = total + 1
      If total = 13 Then
          MsgBox ("reqmm1错误在mcbu中找可用块"), 0, "error"
          reqmm1 = -1                                          '置错误标志
          Exit Function
       End If
      i = i + 1
   Loop
   mcbu(i).flag = True                                       '修改状态 大小 首地址
   mcbu(i).Start = mcbe(num).Start
   mcbu(i).big = big1
   mcbe(num).Start = mcbe(num).Start + big1
   mcbe(num).big = mcbe(num).big - big1
   j = usedm
   k = j
   total = 0
   Do While j <> 0                                        '确定插入位置
     If mcbu(j).Start < mcbu(i).Start Then
        total = total + 1
        If total = 13 Then
           reqmm1 = -1                                         '置错误标志
           MsgBox ("reqmm1错误 确定插入位置"), 0, "error"
           Exit Function
        End If
        k = j
        j = mcbu(j).next
     Else
        Exit Do
     End If
   Loop
   If k = j Then                                           '插到最前面
      mcbu(k).prior = i
      mcbu(i).prior = 0
      mcbu(i).next = k
      usedm = i
   Else
      If j = 0 Then                                       '插到最后
         mcbu(k).next = i
         mcbu(i).next = 0
         mcbu(i).prior = k
      Else                                                '插到中间
         mcbu(k).next = i
         mcbu(i).next = j
         mcbu(i).prior = k
         mcbu(j).prior = i
      End If
   End If
End If
reqmm1 = i
End Function

Public Function freemm(num As Integer) As Integer                  '内存回收子函数
Dim i As Integer, j As Integer, k As Integer, total As Integer, m As Integer
Dim sum As Integer
sum = mcbu(num).big + mcbu(num).Start - 1
sum = sum \ 4 - 1
For i = (mcbu(num).Start - 1) \ 4 To sum Step 1
    frmmain.mmview(i).BackColor = frmmain.weiyong.BackColor     '摘下mcbu的块
Next i
If mcbu(num).prior = 0 And mcbu(num).next <> 0 Then       '有后继 无前驱
    usedm = mcbu(num).next
    mcbu(usedm).prior = 0
Else
   If mcbu(num).prior <> 0 And mcbu(num).next = 0 Then    '有前驱 无后继
       mcbu(mcbu(num).prior).next = 0
   Else
      If mcbu(num).prior <> 0 And mcbu(num).next <> 0 Then  '有前驱 有后继
         mcbu(mcbu(num).prior).next = mcbu(num).next
         mcbu(mcbu(num).next).prior = mcbu(num).prior
      Else                                                  '无前驱 无后继
         usedm = 0
      End If
   End If
End If
mcbu(num).next = 0
mcbu(num).prior = 0
mcbu(num).flag = False
If emptym = 0 Then                                      '插入到mcbe中
   emptym = 1                                           'mcbe表中空，不考虑合并问题
   mcbe(1).prior = 0: mcbe(1).next = 0
   mcbe(1).flag = True
   mcbe(1).Start = mcbu(num).Start
   mcbe(1).big = mcbu(num).big
   Exit Function
Else                                                    'mcbe表中不空，考虑合并问题
   i = 1
   total = 0
   Do While mcbe(i).flag = True                        '在mcbe中找可用块
       total = total + 1
       If total = 13 Then
          freemm = -1
          MsgBox ("freemm错误 在mcbe中找可用块"), 0, "error"
          Exit Function
       End If
       i = i + 1
   Loop
'   mcbe(i).flag = True
   mcbe(i).Start = mcbu(num).Start