Source file: SKIMPC.IMP              Compiled on 25-OCT-1979 at 09:51:22

               Computer Science IMP77 Compiler.  Version 6.01

         1  %externalintegerarrayspec a(1:500)
         2  %externalintegerspec condopt
         3  !-----------------------------------------------------------------------
         4  %externalroutinespec expr(%integer exprp)
         5  %externalroutinespec dump(%string(7) opn,reg,base,%integer disp)
         6  %externalroutinespec filllabel(%integer label)
         7  %externalintegerfnspec fillbranch(%integer label)
         8  %externalintegerfnspec nextplabel
         9  %externalroutinespec fault(%string(63) mess)
        10  !-----------------------------------------------------------------------
        11  %externalinteger condflag=0
        12  !-----------------------------------------------------------------------
        13  %externalintegerfn cond(%integer condp,tlabel,flabel)
        14  %routinespec processcond(%integer condp)
        15  %routinespec test(%integer ltestp)
        16  %routinespec condrest(%integer condrestp)
        17  %routinespec store(%integer testp,level,andor)
        18  %routinespec show(%string(7) an,%integerarrayname a,%integer p)
        19  %conststring(3)%array true(1:6)="BZ","BNZ","BNG","BL","BNL","BG"
        20  %conststring(3)%array false(1:6)="BNZ","BZ","BG","BNL","BL","BNG"
        21  %string(3) opn
        22  %constintegerarray index(1:17)=1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17
        23  %integerarray testpa,levela,andora,brancha(1:16),labela(1:17)
        24  %integer p,pp,ppp,testp,level,andor,comp
        25    level=0
        26    p=1
        27    processcond(condp)
        28    store(testp,-1,1)    ;! pseudo-%and
        29    store(0,-2,2)        ;! pseudo-%or
        30    p=p-2
        31    %for pp=1,1,p %cycle    ;! find branch destinations
        32      level=levela(pp)
        33      andor=andora(pp)
        34      %for ppp=pp+1,1,p+1 %cycle
        35        %if levela(ppp)<level %then %start
        36          level=levela(ppp)
        37          %if andora(ppp)#andor %then %exit
        38        %finish
        39      %repeat
        40      brancha(pp)=ppp+1
        41    %repeat
        42    %if tlabel>=0 %then %start
        43      andora(p)=2    ;! change last branch to branch on true
        44      brancha(p)=p+1
        45      labela(p+1)=tlabel
        46    %finish
        47    labela(p+2)=flabel
        48    %for pp=1,1,p %cycle    ;! assign private labels where needed
        49      %if labela(brancha(pp))<0 %then labela(brancha(pp))=nextplabel
        50    %repeat
        51    %if condopt=1 %then %start
        52      newline
        53      show("      ",index,p+2)
        54      show("TESTP ",testpa,p)
        55      show("LEVEL ",levela,p+1)
        56      show("ANDOR ",andora,p+1)
        57      show("BRANCH",brancha,p)
        58      show("LABEL ",labela,p+2)
        59      newline
        60    %finish
        61    %for pp=1,1,p %cycle    ;! generate test code and fill labels
        62      %if labela(pp)>=0 %then filllabel(labela(pp))
        63      condflag=1
        64      expr(testpa(pp))
        65      comp=a(a(testpa(pp)+2))
        66      %if andora(pp)=1 %then opn=false(comp) %else opn=true(comp)
        67      dump(opn,"ACC","",fillbranch(labela(brancha(pp))))
        68    %repeat
        69    %if labela(p+1)>=0 %and tlabel<0 %then filllabel(labela(p+1))
        70    %if flabel>=0 %then %result=-1 %else %result=labela(p+2)
        71  !-----------------------------------------------------------------------
        72  %routine processcond(%integer condp)
        73    test(a(condp+1))
        74    condrest(a(condp+2))
        75  %end
        76  !-----------------------------------------------------------------------
        77  %routine test(%integer ltestp)
        78    %if a(ltestp)=1 %then testp=ltestp %else level=level+1 %and %c
        79+     processcond(a(ltestp+1)) %and level=level-1
        80  %end
        81  !-----------------------------------------------------------------------
        82  %routine condrest(%integer condrestp)
        83  %integer andor
        84    andor=a(condrestp)
        85    %unless andor=3 %then %start
        86      store(testp,level,andor) %and test(a(condrestp+1)) %and %c
        87+        condrestp=a(condrestp+2) %until a(condrestp)=2
        88    %finish
        89  %end
        90  !-----------------------------------------------------------------------
        91  %routine store(%integer testp,level,andor)
        92    %if p>16 %then fault("CONDITION TOO LONG") %and %stop
        93    testpa(p)=testp
        94    levela(p)=level
        95    andora(p)=andor
        96    labela(p)=-1
        97    p=p+1
        98  %end
        99  !-----------------------------------------------------------------------
       100  %routine show(%string(7) an,%integerarrayname a,%integer p)
       101  %integer pp
       102    print string(an."  ")
       103    %for pp=1,1,p %cycle
       104      write(a(pp),5)
       105    %repeat
       106    newline
       107  %end
       108  %end
       109  %endoffile
      Code 2492 bytes  Glap 432 bytes  Diags 613 bytes   Total size 3537 bytes
          99 statements compiled