!! 28-JAN-81 ! ************************************************************** ! * * ! * PERKIN-ELMER 32-BIT SERIES IMP COMPILER * ! * INTERMEDIATE CODE ASSEMBLER * ! * * ! * (GENERAL SERVICE VERSION) * ! * * ! * C.H. WHITFIELD * ! * 19, REDFORD TERRACE * ! * COLINTON, * ! * EDINBURGH EH13-0BT * ! * * ! * COPYRIGHT (c) MAY 1ST. 1980 * ! * ALL RIGHTS RESERVED * ! * * ! ************************************************************** ! Pass 3 for 7/32 Imp ! =========== ! N.B. All loader-visible addresses generated by pass2 are in units ! of halfwords. ! =========== ! ****Compatibility header: to disappear with old-format EXE files %constinteger h8 = 8 ! %begin !!%include "Sysinc:Com.inc" {Include file for compiler communication} %recordformat impcomfm(%integer statements, flags, code, gla, diags, perm, %string(31) file, %string(63) Option) %externalrecord(impcomfm)%spec IMPCOM !%endoffile %constinteger direct=1, object=2 %constinteger report=0 ! N.B. <0 for diagnostic tracing, >0 for extra details of dumped code %constinteger diagnostic = 0 %constinteger register template = x'7DEF'; ! wsp, code, gla, link %constinteger max tag=2050 %constinteger max ref=2900 %constinteger max proc=255 %constinteger bmax = 8; ! no. of DA buffers available to phase 2 %constinteger safe pc rel = 6500; ! 'SAFE' limit in stretch routines q.v. ! Parameters related to diagnostic table generation %constinteger indirect = x'4000' %constinteger line diag limit = 31 %constinteger proc header=1, diag entry=0, linkage name=-1; ! 'descriptions' %constinteger none = 0, partial = 1, full = 2 %owninteger diags = full, hide = 0 %constinteger main prog = x'4000'; ! main program marker in event chain %conststring(3) main ep = "%GO"; ! must match pass 2 %conststring(6) trace ep = "$TRACE"; ! likewise %constinteger init lit = 4; ! halfwords: must not exceed pass 2 value !******** %constshortinteger max prim = 52 %constshortintegerarray prim(1:1018) = %c x'026F',x'0215',x'0224',x'0035',x'0064',x'0087',x'00D7',x'015A',x'00C1', x'0232',x'029A',x'0160',x'02B3',x'02C7',x'02E7',x'030A',x'01C5',x'01F5', x'01AB',x'0335',x'02AA',x'0294',x'028E',x'0278',x'0288',x'0315',x'0188', x'0194',x'02A2',x'0051',x'0251',x'0265',x'0244',x'019E',x'03AF',x'03CD', x'03DC',x'03EC',x'0000',x'0000',x'0000',x'0000',x'0000',x'0000',x'0000', x'0000',x'0000',x'0000',x'039C',x'03A3',x'0338',x'033F',x'001B',x'480F', x'0000',x'2133',x'3402',x'9400',x'9300',x'D331',x'0000',x'C530',x'0080', x'2138',x'D431',x'0001',x'2135',x'2408',x'2411',x'8883',x'0034',x'0503', x'2385',x'2401',x'2417',x'8883',x'0034',x'26F2',x'8888',x'001E',x'0012', x'0512',x'033F',x'D331',x'0000',x'9433',x'3443',x'F830',x'FF00',x'0001', x'D301',x'4400',x'0000',x'D202',x'4400',x'0000',x'0A43',x'2087',x'030F', x'0022',x'480F',x'0000',x'2133',x'3402',x'9400',x'9300',x'D331',x'0000', x'C530',x'0080',x'2138',x'D431',x'0001',x'2135',x'2408',x'2411',x'8883', x'0034',x'2440',x'0503',x'2383',x'0830',x'2304',x'D301',x'4400',x'0000', x'D202',x'4400',x'0000',x'2641',x'2731',x'2218',x'430F',x'0002',x'0039', x'480F',x'0000',x'2133',x'3402',x'9400',x'9300',x'D331',x'0000',x'C530', x'0080',x'2138',x'D431',x'0001',x'2135',x'2408',x'2411',x'8883',x'0034', x'D342',x'0000',x'C540',x'0080',x'2134',x'D442',x'0001',x'223B',x'0A43', x'C540',x'0100',x'2185',x'2401',x'2413',x'8883',x'0034',x'0B04',x'2315', x'2401',x'2417',x'8883',x'0034',x'D242',x'0000',x'0B43',x'0A42',x'2450', x'2308',x'D301',x'4500',x'0001',x'D204',x'4500',x'0001',x'2651',x'2731', x'2218',x'430F',x'0002',x'0015',x'2441',x'D331',x'0000',x'D302',x'0000', x'0B30',x'231B',x'0A03',x'2309',x'D351',x'4400',x'0000',x'D452',x'4400', x'0000',x'023F',x'2641',x'2701',x'2219',x'0833',x'030F',x'0082',x'735F', x'0000',x'9465',x'1058',x'2133',x'3452',x'9455',x'9355',x'1068',x'2133', x'3464',x'9466',x'9366',x'D0B7',x'0000',x'D3B3',x'0000',x'C5B0',x'0080', x'2134',x'D4B3',x'0001',x'2339',x'D301',x'0000',x'C500',x'0080',x'2138', x'D401',x'0001',x'2135',x'2408',x'2411',x'8883',x'0034',x'0BB0',x'4210', x'80A8',x'24C0',x'0800',x'4330',x'8038',x'D301',x'0001',x'D403',x'4C00', x'0001',x'2339',x'26C1',x'05BC',x'2286',x'4300',x'808A',x'D301',x'0001', x'2207',x'08E3',x'0AEC',x'D3D1',x'0000',x'27D1',x'D30E',x'4D00',x'0001', x'D401',x'4D00',x'0001',x'203E',x'27D1',x'2028',x'0822',x'2334',x'055C', x'4280',x'8062',x'08DC',x'0844',x'233A',x'D301',x'0000',x'0AC0',x'D3E3', x'0000',x'0BEC',x'056E',x'4280',x'804A',x'0822',x'233C',x'D2D2',x'0000', x'2307',x'D303',x'4D00',x'0001',x'D202',x'4D00',x'0001',x'27D1',x'2217', x'0844',x'4330',x'801C',x'D2E4',x'0000',x'0AC3',x'24D0',x'2308',x'D30C', x'4D00',x'0001',x'D204',x'4D00',x'0001',x'26D1',x'27E1',x'2218',x'2501', x'D1B7',x'0000',x'430F',x'0002',x'2400',x'2205',x'D1B7',x'0000',x'2401', x'2417',x'8883',x'0034',x'0005',x'023F',x'2407',x'2410',x'8883',x'0034', x'0027',x'D301',x'0000',x'C500',x'0080',x'2138',x'D401',x'0001',x'2135', x'2408',x'2411',x'8883',x'0034',x'0822',x'2326',x'0503',x'2184',x'CB32', x'FFFF',x'2316',x'0843',x'2405',x'2414',x'8883',x'0034',x'0A21',x'C817', x'0000',x'D231',x'0000',x'2307',x'D302',x'4300',x'0000',x'D201',x'4300', x'0001',x'2731',x'2217',x'030F',x'000B',x'1132',x'2307',x'5801',x'4300', x'0000',x'5002',x'4300',x'0000',x'2734',x'2217',x'030F',x'0009',x'1132', x'2400',x'2304',x'5002',x'4300',x'0000',x'2734',x'2214',x'030F',x'000C', x'0B44',x'D301',x'4400',x'0000',x'D402',x'4400',x'0000',x'023F',x'2641', x'0543',x'2039',x'030F',x'0019',x'0831',x'4932',x'0002',x'212C',x'4B32', x'0000',x'2119',x'0A33',x'7333',x'4200',x'0004',x'2339',x'0A33',x'0A3E', x'0303',x'0821',x'2406',x'2413',x'8883',x'0034',x'0821',x'2408',x'2412', x'8883',x'0034',x'002F',x'D097',x'0000',x'2431',x'2410',x'489F',x'0000', x'08B4',x'48AF',x'0002',x'58CB',x'0008',x'5BCB',x'0004',x'26C1',x'4210', x'8030',x'50CB',x'0000',x'1C0C',x'5B1B',x'0004',x'1C2C',x'26BC',x'2791', x'203F',x'50AB',x'0000',x'1C0A',x'1C2A',x'2633',x'C430',x'FFFC',x'48CF', x'0000',x'50C4',x'0000',x'D197',x'0000',x'430F',x'0004',x'084B',x'D197', x'0000',x'2405',x'2413',x'8883',x'0034',x'001F',x'0807',x'0A03',x'590D', x'0000',x'2325',x'2402',x'2411',x'8883',x'0034',x'0A71',x'5072',x'0000', x'5042',x'0004',x'2628',x'0870',x'580E',x'000C',x'F500',x'8080',x'8080', x'023F',x'2450',x'0B53',x'033F',x'5007',x'4500',x'0000',x'2654',x'2034', x'030F',x'000E',x'0822',x'2315',x'2405',x'2412',x'8883',x'0034',x'2401', x'2411',x'2302',x'1C03',x'2721',x'2212',x'8888',x'0015',x'000D',x'2401', x'2F00',x'0801',x'2316',x'2D02',x'2820',x'2400',x'CB01',x'0001',x'033F', x'2C02',x'2701',x'2203',x'8010',x'2802',x'2114',x'6A00',x'8010',x'2305', x'6B00',x'800A',x'6A20',x'800A',x'2800',x'2B20',x'030F',x'4600',x'0000', x'4110',x'0000',x'0000',x'800C',x'2822',x'2114',x'6A20',x'800C',x'2303', x'6B20',x'8006',x'2E12',x'030F',x'0000',x'4080',x'0000',x'0013',x'480F', x'0000',x'2133',x'3401',x'9400',x'9300',x'0822',x'2328',x'0502',x'2186', x'E611',x'4200',x'0000',x'430F',x'0002',x'2406',x'2415',x'8883',x'0034', x'0009',x'581D',x'0000',x'CB17',x'0200',x'031F',x'2402',x'2411',x'8883', x'0034',x'0008',x'023F',x'2408',x'2411',x'8883',x'0034',x'0000',x'8080', x'8080',x'000F',x'0822',x'233A',x'0B10',x'0801',x'EE00',x'001F',x'1D02', x'0811',x'2113',x'0800',x'033F',x'2405',x'2411',x'8883',x'0034',x'0005', x'033F',x'2404',x'2412',x'8883',x'0034',x'0005',x'033F',x'2401',x'2415', x'8883',x'0034',x'0005',x'034F',x'2401',x'2415',x'8883',x'0034',x'0007', x'D401',x'0000',x'038F',x'2401',x'2417',x'8883',x'0034',x'0007',x'C320', x'FFE0',x'033F',x'2405',x'2416',x'8883',x'0034',x'0008',x'0800',x'033F', x'2601',x'033F',x'2401',x'2411',x'8883',x'0034',x'0013',x'5823',x'0004', x'5912',x'0004',x'2119',x'5912',x'0008',x'2126',x'5C02',x'000C',x'5A13', x'0000',x'030F',x'0842',x'0821',x'2406',x'2412',x'8883',x'0034',x'001F', x'5843',x'0004',x'5914',x'0004',x'4210',x'8028',x'5914',x'0008',x'4220', x'8020',x'5C04',x'000C',x'5924',x'0010',x'211A',x'5924',x'0014',x'2127', x'0A12',x'5C04',x'0018',x'5A13',x'0000',x'030F',x'0812',x'264C',x'0821', x'2406',x'2412',x'8883',x'0034',x'0022',x'5853',x'0004',x'5845',x'0000', x'2741',x'1142',x'0A42',x'0801',x'2410',x'2744',x'5905',x'0004',x'4210', x'801C',x'5905',x'0008',x'212C',x'0A10',x'5C05',x'000C',x'265C',x'5804', x'0000',x'0542',x'228F',x'5A13',x'0000',x'030F',x'0845',x'0820',x'2406', x'2412',x'8883',x'0034',x'000A',x'5843',x'0004',x'5C04',x'000C',x'0A12', x'5C04',x'0018',x'5A13',x'0000',x'030F',x'001F',x'0847',x'484F',x'0000', x'732F',x'0002',x'1122',x'0B42',x'0A27',x'583D',x'0000',x'C532',x'0200', x'2385',x'2402',x'2411',x'8883',x'0034',x'26F4',x'0872',x'F830',x'8080', x'8080',x'553E',x'000C',x'023F',x'5037',x'4400',x'0000',x'2644',x'2224', x'030F',x'0002',x'8883',x'0034',x'0006',x'D007',x'002C',x'0867',x'CA70', x'006C',x'8102',x'005C',x'D007',x'002C',x'584D',x'0008',x'2337',x'5004', x'0000',x'5014',x'0004',x'5024',x'0008',x'C8A7',x'0040',x'0810',x'2441', x'ED41',x'0000',x'0813',x'4120',x'805C',x'0855',x'2315',x'083F',x'0813', x'4120',x'8050',x'4826',x'0002',x'9352',x'1152',x'585A',x'45FF',x'FFEC', x'0822',x'4210',x'8022',x'7316',x'0008',x'0A11',x'0A1E',x'0931',x'232C', x'4816',x'0004',x'0414',x'2338',x'D17A',x'0008',x'7316',x'0006',x'0A11', x'0A1E',x'0301',x'C320',x'4000',x'2138',x'5835',x'0028',x'58E5',x'0024', x'08A5',x'4300',x'FFB0',x'D107',x'002C',x'8101',x'736E',x'40FF',x'FFFE', x'0A66',x'0B1E',x'7306',x'4E00',x'0000',x'0A00',x'0856',x'0B50',x'0916', x'2123',x'0915',x'2128',x'0865',x'221B',x'D107',x'002C',x'2400',x'241F', x'8101',x'0855',x'0212',x'0A6E',x'0302',x'0006',x'583D',x'0004',x'08C8', x'0183',x'088C',x'030F',x'000B',x'486F',x'0000',x'26F2',x'085F',x'D057', x'0000',x'D1DD',x'8887',x'082F',x'08F5',x'0302',x'001D',x'2400',x'C830', x'001C',x'5841',x'4300',x'0000',x'5852',x'4300',x'0000',x'0865',x'0464', x'0964',x'2333',x'C600',x'0001',x'0965',x'2333',x'C600',x'0002',x'2734', x'4310',x'FFDA',x'2460',x'450F',x'0000',x'2132',x'2461',x'430F',x'0002', x'000E',x'C830',x'001C',x'5801',x'4300',x'0000',x'5602',x'4300',x'0000', x'5001',x'4300',x'0000',x'2734',x'221A',x'030F',x'000F',x'C830',x'001C', x'2501',x'5702',x'4300',x'0000',x'5401',x'4300',x'0000',x'5001',x'4300', x'0000',x'2734',x'221B',x'030F',x'000E',x'C830',x'001C',x'5801',x'4300', x'0000',x'5402',x'4300',x'0000',x'5001',x'4300',x'0000',x'2734',x'221A', x'030F' !******** ! ==== control codes ==== %constinteger tag defn = 1 %constinteger r ref = 2 %constinteger p ref = 3 %constinteger sw ref = 4 %constinteger j ref = 5 %constinteger c ref = 6 %constinteger code item = 7 %constinteger gla item = 8 %constinteger line diag = 9 %constinteger line reset = 10 %constinteger var diag = 11 %constinteger code area = 12 %constinteger lit area = 13 %constinteger lit org = 14 %constinteger frame patch = 15 %constinteger proc head = 16 %constinteger proc end = 17 %constinteger prog end = 18 %constinteger code rel = 19 %constinteger gla rel = 20 %constinteger extern = 21 ! external reference sub-types %constinteger data spec = 4, data defn = 5 %constinteger ep spec = 6, ep defn = 7 ! ======== constants associated with code generation ======== %constinteger align=3; ! single word alignment (literal area) %constinteger emark = x'8880', tmark = x'8887' %constinteger backwards = X'0100'; ! short jump modifier %constinteger code base = 14; ! code base register %constinteger BZ = X'433E', BZS = X'2330' %constinteger BNZ = X'423E', BNZS = X'2130' %constinteger BM = X'421E', BMS = X'2110' %constinteger BP = X'422E', BPS = X'2120' %constinteger BNP = X'432E', BNPS = X'2320' %constinteger BNM = X'431E', BNMS = X'2310' %constinteger JMP = X'430E', JMPS = X'2300' %constinteger BAL = X'410E' %constshortintegerarray short jump(0:12) = BZS, BNZS, BMS, BPS, BNPS, BNMS, BNZS, BZS, BPS, BMS, BNMS, BNPS, JMPS %constshortintegerarray long jump(0:12) = BZ, BNZ, BM, BP, BNP, BNM, BNZ, BZ, BP, BM, BNM, BNP, JMP ! == flag bits used in 'REF' table == %constinteger short=1 %constinteger long=2 %constinteger pc rel=4 %constinteger very=8 %constinteger invert=16 %constinteger remove=32 %constinteger rcall=64 %constinteger safe=128 %constinteger conditional=256 ! == values used in code generation phase ( reftype(k)=0 -> 'REMOVE' ) == %constinteger sf=1 %constinteger rx1=2 %constinteger rx2=3 %constinteger rx3=4 %constinteger sign bit = x'80000000' %constinteger halfword sign = x'FFFF8000' ! ** Purely for accumulating jump instruction statistics %owninteger sfjump=0, rx1jump=0, rx2jump=0, rx13jump=0 ! ** For accumulating counts in various bits of program %owninteger localtot=0,localnonsafe=0, globaltot=0,globalnonsafe=0 %owninteger buff miss1=0, buff miss2=0, buff miss3=0 ! ** for recording timings %integer t0,t1,t2; ! phase 1, phase 2 timing %integer t10, t11, t12; ! local, global stretch timing (inside phase 1) %recordformat reffm(%shortinteger tag, link, flags, ca) %recordformat deffm(%record(deffm)%name link, %shortinteger proc,ca) %recordformat procfm(%record(procfm)%name link, %record(reffm)%name ref list, %record(deffm)%name def list, %shortinteger base, ca, static frame, event mask, display reg, event start, event finish, ld base, ld size, vd base, vd size, Me) %record(procfm)%array proc(1:max proc) %record(deffm)%array tagdef(1:max tag) %byteintegerarray reftype(1:max ref) %owninteger refs = 0 %constrecord(*)%name null == (0) %record(procfm)%name proc1, last proc; ! ** N.B. proc1 ultimately is prim ** %shortintegerarray prim entry(1:max prim) %integer header size, gla size, code size, literal size %integer var diags, line diags %owninteger defns = 0, specs = 0, relocations = 0 %integer current line, line incr, ca incr %integer j,k,l tagdef(j) = 0 %for j = 1,1,max tag prim entry(j) = -1 %for j = 1,1,max prim proc1 == proc(1); proc1 = 0 last proc == proc1 %routine phex(%shortinteger n) %integer j,k %for j = 12,-4,0 %cycle k = (n>>j)&15 %if k < 10 %then k = k+'0' %else k = k-10+'A' print symbol(k) %repeat %end %routine error(%integer n,p) select output(report) print string("*ERROR"); write(n,1) print symbol(':'); write(p,4) newline %signal 15,15 %end %routine get(%integername n) %integer j,k read symbol(j); read symbol(K) n = j<<8 ! k %end %routine phase one; ! Input directives and expand jumps %record(reffm)%array ref(1:max ref) %record(procfm)%name pp, qq %integer procs; procs = 0 %integer ca total; ca total = 0 %integer extra, n %integer j %routine input directives %owninteger depth = 0 %owninteger code = 0, n = 0, ca = 0 %record(reffm)%name r %record(deffm)%name d, dd %record(procfm)%name p %integer last ref, this proc, last line %switch dir(1:extern) depth = depth+1 procs = procs+1 this proc = procs; p == proc(procs); p = 0 P_Me = This proc p_ld size = diags; ! FRIG: 0 = none, 1 = partial, 2 full ! 0 + ( ( line org + ( link )? )? p_vd size = 0 %if diags > none %start; ! p_vd size set = zero above p_vd size = 4; ! procedure identifier p_vd size = 5 %if diags = full; ! link required as well %finish last line = current line; ! ??????? last ref = 0; r == null %cycle read symbol(code) -> dir(code) %if 0 < code <= extern !!dir(*): error(0,code) dir(proc head): ! read symbol(n); error(1,n) %unless n = procs input directives %continue dir(proc end): ! ! get(ca) get(n) p_vd size = p_vd size + n %if diags = full; ! header+local idents get(n); p_static frame <- n p_display reg = next symbol; skip symbol; ! avoid any limited 'read symbol' get(n); p_event mask <- n get(n); p_event start = n; ! tag no get(n); p_event finish = n; ! tag no depth = depth-1; %return %if depth = 0 p_ca = ca+2; ! size + basic event header p_ca = p_ca+3 %if p_event mask # 0; ! full form required ca total = ca total + ca ! *** reverse reference list - should grow it forwards *** %if %not r == null %start n = last ref; last ref = 0 %while n # 0 %cycle r == ref(n) k = r_link; r_link = last ref last ref = n n = k %repeat %finish p_ref list == r last proc_link == p; last proc == p %return dir(tag defn): ! *N.B. switch defns. have x'8000' bit set* get(j); get(ca) n = j&x'7FFF'; ! mask out 'switch' bit error(3,n) %unless 0 < n <= max tag d == tag def(n) %if %not d_link == null %start; ! already defined error(4,n) %if j&x'8000' = 0; ! not a switch tag so it's an error ! remove existing entry so it can be redefined %if %not p_def list == d %start dd == p_def list dd == dd_link %while %not dd_link == d dd_link == d_link %else p_def list == d_link %finish %finish d_proc = this proc; d_ca = ca d_link == p_def list p_def list == d %continue dir(r ref): ! code = r call + long; -> ref ref dir(j ref): code = short; -> ref ref dir(c ref): code = short + conditional ref ref: get(n); get(ca) error(5,n) %unless 0 < n <= max tag error(6,n) %if refs = max ref refs = refs+1 r == ref(refs) r_link = last ref; last ref = refs r_tag = n r_ca = ca r_flags = code %continue dir(sw ref): ! * * * IGNORED * * * get(n); get(ca) %continue dir(p ref): ! get(n); get(ca) prim entry(n) = -2 %continue dir(line reset): get(n); current line = n-1 dir(line diag): current line = current line+1 %if diags = full %start p_ld size = p_ld size + 1 p_ld size = p_ld size + 1 %unless %c 0 <= current line-last line <= line diag limit %finish last line = current line %continue %repeat %end; ! input directives %routine set prim(%integer n) %integer a,j,k,base,to error(9,n) %unless 0 < n <= max prim %return %if prim entry(n) >= 0 base = proc1_ca; ! current size of prim package j = prim(n); ! entry to pointer table k = prim(j); ! size of this prim routine %if k&x'8000' # 0 %start; ! routine to be full-word aligned base = (base+1)&(\1) %finish k = k & x'7FFF'; ! strip 'align' bit prim entry(n) = base proc1_ca = base + k*(2//2); ! halfwords to = j+k; ! N.B. j+1:to inclusive %while j # to %cycle j = j+1; a = prim(j)&x'FFFF' %if a&x'FFF0' = emark %and a # tmark %start j = j+1; a = prim(j) set prim(a) %if prim entry(a) < 0 %finish %repeat %end; ! set prim %routine local stretch(%record(procfm)%name p) %record(deffm)%name d,dd %record(reffm)%name r %integer j,n,mod %return %if p_ref list == null; ! no references !! %cycle n = 0; mod = 0 r == p_ref list %cycle local tot = local tot+1; ! *** monitoring only *** r_ca = r_ca + mod %if r_flags&(long!rcall!safe) = 0 %start local nonsafe = local nonsafe+1; ! *** monitoring only *** d == tagdef(r_tag) j = r_ca %unless j-30//2 <= d_ca <= j+30//2 %start n = 1; mod = mod + (2//2) p_ca = p_ca + (2//2) r_flags = r_flags ! long %if j+2-16384//2 <= d_ca <= j+2+16384//2-1 %start r_flags = r_flags ! pc rel r_flags = r_flags ! safe %if |(j-d_ca)| <= safe pc rel %finish dd == p_def list %cycle %exit %if dd == null %or dd_ca <= r_ca dd_ca = dd_ca+(2//2) dd == dd_link %repeat %finish %finish %exit %if r_link = 0 r == ref(r_link) %repeat %exit %if n = 0 %repeat %end; ! local stretch %routine global stretch(%record(procfm)%name p, %integername extra) %record(procfm)%name pp %record(deffm)%name d,dd %record(reffm)%name r %integer j,k,x,n,mod,me extra = 0 %and %return %if p_ref list == null x = 0 %cycle n = 0; mod = 0 r == p_ref list; Me = P_Me %cycle global tot = global tot+1; ! *** monitoring only *** r_ca = r_ca + mod %if r_flags&(safe!very) = 0 %start global nonsafe = global nonsafe+1; ! *** monitoring only *** d == tagdef(r_tag) j = p_base + r_ca ! ****** This wants cleaning up ****** %if D_Proc # Me %or R_Flags&rcall # 0 %start k = proc(d_proc)_base + d_ca %if j+2-16384//2 <= k <= j+2+16384//2-1 %start r_flags = r_flags ! pc rel r_flags = r_flags ! safe %if |(j-k)| <= safe pc rel -> NEXT %if R_Flags&Long # 0 %finish %else k = p_base + d_ca %finish -> NEXT %if j-30//2 <= k <= j+30//2; ! short form adequate %if r_flags&long = 0 %start r_flags = r_flags ! long %if j+2-16384//2 <= k <= j+2+16384//2-1 %start r_flags = r_flags ! pc rel r_flags = r_flags ! safe %if |(j-k)| <= safe pc rel %finish %else %if (r_flags & pc rel = 0 %and %not 0 <= k <= 16383//2) %c %or (r_flags & pc rel # 0 %c %and %not j+2-16384//2 <= k <= j+2+16384//2-1) %if 0 <= k <= 16383//2 %start r_flags = r_flags & (\pc rel) -> NEXT %finish r_flags = r_flags ! very %else -> NEXT %finish !************************************ n = 1; x = x+(2//2); mod = mod+(2//2) p_ca = p_ca + (2//2) dd == p_def list %cycle %exit %if dd_ca <= r_ca dd_ca = dd_ca + (2//2) dd == dd_link %repeat pp == p %cycle pp == pp_link; %exit %if pp == null pp_base = pp_base+(2//2) %repeat %finish NEXT: %exit %if r_link = 0 r == ref(r_link) %repeat %exit %if n = 0 %repeat extra = x %end; ! global stretch %routine condense %constbyteintegerarray m(0:15) = SF, SF, ! 0 1 RX1, RX1, ! 2 3 RX2, RX2, RX2, RX2, ! 4 5 6 7 RX3, RX3, RX3, RX3, RX3, RX3, RX3, RX3 ! 8 9 10 11 12 13 14 15 %integer j,f %for j = 1,1,refs %cycle f = ref(j)_flags %if f&remove # 0 %start reftype(j) = 0 %else reftype(j) = m(f&15) ! ( f & (invert+rcall) ) %finish %repeat %if diagnostic < 0 %start %for j = 1,1,refs %cycle %if (j-1)&15 = 0 %start newline; write(j,-4); print string(": ") %finish write(reftype(j),2) %repeat newlines(2) %finish %end; ! condense ! === for diagnostics only === %routine dump tags %integer k %integerfn tagno(%record(deffm)%name d) %integer k %for k = 1,1,max tag %cycle %result = k %if tagdef(k) == d %repeat %signal 15,15 %end %routine dump proc(%integer n) %record(procfm)%name p %record(deffm)%Name d %integer k; k = 0 p == proc(n) print string(" base"); write(p_base,1) print string(" size"); write(p_ca,1) newline d == p_deflist %while %not d == null %cycle write(tagno(d),3); print symbol(':') write(d_ca,0) k = k+1 newline %if k&7 = 0 d == d_link %repeat newline %if k&7 # 0 %end %for k = 1,1,procs %cycle newline; print string("proc"); write(k,1) dump proc(k) %repeat %end; ! dump tags select input(direct) current line = 0 input directives last proc_link == null readsymbol(j) error(-1, j) %unless j = prog end ! read next six halfwords defining various sizes for last block: ! !===== size in halfwords get(code size); get(literal size); get(gla size) !===== no. of items get(defns); get(specs); get(relocations) error(8,ca total) %if code size # ca total %for j = 1,1,max prim %cycle set prim(j) %if prim entry(j) = -2 %repeat proc1_ca = proc1_ca+2; !event marker+link dump tags %if diagnostic < 0 t10 = cpu time; ! *** monitoring only *** ! Initial stretching and block allocation ! no diags in perm == proc1 !!! proc1_ld size = 0 !!! proc1_vd size = 0 pp == proc1 %cycle qq == pp_link; %exit %if qq == null local stretch(qq) qq_base = qq_base + pp_base + pp_ca qq_ld base = pp_ld base + pp_ld size qq_vd base = pp_vd base + pp_vd size pp == qq %repeat dump tags %if diagnostic < 0 t11 = cpu time; ! *** monitoring only *** ! Routine calls and final stretch %cycle n = 0 pp == proc1 %cycle pp == pp_link; %exit %if pp == null global stretch(pp,extra) %if extra # 0 %start n = n+1 pp_ca = pp_ca + extra qq == pp %cycle qq == qq_link; %exit %if qq == null qq_base = qq_base + extra %repeat %finish %repeat %exit %if n = 0 %repeat dump tags %if diagnostic < 0 t12 = cputime; ! *** monitoring only *** condense; ! from ref(k)_flags -> reftype(k) line diags = last proc_ld base + last proc_ld size var diags = last proc_vd base + last proc_vd size code size = last proc_base + last proc_ca %end; ! phase one %routine phase two ! generate final object file using 'tag defn' and 'ref type' tables %recordformat bfm(%record(bfm)%name link, %integer block, %c %shortintegerarray b(0:255)) %recordformat sfm(%integer zero addr, lower, upper, ca) %record(sfm) code, gla, ldiag, vdiag, reloc, defn, spec %constinteger bmax = 8; ! no. of da buffers (at least 2 !!) %record(bfm)%array buffpool(1:bmax) %record(bfm)%name buff list, bp %recordformat hdfm(%shortinteger p1,p2) %recordformat headerfm(%shortinteger pure size,gla size, code disp, %c lit disp, registers, main ep, %c %record(hdfm) reloc, defn, spec, ldiag, vdiag) %record(headerfm) header; %constinteger basic header=18; ! ** halfwords ** ! formats associated with external linkage %recordformat namefm(%shortinteger n1a,n1b,n2a,n2b) %recordformat xdeffm(%record(namefm) n, %integer ep) %recordformat specfm(%integer code, gla, link) %recordformat descriptionfm(%integer base,disp,type,size,form,otype, %c data size, %shortinteger ident len, %string(12) sym) %record(descriptionfm) xd %integer this proc; this proc = 0 %integer total blocks %integer op, cond, tag, extra %integer ref; ref = 0 %integer event link, ldiag link, vdiag link, defn link, spec link, asynch link %integer trace patch = 0; ! point in perm to patch in jump to $TRACE %integer j,k,l ! =================== SYSTEM DEPENDENT ===================== %recordformat parmfm(%shortinteger dsno,dact,ssno,sact, %c %integer p1,p2,p3,p4,p5,p6) %owninteger da key = 0 %constinteger da read = 9, da write = 10 %routine open da(%string(31)%name fd, %integer blocks) %record(parmfm) p,q string(addr(p_sact)) = fd; svc(17,p); ! pack %if p_p2 < 0 %start print string(fd."?"); newline %stop %finish q = p p_dact = 14; svc(20,p); ! delete p = q; p_p5 = blocks p_dact = 2; svc(20,p); ! create %if p_p6 >= 0 %start p = q p_p5 = 1; !permit write p_dact = 6; svc(20,p); ! open da da key = p_p5 %and %return %if p_p6 >= 0 %finish print string("open da: ".string(addr(p_p1))); newline %stop %end %routine close da %record(parmfm) p p_p5 = da key p_dact = 11; svc(20,p) da key = 0 %return %if p_p6 >= 0 print string("close da: ".string(addr(p_p1))); newline %stop %end %routine block io(%record(bfm)%name block, %integer iofn) %record(parmfm) p p_p4 = addr(block_b(0)) p_p5 = da key p_p6 = block_block; ! block number req'd p_dact = iofn; svc(20,p) %return %if p_p6 >= 0 print string("block io: ".string(addr(p_p1))); write(block_block,1) newline %signal 15,15 %end ! ========================================================== ! Initialise buffer pool buff list == null %for j = 1,1,bmax %cycle bp == buff list buff list == buffpool(j) buff list_block = -1; buff list_link == bp %repeat ! Initialise control records %routine set section(%record(sfm)%name sect, %integer sect size, %c %record(hdfm)%name hd) sect_zero addr = header size; header size = header size + sect size sect_lower = 0 sect_upper = sect size sect_ca = 0 hd_p1 = sect_zero addr; hd_p2 = 0 %end; ! set section header size = basic header defns = defns*(3*2); ! 3 fullwords each specs = specs*(2*2); ! 2 fullwords each relocations = relocations*((2//2)); ! 1 halfword each literal size = (literal size + 3)&(\3); ! double word align code size = code size + proc1_ca; ! allow for prim ! N.B. == defn and spec are fullword aligned in output file == set section(defn,defns,header_defn) set section(spec,specs,header_spec) set section(reloc,relocations,header_reloc) set section(ldiag,line diags,header_ldiag) set section(vdiag,var diags,header_vdiag) header size = (header size+3)&(\3); ! align literals + code code_zero addr = header size + literal size code_lower = -literal size code_upper = code size code_ca = 0 gla_zero addr = (code_zero addr + code size + h8 + 255)&(\255); ! block align gla_lower = 0 gla_upper = gla size gla_ca = 0 header_registers = register template header_main ep = -1; ! default: reset if a main program header_code disp = code_zero addr; ! within-file disp. header_lit disp = header size; ! within-file disp. header_pure size = code_zero addr + code size header_gla size = gla size total blocks = (gla_zero addr + gla size + 255) >> 8 header_reloc_p2 = relocations; ! no. of halfwords header_defn_p2 = defns %record(bfm)%map buff(%integer addr) %record(bfm)%name this,last %integer block block = addr>>8; ! ** N.B. halfword addressing units, 512 byte block ** %result == buff list %if block = buff list_block buff miss1 = buff miss1+1; ! *** monitoring only *** %if diagnostic < 0 %start printstring("block"); write(block,1); newline %finish last == buff list %cycle buff miss3 = buff miss3+1; ! *** monitoring only *** this == last_link -> promote %if this_block = block %exit %if this_link == null last == this %repeat %if this_block < 0 %start; ! buffer still free this_block = block %else block io(this,da write) this_block = block block io(this,da read) buff miss2 = buff miss2+1; ! *** monitoring only *** %finish promote: last_link == this_link this_link == buff list buff list == this %result == buff list %end; ! of 'buff' %routine flush buffers %record(bfm)%name this %integer k this == buff(0) %if h8 # 0 %start this_b(0) = (header_pure size + h8 + 255)//256 this_b(1) = (header_gla size + 255)//256 this_b(2) = x'4321'; ! new format identifier this_b(3) = 0; this_b(4) = 0; this_b(5) = 0 this_b(6) = 0; ! flags this_b(7) = 0; ! stack %finish %for k = 0,1,basic header-1 %cycle this_b(k+h8) = short integer(addr(header)+k*2) %repeat this == buff list %cycle block io(this,da write) %if this_block >= 0 this == this_link %exit %if this == null %repeat %end; ! flush buffers %routine origin(%record(sfm)%name section, %integer org) %if diagnostic < 0 %start %if diagnostic <= -2 %start print string("ORG:"); write(org,1) write(section_lower,6); write(section_upper,1) newline %finish %finish section_ca = org %and %return %if section_lower <= org <= section_upper error(25,org) %end %routine put(%record(sfm)%name section, %shortinteger item) %record(bfm)%name bp %integer addr %owninteger last = -1 addr = section_zero addr + section_ca addr = addr + h8 %unless section == gla %if diagnostic < 0 %start %if diagnostic < -2 %start; ! two-stage test for speed newline %if addr # last+1 last = addr write(addr,4); print string(": "); phex(item) newline %finish %finish bp == buff(addr) bp_b(addr&255) = item section_ca = section_ca + 1 %end; ! of 'put' %routine put name(%record(sfm)%name sect) %integer j; %shortinteger half %integerfn ch(%integer sym) %result = sym-'A'+1 %if 'A' <= sym <= 'Z' %result = sym-'a'+1 %if 'a' <= sym <= 'z'; ! ** lower case alphabet ** %result = sym-'0'+27 %if '0' <= sym <= '9' %result = sym-'#'+37 %if '#' <= sym <= '%'; ! 37='#', 38='$', 39='%' %result = 0 %if sym = ' ' %result = -1 %end; ! ch %routine pack3(%integer k, %shortintegername n) %integer p,q,r p = charno(xd_sym,k); q = charno(xd_sym,k+1); r = charno(xd_sym,k+2) n <- ( (ch(p)*40 + ch(q))*40 + ch(r) ); ! ugh!!! %end; ! pack3 charno(xd_sym,j) = ' ' %for j = length(xd_sym)+1,1,xd_ident len %for j = 1,3,xd_identlen-2 %cycle pack3(j,half); put(sect,half) %repeat %end; ! put name %routine set description(%integer desc type) %integer sym,j,k,l, char read symbol(k) l = k; l = 12 %if l > 12 length(xd_sym) = l %for j = 1,1,l %cycle readsymbol(char) char = char - 'a' + 'A' %if %c 'a' <= char <= 'z' charno(xd_sym,j) = char %repeat k = k-l skip symbol %and k = k-1 %while k > 0 xd_ident len = 12; ! assume full 12-character ident. %return %if desc type = proc header; ! only ident. present xd_identlen = 6 %if l <= 6 %and desc type = diag entry read symbol(xd_otype) read symbol(k) xd_type = k>>4; xd_form = k&15 read symbol(j); get(k) xd_base = j>>4 xd_disp = (j&15)<<16 + (k&x'FFFF') %if diagnostic < 0 %start print string(xd_sym.": "); write(xd_identlen,1) write(xd_base,1); write(xd_disp,4) write(xd_type,3); write(xd_form,1); write(xd_otype,1) newline %finish %end; ! set description %routine insert prims %integer j,k,l,m,to %for j = 1,1,max prim %cycle k = prim entry(j) %if k >= 0 %start %if diagnostic < 0 %start print string("prim"); write(j,1); print symbol(' '); phex(k) newline %finish origin(code,proc1_base + prim entry(j)) k = prim(j) to = k + prim(k) & x'7FFF'; ! strip 'align' bit %while k # to %cycle k = k+1; m = prim(k)&x'FFFF' %if m&x'FFF0' # emark %start put(code,m) %else %if m = tmark; ! trace routine external call trace patch = code_ca put(code,m) %else %if m&15 = 8 %start put(code, jmp) %else put(code, bal + (m&15)<<4) %finish k = k+1; m = prim(k) l = prim entry(m); ! pointer to referenced routine error(15,j) %if l < 0 put(code,(proc1_base+l)*2); ! byte displacement %finish %repeat %finish %repeat asynch link = prim entry(max prim); ! *** must be last entry in perms *** %end; ! 'insert prims' %routine plant code ref %integer j,k,l,t,there %record(deffm)%name d %switch format(SF:RX3) ref = ref+1; t = reftype(ref) d == tagdef(tag) there = proc(d_proc)_base + d_ca + extra cond = cond+6 %if t&invert # 0 op = long jump(cond) %if t&rcall = 0 -> format(t&7) format(SF): ! short format sfjump = sfjump+1 l = 0; k = there-code_ca; ! halfword disp. req'd here %if k < 0 %start l = backwards; k = -k %finish error(200,code_ca) %if k > 15; ! error in reference table put(code,(short jump(cond) !! l) + k) %return format(RX1): rx1jump = rx1jump+1 format(RX3): rx13jump = rx13jump+1 k = (there - proc1_base)*2; ! byte disp. from code base put(code, op) %if t&7 = RX3 %start put(code, x'4000'!((k>>16)&15)) %else error(201,code_ca) %unless 0 <= k <= 16383 %finish put(code,k&x'FFFF') %return format(RX2): rx2jump = rx2jump+1 k = (there - (code_ca+4//2))*2 error(202,code_ca) %unless -16384 <= k <= 16383 put(code, op&(\15)) put(code,halfword sign ! k) %end; ! 'plant code ref' %routine dump code %owninteger depth = 0 %integer last line, last ca %integer code reset %owninteger lit reset; ! no recursion!! - literals are not exbedded %owninteger last spec = 0, gla skip = 0 %record(procfm)%name p %integer cca, lca, vca %integer k,c,half %switch dir(1:extern) depth = depth+1 this proc = this proc+1 p == proc(this proc) origin(code,p_base); origin(ldiag,p_ldbase); origin(vdiag,p_vdbase) last ca = code_ca; last line = 0 %if this proc # 1 %start; ! its a recursive call ! DIAGS: dump procedure line origin and identifier get(last line); set description(proc header) %if diags # none %start k = last line k = 0 %if hide # 0 put(ldiag,k); put name(vdiag) %finish %else; ! initial (non-recursive) call %if diags # none %start xd_sym = "PERM"; xd_identlen = 12 put(ldiag,0); put name(vdiag) %finish insert prims origin(code,proc1_base+proc1_ca-2) put(code,code_ca - event link); ! link round perm event link = code_ca - 1 put(code,x'8000'); ! dummy event mask %finish %cycle read symbol(c) -> dir(c) %if 0 < c <= extern !!dir(*): error(12,c) dir(proc head): read symbol(k); error(13,k) %unless k = this proc cca = code_ca; lca = ldiag_ca; vca = vdiag_ca dump code origin(code,cca); origin(ldiag,lca); origin(vdiag,vca) %continue dir(proc end): depth = depth-1 %if depth # 0 %start; !not in perm ! dump event chain put(code,code_ca-event link); ! here relative link to preceding block event link = code_ca-1 %if p_event mask = 0 %start put(code,p_display reg ! halfword sign) %else put(code,p_display reg) put(code,p_event mask) put(code,tagdef(p_event start)_ca + p_base) put(code,tagdef(p_event finish)_ca + p_base) %finish %finish ! dump line diag. table link !!!!!!!!!! last line = -line diag limit-1 %if diagnostic < 0 %start write(ldiag_ca,1) write(p_ldbase,1); write(p_ldsize,1); newline %finish %if diags = full %start %if depth = 0 %start; !special for perm put(ldiag, proc1_ldsize) put(vdiag, proc1_vdsize) %else put(ldiag, ldiag_ca-ldiag link); ! relative to here ldiag link = ldiag_ca - 1 put(vdiag, vdiag_ca-vdiag link); ! ... ditto ... vdiag link = vdiag_ca - 1 %finish k = p_ld base + p_ld size; put(ldiag,0) %while ldiag_ca # k; ! zero %finish %return dir(code area): lit reset = code_ca code_ca = code reset %continue dir(lit area): code reset = code_ca code_ca = lit reset %continue dir(lit org): get(half) lit reset = -half %continue dir(code item): get(half) put(code,half) %continue dir(gla item): get(half) gla skip = gla skip-1 %and %continue %if gla skip # 0 put(gla,half) %continue dir(gla rel): ! Assumed to immediately follow the dumping of the GLA full-word to ! which it refers. put(reloc,gla_ca-2); ! N.B. -2 halfwords = -4 bytes %continue dir(code rel): ! As for GLA REL but modifies a word in gla according to the value of ! code base at load time put(reloc,(gla_ca-2)+1); ! N.B ** odd-numbered halfword => code seg ** %continue dir(frame patch): origin(code,code_ca-1) put(code,p_static frame); ! bytes if TRUSTED else fullwords %continue dir(c ref): dir(j ref): ! jumps skip symbol; ! 'code item' get(half) cond = half&15; tag = half>>4 extra = 0; ! to match r ref path!! plant code ref %continue dir(r ref): ! procedure calls (including %begin-%end blocks) get(tag) skip symbol; ! 'code item' get(op) skip symbol; ! 'code item' get(extra) cond = 0 plant code ref %continue dir(p ref): ! prim call skip symbol; ! 'code item' get(op) skip symbol; ! 'code item' get(k) error(15,k) %unless 0 < k <= max prim put(code,op) put(code,prim entry(k)*2 ); ! byte disp. %continue dir(sw ref): skip symbol; ! 'code item' get(tag) k = tag def(tag)_ca; k = k + p_base %if k # 0 put(code,k); ! N.B. halfwords relative to code base %continue dir(line reset): get(half) current line = half-1; ! * see below * dir(line diag): current line = current line + 1 %if diagnostic < 0 %start print string("line"); write(current line,1); write(code_ca,1) newline %finish ca incr = code_ca - last ca %continue %if ca incr = 0 line incr = current line - last line %unless 0 <= line incr <= line diag limit %start put(ldiag, (current line-1) ! halfword sign ) %if diags = full line incr = 1 %finish put(ldiag, ca incr*(line diag limit+1) + line incr) %if diags = full last line = current line last ca = code_ca %continue dir(var diag): set description(diag entry) %if diags = full %start k = ((xd_type&7)<<4 + xd_base&15)<<4 + (xd_disp>>16) k = k!halfword sign %if xd_identlen # 12; ! ...%if a short ident k = k!indirect %if xd_form = 2; ! %name variable k = k!x'2000' %if xd_type&8 # 0 put(vdiag,k); put(vdiag,xd_disp&x'FFFF') put name(vdiag) %finish %continue dir(extern): ! <=== word 1 =====> <======== word 2 ======> <== word 3 => ! ------------------ ------------ ----------- ------------- ! Proc spec: | link to previous | identifier : self-link | x'00000000' | ! ------------------ ------------ ----------- ------------- ! ------------------ ------------ ----------- ------------- ! Data spec | link to previous | identifier : ????????? | x'80000000' | ! ------------------ ------------ ----------- ------------- read symbol(c); ! type of cross reference get(xd_data size) set description(linkage name) gla skip = 0 %if c = ep defn %or c = data defn %start k = xd_disp %if c = ep defn %start k = code_ca %if xd_sym = main ep %start p_display reg = p_display reg ! main prog header_main ep = k %finish %finish put(defn, defn link); defn link = header_defn_p1 + defn_ca-1; ! file relative put(defn, k) put name(defn) %else %if c = ep spec %or c = data spec %if trace patch # 0 %and xd_sym = trace ep %start c = code_ca origin(code,trace patch) put(code,gla_ca*2); !halfwords note. origin(code,c) %finish k = header_spec_p1 + spec_ca; ! file relative put name(spec) put(gla,spec link>>16); put(gla,spec link); ! gla relative back link spec link = gla_ca - 2 put(gla,k) put(gla,gla_ca-3); ! halfword disp. of this block into GLA %if c = data spec %start put(gla, -1); put(gla, -1) %else put(gla, 0); put(gla, 0) %finish gla skip = 6; ! half words %else error(170,c) %finish %continue %repeat %end; ! of 'dump code' select input(object) open da(IMPCOM_file,total blocks) !!!! read symbol(j); put(gla,x'7FFF') %for j = 1,1,j; ! init gla ! Dual standard meantime for first words in gla read symbol(j); put(gla,x'7FFF') %for j = 1,1,j-2 put(gla,0); put(gla,0) read symbol(j); error(17,j) %if j < init lit; ! pass2 INIT LIT value current line = 0 event link = -1 ldiag link = proc1_ldsize-1 vdiag link = proc1_vdsize-1 defn link = 0 spec link = 0 dump code readsymbol(j) error(-2,j) %unless j = prog end origin(code,-init lit); ! = -4: must always dump the exact number put(code,0); ! *** padding *** put(code,asynch link); ! signal relative to code base put(code,header_code disp); ! code base addr - file start addr put(code,event link) %if diags # full %start; ! no links embedded in tables!!! %if diags = partial %start header_ldiag_p1 = header_ldiag_p1 ! halfword sign ldiag link = this proc*(2//2); ! halfword size: for use below vdiag link = this proc*8//2; ! ditto %else; ! 'none' header_ldiag_p1 = 0; ! no diag tables present %finish %finish header_ldiag_p2 = ldiag link; ! ldiag_p1+ldiag_p2 => start of chain header_vdiag_p2 = vdiag link header_spec_p2 = spec link; ! GLA relative header_defn_p2 = defn link; ! N.B. FILE relative flush buffers close da %end; ! phase two !======================================================================== diags = (IMPCOM_flags >> 8)&7; ! * * * * SYSTEM DEPENDENT * * * * hide = IMPCOM_flags&x'0800' !======================================================================== select output(report) t0 = cpu time; ! *** monitoring only *** diags = full %if diags > full phase one t1 = cpu time; ! *** monitoring only *** phase two t2 = cpu time; ! *** monitoring only *** IMPCOM_code = (code size+literal size-proc1_ca)*2 IMPCOM_perm = proc1_ca*2 IMPCOM_gla = gla size*2 IMPCOM_diags = (line diags+var diags)*2 ! print string("Jumps:") ! write(sfjump,1); print string(" SF +") ! write(rx1jump,1); print string(" RX1 +") ! write(rx2jump,1); print string(" RX2 +") ! write(rx13jump-rx1jump,1); print string(" RX3 =") ! write(sfjump+rx2jump+rx13jump,1) ! newline; print string("Diagnostic Tables (bytes):") ! print string(" line"); write(line diags*2,1) ! print string(", ident"); write(var diags*2,1) ! newlines(2) ! print string("Millisecs: phase1 "); write(t1-t0,1) ! print string(" phase2"); write(t2-t1,1) ! newline ! %if local tot # 0 %and global tot # 0 %start ! print string("Stretching - safe/total (%) local:") ! write( (local tot-local nonsafe)*100//local tot, 4) ! print string(" global:") ! write( (global tot-global nonsafe)*100//global tot,4) ! newline ! %finish ! spaces(15) ! print string("millisecs:"); write(t11-t10,14); write(t12-t11,13) ! newline ! print string("Total output (halfwords):") ! write(code size+literal size+gla size+var diags+line diags, 1) ! newline ! print string("Disc buffer: searches"); write(buff miss1,1) ! print string(" cache misses"); write(buff miss2,1) ! newline ! print string("Mean search length="); print(buff miss3/buff miss1,1,2) ! newline %endofprogram