Artifact 1de9ae20651d98c50549a54e79a9e9da817359360fe0c5be12edb10cb8b463fd:

• File psl-1983/20-comp/dec20-asm.red — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 4968) [annotate] [blame] [check-ins using] [more...]

% 20-ASM.RED - Dec-20 specific information for LAP-TO-ASM
% 
% Author:      Eric Benson
%	       Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        5 January 1982
% Copyright (c) 1982 University of Utah
%

%  <PSL.20-COMP>20-ASM.RED.1, 25-Feb-82 16:46:44, Edit by BENSON
%  Converted from VAX version

fluid '(CodeFileNameFormat!*
	DataFileNameFormat!*
	InputSymFile!*
	OutputSymFile!*
	CommentFormat!*
	LabelFormat!*
	ExternalDeclarationFormat!*
	ExportedDeclarationFormat!*
	FullWordFormat!*
	DoubleFloatFormat!*
	ReserveZeroBlockFormat!*
	ReserveDataBlockFormat!*
	DefinedFunctionCellFormat!*
	UndefinedFunctionCellInstructions!*
	MainEntryPointName!*
	!*MainFound
	CodeOut!*
	DataOut!*
	!*Lower
	ASMOpenParen!*
	ASMCloseParen!*
	NumericRegisterNames!*);

CodeFileNameFormat!* := "%w.mac";
DataFileNameFormat!* := "d%w.mac";
InputSymFile!* := "20.sym";
OutputSymFile!* := "20.sym";
GlobalDataFileName!* := "global-data.red"$
MainEntryPointName!* := 'MAIN!.;
NumericRegisterNames!* := '[0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15];
CommentFormat!* := "; %p%n";
LabelFormat!* := "%w:";
ExternalDeclarationFormat!* := "	extern %w%n";
ExportedDeclarationFormat!* := "	intern %w%n";
FullWordFormat!* := "	%e%n";	% FullWord expects %e for parameter
DoubleFloatFormat!* := "	%w%n	0%n";
ReserveZeroBlockFormat!* := "%w:	block %e%n";
ReserveDataBlockFormat!* := "	block %e%n";
DefinedFunctionCellFormat!* := "	jrst %w##%n";
UndefinedFunctionCellInstructions!* :=
	       '((jsp (reg t5) (Entry UndefinedFunction)));
ASMOpenParen!* := '!<;
ASMCloseParen!* := '!>;

DefList('((LAnd !&)
	  (LOr !!)
	  (LXor !^!!)
	  (LSH !_)), 'BinaryASMOp);

put('LNot, 'UnaryASMOp, '!^!-);

DefList('((t1 6)
	  (t2 7)
	  (t3 8)
	  (t4 9)
	  (t5 10)
	  (t6 11)
	  (nil 0)
	  (st 15)), 'RegisterName);

put('MkItem, 'ASMExpressionFormat, "<%e_31>+%e");

lisp procedure CodeFileHeader();
    CodePrintF "	search monsym%n	radix 10%n";

lisp procedure DataFileHeader();
    DataPrintF "	radix 10%n";

lisp procedure CodeFileTrailer();
    CodePrintF(if !*MainFound then "	end MAIN.%n" else "	end%n");

lisp procedure DataFileTrailer();
    DataPrintF "	end%n";

lisp procedure CodeBlockHeader();
    NIL;

lisp procedure CodeBlockTrailer();
    NIL;

lisp procedure DataAlignFullWord();
    NIL;

lisp procedure PrintString S;
begin scalar N;
    N := Size S;
    PrintF "	byte(7)";
    for I := 0 step 1 until N do
    <<  PrintExpression Indx(S, I);
	Prin2 '!, >>;
    PrintExpression 0;
    TerPri();
end;

lisp procedure PrintByteList L;
    if null L then NIL else
    <<  PrintF "	byte(7)";
	while cdr L do
	<<  PrintExpression car L;
	    Prin2 '!,;
	    L := cdr L >>;
	PrintExpression car L;
	TerPri() >>;

lisp procedure PrintByte X;
<<  PrintF "	byte(7)";
    PrintExpression X;
    TerPri() >>;

lisp procedure PrintHalfWordList L;
    if null L then NIL else
    <<  PrintF "	byte(18)";
	while cdr L do
	<<  PrintExpression car L;
	    Prin2 '!,;
	    L := cdr L >>;
	PrintExpression car L;
	TerPri() >>;

lisp procedure PrintOpcode X;
    Prin2 X;

lisp procedure SpecialActionForMainEntryPoint();
    CodePrintF "	intern MAIN.%nMAIN.:";

lisp procedure ASMSymbolP X;
    Radix50SymbolP(if IDP X then ID2String X else X);

lisp procedure Radix50SymbolP X;
begin scalar N, C, I;
    N := Size X;
    if N > 5 then return NIL;
    C := Indx(X, 0);
    if not (C >= char A and C <= char Z
		or C = char !% or C = char !. or C = char !$) then return NIL;
    I := 1;
Loop:
    if I > N then return T;
    C := Indx(X, I);
    if not (C >= char A and C <= char Z
		or C >= char !0 and C <= char !9
		or C = char !% or C = char !. or C = char !$) then return NIL;
    I := I + 1;
    goto Loop;
end;

lisp procedure PrintNumericOperand X;
    if ImmediateP X then Prin2 X else PrintF("[%w]", X);

lisp procedure OperandPrintIndirect X;
<<  Prin2 '!@;
    PrintOperand cadr X >>;

put('Indirect, 'OperandPrintFunction, 'OperandPrintIndirect);

lisp procedure OperandPrintIndexed X;
<<  X := cdr X;
    PrintExpression cadr X;
    Prin2 '!(;
    PrintOperand car X;
    Prin2 '!) >>;

put('Indexed, 'OperandPrintFunction, 'OperandPrintIndexed);

macro procedure Immediate X;		% immediate does nothing on the 20
    cadr X;

lisp procedure ASMPseudoFieldPointer U;
%
% (FieldPointer Operand StartingBit Length)
%
<<  U := cdr U;
    Prin2 "point ";
    PrintExpression third U;
    Prin2 '!, ;
    PrintOperand first U;
    Prin2 '!, ;
    PrintExpression list('difference, list('plus2, second U, third U), 1) >>;

put('FieldPointer, 'ASMExpressionFunction, 'ASMPseudoFieldPointer);

procedure MCPrint(x); % Echo of MC's
 CodePrintF(";     %p%n",x);

procedure InstructionPrint(x);
 CodePrintF( ";          %p%n",x);

procedure !*cerror x;
 begin scalar i;
    i:=wrs Nil;
    printf( "%n *** CERROR: %r %n ",x);
    wrs i;
    return list list('cerror,x);
 end;

put('cerror,'asmpseudoop,'printcomment);

DefCmacro !*cerror;

END;