Source: ERCM11:IMP119S.ASS11S Compiled: 06/10/86 15.42.04 Object: ERCM11:IMP119Y.ASS11Y Parms set: DEFAULTS ERCC. Portable Imp80 Compiler Release 4 Version 15 May 86 2047 4095 1 %external %routine ass11(%string (63) files) 2 %external %integer %function %spec smaddr(%integer chan, C %integer %name length) 4 %routine define(%string (255) s) 5 %external %routine %spec emas3(%string %name command,params, C %integer %name flag) 7 %integer flag 8 emas3("DEFINE",s,flag) 9 %end; ! Of %routine define. 10 %external %string %function %spec date %alias "S#DATE" 11 %dynamic %integer %fn %spec time40(%integer in) 12 %dynamic %integer %fn %spec time03(%integer in) 13 %dynamic %integer %fn %spec time45(%integer in) 14 %routine dump bin(%half %integer %array %name code, %integer start,finish, C %string %name t, %integer %name flag) 16 %integer check,j 17 %routine put(%integer n) 18 %integer m 19 m = n>>8&255 20 n = n&255 21 printch(n); printch(m) 22 check = check+(n+m) 23 %end 24 %return %if start<0; !????? 25 select output(3) 26 check = 0 27 put(1) 28 put((finish-start+1)*2+4) 29 %cycle j = start,1,finish 30 put(code(j)) 31 %repeat 32 printch((-check)&255) 33 select output(2) 34 %end 35 !! 36 %integer %fn %spec break up(%byte %integer %array %name lne) 37 %routine %spec octal(%integer n) 38 %routine %spec code 39 %integer %fn %spec an opnd(%integer type, %string (80) opnd) 40 %routine %spec set def(%integer def,opn) 41 %routine %spec user def(%string %name opnd) 42 %routine %spec list line(%integer len) 43 %integer %fn %spec test reg(%string (80) reg) 44 %integer %fn %spec value(%string %name opnd) 45 %integer %fn %spec test name(%string %name name) 46 %integer %fn %spec branch(%integer val,here) 47 %integer %fn %spec new tag(%string %name a) 48 %integer %fn %spec search(%string %name a) 49 %integer %fn %spec hash(%string %name ident, %byte %integer flag) 50 %routine %spec word(%string (80) opnd) 51 %routine %spec fault(%integer i) 52 %routine %spec origin 53 %routine %spec pseudo eval 54 %routine %spec globals 55 %routine %spec byte(%string %name opnd) 56 %routine %spec push byte(%integer n) 57 %routine %spec abandon(%string (60) s) 58 %routine %spec symbols 59 %routine %spec bin out 60 %routine %spec report faults 61 %routine %spec start pass two(%integer str) 62 !! 63 !!!!!!!!!!%c C !!!!!!!!!!%c C !!!!!!!!!!%c C !!!!!!!!!!!!!!!!!!!!!!!!!!!!! 67 !! %c C !! 69 !! INSTRUCTION%c C DESCRIPTOR !! 71 !! %c C !! 73 !!!!!!!!!!%c C !!!!!!!!!!%c C !!!!!!!!!!%c C !!!!!!!!!!!!!!!!!!!!!!!!!!!!! 77 !! 78 %record %format instf(%byte %integer type,byte, %half %integer code) 79 %record (instf) %name inst 80 !! 81 !!!!!!!!!!%c C !!!!!!!!!!%c C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 84 !! %c C !! 86 !! FORMAT OF DES (NAME%c C DESCRIPTOR) !! 88 !! %c C !! 90 !! DES_DEF%c C DES_REG (NAME TYPE) !! 92 !! 0 NOT DEFINED 0%c C NOT USED !! 94 !! 1 DEFINED 1%c C REGISTER !! 96 !! 2%c C GLOBAL !! 98 !! 128 USED 3%c C USER DEFINED !! 100 !! 4%c C LABEL !! 102 !! 8%c C OPERATION !! 104 !! 9%c C MACRO !! 106 !! %c C !! 108 !!!!!!!!!!%c C !!!!!!!!!!%c C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 111 !! 112 %record %format desf(%byte %integer def,reg, %half %integer value) 113 %record (desf) %name des 114 %own %half %integer %array desa(0:4096)=0(4097) 115 !! 116 !!!!!!!!!!%c C !!!!!!!!!!%c C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 119 !! %c C !! 121 !! UNDEFINED REFERENCE LINK FORMAT%c C AND ASL LIST !! 123 !! %c C !! 125 !! FORMAT:%c C !! 127 !! LINK - LINK TO NEXT%c C UNDEF. REF !! 129 !! COT - POSITION TO MODIFY%c C IN CORE ARRAY !! 131 !! OPN - OPERATION TO DO ON%c C WORD +,-,*,/ ETC!! 133 !! BYT - INDICATES A BYTE%c C OPERATION !! 135 !! ADD - ADDRESS IN CORE%c C (LISTING USE ONLY) !! 137 !! LINO - LINE NUMBER OF%c C REFERENCE !! 139 !! %c C !! 141 !!!!!!!!!!%c C !!!!!!!!!!%c C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 144 !! 145 %integer curr,currp,aslp,code1,inpt,stinpt,pass 146 %integer code2 147 %own %half %integer %array cot(0:200)= 0(201) 148 %own %integer corep=0 149 %half %integer %array names(0:2048) 150 %byte %integer %array letters(0:10000) 151 %integer i,j,len,pos,bf,obf,top 152 %own %byte %integer sbf=0 153 %own %integer lino=0 154 %own %integer reloc flag= 0, global op = 0 155 %own %integer endflag=0 156 %own %integer faults=0 157 %own %integer mon=0 158 %own %integer timer= 0 159 %own %integer letterpt=1 160 %own %half %integer dot=0 161 %own %byte %integer brf=1 162 %own %byte %integer list=0 163 %own %byte %integer assmf=0 164 %own %byte %integer absf=0 165 %own %byte %integer mode=0 166 %own %integer hashf=0 167 %own %integer hashg=0 168 %own %integer input=0 169 %own %integer bsw=0 170 %own %integer bytef=0 171 %own %integer enf=1 172 %own %integer desap=0 173 %string (80) oper,opnd 174 %string (63) file2,file3,grot 175 %byte %integer %array lne(0:132) 176 !! 177 !! 178 %own %half %integer %array instaa(-1:114)=0, 0, C x'0101', x'0A00', x'0101', x'0AC0', C x'0101', x'0A80', x'0101', x'0B00', C x'0101', x'0BC0', x'0101', x'0A40', C x'0101', x'0C80', x'0101', x'0CC0', C x'0101', x'0B40', x'0101', x'0B80', C x'0101', x'0C40', x'0101', x'0C00', C x'0101', x'00C0', x'0201', x'1000', C x'0200', x'6000', x'0200', x'E000', C x'0201', x'2000', x'0201', x'5000', C x'0201', x'3000', x'0201', x'4000', C x'0400', x'0100', x'0400', x'0300', C x'0400', x'0200', x'0400', x'8100', C x'0400', x'8000', x'0400', x'8700', C x'0400', x'8600', x'0400', x'8500', C x'0400', x'8400', x'0400', x'0500', C x'0400', x'0400', x'0400', x'0700', C x'0400', x'0600', x'0400', x'8200', C x'0400', x'8300', x'0400', x'8700', C x'0400', x'8600', x'0100', x'0080', C x'0300', x'0800', x'0500', x'8800', C x'0500', x'8900', x'0000', x'0003', C x'0000', x'0004', x'0000', x'0000', C x'0000', x'0001', x'0000', x'0005', C x'0000', x'0002', x'0100', x'0040', C x'0000', x'00A8', x'0000', x'00A4', C x'0000', x'00A2', x'0000', x'00A1', C x'0000', x'00B8', x'0000', x'00B4', C x'0000', x'00B2', x'0000', x'00B1', C x'0300', x'7400' 208 !! 209 %own %half %integer %array built if(1:130)= %c C x'0101', x'0000', x'0101', x'0001', C x'0101', x'0002', x'0101', x'0003', C x'0101', x'0004', x'0101', x'0005', C x'0101', x'0006', x'0101', x'0007', C x'0108', x'0001', x'0108', x'0002', C x'0108', x'0003', x'0108', x'0004', C x'0108', x'0005', x'0108', x'0006', C x'0108', x'0007', x'0108', x'0008', C x'0108', x'0009', x'0108', x'000A', C x'0108', x'000B', x'0108', x'000C', C x'0108', x'000D', x'0108', x'000E', C x'0108', x'000F', x'0108', x'0010', C x'0108', x'0011', x'0108', x'0012', C x'0108', x'0013', x'0108', x'0014', C x'0108', x'0015', x'0108', x'0016', C x'0108', x'0017', x'0108', x'0018', C x'0108', x'0019', x'0108', x'001A', C x'0108', x'001B', x'0108', x'001C', C x'0108', x'001D', x'0108', x'001E', C x'0108', x'001F', x'0108', x'0020', C x'0108', x'0021', x'0108', x'0022', C x'0108', x'0023', x'0108', x'0024', C x'0108', x'0025', x'0108', x'0026', C x'0108', x'0027', x'0108', x'0028', C x'0108', x'0029', x'0108', x'002A', C x'0108', x'002B', x'0108', x'002C', C x'0108', x'002D', x'0108', x'002E', C x'0108', x'002F', x'0108', x'0030', C x'0108', x'0031', x'0108', x'0032', C x'0108', x'0033', x'0108', x'0034', C x'0108', x'0035', x'0108', x'0036', C x'0108', x'0037', x'0108', x'0038', C x'0108', x'0039' 243 %const %byte %integer %array built in(1:259)=2, 82, 48, 2, 82, 49, 2 %c C , 82, 50, 2, C 82, 51, 2, 82, 52, 2, 82, 53, 2, 83, C 80, 2, 80, 67, 3, 67, 76, 82, 3, 68, C 69, 67, 3, 73, 78, 67, 3, 78, 69, 71, C 3, 84, 83, 84, 3, 67, 79, 77, 3, 65, C 83, 82, 3, 65, 83, 76, 3, 65, 68, 67, C 3, 83, 66, 67, 3, 82, 79, 76, 3, 82, C 79, 82, 3, 83, 87, 65, 3, 77, 79, 86, C 3, 65, 68, 68, 3, 83, 85, 66, 3, 67, C 77, 80, 3, 66, 73, 83, 3, 66, 73, 84, C 3, 66, 73, 67, 2, 66, 82, 3, 66, 69, C 81, 3, 66, 78, 69, 3, 66, 77, 73, 3, C 66, 80, 76, 3, 66, 67, 83, 3, 66, 67, C 67, 3, 66, 86, 83, 3, 66, 86, 67, 3, C 66, 76, 84, 3, 66, 71, 69, 3, 66, 76, C 69, 3, 66, 71, 84, 3, 66, 72, 73, 4, C 66, 76, 79, 83, 3, 66, 76, 79, 4, 66, C 72, 73, 83, 3, 82, 84, 83, 3, 74, 83, C 82, 3, 69, 77, 84, 4, 84, 82, 65, 80, C 3, 66, 80, 84, 3, 73, 79, 84, 4, 72, C 65, 76, 84, 4, 87, 65, 73, 84, 5, 82, C 69, 83, 69, 84, 3, 82, 84, 73, 3, 74, C 77, 80, 3, 67, 76, 78, 3, 67, 76, 90, C 3, 67, 76, 86, 3, 67, 76, 67, 3, 83, C 69, 78, 3, 83, 69, 90, 3, 83, 69, 86, C 3, 83, 69, 67, 3, 65, 83, 72, 128 270 %const %half %integer %array built hash(1:65)=1120, 1122, 1124, C 1126, 1128, 1130, 1696, 134, 2020, 1487, C 1258, 1999, 249, 237, 505, 2041, 1228, 710, 749, 1261, C 1285, 493, 1996, 2047, 487, 2011, 731, 2012, 1188, 463, C 1514, 488, 752, 1993, 1994, 2, 3, 740, 1493, 1508, C 725, 472, 1660, 996, 1644, 2044, 1273, 999, 1672, 753, C 2029, 596, 597, 1970, 508, 1767, 997, 2021, 998, 741, C 975, 2000, 976, 719, 1017 278 !! 279 !! 280 %const %string (8) %array pseudo in(1:23)="ASCII", "BYTE", C "WORD", "PAGE", C "IFDF", "IFNDF", C "GLOBL", "TITLE", C "ABSOLUTE", C "END", C "LIST", "NOLIST", C "MON", "MOFF", C "ENDC", "PLIST", C "EVEN", "EOT", C "TIME40", "TIME03", "TIME45", C "DATE", C "^ ^" 293 !! 294 %const %byte %integer %array trans(0:128)=0(32), 6, 2, 0(2), 10, 0, C 3, 0, 1, 0, 4, 6, 0, 5, C 8, 7, 9(10), 0(7), 11(26), 0(6), 11(26), 0(6) 297 !! 0 - RUBBISH 298 !! 1 - ( 299 !! 2 - ! 300 !! 3 - & 301 !! 4 - * 302 !! 5 - - 303 !! 6 - + AND SPACE 304 !! 7 - / 305 !! 8 - . 306 !! 9 - 0-9 307 !! 10 - $ 308 !! 11 - A-Z 309 !! 310 %if files->files.("/").grot %start 311 grot = grot.",," 312 grot -> file2.(",").file3.(",").grot 313 %finish %else %start 314 files = files.",,," 315 files -> files.(",").file2.(",").file3.(",").grot 316 %finish 317 file2 = ".NULL" %if file2="" 318 file3 = "SS#LIST" %if file3="" 319 define("ST2,".file3.",511") 320 define("ST3,".file2) 321 define("SM1,".files) 322 inpt = smaddr(1,input); input = input+inpt 323 stinpt = inpt 324 select output(2) 325 ! SET MARGINS(2, 1, 132) 326 printstring(" 327" SOURCE: ".files." 328" BINARY: ".file2." 329" 330" ERCC PDP11 two pass assembler Version 1.8 331" 332" 333" ") 334 !! 335 desap = addr(desa(0)) 336 !! 337 curr = 1; currp = 2 338 obf = 0 339 %cycle i = 0,1,2048; names(i) = 0; %repeat 340 %cycle i = 1,1,259; letters(i) = built in(i); %repeat 341 %cycle i = 1,1,65 342 names(built hash(i)) = letterpt 343 letterpt = letterpt+letters(letterpt)+1 344 j = built hash(i)<<1 345 desa(j) = built if(i<<1-1) 346 desa(j+1) = built if(i<<1) 347 %repeat 348 pass = 1 349 loop:corep = 0 350 %until endflag#0 %cycle 351 len = 0; bf = 0; sbf = 1 352 lino = lino+1 353 %if break up(lne)<0 %start 354 endflag = 1; fault(2); ! NO '.END' 355 oper = ".END" 356 %finish 357 %if oper#"" %or opnd#"" %start 358 code 359 %if obf#0 %and sbf=0 %start 360 fault(18); dot <- dot+2 361 ! NOT WORD ALIGNED 362 bsw = 0; ! FOR THE SAKE OF LABELS 363 %finish 364 obf = bf; ! %if SBF#0 %and LEN=0 %then 365 ! LEN=1 366 %finish 367 %if pass=2 %start 368 %if list=0 %or (list=1 %and assmf=0) %then list line(len) 369 curr = curr+(len+1)>>1; currp = curr+1 370 %finish %else curr = 1 371 dot <- (dot+len)&x'FFFFFFFE' 372 %if curr>80 %and bsw=0 %start 373 bin out; ! OUTPUT THIS BLOCK 374 corep = dot; ! RESET THE BEGINNING OF THE 375 ! BLOCK 376 %finish 377 %repeat 378 %if pass=1 %start 379 pass = pass+1 380 inpt = stinpt 381 lino = 0 382 start pass two(2) 383 dot = 0 384 endflag = 0 385 assmf = 0; absf = 0; list = 0; obf = 0; bsw = 0 386 ->loop 387 %finish 388 endflag = 0 389 bin out; corep = dot 390 symbols 391 endflag = 1; bin out 392 report faults 393 newpage 394 select output(0) 395 report faults 396 %return 397 !! 398 399 400 %integer %fn break up(%byte %integer %array %name lne) 401 !! 402 %byte %integer %array l(0:100) 403 %integer i,f,len,pt,lp,lp2,s,sc,n,pt2 404 %string %name lab 405 %byte %integer %name str 406 oper = ""; opnd = "" 407 f = 0; len = 0 408 %until i=nl %cycle 409 i = byteinteger(inpt) 410 inpt = inpt+1; %result = -1 %if inpt>input 411 %unless f=0 %and i=' ' %and len<=80 %start 412 len = len+1; l(len) = i; f = 1 413 %finish 414 %repeat 415 lp = 1; lp2 = 1 416 %if len=1 %then ->fin; ! BLANK LINE 417 l(len) = nl 418 pt = 1; %if l(1)=';' %then ->com 419 ! SEARCH FOR LABELS 420 pt2 = 1; i = 'A'; ! DUMMY 421 %while trans(i)>=7 %cycle 422 i = l(pt2); pt2 = pt2+1 423 lne(lp2) = i; lp2 = lp2+1 424 %if i=':' %start 425 l(0) = pt2-2 426 %if l(0)>6 %and pass=2 %then fault(10) 427 lab == string(addr(l(0))) 428 %if assmf=0 %start 429 n = newtag(lab) 430 set def(4,dot+bsw) 431 %finish 432 lp = lp2 433 pt = pt2 434 ->exit1 435 %finish 436 %repeat 437 exit1: ! ON EXIT, NO NAME=>PT=1 438 ! NAME =>PT=PAST LABEL 439 ! 440 %while lp<9 %cycle; lne(lp) = ' '; lp = lp+1; %repeat 441 pt = pt+1 %while l(pt)=' ' 442 ! SCAN PAST SPACES 443 pt2 = pt-1; i = trans(l(pt)) 444 %if i>9 %or i=8 %start 445 lne(lp) = l(pt); lp = lp+1 446 pt = pt+1 447 %while trans(l(pt))>=9 %cycle 448 lne(lp) = l(pt); lp = lp+1; pt = pt+1 449 %repeat 450 %finish 451 l(pt2) = pt-pt2-1 452 oper = string(addr(l(pt2))) 453 %while lp<17 %cycle; lne(lp) = ' '; lp = lp+1; %repeat 454 pt = pt+1 %while l(pt)=' ' 455 %if oper=".ASCII" %start 456 ! DEAL WITH .ASCII SEPERATELY 457 sc = l(pt) 458 lp2 = lp-1; str == lne(lp2); s = str 459 %until (i=sc %and lp2#lp-2) %or i=nl %cycle 460 i = l(pt) 461 pt = pt+1 462 lne(lp) = i; lp = lp+1 463 %repeat 464 %if i=sc %start 465 i = l(pt); pt = pt+1 466 %finish %else %start 467 lne(lp) = sc; lp = lp+1; fault(16) 468 %finish 469 ->opndl 470 %finish 471 %if l(pt)=';' %start 472 com: %if pass=2 %start 473 %if lp#1 %start; ! NOT AT BEGINNING OF LINE 474 %while lp<37 %cycle; lne(lp) = ' '; lp = lp+1 475 %repeat 476 %finish 477 %until i=nl %cycle 478 i = l(pt); pt = pt+1 479 lne(lp) = i; lp = lp+1 480 %repeat 481 lp = lp-1; ! DONT OUTPUT THE NL 482 %finish 483 %finish %else %start 484 lp2 = lp-1; str == lne(lp2); s = str 485 %until i=nl %cycle 486 i = l(pt); pt = pt+1 487 %if i#' ' %start 488 lne(lp) = i; lp = lp+1 489 %finish 490 %if i=';' %and l(pt-2)#'''' %then %exit 491 %repeat 492 lp = lp-1; ! DELETE THE NL 493 opndl: str = lp-lp2-1 494 opnd = string(addr(str)) 495 str = s 496 %if i=';' %start; pt = pt-1; ->com; %finish 497 %finish 498 fin: lne(0) = lp-1 499 %result = 0 500 !! 501 %end 502 503 504 %routine code 505 %integer byteflag 506 %integer n,m 507 %half %integer %name cpt 508 %string (80) opnd2,opern 509 %switch sw(0:5) 510 code1 = -1 511 opern = oper 512 byteflag = 0 513 %if byteinteger(addr(opern)+4)='B' %and length(opern)=4 %start 514 byteflag = x'8000'; byteinteger(addr(opern)) = 3 515 %finish 516 %if oper->(".").oper %start 517 !! PSEUDO OP OR JUST . 518 %if oper="" %start 519 %if byteinteger(addr(opnd)+1)='=' %then origin %else %start 520 oper = "."; ->words 521 %finish 522 %finish %else pseudo eval 523 %return 524 %finish 525 words:%return %if assmf#0 526 %if opnd->("=").opnd %start 527 user def(opnd) 528 %return 529 %finish 530 sbf = 0; ! OPERATION ON BYTE BDRY NOT 531 ! ALLOWED 532 n = -1 533 %if opern#"" %then n = hash(opern,8) 534 ! HASH WILL SET UP DES 535 %if n=-1 %start; ! OPER NOT RECOGNISED 536 word(oper."+".opnd) 537 %return 538 %finish 539 inst == record(addr(instaa(-1))+des_value<<2) 540 ! DES_VALUE POINTS TO ENTR 541 cpt == cot(curr) 542 cpt = 0; ! ZERO, FOR 'OR' LATER 543 %if byteflag=1 %and inst_byte=0 %then fault(4) 544 ! ILLEGAL 'BYTE' 545 len = 2; ! LENGTH OF INSTR 546 %if opern="SWA" %then byteflag = 0 547 cpt <- inst_code+byte flag 548 ->sw(inst_type) 549 !! 550 sw(1): ! ONE OPERAND 551 cpt <- cpt!an opnd(inst_type,opnd) 552 %return 553 sw(4): ! BRANCH INSTRUCTION 554 brf = 5 555 %if pass=2 %start 556 cpt <- cpt!branch(value(opnd),dot) 557 %finish 558 brf = 1; %return 559 sw(2): ! TWO OPERANDS 560 sw(3): ! REG, OPND 561 %unless opnd->opnd.(",").opnd2 %start 562 fault(3); len = 0 563 %finish %else %start 564 m = an opnd(inst_type,opnd) 565 cpt <- cpt!an opnd(2,opnd2)!m<<6 566 %finish 567 %return 568 sw(5): ! EMT AND TRAP 569 %if pass=2 %start 570 %if opnd#"" %then cpt <- cpt!(value(opnd)&x'FF') 571 %finish 572 sw(0): ! NO OPERANDS 573 %end 574 575 576 %integer %fn an opnd(%integer type, %string (80) opnd) 577 %string (16) reg,last 578 %integer minus 579 reloc flag = dot+len+2; global op = 0 580 mode = 0; minus = 0; code1 = 0; code2 = 1 581 %if opnd->("@").opnd %then mode = 8 582 %if opnd->("(").reg.(")").last %start 583 mode = mode!test reg(reg); ! DEAL WITH THE REGISTER FIRST 584 %if last="" %start 585 %if mode>=8 %start; ! @(R) => @0(R) 586 code1 = 0; code2 = 0; mode = mode!x'38' 587 %finish 588 mode = mode!8; ! FOR (R) 589 %finish %else %start 590 %if last#"+" %then fault(5) 591 ! '+' ONLY LEGAL CHAR 592 mode = mode!x'10'; ! (R)+ OR @(R)+ 593 %finish 594 %finish %else %start 595 %if opnd->("-(").opnd %start 596 %if opnd->reg.(")").last %start 597 mode = mode+x'20'+test reg(reg) 598 %finish %else fault(5) 599 ->dump 600 %finish 601 %unless opnd->("#").opnd %start 602 ! NOT MODE 27 603 code1 = value(opnd); ! NOTE R WILL RETURN CODE2=1 AND 604 ! MODE 0 605 %if opnd->("(").reg.(")").last %start 606 ! +X(R) 607 mode = mode+x'30'+test reg(reg) 608 fault(5) %if last#"" 609 %finish %else %start 610 %if code2=0 %start 611 ! NOT A R OPND 612 %if (global op!absf)=0 %or mode#0 %then %c C mode = mode!x'37' %else mode = mode!x'1F' 614 ! MODE 67 OR MODE 37 IF .ABSOLUTE 615 %finish 616 %finish 617 %finish %else %start 618 ! # TYPE OPERAND 619 code1 = value(opnd) 620 mode = mode+x'17' 621 %finish 622 %finish 623 dump: 624 %if pass=2 %start 625 %if type#4 %start; ! NOT BRANCH TYPE 626 %if type=3 %and mode&x'38'#0 %then fault(7) 627 ! REG OPERATION 628 %if code2=0 %start 629 %if mode&x'37'=x'37' %then code1 = code1-(reloc flag) 630 ! PC INDEXED OPERATION 631 cot(currp) <- code1 632 currp = currp+1; len = len+2 633 %finish 634 %finish %else %start 635 ! DEAL WITH BRANCH 636 %if mode#x'37' %then fault(6) 637 %finish 638 %finish %else %start 639 %if code2=0 %then len = len+2 640 %finish 641 %result = mode 642 %end 643 644 645 %integer %fn test reg(%string (80) reg) 646 %integer n 647 byte integer(addr(reg)) = 6 %if length(reg)>6 648 n = search(reg) 649 %if n<0 %start; fault(7); %result = 0; %finish 650 ! REGISTER NAME NOT KNOWN 651 ! SEARCH SETS UP DES 652 %if des_reg#1 %then fault(7) 653 des_def = des_def!x'80' 654 %result = des_value&7 655 %end 656 657 658 %integer %fn value(%string %name opnd) 659 %integer oc,dec,od,j,pt,b,i,total,opl,ptx 660 %byte %integer minus,t 661 %switch char type(0:11) 662 %switch doper(2:7) 663 %string (6) name 664 %byte %integer %name f 665 code2 = 0 666 minus = 6; pt = 1; total = 0; opl = length(opnd) 667 byteinteger(addr(opnd)+opl+1) = ' ' 668 outer: 669 i = byteinteger(addr(opnd)+pt); pt = pt+1 670 %result = total %if pt>opl+1 671 inner:t = trans(i) 672 ->char type(t) %if t<2 %or t>7 673 !! CHARTYPE(6):%c C ! '+' 675 !! CHARTYPE(5):%c C ! '-' 677 !! CHARTYPE(4):%c C ! '*' 679 !! CHARTYPE(3):%c C ! '&' 681 !! CHARTYPE(2):%c C ! '!' 683 minus = t; ->outer 684 !! 685 chartype(8): ! '.' 686 j = dot&x'FFFF' 687 jt: i = byteinteger(addr(opnd)+pt); pt = pt+1 688 ->addon 689 chartype(10): ! '$' 690 chartype(11): ! NAME SEARCH 691 b = pt-2; f == byteinteger(addr(opnd)+b) 692 %while trans(i)>=9 %cycle 693 i = byteinteger(addr(opnd)+pt); pt = pt+1 694 %repeat 695 f = pt-b-2; name <- string(addr(f)) 696 j = test name(name) 697 ->addon 698 chartype(9): ! SEARCH FOR NUMBER 699 oc = 0; od = 0 700 ptx = pt-1 701 %while '0'<=i %and i<='9' %cycle 702 j = i-'0' 703 %if j>7 %then od = 1 704 i = byteinteger(addr(opnd)+pt); pt = pt+1 705 %repeat 706 %if i#'.' %start 707 %if od=1 %then fault(8) 708 %finish %else %start 709 od = 1 710 %finish 711 i = byteinteger(addr(opnd)+ptx); ptx = ptx+1 712 %while ptxaddon 722 chartype(1): ! '(' 723 b = pt-2; f == byteinteger(addr(opnd)+b) 724 f = opl-b 725 opnd = string(addr(f)) 726 %result = total 727 chartype(0): ! THE REST 728 %if i='''' %start 729 j = byteinteger(addr(opnd)+pt); pt = pt+1 730 ->jt 731 %finish 732 fault(11) 733 %result = total 734 !! 735 addon: 736 ->doper(minus) 737 doper(2):total = total!j; ->last 738 doper(3):total = total&j; ->last 739 doper(4):total = total*j; ->last 740 doper(5):total <- total+((-j)&x'FFFF'); ->last 741 doper(6):total = total+j; ->last 742 doper(7):total = total//j 743 !! 744 last: minus = 6 745 ->inner %unless pt>opl 746 %result = total 747 %end 748 749 750 %integer %fn test name(%string %name name) 751 %string (6) r 752 %integer n 753 r <- name 754 n = newtag(r) 755 n = 0 756 %if des_reg=1 %start 757 ! REGISTER NAME 758 mode = mode!des_value; ! IE MODE 0+ VALUE REGISTER 759 code2 = 1; ! NO EXTRA WORD 760 %finish %else %start 761 %if des_def&x'7F'#0 %start; ! IS DEFINED 762 %if des_reg=5 %start 763 inst == record(addr(instaa(-1))+des_value<<2) 764 n = inst_code 765 %finish %else n = des_value&x'FFFF' 766 %finish %else %start 767 n = -1 768 %if pass=2 %start 769 %if des_reg#2 %then fault(15) %else %start 770 n = des_value; reloc flag = 0; global op = 1 771 des_value = dot+len 772 %finish 773 %finish 774 %finish 775 %finish 776 des_def = des_def!x'80'; ! SET NAME=USED 777 %result = n 778 %end 779 780 781 %routine set def(%integer def,opn) 782 %integer i 783 %if des_def&x'7F'=0 %start 784 ! NAME NOT DEFINED 785 des_value <- opn 786 des_def = des_def!1; ! INDICATE DEFINED 787 des_reg = def; ! SET UP TYPE OF NAME 788 %finish %else %start 789 ! NAME WAS DEFINED BEFORE 790 %if des_value&x'FFFF'#opn&x'FFFF' %start 791 %if def=4 %and pass=2 %then i = 14 %else i = 1 792 fault(i) 793 %finish 794 ! REDEF 795 %finish 796 %end 797 798 799 %routine user def(%string %name opnd) 800 %integer n,m,temp 801 %record (desf) %name des2 802 %if length(oper)>6 %then fault(10) 803 pos = new tag(oper) 804 des2 == des 805 %if opnd->("%").opnd %then m = 1 %else m = 0 806 mode = 0 807 n = value(opnd) 808 des == des2 809 %if code2+m#0 %start 810 ! REGISTER 811 %if m=1 %then des_value = n %else des_value = mode 812 des_reg = 1; des_def = des_def!1 813 %finish %else %start 814 ! NAME 815 set def(3,n) 816 %finish 817 %end 818 819 820 %routine octal(%integer n) 821 %integer i 822 n <- n&x'FFFF' 823 %cycle i = 15,-3,0 824 printsymbol((n>>i)&7+'0') 825 %repeat 826 %end 827 828 829 %routine list line(%integer len) 830 %routine %spec numbers 831 %integer i,l2,t 832 write(lino,4) 833 spaces(3) 834 %if assmf=0 %then octal(dot) %else spaces(6) 835 l2 = len 836 %if len>0 %start 837 i = 0; numbers 838 spaces(5) 839 %finish %else spaces(32) 840 %if timer#0 %start 841 %if l2>0 %start 842 %if timer=1 %then t = time40(cot(curr)) %else t = time03(cot(curr)) 843 printsymbol('('); print(t/100,2,2) 844 printstring(") ") 845 %finish %else spaces(11) 846 %finish 847 printstring(string(addr(lne(0)))) 848 %while len>0 %cycle 849 newline; spaces(14) 850 numbers 851 %repeat 852 newline 853 !! 854 855 856 %routine numbers 857 %integer j 858 %cycle j = i,1,i+2 859 spaces(3) 860 %if len>0 %then octal(cot(curr+j)) %else spaces(6) 861 len = len-2 862 %repeat 863 i = j+1 864 %end 865 %end 866 !! 867 868 869 %integer %fn branch(%integer val,here) 870 %half %integer x 871 %integer y 872 x <- val-(here+2) 873 !! %if MON#0 %start 874 !! PRINTSTRING('BRANCH: X=') 875 !! OCTAL(X) 876 !! PRINTSTRING(' VAL,HERE:') 877 !! OCTAL(VAL) 878 !! SPACE 879 !! OCTAL(HERE); !!%c C NEWLINE 881 !! %finish 882 y <- x&x'FF00' 883 %if y#0 %and y#x'FF00' %start 884 fault(13); x = x'FF' 885 %finish %else x <- x>>1 886 %result = x&x'FF' 887 %end 888 889 890 %integer %fn new tag(%string %name a) 891 %result = hash(a,128+7) 892 %end 893 !! 894 895 896 %integer %fn search(%string %name a) 897 %result = hash(a,7) 898 %end 899 900 901 %integer %fn hash(%string %name ident, %byte %integer flag) 902 !! 903 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 904 !! !! 905 !! NOTE: HASH SETS DES AS A SIDE !! 906 !! EFFECT !! 907 !! !! 908 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 909 !! 910 %own %integer cname=0 911 %integer hashc,f8 912 %short %integer z,a,b,c 913 length(ident) = 6 %if length(ident)>6 914 f8 = flag&8 915 hashg = hashg+1 916 b = 0; c = 0; a = 0 917 string(addr(z)+1) = ident 918 hashc <- ((a+b+c)*length(ident))&2047 919 %while names(hashc)#0 %cycle 920 %if ident=string(addr(letters(names(hashc)))) %start 921 des == record(desap+hashc<<2) 922 %if f8!!des_reg<8 %start 923 %result = hashc 924 %finish 925 !! IE IF F=8 AND AN OPER OR F<8 AND A%c C LABEL ETC 927 %finish 928 hashc = (hashc+1)&2047 929 hashf = hashf+1 930 %repeat 931 %result = -1 %if flag<128; ! SEARCH 932 names(hashc) = letterpt 933 des == record(desap+hashc<<2) 934 des_def = 0; des_reg = 0; des_value = 0 935 string(addr(letters(letterpt))) = ident 936 letterpt = letterpt+length(ident)+1 937 cname = cname+1 938 abandon("TOO MANY NAMES") %if cname>=2047 939 abandon("NAMES TOO LONG") %if letterpt>=10000-10 940 %result = hashc 941 %end 942 943 944 %routine word(%string (80) opnd) 945 %string (60) t 946 opnd = opnd."," 947 currp = curr 948 %until opnd="" %cycle 949 opnd -> t.(",").opnd 950 %if pass=2 %start 951 cot(currp) <- value(t) 952 currp = currp+1 953 %finish 954 len = len+2 955 %repeat 956 sbf = 0; ! WORD ON BYTE BDRY NOT ALLOWED 957 %end 958 959 960 %routine fault(%integer i) 961 %own %string (20) %array flist(1:19)= %c C "NAME REDEFINITION", C "NO .END", C "TOO FEW OPNDS", C "ILLEGAL BYTE INSTR.", C "BRACKETS?", C "TYPE FAULTY", C "ILLEGAL REG. OPER.", C "NOT OCTAL", C "ILLEGAL NAME", C "NAME TOO LONG", C "ILLEGAL EXPR.", C "ILLEGAL NAME", C "OUT OF RANGE", C "PHASE ERROR", C "NAME NOT DEFINED", C "TERMINATOR?", C "TOO BIG", C "ON BYTE BDRY", C "PSEUDO INSTR.?" 981 %string (20) s 982 %if i=10 %then s = "WARNING" %else s = "FAULT" 983 write(lino,4) 984 printstring(" ** ".s." ** ") 985 write(i,2) 986 printstring("(".flist(i).")") 987 faults = faults+1 %unless i=10 988 newline 989 %end 990 991 992 %routine origin 993 %integer i 994 %if assmf=0 %start 995 opnd -> ("=").opnd 996 i = value(opnd) 997 %if code2=1 %start 998 !! UNDEFINED NAME OR REGISTER- NOT%c C ALLOWED 1000 fault(12) 1001 %finish %else %start 1002 bin out 1003 dot <- i 1004 corep <- dot 1005 bsw = 0; obf = 0; ! ALIGN EVEN 1006 %if i&1#0 %start 1007 bsw = 1; sbf = 1; bf = 2 1008 cot(curr) = 0 1009 %finish 1010 %finish 1011 %finish 1012 %end 1013 1014 1015 %integer %fn try name 1016 %integer n,def 1017 %string (6) r 1018 r <- opnd 1019 n = newtag(r) 1020 def = des_def&x'7F' 1021 des_def = des_def!x'80' 1022 %result = def 1023 %end 1024 1025 1026 %routine pseudo eval 1027 %integer i,q 1028 %switch ps(1:23) 1029 %cycle i = 1,1,23; ->exit3 %if oper=pseudo in(i); %repeat 1030 exit3:%if assmf=0 %or i>4 %start 1031 ->ps(i) 1032 ps(19): ! TIME TO BE PRINTED 1033 timer = 1 1034 %return 1035 ps(20): ! 11/03 TIME 1036 timer = 2 1037 %return 1038 ps(23): ; ! ILLEGAL 1039 fault(19) 1040 ->ret 1041 ps(22): ! .DATE 1042 opnd = "/".date."/" 1043 ps(1): ! .ASCII 1044 %if length(opnd)>2 %start 1045 ! SET FLAG UNLESS IN BYTE INSTR. 1046 %if obf=0 %then bsw = 0 %else %start 1047 len = 1 1048 %if obf=2 %then bsw = 1 %else curr = curr-1 1049 ! OBF=2 IS THE .=ODD FLAG 1050 %finish 1051 currp = curr 1052 %cycle i = 2,1,length(opnd)-1 1053 push byte(byte integer(addr(opnd)+i)) 1054 %repeat 1055 bf = bsw; ! NOTE WHETHER ON BDRY OR NOT 1056 %finish 1057 ->ret 1058 ps(2): ! .BYTE 1059 byte(opnd) 1060 ->ret 1061 ps(3): ! .WORD 1062 word(opnd) 1063 ->ret 1064 ps(4): ! .PAGE 1065 newpage %if list<2 %and pass=2 1066 ->ret 1067 ps(5): ! .IFDF 1068 q = 0 1069 ps5: 1070 %if assmf>0 %then assmf = assmf+1 %else %start 1071 %if try name=q %start 1072 assmf = 1 1073 %if list=1 %and pass=2 %start 1074 list line(0) 1075 printstring("***** CONDITIONAL TEXT OMITTED 1076" ") 1077 %finish 1078 %finish 1079 %finish 1080 ->ret 1081 ps(6): ! .IFNDF 1082 q = 1 1083 ->ps5 1084 ps(7): ! .GLOBL 1085 globals 1086 ->ret 1087 ps(8): ! .TITLE 1088 ->ret 1089 ps(9): ! .ABSOLUTE 1090 absf = 1 1091 ->ret 1092 ps(10): ! .END 1093 ps(18): ! .EOT 1094 endflag = 1 1095 %if opnd#"" %then enf <- value(opnd) 1096 ->ps17 1097 ps(11): ! .LIST 1098 list = 0; ->ret 1099 ps(12): ! .NOLIST 1100 list = 2; ->ret 1101 ps(13): ! .MON 1102 mon = 1; ->ret 1103 ps(14): ! .MOFF 1104 mon = 0; ->ret 1105 ps(15): ! .ENDC 1106 %if assmf<=1 %start 1107 assmf = 0 1108 %finish %else assmf = assmf-1 1109 ->ret 1110 ps(16): ! .PLIST (PARTIAL LIST (NOT 1111 ! CONDITIONALS)) 1112 list = 1 1113 ->ret 1114 ps(17): ! .EVEN 1115 ps17: 1116 dot <- (dot+bsw+1)&x'FFFFFFFE' 1117 obf = 0; bsw = 0; ! TO ALIGN LABELS CORRECTLY 1118 %finish 1119 ret: 1120 %end 1121 1122 1123 %routine globals 1124 %integer n 1125 %string (30) s 1126 %if pass=1 %start 1127 opnd = opnd."," 1128 %while opnd->s.(",").opnd %cycle 1129 n = newtag(s) 1130 compiler bug: ! OVER OPTIMISATION OF 'DES' 1131 fault(1) %if des_reg#0 1132 des_reg = 2; ! GLOBAL 1133 des_value = 0 1134 %repeat 1135 %finish 1136 %end 1137 1138 1139 %routine byte(%string %name opnd) 1140 %string (60) t 1141 ! SET FLAG UNLESS LAST OPRN. 1142 %if obf=0 %then bsw = 0 %else %start 1143 len = 1 1144 %if obf=2 %then bsw = 1 %else curr = curr-1 1145 %finish 1146 ! WAS BYTE 1147 currp = curr 1148 opnd = opnd."," 1149 %until opnd="" %cycle 1150 bytef = 2-bsw 1151 opnd -> t.(",").opnd 1152 push byte(value(t)) 1153 %repeat 1154 bytef = 0 1155 bf = bsw; ! REMEMBER ALIGNMENT 1156 %end 1157 1158 1159 %routine push byte(%integer n) 1160 %half %integer %name cpt 1161 n = n&x'FFFF'; ! CUT TO 16 BITS 1162 %if n>x'FF' %then write(n,1) %and fault(17) 1163 n <- n&x'FF' 1164 cpt == cot(currp) 1165 %if bsw=0 %start 1166 cpt = n 1167 %finish %else %start 1168 cpt <- cpt!n<<8; currp = currp+1 1169 %finish 1170 bsw = bsw!!1; len = len+1 1171 %end 1172 1173 1174 %routine abandon(%string (60) s) 1175 select output(0) 1176 printstring(" 1177" ** ABORT ** ".s." ** 1178" ") 1179 endflag = 2; ! INDISCATE ABNORMAL STOP 1180 select output(2) 1181 %end 1182 1183 1184 %routine symbols 1185 %routine %spec list symbol table 1186 %routine %spec check refs 1187 %routine %spec sort names(%integer a,b) 1188 !! 1189 %half %integer %array sorta(0:2048) 1190 !! 1191 check refs 1192 list symbol table 1193 %return 1194 !! 1195 1196 1197 %routine list symbol table 1198 %integer i,cn,pos,j,old end 1199 %string %name s 1200 %string (15) sss 1201 %own %byte %integer %array type(0:5)=' ', 'R', 'G', 'U', 'L', 'S' 1202 %own %byte %integer %array used(0:1)='*', ' ' 1203 old end = endflag; end flag = 0 1204 bin out; len = 0 1205 newpage 1206 printstring(" 1207" SYMBOL TABLE 1208" 1209" SPACE USED ="); write(letterpt,1); printstring(" BYTES 1210" NUMBER OF NAMES =") 1211 write(top,1); printstring(" 1212" HASH GOES ="); print(hashf/hashg+1,1,2); newline 1213 sort names(1,top) 1214 cn = 0 1215 %cycle i = 1,1,top 1216 s == string(addr(letters(sorta(i)))) 1217 pos = search(s) 1218 %if pos>=0 %start 1219 des == record(desap+pos<<2) 1220 %continue %if des_reg=254 1221 printstring(s); spaces(7-length(s)) 1222 printsymbol(type(des_reg)); space 1223 %if des_def&x'7F'#0 %or des_reg=2 %then octal(des_value) %else %c C printstring("UNDFND") 1225 printsymbol(used((des_def&128)>>7)) 1226 cn = cn+1 1227 %if cn#6 %then spaces(6) %else %start 1228 cn = 0; newline 1229 %finish 1230 %if des_reg=2 %start 1231 sss = tostring(length(s)).s 1232 sss = sss.tostring(0) %if length(sss)&1#0 1233 %cycle j = 1,2,length(sss)-1 1234 cot(curr) <- charno(sss,j+1)<<8+charno(sss,j) 1235 curr = curr+1; len = len+2 1236 %repeat 1237 cot(curr) <- des_value 1238 curr = curr+1; len = len+2 1239 dot = (dot+len)&(\1) 1240 bin out; corep = dot; len = 0 1241 %finish 1242 des_reg = 254 1243 %finish 1244 %repeat 1245 cot(curr) = 0; curr = curr+1; len = len+2 1246 dot = (dot+len)&(\2) 1247 bin out; corep = dot; len = 0 1248 endflag = old end 1249 newlines(5) 1250 %end 1251 1252 1253 %routine check refs 1254 %integer i,pt 1255 pt = 1; i = 1 1256 %until pt>=letterpt %cycle 1257 sorta(i) = pt 1258 i = i+1 1259 pt = pt+letters(pt)+1 1260 %repeat 1261 top = i-1 1262 %end 1263 1264 1265 %routine sort names(%integer a,b) 1266 %integer l,u,d 1267 %string (6) x 1268 %return %if a>=b 1269 l = a; u = b; d = sorta(u) 1270 x = string(addr(letters(sorta(u)))) 1271 ->find 1272 !! 1273 up: l = l+1 1274 ->found %if l=u 1275 find: ->up %unless string(addr(letters(sorta(l))))>=x 1276 sorta(u) = sorta(l) 1277 !! 1278 down: u = u-1 1279 ->found %if l=u 1280 ->down %unless string(addr(letters(sorta(u))))<=x 1281 sorta(l) = sorta(u) 1282 ->up 1283 !! 1284 found: sorta(u) = d 1285 sort names(a,l-1) 1286 sort names(u+1,b) 1287 %end 1288 %end 1289 1290 1291 %routine bin out 1292 %integer i,flag 1293 %string (10) st 1294 i = 1 1295 st = ""; flag = 0 1296 cot(0) = corep; ! SET THE START ADDRESS 1297 %if curr>1 %then dump bin(cot,0,curr-1,st,flag) 1298 abandon("BINARY FAULT") %if flag#0 1299 %if endflag#0 %start 1300 st = "END" 1301 cot(0) = enf 1302 dump bin(cot,0,0,st,flag) %unless oper="EOT" 1303 dump bin(cot,-1,200,st,flag) 1304 %finish 1305 currp = 2; curr = 1 1306 %end 1307 1308 1309 %routine report faults 1310 %if faults=0 %start 1311 write(lino,6) 1312 printstring(" statements assembled 1313" ") 1314 %finish %else %start 1315 write(faults,6); printstring(" FAULTS IN PROGRAM 1316" ") 1317 %finish 1318 %end 1319 !! 1320 %routine start pass two(%integer str) 1321 select output(str) 1322 printstring("Pass two"); newline 1323 %end 1324 %end 1325 !! 1326 !! 1327 %end %of %file 1327 LINES ANALYSED SIZE= 42072 ? Warning :- Unsupported precision used - nearest available substituted at line No 15 ? Warning :- Unsupported precision used - nearest available substituted at line No 15 ? Warning :- Name flag not used at line No 34 ? Warning :- Name t not used at line No 34 ? Warning :- Unsupported precision used - nearest available substituted at line No 78 ? Warning :- Unsupported precision used - nearest available substituted at line No 112 ? Warning :- Unsupported precision used - nearest available substituted at line No 114 ? Warning :- Unsupported precision used - nearest available substituted at line No 147 ? Warning :- Unsupported precision used - nearest available substituted at line No 149 ? Warning :- Unsupported precision used - nearest available substituted at line No 160 ? Warning :- Unsupported precision used - nearest available substituted at line No 207 ? Warning :- Unsupported precision used - nearest available substituted at line No 242 ? Warning :- Unsupported precision used - nearest available substituted at line No 277 ? Warning :- Unsupported precision used - nearest available substituted at line No 507 ? Warning :- Name dec not used at line No 747 ? Warning :- Name temp not used at line No 817 ? Warning :- Unsupported precision used - nearest available substituted at line No 870 ? Warning :- Unsupported precision used - nearest available substituted at line No 1160 ? Warning :- Unsupported precision used - nearest available substituted at line No 1189 ? Warning :- Name aslp not used at line No 1324 ? Warning :- Name time45 not used at line No 1324 IBM CODE 24880+ 1360 BYTES GLAP 496+ 18592 BYTES DIAG TABLES 2776 BYTES TOTAL 49152 BYTES 1148 STATEMENTS COMPILED