; @(#)obedump.pro	1.2 09/22/99 - D.Wang
; Call: obedump,dumpname,OUTFILE=filename,FULL_SCB=full_scb
;
; Example: obedump,'980113_125003.mem',OUTFILE='980113.dmp',FULL_SCB=1
;
; read OBE dumps
;
; This software requires the starting locations of the TCB and SCB arrays
; from the OBE all_val.map  Set scb_base and tcb_base in the procedure read_dump
; tcb_base = _tasks
; scb_base = _avail_scb
;
; These values will change with OBE version
;
; as of 6/10/97
; 1000 SCB (size = 84 bytes)
;
;  word 0: LSW pointer to next SCB
;  word 1: MSW pointer to next SCB
;  word 2: start time
;  word 3: start time
;  word 4: LSW f32 start time
;  word 5: pad
;  word 6: exit type
;  word 7: exit time
;  word 8: exit time
;  word 9: exit time
;  word 10: exit time
;  word 11: pad
;  word 12: # of parameters
;  word 13: campaign ID  (actually 1st parameter for most LPs)
;  word 14: 2nd parameter

; 25  TCB (size = 332)
; word 0: LSW pointer
; word 1: MSW pointer
; word 2: task id
; word 3: priority
; word 4: resident_q
; word 5: scb_queue

; word 48: gracefull_suspend
; word 49: gracefull_preempt
; word 50: exit_criteria
; word 51: iteration_counter

function scb_start_c32,index
common mem,scb,tcb,tcb_base,tcb_size, scb_base, scb_size
start = scb(3,index)*65536l+scb(2,index)
return, start
end

function scb_start_f32,index
common mem,scb,tcb,tcb_base,tcb_size, scb_base, scb_size
 start = fix(scb(4,index))
 if(start lt 0l ) then start = start and '0000FFFF'XL
 ; print,start,start,format='(I8,1x,Z8)'
return, start
end

function scbq,index
common mem,scb,tcb,tcb_base,tcb_size, scb_base, scb_size
 next = scb(0,index) + scb(1,index)*65536l
 if(next ne 0) then next_scb = (next - scb_base)/scb_size $
 else next_scb = 0
return, next_scb
end

pro read_dump,filename
common mem,scb,tcb,tcb_base,tcb_size, scb_base, scb_size
common sched, sched
common hdr, header, outfilename
filelen = 92310
; avail_scb in all_val.map
scb_base = '239aca'XL
scb_size = 84
; _tasks in all_val.map
tcb_base = '21e0c2'XL
tcb_size = 332
if(header(1) eq 2) then begin
  array = intarr(filelen/2)
  openr,1,filename
  readu,1,array
  close,1
  scb = reform(array(5:42004),scb_size/2,1000)
  scb = scb and 65535
  tcb = reform(array(42005:*),tcb_size/2,25)
  tcb = tcb and 65535
endif
if( header(1) eq 3) then begin
  array = intarr(166*25+5)
  openr,1,filename
  readu,1,array
  close,1
  tcb = reform(array(5:*),166,25)
  tcb = tcb and 65535
endif
if( header(1) eq 17) then begin
 array = intarr(1000 * 28 + 5)
 openr,1,filename
 readu,1,array
 close,1
 sched = reform(array(5:*),28,1000)
 endif
end

pro print_scb,r1,r2,full_scb
common hdr, header, outfilename
common mem,scb,tcb,tcb_base,tcb_size, scb_base, scb_size
print,format='(A13,1x,Z8)','SCB Address =',scb_base
print,"SCB  Next     NextSCB  Start32 f32  Type   Exit32  f32  NumP  Parm01  Parm02  Parm03 "
if(outfilename) then BEGIN
 printf,2,format='(A13,1x,Z8)','SCB Address =',scb_base
 if(full_scb) then printf,2,"SCB  Next     NextSCB  Start32 f32  Type   Exit32  f32  NumP  Parm01  Parm02  Parm03 Parm04 Parm05 Parm06 Parm07 Parm08 Parm09" $
 else printf,2,"SCB  Next     NextSCB  Start32 f32  Type   Exit32  f32  NumP  Parm01  Parm02  Parm03 "
ENDIF
for icount=r1,r2 do begin
 next = scb(0,icount) + scb(1,icount)*65536l
 if(next ne 0) then next_scb = (next - scb_base)/scb_size $
 else next_scb = 0
 start = double(scb(3,icount)*65536.0)+scb(2,icount)
 start1 = scb(4,icount)
 tai = double(32.0*start) + double((start1/2048.0))
 start_time = tai2utc(tai,/ECS) 
 type = 'Cycl'
 if( scb(6,icount) eq 2) then type ='Iter'
 if( scb(6,icount) eq 3) then type ='Enda'
 if( scb(6,icount) eq 4) then type ='Dura'
 exit = scb(9,icount)*65536l + scb(8,icount)
 exit1 = scb(10,icount)

 if( full_scb) then BEGIN
 print,format='(I3,2x,Z8,1x,I7,1x,Z8,1x,Z4,1x,A25,1x,A4,1x,Z8,1x,z4,1x,I4,1x,20I8)', $
  icount,next,next_scb,start,start1,start_time,type,exit,exit1,scb(12,icount), $
  scb(13,icount), scb(14,icount), scb(15,icount), scb(16,icount), $
  scb(17,icount), scb(18,icount), scb(19,icount), scb(20,icount), $
  scb(21,icount), scb(22,icount), scb(23,icount), scb(24,icount), $
  scb(25,icount), scb(26,icount), scb(27,icount), scb(28,icount), $
  scb(29,icount), scb(30,icount), scb(31,icount), scb(32,icount)

 ENDIF ELSE print,format='(I3,2x,Z8,1x,I7,1x,Z8,1x,Z4,1x,A25,1x,A4,1x,Z8,1x,z4,1x,I4,1x,20I8)', $
  icount,next,next_scb,start,start1,start_time,type,exit,exit1,scb(12,icount),scb(13,icount),scb(14,icount),scb(15,icount)
 if(outfilename) then BEGIN
  if( full_scb) then BEGIN
   printf,2,format='(I3,2x,Z8,1x,I7,1x,Z8,1x,Z4,1x,A25,1x,A4,1x,Z8,1x,z4,1x,I4,1x,20I8)', $
   icount,next,next_scb,start,start1,start_time,type,exit,exit1,scb(12,icount), $
   scb(13,icount), scb(14,icount), scb(15,icount), scb(16,icount), $
   scb(17,icount), scb(18,icount), scb(19,icount), scb(20,icount), $
   scb(21,icount), scb(22,icount), scb(23,icount), scb(24,icount), $
   scb(25,icount), scb(26,icount), scb(27,icount), scb(28,icount), $
   scb(29,icount), scb(30,icount), scb(31,icount), scb(32,icount)
 ENDIF ELSE BEGIN
   printf,2,format='(I3,2x,Z8,1x,I7,1x,Z8,1x,Z4,1x,A25,1x,A4,1x,Z8,1x,z4,1x,I4,1x,20I8)', $
   icount,next,next_scb,start,start1,start_time,type,exit,exit1,scb(12,icount), $
   scb(13,icount),scb(14,icount),scb(15,icount)
  ENDELSE
ENDIF
endfor
end

function chk_scb_q,ilist,scb_list_time,scb_list_f32
ok = 0
for i=1,ilist - 1 do begin
 if( scb_list_time(i) gt scb_list_time(i-1)) then continue
 if ( scb_list_f32(i) gt scb_list_f32(i)) then ok = 1
endfor
return,ok
end

; check the parameters for a given tcb and scb
function parameter_check,tcb_num,scb_num
common mem,scb,tcb,tcb_base,tcb_size, scb_base, scb_size
ok = 'UNK'
if(scb_num eq 0) then return,ok

 CASE tcb_num OF
  5: BEGIN          ; Dark Images
     ok = 'OK'
     if(scb(14,scb_num) lt 0 or scb(14,scb_num) gt 3) then ok = 'BAD_CAM'
     if(scb(15,scb_num) lt 1 or scb(15,scb_num) gt 3) then ok = 'BAD_PT'
     if(scb(17,scb_num) lt 0 or scb(17,scb_num) gt 19) then ok = 'BAD_IP'
     END
  9: BEGIN          ; Normal Images
     ok = 'OK'
     ; parameter table
     if(scb(14,scb_num) lt 1 or scb(14,scb_num) gt 3) then ok = 'BAD_C1_PT'
     if(scb(19,scb_num) lt 1 or scb(19,scb_num) gt 3) then ok = 'BAD_C2_PT'
     if(scb(24,scb_num) lt 1 or scb(24,scb_num) gt 3) then ok = 'BAD_C3_PT'
     if(scb(29,scb_num) lt 1 or scb(29,scb_num) gt 3) then ok = 'BAD_C4_PT'
     ; filter wheel 
     if(scb(15,scb_num) lt 0 or scb(15,scb_num) gt 4) then ok = 'BAD_C1_FW'
     if(scb(20,scb_num) lt 0 or scb(20,scb_num) gt 4) then ok = 'BAD_C2_FW'
     if(scb(25,scb_num) lt 0 or scb(25,scb_num) gt 4) then ok = 'BAD_C3_FW'
     if(scb(30,scb_num) lt 0 or scb(30,scb_num) gt 4) then ok = 'BAD_C4_FW'
     ; polar wheel 
     if(scb(16,scb_num) lt 0 or scb(16,scb_num) gt 4) then ok = 'BAD_C1_PW'
     if(scb(21,scb_num) lt 0 or scb(21,scb_num) gt 4) then ok = 'BAD_C2_PW'
     if(scb(26,scb_num) lt 0 or scb(26,scb_num) gt 4) then ok = 'BAD_C3_PW'
     if(scb(31,scb_num) lt 0 or scb(31,scb_num) gt 4) then ok = 'BAD_C4_PW'
     ; IP table
     if(scb(17,scb_num) lt 0 or scb(17,scb_num) gt 19) then ok = 'BAD_C1_IP'
     if(scb(22,scb_num) lt 0 or scb(22,scb_num) gt 19) then ok = 'BAD_C2_IP'
     if(scb(27,scb_num) lt 0 or scb(27,scb_num) gt 19) then ok = 'BAD_C3_IP'
     if(scb(32,scb_num) lt 0 or scb(32,scb_num) gt 19) then ok = 'BAD_C4-IP'
     END
  14: BEGIN        ; Seq PW
     ok='OK'
     if(scb(14,scb_num) lt 0 or scb(14,scb_num) gt 3) then ok = 'BAD_CAM'
     if(scb(15,scb_num) lt 1 or scb(15,scb_num) gt 3) then ok = 'BAD_PT'
     if(scb(16,scb_num) lt 0 or scb(16,scb_num) gt 4) then ok = 'BAD_FW'
     if(scb(17,scb_num) lt 0 or scb(17,scb_num) gt 19) then ok = 'BAD_IP'
     if(scb(18,scb_num) lt 1 or scb(18,scb_num) gt 5) then ok = 'BAD_NUM' $
     ELSE BEGIN
      for i=0,(scb(18,scb_num)-1) DO BEGIN
       if(scb(19+i,scb_num) lt 0 or scb(19+i,scb_num) gt 4) then ok = 'BAD_PW'
      ENDFOR
     END
     END
  ELSE : ok = 'UNK'         ;  Default is UNKNOWN
 ENDCASE
RETURN,ok
end

pro print_tcb,r1,r2
common mem,scb,tcb,tcb_base,tcb_size, scb_base, scb_size
common wait_from_scb,tcb_scbtime32,tcb_scbf32
common hdr, header, outfilename
tcb_scbtime32 = lonarr(25)
tcb_scbf32 = lonarr(25)
scb_list = intarr(1000)
delta_scb = lonarr(1000)
scb_list_time = lonarr(1000)
scb_list_f32 = lonarr(1000)
scb_list_datetime = strarr(1000)
print,format='(A13,1x,Z8)','TCB Address =',tcb_base
print,"TCB  NextTCB TCBQ TaskID Prty  Queue  SCBQ  Time32  f32  DeltaT Exit  Iter"

if(outfilename) then BEGIN
 printf,2,format='(A13,1x,Z8)','TCB Address =',tcb_base
 printf,2,"TCB  NextTCB TCBQ TaskID Prty  Queue  SCBQ  Time32  f32  DeltaT Exit  Iter"
ENDIF

FOR icount=r1,r2 DO BEGIN
 next = tcb(0,icount) + tcb(1,icount)*65536l
 if(next ne 0) then next_tcb = (next - tcb_base)/tcb_size $
 else next_tcb = 0
 nextscb= tcb(6,icount) + tcb(7,icount)*65536l
 next_scb = (nextscb - scb_base)/scb_size 
 ilist = 0
 scb_list_time(0) = 0l
 scb_list_f32(0) = 0l
 IF(next_scb gt 0) then BEGIN
  scb_list_time(ilist) = scb_start_c32(next_scb)
  scb_list_f32(ilist) = scb_start_f32(next_scb)
  tai = double(32.0)*scb_list_time(ilist) + double(scb_list_f32(ilist)/2048.0)
  scb_list_datetime(ilist) = tai2utc(tai,/ECS) 
  IF(ilist eq 0) then BEGIN
   tcb_scbtime32(icount) = scb_start_c32(next_scb)
   tcb_scbf32(icount) = scb_start_f32(next_scb)
   parameter_ok1 = parameter_check(icount,next_scb)         ; check parameters
  ENDIF
  ilist = ilist + 1
  next_scb1 = next_scb
  while ( next_scb1 gt 0 and ilist lt 1000 and icount gt 0) do begin
   scb_list(ilist) = scbq(next_scb1)
   scb_list_time(ilist) = scb_start_c32(scb_list(ilist))
   scb_list_f32(ilist) = scb_start_f32(scb_list(ilist))
   tai = double(32.0)*scb_list_time(ilist) + double(scb_list_f32(ilist)/2048.0)
   scb_list_datetime(ilist) = tai2utc(tai,/ECS) 
   next_scb1 = scb_list(ilist)
   ilist = ilist + 1
  endwhile
 endif else begin
  next_scb = 0
 endelse
 queue='D'
 if(tcb(4,icount) eq 1) then queue = 'R'
 if(tcb(4,icount) eq 3) then queue = 'S'
 if(tcb(4,icount) eq 4) then queue = 'W'
 if(tcb(4,icount) eq 5) then queue = 'C'
 type = 'Cycl'
 if( tcb(50,icount) eq 2) then type ='Iter'
 if( tcb(50,icount) eq 3) then type ='Enda'
 if( tcb(50,icount) eq 4) then type ='Dura'

; check scb Q times
 ok = 'Q_OK'
 delta_scb(0) = 0l
 for i=1,ilist - 2 do begin
  if( scb_list_time(i) lt scb_list_time(i-1)) then ok='QBad'  
  if( (scb_list_time(i) eq scb_list_time(i-1)) and     $
      (scb_list_f32(i) lt scb_list_f32(i-1))) then ok = 'QBad'
; calculate time differences
  delta_scb(i) = (scb_list_time(i) - scb_list_time(i-1)) * 32 
  if(scb_list_f32(i) ge scb_list_f32(i-1)) then begin
   delta_scb(i) = delta_scb(i) + (( scb_list_f32(i) - scb_list_f32(i-1) ) / 2048)
  endif else begin
   delta_scb(i) = delta_scb(i) - 32 + (( 65536l + scb_list_f32(i) - scb_list_f32(i-1) ) / 2048)
  endelse
 endfor

 print,format='(I2,1x,Z8,1x,I4,1x,I6,1x,I4,5x,A1,4x,I4,1x,Z8,1x,Z4,1x,A25,1x,I6,1x,A4,1x,I4,1x,A4,1X,A9)', $
  icount,next,next_tcb,tcb(2,icount),tcb(3,icount),queue,next_scb, $
  scb_list_time(0),scb_list_f32(0),scb_list_datetime(0),delta_scb(0),type,tcb(51,icount), $
  ok,parameter_ok1
 IF(ilist gt 1) then BEGIN
  FOR i=1,ilist-1 do BEGIN
  ; check parameters
  parameter_ok = parameter_check(icount,scb_list(i))
  print,format='(38x,I4,1x,Z8,1x,Z4,1x,A25,1x,I6,1X,A9)', $
  scb_list(i),scb_list_time(i),scb_list_f32(i),scb_list_datetime(i),delta_scb(i),parameter_ok
  ENDFOR
 ENDIF
 if(outfilename) then BEGIN
  printf,2,format='(I2,1x,Z8,1x,I4,1x,I6,1x,I4,5x,A1,4x,I4,1x,Z8,1x,Z4,1x,A25,1x,I6,1x,A4,1x,I4,1x,A4,1X,A9)', $
   icount,next,next_tcb,tcb(2,icount),tcb(3,icount),queue,next_scb, $
   scb_list_time(0),scb_list_f32(0),scb_list_datetime(0),delta_scb(0), $
   type,tcb(51,icount), ok,parameter_ok1
  IF(ilist gt 1) then BEGIN
   FOR i=1,ilist-1 do BEGIN
   ; check parameters
   parameter_ok = parameter_check(icount,scb_list(i))
   printf,2,format='(38x,I4,1x,Z8,1x,Z4,1x,A25,1x,I6,1X,A9)', $
   scb_list(i),scb_list_time(i),scb_list_f32(i),scb_list_datetime(i),delta_scb(i),parameter_ok
   ENDFOR
  ENDIF
 ENDIF
endfor
end

pro print_tcbq
common mem,scb,tcb,tcb_base,tcb_size, scb_base, scb_size
common hdr, header, outfilename
list = intarr(25)
list2 = intarr(25)
next_tcb = lonarr(25)
for iqueue = 1,5 do begin
                      queue = 'Dormant Queue  '
 if(iqueue eq 1) then queue = 'Ready Queue    '
 if(iqueue eq 3) then queue = 'Suspended Queue'
 if(iqueue eq 4) then queue = 'Wait Queue     '
 if(iqueue eq 5) then queue = 'Current Queue  '
 iorder = 0
 for itcb = 0, 24 do begin
  if(tcb(4,itcb) eq iqueue) then begin
   list(iorder) = itcb
   next_tcb(iorder) = tcb(0,itcb) + tcb(1,itcb)*65536l
   if(next_tcb(iorder) ne 0) then $
    next_tcb(iorder) = (next_tcb(iorder) - tcb_base)/tcb_size $
    else next_tcb(iorder) = 0 
   iorder = iorder + 1
  endif
 endfor      ; itcb
; print,'list',list,'next_tcb',next_tcb
 search_tcb = 0
 found_tcb = iorder
 for jorder = iorder-1 , 0, -1 do begin
 for korder = 0, iorder do begin
;print,jorder,next_tcb(korder),found_tcb,search_tcb
 if ( next_tcb(korder) eq search_tcb and found_tcb gt 0) then begin
;print,"got one"
  list2(found_tcb) = list(korder)
  search_tcb = list(korder)
  found_tcb = found_tcb - 1
 endif
 endfor      ; korder
 endfor      ; jorder
 if(iorder ge 1) then BEGIN
  print,format='(A15,1x,25I3)',queue,list2(1:iorder)
  if(outfilename) then printf,2,format='(A15,1x,25I3)',queue,list2(1:iorder)
 ENDIF
endfor       ; iqueue
end

pro waitq_from_scb
common wait_from_scb,tcb_scbtime32,tcb_scbf32
common hdr, header, outfilename
iorder = indgen(25)
izero = intarr(25)
w = intarr(25)
iswitch = 0

for itcb = 0, 24 do begin
 if (tcb_scbtime32(itcb) eq 0 and tcb_scbf32(itcb) eq 0) then izero(itcb) = 1
endfor

while (iswitch ne -1) do begin
 iswitch = -1
 for itcb = 1, 24 do begin
; check time of 1st scb in each TCBQ 
  if (tcb_scbtime32(iorder(itcb)) lt tcb_scbtime32(iorder(itcb - 1))) then begin
   iswitch = iorder(itcb)
   iorder(itcb) = iorder(itcb - 1)
   iorder(itcb - 1) = iswitch
  endif else begin 
   if (tcb_scbtime32(iorder(itcb)) eq tcb_scbtime32(iorder(itcb - 1))) then begin
    if (tcb_scbf32(iorder(itcb)) lt tcb_scbf32(iorder(itcb - 1))) then begin
     iswitch = iorder(itcb)
     iorder(itcb) = iorder(itcb - 1)
     iorder(itcb - 1) = iswitch
    endif
   endif
  endelse
 endfor
endwhile
for itcb = 0, 24 do begin
 if(izero(iorder(itcb)) eq 1) then w(itcb) = 1 else w(itcb) = 0
endfor
z = where(w eq 0)
print,'Wait Q from SCBQ',iorder(z),format='(A16,1x,25I3)'
if(outfilename) then BEGIN
 printf,2,'Wait Q from SCBQ',iorder(z),format='(A16,1x,25I3)'
ENDIF
end

pro print_sched,r1,r2
common sched, sched
common hdr, header, outfilename
print,"Num Type Task  Start32  f32 Exit   Exit32  f32 NumP Parm01 Parm02 Parm03 Parm04"
if(outfilename) then BEGIN
 printf,2,"Num Type Task  Start32  f32 Exit   Exit32  f32 NumP Parm01 Parm02 Parm03 Parm04"
ENDIF
for i= r1,r2 do begin
 type = 'Cycl'
 if( sched(4,i) eq 2) then type ='Iter'
 if( sched(4,i) eq 3) then type ='Enda'
 if( sched(4,i) eq 4) then type ='Dura'
 print, format='(I3,1x,I4,1x,I4,1x,Z8,1x,Z4,1x,A4,1x,Z8,1x,Z4,1x,I4,1x,21(I6,1x))', $
  i,sched(0),sched(1),sched(2),sched(3),type,sched(5),sched(6),sched(7),sched(8), $
  sched(9),sched(10),sched(11)

 if(outfilename) then printf,2, format='(I3,1x,I4,1x,I4,1x,Z8,1x,Z4,1x,A4,1x,Z8,1x,Z4,1x,I4,1x,21(I6,1x))', $
  i,sched(0),sched(1),sched(2),sched(3),type,sched(5),sched(6),sched(7),sched(8), $
  sched(9),sched(10),sched(11)
endfor
end

pro obedump,filename,OUTFILE=outfile,FULL_SCB=full_scb
common mem,scb,tcb,tcb_base,tcb_size, scb_base, scb_size
common hdr, header, outfilename
if(keyword_set(full_scb))then full_scb = 1 else full_scb = 0
array = intarr(5)
openr,1,filename
readu,1,array
close,1

outfilename = 0
if keyword_set (outfile) then BEGIN
 outfilename = 1
 openw,2,outfile
 printf,2,filename
ENDIF

header = array(0:4)
if ( header(1) eq 2 or header(1) eq 3) then read_dump,filename
if ( header(1) eq 2 ) then print_scb,0,999,full_scb
print
if ( header(1) eq 2 or header(1) eq 3) then print_tcb,0,24
print
if ( header(1) eq 2 or header(1) eq 3) then print_tcbq
if ( header(1) eq 2 ) then waitq_from_scb
if ( header(1) eq 17 ) then begin
 read_dump,filename
 print_sched,0,499
endif

if keyword_set (outfile) then BEGIN
 close,2
ENDIF

end