Bench = Object () class (

  "Category: schedule"

  main: aCount = (
    | s wkq count ticks filename stream |
    layout := 50.
    count := aCount.
    ticks := (Time measure: [
      s := Scheduler showTrace: false.
      s addIdleTask: idle priority: 0 queue: nil for: count.
    
      wkq := Packet link: nil id: worker kind: Packet::work.    
      wkq := Packet link: wkq id: worker kind: Packet::work.
      s addWorkerTask: worker priority: 1000 queue: wkq.
    
      wkq := Packet link: nil id: deviceA kind: Packet::device.
      wkq := Packet link: wkq id: deviceA kind: Packet::device.
      wkq := Packet link: wkq id: deviceA kind: Packet::device.
      s addHandlerTask: handlerA priority: 2000 queue: wkq.            
        
      wkq := Packet link: nil id: deviceB kind: Packet::device.
      wkq := Packet link: wkq id: deviceB kind: Packet::device.
      wkq := Packet link: wkq id: deviceB kind: Packet::device.
      s addHandlerTask: handlerB priority: 3000 queue: wkq.
    
      s addDeviceTask: deviceA priority: 4000 queue: nil.
      s addDeviceTask: deviceB priority: 5000 queue: nil.  
    
      s schedule.          
      
    ]) milliseconds.
    
    stream := Hosted::File open: 'J:\benchmarks\build\testrun-times.xml' mode: 'a'.
    stream 
    putAll: '<ExternalStat>';
    putAll: '<size>'; putAll: count printString; putAll: '</size>';
    putAll: '<ticks>';  putAll: ticks printString; 
    putAll: '</ticks>';
    putAll: '<ticksPerSecond>'; putAll: 1000 printString; 
    putAll: '</ticksPerSecond>';
    putAll: '</ExternalStat>';
    close.    
    
    Debug::console show: 'QueueCount = '; show: s queueCount printString; cr.
    Debug::console show: 'HoldCount = '; show: s holdCount printString.  
    )
    
  trace: aString = (
    layout <= 0
      ifTrue: [
        Debug::console cr.
        layout := 50.
        ].
    layout := layout - 1.
    Debug::console show: aString.
  )     
  
) statics (
  layout = variable
  maxTasks = 6
  
  idle = 1
  worker = 2
  handlerA = 3  
  handlerB = 4
  deviceA = 5
  deviceB = 6
)



DeviceTask = Object ( 
  | scheduler v1 v2 |

  "Category: functions"
  
  run: aPacket = (
    | pkt |
    aPacket isNil
      ifTrue: [
        v1 isNil
          ifTrue: [
            ^scheduler suspendCurrent]
          ifFalse: [
            pkt := v1.
            v1 := nil.
            ^scheduler queue: pkt.
            ]
        ]
      ifFalse: [
        v1 := aPacket.
        "scheduler traceOn 
          ifTrue: [
            Bench trace: (StringStream new 
              put: aPacket a1 asCharacter) asString]."
        ^scheduler holdCurrent.
        ]  
    )
        
  
  "Category: schedule"
  
  for: aScheduler = (
      scheduler := aScheduler.
      )  

) class (
  "Category: schedule"  
  
  for: aScheduler = (
    ^super new
      for: aScheduler
    )
)



HandlerTask = Object ( 
  | scheduler v1 v2 |
  
  "Category: functions"
  
  run: aPacket = (
    | workPacket devicePacket count |
    aPacket isNotNil
      ifTrue: [
        aPacket kind == Packet::work
          ifTrue: [v1 := aPacket addTo: v1]
          ifFalse: [v2 := aPacket addTo: v2].
        ].
    v1 isNotNil
      ifTrue: [
        workPacket := v1.
        count := workPacket a1.
        count > 4
          ifTrue: [
            v1 := v1 link.
            ^scheduler queue: workPacket.
            ]
          ifFalse: [
            v2 isNotNil
              ifTrue: [
                devicePacket := v2.
                v2 := devicePacket link.
                devicePacket a1: (workPacket a2 at: count).
                workPacket a1: count + 1.
                ^scheduler queue: devicePacket.
                ]                             
            ]
        ].      
        ^scheduler suspendCurrent          
    )
  
  
  "Category: schedule"
  
  for: aScheduler = (
      scheduler := aScheduler.
      )


) class (
  "Category: schedule"  
  
  for: aScheduler = (
    ^super new
      for: aScheduler
    )
)



