flag=0
proc err () { xpanel("**** ERROR ****") xlabel($s1) xpanel() }
strdef tstr
if (unix_mac_pc() == 3) {
   chdir(neuronhome())
   if (chdir("fctb")==0) flag=1
   if (chdir("..\fctb")==0) flag=1
   if (flag==0) {
     sprint(tstr,"ERROR: FCTB directory not found; should be in %s or %s/..\n",neuronhome(),neuronhome()) err(tstr)
   } else if (default_dll_loaded_== 0) {
     flag = nrn_load_dll("nrnmech.dll")
     if (flag==1) { default_dll_loaded_ = 1 } else {
       sprint(tstr,"ERROR loading %s/nrnmech.dll; remake with mknrndll.\n",getcwd()) err(tstr) }
   }
}

objref helpbox, helpdeck
proc help_list() {
  helpbox=new HBox(2)
  helpbox.intercept(1)
  xpanel("")
  xbutton("General","helpdeck.flip_to(0)")
  xbutton("Quick start","helpdeck.flip_to(1)")
  xbutton("GUI layout","helpdeck.flip_to(2)")
  xbutton("Instruction set","helpdeck.flip_to(3)")
  xbutton("Read/write program files","helpdeck.flip_to(4)")
  xbutton("Exercises","helpdeck.flip_to(5)")
  xpanel()

 helpdeck=new Deck()
helpdeck.intercept(1)
  xpanel("")
    xlabel("Program #5 -- add numbers in a list -- kludge")
    xlabel("0 13")
    xlabel("1 22")
    xlabel("2 17")
    xlabel("3 CLA 0    // start here")
    xlabel("4 ADD 2    // pointer -- becomes a HLT")
    xlabel("5 DEC 4    // ")
    xlabel("6 JMP 4    // loop")
    xlabel("")
  xpanel()
  xpanel("")
    xlabel("Press \"Single step\" multiple times to step through program.  Before")
    xlabel("each press, note the contents of the memory location pointed to by")
    xlabel("the PC (program counter) and try to predict what will happen to")
    xlabel("values in memory and in ACC (accumulator).  Rerun by pressing menu")
    xlabel("entry \"Load program: Reload program.\"")
    xlabel("")
  xpanel()
  xpanel("")
    xlabel("Two windows: ")
    xlabel("  1) Memory display: shows the entire core memory in octal with each")
    xlabel("  address followed by contents of the memory location")
    xlabel("  2) Control panel: shows main registers and allows program control")
    xlabel("")
    xlabel("Control Panel contents:")
    xlabel("Stop processing: toggle switch to stop CPU if in infinite loop")
    xlabel("ACC: gives contents of accumulator")
    xlabel("PC:  gives contents of program counter")
    xlabel("Run: start the program at the location specified in PC")
    xlabel("Single step: run one instruction cycle of CPU")
    xlabel("Change Address: specify an octal address in memory to change (poke)")
    xlabel("To value: octal value to place in address specified")
    xlabel("Registers: allows clearing of registers (ACC, PC) or core memory,")
    xlabel("  increment PC")
    xlabel("Load program: read and write programs to disk, reload program")
    xlabel("Show: List instruction set")
    xlabel("      Alternatives for listing memory (binary, octal, hex, decimal)")
    xlabel("      Relaunch memory window")
    xlabel("")
  xpanel()
  xpanel("")
    xlabel("ADD     0       Add contents of address to ACC        add [addr]")
    xlabel("DEC     1       Decrement address contents by 1      dec [addr]")
    xlabel("INC     2       Increment address contents by 1         inc [addr]")
    xlabel("SKP     3       Skip next instruction if addr==0          skp [addr]")
    xlabel("JMP     4       Jump to specified address                   jmp [addr]")
    xlabel("CLA     5       Clear the accumulator                           cla 0")
    xlabel("LDA     6       Load ACC to specified address            lda [addr]")
    xlabel("HLT     7       Halt the Program                                      hlt 0")
    xlabel("")
  xpanel()
  xpanel("")
    xlabel("You can create .p8 files in an editor and load them")
    xlabel("Max lines currently 30 (24 decimal): address 00-27")
    xlabel("Format is either")
    xlabel("  1) an address (octal) followed by an octal number <= 7777")
    xlabel("  2) an address (octal ) followed by an assembler command followed by")
    xlabel("     an octal number")
    xlabel("Comments can follow, starting with '//'")
    xlabel("Full line comments can also be given starting with '//'")
    xlabel("")
  xpanel()
  xpanel("")
    xlabel("1) Run the program.  Confirm that the results are correct.")
    xlabel("")
    xlabel("2) Rewrite the program to add together a list of 5 numbers.")
    xlabel("")
    xlabel("3) Think of other silly kludges that change one command to another.")
    xlabel("   Consider adding 1000 to a command to move it to the next command.")
  xpanel()
helpdeck.intercept(0)
  helpdeck.map()
  helpdeck.flip_to(0)
  helpbox.intercept(0)
  helpbox.map()
}
// Created 07/24/09 17:50:28 by "/usr/site/scripts/loadfiles -q -a COM_kludge.hoc"
//================================================================
// INSERTED COM_kludge.hoc
// =Id=  COM_kludge.hoc,v 1.6 2002/09/15 17:14:10 billl Exp 

