dbstab.p

<B>Digital的Unix操作系统VAX 4.2源码</B>

	    DTLONGREAL,
	    DTCARDINAL,
	    DTNULL, DTSTRING, DTANY,
	    DTWORD, DTBYTE : begin
		{ these are already defined }
	    end;
	    DTOPAQUE,
	    DTENUMERATION : { nothing to do };
	    DTRENAME : begin
		StabCheckType(tn^.renameType);	
	    end;
	    DTPOINTER : begin
		StabCheckType(tn^.toType);
	    end;
	    DTPROC : begin
		StabCheckProcType(tn);
	    end;
	    DTSET : begin
		StabCheckType(tn^.setRange);
	    end;
	    DTSUBRANGE : begin
		StabCheckType(tn^.baseType);
	    end;
	    DTRECORD : begin
		StabCheckFieldList(tn^.fieldList);
	    end;
	    DTARRAY : begin
		if tn^.indexType <> nil then begin
		    StabCheckType(tn^.indexType);
		end;
		StabCheckType(tn^.elementType);
	    end;
	end;
	StartTypeDef;
	    GenString(name); GenChar(':'); GenChar('t');
	    GenInteger(tn^.number);
	    GenChar('=');
	    inTypeDef := true;
	    StabTypeDef(tn);
	    inTypeDef := false;
	EndTypeDef;
    end;
end;

procedure StabTypeNumber{(tn : TypeNode)};
begin
    if TraceStab then begin
	write(output,'StabTypeNumber: ',tn^.kind,' ',tn^.number,' ');
	WriteString(output,tn^.name);
	writeln(output);
    end;
    tn := NamedType(tn);
    if TraceStab then begin
	write(output,'StabTypeNumber(Actual): ',tn^.kind,' ',tn^.number,' ');
	WriteString(output,tn^.name);
	writeln(output);
    end;
    if tn = nil then begin
	GenInteger(0);
    end else if tn^.number <> 0 then begin
	GenInteger(tn^.number);
    end else begin
	tn^.number := NewTypeNumber;
	GenInteger(tn^.number);
	GenChar('=');
	StabTypeDef(tn);
    end;
end;

procedure StabQualifiers(module : ModuleNode; proc : ProcNode; last : boolean);
begin
    if (module = nil) or
	((module = globalModule) and ((proc = globalProc) or (proc = nil)))
    then begin
	{ do nothing }
    end else if proc = nil then begin
	{ global thing, just module qualifiers }
	StabQualifiers(module^.enclosing,proc,false);
	GenString(module^.name);
	if not last then begin
	    GenChar(':');
	end;
    end else if module^.enclosingProc = proc then begin
	{ next level is a module }
	StabQualifiers(module^.enclosing,proc,false);
	GenString(module^.name);
	if not last then begin
	    GenChar(':');
	end;
    end else if proc^.enclosingModule = module then begin
	{ next level is a proc }
	StabQualifiers(module,proc^.enclosing,false);
	GenString(proc^.name);
	if not last then begin
	    GenChar(':');
	end;
    end else begin
	ErrorName(module^.name,'Module/proc list confused');
	ErrorName(proc^.name,'Module/proc list confused');
    end;
end;

procedure StabProc{(proc : ProcNode)};
var
    tn : TypeNode;
    pn : ParamNode;