IdleTask = Object ( 
  | scheduler v1 v2 |  

  "Category: functions"
  
  run: aPacket = (
    v2 := v2 - 1.
    v2 == 0 
      ifTrue: [^scheduler holdCurrent]
      ifFalse: [
        (v1 & 1) == 0
          ifTrue: [
            v1 := v1 >> 1.
            ^scheduler release: Bench::deviceA.
            ]
          ifFalse: [
            v1 := (v1 >> 1) ~ 16rD008.
            ^scheduler release: Bench::deviceB.
            ].
        ]  
    )
    
  
  "Category: schedule"
  
  for: aScheduler with: aValue1 with: aValue2 = (
      scheduler := aScheduler.
      v1 := aValue1.
      v2 := aValue2.
      )    

) class (
  "Category: schedule"  
  
  for: aScheduler with: aValue1 with: aValue2 = (
    ^super new
      for: aScheduler with: aValue1 with: aValue2
    )
)



WorkerTask = Object ( 
  | scheduler v1 v2 |
  
  "Category: functions"
  
  run: aPacket = (
    aPacket isNil
      ifTrue: [^scheduler suspendCurrent]
      ifFalse: [
        v1 := v1 == Bench::handlerA 
          ifTrue: [Bench::handlerB] ifFalse: [Bench::handlerA].
        aPacket id: v1; a1: 1.
        1 to: aPacket a2 size do: [:i| 
          v2 := v2 + 1.
          v2 > 26 ifTrue: [v2 := 1].
          aPacket a2 at: i put: $A asInteger + v2 - 1.
          ].
        ^scheduler queue: aPacket
        ]  
    )
    
    
  "Category: schedule"
  
  for: aScheduler with: aValue1 with: aValue2 = (
      scheduler := aScheduler.
      v1 := aValue1.
      v2 := aValue2.
      )  

    
) class (
  "Category: schedule"  
  
  for: aScheduler with: aValue1 with: aValue2 = (
    ^super new
      for: aScheduler with: aValue1 with: aValue2
    )
)



Scheduler = Object (
  | table list currentTcb currentId v1 v2 queueCount holdCount traceOn |
  
  "Category: accessing"    
  
  holdCount = (^holdCount)    
  queueCount = (^queueCount)  
  traceOn = (^traceOn)


  "Category: initialize"       
  
  addDeviceTask: anId priority: aPriority queue: aQueue = (
      self createTcb: anId priority: aPriority 
        queue: aQueue task: (DeviceTask for: self)
      )
        
  addHandlerTask: anId priority: aPriority queue: aQueue = (
    self createTcb: anId priority: aPriority 
      queue: aQueue task: (HandlerTask for: self)        
    ) 
  
  addIdleTask: anId priority: aPriority queue: aQueue for: aCount = (
    self createRunningTcb: anId priority: aPriority 
      queue: aQueue task: (IdleTask for: self with: 1 with: aCount)    
    )
  
  addWorkerTask: anId priority: aPriority queue: aQueue = (
    self createTcb: anId priority: aPriority 
      queue: aQueue task: (WorkerTask for: self with: Bench::handlerA with: 0)  
    )
    
    
  createRunningTcb: anId priority: aPriority queue: aQueue task: aTask = (
    self createTcb: anId priority: aPriority queue: aQueue task: aTask.
      currentTcb setRunning.
    )   
    
  createTcb: anId priority: aPriority queue: aQueue task: aTask = (
      currentTcb := Tcb link: list id: anId priority: aPriority 
        queue: aQueue task: aTask.
    list := currentTcb.
    table at: anId put: currentTcb.
    )
    
  initialize = (
    table := Array new: Bench::maxTasks.
    list := nil.
    queueCount := 0.
    holdCount := 0.
    traceOn := false.    
   )
      
  showTrace: aBoolean = (
      traceOn := aBoolean
    )

  "Category: schedule"    
  
  holdCurrent = (
      holdCount := holdCount + 1.
      currentTcb hold.
      ^currentTcb link  
    )    
    
  queue: aPacket = (
    | task |
    task := table at: aPacket id.
    task isNil 
      ifTrue: [^task].
    queueCount := queueCount + 1.
    aPacket link: nil.
    aPacket id: currentId.
    ^task checkPriority: currentTcb add: aPacket
    )
    
  release: anId = (
    | task |
    task := table at: anId.
    task isNil 
      ifTrue: [^task].
    task releaseHold.
    ^task priority > currentTcb priority
      ifTrue: [task]
      ifFalse: [currentTcb]
    )
    
  schedule = (
    currentTcb := list.
    [currentTcb isNotNil] 
      whileTrue: [
        currentTcb isHeldOrSuspended
          ifTrue: [
            currentTcb := currentTcb link]
          ifFalse: [
            currentId := currentTcb id.
            "traceOn 
              ifTrue: [Bench trace: currentId printString]."
            currentTcb := currentTcb run.
            ].
        ].  
    )  

  suspendCurrent = (^currentTcb suspend)


) class (

  "Category: initialize"  
  
  showTrace: aBoolean = (
    ^super new
      initialize;
      showTrace: aBoolean  
    )
)