// load_file("COM_kludge_.hoc")
//================================================================
// INSERTED string2.hoc
// =Id=  string2.hoc,v 1.1 2002/09/07 12:55:06 billl Exp 

//*String2 template
begintemplate String2
public s,t
strdef s,t
proc init() {
    if (numarg() == 1) { s=$s1 }
    if (numarg() == 2) { s=$s1 t=$s2 }
  }
endtemplate String2
// END string2.hoc
//================================================================
//================================================================
// INSERTED bkutils.hoc
// =Id=  bkutils.hoc,v 1.73 2004/04/30 15:35:32 billl Exp 

// load_file("stdgui.hoc")
// load_file("setup.hoc")
load_file("stdrun.hoc")
if (name_declared("install_matrix")) execute("install_matrix()") 
if (name_declared("install_vecst")) execute("install_vecst()")

//* objects
objref  g[4], stim[2], nc, gp, sns, ind, vec0, vec[2], rdm[2], XO, YO, cvode
objref st,wt,scr,smat,box[4],insr,nil,sref,tmpfile,tmpobj,tmpvec,tmplist,sfunc,deck
strdef mesg,tstr,tstr2,temp_string_,filename,section
tmpfile = new File()
tmplist = new List()
fchooser_flag = 0
graph_flag = 1
double x[4],y[4]
rdm = new Random()
cvode = new CVode()
sfunc = new StringFunctions()
{ ind=new Vector() vec[0]=ind.c vec[1]=ind.c vec0=ind.c}

//* iterators and templates
//** string iterator
iterator case() { local i
    i1 = 0
    for i = 2, numarg() {
        $&1 = $i
        iterator_statement
        i1+=1
      }
  }

iterator scase() { local i
    i1 = 0
    for i = 1, numarg() {
        temp_string_ = $si
        iterator_statement
        i1+=1
      }
  }

// eg for scase2("a","b","c","d","e","f") print temp_string_,temp_string2_
iterator scase2() { local i
    i1 = 0
    if (numarg()%2==1) {print "ERROR: scase2 needs even number of args" return }
    for i = 1, numarg() {
        tmpobj=new String2()
        tmpobj.s=$si i+=1  tmpobj.t=$si
        iterator_statement
        i1+=1
      }
  }

// like perl chop -- removes the last character
proc chop () { sfunc.left($s1,sfunc.len($s1)-1) }

//** list iterator ltr
// usage 'for ltr(XO, tmplist) { print XO }'
iterator ltr() { local i
    if (numarg()==3) {$&3=0} else {i1 = 0}
    for i = 0, $o2.count() - 1 {
        $o1 = $o2.object(i)
        iterator_statement
        if (numarg()==3) { $&3+=1 } else { i1+=1 }
      }
    $o1 = nil
  }

//** list pairwise iterator ltrp
// usage 'for ltrp(XO, YO, list) { print XO,YO }' takes them pairwise
iterator ltrp() { local i
    if (numarg()==4) {$&4=0} else {i1 = 0}
    for (i=0;i<$o3.count()-1;i+=2) {
        $o1 = $o3.object(i) $o2 = $o3.object(i+1)
        iterator_statement
        if (numarg()==4) { $&4+=1 } else { i1+=1 }
      }
    $o1=nil $o2=nil
  }

//** vector iterator vtr
// usage 'for vtr(&x, vec) { print x }'
iterator vtr() { local i
    if (numarg()==3) {$&3=0} else {i1 = 0}
    for i = 0, $o2.size() - 1 {
        $&1 = $o2.x[i]
        iterator_statement
        if (numarg()==3) { $&3+=1 } else { i1+=1 }
      }
  }

//* vlk(vec) -- display vector slice -- more flexible than vec.printf
// vlk(vec,max)
// vlk(vec,min,max)
// prints out a segment of a vector
vlk_width=20
proc vlk () { local i,j,min,max,dual,wdh,nonl,nl
    j=dual=0 nl=1 wdh=vlk_width
    if (numarg()==1) { min=0 max=$o1.size-1 }
    if (numarg()==2) if ($2==0) { nl=min=0 max=$o1.size-1 // vlk(vec,0) flag to suppress new lines
          } else if ($2>0) { min=0 max=$2-1 } else { min=$o1.size+$2 max=$o1.size-1 }
    if (numarg()==3) if ($3>-1) { min=$2 max=$3 } else { min=0 max=$o1.size-1 dual=1 }
    if (numarg()==4) { min=$3 max=$4 dual=1 }
    if (min<0) min=0
    if (max>$o1.size-1) max=$o1.size-1
    if (dual) if (max>$o2.size-1) max=$o2.size-1
    for i=min,max { 
        if (dual) printf("%g:%g ",$o1.x[i],$o2.x[i]) else printf("%g ",$o1.x[i]) 
        if ((j=j+1)%vlk_width==0 && nl) { print "" }
      }
    if (nl) print ""
  }

