         Source file: SKIMPA.IMP              Compiled on 25-OCT-1979 at 09:38:57

               Computer Science IMP77 Compiler.  Version 6.01

         1  %externalintegerarray a(1:500)
         2  ! initialisation for i/o routines
         3  %externalbyteintegerarray named(1:1024)=10,'R','E','A','D','S','Y','M',
         4+   'B','O','L',10,'N','E','X','T','S','Y','M','B','O','L',10,'S','K',
         5+   'I','P','S','Y','M','B','O','L',11,'P','R','I','N','T','S','Y','M',
         6+   'B','O','L',5,'S','P','A','C','E',6,'S','P','A','C','E','S',7,'N',
         7+   'E','W','L','I','N','E',8,'N','E','W','L','I','N','E','S',7,'N','E',
         8+   'W','P','A','G','E',4,'R','E','A','D',5,'W','R','I','T','E',0(930)
         9  %externalintegerarray namedlink(0:255)=0,76,0(12),89,0(54),84,0(118),
        10+   52,0(11),1,12,23,34,0(4),67,0(23),46,0(5),59,0(17)
        11  %externalintegerarray taglink(0:255)=0,13,0(12),16,0(54),14,0(118),8,
        12+   0(11),1,3,4,5,0(4),11,0(23),7,0(5),10,0(17)
        13  %externalintegerarray tag(1:512)=16_40100001,16_01010002,16_41000002,
        14+   16_40000003,16_40100004,16_01010002,16_40000005,16_40100006,
        15+   16_01010002,16_40000007,16_40100008,16_01010002,16_40000009,
        16+   16_4010000A,16_11010002,16_4020000B,16_01010002,16_01010003,0(494)
        17  %externalintegerarray link(1:512)=2,0,0,0,6,0,0,9,0,0,12,0,0,
        18+   15,0,17,18,0,0(494)
        19  %externalinteger namedp=95
        20  %externalinteger tagasl=19
        21  %externalinteger expropt=0
        22  %externalinteger condopt=0
        23  %externalinteger tagsopt=0
        24  !-----------------------------------------------------------------------
        25  %externalroutinespec statement(%integer statementp)
        26  %externalstring(255)%fnspec strint(%integer n,p)
        27  %externalroutinespec fault(%string(63) mess)
        28  %externalroutinespec dump(%string(7) opn,reg,base,%integer disp)
        29  %externalstring(255)%fnspec name(%integer ident)
        30  !-----------------------------------------------------------------------
        31  %externalroutine skimp(%string(63) s)
        32  %routinespec readps
        33  %routinespec read statement
        34  %routinespec rpsym(%integername l)
        35  %integerfnspec findk(%string(*)%name k)
        36  %integerfnspec compare(%integer p)
        37  %recordformat kdf(%byteinteger l,n,a,b)
        38  %record(kdf)%array kd(1:255)
        39  %string(15)%array pn(256:319)
        40  %integerarray pp(256:319)
        41  %integerarray ps(1:512)
        42  %integerarray t,tt(1:256)
        43  %integer tp,ap,ttp,ttpp,i,j,psflag
        44  %string(63) file,object,options,option,as
        45  %owninteger lexopt=0
        46  %owninteger analopt=0
        47    %if s->("/").options %then %start
        48      %unless options->options.(" ").file %then file=""
        49      %cycle
        50        %unless options->option.("/").options %then %c
        51+         option=options %and options=""
        52        %if option->("NO").option %then i=0 %else i=1
        53        %if option="LEX" %then lexopt=i %else %c
        54+       %if option="ANAL" %then analopt=i %else %c
        55+       %if option="EXPR" %then expropt=i %else %c
        56+       %if option="COND" %then condopt=i %else %c
        57+       %if option="TAGS" %then tagsopt=i %else %c
        58+       print string(option." OPTION ?
        59+ ") %and %stop
        60      %repeat %until options=""
        61    %finish %else file=s
        62    readps
        63    %if file="" %then open output(1, ".TT") %else open output(1,file.".LIS")
        64    select output(1)
        65    print string("
        66+ 
        67+                    SKIMP COMPILER MKII
        68+ 
        69+ FILE: ".file."
        70+ OPTIONS: ")
        71    %if lexopt=1 %then print string("LEX ")
        72    %if analopt=1 %then print string("ANAL ")
        73    %if expropt=1 %then print string("EXPR ")
        74    %if condopt=1 %then print string("COND ")
        75    %if tagsopt=1 %then print string("TAGS ")
        76    newline
        77    %if psflag#0 %then fault("PHRASE STRUCTURE FAULTY") %and %stop
        78    %if file="" %then open input(1,".tt") %else open input(1,file.".IMP")
        79    select input(1)
        80    ! set up tags available space list
        81    %for i=tagasl,1,511 %cycle
        82      link(i)=i+1
        83    %repeat
        84    %cycle    ;! for each statement
        85      read statement
        86      ttp=tp-1
        87      tp=1
        88      ap=1
        89      %if compare(258)=0 %or tp#ttp %then fault("SYNTAX ?") %else %start
        90        %if analopt=1 %then %start
        91          newline
        92          j=0
        93          %for i=1,1,ap-1 %cycle    ;! print analysis record
        94            %if a(i)<0 %then as=("  (".strint(i,1)."/".pn(a(i)<<1>>17). %c
        95+             ")") %and %c
        96+             a(i)=a(i)&16_FFFF
        97            write(a(i),4)
        98            j=j+5
        99            %if j>60 %then newline %and j=0
       100          %repeat
       101          newlines(2)
       102        %finish %else %start
       103          %for i=1,1,ap-1 %cycle    ;! remove phrase numbers
       104            %if a(i)<0 %then a(i)=a(i)&16_FFFF
       105          %repeat
       106        %finish
       107        statement(1)    ;! generate code for statement
       108      %finish
       109    %repeat
       110  !-----------------------------------------------------------------------
       111  %routine readps
       112  ! read phrase structure from file 'SKIMPPS' and reduce it
       113  %string(31)%array ka(1:128)
       114  %integerarray kna(1:128)
       115  %string(31) k
       116  %integer kap,kdasl,kn,i,l,psp,pnp,alt
       117  %integername np
       118  %routinespec insert(%string(15) k)
       119  %routinespec extract(%integer i,%string(15) k)
       120  %routinespec assign(%integer i)
       121  %integerfnspec newkd
       122  %routinespec returnkd(%integer i)
       123  %routinespec returnlist(%integer i)
       124  %integerfnspec phrase
       125  %routinespec literal
       126  %routinespec keyword
       127    open input(2,"SKIMPPS.IMP")
       128    select input(2)
       129    open output(2,"SKIMPPSL.LIS")
       130    select output(2)
       131    print string("
       132+ 
       133+ PHRASE STRUCTURE
       134+ 
       135+ ")
       136    ! scan file to build keyword dictionary
       137    kap=1
       138    %cycle
       139      rpsym(l)
       140      %if l='$' %then %exit
       141      %if l='"' %then %start
       142        k=""
       143        %cycle
       144          rpsym(l)
       145          %if l='"' %then %exit
       146          %if 'A'<=l<='Z' %then k=k.tostring(l)
       147        %repeat
       148        ka(kap)=k
       149        kap=kap+1
       150      %finish
       151    %repeat
       152    %for i=1,1,26 %cycle
       153      kd(i)=0
       154    %repeat
       155    %for i=27,1,254 %cycle
       156      kd(i)_b=i+1
       157    %repeat
       158    kdasl=27
       159    i=1
       160    insert(ka(i)) %and i=i+1 %until i=kap
       161    kn=128
       162    %for i=1,1,26 %cycle
       163      %if kd(i)_l#0 %then assign(i)
       164    %repeat
       165    kap=1
       166    %for i=1,1,26 %cycle
       167      %if kd(i)_l#0 %then extract(i,"")
       168    %repeat
       169    print string("
       170+ 
       171+ KEYWORDS
       172+ 
       173+ ")
       174    %for i=1,1,kap-1 %cycle
       175      print string(strint(kna(i),3)."  ".ka(i)."
       176+ ")
       177    %repeat
       178    ! reread file and reduce phrase structure
       179    reset input
       180    pn(256)="NAME"
       181    pp(256)=0
       182    pn(257)="CONST"
       183    pp(257)=0
       184    pnp=258
       185    psp=1
       186    %cycle    ;! for each phrase definition
       187      read symbol(l)
       188      %if l='$' %then %exit
       189      %if l='<' %then %start    ;! start of phrase definition
       190        pp(phrase)=psp
       191        %cycle    ;! for each alternative
       192          alt=psp
       193          np==ps(psp+1)
       194          np=0    ;! number of phrases
       195          psp=psp+2
       196          %cycle    ;! for each item
       197            read symbol(l)
       198            %if l='<' %then ps(psp)=phrase %and psp=psp+1 %and np=np+1
       199            %if l='''' %then literal
       200            %if l='"' %then keyword
       201            %if l=',' %or l=';' %then %exit
       202          %repeat
       203          ps(alt)=psp
       204          %if l=';' %then %exit
       205        %repeat
       206        ps(psp)=0
       207        psp=psp+1
       208      %finish
       209    %repeat
       210    psflag=0
       211    %for i=258,1,pnp-1 %cycle
       212      %if pp(i)=0 %then fault("<".pn(i)."> NOT DEFINED") %and psflag=1
       213    %repeat
       214    print string("
       215+ 
       216+ PHRASES
       217+ 
       218+ ")
       219    %for i=256,1,pnp-1 %cycle
       220      print string(strint(i,3).strint(pp(i),6)."   ".pn(i)."
       221+ ")
       222    %repeat
       223    print string("
       224+ 
       225+ REDUCED PHRASE STRUCTURE
       226+ 
       227+ ")
       228    %for i=1,1,psp-1 %cycle
       229      %if (i-1)&15=0 %then print string("
       230+ ".strint(i,3)."   ")
       231     write(ps(i),3)
       232    %repeat
       233    newlines(2)
       234    %return
       235  !-----------------------------------------------------------------------
       236  %routine insert(%string(15) k)
       237  ! search for and insert keyword into dictionary
       238  %integer i,j,l
       239    l=charno(k,1)
       240    k->(tostring(l)).k
       241    i=l-'A'+1
       242    %if kd(i)_l#0 %then %start
       243  search:%if k="" %then %start
       244        %if kd(i)_a#0 %then extract(kd(i)_a,"") %and %c
       245+         returnlist(kd(i)_a) %and kd(i)_a=0
       246        %return
       247      %finish
       248      %if kd(i)_a=0 %then insert(k) %and %return
       249      l=charno(k,1)
       250      k->(tostring(l)).k
       251      i=kd(i)_a
       252      %cycle
       253        %if kd(i)_l=l %then ->search
       254        %if kd(i)_b=0 %then %exit
       255        i=kd(i)_b
       256      %repeat
       257      j=i
       258      i=newkd
       259      kd(j)_b=i
       260    %finish
       261    ! insert remainder of letters
       262    %cycle
       263      kd(i)_l=l
       264      %if k="" %then %return
       265      l=charno(k,1)
       266      k->(tostring(l)).k
       267      j=i
       268      i=newkd
       269      kd(j)_a=i
       270    %repeat
       271  %end
       272  !-----------------------------------------------------------------------
       273  %routine extract(%integer i,%string(15) k)
       274  %string(15) kk
       275    %if i=0 %then %return
       276    kk=k.tostring(kd(i)_l)
       277    %if kd(i)_a=0 %then ka(kap)=kk %and kna(kap)=kd(i)_n %and kap=kap+1%c
       278+     %else extract(kd(i)_a,kk)
       279    extract(kd(i)_b,k)
       280  %end
       281  !-----------------------------------------------------------------------
       282  %routine assign(%integer i)
       283    %if i=0 %then %return
       284    %if kd(i)_a=0 %then kd(i)_n=kn %and kn=kn+1 %else assign(kd(i)_a)
       285    assign(kd(i)_b)
       286  %end
       287  !-----------------------------------------------------------------------
       288  %integerfn newkd
       289  %integer i
       290    %if kdasl=0 %then print string("KD ASL EMPTY") %and %stop
       291    i=kdasl
       292    kdasl=kd(i)_b
       293    kd(i)=0
       294    %result=i
       295  %end
       296  !-----------------------------------------------------------------------
       297  %routine returnkd(%integer i)
       298    kd(i)_b=kdasl
       299    kdasl=i
       300  %end
       301  !-----------------------------------------------------------------------
       302  %routine returnlist(%integer i)
       303    %if i=0 %then %return
       304    returnlist(kd(i)_a)
       305    returnlist(kd(i)_b)
       306    returnkd(i)
       307  %end
       308  !-----------------------------------------------------------------------
       309  %integerfn phrase
       310  %string(15) p
       311  %integer i,l
       312    p=""
       313    %cycle
       314      read symbol(l)
       315      %if l='>' %then %exit %else p=p.tostring(l)
       316    %repeat
       317    %for i=256,1,pnp-1 %cycle
       318      %if pn(i)=p %then %result=i
       319    %repeat
       320    pn(pnp)=p
       321    pp(pnp)=0
       322    pnp=pnp+1
       323    %result=pnp-1
       324  %end
       325  !-----------------------------------------------------------------------
       326  %routine literal
       327  %integer l
       328    %cycle
       329      read symbol(l)
       330      %if l='''' %then %return %else ps(psp)=l %and psp=psp+1
       331    %repeat
       332  %end
       333  !-----------------------------------------------------------------------
       334  %routine keyword
       335  %string(31) k
       336  %integer l
       337    k=""
       338    %cycle
       339      read symbol(l)
       340      %if l='"' %then %exit
       341      %if 'A'<=l<='Z' %then k=k.tostring(l)
       342    %repeat
       343    ps(psp)=findk(k) %and psp=psp+1 %until k=""
       344  %end
       345  %end
       346  !-----------------------------------------------------------------------
       347  %routine read statement
       348  %routinespec store(%integer l)
       349  %routinespec keyword
       350  %routinespec name
       351  %routinespec const
       352  %integer i,l,ksh
       353    ! line reconstruct phase
       354    newlines(3)
       355    ttp=1
       356    ksh=0
       357    %cycle    ;! for each character
       358      rpsym(l)
       359      %if l='%' %then ksh=128 %else %start
       360        %unless 'A'<=l<='Z' %then ksh=0
       361        %if l#' ' %then %start    ;! discard spaces
       362          %if l='!' %and ttp=1 %then %start
       363            rpsym(l) %until l=';' %or l=nl    ;! discard comments
       364          %finish %else %start
       365            store(l)
       366            %if l='''' %then %start
       367              rpsym(l) %and store(l) %until l=''''
       368            %finish %else %start
       369              %if l=';' %or l=nl %then %start
       370                %if ttp=2 %then ttp=1 %else %start
       371                  %if l=';' %then newline %and %exit
       372                  %if tt(ttp-2)='C'+128 %then ttp=ttp-2 %else %exit
       373                %finish
       374              %finish
       375            %finish
       376          %finish
       377        %finish
       378      %finish
       379    %repeat
       380    ! lexical phase
       381    tp=1
       382    ttpp=1
       383    %cycle    ;! for each lexical item
       384      i=tt(ttpp)
       385      %if i>=128 %then keyword %else %start
       386        %if 'A'<=i<='Z' %then name %else %start
       387          %if '0'<=i<='9' %or i='''' %then const %else %c
       388+           t(tp)=i %and tp=tp+1 %and ttpp=ttpp+1
       389        %finish
       390      %finish
       391    %repeat %until ttpp=ttp
       392    %if lexopt=1 %then %start
       393      newline
       394      %for ttpp=1,1,tp-2 %cycle
       395        write(t(ttpp),4)
       396        %if ttpp&16_f=0 %then newline
       397      %repeat
       398      newline
       399    %finish
       400    %return
       401  !-----------------------------------------------------------------------
       402  %routine store(%integer l)
       403    %if ttp>256 %then fault("STATEMENT TOO LONG") %and %stop
       404    tt(ttp)=l+ksh
       405    ttp=ttp+1
       406  %end
       407  !-----------------------------------------------------------------------
       408  %routine keyword
       409  %string(255) k
       410  %integer i
       411    k=""
       412    %while tt(ttpp)>128 %then k=k.tostring(tt(ttpp)-128) %and ttpp=ttpp+1
       413    i=findk(k) %and t(tp)=i %and tp=tp+1 %until k="" %or i=0
       414  %end
       415  !-----------------------------------------------------------------------
       416  %routine name
       417  %string(*)%name sname
       418  %integer i,l,hash
       419    sname==string(addr(named(namedp)))
       420    hash=0
       421    sname=""
       422    l=tt(ttpp)
       423    %cycle
       424      %if namedp+length(sname)>=1022 %then fault("NAME DICTIONARY FULL")%c
       425+       %and %stop
       426      %if length(sname)=255 %then fault("NAME TOO LONG") %and %stop
       427      sname=sname.tostring(l)
       428      hash=hash<<8!l
       429      ttpp=ttpp+1
       430      l=tt(ttpp)
       431    %repeat %until l<'0' %or '9'<l<'A' %or l>'Z'
       432    hash=hash-hash//251*251
       433    i=hash
       434    %cycle    ;! scan dictionary
       435      %if namedlink(i)=0 %then namedlink(i)=namedp %and %c
       436+        namedp=namedp+length(sname)+1 %and %exit    ;! insert name
       437      %if sname=string(addr(named(namedlink(i)))) %then %exit
       438      i=(i+1)&255
       439      %if i=hash %then fault("NAME DICTIONARY FULL") %and %stop
       440    %repeat
       441    t(tp)=256    ;! <name>
       442    t(tp+1)=i    ;! ident
       443    tp=tp+2
       444  %end
       445  !-----------------------------------------------------------------------
       446  %routine const
       447  %integer l,value,flag,count,maxby10,maxld
       448    value=0
       449    flag=0
       450    %if tt(ttpp)='''' %then %start
       451      count=0
       452      %cycle
       453        ttpp=ttpp+1
       454        %if tt(ttpp)='''' %then %start
       455          ttpp=ttpp+1
       456          %if tt(ttpp)#'''' %then %exit
       457        %finish
       458        value=value<<8!tt(ttpp)
       459        count=count+1
       460      %repeat
       461      %unless 1<=count<=4 %then flag=1
       462    %finish %else %start
       463      maxby10=16_7FFFFFFF//10
       464      maxld=16_7FFFFFFF-maxby10*10
       465      l=tt(ttpp)
       466      %cycle
       467        %if value>maxby10 %or (value=maxby10 %and l>maxld) %then flag=1 %c
       468+         %else value=value*10+l-'0'
       469        ttpp=ttpp+1
       470        l=tt(ttpp)
       471      %repeat %until l<'0' %or l>'9'
       472    %finish
       473    t(tp)=257    ;! <const>
       474    %if flag#0 %then fault("CONSTANT INVALID") %and value=0
       475    t(tp+1)=value
       476    tp=tp+2
       477  %end
       478  %end
       479  !-----------------------------------------------------------------------
       480  %routine rpsym(%integername l)
       481    read symbol(l)
       482    print symbol(l)
       483    %if 'a'<=l<='z' %then l=l-'a'+'A'
       484  %end
       485  !-----------------------------------------------------------------------
       486  %integerfn findk(%string(*)%name k)
       487  ! look keyword up in dictionary
       488  %integer i,l
       489    l=charno(k,1)
       490    k->(tostring(l)).k
       491    i=l-'A'+1
       492    %if kd(i)_l=0 %then %result=0
       493  search:%if k="" %or kd(i)_a=0 %then %result=kd(i)_n
       494    l=charno(k,1)
       495    k->(tostring(l)).k
       496    i=kd(i)_a
       497    %cycle
       498      %if kd(i)_l=l %then ->search
       499      %if kd(i)_b=0 %then %result=0
       500      i=kd(i)_b
       501    %repeat
       502  %end
       503  !-----------------------------------------------------------------------
       504  %integerfn compare(%integer p)
       505  %integer app,tpp,alt,altend,psp,psi
       506    a(ap)=p<<16!16_80000001       ;! phrase number & alternative 1
       507    %if p<=257 %then %start       ;! <name> or <const>
       508      %if p=t(tp) %then %start    ;! success
       509        a(ap+1)=t(tp+1)
       510        ap=ap+2
       511        tp=tp+2
       512        %result=1
       513      %finish %else %result=0
       514    %finish
       515    tpp=tp       ;! preserve text pointer
       516    app=ap       ;! preserve analysis record pointer
       517    psp=pp(p)    ;! start of phrase definition
       518    %cycle       ;! for each alternative
       519      alt=ap+1
       520      altend=ps(psp)
       521      ap=alt+ps(psp+1)    ;! leave gap for forward pointers
       522      %if ap>255 %then fault("ANALYSIS RECORD TOO LONG") %and %stop
       523      psp=psp+2
       524      %cycle    ;! for each item
       525        %if psp=altend %then %result=1    ;! success
       526        psi=ps(psp)
       527        %if psi>=256 %then %start         ;! phrase
       528          a(alt)=ap                       ;! forward pointer
       529          %if compare(psi)=0 %then %exit
       530          alt=alt+1
       531        %finish %else %start              ;! literal or keyword
       532          %if psi#t(tp) %then %exit
       533          tp=tp+1
       534        %finish
       535        psp=psp+1
       536      %repeat
       537      %if ps(altend)=0 %then %result=0    ;! failure
       538      psp=altend
       539      tp=tpp           ;! backtrack text pointer
       540      ap=app           ;! backtrack analysis record pointer
       541      a(ap)=a(ap)+1    ;! next alternative number
       542    %repeat
       543  %end
       544  %endofprogram
      Code 9996 bytes  Glap 10136 bytes  Diags 2355 bytes   Total size 22487 bytes
         464 statements compiled

