Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0068/amod.imc
There are 2 other files named amod.imc in the archive. Click here to see a list.
TWOSEG;
#FILE AMOD -- ASSEMBLY MODULE FOR NEW IMP.
THE ASSEMBLER MAKES THREE PASSES THRU THE CODE:
PASS 1: COUNT REGISTER REFERENCES
PASS 2: ALLOCATE REGISTERS, INSERT REGISTER SAVES & RESTORES, DEFINE TAGS,
COUNT INSTRUCTIONS, SUPPRESS REGISTER LOADS (WHEN PERMITTED),
AND MARK REFERENCES TO VARIABLES OR LONG CONSTANTS BY SETTING
THE DIR PROPERTY "ATYPE" TO 6.
PASS 3: PUT OUT THE OBJECT CODE
BETWEEN THE SECOND AND THIRD PASSES, STORAGE IS ALLOCATED FOR VARIABLES.
/A PROVIDES AN ASSEMBLY LISTING.
/B TURNS ON DEBUGGING PRINTOUT AND LISTING.
THE FORMATTING OF THE OBJECT PROGRAM IS DONE IN FILE "OMOD" (OUTPUT MODULE).
*** IMPORTANT ASSUMPTION: THE ASSEMBLER MUST BE CALLED ONLY ONCE! *** #
CO,NCO,FINAM,CONST,RG,ARR,NARR ARE COMMON;
SUBR ASSEMB(E,F,REGN,IMPM,RELNM) IS (
AST_CALLI(27B,0); IASSEM(RELNM); INIREG();
SUPPR_1; LCONS_FALLOT('LCONS',25); NLCONS_0;
FINAM[5]_FINAM[5] AND NOT 4; #TURN OFF CONTINUE OPTION#
LIST_FINAM[5] AND 3; LIST => ALIST(8,RELNM);
(DBG_FINAM[5] AND 2) => (S_ENSTACK(0);
E => (PRINT /,STG 0,'HIGH SEGMENT --',/;
FREES(S+2,E LS 18); PCODE(S,9999));
F => (PRINT /,STG 0,'LOW SEGMENT --',/;
FREES(S+2,F LS 18); PCODE(S,9999)));
IW_E; SEG_1; UNREFL_0;
PASS1: IW=0=>GO TO P1X; W_NXCW(IW); IW => (
UNPKCW(W);
CODE NE 1 => (W_NXCW2(IW);
CODE=0 => (ACI=>REGREF(ACI);
IXI=>UNREFL=0=>REGREF(IXI);
UNREFL_0;
VIF=>REGREF(W AND 777777B)))
ELSE (CODE_(W RS 27) AND 177B; VI_W AND 777777B;
CODE=0=>DPROP('COM',VI)=1=>DPROPS('COM',VI,2);
CODE=5 => REGREF(VI);
CODE=6 => (REGREF(VI); REGREF(VI)); #EXTRA REFERENCE
TO RESERVE REGISTER FOR DURATION OF PROGRAM#
CODE=7 => OPTREG(IW);
CODE=8 => REGREF(VI);
CODE=9 => REGREF(VI);
CODE=10 => REGREF(VI);
CODE=11=>UNREFL_1);
GO TO PASS1);
P1X: SEG=>(IW_F; SEG_0; GO TO PASS1);
DBG => (PRINT /,STG 0,'REGISTER ARRAY --',/;
N_(REGN+2)/4;
(K_I; DBR: R_RGG(K); PRINT STG 0;
R AND 10000B => PRINT 'U'; R AND 4000B => PRINT 'Z';
R AND 40B => PRINT 'D'; (R AND 14040B)=0 => PRINT ' ';
PRINT ' R',OCT 3,K,STG 0,' ',OCT 2,37B AND R RS 6,37B AND R,
IGR 3,7777B AND R RS 18,STG 0,' ';
K_K+N; K<REGN => GO TO DBR;
PRINT /) FOR I IN 1,1,N;
PRINT /);
IW_0;
ASCOM: IW<NARR => (
VI_FREE(ARR+IW) AND 777777B;
DPROP('COM',VI)=1 => DPROPS('COM',VI,2);
IW_IW+1; GO TO ASCOM);
IW_E; SEG_1; ADR_400000B; SNO_0;
PASS2: IW=0=>GO TO P2X; OIW_IW; W_NXCW(IW); IW => (
UNPKCW(W);
CODE=1 => (
VI_W AND 777777B; OPC_(W RS 27) AND 177B;
OPC>11 => GO TO PASS2;
GO TO (SF0,SF1,SF2,SF3,SF4,SF5,SF5,PASS2,SF8,SF9,SF10,PASS2) OPC;
#TAG#
SF0: DPROP('ATYPE',VI)=7 => (ERROR(1,'DUPLICATE TAG'); ERTYP(VI);
ALIST(0,VI); GO TO PASS2);
DPROPS('SEM',VI,ADR); DPROPS('ATYPE',VI,7); REGCLR(0);
PUTS(VI,ADR)=2=>SNO_SNO+1; LIST=>ALIST(0,VI); GO TO PASS2;
#SAVE REGISTERS#
SF1: IW_SVREG(SNO,OIW,IW,VI); GO TO PASS2;
#RESTORE REGISTERS; VI NE 0 MEANS FORCE A REFERENCE TO THE REGISTER
WHICH IS INDEXED BY VI (THIS ALLOCATES THE REGISTER WHICH CONTAINS
THE RETURNED VALUE OF A FUNCTION). #
SF2: IW_RSREG(OIW,IW);
VI => (REGREF(VI); REGSET(VI,0,0,0,0,0));
GO TO PASS2;
#ENTER DELETE NO INSTRUCTIONS MODE#
SF3: SUPPR_0; GO TO PASS2;
#LEAVE DELETE NO INSTRUCTIONS MODE#
SF4: SUPPR_1; GO TO PASS2;
#RESERVE A REGISTER-- COUNT THIS AS A REFERENCE TO IT#
SF5: REGSET(VI,0,0,0,0,0); GO TO PASS2;
#RELEASE A PARTICULAR REGISTER#
SF8: REGSET(VI,0,0,0,0,0); RELREG(VI); GO TO PASS2;
#DECLARE REGISTER SCRATCH - WON'T BE SAVED & RESTORED#
SF9: REGSET(VI,0,0,0,0,0); RSCR(VI); GO TO PASS2;
#PROTECT REGISTER - SAVE & RESTORE#
SF10: REGSET(VI,0,0,0,0,0); RPRT(VI); GO TO PASS2); #END OF SPECIAL FUNCTIONS#
SW_W; W_NXCW2(IW);
CODE=0 =>
(OPC_(SW RS 24) AND 777B;
(OPC RS 3)=33B => (IXI=0=>(OPTSKP(IW,OPC,VIF,W,ADR)=>GO TO PASS2));
REGSET(ACI,IXI,W,VIF,OPC,1 AND SW RS 33) => SUPPR =>
(FREES(CO+OIW,400000000000B+IW); GO TO PASS2);
# IN DELETE NO INSTRUCTIONS MODE, PRESUMABLY INSTRUCTION MAY
BE SKIPPED (THAT'S WHY THE MODE EXISTS). THUS, ZAP
CONTENTS OF REGISTER AND/OR MEMORY AFFECTED. #
SUPPR=0=>( J_OCHK(OPC);
(J AND 1)=>ACI=>REGZAP(37B AND RGG(R) RS 13,0);
(J AND 2)=>REGZAP(-1,W));
VIF=0 => ((I_W<R>) => MKVAR(I,ADR,OPC)))
ELSE
(I_SW AND 777777B) => MKVAR(I,ADR,202B);
ADR_ADR+1; GO TO PASS2);
P2X: SEG=>(IW_F; SEG_0; HADR_ADR; ADR_0; GO TO PASS2);
LADR_ADR;
IW_0; LIST => ALIST(6,0);
ASVEC: IW<NARR => (
W_FREE(ARR+IW); VI_W AND 777777B;
DPROP('ATYPE',VI)=7 => (
ERROR(2,'VECTOR APPEARS IN MORE THAN ONE DECLARATION');
ERTYP(VI); ALIST(0,VI); GO TO NXVEC);
DPROPS('SEM',VI,ADR); DPROPS('ATYPE',VI,7); PUTS(VI,ADR);
LIST => ALIST(0,VI);
ADR_ADR+(W RS 18);
NXVEC: IW_IW+1; GO TO ASVEC);
IW_-1; VEND_ADR; LIST => ALIST(6,0);
ASSCA: (IW_DSEQ(IW)) GE 0 => (
DPROP('ATYPE',IW)=6 =>
(I_CONVC(IW);
I=0=>(LIST => ALIST(0,IW);
DPROPS('SEM',IW,ADR); PUTS(IW,ADR);
DPROP('ENTRY',IW) NE 7 => (
ERROR(2,'QUESTIONABLY DEFINED VARIABLE');
ERTYP(IW); PNAME(IW); ALIST(6,0));
ADR_ADR+1; GO TO ASSCA);
I NE 0=>(DPROPS('SEM',IW,NLCONS);
I=-1 => FADD(LCONS,NLCONS,CONST);
I>0 => (VI_FREE(I); IX_0;
SVCNS: (IX_IX+1) LE VI => (
FADD(LCONS,NLCONS,FREE(I+IX));
GO TO SVCNS))));
GO TO ASSCA);
SEND_ADR;
STCONS_(E=>HADR ELSE ADR); LIST => ALIST(7,NLCONS);
E=>HISEG(HADR);
IMPM=>(E=>STADR(400000B) ELSE STADR(0));
IW_E; SEG_1; STCODE(400000B);
PASS3: IW=0=>GO TO P3X; W_NXCW(IW); IW => (
UNPKCW(W); CODE=1=>(LIST=>(((W RS 27) AND 177B)=0=>ALIST(4,W AND 777777B));
GO TO PASS3);
I_NXCW2(IW);
CODE=3 =>
(C_I; (VI_W AND 777777B) => C_C+GETADR(VI,IXI) ELSE IXI_0)
ELSE
(J_((W LS 3) AND 777000000000B) OR ((W RS 11) AND 20000000B);
IXI=>J_J OR (GETREG(IXI) LS 18);
ACI=>J_J OR (GETREG(ACI) LS 23);
VI_I AND 777777B;
VIF => (C_J OR GETREG(VI); VI_IXI_0)
ELSE (I_I RS 18;
VI => C_J OR (GETADR(VI,IXI)+I) AND 777777B
ELSE (C_J OR I; IXI_0)));
ADR_PUT(C,IXI); LIST => ALIST(3,VI); GO TO PASS3);
P3X: SEG=>(NLCONS=>(IW_NLCONS-1; STCODE(STCONS);
PUT(FREE(LCONS+I),0) FOR I TO IW);
IW_F; SEG_0; STCODE(0); GO TO PASS3);
BRK1_STCONS+NLCONS; BRK2_(E=>SEND ELSE 0);
EASSEM(BRK1,BRK2); LIST => ALIST(9,0);
AST_CALLI(27B,0)-AST; ASTATS(0));
SUBR MKVAR(VI,A,OPC) IS (
DPROP('ATYPE',VI) NE 7 => (
DPROP('COM',VI) NE 1 => (DPROPS('ATYPE',VI,6);
OPC=320B=>M_2 ELSE M_OCHK(OPC);
M AND 2=>DPROPS('ENTRY',VI,7))
ELSE (PUTS(VI,A); DPROPS('SEM',VI,0)));
0);
SUBR GETADR(IW,IXI) IS (
RTV_DPROP('SEM',IW); IXI_1;
CONVC(IW) => RTV_RTV+STCONS
ELSE (DPROP('COM',IW)=1=>IXI_0);
RTV);
SUBR NXCW(I) IS (
GWC: J_FREE(CO+I);
(J RS 34)=2=>((I_J AND 777777B)=>GO TO GWC; GO TO EXITN);
I_I+1;
EXITN: J);
SUBR NXCW2(I) IS (
J_FREE(CO+I);
I_I+1; J);
SUBR UNPKCW(W) IS (
(CODE_W RS 34)=0 => (
ACI_(W RS 12) AND 3777B;
IXI_W AND 3777B;
VIF_(W RS 11) AND 1);
0);
#FCN WHICH OPTIMIZES EXPLICIT REGISTER USEAGE:
MOVE TREG,UREG
INST TREG,ANYTHING
MOVE UREG,TREG
BECOMES
INST UREG,ANYTHING #
SUBR OPTREG(IW) IS (
ADF_IW; AC_3777B AND (NXCW(ADF) RS 12); VI_3777B AND NXCW2(ADF);
OP_NXCW(ADF); ADR_NXCW2(ADF); C_NXCW(ADF);
VI=3777B AND C RS 12 => C AND 4000B => 200B=777B AND C RS 24 =>
(C_NXCW2(ADF); AC=3777B AND C =>
(FREES(CO+IW,(OP AND 777740007777B) OR (VI LS 12));
FREES(CO+IW+1,ADR); NXCW(IW); NXCW2(IW);
FREES(CO+IW,400000000000B+ADF);
REGREF(VI)));
0);
#FCN WHICH RECOGNIZES THE SEQUENCE:
SKIPX MEM WHEN MEM HAPPENS TO ALREADY BE IN A REGISTER
JRST L
THIS BECOMES:
JUMPNX R,L (WHERE REG R CONTAINS MEM) #
SUBR OPTSKP(IW,OPC,VIF,W,ADR) IS (
RTV_0; VIF=>VI_ W AND 777777B ELSE ((VI_REGCON(W))=0=>GO TO EXITSK);
ADF_IW; (C_NXCW(ADF)) RS 34 => (
C NE 203000000000B=>GO TO EXITSK; #IGNORE SCL FCN 3#
(C_NXCW(ADF)) RS 34=>GO TO EXITSK);
(I_777B AND C RS 24) NE 254B => (I NE 324B=>GO TO EXITSK);
C AND 100000007777B => GO TO EXITSK;
J_7 AND 4+(OPC AND 7); I_((320B OR J) LS 24) OR (VI LS 12);
C_NXCW2(ADF); (J_C AND 777777B) => MKVAR(J,ADR,0);
FREES(CO+IW-2,I); FREES(CO+IW-1,C); FREES(CO+IW,400000000000B+ADF);
ADR_ADR+1; IW_ADF; RTV_1;
EXITSK: RTV);
SUBR ERTYP(VI) IS (ADF_GNAME(VI); MSG([ADF]));
SUBR ALIST(L,V) IS (
GO TO ATG[L];
ATG: GO TO AL0; GO TO AL1; GO TO AL1; GO TO AL3; GO TO AL4;
GO TO AL5; GO TO AL6; GO TO AL7; GO TO AL8; GO TO AL9;
AL0: PRINT STG 3,' ', OCT 6,ADR, STG 3,' ';
PNAME(V); GO TO AL6;
AL1: PRINT OCT 4,IW-L, STG 4,' ', OCT 1,CODE, STG 1,' ',
OCT 3,OPC, STG 1,' ';
L=1 => PRINT OCT 6,V,/
ELSE PRINT OCT 4,ACI, IGR 2,VIF, STG 1,' ', OCT 4,IXI, OCT 15,V,/;
GO TO EXITA;
AL3: ADF_C AND 777777B; OP_C RS 27;
PRINT STG 3,' ', OCT 6,ADR-1,
STG 3,' ', OCT 6,C RS 18, STG 1,' ', OCT 6,ADF, STG 5,' ';
OPCODE(OP,O,M) => M_PRINT STG 0,O,M
ELSE M_PRINT OCT 3,OP;
AC_(C RS 23) AND 17B; IX_(C RS 18) AND 17B; I_I AND 777777B;
PRINT STG 38-M,' '; AC=>PRINT OCT 0,AC, STG 0,',';
C AND 20000000B => PRINT STG 0,'@';
V=>PNAME(V) ELSE (PRINT OCT 0,ADF; I_0);
I => (I AND 400000B=>PRINT STG 0,'-', OCT 0, -(I OR 777777000000B)
ELSE PRINT STG 0,'+', OCT 0,I);
IX => PRINT STG 0,'(', OCT 0,IX, STG 0,')';
GO TO AL6;
AL4: PRINT STG 25,' '; PNAME(V); PRINT STG 0,':',/; GO TO EXITA;
AL5: PRINT OCT 4,IW-2, OCT 16,SW, OCT 20,V,/; GO TO EXITA;
AL9: PRINT STG 33,'END',/; GO TO EXITA;
AL7: V => (PRINT /; ADF_V-1;
(PRINT STG 3,' ', OCT 6, STCONS+I,
OCT 15,FREE(LCONS+I),/) FOR I TO ADF);
GO TO AL6;
AL8: PRINT /, STG 0,'** CODE PRODUCED BY PROGRAM '; PNAME(V); PRINT /;
AL6: PRINT /;
EXITA: 0);
SUBR ASTIME(NIL) IS (AST);
SUBR ASTATS(NIL) IS (
HLEN_HADR-400000B;
PRINT /,STG 0, 'ASSEMBLY TIME = ', IGR 0,AST, STG 0, ' MSEC.',/,
' ', IGR 0,HLEN+LADR, STG 0,' WORDS OBJECT CODE',/;
HLEN=>PRINT ' ',IGR 0,HLEN+NLCONS,STG 0,' WORDS HIGH SEGMENT, ',
IGR 0,SEND,STG 0,' WORDS LOW SEGMENT',/;
PRINT ' ', IGR 0,VEND-LADR, STG 0,' WORDS VECTOR STORAGE, ',
IGR 0,SEND-VEND, STG 0,' WORDS SCALAR STORAGE, ',
IGR 0,NLCONS, STG 0,' CONSTANTS',/,/;
0) %%%