//** savevec([list,]vec1[,vec2,...]) add vector onto veclist or other list if given as 1st arg
objref veclist
veclist = new List()
proc savevec () { local i,flag,beg
    if (isobj($o1,"List")) beg=2 else beg=1
    for i=beg, numarg() { 
        tmpvec = new Vector($oi.size)
        tmpvec.copy($oi)
        if (beg==2) $o1.append(tmpvec) else veclist.append(tmpvec)
        tmpvec = nil
      }
  }

//* graphics; symbols and colors
{symnum = 7 colnum = 9}
objectvar cl[colnum], sym[symnum]
for ii=0,colnum-1 cl[ii]=new String()
{ cl[0].s ="white" cl[1].s ="black"  cl[2].s ="red"  cl[3].s ="blue"  cl[4].s ="green"  
  cl[5].s ="orange" cl[6].s ="brown"  cl[7].s ="violet"  cl[8].s ="yellow"  }
for ii=0,symnum-1 sym[ii]=new String()
{ sym[0].s = "o" sym[1].s = "t" sym[2].s = "s"  
    sym[3].s = "O" sym[4].s = "T" sym[5].s = "S"  sym[6].s = "+"}

gcl=0  // graph color
func color () {
    gcl = (gcl+1)%colnum
    if (gcl==0) gcl=1 // throw out white
    if (numarg()==1) $o1.color(gcl)
    return gcl
  }

//** qhp() basic buttons
proc qhp () {
    if (numarg()==1) xpanel("CONTROLS",1)
    xbutton("Quit","quit()")
    xbutton("Help","help_list()")
    xbutton("Print panel","pwman_place(50,50)")  
    xbutton("Reset","reset()")
    if (numarg()==1) xvarlabel(mesg)
    if (numarg()==1) xpanel(0,0)
    mesg="" 
  }

//** allgraphs()
proc remgrs () { local ii
    for ii=0,3 graphList[ii].remove_all()
    objref graphItem
  }
proc allgraphs () { for ii=0,3 for ltr(XO,graphList[ii]) XO.exec_menu($s1) }
proc vp() { allgraphs("View = plot") }
proc allgrop () { 
    for ii=0,3 for ltr(XO,graphList[ii]) {
        sprint(tstr,"%s.%s",XO,$s1)
        execute(tstr)
      }
  }

//** grrtsize() use view=plot and then pad a little
proc grrtsize () { local h,w,frac
    if (numarg()>=1) tmpobj=$o1 else tmpobj=graphItem
    if (numarg()>=2) frac = $2 else frac=.05
    tmpobj.exec_menu("View = plot")
    tmpobj.size(&x)
    w=frac*(x[1]-x[0])  h=frac*(x[3]-x[2])
    x[0]-=2*w x[1]+=w x[2]-=4*h x[3]+=h // need extra padding on bottom
    tmpobj.size(x[0],x[1],x[2],x[3])
  }

//** isobj(o1,s2) checks whether object $o1 is of type $s2
func isobj () {
    sprint(temp_string_,"%s",$o1)
    if (sfunc.substr(temp_string_,$s2)==0) {
        return 1
      } else {
        return 0
      }
  }

// cbin(min,max): binary colormap
proc cbin () {
    $o1.colormap(2)
    $o1.colormap(0, 255, 0, 0)
    $o1.colormap(1, 255, 255, 0)
    $o1.scale($2, $3)
  }

// my version of newPlotV() leaves off the label
proc newplotv () {
    newplot()
    graphItem.addvar("","v(.5)",1,3)
  }

proc redraw0 () { plrdrf=0 } // stub with flag
proc plcback () { } // callback
objref oxv,oyv // coordinates: 0,1 line start; 2,3 last loc
oxv=new Vector(2)
oyv=new Vector(2)
plrdrf=1 // flag will be unset if using redraw stub
plhorz=0 // 1 for horizontal, 2 for verticle lines

proc pl () {
    if ($1==2) { // mouse down -- new line
        redraw0() // unset plrdrf if redraw0() not overwritten
        oxv.x[0]=oxv.x[1]=$2 oyv.x[0]=oyv.x[1]=$3
      } else {
        if (plrdrf) graphItem.erase_all
        oyv.line(graphItem,oxv,0,2)
        oxv.x[1]=$2 oyv.x[1]=$3
        if (plhorz==1) oyv.x[1]=oyv.x[0]
        if (plhorz==2) oxv.x[1]=oxv.x[0]
        oyv.line(graphItem,oxv,2,2)
        redraw0() // will redraw if defined
        if ($1==3) plcback(oxv,oyv)
      }
  }

