Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/listou.bli
There are 26 other files named listou.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) 1973,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR F.INFANTE/DCE/SJW/JNG/TFV
MODULE LISOUT(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4,GLOROUTINES)=
BEGIN
! REQUIRES FIRST, TABLES, REQREL
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE REQREL.BLI;
SWITCHES LIST;
GLOBAL BIND LISTOV = 6^24 + 0^18 + 69; ! Version Date: 21-Jul-81
%(
***** Begin Revision History *****
39 ----- ------ GENERATE SYMBOL TABLE ENTRIES FOR FORMAT STMNTS,
USE THE SYMBOL "STMNT-NUMBER F"
40 ----- ----- FIX BUG IN EDIT 39
41 ----- ----- ADD ROUTINE "LSTFORMATS" TO LIST ALL FORMAT STMNTS
AT THE END OF A MACRO-EXPANDED LISTING
42 ----- ----- FIX BUG IN LSTFORMATS TO LIST RELATIVE ADDRS
CORRECTLY
43 ----- ----- CHANGE "OUTMDA" SO THAT WHEN PSYMPTR IS THE CODE
"PBFFORMAT" WE EXPECT THE RIGHT HALF OF THE INSTR
IN THE PEEPHOLE BUFFER TO CONTAIN A PTR TO THE
FORMAT STMNT (RATHER THAN THE REL ADDR OF THE FORMAT STRING)
44 ----- ----- TAKE OUT DEFINITIONS OF LOADER BLOCK TYPES - PUT
THEM INTO A SEPARATE "REQUIRE" FILE.
ALSO REMOVE THE ROUTINES "ZOUTBLOCK" AND
"ZDMPBLK". ZOUTBLOCK HAS BEEN MOVED TO THE MODULE
RELBUF. ZDMPBLK IS NO LONGER NEEDED.
ALSO, EDIT "ZENDALL" TO OUTPUT ANY CODE
LEFT IN THE BUFFERS SYMRLBF,LOCRLBF, AND MAINRLBF.
ALSO REMOVE THE ROUTINE "DATAOUT", MAKE OUTDATA CALL
ZOUTBLOCK INSTEAD.
ALSO REMOVE THE ROUTINE DMPRELONLST.
ALSO REMOVE ALL REFERENCES TO "RELOCPTR" AND "RELBLOCK"
AND DELETE THEIR DEFINITIONS.
45 ----- ----- REMOVE THE ROUTINES: ZOUTMSG,ZOUTSYM,ZOUTOCT,RADIX50,
ZOUDECIMAL,ZOUOFFSET.
THESE HAVE BEEN PUT INTO THE MODULE "RELBUFF"
46 ----- ----- REMOVE THE ROUTINE LSTRLWD WHICH HAS BEEN
PUT INTO THE MODULE RELBUF
47 ----- ----- TAKE OUT DEF OF THE MACRO "CRLF" - IT IS NOW
IN THE REQUIRE FILE "REQREL"
48 ----- ----- REMOVE THE ROUTINE OUTDATA - ITS NOT NEEDED IN
FORTG
49 ----- ----- IN ZENDALL - MUST CALL DMPMAINRLBF (TO DUMP
ANY CODE IN THE BUFFER) BEFORE DUMPING
THE CONTENTS OF THE FIXUP BUFFERS
50 ----- ----- IN LSTINST MOVE THE OUTPUT OF THE MACRO
LISTING HEADING TO PHA3 SO THAT THE SIXBIT FUNCTION
NAME WILL COME OUT AFTER THE HEADING
IN OUTMDA - CHANGE IT SO THAT IT PUTS OUT
A CRLF AT THE BEGINNING OF EACH LINE INSTEAD OF
AT THE END. THIS WILL MATCH THE WAY LSTINST DOES
IT AND STRAIGHTEN OUT THE LISTING
PUT PAGEHEADING CHECKS IN BOTH OF THE ABOVE ROUTINES
51 ----- ----- PUT OUT F LABELS AT THE END OF FORMAT STRINGS IF
THE FLAG "DBGLABL" IS SET; OUTPUT L LABELS FOR
THE LINES IF THE FLAG "DBGLABL" IS SET. HAVE P
LABELS AT START OF FORMAT STMNTS.
52 ----- ----- PUT OUT THE SYMBOL '.VEND' AFTER THE END
OF THE SCALARS AND ARRAYS
53 ----- ------ DO NOT PUT OUT THE EXIT UUO (HAVE CALL TO FOROTS
EXIT.)
54 15349 247 CHANGE ALL REFERENCES TO FORMAT LABELS TO XXXXP, (JNT)
55 QAR 317 FIX 247 TO STILL PUT XXF ON END, FIX SYMBOL TABLE, (JNT)
56 18015 356 PUT OUT GLOBAL MAIN. FOR MAIN PROG, (DCE)
57 19477 461 CHECK SIZES OF HIGH AND LOW SEGMENTS FOR OVERFLOW, (DCE)
58 QA754 464 ADD LINE/OCTAL MAP OUTPUT IF NO MACRO LISTING, (SJW)
59 QA754 476 MAKE LINE/OCTAL MAP OPTIONAL UNDER /MAP=MAPFLG, (SJW)
***** Begin Version 5A *****
60 22281 555 FIX MAP WITH ENTRY POINTS, (DCE)
61 23760 614 OUTPUT ONLY NON-BLANK LINES IN /LNMAP, (SJW)
***** Begin Version 5B *****
62 23066 636 DON'T DUMP LABELS TO THE REL FILE THAT WE DON'T
KNOW THE VALUE OF. ALSO SET SNDEFINED WHEN
WE FILL IN THE SNADDR FIELD., (JNG)
63 25249 645 ENTRY POINTS CAUSE LINE COUNT TO BE OFF BY ONE, (DCE)
64 25250 646 SIXBIT SUBROUTINE NAMES HAVE LOCATION 0, (DCE)
65 25247 650 IMPROVE LISTING FILE WITH RESPECT TO DOUBLE
PRECISION AND STRING LITERAL CONSTANTS, (DCE)
66 26442 705 USE NAME FROM PROGRAM STATEMENT AS THE ENTRY
POINT FOR THE MAIN PROGRAM, (DCE)
67 ----- 734 ONLY PRINT DP CONSTANTS IN LISTING WHEN APPROPRIATE,
(DCE)
***** Begin Version 6 *****
68 761 TFV 1-Mar-80 -----
Adjust mnemonic table offset to deal with GFAD, etc.
Print double octal literals for GFAD, etc. (/GFLOATING)
69 1003 TFV 1-Jul-80
Add global symbol ..GFL. if compiling /GFLOATING for FORDDT
support. Suppress DDT output of .VEND and ..GFL. .
***** End Revision History *****
)%
!THE ROUTINES IN THIS MODULE ARE FOR THE PURPOSE
!OF GENERATING THE FOLLOWING THINGS:
% THE MACRO EXPANDED LISTING OF THE CODE GENERATED
I .THE GENERATION OF THE RELOCATABLE BINARY INFORMATION IN THE
.REL FILE
%
EXTERNAL ZOUTMSG,ZOUTSYM,ZOUTOCT,RADIX50,ZOUDECIMAL,ZOUOFFSET;
EXTERNAL HEADCHK; !CHECKS LINE COUNT AND OUTPUTS HEADINGS
EXTERNAL RDATWD,RELOUT; !CONTAINS CURRENT REL DATA WD
EXTERNAL ZOUTBLOCK;
EXTERNAL LSTOUT,ERROUT,
LOWLOC, !CURRENT LOWSEG AVAILABLE LOCATION
HILOC, !CURRENT HISEG AVAILABLE LOCATION
RELBLOCK, !RELOCATABLE BINARY BLOCK
RELDATA, !DATA WORD <LEFT> = CURRENT BLOCK NUMBER
!<RIGHT> = CURRENT DATA COUNT
RELOCWD; !THE RELOCATION WORD FOR THE BLOCK
!
MACRO EXITUUO = #047000000012$;
!
!
ROUTINE DMPSYMTAB= !DUMPS THE SYMBOL TABLE TO REL FILE
BEGIN
EXTERNAL SYMTBL,LABTBL,FRSTLNK,RADIX50,ZOUTBLOCK,PROGNAME;
EXTERNAL FORMPTR; !PTR TO 1ST FORMAT STMNT IN PROGRAM
OWN LABL;
LOCAL BASE SYMPTR;
EXTERNAL ENDSCAA;
ROUTINE BLDLABL=
%(***************************
LOCAL ROUTINE TO BUILD THE SIXBIT FOR THE
DECIMAL FORM OF THE STMNT NUMBER IN THE REG "R1".
CALLED WITH THE VAR "LABL" CONTAINING ONE
SIXBIT CHAR IN THE LEFTMOST SIX BITS. LEAVES "LABL" CONTAINING
THE STMNT NUMBER FOLLOWED BY THAT CHAR.
****************************)%
BEGIN
DO (
LABL _ .LABL ^(-6);
R2 _ .R1 MOD 10; R1 _ .R1/10;
LABL<30,6> _ (#20[.R2]<0,0>); !MAKING ROOM FOR NEXT
IF .R1 EQL 0 THEN EXITLOOP;
) WHILE 1;
END;
%(**DUMP THE SYMBOL TABLE***)%
DECR I FROM SSIZ-1 TO 0 DO
BEGIN
IF (SYMPTR _ .SYMTBL[.I]) NEQ 0
THEN BEGIN
DO BEGIN
IF .FLGREG<DBGDIMN> !IF USER SPECIFIED THE "DEBUG" SWITCH
THEN ! THEN FOR ALL ARRAYS WE WANT TO
! PUT A PTR IN THE SYMBOL TABLE ENTRY POINTING
! TO THE DIMENSION INFORMATION FOR THE ARRAY
BEGIN
IF .SYMPTR[OPRSP1] EQL ARRAYNM1
AND ((NOT .SYMPTR[IDATTRIBUT(NOALLOC)])
OR .SYMPTR[IDATTRIBUT(INCOM)]) !PUT IN COMMON
THEN
BEGIN
%(**USE THE KLUGE OF ADDING A 2ND ENTRY
FOR THE SAME SYMBOL IMMEDIATELY
FOLLOWING ITS TRUE DEFINITION, WHERE THIS ENTRY
POINTS TO THE DIMENSION INFORMATION**)%
REGISTER BASE T1;
R2_.SYMPTR[IDSYMBOL];
RDATWD_RLOCDDTSUP+RADIX50(); !SUPPRESS THIS 2ND
! DEF FROM DDT
ZOUTBLOCK(RSYMBOL,RELN);
T1_.SYMPTR[IDDIM]; !PTR TO DIMENS TABLE ENT
T1_.T1[ARADLBL]; !PTR TO LABEL TABLE ENTRY FOR
!LABEL ON DIMENS INFO ARG BLOCK
RDATWD_.T1[SNADDR]; !REL ADDR OF LABEL
ZOUTBLOCK(RSYMBOL,RELRI);
END
END;
IF .SYMPTR[IDATTRIBUT(INCOM)]
THEN
BEGIN
MAP BASE R2;
R2 _ .SYMPTR[IDSYMBOL]; RDATWD _ RLOCREQ+RADIX50();
ZOUTBLOCK(RSYMBOL,RELN);
RDATWD _ .SYMPTR[IDADDR]; !COMMON BLOCK OFFSET
ZOUTBLOCK(RSYMBOL,RELN);
R2 _ .SYMPTR[IDCOMMON]; R2 _ .R2[COMNAME];
RDATWD _ RGLOBREQ + RADIX50();
ZOUTBLOCK(RSYMBOL,RELN);
R2 _ .SYMPTR[IDSYMBOL]; RDATWD _ RLOCFIX + RADIX50();
ZOUTBLOCK(RSYMBOL,RELN);
END
ELSE
IF .SYMPTR[OPRSP1] NEQ FNNAME1 AND
NOT .SYMPTR[IDATTRIBUT(NOALLOC)] THEN
BEGIN
R2 _ .SYMPTR[IDSYMBOL];
RDATWD _ RLOCREQ + RADIX50();
ZOUTBLOCK(RSYMBOL,RELN);
RDATWD _ .SYMPTR[IDADDR];
ZOUTBLOCK(RSYMBOL,RELRI);
END;
END WHILE (SYMPTR _ .SYMPTR[CLINK]) NEQ 0;
END;
END;
!
!OUTPUT A SYMBOL FOR THE WD AFTER THE END OF THE SCALARS AND ARRAYS
R2_SIXBIT'.VEND';
![1003] Suppress DDT output of .VEND
%[1003]% RDATWD_RLOCDDTSUP+RADIX50();
ZOUTBLOCK(RSYMBOL,RELN);
RDATWD_.ENDSCAA; !LOC AFTER END OF ARRAYS/SCALARS
! (SET IN ALLSCA)
ZOUTBLOCK(RSYMBOL,RELRI);
![1003] Output the global symbol ..GFL. if compiling /GFLOAT for FORDDT support
%[1003]% IF .GFLOAT
%[1003]% THEN
%[1003]% BEGIN
%[1003]% R2_SIXBIT'..GFL.';
%[1003]% RDATWD_RGLOBDDTSUP+RADIX50();
%[1003]% ZOUTBLOCK(RSYMBOL,RELN);
%[1003]% RDATWD_1; ! give it the value of 1
%[1003]% ZOUTBLOCK(RSYMBOL,RELN);
%[1003]% END;
!
!
!DUMP THE LOCAL LABLES NOW
!
DECR I FROM LASIZ-1 TO 0 DO
BEGIN
IF (SYMPTR _ .LABTBL[.I]) NEQ 0 THEN
BEGIN
DO BEGIN
%[636]% IF .SYMPTR[SNDEFINED]
%[636]% THEN
%[636]% BEGIN
LABL _ 0;
R1 _ .SYMPTR[SNUMBER];
LABL<30,6> _ IF .R1 GTR 99999 THEN (R1 _ .R1-99999; SIXBIT "M" ) ELSE SIXBIT "P";
BLDLABL(); !IN "LABL" BUILD THE SIXBIT FOR
! THE STMNT NUMBER IN R1 (FOLLOWED BY THE CHAR
! ALREADY IN "LABL"
R2 _ .LABL;
RDATWD _ RLOCREQ + RADIX50();
ZOUTBLOCK(RSYMBOL,RELN);
RDATWD _ .SYMPTR[SNADDR];
ZOUTBLOCK(RSYMBOL,RELRI);
%[636]% END;
!
END WHILE (SYMPTR _ .SYMPTR[CLINK]) NEQ 0;
END;
END;
!
!DUMP THE LOCAL TEMPORARIES NAMES
!
WHILE .FRSTLNK NEQ 0
DO (
MAP BASE FRSTLNK;
R2 _ .FRSTLNK[IDSYMBOL];
RDATWD _ RLOCREQ + RADIX50();
ZOUTBLOCK(RSYMBOL,RELN);
RDATWD _ .FRSTLNK[IDADDR];
ZOUTBLOCK(RSYMBOL,RELRI);
FRSTLNK _ .FRSTLNK[CLINK]
);
!
!DEFINE A LABEL OF THE FORM <STMNT NUMBER>F ON THE LAST WD
! OF EACH FORMAT SRING
IF .FLGREG<DBGLABL>
THEN
!
BEGIN
REGISTER BASE FPTR; !PTR TO FORMAT STMNT NODE
FPTR_.FORMPTR<LEFT>; !1ST FORMAT STMNT IN PROGRAM
UNTIL .FPTR EQL 0
DO
BEGIN
SYMPTR_.FPTR[SRCLBL]; !STMNT NUMBER TABLE
! ENTRY FOR THE LABEL ON THE FORMAT
R1_.SYMPTR[SNUMBER]; !STMNT NUMBER ON THE FORMAT STMNT
LABL_0;
LABL<30,6>_SIXBIT"F";
BLDLABL(); !SET "LABL" TO THE SIXBIT FOR
! <STMNT NUMBER>P
R2_.LABL;
RDATWD_RLOCREQ+RADIX50();
ZOUTBLOCK(RSYMBOL,RELN);
RDATWD_.FPTR[FORADDR]+.FPTR[FORSIZ]-1; !ADDR OF LAST WD OF STRING
ZOUTBLOCK(RSYMBOL,RELRI);
FPTR_.FPTR[FMTLINK] !GO ON TO NEXT FORMAT
END;
END;
END; !OF DMPSYMTAB
ROUTINE ZSIXBIT(ZVAL)= !CONVERT ZVAL TO SIXBIT SYMBOL
BEGIN
R2 _ SIXBIT 'P';
DECR I FROM 5 TO 0 DO
BEGIN
R2 _ .R2^(-6); R2<30,6> _ (.ZVAL MOD 10) + #40; ZVAL _ .ZVAL/10;
IF .ZVAL EQL 0 THEN EXITLOOP;
END;
RETURN .R2
END;
!
%[650]% EXTERNAL STRNGOUT;
%[650]% ROUTINE ZDOUTCON(WORD2)=
%[650]% BEGIN
%[650]% !LIST A DOUBLE WORD CONSTANT IN OCTAL
%[650]% !WORD ONE IS IN R2; SECOND WORD IS IN WORD2
%[650]%
%[650]% STRNGOUT(PLIT ASCIZ '[EXP ');
%[650]%
%[650]% DECR I FROM 11 TO 0 DO
%[650]% BEGIN
%[650]% R1_0; LSHC(R1,3);
%[650]% CHR_.R1+#60; LSTOUT();
%[650]% END;
%[650]%
%[650]% CHR_","; LSTOUT();
%[650]%
%[650]% R2_.WORD2;
%[650]% DECR I FROM 11 TO 0 DO
%[650]% BEGIN
%[650]% R1_0; LSHC(R1,3);
%[650]% CHR_.R1+#60; LSTOUT();
%[650]% END;
%[650]%
%[650]% CHR_"]"; LSTOUT();
%[650]% END;
%[650]% ROUTINE ZSOUTCON(ADDR)=
%[650]% BEGIN
%[650]% !OUTPUT A STRING STARTING FROM ADDR AND BEING NO
%[650]% !MORE THAN 10 CHARACTERS. THE FORMAT WILL BE:
%[650]% ! [ASCIZ /STRING/{...}]
%[650]% MAP BASE ADDR;
%[650]% LOCAL STRING[3];
%[650]% MACRO LASTCHAR=1,7$;
%[650]%
%[650]% STRNGOUT(PLIT ASCIZ '[ASCIZ /');
%[650]%
%[650]% STRING[0]_.ADDR[CONST1];
%[650]% STRING[1]_.ADDR[CONST2];
%[650]% STRING[2]_0;
%[650]%
%[650]% STRNGOUT(STRING);
%[650]%
%[650]% !IS IT A LONG OR SHORT STRING?
%[650]% IF .STRING[0]<LASTCHAR> NEQ 0 AND .STRING[1]<LASTCHAR> NEQ 0
%[650]% AND .ADDR[CW5] NEQ 0
%[650]% THEN STRNGOUT(PLIT ASCIZ '/...]')
%[650]% ELSE STRNGOUT(PLIT ASCIZ '/]');
%[650]% END;
ROUTINE ZOUTCON=
BEGIN
!LIST A CONSTANT IN OCTAL ; R2 CONTAINS VALUE
CHR _ "["; LSTOUT();
DECR I FROM 11 TO 0 DO
BEGIN
R1 _ 0; LSHC(R1,3);
CHR _ .R1 + #60; LSTOUT();
END;
CHR _ "]"; LSTOUT()
END;
ROUTINE COMCOM=
BEGIN
EXTERNAL LSTOUT;
CHR_",";LSTOUT();LSTOUT()
END;
ROUTINE LSTINST(IPTR)=
BEGIN
%
ROUTNE LISTS ON LISTING DEVICE THE MACRO -10 MNEMONICS OF THE INSTRUCTIONS BEING GENERATED
%
MACRO
IISN = (@IPTR)<FULL>$, !LINENUMBER OF INSTRUCTION
ILABEL = (@IPTR+1)<LEFT>$,
IADDRPTR = (@IPTR+1)<RIGHT>$,
IOPCODE = (@IPTR+2)<27,9>$,
IAC = (@IPTR+2)<23,4>$,
IINDIR = (@IPTR+2)<22,1>$,
IINDEX = (@IPTR+2)<18,4>$,
IEFFADDR = (@IPTR+2)<RIGHT>$;
EXTERNAL CODELINES;
MACRO HEADRSW = CODELINES<LEFT>$;
LOCAL OPPOINT;
EXTERNAL OPMNEM;
!
ROUTINE ZLABLMAK(ILABLPT)=
BEGIN
%R1 CONTAINS LABEL IN BINARY%
MAP BASE ILABLPT;
R1_.ILABLPT[SNUMBER];
IF .R1 GTR 99999 THEN R1 _ .R1-99999; !REDUCE TO NICE RANGE
ZOUDECIMAL(); !OUTPUT VALUE OF R1 IN DECIMAL
IF .ILABLPT[SNUMBER] GTR 99999
THEN CHR _ "M" ELSE CHR _ "P";
LSTOUT(); .VREG
END; !OF ROUTINE ZMAKLABL
%[734]% LOCAL DINSTF; !DOUBLE WORD INSTRUCTION FLAG
EXTERNAL HEADCHK; !CHECK AND COUNT LINES ON PAGE
EXTERNAL ZOUDLB; !ROUTINE TO ADD TO THE MACRO EXPANDED LISTING A
! LABEL THAT IS INSERTED ON THE 1ST INSTR OF EACH STMNT WHEN
! THE USER HAS SPECIFIED THE "DEBUG" SWITCH
%[645]% EXTERNAL PAGELINE;
IF .HEADRSW NEQ #777777
THEN( CODELINES _ 0;
HEADRSW _ #777777
);
CRLF;
HEADCHK();
IF (R1 _ .IISN) GEQ 0
THEN IF .R1 EQL 0 THEN ( CHR _ "*"; LSTOUT()) ELSE ZOUDECIMAL();
CHR _ #11; LSTOUT(); !TAB
IF .IADDRPTR EQL PBFENTRY
THEN(MAP BASE R2;
!ENTRY NAME TAKES UP ONE LISTING LINE - ACCOUNT FOR IT
%[645]% CRLF; PAGELINE_.PAGELINE-1; CHR_#11; LSTOUT();
R2 _ .IEFFADDR; R2 _ .R2[IDSYMBOL]; ZOUTSYM();
CHR _ ":"; LSTOUT();
RETURN
);
!
!GEN THE RELATIVE LOCATION (OCTAL)
!
R2<LEFT> _ .CODELINES<RIGHT>; ZOUTOCT(); CHR _ #11; LSTOUT(); %TAB%
CODELINES _ .CODELINES + 1;
IF .ILABEL NEQ 0 !LIST A LABEL
THEN (
LOCAL BASE LABPT;
LABPT _ .ILABEL;
DO
(
ZLABLMAK(.LABPT);
CHR _ ":"; LSTOUT(); CRLF; HEADCHK();
CHR _ #11; LSTOUT(); LSTOUT(); !TAB
) WHILE (LABPT _ .LABPT[SNNXTLAB]) NEQ 0;
);
IF (R1_.IISN) GTR 0 AND .FLGREG<DBGLABL> !IF THE USER SPECIFIED THE "DEBUG" SWITCH
! THEN IFTHIS INSTR STARTS A STMNT, LIST
! AN "L" LABEL ON THIS INSTR
THEN ZOUDLB();
CHR _ #11; LSTOUT(); !TAB
%[734]% DINSTF_0;
!NOW DO THE INSTRUCTION LISTING
!
IF .IOPCODE NEQ 0
THEN(
!First mnemonic is now GFAD (#103)
%[761]% OPPOINT _ (OPMNEM-#103)[.IOPCODE]<0,6>; !MNEMONIC TABLE POINTER
INCR I FROM 0 TO 5 DO
(CHR _SCANI(OPPOINT,CHR); !GET A CHARACTER
IF(CHR _ .CHR + #40 ) LEQ #100 THEN EXITLOOP;
%[734]% IF .I EQL 0 THEN DINSTF_.CHR; ! PICK UP FIRST CHAR OF INSTRUCTION
LSTOUT()
)
);
CHR _ #11; LSTOUT(); !TAB
!AC FIELD
!
IF .IAC LEQ 7
THEN (CHR _ .IAC + #60; LSTOUT())
ELSE (CHR _ "1"; LSTOUT();
CHR _ (.IAC + #50); LSTOUT()
);
CHR _ ","; LSTOUT();
!
!INDIRECT BIT
!
IF .IINDIR NEQ 0 THEN (CHR _ "@"; LSTOUT());
!
!ADDRESS
!
BEGIN BIND ZADDR = IADDRPTR; MAP BASE ZADDR;
IF .IADDRPTR GTR PBF2LABREF
THEN
(IF SYMBOL(ZADDR)
THEN ( R2 _ .ZADDR[IDSYMBOL];
ZOUTSYM()
)
ELSE IF .ZADDR[OPERSP] EQL CONSTANT
THEN ( IF .ZADDR[DBLFLG] OR .ZADDR[VALTYPE] EQL REAL
THEN(IF .ZADDR[CONADDR] EQL .IEFFADDR
![650] IN THE CONSTANT CASE, DISTINGUISH BETWEEN SINGLE AND
![650] DOUBLE WORD CONSTANTS.
%[650]% THEN (R2 _ .ZADDR[CONST1];
![734] ONLY PRINT AS DOUBLE OCTAL IF INSTRUCTION IS DOUBLE WORD, I. E.,
![734] THE FIRST CHARACTER BEGINS WITH "D" (AVOID CAMXX).
![761] also if instruction starts with "G" (GFAD, etc.)
%[761]% IF .ZADDR[DBLFLG] AND
%[761]% (.DINSTF EQL "D" OR .DINSTF EQL "G")
%[761]% THEN RETURN ZDOUTCON(.ZADDR[CONST2]))
ELSE R2 _ .ZADDR[CONST2]
)
ELSE R2 _ .ZADDR[CONST2]; !ELSE INTEGER OR LOGICAL OR BYTE
RETURN ZOUTCON()
)
ELSE
(R2_.ZADDR[IDSYMBOL]; ZOUTSYM(););
IF (R1 _ EXTSIGN(.IEFFADDR) -.ZADDR[IDADDR]) NEQ 0 THEN ZOUOFFSET();
)
ELSE IF .IADDRPTR GTR 3 THEN BEGIN END
ELSE IF .IADDRPTR GTR 2
THEN BEGIN MAP BASE R2;
R2_.IEFFADDR; R2 _ .R2[IDSYMBOL];
ZOUTSYM()
END
ELSE IF .IADDRPTR GTR 1
THEN !DOTTED FUNCTION NAME
(R2 _@(.IEFFADDR);
ZOUTSYM()
)
ELSE IF .IADDRPTR GTR 0 !NO SYMBOLIC ADDR
THEN (R2<LEFT> _ .IEFFADDR; ZOUTOCT()) !IMMEDIATE MODE VALUE
ELSE ZLABLMAK(.IEFFADDR);
END;
!
!INDEX FIELD
!
IF .IINDEX NEQ 0
THEN ( CHR _ "("; LSTOUT();
IF .IINDEX LEQ 7
THEN (CHR _ .IINDEX +#60; LSTOUT())
ELSE (CHR _ "1"; LSTOUT();CHR _ .IINDEX +#50; LSTOUT()
);
CHR _ ")"; LSTOUT();
);
END; !OF ROUTINE LSTINST
ROUTINE LINEMAP (IPTR) =
!LIST ON LISTING DEVICE A LINE-NUMBER/OCTAL-LOCATION MAP IF
! NO MACRO LISTING WAS REQUESTED
BEGIN
EXTERNAL CODELINES, HEADCHK;
EXTERNAL LMLINO, ! CURRENT SOURCE LINE NUMBER
LMRONO, ! CURRENT MAP ROW NUMBER
LMCONO; ! CURRENT MAP COLUMN NUMBER
MACRO IISN = (@IPTR)<FULL>$,
IADDRPTR = (@IPTR+1)<RIGHT>$,
HEADRSW = CODELINES<LEFT>$;
IF .HEADRSW NEQ #777777
THEN BEGIN
CODELINES _ 0;
HEADRSW _ #777777;
END;
IF .IADDRPTR EQL PBFENTRY
THEN RETURN;
IF .IISN GTR 0 AND
.LMLINO LSS .IISN ! BEWARE 1 LINE NUM FOR >1 OCTAL LOC
THEN BEGIN
DO
BEGIN
IF (LMCONO _ .LMCONO + 1) EQL 10
THEN BEGIN
LMCONO _ 0;
CRLF;
HEADCHK ();
CHR _ "0";
IF (LMRONO _ (.IISN DIV 10) - 1) LSS 999
THEN BEGIN
LSTOUT ();
IF .LMRONO LSS 99
THEN BEGIN
LSTOUT ();
IF .LMRONO LSS 9
THEN LSTOUT ();
END
END;
R1 _ LMRONO _ .LMRONO + 1;
ZOUDECIMAL ();
CHR _ "0";
LSTOUT ();
CHR _ " ";
LSTOUT ();
CHR _ ":";
LSTOUT ();
CHR _ " ";
LSTOUT ();
LMLINO _ .LMRONO * 10 - 1;
END
ELSE BEGIN
CHR _ #11;
LSTOUT ();
END
END
WHILE (LMLINO _ .LMLINO + 1) LSS .IISN;
R2<LEFT> _ .CODELINES<RIGHT>;
ZOUTOCT ();
END;
CODELINES _ .CODELINES + 1;
END; ! OF ROUTINE LINEMAP
ROUTINE ROUIMFUN(FUNCPTR,FUNAME)= !OUTPUT FUNCTION REQUEST GLOBAL
BEGIN
RDATWD_.FUNCPTR<LEFT>^18; ZOUTBLOCK(RCODE,RELN);
R2 _ .FUNAME; !SIXBIT SYMBOL NAME
RDATWD_(RGLOBREQ +RADIX50()); ZOUTBLOCK(RSYMBOL,RELN);
RDATWD_RGLOB0^18 + .HILOC;
ZOUTBLOCK(RSYMBOL,RELRI)
END;
ROUTINE ROURLABEL(LABLPTR)=
BEGIN
MAP BASE LABLPTR;
RDATWD<LEFT> _ .LABLPTR<LEFT>;
IF .LABLPTR[SNSTATUS] NEQ OUTPBUFF THEN
%[636]% IF NOT .LABLPTR[SNDEFINED]
%[636]% THEN
%[636]% BEGIN
%[636]% LABLPTR[SNADDR]_0;
%[636]% LABLPTR[SNDEFINED]_TRUE;
%[636]% END;
RDATWD<RIGHT> _ .LABLPTR[SNADDR];
!
!AT THIS POINT RDATWD<RIGHT> CONTAINS EITHER 0 (IF FIRST TIME LABEL REFERENCED)
! OR A HI-SEG CHAIN ADDRESS IF NOT FIRST REFERENCE AND STILL UNDEFINED
! OR THE HI-SEG ADDRESS OF THE INSTRUCTION THE LABEL DEFINES
! THE VALUE OUTPBUFF MEANS THE LABEL HAS BEEN DEFINED TO LOADER
!
ZOUTBLOCK(RCODE,IF .LABLPTR[SNADDR] EQL 0 THEN RELN ELSE RELRI);
!RELOCATE (RELRI) ONLY IF NOT FIRST REFERENCE
%[636]% IF .LABLPTR[SNSTATUS] NEQ OUTPBUFF
%[636]% THEN
%[636]% BEGIN
%[636]% LABLPTR[SNADDR] _ .HILOC; !CHAIN THE REQUEST
%[636]% LABLPTR[SNDEFINED]_TRUE;
%[636]% END;
END; !END OF ROURLABEL
ROUTINE ROUSYM(INSTRUCTION,INSADDR)= !RELOCATABLE SYMBOLIC OUTPUT
BEGIN
MACRO ADD=3$,SUBT=4$;
MACRO POLISHREL(OP,OPER1,RELOC1,OPER2,RELOC2,SYM)=
BEGIN
RDATWD _ OP; !MEANS NEXT WD IS FULL WD OPERAND
ZOUTBLOCK(RPOLISH,RELN);
RDATWD _ OPER1; !FULL WORD
ZOUTBLOCK(RPOLISH,RELOC1);
RDATWD _ OPER2;
ZOUTBLOCK(RPOLISH,RELOC2);
RDATWD _ #777777^18 + .HILOC; !RIGHT HALF CHAINED FIXUP,, ADDRESS
ZOUTBLOCK(RPOLISH,RELRI);
END$;
MAP BASE R2;
LOCAL BASE SYMPTR; SYMPTR _ .INSADDR<RIGHT>;
!NOW CHECK FOR SUBROUTINE OR FUNCTION CALL
IF NOT SYMBOL(SYMPTR)
THEN (RDATWD _ .INSTRUCTION; ZOUTBLOCK(RCODE,RELRI);
RETURN
);
IF .SYMPTR[OPRSP1] EQL FNNAME1
THEN
IF (NOT .SYMPTR[IDATTRIBUT(FENTRYNAME)])
THEN IF (NOT .SYMPTR[IDATTRIBUT(DUMMY)])
THEN (ROUIMFUN(.INSTRUCTION,.SYMPTR[IDSYMBOL]);
RETURN
);
!HERE IF NOT A FUNCTION CALL OR SUBROUTINE CALL
RDATWD _ .INSTRUCTION;
IF ( EXTSIGN(.INSTRUCTION<RIGHT>)) LSS (-#400)
THEN
(RDATWD<RIGHT> _ 0;
ZOUTBLOCK(RCODE,RELN);
IF NOT .SYMPTR[IDATTRIBUT(INCOM)] THEN
POLISHREL(ADD^18+1,EXTSIGN(.INSTRUCTION<RIGHT>),
RELN,0,RELRI,.SYMPTR) !GENERAT A POLISH FIXUP BLOCK
ELSE
BEGIN
RDATWD _ ADD^18+2; !NEXT WD IS GLOBAL REQUEST
ZOUTBLOCK(RPOLISH,RELN);
R2 _ .SYMPTR[IDCOMMON]; R2 _ .R2[COMNAME];
RDATWD _ RGLOBDEF + RADIX50(); !A GLOBAL REQUEST POLISH FIXUP
ZOUTBLOCK(RPOLISH,RELN);
RDATWD _ #1777777; !1^18 + -1
ZOUTBLOCK(RPOLISH,RELN);
RDATWD _ .INSTRUCTION<RIGHT>^18+#777777;
ZOUTBLOCK(RPOLISH,RELN);
RDATWD _ .HILOC^18;
ZOUTBLOCK(RPOLISH,RELL); !FINALLY O/P THE FIXUP ADDRESS
END;
RETURN
)
ELSE
IF .SYMPTR[IDATTRIBUT(INCOM)]
THEN !GENERATE INSTRUCTION
(
ZOUTBLOCK(RCODE,RELN); !OUTPUT THE INSTRUCTION
R2 _ .SYMPTR[IDCOMMON]; R2 _ .R2[COMNAME];
RDATWD _ (RGLOBREQ + RADIX50());
ZOUTBLOCK(RSYMBOL,RELN); !OUTPUT SYMBOL BLOCK
RDATWD _ RGLOB4^18 + .HILOC; !THE FIXUP REQUEST
ZOUTBLOCK(RSYMBOL,RELRI);
RETURN
)
ELSE ZOUTBLOCK(RCODE,RELRI); !OUTPUT THE INSTRUCTION
END;
FORWARD GMULENTRY;
ROUTINE OUTMOD(CODEPTR, !PTR TO BLOCK OF CODE TO BE GENERATED
COUNT)= !#OF INSTRUCTIONS TO BE GENERATED
BEGIN
%
ROUTINE GENERATES THE RLOCATABLE BINARY INSTRUCTIONS FOR THE OMPILER. ALSO
RESPONSIBLE OFR CALLING ROUTINES THAT GENERATE THE MACRO CODE LISTING
AND THE ROUTINES THAT GENERATE SYMBOL INGORMATION FOR THE LOADER
%
EXTERNAL DEFISN; !ROUTINE CALLED FOR 1ST INSTR OF EACH LINE TO
! PUT OUT A LABEL CORRESPONDING TO THE LINE SEQ NUMBER
REGISTER CODEBLOCK;
MAP BASE R2;
MAP PEEPHOLE CODEPTR;
!
!LOOP ON COUNT WHERE COUNT IS THE NUMBER OF INSTRUCTIONS TO BE GENERATED
!BUT ONE-HALF THE SIZE OF THE CODE BLOCK
!
CODEBLOCK _ .CODEPTR<RIGHT>;
!OUTPUT LINE-NUMBER/OCTAL-LOCATION MAP IF NO MACRO LISTING
IF .FLGREG<LISTING>
THEN
INCR I FROM 0 TO .COUNT-1
DO BEGIN
IF .FLGREG<MACROCODE>
THEN LSTINST ((.CODEBLOCK)[.I*3])
ELSE
IF .FLGREG<MAPFLG>
THEN LINEMAP ((.CODEBLOCK)[.I*3]);
END;
!START RELOCATABLE BINARY GENERATON IF REQUESTED
IF .FLGREG<OBJECT>
THEN
INCR I FROM 0 TO (.COUNT-1) DO
BEGIN
LABEL REL1;
REL1: IF .CODEPTR[.I,PBFSYMPTR] GTR PBFENTRY
THEN (ROUSYM(.CODEPTR[.I,PBFINSTR],.CODEPTR[.I,PBFSYMPTR]); LEAVE REL1) !SYMBOLIC- IDENTIFIER,CONSTANT OR TEMP
ELSE !EITHER NOT SYMBOLIC, OR LABEL OR FUNCTION CALL OR LIBRARY FUNCTION CALL "DOTTED"
CASE .CODEPTR[.I,PBFSYMPTR] OF SET
%
0 - LABEL ADDRESS - PTR TO LABEL IN RH OF INSTRUCTION
%
ROURLABEL(.CODEPTR[.I,PBFINSTR]); !RELOCATABLE LABEL O/P
%
1- NO SYMBOLIC ADDRESS OUTPUT THE INSTRUCTION
%
BEGIN
RDATWD _ .CODEPTR[.I,PBFINSTR];
ZOUTBLOCK(RCODE,RELN);
LEAVE REL1
END;
%
2- FUNCTION CALL DOTTED
%
ROUIMFUN(.CODEPTR[.I,PBFINSTR],@(.CODEPTR[.I,PBFADDR])); !RELOCATABLE IMPLICIT FUNCTION CALL
%3- FUNCTION CALL NOT "DOTTED"
%
BEGIN MAP BASE R2;
R2_.CODEPTR[.I,PBFADDR];
ROUIMFUN(.CODEPTR[.I,PBFINSTR],.R2[IDSYMBOL]);
END;
%4-USED IN OUTMDA, NOT HERE
%
BEGIN END;
%5-USED IN OUTMDA, NOT HERE
%
BEGIN END;
%6-USED IN OUTMOD, NOT HERE
%
BEGIN END;
%7-USED IN OUTMDA, NOT HERE
%
BEGIN END;
%8-PBFENTRY, A GLOBAL ENTRY SYMBOL
%
BEGIN
GMULENTRY(.CODEPTR[.I,PBFADDR]); !SPECIAL CASE FOR GLOBAL ENTRY DEFINITIONS(NOT AN INSTRUCTION)
HILOC _ .HILOC-1; !DECREMENT HILOC TO OFFSET THE INCREMENT
!COMING AT END OF LOOP SO THAT
!NEXT INSTRUCTION WILL HAVE SAME ADDR
!AS THAT ASSIGNED TO ENTRY SYMBOL
END
TES;
!
!LEAVE REL1 EXPRESSION COMES HERE
!
IF .CODEPTR[.I,PBFLABEL] NEQ 0
THEN
(LOCAL BASE LINLABEL;
LINLABEL _ .CODEPTR[.I,PBFLABEL];
DO
BEGIN
%[636]% IF .LINLABEL[SNDEFINED]
THEN (
RDATWD _ .LINLABEL[SNADDR]^18+.HILOC;
ZOUTBLOCK(RLOCAL,RELB);
);
LINLABEL[SNSTATUS]_OUTPBUFF; !DEFINE IT (HAS PASSED THRU PBUFF)
LINLABEL[SNADDR] _ .HILOC; !DEFINING THE SYMBOL NOW
%[636]% LINLABEL[SNDEFINED]_TRUE;
END WHILE (LINLABEL_.LINLABEL[SNNXTLAB]) NEQ 0;
);
%(***IF THIS INSTRUCTION STARTS A SOURCE LINE, THEN
IF THE "DEBUG" SWITCH WAS SPECIFIED BY THE USER, OUPUT A LABEL FOR THIS INSTR**)%
IF .CODEPTR[.I,PBFISN] GTR 0 AND .FLGREG<DBGLABL> THEN DEFISN(.CODEPTR[.I,PBFISN]);
HILOC _ .HILOC + 1; !INCREMENT HISEG AVAILABLE LOCATION
END; !END OF INCR LOOP
.VREG
END; !OF ROUTINE
GLOBAL ROUTINE OUTMDA(ARPTR,ARCOUNT)=
BEGIN
%
ROUTINE OUTPUTS TO THE REL FILE THE ARG BLOCKS
FOR ALL STATEMENTS THAT USE THEM. THESE INCLUDE IOLISTS,
FUNCTION OR SUBROUTINE ARGUMENTS LISTS, AND
OTHER ARG LISTS.
THE CALL IS MADE TO THIS ROUTINE WITH A PTR TO THE ARGUMENT
CODE WORDS AND A COUNT OF THE NUMBER OF WORDS TO GENERATE.
THE FORMAT OF THE BLOCK OF WORDS IS SIMILAR TO THAT USED
IN A CAL TO OUTMOD TO OUTPUT INSTRUCTIONS.
%
EXTERNAL ZOUDECIMAL;
EXTERNAL ZOUOFFSET;
EXTERNAL CODELINES,LSTOUT,ZLABLMAK,ZOUTOCT,COMCOM,OUTMSG,ZOUTSYM;
MAP BASE R1:R2;
OWN HDRSW;
MACRO ILABEL = (@ARPTR)[.I+1]<LEFT>$,
IADDRPTR = (@ARPTR)[.I+1]<RIGHT>$,
ILADDR = (@ARPTR)[.I+2]<LEFT>$,
IRADDR = (@ARPTR)[.I+2]<RIGHT>$,
IARGWD = (@ARPTR)[.I+2]<FULL>$;
!
INCR I FROM 0 TO (.ARCOUNT-1)*3 BY 3 DO
BEGIN
IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE>
THEN
BEGIN
EXTERNAL HEADCHK;
CRLF;
HEADCHK();
CHR _ #11;LSTOUT();
!SUBROUTINE SIXBIT NAME SHOULD NOT PRINT LOCATION 0 (NONE AT ALL!)
%[646]% IF .CODELINES<RIGHT> NEQ 0 THEN (R2<LEFT>_.CODELINES<RIGHT>;
%[646]% ZOUTOCT());
%[646]% CHR_#11; LSTOUT();
CODELINES _ .CODELINES+1;
IF .ILABEL NEQ 0 THEN(ZLABLMAK(.ILABEL); CHR_":"; LSTOUT());
CHR_#11; LSTOUT(); !TAB
!FOR VARIOUS DATA (ENTRY POINTS) UPDATE OCTAL LOCATION COUNTER
END ELSE IF .FLGREG<MAPFLG> THEN CODELINES_.CODELINES+1;
SELECT .IADDRPTR OF NSET
PBFLABREF: EXITSELECT
(
IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE> THEN
BEGIN
R2<LEFT>_.ILADDR; ZOUTOCT();
COMCOM(); ! ",,"
ZLABLMAK(.IRADDR);
END;
IF .FLGREG<OBJECT> THEN
ROURLABEL(.IARGWD);
);
PBFNOSYM: EXITSELECT
(
IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE> THEN
BEGIN
R2<LEFT>_.ILADDR; ZOUTOCT();
COMCOM();
R2<LEFT>_.IRADDR; ZOUTOCT();
END;
IF .FLGREG<OBJECT> THEN
(RDATWD _ .IARGWD; ZOUTBLOCK(RCODE,RELN));
);
PBF2NOSYM: EXITSELECT
(
IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE> THEN
BEGIN
R2<LEFT>_.ILADDR; ZOUTOCT();
COMCOM();
R2<LEFT>_.IRADDR; ZOUTOCT();
END;
IF .FLGREG<OBJECT> THEN
(RDATWD _ .IARGWD; ZOUTBLOCK(RCODE,RELN));
);
PBFIMFN: EXITSELECT
(
IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE> THEN
BEGIN
R2<LEFT> _ .ILADDR; ZOUTOCT();
COMCOM();
R2 _ @.IRADDR; ZOUTSYM();
END;
IF .FLGREG<OBJECT> THEN
ROUIMFUN(.IARGWD,@.IRADDR);
);
PBFEXFN: EXITSELECT
(
IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE> THEN
BEGIN
R2<LEFT> _ .ILADDR; ZOUTOCT();
COMCOM();
R2 _ .IRADDR; R2 _ .R2[IDSYMBOL]; ZOUTSYM();
END;
IF .FLGREG<OBJECT> THEN
(R2_.IRADDR; ROUIMFUN(.IARGWD,.R2[IDSYMBOL]));
);
PBF2LABREF: EXITSELECT
(IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE> THEN
BEGIN
ZLABLMAK(.ILADDR); COMCOM(); ZLABLMAK(.IRADDR);
END;
IF .FLGREG<OBJECT> THEN
(R1 _ .ILADDR; R2 _ .IRADDR;
RDATWD _ .R1[SNADDR]^18 + .R2[SNADDR];
ZOUTBLOCK(RCODE,RELB);
);
);
PBFFORMAT: EXITSELECT
BEGIN
REGISTER BASE TPTR; !TEMPORARY PTR
IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE> THEN
BEGIN
R2<LEFT> _.ILADDR; ZOUTOCT();
COMCOM();
!TYPE THE P LABEL FOR THE RIGHT HALF
TPTR_.IRADDR; !PTR TO THE FORMAT STMNT
TPTR_.TPTR[SRCLBL]; !STMNT NUMBER TABLE ENTRY FOR THE LABEL
R1_.TPTR[SNUMBER]; ZOUDECIMAL(); !THE STMNT NUMBER OF THE FORMAT
CHR_"P"; LSTOUT(); !FOLLOWED BY "P"
END;
IF .FLGREG<OBJECT> THEN
BEGIN
TPTR_.IRADDR; !PTR TO FORMAT STMNT
RDATWD_.ILADDR^18 !LEFT HALF OF OUTPUT WD COMES DIRECTLY FROM PBUFF
+ .TPTR[FORADDR]; !RIGHT HALF IS REL ADDR OF THE FORMAT STMNT
ZOUTBLOCK(RCODE,RELRI);
END;
END;
OTHERWISE: BEGIN
IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE> THEN
(
R2<LEFT> _ .ILADDR; ZOUTOCT();
COMCOM();
R2 _ .IADDRPTR;
IF .R2[OPERSP] EQL CONSTANT
![650] IN ARGUMENT LISTS, TAKE CARE OF ARGUMENTS BASED ON THEIR TYPE.
%[650]% THEN BEGIN
%[650]% LOCAL TMP;
%[650]% IF .(@ARPTR)[.I+2]<23,4> EQL #17 THEN %STRING% ZSOUTCON(.R2) ELSE
%[650]% IF .R2[DBLFLG] THEN !DP OR COMPLEX CONSTANT
%[650]% (TMP_.R2[CONST2];
%[650]% R2_.R2[CONST1];
%[650]% ZDOUTCON(.TMP))
%[650]% ELSE (IF .R2[VALTYPE] EQL REAL
%[650]% THEN R2_.R2[CONST1]
%[650]% ELSE R2_.R2[CONST2];
%[650]% ZOUTCON());
%[650]% END
ELSE (R2 _ .R2[IDSYMBOL]; ZOUTSYM();
R2 _ .IADDRPTR;
IF (R1 _ EXTSIGN(.IRADDR) - .R2[IDADDR]) NEQ 0 THEN ZOUOFFSET();
);
);
IF .FLGREG<OBJECT> THEN ROUSYM(.IARGWD,.IADDRPTR);
END;
TESN;
IF .FLGREG<OBJECT> THEN
(IF .ILABEL NEQ 0
THEN
BEGIN
REGISTER BASE LABENT;
LABENT_.ILABEL;
%[636]% IF .LABENT[SNDEFINED]
THEN (
RDATWD _ .LABENT[SNADDR]^18+.HILOC;
ZOUTBLOCK(RLOCAL,RELB);
);
LABENT[SNSTATUS] _ OUTPBUFF; !THRU THE OUTPUT BUFFFER
LABENT[SNADDR] _ .HILOC; !DEFINING THE SYMBOL NOW
%[636]% LABENT[SNDEFINED]_TRUE;
END;
HILOC _ .HILOC + 1; !INCREMENT HISEG AVAILABLE LOCATION
);
END; !OF INCR I DO
END; !OF OUTMDA
GLOBAL ROUTINE ZENDALL(STADDR)= !FINISHES OUTPUT OF REL FILE
!FOR CURRENT PROGRAM
!DUMPS SYMBOL DTABLE
!DUMPS NEWLY DEFINED SYMBOLS
!OUTPUTS "END" BLOCK
BEGIN
EXTERNAL ISN,E142; !NEW ERROR MESSAGE - PROGRAM TOO LARGE
EXTERNAL FATLER; !NEED THIS FOR PRINTING ERROR MESSAGE
EXTERNAL ENDISNRLBLK;
EXTERNAL DMPRLBLOCK; !ROUTINE TO DUMP A BUFFERED REL-FILE BLOCK OUT
EXTERNAL ZOUTBLOCK,RADIX50,PROGNAME,DMPSYMTAB;
EXTERNAL SYMRLBF,LOCRLBF,MAINRLBF; !REL FILE BUFFERS
EXTERNAL DMPMAINRLBF; !TO DUMP THE MAIN REL-FILE BUFFER
MAP RELBUFF SYMRLBF:LOCRLBF:MAINRLBF;
IF .FLGREG<DBGLABL> THEN ENDISNRLBLK(); !IF THE USER SPECIFIED
! THE "DEBUG" SWITCH, OUTPUT THE SYMBOL DEFS FOR ANY
! LABELS REMAINING IN THE BUFFER OF LABELS TO BE INSERTED
! ON EACH SOURCE LINE
DMPSYMTAB(); !DUMP THE SYMBOL TABLE TO REL FILE
%(**DUMP ANY LOCAL REQUESTS,GLOBAL REQUESTS, AND SYMBOL DEFS THAT
ARE STILL IN THEIR BUFFERS**)%
DMPMAINRLBF(); !MUST OUTPUT ANY CODE BLOCKS TO THE REL FILE
! BEFORE DUMPING LOCAL AND G;LOBAL REQUESTS
!PUT OUT GLOBAL SYMBOL FOR MAIN PROGRAM
! SO LINK CAN WARN ABOUT TWO MAIN PROGRAMS
IF .FLGREG<PROGTYP> EQL MAPROG THEN
BEGIN
R2 _ SIXBIT'MAIN.';
RDATWD _ RGLOBDEF+RADIX50();
ZOUTBLOCK(RSYMBOL,RELN);
RDATWD _ .STADDR;
ZOUTBLOCK(RSYMBOL,RELRI);
![705] IF A REAL PROGRAM NAME WAS GIVEN TO THE PROGRAM, USE IT AS
![705] AN ENTRY POINT FOR THE MAIN PROGRAM - THIS IS THE ONLY WAY
![705] (SHORT OF A MACRO PROGRAM) TO GET THIS EFFECT.
%[705]% IF .PROGNAME NEQ SIXBIT'MAIN.' THEN
%[705]% BEGIN
%[705]% R2 _ .PROGNAME;
%[705]% RDATWD _ RGLOBDEF+RADIX50();
%[705]% ZOUTBLOCK(RSYMBOL,RELN);
%[705]% RDATWD _ .STADDR;
%[705]% ZOUTBLOCK(RSYMBOL,RELRI);
%[705]% END
END;
IF .SYMRLBF[RDATCNT] NEQ 0 THEN DMPRLBLOCK(SYMRLBF,.SYMRLBF[RDATCNT]+2);
IF .LOCRLBF[RDATCNT] NEQ 0 THEN DMPRLBLOCK(LOCRLBF,.LOCRLBF[RDATCNT]+2);
IF .FLGREG<PROGTYP> EQL MAPROG THEN (RDATWD _ .STADDR; ZOUTBLOCK(RSTART,RELRI)); !START ADDRESS BLOCK
RDATWD_.HILOC; ZOUTBLOCK(REND,RELRI);
RDATWD _ .LOWLOC; ZOUTBLOCK(REND,RELRI);
IF .MAINRLBF[RDATCNT] NEQ 0 THEN DMPRLBLOCK(MAINRLBF,.MAINRLBF[RDATCNT]+2);
!CHECK FOR HIGH AND LOW OVERFLOWS IF PROGRAM TOO LARGE
IF .HILOC GEQ 1^18 OR .LOWLOC GEQ 1^18
THEN FATLER(.ISN,E142<0,0>);
END;
ROUTINE GMULENTRY(MULSYM)=
BEGIN
!GENERATE AN ENTRY DEFINITION (GLOBAL) IN REL FILE FOR MULTIPLE ENTRY
!NAMES; OUTMOD MUST HAVE ALREADY BEEN CALLED TO DUMP ANY CODE IN PBUFF
!
MAP BASE MULSYM;
R2 _ .MULSYM[IDSYMBOL];
RDATWD _ (RGLOBDEF+RADIX50());
ZOUTBLOCK(RSYMBOL,RELN);
RDATWD _ .HILOC<RIGHT>;
ZOUTBLOCK(RSYMBOL,RELRI)
END;
GLOBAL ROUTINE LSTFORMATS=
%(***************************************************************************
ROUTINE TO LIST ALL THE FORMAT STMNTS IN A PROGRAM.
ASSUMES THAT THE GLOBAL "FORMPTR" POINTS TO THE 1ST
FORMAT STMNT. EACH FORMAT STMNT IS LINKED TO THE
NEXT BY THE "FMTLINK" FIELD
***************************************************************************)%
BEGIN
EXTERNAL PAGELINE,STRNGOUT,HEADING;
EXTERNAL ZOUDECIMAL;
EXTERNAL FORMPTR;
LOCAL RLOC; !RELATIVE LOC IN LOW SEG OF THE WD BEING LISTED
LOCAL BASE SNENTRY; !THE STMNT NUMBER TABLE ENTRY FOR
! THE STMNT NUMBER FOR A GIVEN FORMAT STMNT
REGISTER BASE FPTR; !PTR TO THE FORMAT STMNT BEING PRINTED
REGISTER CPTR; !BYTE PTR TO THE CHARACTER IN THE STRING
! TO BE LISTED
IF (FPTR_.FORMPTR<LEFT> ) EQL 0 !IF THERE ARE NO FORMAT STMNTS IN THIS PROGRAM
THEN RETURN;
%(**PRINT HEADER**)%
IF ( PAGELINE_.PAGELINE-4) LEQ 0
THEN ( HEADING(); PAGELINE_.PAGELINE-4);
STRNGOUT(PLIT ASCIZ'?M?J?M?JFORMAT STATEMENTS (IN LOW SEGMENT):?M?J?M?J');
%(***LIST ALL FORMAT STMNTS IN PROGRAM**)%
UNTIL .FPTR EQL 0
DO
BEGIN
R1_.FPTR[SRCISN]; ZOUDECIMAL(); !LINE NUMBER OF THIS FORMAT STMNT
CHR_#11; LSTOUT(); !TAB
RLOC_.FPTR[FORADDR]; !RELATIVE ADDRESS OF THE 1ST WD OF THE
! STRING
R2<LEFT>_.RLOC; ZOUTOCT(); !LIST IT
CHR_#11; LSTOUT(); !TAB
!LIST THE "P" LABEL
SNENTRY_.FPTR[SRCLBL]; !LABEL TABLE ENTRY FOR THE STMNT NUMBER
R1_.SNENTRY[SNUMBER]; !STMNT NUMBER
ZOUDECIMAL(); !LIST IT
CHR_"P"; LSTOUT(); ! FOLLOWED BY "P"
CHR_":"; LSTOUT(); ! FOLLOWED BY ":"
CHR_#11; LSTOUT(); !TAB
!LIST THE 1ST WD OF THIS FORMAT STRING
CPTR_(.FPTR[FORSTRING]-1)<0,7>; !BYTE PTR TO CHAR PRECEEDING
! THE 1ST CHAR OF THE STRING
DECR I FROM 4 TO 0 !LIST 5 CHARS
DO
(CHR_SCANI(CPTR); LSTOUT()); !INCR BYTE PTR TO NEXT CHAR AND LIST THAT CHAR
CRLF;
HEADCHK();
!LIST ALL WDS OF THE FORMAT STRING AFTER THE 1ST,
! PRECEEDING EACH BY ITS RELATIVE ADDRESS
DECR I FROM .FPTR[FORSIZ]-2 TO 0
DO
BEGIN
CHR_#11; LSTOUT(); !TAB
RLOC_.RLOC+1; !RELATIVE LOC OF THIS WD
R2<LEFT>_.RLOC;
ZOUTOCT(); !LIST IT
CHR_#11; LSTOUT(); !TAB
CHR_#11; LSTOUT();
DECR I FROM 4 TO 0 !LIST 5 CHARS
DO
(CHR_SCANI(CPTR); LSTOUT()); !INCR BYTE PTR TO NEXT CHAR AND LIST IT
CRLF;
HEADCHK();
END;
FPTR_.FPTR[FMTLINK]; !GO ON TO THE NEXT FORMAT STMNT
END;
END; !OF ROUTINE LSTFORMATS