begin 

routinespec (16_1198)phex(integer  l)
routinespec (16_1194)whex(integer  w)
routinespec (16_1190)bhex(integer  b)
integerfnspec (16_119c)rhex
bytename  status,data,control
constinteger  tbe=8,rd=4,rc=2,rbf=1
integer  sym

 status == byteinteger(16_7fffc)
   data == byteinteger(16_7fffd)
control == byteinteger(16_7ffff)

constinteger  cr=13,esc=27

routine  put(integer  x)
  newline and  printsymbol('^') unless  x&255=x
  if  ' '<=x<=126 or  x=nl or  x=cr then  printsymbol(x) elsestart 
    printsymbol('_') if  x&255=x
    bhex(x)
  finish 
end 

integerfn  hex
integer  n1,n2
  n1 = testsymbol until  n1>=0
  n1 = n1-7 if  n1>'?'; n1 = n1&15
  n2 = testsymbol until  n2>=0
  n2 = n2-7 if  n2>'?'; n2 = n2&15
  result  = n1<<4+n2
end 

routine  reset
  status = 16_40
end 

routine  disable
integer  zero=0
  status = zero
end 

routine  twait
  cycle 
    returnif  status&tbe#0
  repeat 
end 

routine  putc(integer  x)
  control = x; twait
end 

routine  putd(integer  x)
  data = x; twait
end 

constinteger  filebeg=16_1000
bytearray  file(filebeg:16_3fff)
integer  fileend

routine  preload
integer  sym
  onevent  9 start 
    closeinput; selectinput(0); return 
  finish 
  selectinput(1)
  fileend = filebeg
  cycle 
    readsymbol(sym); file(fileend) = sym; fileend = fileend+1
  repeat 
end 

routine  load
integer  sym,ad
  putc(16_03)
  ad = 16_1000
  while  ad<fileend cycle 
    sym = file(ad); putd(sym); ad = ad+1
  repeat 
  putc(16_0b)
end 

integerfn  getd
  cycle 
  repeatuntil  status&rbf#0
  result  = data if  status&rd#0
  result  = control
end 

routine  getc(integer  x)
integer  y
  cycle 
    cycle 
    repeatuntil  status&rbf#0
    if  status&rd#0 start 
      y = data
      unless  x=16_0b start 
        printsymbol('['); bhex(y); printsymbol(']')
      finish 
    finishelsestart 
      y = control
      returnif  x=y
      unless  x!!y=16_f0 start ; !?????
        printstring("[^"); bhex(y); printsymbol(']')
      finish 
    finish 
  repeat 
end 

constinteger  ptr=8,peek=13,poke=14

routine  at(integer  x)
  putc(ptr); putd(x&255); putd(x>>8&255)
end 

integerfn  byte
  putc(peek); getc(poke); result =getd
end 

integerfn  word
integer  x
  x = byte; result =byte<<8+x
end 

routine  do long
integer  x
  x = word; x = word<<16+x
  space; phex(x); newline
end 

routine  do word
  space; whex(word); newline
end 

routine  do byte
  spaces(3); bhex(byte); newline
end 