// newplot([width,height,pointer]) OR newplot([pointer])
proc newplot () { local wd,ht
    graphItem = new Graph(0)
    if (numarg()==1) $o1=graphItem // make a pointer
    if (numarg()==3) $o3=graphItem
    if (numarg()>1) { wd=$1 ht=$2 } else { wd=500 ht=300 }
    graphItem.save_name("graphList[0].")
    graphList[0].append(graphItem)
    graphItem.view(0,-90,tstop,150,600,200,wd,ht)
  }

//* cbw(min,max): b/w binary colormap
proc cbw () {
    $o1.colormap(2)
    $o1.colormap(0, 0, 0, 0)
    $o1.colormap(1, 255, 255, 255)
    $o1.scale($2, $3)
  }

//* I/O
//** svrd(0/1,name,file_ext[,fflag]) save-0 and read-1
// eg svrd(1,"Image","img") will look for file.img files to read
// fflag -- return filename only -- don't call parser
proc svrd () { local ii,num,cnt,fflag
    rdflag=$1
    if (numarg()==4) fflag=$4 else fflag=0
    sprint(tstr2,"*.%s",$s3)
    if (rdflag==0) { // write
        sprint(tstr,"Write %s",$s2)
        tmpfile.chooser("w",tstr,tstr2,"WRITE","","")
        if (tmpfile.chooser()==1) {
            tmpfile.getname(filename)
            if (!fflag) parsr(rdflag)
          }
      } else if (rdflag==1) { // read
        sprint(tstr,"Read %s",$s2)
        tmpfile.chooser("r",tstr,tstr2,"READ","","")
        if (tmpfile.chooser()==1) {
            tmpfile.getname(filename)
            if (!fflag) parsr(rdflag)
          }
      }
    mesg=filename
    tmpfile.close
  }

//* xgetargs, d2b
//** range(val,min,max) -- return val only if in proper range
// eg stim.noise=range(stim.noise,0,1)
func range () {
    if ($1<$2) return $2 
    if ($1>$3) return $3
    return $1
  }

//** err()
proc err () {
    if (numarg()==1) mesg=$s1
    print mesg
  }

//** xvarstr(): display a list of strings in an xpanel using xvarlabel
proc xvarstr () { local ii,cnt
    // ivoc_style("*font", "fixed")
    if (unix_mac_pc() == 1) {
        ivoc_style("*font", "*helvetica-bold-r-normal*--14*")
      }
    xpanel($s1)
    for ltr(XO,$o2) xvarlabel(XO.s)
    xpanel()
  }

//** xgetargs(panel_name,command,arg1[,arg2,...],defaults)
// xgetargs("Random session","newrand","# of patts","patt size  ","overlap   ","5,33,7")
objref argv
argv = new Vector()
proc xgetargs () { local i,args
    args=numarg()-3  i=numarg()
    argv.resize(0)
    sprint(temp_string_,"argv.append(%s)",$si)
    execute(temp_string_)
    if (argv.size!=args) argv.resize(args)
    xpanel($s1)
    mesg=$s1
    xvarlabel(mesg)
    for i=3,numarg()-1 {
        sprint(temp_string_,"argv.x[%d]",i-3)
        xvalue($si,temp_string_)
      }
    sprint(temp_string_,"xgetexec(\"%s\",%d)",$s2,args)
    xbutton("Execute",temp_string_)
    xpanel()
  }

proc xgetexec () { local i,args
    args = $2
    if (argv.size!=args) { mesg="Error-close & relaunch panel" return }
    sprint(temp_string_,"%s(",$s1)
    for i=0,args-2 sprint(temp_string_,"%s%g,",temp_string_,argv.x[i])
    sprint(temp_string_,"%s%g)",temp_string_,argv.x[i])
    print temp_string_
    execute(temp_string_)
  }
  

//** d2b(): decimal to binary, gives a binary appearing number for showing
// eg for ii=0,100 printf("%010d\n",d2b(ii))
func d2b () { local num,ii,rem,res
    num=$1 ii=0 res=0
    while (num>0) {
        rem = int(2*(num/2-int(num/2))) // right digit
        num=int(num/2) // remove right digit
        res+=rem*10^ii
        ii+=1
      }
    return res
  }

//* matrix stuff

//** cvec(),rvec() put out col bzw row vecs in latex format
proc cvec () { local i
    printf("\\bpm ")
    for vtr(&x,$o1) if (i1<$o1.size-1) printf("%g \\\\ ",x)
    printf("%g \\epm\n",x)
  }

proc rvec () { local i
    printf("\\bpm ")
    for vtr(&x,$o1) if (i1<$o1.size-1) printf("%g & ",x)
    printf("%g \\epm\n",x)
  }