Tcb = Object (
  | link id pri wkq state task |
  
  "Category: accessing"    
  
  id = (^id)  
  priority = (^pri)  
  link = (^link)  


  "Category: initialize"
            
  link: aLink id: anId priority: aPriority queue: aQueue task: aTask = (
    link := aLink.
    id := anId.
    pri := aPriority.
    wkq :=  aQueue.
    task := aTask.
    state := wkq isNil
      ifTrue: [2r10] ifFalse: [2r11]
    )
    
    
  "Category: schedule"  
    
  checkPriority: aTcb add: aPacket = (
    wkq isNil
      ifTrue:[
        wkq := aPacket.
        state := state | 2r1. 
        pri > aTcb priority
          ifTrue: [^self]
        ]
      ifFalse: 
        [wkq := aPacket addTo: wkq].
    ^aTcb
    )  
    
  run = (
      | packet |
      state == 2r11 "SuspendedRunnable"      
         ifTrue: [
            packet := wkq.
            wkq := packet link.
            wkq isNil
               ifTrue: [state := 2r0] "Running"            
               ifFalse: [state := 2r1]. "Runnable"  
            ]
         ifFalse: [packet := nil].
    ^task run: packet
    )    
    
		
   "Category: state"   
   
   setRunning = (state := 2r0)   
   
   isHeldOrSuspended = (^(state & 2r100) ~== 0  or: [state == 2r10])         
      
   suspend = (state := state | 2r10)      
      
   hold = (state := state | 2r100)      
   
   releaseHold = (state := state & -2r101)      
       
   isSuspended = (^(state & 2r10) ~== 0)                             

) class (

  "Category: initialize"  
    
  link: aLink id: anId priority: aPriority queue: aQueue task: aTask = (
    ^super new
        link: aLink id: anId priority: aPriority queue: aQueue task: aTask
    )  
)



Packet = Object (
  | link id kind a1 a2 |
  
  "Category: accessing"    
  
  a1 = (^a1)  
  a1: aValue = (a1 := aValue)  
  a2 = (^a2)  
  id = (^id)  
  id: anId = (id := anId)  
  kind = (^kind)  
  link = (^link)  
  link: aPacket = (link := aPacket)  
  
  "Category: initialize"  
  
  link: aLink id: anId kind: aKind = (
    link := aLink.
    id := anId.
    kind := aKind.
    a1 := 1.
    a2 := ByteArray new: 4 with: 0
    )  
  
  "Category: schedule"  
  
  addTo: aQueue = (
    | next peek |
    link := nil.
    aQueue isNil
      ifTrue: [^self].
    next := aQueue.
    [(peek := next link) isNotNil]
      whileTrue: [next := peek].
    next link: self.
    ^aQueue  
    )  
  

) class (

  "Category: initialize"
  
  link: aLink id: anId kind: aKind = (
    ^super new
      link: aLink id: anId kind: aKind
  )

) statics (
  device = 0  
  work = 1    
)