%externalroutine pass3; !PASS3 FOR PDP11 IMP %externalinteger shortjumps=0 %externalinteger mediumjumps=0 %externalinteger longjumps=0 %externalreal stretch time = 0 %externallongrealfnspec cputime !INFO BITS &1 = NO SHORT JUMPS ! &2 = NO JUMPS ROUND JUMPS ! &4 = NO DEFERAL OF JUMPS ! &8 = NO TAILORED ENTRY ! OBJECT FILE FORMAT ! ! +============================+ ! ! NUMBER OF DEFINITIONS ! ! +----------------------------+ ! ! ! ! ! DEFINITIONS ! ! ! ADDR<2> TYPE<1> "TEXT" ! ! ! ! ! +----------------------------+ ! ! NUMBER OF REFERENCES ! ! +----------------------------+ ! ! ! ! ! REFERENCES ! ! ! TYPE<1> "TEXT" ! ! ! ! ! +============================+ ! ! CODE SIZE ! ! +----------------------------+ ! ! GLA SIZE ! ! +----------------------------+ ! ! ! ! ! OBJECT ! ! ! ! ! +----------------------------+ ! ! X'E0E0E0' ! ! +============================+ ! %constinteger max defs = 1600 %constinteger max tags = 1800 %constinteger max externals = 100 %constinteger objects = 1 %constinteger directives = 2 %constinteger object file = 3 !OBJECT FILE CONTROL CODES %constinteger abs code = 1 %constinteger abs gla = 2 %constinteger plug code = 3 %constinteger plug gla = 4 %constinteger set loc = 5 %constinteger line no = 6 %constinteger ext reloc = 7 %constinteger terminator= 8 ! MOD CODE = 9 ! MOD GLA = 10 ! MOD REL = 11 %recordformat tfm(%integer ca, tag, flags, %record(?)%name link) !NOTIMP80 %RECORDSPEC TFM_LINK(TFM) %recordformat pfm(%integer ca, frame, flags, param) %recordformat deffm(%integer ca, uses, %record(?)%name link) !NOTIMP80 %RECORDSPEC DEFFM_LINK(DEFFM) %ownrecord(tfm) null; null_ca = -1 %constinteger long jump bit = 128 %constinteger load ds = 256 %constinteger load lnb = 512 %constinteger marked = 1024 %constinteger ignore = 2048 %constinteger invert = 4096 %constinteger fixed = 8192 %constinteger cond bit = 32 %integer current line %integer ca, ga %owninteger max ca = 0 %owninteger last event = 0 %owninteger total ca = 0 %integer gla limit %owninteger tags = 0 %owninteger top tag = max tags %ownstring(10) text %string(10) %array xtext(1:max externals) %byteintegerarray xtype(1:max externals) %integerarray xaddr(1:max externals) %owninteger xrefs %integer j, mask %integer pregs %integer mod, flags %constbyteintegerarray inverted(0:19) = %c 9,2,1,6,5,4,3,8,7,0, 19,12,11,16,15,14,13,18,17,10 %record(deffm)%array def(0:max defs) %record(tfm)%array tag(0:max tags+1) ! gla limit = 0 pregs = 0 ! %routine fail(%string(63) message, %integer n) selectoutput(0) printstring("*** PASS3 FAILS: ") printstring(message) write(n, 1) %if current line # 0 %start printstring(" AT LINE"); write(current line, 1) %finish newline %monitor; %stop %end %routine get text %integer l, j, s text = "" readch(l) %cycle j=1, 1, l readch(s) text = text.tostring(s) %if j <= 10 %repeat %end %routine get(%integername n) %integer s, sh readch(s); readch(sh) sh = s<<8+sh sh = sh!x'FFFF0000' %if sh&x'00008000' # 0 n = sh; !TEMP TO PROPAGATE SIGN %end %routine put(%integer n) printch(n&255); printch(n>>8) %end %routine dump(%integer code, value) printch(code); put(value) %end %routine cdump(%integer code, value) printch(code); put(value) ca = ca+2 %end %routine gdump(%integer code, value) printch(code); put(value) ga = ga+2 %end %routine short jump(%integer disp) %integer n %constinteger nop = k'000240' ! %CONSTINTEGERARRAY BR(0:19) = 8_000400,; !0: BR ! 8_001400,; !1: BEQ ! 8_001000,; !2: BNE ! 8_003000,; !3: BGT ! 8_002000,; !4: BGE ! 8_000000,; !5: BLT ! 8_003400,; !6: BLE ! 8_103400,; !7: BCS (TRUE) ! 8_103000,; !8: BCC (FALSE) ! 8_000000,; !9: NOP ! 8_000400,; !10: BR ! 8_001400,; !11: BEQ ! 8_001000,; !12: BNE ! 8_101000,; !13: BHI ! 8_103000,; !14: BHIS ! 8_103400,; !15: BLO ! 8_101400,; !16: BLOS ! 8_103400,; !17: BCS (TRUE) ! 8_103000,; !18: BCC (FALSE) ! 8_000240 ; !19: NOP %constintegerarray br(0:19) = x'100', x'300',x'200',x'600',x'400',x'500',x'700',x'8700',x'8600', x'00',x'100',x'300',x'200',x'8200',x'8600', x'8700',x'8300',x'8700',x'8600',x'00' n = br(mask&31) %if n = 0 %then n = nop %else n = n+disp&255 cdump(abs code, n) shortjumps = shortjumps+1 %end %routine long jump(%integer dest) %if mask # 0 %start mask = inverted(mask&31) %if mask = 0 %start cdump(abs code, k'000240') %return %finish short jump(2) shortjumps = shortjumps-1 mediumjumps = mediumjumps-1 longjumps = longjumps+1 %finish medium jumps = medium jumps+1 cdump(abs code, x'77'); cdump(abs code, dest-ca-2) ;! 8_000167 %end %routine process header(%integer dummy, level, %record(?)%name proc) !DUMMY = 0 TO INHIBIT CODE DUMPING (FIRST TIME) !NOTIMP80 %RECORDSPEC PROC(PFM) %integer p, disp, d, flags %routine dump(%integer value) %if dummy = 0 %thenc mod = mod+2 %elsec cdump(abs code, value) %end flags = proc_flags %if flags&( \(3<<5) ) # 0 %start dump(x'1126') ;! 8_010446 dump(x'1166') %if flags&load ds # 0 ;! 8_010546 %if proc_param # 0 %start dump(x'E5CE'); dump(proc_param) ;! 8_162716 %finishelsestart dump(x'1055') %if flags&(2<<5) # 0; ! 8_010125 dump(x'1015') %if flags&(3<<5) # 0 ;! 8_010025 %finish p = 5; disp = 6; d = b'10000' %until disp < 0 %cycle %if flags&d # 0 %start %if p = level %start %if disp = 0 %start dump(k'010515') %finishelsestart dump(k'010565') dump(disp) %finish %finishelsestart %if disp = 0 %start dump(x'130D') %if level # 1 ;! 8_011415 %finish %else %start dump(x'1D35') ;! 8_016465 dump(disp); dump(disp) %finish %finish %finish disp = disp-2 p = p-1 d = d>>1 %repeat dump(x'1144') ;! 8_010504 dump(x'65C5'); dump(proc_frame) ;! 8_062705 %finish %end %integerfn new proc(%integer proc id, level); !RETURNS USE MASK %record(tfm)%name proc %record(tfm)%name t, last t %record(deffm)%name f %record(deffm)%name def list; def list == null %integer r, code, n, fix %integer proc size %integer frame, events %integer inner uses, uses %integer modified %switch d(1:8) %routine adjust labels(%integer here, new) %record(deffm)%name d d == def list %cycle %return %if d_ca <= here d_ca = d_ca+new d == d_link %repeat %end %routine mark tags !LABEL LIST IN DECREASING ORDER OF CA !THE LABEL LIST IS REVERSED %record(deffm)%name l, n %record(tfm)%name t t == proc_link; !HEAD OF REF LIST l == def list; def list == null %cycle %return %if addr(l) = addr(null); !END OF LABELS n == l_link l_link == def list def list == l %cycle %exit %if addr(t) = addr(null) t_flags = t_flags&(\marked) %if t_ca >= l_ca %start t_flags = t_flags!marked %exit %finish t == t_link %repeat l == n %repeat %end %routine remove unused labels !LABEL LIST IS IN INCREASING ORDER OF CA !AND IS REVERSED %record(deffm)%name n, next n == def list def list == null %while addr(n) # addr(null) %cycle next == n_link %if n_uses # 0 %start n_link == def list def list == n %finish n == next %repeat %end %routine simplify jumps !LABEL LIST IN ANY ORDER %record(tfm)%name this, next %integer mod mod=0 next == proc_link; %return %if addr(next) = addr(null) %cycle this == next next == next_link; %return %if addr(next) = addr(null) next_ca = next_ca+mod %if next_flags&(marked!ignore!fixed) = 0 %andc this_ca+2 = next_ca %andc next_tag # 0 %and next_flags&cond bit = 0 %start %if def(this_tag)_ca = this_ca+4 %start proc size = proc size-2 mod = mod-2; modified = 1 this_flags = this_flags&(\31)!inverted(this_flags&31) %if this_flags&cond bit = 0 %start this_flags = this_flags!long jump bit %finish this_flags = this_flags!invert def(this_tag)_uses = def(this_tag)_uses-1 this_tag = next_tag next_flags = ignore!marked adjust labels(next_ca, -2) next == next_link; this_link == next %exit %if addr(next) = addr(null) next_ca = next_ca+mod %finish %finish %repeat %end %routine defer jumps !LABEL LIST IN INCREASING ORDER OF CA %integer mod, n %record(deffm)%name d, l, last %record(deffm) head %record(tfm)%name t t == proc_link; head_link == def list %cycle mod = 0 last == head %until addr(last) = addr(null) %cycle l == last_link %exit %if addr(l) = addr(null) %cycle %return %if addr(t) = addr(null) %exit %if t_ca > l_ca %if t_ca = l_ca %and t_flags&cond bit = 0 %andc t_tag # 0 %start d == def(t_tag) n = d_ca %if n # l_ca %start mod = 1; modified = 1 l_ca = n last_link == l_link l_link == d_link d_link == l def list == head_link %finish %exit %finish t == t_link %repeat last == last_link %repeat %return %if mod = 0 %repeat %end %routine expand(%record(?)%name proc) %real time !NOTIMP80 %RECORDSPEC PROC(TFM) %integer disp, here, new, mask %integer modx, returns %integer display, level bit %record(deffm)%name d %record(tfm)%name t, tag head %record(pfm)%name procp %integer paramx time = cputime procp==proc flags = 0; mod = 0; returns = 0 paramx = pregs>>2 !CALCULATE SIZE OF ENTRY & EXIT CODE SEQUENCES level bit = 1<< (level-1) mask = (-1)<< (level) display = (inner uses!(uses&(\level bit)))&(\mask) !LNB DOES NOT NEED TO BE SAVED IF IT IS ONLY USED LOCALLY inner uses = (inner uses!uses)&(\mask) ! events condition added to fix bug by M.T. %if EVENTS#0 %OR inner uses # 0 %or paramx # 0 %start; !NEEDS A DISPLAY flags = display!load lnb!(pregs&3)<<5 flags = flags!load ds %if pregs # 0 returns = 4; !EXTRA CODE PER RETURN %finish tag head == proc_link procp_frame = frame proc_flags = flags procp_param = paramx process header(0, level, proc) modx = mod proc size = proc size+mod+2 !STRETCH JUMPS %until mod=0 %cycle mod = 0 t == tag head %while addr(t) # addr(null) %cycle here = t_ca+mod; t_ca = here %if t_tag = 0 %start; !RETURN %if returns # 0 %start mod = mod+returns adjust labels(here, returns) %finish %finishelsestart %if t_flags&long jump bit = 0 %start; !STILL SHORT disp = def(t_tag)_ca disp = disp-here-2 %unless -k'400' <= disp <= k'376' %start t_flags = t_flags!long jump bit new = 2 new = 4 %if t_flags&cond bit # 0; !CONDITIONAL mod = mod+new adjust labels(here, new) %finish %finish %finish t == t_link %repeat returns = 0 proc size = proc size+mod %repeat proc size = proc size+6 %if events # 0 proc size = (proc size+2)&(\2); !UP TO A MULTIPLE OF 4 total ca = total ca+proc size !SPACE FOR EVENT LINK (+ROUND TO *4) proc_ca = ca def(proc id)_ca = ca modx = modx+ca; !BIAS FOR HEADER !ALLOCATE THE LABELS d == def list %while addr(d) # addr(null) %cycle d_ca = d_ca+modx d == d_link %repeat ca = ca+proc size stretchtime = stretchtime+(cputime-time) %end %routine get tag(%integer index) tags = tags+1 fail("TOO MANY JUMPS", tags) %if tags > top tag fail("TAG OVERFLOW", index) %if index > max defs t == tag(tags) get(t_ca) t_tag = index last t_link == t last t == t t_link == null %end fail("PROC OVERFLOW", proc id) %if proc id > max defs proc == tag(top tag) top tag = top tag-1 fail("TOO MANY TAGS", top tag) %if toptagd(code) %if 0 < code <= 8 fail("ILLEGAL DIRECTIVE", code) d(1): !PROC HEAD get(n) inner uses = inner uses!new proc(n, level+1) ->outd d(2): !PROC END get(proc size); !SIZE OF PROC (BASIC) get(frame); !STATIC FRAME SIZE get(events); !EVENTS get(uses); !BASE REG USAGE get(pregs); !PARAMS IN REGS %result = 0 %if proc id = 0 %until modified=0 %cycle modified = 0 remove unused labels; !LABELS <<<< defer jumps mark tags; !LABELS >>>> simplify jumps %repeat expand(proc); !STRETCH JUMPS %result = inner uses d(3): !LABEL DEFINITION get(r); !TAG %if r < 0 %start; !SWITCH LABEL f == def(-r) f_uses = f_uses+1; !IT HAS A HIDDEN USE fix = fixed %finishelsestart fail("TAG OVERFLOW", r) %if r > max defs f == def(r) %finish f_link == def list; def list == f get(f_ca) ->outd d(4): !LABEL REFERENCE get(r) get tag(r) readch(t_flags) t_flags = t_flags!fix; fix = 0 def(r)_uses = def(r)_uses+1 ->outd d(8): get(r) def(r)_uses = 255 ->outd d(5): !RETURN get tag(0) t_flags = 0 ->outd d(6): !LOAD DATA readch(r); get(n); get text xrefs = xrefs+1 fail("TOO MANY EXTERNALS", xrefs) %if xrefs > max externals xtext(xrefs) = text xtype(xrefs) = r xaddr(xrefs) = n ->outd d(7): !SPEC USED get(n) xtype(n) = xtype(n)!8; !SHOW USED outd: %repeat %end %routine process load data !TYPE BITS: &1 : 0=PROC, 1=DATA ! &2 : DEFINITION ! &4 : REFERENCE (SPEC) ! &8 : USED (SPEC) %integer j, type %integer defs %integer refs %routine plant(%integer mask) %string%name s %integer type, j, n %return %if xrefs = 0 %cycle j = 1, 1, xrefs type = xtype(j) %if type&mask # 0 %start put(xaddr(j)) %if mask = 2; !DEFINITION printch(type&7) s == xtext(j) printch(length(s)) %cycle n=1,1,length(s) printch(charno(s, n)) %repeat %finish %repeat %end !CALCULATE AREA SIZES defs = 0 refs = 0 %if xrefs # 0 %start %cycle j = 1, 1, xrefs type = xtype(j) %if type&2 # 0 %start; !DEFINITION defs = defs+1 xaddr(j) = def(xaddr(j))_ca %if type&1 = 0; !PROC DEF %finish %elsestart %if type&8 # 0 %start; !SPEC refs = refs+1 xaddr(j) = refs %finish %finish %repeat %finish put(1); !ONE MODULE put(defs); plant(2) put(refs); plant(8) %end %routine dump proc(%integer level) %switch y(1:16) %integer code, index, d, disp, n %integer events, ep, from %integer old ca %record(tfm)%name proc, t old ca = ca proc == tag(top tag); top tag = top tag-1 ca = proc_ca dump(set loc, ca) process header(1, level, proc) %cycle readch(code) ->y(code) %if 0 < code <= 16 fail("ILLEGAL OBJECT CODE", code) y(1): !PROC HEAD get(index) dump proc(level+1) dump(set loc, ca) ->outy y(2): !PROC END get(events); get(ep); get(from) %if level # 1 %start %if (ca&2 = 0 %and events=0) %or (ca&2#0 %and events#0) %start cdump(abs code, 0); !ALIGN IT %finish %if events # 0 %start cdump(abs code, events) printch(9); cdump(abs code, def(from)_ca) printch(9); cdump(abs code, def(-ep)_ca) %finish n = (ca-last event)<<1 last event = ca n = n!1 %if events # 0 n = n!2 %if proc_flags # 0 n = n!4 %if proc_flags&load ds # 0 cdump(abs code, n) %finish max ca = max ca+ca-proc_ca ca = old ca %return y(9): !RETURN tags = tags+1 %if proc_flags # 0 %start %if proc_flags&load ds # 0 %start cdump(abs code, x'1585'); !*MOV_(SP)+,DS 8_012605 %finishelsestart cdump(abs code, x'1105'); !*MOV_LNB,DS 8_010405 %finish cdump(abs code, x'1584'); !*MOV_(SP)+,LNB 8_012604 %finish ->outy y(7): !JUMP tags = tags+1; t == tag(tags) get(index); readch(mask) ->outy %if t_flags&ignore # 0 %if t_flags&invert # 0 %start index = t_tag mask = t_flags&31 %finishelsestart fail("MISMATCH", index) %if t_tag # index %finish d = def(index)_ca disp = d-ca-2 %if -k'400' <= disp <= k'376' %thenc short jump(disp//2) %c %else long jump(d) ->outy y(3): !ABSOLUTE CODE get(n); cdump(abs code, n); ->outy y(8): !LABEL CODE get(n); cdump(abs code, def(n)_ca); ->outy y(4): !ABSOLUTE GLA get(n) gdump(abs gla, n) ->outy y(6): !MODIFY GLA get(index); get(n) dump(plug gla, def(index)_ca); put(n) ->outy y(11): !MOD CODE y(12): !MOD GLA y(13): !MOD REL printch(code-2); ->outy y(14): !MOD EXT get(index); dump(ext reloc, xaddr(index)); ->outy y(15): ;! MCODE BRANCH y(16): ;! MCODE SOB get(n) ; get(index) d=def(index)_ca disp=(d-ca-2)//2 %if code=15 %start fail("BRANCH LENGTH",disp) %unless -k'200'<=disp<=k'177' n=n!disp&255 %finishelsestart fail("FORWARD SOB",disp) %if disp>0 disp=-disp fail("SOB LENGTH",disp) %if disp>63 n=n!disp %finish cdump(abscode,n) ->outy y(10): !LINE FLAG get(current line) dump(lineno, current line) outy: %repeat %end current line = 0 %cycle j=0,1,maxdefs def(j) = 0 %repeat tag(0) = 0; tag(max tags+1) = 0 selectoutput(object file) selectinput(directives) ca = 0; total ca = 0; j = new proc(0, 1); get(gla limit) process load data selectinput(objects) put(total ca); put(gla limit) top tag = max tags tags = 0 ca = 0; ga = 0; last event = -2 dump proc(1) dump(terminator, last event) printch(x'E0'); put(x'E0E0') fail("STRETCH ERROR", max ca-total ca) %if max ca # total ca selectoutput(0) printstring("Code"); write(max ca, 1) printstring(" glap"); write(ga, 1) printstring(": total ="); write(max ca+ga, 1) printstring(" bytes"); newline %end %endoffile