//** matp(mat,rows,cols) prints out matrix in latex format
proc matp () { local i,j,rows,cols
    rows=$2 cols=$3
    if ($o1.size!=rows*cols) {print "ERR: matp - mat.size != rows*cols" return}
    printf("\\bpm\n")
    for (i=0;i<rows;i+=1) {
        for (j=0;j<cols-1;j+=1) {
            printf("%4g & ",$o1.x[i*cols+j])
          }
        printf("%4g \\\\ \n",$o1.x[i*cols+j])
      }
    printf("\\epm\n")
  }

//** same as matp but not latex format
proc mpf () { local i,j,rows,cols
    rows=$2 cols=$3
    if ($o1.size!=rows*cols) {print "ERR: - mat.size != rows*cols" return}
    for (i=0;i<rows;i+=1) {
        for (j=0;j<cols-1;j+=1) {
            printf("%12.3g  ",$o1.x[i*cols+j])
          }
        printf("%12.04g \n",$o1.x[i*cols+j])
      }
  }

//** print out a matrix*vec multiplication
proc mpfv () { local i,j,rows,cols
    cols=$o2.size rows=$o1.size/cols
    for (i=0;i<rows;i+=1) {
        printf("|  ")
        for (j=0;j<cols;j+=1) {
            printf("%-12.03g  ",$o1.x[i*cols+j])
          }
        if (i<$o2.size) printf("  |   %12.04g \n",$o2.x[i]) else printf("  |\n")
      }
    if (cols>rows) for i=rows,cols-1 printf("%70.04g \n",$o2.x[i])
  }

//** mmlt(mdest,m1,m2,r2) matrix mult between 2 mats
// r2==c1 gives shared dimension
proc mmlt () { local i,j,r1,c1,r2,c2
    c1 = r2 = $4 // shared dimension (cols of 1st/rows of second)
    r1=$o2.size/c1 c2=$o3.size/r2
    printf("%dx%d * %dx%d = %dx%d\n",r1,c1,r2,c2,r1,c2)
    $o1.resize(r1*c2)
    vec[0].resize(c1) // length of a row of mat A
    vec[1].resize(r2) // length of a col of mat B
    for i=0,r1-1 for j=0,c2-1 {
        vec[0].mrow($o2,i,c1) vec[1].mcol($o3,j,c2)
        $o1.x[i*c2+j]=vec[0].dot(vec[1])
      }
    $o1.mprintf(r1,c2)
    dealloc(a)
  }

//* membrane and pp's
//** runbutton
running_ = 1
proc runbutton () {
    if (running_ == 0) { stoprun = 1  return }
    if (t>0 && t<tstop-0.1) continuerun(tstop) else run()
    stoprun=1 running_=0
  }

//** proc print_pp_location(PP), from doc/html/refman/nocmodl.html
proc print_pp_location() { local x //arg1 must be a point process
     x = $o1.get_loc()
     sectionname(section)
     printf("%s located at %s(%g)\n", $o1, section, x)
     pop_section()
  }

func get_pp () { local x
     x = $o1.get_loc()
     sectionname(section)
     section sref = new SectionRef()
     pop_section()
     return x
  }
// END bkutils.hoc
//================================================================
//================================================================
// INSERTED pdp8.hoc
// =Id=  pdp8.hoc,v 1.51 2004/02/23 18:40:14 billl Exp 

// load_file("pdp8.hoc")
if (! name_declared("String2")) load_file("string2.hoc")
if (! name_declared("tmpobj")) load_file("bkutils.hoc")

//* DEFS and Main panel
NSTEPS=24
double OP[NSTEPS], ADDR[NSTEPS] // core: see doc under sstep()
objref prog // core: copied into strings for user viewing
prog = new List() // use list statt prog[NSTEPS] so iterator easy
for ii=0,NSTEPS-1 prog.append(new String())
double ACC[1],PC[1] // accumulator, program counter as decimal numbers
strdef acc,pc       // accumulator, program counter as octal strings
strdef pstr1,pstr2,lstprog,errline,loadstr
stopf = 0  // set to 1 to stop processing
pkaddr=pkval=0      // address and value for poking memory

objref comms[8] // command names
for ii=0,7 comms[ii]=new String2() // allows 2 strings as .s and .t
for scase("add","dec","inc","skp","jmp","cla","lda","hlt") comms[i1].s=temp_string_
for scase("ADD","DEC","INC","SKP","JMP","CLA","LDA","HLT") comms[i1].t=temp_string_

//** user documentation
objref docs[8],instsetl // long and brief documentation for commands
instsetl = new List()   // list of documentation for display
for ii=0,7 docs[ii]=new String2() // allows 2 strings as .s and .t
for scase("Add contents of address to ACC ",\
          "Decrement address contents by 1",\
          "Increment address contents by 1",\
          "Skip next instruction if addr==0",\
          "Jump to specified address      ",\
          "Clear the accumulator          ",\
          "Load ACC to specified address  ",\
          "Halt the Program               ") docs[i1].s=temp_string_
