Source file: SKIMPB.IMP Compiled on 25-OCT-1979 at 09:39:49 Computer Science IMP77 Compiler. Version 6.01 1 %externalintegerarrayspec a(1:500) 2 %externalintegerarrayspec taglink(0:255) 3 %externalintegerarrayspec tag(1:512) 4 %externalintegerarrayspec link(1:512) 5 !----------------------------------------------------------------------- 6 %externalroutinespec expr(%integer exprp) 7 %externalintegerfnspec cond(%integer condp,tlabel,flabel) 8 %externalstring(255)%fnspec strint(%integer n,p) 9 %externalintegerfnspec getwork 10 %externalroutinespec returnwork(%integer work) 11 %externalroutinespec clearwork 12 %externalintegerfnspec newtag 13 %externalroutinespec pushtag(%integer ident,form,type,dim,level,rad) 14 %externalroutinespec poptags 15 %externalintegerfnspec getlabel(%integer constp) 16 %externalroutinespec filllabel(%integer label) 17 %externalintegerfnspec fillbranch(%integer label) 18 %externalroutinespec poplabels 19 %externalintegerfnspec nextplabel 20 %externalroutinespec dump(%string(7) opn,reg,base,%integer disp) 21 %externalroutinespec fault(%string(63) mess) 22 %externalstring(255)%fnspec name(%integer ident) 23 %externalroutinespec pushstart(%integer flag,plab) 24 %externalroutinespec popstart(%integername flag,plab) 25 %externalroutinespec clearstart 26 %externalintegerfnspec enter 27 %externalroutinespec dump return 28 %externalroutinespec proc(%integer procp) 29 %externalroutinespec array(%integer arrayp) 30 %externalroutinespec endofprog 31 !----------------------------------------------------------------------- 32 %externalintegerarray nextrad(0:15) 33 %externalstring(4)%array display(0:15)="DR0","DR1","DR2","DR3","DR4", 34+ "DR5","DR6","DR7","DR8","DR9","DR10","DR11","DR12","DR13","DR14","DR15" 35 %externalinteger level,nextcad 36 !----------------------------------------------------------------------- 37 %ownintegerarray proctype(0:15) 38 %ownintegerarray staticalloc(0:15) 39 %ownintegerarray skipproc(0:15) 40 !----------------------------------------------------------------------- 41 %externalroutine statement(%integer statementp) 42 %routinespec instr(%integer instrp) 43 %switch sttype(1:8) 44 %integer condp,instrp,elsep,constp,arrayp,namep,namesp,expr1p,expr2p, %c 45+ instr2p,tlabel,flabel,label,fplabel,tplabel,work1,work2,flag,plabel,%c 46+ procp,formalp,formp,params,procid,ident,form,paramt,paraml,dim 47 ->sttype(a(statementp)) 48 !----------------------------------------------------------------------- 49 sttype(1):! 50 instr(a(statementp+1)) 51 %return 52 !----------------------------------------------------------------------- 53 sttype(2):! "IF""THEN" 54 condp=a(statementp+1) 55 instrp=a(statementp+2) 56 elsep=a(statementp+3) 57 %if a(instrp)=2 %then %start ;! branch 58 constp=a(instrp+1) 59 tlabel=getlabel(constp) 60 %if a(elsep)=2 %then filllabel(cond(condp,tlabel,-1)) %else %start 61 instrp=a(elsep+1) 62 %if a(instrp)=2 %then %start ;! branch 63 constp=a(instrp+1) 64 flabel=getlabel(constp) 65 filllabel(cond(condp,tlabel,flabel)) 66 dump("B","","",fillbranch(flabel)) 67 %finish %else %start 68 filllabel(cond(condp,tlabel,-1)) 69 %if a(instrp)=3 %then pushstart(1,-1) %else instr(instrp) 70 %finish 71 %finish 72 %finish %else %start 73 %if a(elsep)=2 %then %start 74 fplabel=cond(condp,-1,-1) 75 %if a(instrp)=3 %then pushstart(0,fplabel) %else %c 76+ instr(instrp) %and filllabel(fplabel) 77 %finish %else %start 78 instr2p=a(elsep+1) 79 %if a(instr2p)=2 %then %start ;! branch 80 constp=a(instr2p+1) 81 fplabel=cond(condp,-1,getlabel(constp)) ;! result always -1 82 instr(instrp) 83 %finish %else %start 84 fplabel=cond(condp,-1,-1) 85 instr(instrp) 86 tplabel=nextplabel 87 dump("B","","",fillbranch(tplabel)) 88 filllabel(fplabel) 89 %if a(instr2p)=3 %then pushstart(1,tplabel) %else %c 90+ instr(instr2p) %and filllabel(tplabel) 91 %finish 92 %finish 93 %finish 94 %return 95 !----------------------------------------------------------------------- 96 sttype(3):! ':' 97 constp=a(statementp+1) 98 statementp=a(statementp+2) 99 label=getlabel(constp) 100 filllabel(label) 101 statement(statementp) 102 %return 103 !----------------------------------------------------------------------- 104 sttype(4):! "FINISH" 105 elsep=a(statementp+1) 106 popstart(flag,plabel) 107 %if flag=0 %then %start ;! first %start/%finish 108 %if a(elsep)=1 %then %start 109 instrp=a(elsep+1) 110 tplabel=nextplabel 111 dump("B","","",fillbranch(tplabel)) 112 filllabel(plabel) 113 %if a(instrp)=3 %then pushstart(1,tplabel) %else %c 114+ instr(instrp) %and filllabel(tplabel) 115 %finish %else filllabel(plabel) 116 %finish %else %start ;! second %start/%finish 117 %if a(elsep)=1 %then fault("SPURIOUS %ELSE") %else filllabel(plabel) 118 %finish 119 %return 120 !----------------------------------------------------------------------- 121 sttype(5):! "INTEGER" 122 arrayp=a(statementp+1) 123 namep=a(arrayp+1) 124 namesp=a(arrayp+2) 125 %if a(arrayp)=1 %then %start ;! array declaration 126 expr1p=a(arrayp+3) 127 expr2p=a(arrayp+4) 128 expr(expr1p) 129 work1=getwork 130 dump("STR","ACC",display(level),work1) 131 expr(expr2p) 132 dump("LDA","ACC","ACC",1) 133 work2=getwork 134 dump("STR","ACC",display(level),work2) 135 %cycle 136 pushtag(a(namep+1),2,1,1,level,nextrad(level)) 137 dump("SUB","STP",display(level),work1) 138 dump("STR","STP",display(level),nextrad(level)) 139 dump("ADD","STP",display(level),work2) 140 nextrad(level)=nextrad(level)+1 141 %if a(namesp)=2 %then %exit 142 namep=a(namesp+1) 143 namesp=a(namesp+2) 144 %repeat 145 returnwork(work1) 146 returnwork(work2) 147 %finish %else %start 148 %cycle 149 pushtag(a(namep+1),0,1,0,level,nextrad(level)) 150 nextrad(level)=nextrad(level)+1 151 %if a(namesp)=2 %then %exit 152 namep=a(namesp+1) 153 namesp=a(namesp+2) 154 %repeat 155 %finish 156 %return 157 !----------------------------------------------------------------------- 158 sttype(6):! 159 %if level=0 %then fault("PROCEDURE BEFORE %BEGIN") 160 %if level=15 %then fault("PROCEDURE NESTING TOO DEEP") 161 procp=a(statementp+1) 162 namep=a(statementp+2) 163 formalp=a(statementp+3) 164 procid=a(namep+1) 165 skipproc(level)=nextcad 166 dump("B","","",0) ;! branch round procedure 167 pushtag(procid,4,a(procp)-1,0,level,nextcad) 168 level=level+1 169 proctype(level)=a(procp) 170 staticalloc(level)=enter 171 nextrad(level)=2 172 %if a(formalp)=2 %then %return ;! no parameters 173 params=0 174 paraml=taglink(procid) 175 %until a(formalp)=2 %cycle 176 formp=a(formalp+1) 177 namep=a(formalp+2) 178 namesp=a(formalp+3) 179 formalp=a(formalp+4) 180 %if a(formp)=1 %then form=3 %and dim=1 %else %start 181 %if a(formp)=2 %then form=1 %else form=0 182 dim=0 183 %finish 184 %cycle 185 ident=a(namep+1) 186 ! declare parameters as locals 187 pushtag(ident,form,1,dim,level,nextrad(level)) 188 nextrad(level)=nextrad(level)+1 189 ! append parameter tag cells to procedure tag cell 190 paramt=newtag 191 tag(paramt)=tag(taglink(ident)) 192 link(paramt)=link(paraml) 193 link(paraml)=paramt 194 paraml=paramt 195 params=params+1 196 %if params>15 %then fault(name(procid). %c 197+ " HAS TOO MANY PARAMETERS") %and %stop 198 %if a(namesp)=2 %then %exit 199 namep=a(namesp+1) 200 namesp=a(namesp+2) 201 %repeat 202 %repeat 203 ! insert number of parameters into tag cell 204 tag(taglink(procid))=tag(taglink(procid))!params<<20 205 %return 206 !----------------------------------------------------------------------- 207 sttype(7):! "END" 208 dump("FILL","ALLOC",strint(staticalloc(level),1),nextrad(level)) 209 poptags 210 poplabels 211 clearstart 212 clearwork 213 %if proctype(level)=1 %then dump return %else dump("STOP","","",0) 214 level=level-1 215 %if a(a(statementp+1))=2 %then %start ;! %end 216 %if level<=0 %then fault("SPURIOUS %END") %and endofprog 217 dump("FILL","SKIP",strint(skipproc(level),1),nextcad) 218 %finish %else %start ;! %endofprogram 219 %if level#0 %then fault("TOO FEW %ENDS") 220 endofprog 221 %finish 222 %return 223 !----------------------------------------------------------------------- 224 sttype(8):! "BEGIN" 225 %if level#0 %then fault("SPURIOUS %BEGIN") %else %start 226 level=1 227 proctype(1)=0 228 staticalloc(1)=enter 229 %finish 230 %return 231 !----------------------------------------------------------------------- 232 %routine instr(%integer instrp) 233 %switch instype(1:6) 234 %string(4) base 235 %integer namep,assignp,constp,ident,actualp,exprp,nametag,disp,work 236 ->instype(a(instrp)) 237 !----------------------------------------------------------------------- 238 instype(1):! 239 namep=a(instrp+1) 240 actualp=a(instrp+2) 241 assignp=a(instrp+3) 242 ident=a(namep+1) 243 %if taglink(ident)=0 %then fault(name(ident)." NOT DECLARED") %c 244+ %and %return 245 nametag=tag(taglink(ident)) 246 %if a(assignp)=1 %then %start 247 %if nametag>>28=4 %then fault(name(ident)." NOT A DESTINATION") %c 248+ %and %return 249 exprp=a(assignp+1) 250 %if nametag>>28>=2 %then %start ;! array variable 251 expr(exprp) 252 work=getwork 253 dump("STR","ACC",display(level),work) 254 array(instrp) 255 dump("LOAD","WK",display(level),work) 256 dump("STR","WK","ACC",0) 257 returnwork(work) 258 %finish %else %start 259 expr(exprp) 260 base=display(nametag>>16&16_F) 261 disp=nametag&16_FFFF 262 %if nametag>>28=1 %then %start ;! %name variable 263 dump("LOAD","WK",base,disp) 264 dump("STR","ACC","WK",0) 265 %finish %else dump("STR","ACC",base,disp) 266 %if a(actualp)=1 %then fault(name(ident)." DECLARED AS SCALAR") 267 %finish 268 %finish %else %start 269 %if nametag>>28=4 %and nametag>>24&16_F=0 %then proc(instrp) %c 270+ %else fault(name(ident)." NOT A ROUTINE NAME") 271 %finish 272 %return 273 !----------------------------------------------------------------------- 274 instype(2):! '->' 275 constp=a(instrp+1) 276 label=getlabel(constp) 277 dump("B","","",fillbranch(label)) 278 %return 279 !----------------------------------------------------------------------- 280 instype(3):! "START" 281 fault("ILLEGAL %START") 282 %return 283 !----------------------------------------------------------------------- 284 instype(4):! "RETURN" 285 %if proctype(level)#1 %then fault("%RETURN OUT OF CONTEXT") 286 dumpreturn 287 %return 288 !----------------------------------------------------------------------- 289 instype(5):! "RESULT"'=' 290 %if proctype(level)#2 %then fault("%RESULT OUT OF CONTEXT") 291 expr(a(instrp+1)) 292 dumpreturn 293 %return 294 !----------------------------------------------------------------------- 295 instype(6):! "STOP" 296 dump("STOP","","",0) 297 %end 298 %end 299 %endoffile Code 7292 bytes Glap 1256 bytes Diags 1276 bytes Total size 9824 bytes 253 statements compiled