begin
    if genDebugInfoFlag then begin
	tn := proc^.procType^.funcType;
	GenOp(PCSYM); GenChar('F'); StabComma; GenChar('''');
	    if proc^.name = nil then begin
		GenText(MODULEINITNAME);
	    end else begin
		GenString(proc^.name);
	    end;
	    GenChar(':');
	    if tn <> nil then begin
		StabCheckType(tn);
		if proc^.internalProc then begin
		    GenChar('J');
		end else begin
		    GenChar('F');
		end;
		StabTypeNumber(tn);
	    end else begin
		if proc^.internalProc then begin
		    GenChar('I');
		end else begin
		    GenChar('P');
		end;
	    end;
	    StabComma;
	    GenProcName(proc);
	    StabComma;
	    if proc^.name = nil then begin
		GenString(proc^.enclosingModule^.name);
	    end else begin
		StabQualifiers(proc^.enclosingModule,proc^.enclosing,true);
	    end;
	    GenChar(''''); StabComma; GenInteger(STABPROC); Comma;
	    GenInteger(0); StabComma;
	    if tn <> nil then begin
		GenInteger(SizeOf(tn));
	    end else begin
		GenInteger(0);
	    end;
	    StabComma;
	    GenProcName(proc);
	StabEndLine;
	if proc^.procType^.paramList <> nil then begin
	    pn := proc^.procType^.paramList^.first;
	    while pn <> nil do begin
		GenOp(PCSYM); GenChar('p'); StabComma;
		    GenChar(''''); GenString(pn^.name); GenChar(':');
		    if pn^.reference then begin
			GenChar('v');
		    end else begin
			GenChar('p');
		    end;
		    StabTypeNumber(pn^.paramType); GenChar('''');
		    StabComma; GenInteger(STABPARAM); Comma;
		    GenInteger(0); StabComma; GenInteger(SizeOf(pn^.paramType));
		    StabComma; GenAddress(pn^.paramVar^.address);
		StabEndLine;
		pn := pn^.next;
	    end;
	end;
    end;
end;

procedure StabModule{(module : ModuleNode)};
begin
    if genDebugInfoFlag then begin
	GenOp(PCSYM); GenChar('m'); StabComma; GenChar('''');
	    GenString(module^.name); GenChar(':'); GenChar('m');
	    StabComma;
	    StabQualifiers(module^.enclosing,module^.enclosingProc,true);
	    GenChar(''''); StabComma; GenInteger(STABSYMBOL); Comma;
	    GenInteger(0); StabComma; GenInteger(0);
	    StabComma; GenInteger(0);
	StabEndLine;
    end;
end;


procedure StabScope{(scope : Scope)};
var
    sym : Symbol;
    tn : TypeNode;
begin
    if genDebugInfoFlag then begin
	sym := scope^.symbols^.first;
	while sym <> nil do begin
	    if sym^.kind = SYMVAR then begin
		tn := NamedType(sym^.symVar^.varType);
		StabCheckType(tn);
		case sym^.symVar^.address.kind of
		    MEMGLOBAL : begin
			GenOp(PCSYM); GenChar('G'); StabComma; GenChar('''');
			    GenString(sym^.name); GenChar(':');
			    if sym^.symVar^.address.gvn^.extern then begin
				GenChar('G');
			    end else begin
				GenChar('V');
			    end;
			    StabTypeNumber(tn); StabComma;
			    GenString(sym^.symVar^.address.gvn^.name);
			    GenChar(''''); StabComma; GenInteger(STABGLOBAL); Comma;
			    GenInteger(0); StabComma; GenInteger(SizeOf(tn));
			    StabComma; GenInteger(0);
			StabEndLine;
		    end;
		    MEMNORMAL, MEMFAST : begin
			GenOp(PCSYM); GenChar('v'); StabComma;
			    GenChar(''''); GenString(sym^.name); GenChar(':');
			    StabTypeNumber(tn); GenChar(''''); StabComma;
			    GenInteger(STABSYMBOL); StabComma; GenInteger(0); Comma;
			    GenInteger(SizeOf(tn)); StabComma;
			    GenAddress(sym^.symVar^.address);
			StabEndLine;
		    end;
		    MEMPARAM : begin
		    end;
		end;
	    end else if sym^.kind = SYMTYPE then begin
		StabNamedType(sym^.name,sym^.symType);
	    end;
	    sym := sym^.next;
	end;
    end;
end;

procedure StabGlobalPort;
var
    pn : PortNode;
    tn : TypeNode;
    cn : ConstNode;
    i : integer;
begin
    GenOp(PCSYM); GenChar('X'); StabComma;
	GenChar('''');
	GenString(compileModuleName); GenChar(':'); GenChar('X');
	GenInteger(0); GenInteger(0); GenInteger(0);
	GenChar('m'); GenChar(''''); StabComma;
	GenInteger(STABNMOD2); StabComma; GenInteger(0); Comma;
	GenInteger(0); StabComma; GenInteger(0);
    StabEndLine;
    pn := globalPortList^.first;
    while pn <> nil do begin
	if pn^.sym^.kind = SYMVAR then begin
	    tn := pn^.sym^.symVar^.varType;
	    StabCheckType(tn);
	    GenOp(PCSYM); GenChar('X'); StabComma;
		GenChar('''');
		GenString(pn^.module^.name); GenChar('_');
		GenString(pn^.sym^.name); GenChar(':'); GenChar('X');
		GenInteger(ord(pn^.qualified)); GenInteger(ord(pn^.export));
		GenInteger(ord(pn^.extern));
		GenChar('v'); StabTypeNumber(tn); GenChar(''''); StabComma;
		GenInteger(STABNMOD2); StabComma; GenInteger(0); Comma;
		GenInteger(0); StabComma; GenInteger(0);
	    StabEndLine;
	end else if pn^.sym^.kind = SYMPROC then begin
	    tn := pn^.sym^.symProc^.procType;
	    StabCheckProcType(tn);
	    GenOp(PCSYM); GenChar('X'); StabComma;
		GenChar('''');
		GenString(pn^.module^.name); GenChar('_');
		GenString(pn^.sym^.name); GenChar(':'); GenChar('X');
		GenInteger(ord(pn^.qualified)); GenInteger(ord(pn^.export));
		GenInteger(ord(pn^.extern));
		StabProcType(tn); GenChar(''''); StabComma;
		GenInteger(STABNMOD2); StabComma; GenInteger(0); Comma;
		GenInteger(0); StabComma; GenInteger(0);
	    StabEndLine;
	end else if pn^.sym^.kind = SYMTYPE then begin
	    tn := pn^.sym^.symType;
	    StabCheckType(tn);
	    GenOp(PCSYM); GenChar('X'); StabComma;
		GenChar('''');
		GenString(pn^.module^.name); GenChar('_');
		GenString(pn^.sym^.name); GenChar(':'); GenChar('X');
		GenInteger(ord(pn^.qualified)); GenInteger(ord(pn^.export));
		GenInteger(ord(pn^.extern));
		GenChar('t'); StabTypeNumber(tn); GenChar(''''); StabComma;
		GenInteger(STABNMOD2); StabComma; GenInteger(0); Comma;
		GenInteger(0); StabComma; GenInteger(0);
	    StabEndLine;
	end else if pn^.sym^.kind = SYMCONST then begin
	    cn := pn^.sym^.symConst;
	    if cn^.kind = DTENUMERATION then begin
		tn := cn^.enumVal^.enumType;
		StabCheckType(tn);
	    end else if cn^.kind = DTSET then begin
		tn := cn^.setVal^.setType;
		StabCheckType(tn);
	    end;
	    GenOp(PCSYM); GenChar('X'); StabComma;
		GenChar('''');
		GenString(pn^.module^.name); GenChar('_');
		GenString(pn^.sym^.name); GenChar(':'); GenChar('X');
		GenInteger(ord(pn^.qualified)); GenInteger(ord(pn^.export));
		GenInteger(ord(pn^.extern));
		GenChar('c'); GenChar('=');
		case cn^.kind of
		    DTREAL, DTLONGREAL : begin
			GenChar('r');
			GenReal(cn^.realVal);
		    end;
		    DTINTEGER, DTCARDINAL : begin
			GenChar('i');
			GenInteger(cn^.cardVal);
		    end;
		    DTBOOLEAN : begin
			GenChar('b');
			GenInteger(ord(cn^.boolVal));
		    end;
		    DTCHAR : begin
			GenChar('c');
			GenInteger(cn^.charVal);
		    end;
		    DTSTRING : begin
			GenChar('s');
			GenChar('''');
			GenChar('''');
			WriteStringConst(codeFile,cn^.strVal);
			GenChar('''');
			GenChar('''');
		    end;
		    DTENUMERATION : begin
			GenChar('e');
			StabTypeNumber(tn); StabComma;
			GenInteger(cn^.enumVal^.enumOrd);
		    end;
		    DTSET : begin
			GenChar('S');
			StabTypeNumber(tn); StabComma;
			GenSet(cn^.setVal);
		    end;
		end;
		GenChar(';');
		GenChar(''''); StabComma;
		GenInteger(STABNMOD2); StabComma; GenInteger(0); Comma;
		GenInteger(0); StabComma; GenInteger(0);
	    StabEndLine;
	end;
	pn := pn^.next;
    end;
    GenOp(PCSYM); GenChar('X'); StabComma;
	GenChar('''');
	GenString(compileModuleName); GenChar(':'); GenChar('X');
	GenInteger(0); GenInteger(0); GenInteger(0);
	GenChar('z'); GenChar(''''); StabComma;
	GenInteger(STABNMOD2); StabComma; GenInteger(0); Comma;
	GenInteger(0); StabComma; GenInteger(0);
    StabEndLine;
end;

procedure StabLine{(fileName:String; lineNumber : integer)};
begin
    if genDebugInfoFlag then begin
	if fileName <> stabFileName then begin
	    { stab file name }
	    stabLineNumber := -1;
	end;
	if lineNumber <> stabLineNumber then begin
	    GenOp(PCSYM);
	    GenChar('l');
	    StabComma;
	    GenInteger(STABLINE);
	    StabComma;
	    GenInteger(0);
	    StabComma;
	    GenInteger(lineNumber);
	    StabEndLine;
	    stabLineNumber := lineNumber;
	end;
    end;
end;