for scase ("add [addr]", "dec [addr]", "inc [addr]", "skp [addr]", "jmp [addr]",\
"cla 0", "lda [addr]", "hlt 0") docs[i1].t=temp_string_
// put together different doc strings in a single table
temp_string2_="%-5s %-03d %-35s %-8s" // same size fields
for ii=0,7 {
    sprint(temp_string_,temp_string2_,comms[ii].t,ii,docs[ii].s,docs[ii].t)
    instsetl.append(new String(temp_string_))
  }

//** stxshow() main panel
proc stxshow () { 
    box=new VBox() box.intercept(1)
    qhp(1)
    xpanel("Quasi-PDP8 Emulator")
    xvarlabel(mesg)
    xcheckbox("Stop processing",&stopf)
    xvarlabel(acc)
    xvarlabel(pc)
    xbutton("Run","emu()")
    xbutton("Single step","sstep()")
    xvalue("Change address","pkaddr",0,"peek()")
    xvalue("To value","pkval",0,"poke()")
    xmenu("Registers")
    xbutton("Clear REGS","clrregs()")
    xbutton("Increment PC","{PC+=1 updateregs()}")
    xbutton("Clear PC","{PC=0 updateregs()}")
    xbutton("Clear ACC","{ACC=0 updateregs()}")
    xbutton("Clear MEM","{for ii=0,NSTEPS-1 {OP[ii]=0 ADDR[ii]=0} updateregs()}")
    xmenu()
    xmenu("Load program")
    xbutton("Reload program","parsp8f(lstprog)")
    xbutton("Write prog to file","wrtp8()")
    xbutton("Read file","readp8()")
    xmenu()
    xmenu("Show")
    xbutton("Instructions","xvarstr(\"Emulator Instruction Set\",instsetl)")
    xbutton("Assembler code","showprog(1)")
    xbutton("Assembler + machine (octal)","showprog(5)")
    xbutton("Machine code (octal)","showprog(2)")
    xbutton("Machine code (binary)","showprog(3)")
    xbutton("Machine code (decimal)","showprog(4)")
    xbutton("New core panel","xvarstr(\"Core memory\",prog)")
    xbutton("Clear error message","mesg=\"\"")
    xmenu()
    xpanel()
    box.intercept(0) box.map("Quasi-PDP8 Emulator")
    clrregs()
  }

proc reset () { parsp8f(lstprog) }

//* Utility programs
//** clrregs -- clear registers
proc clrregs () {
    PC=0 ACC=0 mesg="" stopf=0
    updateregs()
  }

//** peek(): peek (look) at memory address
proc peek () { local addr
    addr=o2d(pkaddr)
    if (addr==-1e10) pkaddr=-1
    pkval=d2o(loc2num(addr))
    printf("%2d: %4d\n",pkaddr,pkval) // both already octalized
  }

//** poke(): poke (change) memory address
proc poke () { local num,ii,addr
    if ((num=o2d(pkval))==-1e10) { pkval=-1 return }
    pkval=d2o(num)  // fix up octal appearence in xvalue
    addr=o2d(pkaddr) // where to put it
    if (addr>=NSTEPS) { 
        sprint(mesg,"Address out of bounds: %d",pkaddr) err() return }
    num2loc(num,addr)
    printf("%2d: %4d\n",pkaddr,pkval) // both already octalized
    showprog(0)
  }

//** updateregs(): handle reg overflow and update xvarlabels
proc updateregs () {
    ACC=ACC%4096 PC=PC%4096
    sprint(acc,"ACC: %04o",ACC)
    sprint(pc," PC: %04o",PC)
    showprog(0)
  }

//** showprog(): update core mem display
showmode=1
proc showprog () { local ii,flag
    if ($1>0) showmode=$1 // else keep it
    if (showmode==1) {  // assembler command format
        for ltr(XO,prog) sprint(XO.s,"%02o :: %s %03o",i1,comms[OP[i1]].t,ADDR[i1])
      }
    if (showmode==2) {  // machine code octal format
        for ltr(XO,prog) sprint(XO.s,"%02o :: %1o%03o",i1,OP[i1],ADDR[i1])
      } 
    if (showmode==3) {  // machine code binary format
        for ltr(XO,prog) sprint(XO.s,"%06d :: %012.0f",d2b(i1),d2b(512*OP[i1]+ADDR[i1]))
      } 
    if (showmode==4) {  // machine code binary format
        for ltr(XO,prog) sprint(XO.s,"%02d :: %d",i1,512*OP[i1]+ADDR[i1])
      } 
    if (showmode==5) {  // assembler + octal machine code
        for ltr(XO,prog) sprint(XO.s,"%02o :: %s %03o == %1o%03o",i1,comms[OP[i1]].t,ADDR[i1],OP[i1],ADDR[i1])
      } 
    if (PC<NSTEPS) sprint(prog.object(PC).s,"%s<",prog.object(PC).s)
    doNotify()
  }

