<> <> <> <> <<>> DIRECTORY CD, CDBasics, CDRects, CDSatellites, CDSimpleRules, CDTexts, CMosB, CMosBObjects, Core, CoreClasses, CoreGeometry, CoreOps, CoreProperties, DP, IO, Lists, PW, RefTab, Rope, RopeList, Sisyph, SourceFromLayout, SymTab, TerminalIO; DPMux: CEDAR PROGRAM IMPORTS CDBasics, CDRects, CDSatellites, CDSimpleRules, CDTexts, CMosB, CMosBObjects, CoreGeometry, CoreOps, CoreProperties, DP, IO, Lists, PW, RefTab, Rope, RopeList, Sisyph, SourceFromLayout, SymTab, TerminalIO EXPORTS DP = BEGIN Signal: SIGNAL = CODE; textScale: INT _ 2; font: CDTexts.CDFont _ CDTexts.MakeFont["Xerox/TiogaFonts/Helvetica7", textScale]; dwText: CD.Object _ CDTexts.Create["driveWeak", font]; Vdd: DP.ROPE _ "Vdd"; Gnd: DP.ROPE _ "Gnd"; plus: DP.ROPE _ "+"; minus: DP.ROPE _ "-"; log: IO.STREAM _ TerminalIO.TOS[]; lambda: INT _ DP.lambda; pwrW: INT _ DP.pwrW; metW: INT _ DP.metW; met2W: INT _ DP.met2W; polW: INT _ DP.polW; difW: INT _ DP.difW; topTail: INT _ DP.topTail; leftTail: INT _ DP.leftTail; -- to center of 0th channel rightTail: INT _ DP.rightTail; -- metPitch-leftTail botTail: INT _ DP.botTail; cnctSize: INT _ DP.cnctSize; metPitch: INT _ DP.metPitch; met2Pitch: INT _ DP.met2Pitch; layRules: ATOM _ $cmosB; nullCC: DP.ROPE _ "="; dpCharCodeProp: ATOM _ CoreProperties.RegisterProperty[$DPCharCode]; GetCharCode: PUBLIC PROC[wire: DP.Wire] RETURNS[charCode: DP.ROPE] = { IF wire=NIL THEN RETURN[nullCC]; charCode _ NARROW [CoreProperties.GetWireProp[wire, dpCharCodeProp]]; IF charCode=NIL THEN RETURN[nullCC]}; SetCharCode: PUBLIC PROC[wire: DP.Wire, charCode: DP.ROPE] = {CoreProperties.PutWireProp[wire, dpCharCodeProp, charCode]}; GetMuxCellTypes: PUBLIC PROC[dp: DP.DataPath, inst: DP.CellInstance] RETURNS[muxes: DP.CellTypeSeq] = { OPEN CG: CoreGeometry; data: CoreClasses.RecordCellType _ NARROW[inst.type.data]; top, bot, ctl, in, out: DP.Wire; wires: DP.Wires; gnd: DP.Wire _ FindCCWire[data.internal, minus]; vdd: DP.Wire _ FindCCWire[data.internal, plus]; schDeco: CG.Decoration _ Sisyph.mode.decoration; name: DP.ROPE _ "Mux|"; char: CHAR _ 'a; FindCCWire: PROC[wire: DP.Wire, cc: DP.ROPE] RETURNS[subWire: DP.Wire] = { FOR i: NAT IN [0..wire.size) DO IF Rope.Equal[GetCharCode[wire[i]], cc] THEN RETURN[wire[i]]; REPEAT FINISHED => ERROR ENDLOOP}; SetCC: PROC[wire: DP.Wire] = { cc: DP.ROPE _ GetCharCode[wire]; IF wire#NIL AND Rope.Equal[cc, nullCC] THEN {cc _ IO.PutFR["%g", IO.char[char]]; char_char+1; SetCharCode[wire, cc]}; name _ name.Cat[cc]}; EachSideWire: CG.EachSortedPinProc = {wires _ CONS[wire, wires]}; EachChanWire: CG.EachSortedPinProc = { -- wire min max layer count: INT _ 0; chan: INT _ (DP.SchHalfChan[(min+max)/2]-1)/2; FOR ws: DP.Wires _ wires, ws.rest WHILE ws#NIL DO count _ count+1 ENDLOOP; IF dp.spec.chans IN [count..chan) THEN { THROUGH [count..dp.spec.chans) DO wires _ CONS[NIL, wires] ENDLOOP; wires _ CONS[gnd, wires]; wires _ CONS[vdd, wires]; count _ dp.spec.chans+2}; IF chan < count THEN Signal[]; THROUGH [count..chan) DO wires _ CONS[NIL, wires] ENDLOOP; wires _ CONS[wire, wires]}; SetCharCode[gnd, minus]; SetCharCode[vdd, plus]; wires _ NIL; []_CG.EnumerateSortedSides[schDeco, inst.type, top, EachChanWire]; top _ CoreOps.CreateWire[CoreOps.Reverse[wires]]; wires _ NIL; []_CG.EnumerateSortedSides[schDeco, inst.type, bottom, EachChanWire]; bot _ CoreOps.CreateWire[CoreOps.Reverse[wires]]; wires _ NIL; []_CG.EnumerateSortedSides[schDeco, inst.type, left, EachSideWire]; ctl _ CoreOps.CreateWire[CoreOps.Reverse[wires]]; in _ CoreOps.CreateWires[ctl.size]; FOR child: NAT IN [0..data.size) DO gate: DP.Wire _ data[child].actual[CoreOps.GetWireIndex[data[child].type.public, "gate"]]; ch1: DP.Wire _ data[child].actual[CoreOps.GetWireIndex[data[child].type.public, "ch1"]]; ch2: DP.Wire _ data[child].actual[CoreOps.GetWireIndex[data[child].type.public, "ch2"]]; FOR index: INT IN [0..ctl.size) DO IF ctl[index]#gate THEN LOOP; IF in[index]#NIL THEN Signal[]; in[index] _ ch1; IF out#NIL AND out#ch2 THEN Signal[]; out _ ch2; EXIT REPEAT FINISHED=> Signal[] ENDLOOP; ENDLOOP; FOR index: INT IN [0..top.size) DO SetCC[top[index]] ENDLOOP; name _ name.Cat["|"]; FOR index: INT IN [0..bot.size) DO SetCC[bot[index]] ENDLOOP; name _ name.Cat["|"]; FOR index: INT IN [0..ctl.size) DO SetCC[ctl[index]] ENDLOOP; name _ name.Cat["|"]; FOR index: INT IN [0..in.size) DO SetCC[in[index]] ENDLOOP; name _ name.Cat["|"]; SetCC[out]; muxes _ NEW[DP.CellTypeSeqRec[dp.spec.n]]; FOR bit: INT IN [0..dp.spec.n) DO muxes[bit] _ GetMux[dp.spec.chans, dp.spec.dChans, name] ENDLOOP}; objCache: SymTab.Ref _ SymTab.Create[]; cellCache: RefTab.Ref _ RefTab.Create[]; GetMux: PROC[rChans, dChans: INT, refName: DP.ROPE] RETURNS[mux: DP.CellType] = { Valid: PROC RETURNS[BOOL] = { IF name.Length=0 THEN RETURN[FALSE]; char _ name.Fetch[]; name _ name.Substr[1]; RETURN[char#'|]}; char: CHAR; name: DP.ROPE; object: CD.Object _ NARROW[SymTab.Fetch[objCache, refName].val]; IF object=NIL THEN { RP: PROC[ch: CHAR] RETURNS[rope: DP.ROPE] = {IF ch = '= THEN RETURN[NIL]; rope_IO.PutFR["%g", IO.char[ch]]}; Rev: PROC [ls: LIST OF DP.ROPE] RETURNS[LIST OF DP.ROPE] = {RETURN[RopeList.Reverse[ls]]}; top, bot, ctl, in, out: LIST OF DP.ROPE _ NIL; name _ refName.Substr[4]; WHILE Valid[] DO top _ CONS[RP[char], top] ENDLOOP; top _ Rev[top]; WHILE Valid[] DO bot _ CONS[RP[char], bot] ENDLOOP; bot _ Rev[bot]; WHILE Valid[] DO ctl _ CONS[RP[char], ctl] ENDLOOP; ctl _ Rev[ctl]; WHILE Valid[] DO in _ CONS[RP[char], in] ENDLOOP; in _ Rev[in]; WHILE Valid[] DO out _ CONS[RP[char], out] ENDLOOP; out _ Rev[out]; object _ Mux[refName, rChans, dChans, top, ctl, in, out, bot]; []_SymTab.Store[objCache, refName, object]}; IF (mux _ NARROW[RefTab.Fetch[cellCache, object].val])=NIL THEN { mData: CoreClasses.RecordCellType; mux _ SourceFromLayout.LayoutSource[object, refName]; mData _ NARROW[mux.data]; FOR i: INT IN [0..mData.size) DO CoreProperties.PutCellTypeProp[mData[i].type, $MintOneWay, $TRUE] ENDLOOP; []_RefTab.Store[cellCache, object, mux]}}; Mux: PROC [ name: Rope.ROPE, rChans: INT, dChans: INT, top: LIST OF DP.ROPE, ctl: LIST OF DP.ROPE, in: LIST OF DP.ROPE, out: LIST OF DP.ROPE, bot: LIST OF DP.ROPE] RETURNS [cell: CD.Object] = { cellWidth: INT _ (rChans + dChans)*DP.layChanW; xstrLgth: INT _ 8*lambda; xstrWth: INT _ (4+4)*lambda; xstrWthBig: INT _ (4+8)*lambda; tranBiasx: INT _ (xstrWth-metW)/2; tranBiasLtx: INT _ tranBiasx + 4*lambda; xstrHt: INT _ xstrLgth + 2*difW; pFrng: INT _ (pwrW-metW)/2; topExtra: INT _ cnctSize/2 + topTail; botExtra: INT _ cnctSize/2 + botTail; pitch: CD.Position = [metPitch, met2Pitch]; usingMinTransistor: BOOL _ FALSE; muxEvenDn: BOOL = TRUE; range: CD.Position; outN: DP.ROPE _ IF out=NIL THEN NIL ELSE out.first; iRect: CD.Rect; gnd: INT _ rChans; vdd: INT _ rChans+1; cnctBiasx: INT _ (cnctSize-metW)/2; outIndex, outIndexBot: INT; insts: CD.InstanceList _ NIL; top _ FixGVCharInList[rChans, top]; bot _ FixGVCharInList[rChans, bot]; range _ [MAX[Lists.ListLength[top],Lists.ListLength[bot]], Lists.ListLength[ctl]]; outIndex _ Lists.ListItemIndexMin[top, outN]; outIndexBot _ Lists.ListItemIndexMin[bot, outN]; IF outIndex # Lists.ListItemIndexMax[top, outN] OR outIndexBot # Lists.ListItemIndexMax[bot, outN] OR (outIndex#-1 AND outIndexBot#-1 AND outIndex#outIndexBot) THEN { log.PutF["Multiple column output %g- ABORT", IO.rope[outN]]; Signal[]}; IF outIndex = -1 THEN outIndex _ outIndexBot; <> IF outN#NIL AND Lists.ListItemIndexMax[top, outN]=-1 AND Lists.ListItemIndexMax[bot, outN]=-1 THEN { log.PutF["\n Output signal (%g) is not in either top or bot lists - ABORT", IO.rope[outN]]; Signal[]}; IF outN#NIL AND Lists.ListItemIndexMax[in, outN]#-1 THEN{ log.PutF["\n Output signal (%g) is also used as input - ABORT", IO.rope[outN]]; Signal[]}; FOR i: INT IN [0..range.x) DO loc: CD.Position _ [i*pitch.x, 0]; tIO: DP.ROPE _ Lists.ListIndexItem[top, i]; bIO: DP.ROPE _ Lists.ListIndexItem[bot, i]; topOut: BOOL _ Rope.Equal[tIO,outN]; botOut: BOOL _ Rope.Equal[bIO,outN]; tY: INT _ IF topOut THEN Lists.ListNonNILIndexMin[in] ELSE Lists.ListItemIndexMin[in,tIO]; bY: INT _ IF botOut THEN Lists.ListNonNILIndexMax[in] ELSE Lists.ListItemIndexMax[in,bIO]; tY _ tY + ((tY + (IF topOut=muxEvenDn THEN 1 ELSE 2)) MOD 2); bY _ bY + ((bY + (IF botOut=muxEvenDn THEN 1 ELSE 2)) MOD 2); IF tY=-1 AND bY=-1 THEN tY_bY_0; IF ~Rope.Equal[tIO, bIO] AND tY<=bY AND tIO#NIL AND bIO#NIL THEN { log.PutF["\n 2 signals (%g, %g) in same channel - ABORT", IO.rope[tIO], IO.rope[bIO]]; Signal[]}; IF tIO#NIL THEN insts _ AddRetInst[insts: insts, name: tIO, level: CMosB.met, size: [metW, (range.y-tY) * pitch.y + topExtra ], loc: [i*pitch.x, tY * pitch.y ]]; IF bIO#NIL THEN insts _ AddRetInst[insts: insts, name: bIO, level: CMosB.met, size: [metW, bY * pitch.y + botExtra ], loc: [i*pitch.x, 0 * pitch.y - botExtra ]]; ENDLOOP; FOR vgIndex: INT IN [gnd..vdd] DO insts _ AddRetInst[ insts: insts, name: (IF vgIndex=gnd THEN minus ELSE plus), level: CMosB.met, size: [pwrW, range.y * pitch.y + topExtra + botExtra ], loc: [vgIndex*pitch.x-pFrng, - botExtra ]] ENDLOOP; <> <<[cell, top, bot, 0, range.y*pitch.y+ topExtra, - botExtra, TRUE];>> BEGIN xstr: CD.Object _ CMosBObjects.CreateTransistor [size: [xstrWth, xstrLgth], difLayer: CMosB.ndif]; xstrBig: CD.Object _ CMosBObjects.CreateTransistor [size: [xstrWthBig, xstrLgth], difLayer: CMosB.ndif]; dcon: CD.Object _ CDSimpleRules.Contact[layRules, CMosB.met, CMosB.ndif]; pcon: CD.Object _ CDSimpleRules.Contact[layRules, CMosB.met, CMosB.pol]; vcon: CD.Object _ CDSimpleRules.Contact[layRules, CMosB.met, CMosB.met2]; scon: CD.Object _ CMosBObjects.CreateDifCon[CMosB.pwellCont]; pvconn: CD.Object _ CDRects.CreateRect[[2*cnctSize, cnctSize], CMosB.met]; lstIONotGnd: BOOL _ TRUE; lstGndClear: BOOL _ TRUE; thsIONotGnd: BOOL _ TRUE; thsGndClear: BOOL _ TRUE; FOR ctlIndex: INT IN [0..range.y) DO Include: PROC[object: CD.Object, location: CD.Position] = {insts _ CONS[ NEW[CD.InstanceRep _ [object, [location]]], insts]}; AddGndContact: PROC[updn: {up, dn}] = {IF updn=up THEN Include[scon, [gnd*pitch.x-cnctBiasx, (ctlIndex+1)*pitch.y -cnctSize/2 ]] ELSE Include[scon, [gnd*pitch.x-cnctBiasx, (ctlIndex+0)*pitch.y -cnctSize/2 ]]}; AddMux: PROC [index: CD.Position, lt, rt: BOOL] = { <> dWL: INT _ (ABS[outIndex-index.x])*pitch.x+cnctSize; pWL: INT _ (range.x-index.x)*pitch.x; minX: INT _ MIN[outIndex, index.x]; polX: INT _ MIN[outIndex, index.x]; pol: CD.Object _ CDRects.CreateRect[[pWL, polW], CMosB.pol]; dif: CD.Object _ CDRects.CreateRect[[dWL, difW], CMosB.ndif]; <> dir: INT _ IF ((index.y MOD 2)=0)=muxEvenDn THEN 1 ELSE -1; yloc: INT _ index.y*pitch.y + pitch.y/2; Include[pcon, [range.x *pitch.x -cnctBiasx, yloc -cnctSize/2 ]]; Include[pvconn, [range.x *pitch.x -cnctBiasx, yloc -cnctSize/2 ]]; Include[vcon, [range.x *pitch.x -cnctBiasx+cnctSize+lambda, yloc -cnctSize/2 ]]; Include[pol, [index.x *pitch.x -cnctBiasx, yloc -polW/2 ]]; Include[dif, [minX *pitch.x -cnctBiasx, yloc +dir*pitch.y/2 -difW/2 ]]; <> Include[dcon, [outIndex *pitch.x -cnctBiasx, yloc +dir*pitch.y/2 -cnctSize/2 ]]; Include[dcon, [index.x *pitch.x -cnctBiasx, yloc -dir*pitch.y/2 -cnctSize/2 ]]; Include[dwText, [index.x *pitch.x -tranBiasx, yloc -lambda*textScale/2 ]]; SELECT TRUE FROM lt => Include[xstrBig, [index.x *pitch.x -tranBiasLtx, yloc -xstrLgth/2 ]]; rt => Include[xstrBig, [index.x *pitch.x -tranBiasx, yloc -xstrLgth/2 ]]; ENDCASE => Include[xstr, [index.x *pitch.x -tranBiasx, yloc -xstrLgth/2 ]]; CDSatellites.Associate[master: insts.first, text: insts.rest.first]}; cName: DP.ROPE _ Lists.ListIndexItem[ctl, ctlIndex]; size: CD.Position _ [cellWidth, met2W]; loc: CD.Position _ [metW/2-leftTail, ctlIndex*pitch.y+pitch.y/2-met2W/2]; insts _ AddRetInst[insts: insts, name: cName, size:size, loc:loc, level: CMosB.met2]; <> <> <> <> IF outN#NIL THEN { ioIndex: INT _ IOIndex[ctlIndex, in, top, bot]; ioItem: DP.ROPE _ Lists.ListIndexItem[in, ctlIndex]; IF ioIndex >=0 THEN { <> inDn: BOOL _ ((ctlIndex MOD 2)=0)=muxEvenDn; <> ioIndexUp: INT _ IF inDn THEN -1 ELSE IOIndex[ctlIndex+1, in, top, bot]; ioIndexDn: INT _ IF ~inDn THEN -1 ELSE IOIndex[ctlIndex-1, in, top, bot]; extLt: BOOL _ ioIndex # (gnd+1) AND ioIndex # 0 AND (ioIndexUp=-1 OR ioIndexUp#(ioIndex-1)) AND (ioIndexDn=-1 OR ioIndexDn#(ioIndex-1)); extRt: BOOL _ ioIndex # (gnd-1) AND ioIndex < (range.x-1) AND (ioIndexUp=-1 OR ioIndexUp#(ioIndex+1)) AND (ioIndexDn=-1 OR ioIndexDn#(ioIndex+1)); IF NOT(extLt OR extRt) THEN usingMinTransistor _ TRUE; AddMux[[ioIndex, ctlIndex], extLt, extRt]}; thsIONotGnd _ ioIndex # gnd; thsGndClear _ thsIONotGnd AND ((ioIndex-1 THEN RETURN[ioIndex]; ioIndex _ Lists.ListItemIndexMax[bot, ioItem]}; <> <<[cell: CD.Object, top, bot: LIST OF DP.ROPE, refX, topY, botY: INT, realNames: BOOL] = {>> <> <> <> <> <> <> <> <<(IF realNames THEN tName ELSE NIL)];>> <> <<(IF realNames THEN bName ELSE NIL)];>> <> AddRetInst: PROC [insts: CD.InstanceList, name: DP.ROPE, size: CD.Position, loc: CD.Position, level: CD.Layer] RETURNS[CD.InstanceList] = { text: CD.Object _ CDTexts.Create[name, font]; textSize: CD.Position _ CDBasics.SizeOfRect[text.bbox]; textLoc: CD.Position _ IF size.x>size.y THEN [loc.x, loc.y + size.y/2 - lambda*textScale/2] ELSE IF loc.y < 0 THEN [loc.x + size.x/2 - textSize.x/2, loc.y] ELSE [loc.x + size.x/2 - textSize.x/2, loc.y + size.y - textSize.y]; IF size.x<0 OR size.y<0 THEN {log.PutF["Strange rectangle size [%g, %g]\n", IO.int[size.x], IO.int[size.y] ]; Signal[]}; IF size.x=0 OR size.y=0 THEN RETURN[insts]; insts _ CONS[ NEW[CD.InstanceRep _ [text, [textLoc ]]], insts]; insts _ CONS[ NEW[CD.InstanceRep _ [CDRects.CreateRect[size, level], [loc ]]], insts]; CDSatellites.Associate[master: insts.first, text: insts.rest.first]; RETURN[insts]}; FixGVCharInList: PROC [chans: INT, list: LIST OF DP.ROPE] RETURNS[new: LIST OF DP.ROPE] = {RETURN[AddGVCharToList[chans, DelGVFromList[list]]]}; DelGVFromList: PROC [list: LIST OF DP.ROPE] RETURNS[new: LIST OF DP.ROPE] = { nonNilItemAdded: BOOL _ FALSE; IF list=NIL THEN RETURN[NIL]; FOR ii: INT DECREASING IN [0..Lists.ListLength[list]) DO item: DP.ROPE _ Lists.ListIndexItem[list, ii]; IF Rope.Equal[item, Gnd] OR Rope.Equal[item, Vdd] OR Rope.Equal[item, plus] OR Rope.Equal[item, minus] THEN item _ NIL; IF item=NIL AND NOT nonNilItemAdded THEN LOOP; nonNilItemAdded _ TRUE; new _ CONS[item, new] ENDLOOP}; AddGVCharToList: PROC [chans: INT, list: LIST OF DP.ROPE] RETURNS[new: LIST OF DP.ROPE] = { FOR ii: INT DECREASING IN [0..MAX[chans+2, Lists.ListLength[list]]) DO item: DP.ROPE _ Lists.ListIndexItem[list, ii]; IF ii=chans+1 THEN item _ plus; IF ii=chans THEN item _ minus; new _ CONS[item, new] ENDLOOP}; END.