routine  spy
integer  ad,sym,count,i
constinteger  portstart=16_1e00
constinteger  portsize=32
constinteger  procstart=portstart+32*portsize
constinteger  procsize=40
constinteger  buffstart=procstart+32*procsize
constinteger  buffsize=14+512+20+6

  routine  do port(integer  p)
  integer  i,j
  bytearray  b(1:32)
    ad = portstart+p*portsize; at(ad)
    j = 0
    for  i = 1,1,32 cycle 
      b(i) = byte; j = j!b(i) unless  i=7 or  i=8
    repeat 
    returnif  j=0
    at(ad)
    printstring("port"); bhex(p)
    printstring(" ("); whex(ad); printsymbol(')')
    for  i=0,1,11 cycle 
      space if  i=0 or  i=6; bhex(byte)
    repeat 
    printstring(" t"); bhex(byte)
    printstring(" i"); bhex(byte)
    space; whex(word)
    printstring(" o"); bhex(byte)
    space; printsymbol('l'); bhex(byte); space; whex(word)
    newline; spaces(13)
    printsymbol('r'); whex(word); space
    printsymbol('s'); whex(word); space
    printsymbol('L'); whex(word); printsymbol('/'); whex(word); space
    printsymbol('E'); whex(word); printsymbol('/'); whex(word); newline
  end 

  routine  do proc(integer  i)
  integer  lim,sp
    ad = procstart+i*procsize
    at(ad); lim = ad+procsize
    printstring("proc"); bhex(i)
    printstring(" ("); whex(ad); printsymbol(')')
    space; whex(word)
    sp = word
    newline andreturnif  sp=0
    printstring(" sp"); whex(sp);
    printstring(" bu"); whex(word)
    printstring(" sz"); whex(word)
    unless  ad>sp start 
      at(sp)
      while  sp<lim cycle 
        printsymbol('|'); sp = sp+2; whex(word)
      repeat 
      printsymbol('|')
    finish 
    newline
  end 

  routine  do buff(integer  i)
    ad = buffstart+i*buffsize
    printstring("buff"); bhex(i)
    printstring(" ("); whex(ad); printstring(") ")
    at(ad)
    whex(word); space
    at(ad)
    bhex(byte) for  i = 1,1,6; space
    bhex(byte) for  i = 1,1,6; space
    bhex(byte) for  i = 1,1,2; space
    bhex(byte) for  i = 1,1,5; newline
  end 

  sym = nextsymbol
  if  sym#nl start 
    ad = rhex; read(count)
    at(ad)
    while  count>0 cycle 
      count = count-1; space; bhex(byte); newline if  count&15=0
    repeat 
  finishelsestart 
    at(3)
    printstring("Station "); bhex(byte)
    printstring(" firmware of "); bhex(byte); printsymbol('/')
    bhex(byte); printsymbol('/'); bhex(byte); newline
    at(16_3d00)
    printstring("prolist"); do word
    printstring("buflist"); do word
    printstring("bufque "); do word
    printstring("erbuf1 "); do word
    printstring("erbuf2 "); do word
    printstring("lrpro  "); do word
    printstring("ltpro  "); do word
    printstring("ltque  "); do word
    printstring("etpro  "); do word
    printstring("etque  "); do word
    printstring("temp   "); do word
    printstring("intstak"); do word
    printstring("dmaon  "); do byte
    printstring("dmaoff "); do byte
    printstring("inton  "); do byte
    printstring("station"); do byte
    printstring("net    "); do word; do word
    printstring("ptr    "); do word
    printstring("sizerr "); do long
    printstring("crcerr "); do long
    printstring("trcerr "); do long
    printstring("rejerr "); do long
    printstring("heard  "); do long
    printstring("hearc  "); do long
    printstring("ignore "); do long
    printstring("duplic "); do long
    printstring("closed "); do long
    printstring("dwrong "); do long
    printstring("swrong "); do long
    printstring("spuack "); do long
    printstring("qwrong "); do long
    printstring("cretr  "); do long
    printstring("aretr  "); do long
    printstring("sent   "); do long
    printstring("sentc  "); do long
    printstring("eovf   "); do long
    printstring("eovr   "); do long
    printstring("adderr "); do long
    printstring("mode   "); do byte
    at(16_2000)
    do port(i) for  i=0,1,31
    do proc(i) for  i=0,1,31
    do buff(i) for  i=0,1,9
  finish 
  sym = testsymbol until  sym<0
end 

routine  temp
ownstring (31)s="s0fmac:exec.mob"
integer  i,xno,j,k
  routine  sym(integer  sym)
  owninteger  pos=0
    printsymbol(sym); pos=0 if  sym=nl
    newline and  pos=0 if  pos>=70
  end 
  routine  prolog
    putc(16_3f); getc(16_1f); putc(16_2f)
  end 
  routine  response
  integer  i,j
    putc(16_0b); getc(16_3f)
    putc(16_1f); getc(16_2f)
  end 
  onevent  0 start 
    printstring("*A*")
    return 
  finish 
  cycle 
    prolog; putd(charno(s,i)) for  i=1,1,length(s); putd(nl); response
    xno = getd; sym(xno)
!    i = getd %and printsymbol(i) %until i=nl
    getc(16_0b)
    cycle 
      prolog; putd('x'); putd(xno); putd(nl); response
      j = getd; {printsymbol(j);} k = getd; {printsymbol(k)}
!      i = getd %and printsymbol(i) %until i=nl
      getc(16_0b)
    repeatuntil  j#'P' or  k#'0'
    prolog; putd('k'); putd(xno); putd(nl); response
    i = getd and  sym(i) until  i=nl
    getc(16_0b)
  repeatuntil  testsymbol>=0
end 

routine  open
  putc(16_07); putd(16_11); !Station NOR1
  putc(16_8f); getc(16_1f); putc(16_2f)
  putd(16_70); putd(1); putc(16_0b)
end 

routine  boot
  putc(16_3f); getc(16_1f); putc(16_2f); putd(16_0c); putc(16_0b)
end 

!reset
preload
disable

sym = testsymbol
printstring(" Load Boot Open Temp Spy"); newline

cycle 
  sym = testsymbol
  if  status&rbf#0 start 
    if  status&rc#0 then  put(control!256) c 
    else {if status&rd#0 %then} put(data&255)
  finishelseif  status&tbe#0 and  sym>=0 start 
    if  sym=esc start 
      sym = testsymbol until  sym>=0
      if  sym='H' then  spy c 
      elseif  sym='B' then  temp c 
      elseif  sym='A' then  open c 
      elseif  sym='C' then  boot c 
      elseif  sym='D' then  load c 
      else  putd(esc) and  putd(sym)
    finishelseif  sym='^' then  putc(hex) c 
    elseif  sym='_' then  putd(hex) c 
    elseif  sym='.' thenexitc 
    else  putd(sym)
  finish 
repeat 
status = 6

endofprogram