//** o2d(): convert octal to decimal using sscanf
func o2d () { local num
    num=$1
    sprint(temp_string_,"%d",int(num))
    // throw away &y; need to pick up a trailing 8 or 9
    if (sscanf(temp_string_,"%o%d",&x,&y)!=1) {
        sprint(mesg,"ERROR: %s not octal.",temp_string_) err() return -1e10 }
    // only use 4 octal digits, max 4095 decimal
    if (x>4095) { mesg="Overflow: number truncated" x=x%4096 err() }
    return x
  }

//** d2o(): convert decimal to octal using sscanf
func d2o () { local num
    num=$1
    sprint(temp_string_,"%o",num) // read as an octal num
    sscanf(temp_string_,"%d",&x)  // convert to a decimal
    return x
  }

//** d2b(): decimal to binary, gives a binary appearing number for showing
// eg for ii=0,100 printf("%010d\n",d2b(ii))
func d2b () { local num,ii,rem,res
    num=$1 ii=0 res=0
    while (num>0) {
        rem = int(2*(num/2-int(num/2))) // right digit
        num=int(num/2) // remove right digit
        res+=rem*10^ii
        ii+=1
      }
    return res
  }

//** loc2num(): look in memory location and extract value in decimal
// OP contains 0-7 which is the 4th octal place (hence *512)
// ADDR contains a decimal number to directly address the array
func loc2num () { local addr
    addr=$1
    if (addr>=NSTEPS) { sprint(mesg,"Illegal memory access: %o",addr) 
        err() stopf=1 PC-=1 return 0  }
    return OP[addr]*512+ADDR[addr]
  }

//** num2loc(): parse decimal value to pull out octal and decimal fields
// OP field is in octal 
// ADDR field needs to be decimal (pos2-4)
proc num2loc () { local num,ii
    num=$1 ii=$2
    num=num%4096  // take care of overflow here
    OP[ii] = int(num/512)  
    ADDR[ii] = num-OP[ii]*512
  }

//* I/O
//** readp8() -- calls chooser to read
proc readp8 () { local ii,num,cnt
    if (fchooser_flag == 0) {  // create panel first time only
        tmpfile.chooser("r","Read program","*.p8","READ","","")
      }
    fchooser_flag = 1
    if (tmpfile.chooser()==1) {
        for ii=0,NSTEPS-1 { OP[ii]=3 ADDR[ii]=0 } // clear
        tmpfile.getname(filename)
        parsp8f(filename)
      }
  }

//** wrtp8() -- calls chooser to write
// writes out program in assembler, any comments read-in were lost
proc wrtp8 () { 
    tmpfile.chooser("w","Write to file","*.p8","WRITE","","")
    fchooser_flag = 0
    if (tmpfile.chooser()==1) {
        tmpfile.getname(lstprog)
        showprog(1)             // write out in assembler
        chop(prog.object(PC).s) // remove <
        for ltr(XO,prog) tmpfile.printf("%s\n",XO.s)
      }
    tmpfile.close
  }

//** parsp8f() -- reads in file, does lots of error checking
// file format:
// 2-4 white-space separated columns
//   1st column: address
//   2nd column: a) Assembler command (3 letters, upper or lower case)
//               b) Machine command (4 octal digits, 0-7)
//   3rd column: a) address for assembler command (1-3 digits octal)
//               b) comment if machine command (ignored)
//   4th column: a) comment if assembler command (ignored)
double loc1[1],adr1[1]
proc parsp8f () { local ii,num,cnt
    lstprog=$s1
    if (strcmp(lstprog,"")==0) {sprint(mesg,"Need to load something first.") err() return}
    for ii=0,NSTEPS-1 { OP[ii]=0 ADDR[ii]=0 } // clear the program
    if (! tmpfile.ropen(lstprog)) { 
        if (strcmp(loadstr,"")!=0) { execute(loadstr) return 
          } else { sprint(mesg,"Unable to open %s.",lstprog) err() return }
      }
    cnt=0
    while (tmpfile.gets(pstr1)>0) {
        chop(pstr1)
        if (strcmp(pstr1,"")==0) continue
        if (sfunc.substr(pstr1,"//")==0) continue
        cnt+=1 sprint(errline,"#%d:\"%s\" -- ",cnt,pstr1)
        if (sscanf(pstr1,"%d %s %d",&loc1,pstr2,&adr1)==3 ||\
            sscanf(pstr1,"%d :: %s %d",&loc1,pstr2,&adr1)==3) {
            if ((ii=o2d(loc1))==-1e10) {sprint(mesg,"%s%s",errline,mesg) err() return}
            if (ii>NSTEPS-1) { 
                sprint(mesg,"%sERROR: only %d memory available.",errline,NSTEPS) err() return }
            if ((OP[ii]=whatcomm(pstr2))==-1) {
                sprint(mesg,"%sERROR: %s not recognized.",errline,pstr2) err() return }
            if ((ADDR[ii]=o2d(adr1))==-1e10) {sprint(mesg,"%s%s",errline,mesg) err() return}
          } else if (sscanf(pstr1,"%d %d",&loc1,&adr1)==2) {
            if ((ii=o2d(loc1))==-1e10) {sprint(mesg,"%s%s",errline,mesg) err() return}
            if (ii>NSTEPS-1) {
                sprint(mesg,"%sERROR: only %d memory.",errline,NSTEPS) err() return}
            OP[ii] = int(adr1/1000) // faux octal
            if (OP[ii]>7) { sprint(mesg,"%sNon-octal",errline,cnt) err() return }
            if((ADDR[ii]=o2d(1000*(adr1/1000-int(adr1/1000))))==-1e10) {
                sprint(mesg,"%s%s",errline,mesg) err() return}
          } else if (sscanf(pstr1,"%d",&adr1)==1) {
            ii=cnt-1
            if (ii>NSTEPS-1) {
                sprint(mesg,"%sERROR: only %d memory.",errline,NSTEPS) err() return}
            OP[ii] = int(adr1/1000) // faux octal
            if (OP[ii]>7) { sprint(mesg,"%sNon-octal",errline,cnt) err() return }
            if((ADDR[ii]=o2d(1000*(adr1/1000-int(adr1/1000))))==-1e10) {
                sprint(mesg,"%s%s",errline,mesg) err() return}
          } else { 
            sprint(mesg,"ERROR: \"%s\"?? unrecognized",pstr1) err() return
          }
      }
    mesg=""
    clrregs() updateregs()
  }

