genpc.p

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

(*#@(#)genpc.p	4.1	Ultrix	7/17/90 *)
(****************************************************************************
 *									    *
 *  Copyright (c) 1984 by						    *
 *  DIGITAL EQUIPMENT CORPORATION, Maynard, Massachusetts.		    *
 *  All rights reserved.						    *
 * 									    *
 *  This software is furnished under a license and may be used and copied   *
 *  only in  accordance with  the  terms  of  such  license  and with the   *
 *  inclusion of the above copyright notice. This software or  any  other   *
 *  copies thereof may not be provided or otherwise made available to any   *
 *  other person.  No title to and ownership of  the  software is  hereby   *
 *  transferred.							    *
 * 									    *
 *  The information in this software is  subject to change without notice   *
 *  and  should  not  be  construed as  a commitment by DIGITAL EQUIPMENT   *
 *  CORPORATION.							    *
 * 									    *
 *  DIGITAL assumes no responsibility for the use  or  reliability of its   *
 *  software on equipment which is not supplied by DIGITAL.		    *
 * 									    *
$Header: genpc.p,v 1.6 84/06/06 12:56:14 powell Exp $
 ****************************************************************************)
#include "globals.h"
#include "decls.h"
#include "pcode.h"
#include "optim.h"
#include "ocount.h"
#include "genpcf.h"
#include "genpc.h"
#include "alloc.h"
#include "const.h"
#include "dbstab.h"
#include "bexpr.h"
#include "cexpr.h"
#include "builtinpc.h"
#include "gencode.h"

var
    exitLabel : LabelNumber;
    currLevel : DisplayLevel;
    loopNestLevel : integer;
    genProc : ProcNode;

procedure GenComs;
var
    gvn : GlobalVarNode;
begin
    gvn := globalVarList^.first;
    while gvn <> nil do begin
	GenOp(PCCOM);
	GenInteger(gvn^.number);
	Comma;
	GenString(gvn^.name);
	Comma;
	GenInteger(CardDiv(RoundUp(gvn^.size,WORDSIZE),WORDSIZE));
	EndLine;
	gvn := gvn^.next;
    end;
end;

procedure GenTagList(csl : ConstSetList);
var
    csn : ConstSetNode;
    value : cardinal;
begin
    if csl <> nil then begin
	csn := csl^.first;
	while csn <> nil do begin
	    value := OrdOf(csn^.lower);
	    GenInteger(value);
	    if (csn^.upper <> nil) and (csn^.upper <> csn^.lower) then begin
		GenChar(':');
		value := OrdOf(csn^.upper);
		GenInteger(value);
	    end;
	    csn := csn^.next;
	    if csn <> nil then begin
		GenChar(';');
	    end;
	end;
    end;
end;

procedure GenExprCheck(expr : ExprNode; mode : EvalMode);
var
    checkFn, tagFn : FieldNode;
    vn : VariantNode;
    csn : ConstSetNode;
begin
    GenExpr(expr^.checkExpr,mode);
    if genCheckFlag then begin
	case expr^.exprCheck of
	    CHECKSUBSCR : begin
		GenOp(PCCHK); GenChar('s'); Comma; GenT(expr^.checkType); Comma;
			GenInteger(expr^.checkLower); Comma;
			GenInteger(expr^.checkUpper);
		EndLine;
	    end;
	    CHECKSUBSCROPEN : begin
		GenVar(expr^.checkVar,EVALPOINT);
		GenOp(PCCHK); GenChar('o'); EndLine;
	    end;
	    CHECKRANGE : begin
		GenOp(PCCHK); GenChar('r'); Comma; GenT(expr^.checkType); Comma;
			GenInteger(expr^.checkLower); Comma;
			GenInteger(expr^.checkUpper);
		EndLine;
	    end;
	    CHECKPTRMODULA : begin
		GenOp(PCCHK); GenChar('a'); Comma; GenChar('m'); EndLine;
	    end;
	    CHECKPTRPASCAL : begin
		GenOp(PCCHK); GenChar('a'); Comma; GenChar('p'); EndLine;
	    end;
	    CHECKPTRNIL : begin
		GenOp(PCCHK); GenChar('a'); Comma; GenChar('n'); EndLine;
	    end;
	    CHECKVARIANT : begin
		checkFn := expr^.checkField;
		vn := checkFn^.containingVariant;
		while vn <> nil do begin
		    tagFn := vn^.tagField;
		    if tagFn^.offset < 0 then begin
			{ no tag field }
		    end else begin
			GenOp(PCCHK); GenChar('v'); Comma;
			    GenInteger(tagFn^.offset); Comma;
			    GenInteger(SizeOf(tagFn^.fieldType)); Comma;
			if vn^.tag = nil then begin
			    { else }
			    GenChar('~');
			    vn := tagFn^.variantList^.first;
			    while vn <> nil do begin
				GenTagList(vn^.tag);
				vn := vn^.next;
				if vn <> nil then begin
				    GenChar(';');
				end;
			    end;
			end else begin
			    GenTagList(vn^.tag);
			end;
			EndLine;
		    end;
		    checkFn := tagFn;
		    vn := checkFn^.containingVariant;
		end;
	    end;
	    CHECKPTRNONE, CHECKPTRC : begin
	    end;
	end;
    end;
end;

procedure GenCode;
begin
    if TraceGenpc then begin
	writeln(output,'Beginning code generation');
    end;
    InitPcode;
    exitLabel := NULLLABEL;
    loopNestLevel := 0;
    rewrite(codeFile,codeFileName);
    InitStab;
    if globalProc^.globalName = nil then begin
	GenText(MAINPROGNAME); GenOp(PCBGN); GenText('Modula'); Comma;
	    GenInteger(globalProc^.block);
	EndLine;
    end else begin
	GenString(globalProc^.globalName); GenOp(PCBGN); GenText('Modula');
	    Comma; GenInteger(0);
	EndLine;
    end;
    GenComs;
    GenModule(globalModule);
    GenOpL(PCSTP);
    if TraceGenpc then begin
	writeln(output,'Ending code generation');
    end;
end;

procedure GenParamCopies(params : ParamList);
var
    param : ParamNode;
    size : cardinal;
begin
    param := params^.first;
    while param <> nil do begin
	if param^.docopy then begin
	    { if it is a value open array, must copy it onto stack }
	    if param^.kind = PARAMARRAYVALUE then begin
		{ point to parameter address }
		GenVarT(param^.paramVar,addressTypeNode,EVALPOINT);

		{ get number of elements }
		GenVar(param^.numElements,EVALGET);

		{ allocate space on stack, copy parameter value }
		size := SizeOf(param^.paramType^.elementType);
		GenOp(PCSAL); GenInteger(size); EndLine;
	    end else if param^.kind = PARAMVALUE then begin
		GenVarT(param^.paramVar,addressTypeNode,EVALPOINT);
		GenConstInteger(CardDiv(WordSizeOf(param^.paramType),WORDSIZE));
		{ allocate space on stack, copy parameter value }
		GenOp(PCSAL); GenInteger(WORDSIZE); EndLine;
	    end else begin
		Error('GenParamCopies: not open array or value param');
	    end;
	end;
	param := param^.next;
    end;
end;

procedure GenGlobalProc(proc: ProcNode);
var
    submod : ModuleNode;
    oklabel : LabelNumber;
begin
    if proc^.initFlagVar <> nil then begin
	GenVar(proc^.initFlagVar,EVALGET);
	oklabel := NewLabel;
	GenOp(PCFJP); GenLabel(oklabel); EndLine;
	GenOpTL(PCRET,procTypeNode);
	GenLabel(oklabel); GenOpL(PCLAB);
	GenConstBoolean(true);
	GenVar(proc^.initFlagVar,EVALPUT);
    end;

    { generate initialization calls if this is global proc }
    submod := globalModule^.modules^.first;
    while (submod <> nil) do begin
	if submod^.kind = MODDEFINITION then begin
	    GenOpL(PCMST);
	    AddString(submod^.name);
	    AddChar('_');
	    AddText(MODULEINITNAME);
	    GenCall(false,NewString,procTypeNode,0);
	end;
	submod := submod^.next;
    end;
end;

procedure GenProcName{(proc : ProcNode)};
begin
    if proc = globalProc then begin
	if proc^.globalName = nil then begin
	    { program module }
	    GenText(MAINPROGNAME);
	end else begin
	    { implementation module }
	    GenString(proc^.globalName);
	end;
    end else begin
	GenString(proc^.globalName);
    end;
end;

procedure GenProcEntry(proc : ProcNode);
var
    numParams : integer;
    param : ParamNode;
begin
    genProc := proc;
    StabProc(proc);
    StabLine(currFile,currLine);
    GenProcName(proc);
    GenOpT(PCENT,proc^.procType^.funcType);
    Comma;
    if proc^.procType^.funcType <> nil then begin
	GenInteger(SizeOf(proc^.procType^.funcType));
    end else begin
	GenInteger(0);
    end;
    Comma;
    GenInteger(proc^.displayLevel);
    Comma;
    GenInteger(proc^.block);
    Comma;
    numParams := 0;
    if proc^.procType^.paramList <> nil then begin
	param := proc^.procType^.paramList^.first;
	while param <> nil do begin
	    numParams := numParams + 1;
	    param := param^.next;
	end;
    end;
    GenInteger(numParams);
    Comma;
    if genDebugInfoFlag then begin
	GenInteger(proc^.lineNumber);
    end else begin
	GenInteger(0);
    end;
    Comma;
    if optimFlag then begin
	GenInteger(ord(not (proc^.displayLevel in proc^.containsUpLevel)));
    end else begin
	GenInteger(ord(not proc^.containsProcs));
    end;
    GenInteger(ord(proc^.internalProc));
    GenInteger(ord(gprofFlag));
    Comma;
    if (proc^.tempMap = nil) or OptNreg then begin
	GenInteger(-1);
    end else begin
	GenInteger(proc^.tempMap^.numReg+1);
    end;
    EndLine;
    GenOp(PCDEF);
    GenInteger(CardDiv(RoundUp(proc^.mem^.maximum[MEMPARAM],WORDSIZE),
		WORDSIZE));
    Comma;
    GenInteger(CardDiv(RoundUp(proc^.mem^.maximum[MEMFAST],WORDSIZE),
		WORDSIZE));
    Comma;
    GenInteger(CardDiv(RoundUp(proc^.mem^.maximum[MEMNORMAL],WORDSIZE),
		WORDSIZE));
    Comma;
    GenInteger(proc^.block);
    Comma;
    GenProcName(proc);
    EndLine;
    if proc <> globalProc then begin
	StabScope(proc^.scope);
    end;
    if proc^.tailRecursion then begin
	proc^.tailRecursionEntry := NewLabel;
	GenLabel(proc^.tailRecursionEntry); GenOpL(PCLAB);
    end;
    currLevel := proc^.displayLevel;
    if proc^.procType^.paramList <> nil then begin
	GenParamCopies(proc^.procType^.paramList);
    end;
    if proc = globalProc then begin
	GenGlobalProc(proc);
    end;
end;

procedure GenProcExit(proc : ProcNode);
begin
    if proc^.procType^.funcType = nil then begin
	GenOpTL(PCRET,nil);
    end else if genCheckFlag then begin
	GenOpTL(PCCHK,procTypeNode);
    end;
    GenOpL(PCEXI);
end;

procedure GenProc {(proc : ProcNode)};
var
    code : CodeNode;
begin
    GenText('#procedure ');
    GenString(proc^.globalName);
    EndLine;
    currFile := proc^.fileName;
    currLine := proc^.lineNumber;
    InitTemps;
    if proc^.code = nil then begin
	writeln(output,'No code in procedure');
    end else begin
	GenProcEntry(proc);
	code := proc^.code^.first;
	while code <> nil do begin
	    GenStmtList(code^.stmts);
	    code := code^.next;
	end;
	GenProcExit(proc);
    end;
end;

procedure GenModule {(module : ModuleNode)};
var
    proc : ProcNode;
    submod : ModuleNode;
begin
    if module^.kind <> MODDEFINITION then begin
	GenText('#module ');
	GenString(module^.name);
	EndLine;
	if module <> globalModule then begin
	    StabModule(module);
	    if module^.enclosing = globalModule then begin
		StabGlobalPort;
	    end;
	    StabScope(module^.scope);
	end;
	submod := module^.modules^.first;
	while submod <> nil do begin
	    GenModule(submod);
	    submod := submod^.next;
	end;
	proc := module^.procs^.first;
	while proc <> nil do begin
	    if proc^.builtin = BIPNOTBIP then begin
		GenProc(proc);
	    end;
	    proc := proc^.next;
	end;
    end;
end;

procedure GenStmtList{(stmts : StmtList)};
var
    stmt : StmtNode;
begin
    if stmts <> nil then begin
	stmt := stmts^.first;
	while stmt <> nil do begin
	    GenStmt(stmt);
	    stmt := stmt^.next;
	end;
    end;
end;

procedure GenStore{(expr : ExprNode; tn : TypeNode)};
begin
    if expr^.kind = EXPRVAR then begin
	GenVarT(expr^.exprVar,tn,EVALPUT);
    end else begin
	GenExpr(expr,EVALGET);
	GenIndirectVar(tn,EVALPUT);
    end;
end;

procedure GenStmtAssign(stmt : StmtNode);
begin
    if stmt^.assignOp = TKASSIGN then begin
	GenExpr(stmt^.rhs,EVALGET);
	GenStore(stmt^.lhs,stmt^.lhsType);
    end else begin
	GenExpr(stmt^.rhs^.opnd1^.exprVal,EVALPOINT);
	GenExpr(stmt^.rhs^.opnd2,EVALGET);
	case stmt^.assignOp of
	    TKPLUS: GenOp(PCAD2);
	    TKASTERISK: GenOp(PCMP2);
	    TKMINUS: GenOp(PCSB2);
	    TKDIV, TKSLASH: GenOp(PCDV2);
	end;
	GenT(stmt^.lhsType); Comma; GenInteger(SizeOf(stmt^.lhsType)); EndLine;
    end;
end;

function GenParamList(procType : TypeNode; procVariable : ExprNode;
	params : ExprList) : integer;
var
    pn : ParamNode;
    pen : ExprNode;
    numParams : integer;
    noCount : boolean;
begin
    numParams := 0;
    GenOpL(PCMST);
    if procVariable <> nil then begin
	{ invocation of procedure variable, make it first parameter }
	GenExpr(procVariable,EVALGET);
    end;
    if (params = nil) or (procType^.paramList = nil) then begin
	{ do nothing }
    end else begin
	pen := params^.first;
	pn := procType^.paramList^.first;
	while (pn <> nil) and (pen <> nil) do begin
	    case pn^.kind of
		PARAMARRAYVALUE, PARAMARRAYVAR : begin
		    GenExpr(pen,EVALPOINT);
		    noCount := false;
		    if pn^.paramType^.kind = DTARRAY then begin
			noCount :=  pn^.paramType^.nocount;
		    end;
		    if noCount then begin
		    end else if pen^.next = nil then begin
			ExprError(pen,'GenParamList: Open array, no length?');
		    end else begin
			pen := pen^.next;
			GenExpr(pen,EVALGET);
			numParams := numParams + 1;
		    end;
		end;
		PARAMVAR, PARAMVALUE : begin
		    if pn^.reference then begin
			GenExpr(pen,EVALPOINT);
		    end else begin
			GenExpr(pen,EVALGET);
		    end;
		end;
	    end;
	    numParams := numParams + 1;
	    pen := pen^.next;
	    pn := pn^.next;
	end;
    end;
    GenParamList := numParams;
end;

procedure GenCall{(internal : boolean; procName : String; procType : TypeNode;
	numParams : integer)};
begin
    if internal then begin
	GenOp(PCCUP);
    end else begin
	GenOp(PCCEP);
    end;
    GenT(procType^.funcType);
    Comma;
    if procType^.funcType <> nil then begin
	GenInteger(SizeOf(procType^.funcType));
    end else begin
	GenInteger(0);
    end;
    Comma;
    GenInteger(numParams);
    Comma;
    GenString(procName);
    EndLine;
end;

procedure GenTailRecursion(proc : ProcNode; params : ExprList);
var
    pn : ParamNode;
    pen : ExprNode;
    pnum : integer;
    temps : array [1..MAXTAILPARAMS] of integer;
    tempCount : integer;