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''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 ;! 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 ;! 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 ;! or 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