//** loadp8() dumpp8() abbreviated numerical versions of program
proc loadp8 () { local i
    i1 = 0
    if (numarg()%2==1) {print "ERROR: loadp8 needs even number of args" return }
    for ii=0,NSTEPS-1 { OP[ii]=0 ADDR[ii]=0 } // clear the program
    for i = 1, numarg() { OP[i1]=$i i+=1 ADDR[i1]=$i i1+=1 }
    clrregs() updateregs()
  }

// dumpp8() print out string for loadp8()
proc dumpp8 () { local ii
    sprint(temp_string_,"loadp8( ")
    for ii=0,NSTEPS-1 {
        sprint(temp_string_,"%s%d,%d,",temp_string_,OP[ii],ADDR[ii]) }
    chop(temp_string_)
    sprint(temp_string_,"%s)",temp_string_)
    print temp_string_
  }

//** whatcomm(): searches through commands to identify 3 letter string
func whatcomm () { local ii
    for ii=0,7 {
        if (strcmp(comms[ii].s,$s1)==0 || strcmp(comms[ii].t,$s1)==0) return ii
      }
    return -1
  }

//* emu(): the emulator main loop
proc emu () {
    stopf=0 mesg="" // reset
    while (stopf==0) sstep()
  }

//** sstep(): line-by-line interpreter
// 1) pick up command (0-7) from OP[PC] and address from ADDR[PC]
// 2) increment PC [program counter] to step through
// 3) addresses are in decimal so can be used directly to access arrays
// 4) words being used as data must be reconstructed as numbers by 
//    combining OP/ADDR fields: this is done by loc2num()
// 5) similarly num2loc() will take a number and parse out octal OP/ADDR
proc sstep () { local op,addr,num
    if (stopf==1) return
    if (PC>=NSTEPS) { stopf=1
        sprint(mesg,"ERROR: Segmentation fault PC==%o.",PC) err() return}
    op=OP[PC] addr=ADDR[PC] PC+=1
    if (op==0) { // ADD: ACC+=@addr
        ACC += loc2num(addr)  
      } else if (op==1) { // DEC: @addr--
        num=loc2num(addr)
        num2loc(num-1,addr)
      } else if (op==2) { // INC: @addr++
        num=loc2num(addr)
        num2loc(num+1,addr)
      } else if (op==3) { // SKP: PC++ if @addr==0
        if (loc2num(addr)==0) PC+=1
      } else if (op==4) { // JMP: PC=addr
        PC=addr
      } else if (op==5) { // CLA: ACC=0
        ACC=0
      } else if (op==6) { // LDA: @addr=ACC
        num2loc(ACC,addr)
      } else if (op==7) { // HLT: stop
        stopf=1 PC-=1
      }
    updateregs()  // update registers and core
  }

//* startup
stxshow()  // put up panel
xvarstr("Program",prog)
// END pdp8.hoc
//================================================================
lstprog="prog5.p8"
loadstr="loadp8(0,11,0,18,0,15,5,0,0,2,1,4,4,4)"
parsp8f(lstprog)
mesg = "Prog. #5: add numbers in a list -- kludge"
// END COM_kludge.hoc
//================================================================