         Source file: SKIMPAI.IMP              Compiled on 30-OCT-1979 at 10:38:02

               Computer Science IMP77 Compiler.  Version 6.01

         1  %externalroutine skimpai(%string(63) file)
         2  %string(15)%fnspec readmn(%integername sep)
         3  %routinespec dump(%integer on,rn,bn,dn)
         4  %integerfnspec intstr(%string(15) s)
         5  %string(15)%fnspec strint(%integer n)
         6  %routinespec fault(%string(255) mess)
         7  %routinespec fail(%string(255) mess)
         8  %routinespec monitor
         9  %conststring(7)%array imn(0:32)="STOP","LOAD","LDA","ADD","SUB","MLT",
        10+   "DIV","EXP","STR","NEG","NOT","SHL","SHR","AND","OR","XOR","BAL","B",
        11+   "BZ","BNZ","BG","BNG","BL","BNL","ADDF","SUBF","MLTF","DIVF","EXPF",
        12+   "NEGF","FLT","FILL","CONST"
        13  %string(15)%array rmn(0:15)
        14  %integerarray r(0:15)
        15  %integerarray s(0:4095)
        16  %string(15) opn,reg,base,disp
        17  %constinteger sl=4095
        18  %constinteger datamask=2_0011111000000001111100011111010
        19  %integer rp,sp,mon,tron,troff,on,rn,bn,dn,sep,i,faults,inst,trace,pc, %c
        20+   pcl,tracepc,tracen,efad,stackb,stpr,accr,cyc,ic
        21  %switch ins(0:31)
        22  %switch ext(1:11)
        23    %if file->("/TR").file %then trace=1 %and tracen=0 %else %start
        24      %if file="" %then print string("file ?
        25+ ") %and %stop
        26      trace=0
        27    %finish
        28    open input(2,file.".lis")
        29    select input(2)
        30    select output(1)
        31    rmn(0)=""
        32    r(0)=0
        33    rp=1
        34    sp=0
        35    mon=0
        36    tron=0
        37    troff=0
        38    faults=0
        39  instr:! process next instruction
        40    read symbol(i) %until i='$'
        41    %cycle
        42      i=next symbol
        43      %if i=' ' %then skip symbol %else %exit
        44    %repeat
        45    %if '0'<=i<='9' %then %start    ;! "FAULTS IN PROGRAM"
        46      %if i>'0' %then fault("PROGRAM WAS FAULTY") %and %stop
        47      %if faults>0 %then fault("ASSEMBLY FAULTY") %and %stop
        48      read symbol(i) %until i=nl
        49      ->interpret
        50    %finish
        51    opn=readmn(sep)
        52    %for on=0,1,32 %cycle
        53      %if opn=imn(on) %then ->gotopn
        54    %repeat
        55    %if opn="MONITOR" %then mon=1 %and ->instr
        56    %if opn="TRON" %then tron=1 %and ->instr
        57    %if opn="TROFF" %then troff=1 %and ->instr
        58    fault("INVALID OPERATION : ".opn.tostring(sep))
        59    ->instr
        60  gotopn:! get operands
        61    %if sep#',' %then fault("INVALID FORMAT : ".opn.tostring(sep)) %c
        62+     %and ->instr
        63    reg=readmn(sep)
        64    %if sep#',' %then fault("INVALID FORMAT : ".opn.",".reg. %c
        65+     tostring(sep)) %and ->instr
        66    base=readmn(sep)
        67    %if sep#',' %then fault("INVALID FORMAT : ".opn.",".reg. %c
        68+     ",".base.tostring(sep)) %and ->instr
        69    disp=readmn(sep)
        70    %if opn="FILL" %then %start
        71      bn=intstr(base)
        72      %if bn<0 %then fault("INVALID FILL : ".reg.",".base) %and ->instr
        73      dn=intstr(disp)
        74      %unless 0<=dn<=16_FFFF %then fault("INVALID FILL : ".reg. %c
        75+       ",".base.",".disp) %and ->instr
        76      cyc=0
        77      %cycle
        78        cyc=cyc+1
        79        %if bn>=sp %or cyc>sp %then fault("INVALID FILL LIST AT ". %c
        80+         strint(sp)) %and ->instr
        81        i=bn
        82        bn=s(bn)&16_FFFF
        83        s(i)=s(i)&16_FFFF0000!dn
        84      %repeat %until bn=0
        85      %if reg="COT" %then pcl=dn-1    ;! program counter limit
        86      ->instr
        87    %finish
        88    %if opn="CONST" %then %start
        89      dn=intstr(disp)
        90      %if dn<0 %then fault("INVALID CONSTANT : ".disp) %and ->instr
        91      dump(0,0,0,dn)
        92      ->instr
        93    %finish
        94      %if reg="" %and opn#"B" %and opn#"STOP" %then %c
        95+       fault("REGISTER MISSING AT ".strint(sp)) %and rn=0 %and ->gotreg
        96    %for rn=0,1,rp-1 %cycle
        97      %if reg=rmn(rn) %then ->gotreg
        98    %repeat
        99    %if rp=16 %then fault("EXCESS REGISTER : ".reg) %and rn=0 %c
       100+      %else rmn(rp)=reg %and rn=rp %and rp=rp+1
       101  gotreg:%if base="EXT" %and opn="BAL" %then on=31 %and bn=0 %and->gotbase
       102  %for bn=0,1,rp-1 %cycle
       103      %if base=rmn(bn) %then ->gotbase
       104    %repeat
       105    %if rp=16 %then fault("EXCESS REGISTER : ".base) %and bn=0 %c
       106+     %else rmn(rp)=base %and bn=rp %and rp=rp+1
       107  gotbase:dn=intstr(disp)
       108    %unless 0<=dn<=16_FFFF %then fault("INVALID DISPLACEMENT : ". %c
       109+     disp) %and dn=0
       110    dump(on,rn,bn,dn)
       111    ->instr
       112  !-----------------------------------------------------------------------
       113  interpret:! interpretation section
       114    trace=0
       115    stpr=0
       116    accr=0
       117    %for i=0,1,rp-1 %cycle
       118      %if rmn(i)="STP" %then stpr=i
       119      %if rmn(i)="ACC" %then accr=i
       120      r(i)=0
       121    %repeat
       122    stackb=sp
       123    %while sp<=sl %then s(sp)=16_80000000 %and sp=sp+1
       124    ic=0
       125    pc=0
       126  exi:! execute instruction
       127    %if ic>10000 %then fail("10000 INSTRUCTIONS EXECUTED")
       128    %unless 0<=pc<=pcl %then fail("PC OUT OF BOUNDS")
       129    inst=s(pc)
       130    tracepc=pc
       131    pc=pc+1
       132    %if inst&16_80000000#0 %then monitor
       133    %if inst&16_40000000#0 %then trace=1
       134    %if inst&16_20000000#0 %then trace=0
       135    on=inst>>24&16_1F
       136    rn=inst>>20&16_F
       137    bn=inst>>16&16_F
       138    dn=inst&16_FFFF
       139    efad=r(bn)+dn
       140    %if 1<<on&datamask#0 %then %start
       141      %unless pcl<efad<=sl %then fail("DATA ADDRESS ". %c
       142+       strint(efad)." OUT OF BOUNDS")
       143      %if s(efad)=16_80000000 %then fail("UNASSIGNED VARIABLE AT ". %c
       144+       strint(efad))
       145    %finish %else %start
       146      %if on=8 %then %start
       147        %unless stackb<=efad<=sl %then fail("STR ADDRESS ". %c
       148+         strint(efad)." OUT OF BOUNDS")
       149      %finish
       150    %finish
       151    ->ins(on)
       152  ins(0):print string("
       153+ STOPPED AT ".strint(tracepc).", ".strint(ic)." INSTRUCTIONS EXECUTED
       154+ ") %and %stop
       155  ins(1):r(rn)=s(efad) ; ->tracep
       156  ins(2):%if rn=stpr %and efad<r(stpr) %then %start
       157      ! clear old area back to unassigned
       158      %for i=efad+2,1,r(stpr)+2 %cycle
       159        s(i)=16_80000000 %unless i>sl
       160      %repeat
       161    %finish
       162    r(rn)=efad
       163    ->tracep
       164  ins(3):r(rn)=r(rn)+s(efad) ; ->tracep
       165  ins(4):r(rn)=r(rn)-s(efad) ; ->tracep
       166  ins(5):r(rn)=r(rn)*s(efad) ; ->tracep
       167  ins(6):r(rn)=r(rn)//s(efad) ; ->tracep
       168  ins(7):r(rn)=r(rn)\\s(efad) ; ->tracep
       169  ins(8):s(efad)=r(rn) ; ->tracep
       170  ins(9):r(rn)=-r(rn) ; ->tracep
       171  ins(10):r(rn)=\r(rn) ; ->tracep
       172  ins(11):r(rn)=r(rn)<<s(efad) ; ->tracep
       173  ins(12):r(rn)=r(rn)>>s(efad) ; ->tracep
       174  ins(13):r(rn)=r(rn)&s(efad) ; ->tracep
       175  ins(14):r(rn)=r(rn)!s(efad) ; ->tracep
       176  ins(15):r(rn)=r(rn)!!s(efad) ; ->tracep
       177  ins(16):r(rn)=pc ; pc=efad ; ->tracep
       178  ins(17):pc=efad ; ->tracep
       179  ins(18):%if r(rn)=0 %then pc=efad ; ->tracep
       180  ins(19):%if r(rn)#0 %then pc=efad ; ->tracep
       181  ins(20):%if r(rn)>0 %then pc=efad ; ->tracep
       182  ins(21):%if r(rn)<=0 %then pc=efad ; ->tracep
       183  ins(22):%if r(rn)<0 %then pc=efad ; ->tracep
       184  ins(23):%if r(rn)>=0 %then pc=efad ; ->tracep
       185  ins(24):real(addr(r(rn)))=real(addr(r(rn)))+real(addr(s(efad)))
       186    ->tracep
       187  ins(25):real(addr(r(rn)))=real(addr(r(rn)))-real(addr(s(efad)))
       188    ->tracep
       189  ins(26):real(addr(r(rn)))=real(addr(r(rn)))*real(addr(s(efad)))
       190    ->tracep
       191  ins(27):real(addr(r(rn)))=real(addr(r(rn)))/real(addr(s(efad)))
       192    ->tracep
       193  ins(28):real(addr(r(rn)))=real(addr(r(rn)))\s(efad)
       194    ->tracep
       195  ins(29):real(addr(r(rn)))=-real(addr(r(rn))) ; ->tracep
       196  ins(30):real(addr(r(rn)))=r(rn) ; ->tracep
       197  ins(31):%if stpr=0 %then fail("REGISTER STP NOT DEFINED FOR I/O". %c
       198+     " ROUTINE CALL")
       199    ->ext(dn)
       200  ext(1):read symbol(s(s(r(stpr)+2))) ; ->tracep
       201  ext(2):%if accr=0 %then fail("REGISTER ACC NOT DEFINED FOR ". %c
       202+     "'NEXT SYMBOL' I/O FUNCTION CALL")
       203    r(accr)=next symbol
       204    ->tracep
       205  ext(3):skip symbol ; ->tracep
       206  ext(4):print symbol(s(r(stpr)+2)) ; ->tracep
       207  ext(5):space ; ->tracep
       208  ext(6):spaces(s(r(stpr)+2)) ; ->tracep
       209  ext(7):newline ; ->tracep
       210  ext(8):newlines(s(r(stpr)+2)) ; ->tracep
       211  ext(9):newpage
       212  ext(10):read(s(s(r(stpr)+2))) ; ->tracep
       213  ext(11):write(s(r(stpr)+2),s(r(stpr)+3))
       214  tracep:ic=ic+1
       215    %if trace#0 %then %start
       216      write(tracepc,4)
       217      print symbol('$')
       218      tracen=tracen+1
       219      %if tracen=10 %then newline %and tracen=0
       220    %finish
       221  ->exi
       222  !-----------------------------------------------------------------------
       223  %string(15)%fn readmn(%integername sep)
       224  %string(255) s
       225  %integer flag
       226    s=""
       227    flag=0
       228    %cycle
       229      read symbol(sep)
       230      %if '0'<=sep<='9' %or 'A'<=sep<='Z' %then %start
       231        %if length(s)<255 %then s=s.tostring(sep) %else flag=1
       232      %finish %else %start
       233        %if sep#' ' %then %exit
       234      %finish
       235    %repeat
       236    %if length(s)>15 %or flag#0 %then fault("INVALID MNEMONIC : ".s) %c
       237+      %and %result="" %else %result=s
       238  %end
       239  !-----------------------------------------------------------------------
       240  %routine dump(%integer on,rn,bn,dn)
       241    %if sp>sl %then fault("PROGRAM TOO BIG") %and %stop
       242    s(sp)=mon<<31!tron<<30!troff<<29!on<<24!rn<<20!bn<<16!dn
       243    sp=sp+1
       244    mon=0
       245    tron=0
       246    troff=0
       247  %end
       248  !-----------------------------------------------------------------------
       249  %integerfn intstr(%string(15) s)
       250  %integer value,d,i
       251    value=0
       252    %for i=1,1,length(s) %cycle
       253      d=charno(s,i)
       254      %unless '0'<=d<='9' %then %result=-1
       255      value=value*10+d-'0'
       256    %repeat
       257    %result=value
       258  %end
       259  !-----------------------------------------------------------------------
       260  %string(15)%fn strint(%integer n)
       261  %string(15) r
       262  %string(1) s
       263    r=""
       264    %if n<0 %then n=-n %and s="-" %else s=""
       265    r=tostring(n-n//10*10+'0').r %and n=n//10 %until n=0
       266    %result=s.r
       267  %end
       268  !-----------------------------------------------------------------------
       269  %routine fault(%string(255) mess)
       270    print string("
       271+ ".strint(sp)."$   ".mess."
       272+ ")
       273    faults=faults+1
       274  %end
       275  !-----------------------------------------------------------------------
       276  %routine fail(%string(255) mess)
       277    print string("
       278+ *  ".mess."
       279+ PC=".strint(tracepc)."$")
       280    monitor
       281    %stop
       282  %end
       283  !-----------------------------------------------------------------------
       284  %routine monitor
       285  %string(15) v
       286  %integer i,j
       287    newline
       288    %if rp>1 %then %start
       289      %for i=1,1,rp-1 %cycle
       290        print string(rmn(i)."  ".strint(r(i))."
       291+ ")
       292      %repeat
       293    %finish
       294    %if stpr#0 %and r(stpr)>stackb %then %start
       295      write(stackb,2)
       296      print symbol('$')
       297      j=1
       298      %for i=stackb,1,r(stpr)+17 %cycle
       299        %if s(i)=16_80000000 %then print string("   ?") %c
       300+         %else write(s(i),3)
       301        j=j+1
       302        %if j=16 %then newline %and j=0
       303      %repeat
       304      newline
       305    %finish
       306  %end
      ?V unused
       307  %endofprogram
      Code 9580 bytes  Glap 1456 bytes  Diags 1428 bytes   Total size 12464 bytes
         299 statements compiled

