Trailing-Edge
-
PDP-10 Archives
-
BB-4157D-BM
-
sources/listng.bli
There are 26 other files named listng.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,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: D. B. TOLMAN/DCE/SJW
MODULE LISTNG(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN %LISTNG%
GLOBAL BIND LISTV = 5^24 + 1^18 + 19; ! VERSION DATE: 30-SEP-77
%(
REVISION HISTORY
1 ----- ----- ADD CODE TO INSTAT TO HANDLE THE
COMPIL "+" CONSTRUCT.
ADD CODE TO GETBUF,EOPRESTORE,EOPSAVE TO ALOW THE INCLUDE STATEMENT TO WORK
2 ----- ----- IT IS ALWAYS NICE TO TELL THE MOINTOR WHEN
YOU ARE GRABBING UP MORE CORE - EOPRESTORE
3 ----- ----- FIX SHIFTPOOL SO IT WON'T GO BANANAS IF THE
BEGINNING OF THE STATEMENT IS AT THE BEGINNING
OF POOL ALREADY.
FIX BUG IN THE HEADING - PAGEHEADER
4 ----- ----- ADD NEW DEBUG SWITCH OUTPUT TO HEADING
5 ----- ----- CHANGE INSTAT AND EOPRESTORE TO USE THE BUFFER
CORE REQUIREMENTS (BGSTBF) THAT WERE CALCULATED
IN COMMAN. FOR THE INCLUDE STATEMENT - SINCE
IT ONLY USES DSK WE CAN ASSUME THAT THE BUFFER
SIZES WILL NOT CHANGE FROM FILE TO FILE - SO
DON'T HAVE TO WORRY ABOUT ALLOCATING XTRA CORE
FIX PRINT SO THAT WHEN IT INSERTS A CR ( IE. NOCR
IS SET ) THAT IT INSERTS IT BEFORE THE LINE
TERMINATOR. THIS IS FOR THE OLD WORLD PRINTERS
THAT PRINT WHEN THEY SEE A CR
6 ----- ----- CHANGE CALLS TO ERROR - SOME OF ITS MESSAGES WERE
DELETED
7 ----- ----- SET ERRFLAG IN PRINT WHEN ERLSTR IS CALLED
IT WAS SUPPOSED TO BE SET BY BACKTYPE BUT
BACKTYPE DOES NOT GET CALLED IF THE LISTING
IS GOING TO THE TTY: . NOTHING BAD HAPPENED
EXCEPT LEXICA THOUGHT THINGS WERE INCONSISTANT
AND SAID SO...
CHANGE ALL INUUOS TO USE SKIP MACROS
8 ----- ----- ADD FTTENEX I/O CODE
9 ----- ----- FIX FTTENEX CODE
10 342 17876 FIX NUMEROUS BUGS FOR UNCLASSIFIABLE STATEMENT
(VERY LONG ONES)
11 351 MAKE THE LAST PATCH WORK
12 422 18493 IMBEDDED NULLS (MANY) CAUSE LOOPING
PREVENT THIS, AND CHANGE MESSAGE
13 467 VER5 REQUIRE FTTENX.REQ
14 506 10056 FIX FILES WITH LINE SEQUENCE NUMBERS
WHICH OCCUR AT BUFFER BOUNDARIES
***** BEGIN VERSION 5A *****
15 537 21811 LEXEME SPLIT ACROSS LINES GIVES BAD ERROR MSG
16 541 ----- -20 ONLY: CLEAR LASTCHARACTER IN READTXT AFTER
^Z SEEN SO MORE TTY: INPUT MAY BE DONE
17 556 ----- PUT /L IN HEADER IF LINE NUMBER/OCTAL MAP REQUESTED
18 561 10429 PAGE MARKS SHOULD BE IGNORED DURING CONTINUATION
LINE PROCESSING
19 621 QAR2120 MODIFY EDIT 561 IN CASE PAGE MARK ENDS FILE.
)%
REQUIRE FTTENX.REQ;
SWITCHES NOLIST;
REQUIRE LEXAID.BLI;
SWITCHES LIST;
EXTERNAL E112; !ERROR POINTER
EXTERNAL FATLEX,JOBREL,JOBFF;
EXTERNAL DIGITS,FNDFF;
EXTERNAL LINEOUT,CHAROUT,ERRLINK,SAVSPACE,STRNGOUT;
EXTERNAL NAME,CORMAN,MSGNOTYPD,ERRMSG,NUMFATL,NUMWARN,WARNOPT;
EXTERNAL NOCR,PAGE;
EXTERNAL FATLERR,WARNERR,BLDMSG,HEADING,STRNG6,STRNG7,ERROR;
!**;[342], LISTNG @284, DCE, 20-JAN-76
EXTERNAL MSNGTIC; !**;[342], NEED ACCESS WHEN RETURNING BOGUS CHARACTER
REQUIRE IOFLG.BLI; ! IO AND FLGREG DEFINITIONS
FORWARD BACKTYPE,SINPUT,READTXT,CHK4MORE;
MACRO FULL = 0,36 $;
OWN BTPTR; ! POINTER FOR BACK TYPE WHICH CONTAINS THE BYTE
! POSTION OF THE NEXT PORTION OF THE STATEMENT
! IN ERROR, TO BE TYPED
!**;[351], LISTNG @433, DCE, 13-FEB-76
!**;[351], MAKE ARINGLEFT A TRUE GLOBAL
EXTERNAL ARINGLEFT; !**;[351], USED FOR HANDLING BUFFERS CORRECTLY
!**;[351], IT MUST BE KEPT AROUND AT ALL TIMES FOR FORTB
MACRO SKIP(OP)=
BEGIN
MACHOP SETZ=#400, SETO=#474;
SETO(VREG,0);
OP;
SETZ(VREG,0);
.VREG
END$;
GLOBAL ROUTINE
DECREMENT (PTR) = ! DECREMENT BYTE POINTER PTR
BEGIN
% PTR CONTAINS A POINTER TO A BYTE POINTER %
STRUCTURE IND[P,S] = (@.IND)<.P,.S>;
MAP IND PTR;
IF (VREG _ .PTR[PFLD] + .PTR[SFLD] ) EQL 36
THEN ( PTR[PFLD] _ 1;
PTR[RIGHT] _ .PTR[RIGHT] - 1
)
ELSE PTR[PFLD] _ .VREG
;
END; %DECREMENT POINTER %
!**;[506], LISTNG @460, DCE, 29-OCT-76
!**;[506], SET UP THE ROUTINES NECESSARY TO BE CALLED
%[506]% FORWARD GETBUF,SHIFTPOOL,OVRESTORE,OVERFLOW;
GLOBAL ROUTINE
LINESEQNO ( PTRPTR ) =
% .PTRPTR CONTAINS THE ADDRESS OF A BYTE POINTER %
% DECODE THE LINESEQUENCE NUMBER POINTED TO BY ..PTRPTR AND RETURN IT
NOTE THAT ..PTRPTR IS UPDATED IN THE PROCESS %
% THE FOLLOWING TAB IF AY IS SKIPPED %
BEGIN
!**;[506], LINESEQNO @471, DCE, 29-OCT,76
!**;[506], NEED ONE MORE LOCAL
%[506]% LOCAL LINESAVE;
REGISTER T1;
VREG _ 0;
(@PTRPTR)<LEFT> _ #440700; ! SET BYTEPOINTER TO BEGINNING OF THE WORD
DECR N FROM 4 TO 0 DO
BEGIN
IF ( T1 _ SCANI ( @PTRPTR ) - "0" ) LSS 0 OR .T1 GTR 9
THEN
BEGIN
IF .T1 NEQ ( " " - "0" )
THEN WARNERR(.LINELINE,E112<0,0>);
T1 _ 0
END;
VREG _ .VREG * 10 +.T1
END;
!**;[506], LINESEQNO @486, DCE, 29-OCT-76
!**;[506], HERE IS THE BULK OF THE PATCH. BE SURE THAT THE
!**;[506], TAB FOLLOWING THE LINE SEQUENCE NUMBER DOES NOT
!**;[506], OCCUR IN THE NEXT BUFFER IN WHICH CASE WE HAVE TO
!**;[506], GO THROUGH ALL KINDS OF CONTORTIONS HERE
!**;[506], TO GET THE BUFFERS SET UP RIGHT AND THE TAB SKIPPED.
%[506]% LINESAVE_.VREG;
%[506]% T1_SCANI(@PTRPTR);
%[506]% IF .T1 EQL #177 !END OF BUFFER CHARACTER?
%[506]% THEN IF CURWORD EQL .CURPOOLEND !REALLY BUFFER END?
%[506]% THEN IF (T1_GETBUF()) EQL OVRFLO
%[506]% THEN(SHIFTPOOL();
%[506]% IF (T1_OVRESTORE()) EQL OVRFLO
%[506]% THEN T1_OVERFLOW(0,0)
%[506]% );
%[506]% ! NOW WE HAVE THE REAL NEXT CHAR IN T1
!**;[561], LINESEQNO @534, DCE, 12-APR-77
!**;[561], WE HAVE JUST SCANNED PAST A LINE SEQUENCE NUMBER, AND NOW ARE
!**;[561], LOOKING FOR A POTENTIAL TAB. IT IS POSSIBLE THAT THE LINE
!**;[561], SEQUENCE NUMBER WAS REALLY PART OF A PAGE MARK IN WHICH CASE
!**;[561], THE NEXT WORD IS A CARRIAGE RETURN, FORM FEED, NUL, NUL, NUL.
!**;[561], IF THIS IS THE CASE, SCAN PAST THIS ENTIRE WORD, PUTTING OUT
!**;[561], A NEW PAGE HEADER AS WE GO, AND LOOK FOR THE NEXT LINE SEQUENCE
!**;[561], NUMBER INSTEAD OF THE ZERO ONE WHICH WE HAVE JUST SEEN.
%[561]% IF .T1 NEQ " "
%[561]% THEN
%[561]% IF (@@@PTRPTR EQL #643^#30 AND .LINESAVE EQL 0) THEN
%[561]% BEGIN ! A PAGE MARK HAS BEEN SEEN
%[561]% (@PTRPTR)<RIGHT>_@@PTRPTR+1;
%[561]% (@PTRPTR)<LEFT>_#440700;
%[561]% FNDFF_1;
%[561]% IF .FLGREG<LISTING> THEN (CHAROUT(FF); HEADING());
!**;[621], LINESEQNO @532 (IN EDIT 621), DCE, 30-SEP-77
!**;[621], BEFORE RECURSION, CHECK LINE SEQUENCE BIT (MAY BE AT END OF FILE).
%[621]% IF @@@PTRPTR THEN RETURN LINESEQNO(@PTRPTR); ! GET REAL LSN
%[561]% END
%[561]% ELSE DECREMENT(@PTRPTR);
%[506]%
%[506]% RETURN .LINESAVE ;
END; % LINESEQNO %
MACHOP CALLI=#047,ROTC=#245,MOVEI=#201,HLLZ=#510;
MACHOP ROT=#241,HLRZ=#554,HRLZ=#514;
BIND JOBVER=#137;
EXTERNAL HEADSTR,BASENO,HEADPTR,PAGEPTR;
MACRO NXT(C) = REPLACEI ( HEADPTR, C ) $;
GLOBAL ROUTINE
PAGEHEADER =
BEGIN
REGISTER T[2];
!------------------------------------------------------------------------------------------------------------------
! PROGRAM NAME - LEAVE 6 CHARACTERS
!------------------------------------------------------------------------------------------------------------------
HEADPTR _ HEADSTR[1]<29,7>;
!------------------------------------------------------------------------------------------------------------------
! FILENAME - NOT NECESSARY
!------------------------------------------------------------------------------------------------------------------
NXT(" ");
IF (T[1]_@FILENAME(SRC)) NEQ 0 THEN
BEGIN
STRNG6( .T[1] );
IF HLLZ(T[1],EXTENSION(SRC)) NEQ 0 THEN
BEGIN
NXT(".");
STRNG6( .T[1] );
END
END;
NXT(" ");
STRNG7('FORTR');STRNG7('AN V.');
!------------------------------------------------------------------------------------------------------------------
! VERSION - DOESN'T CHANGE
!------------------------------------------------------------------------------------------------------------------
T[0]_@JOBVER;T[1]_0;
BASENO _ 8;
ROT(T[0],3);ROTC(T[0],9);DIGITS(.T[1]);T[1]_0;
ROTC(T[0],6);
IF .T[1] NEQ 0 THEN NXT( .T[1] + "@" );
IF HLRZ(T[1],T[0]) NEQ 0 THEN (NXT("(");DIGITS(.T[1]);NXT(")"); T[1]_0);
HRLZ(T[0],T[0]);ROTC(T[0],3);
IF .T[1] NEQ 0 THEN (NXT("-");DIGITS(.T[1]));
!
!SET IN KA OR KI VERSION AND /OPT IF OPTIMIZED
!
IF .FLGREG<KA10> THEN STRNG7( ' /KA') ELSE STRNG7( ' /KI');
IF .FLGREG<OPTIMIZE> THEN STRNG7( '/OPT');
IF .FLGREG<NOWARNING> THEN STRNG7('/NOWA');
IF .FLGREG<CROSSREF> THEN STRNG7('/C');
IF .FLGREG<SYNONLY> THEN STRNG7('/S');
IF .FLGREG<INCLUDE> THEN STRNG7('/I');
IF .FLGREG<MACROCODE> THEN STRNG7('/M');
IF .FLGREG<EXPAND> THEN STRNG7('/E');
IF .FLGREG<NOERRORS> THEN STRNG7('/NOER');
!**;[556], PAGEHEADER @594, DCE, 31-MAR-77
!**;[556], ADD /L TO PAGE HEADERS IF LINE NUMBER/OCTAL MAP REQUESTED
%[556]% IF .FLGREG<MAPFLG> THEN STRNG7('/L');
BEGIN %CHECK DEBUG FLAGS%
BIND DEBUGFLGS =
% FLGREG BIT POSITIONS FOR THE VARIOUS MODIFIERS%
1^DBGDIMNBR +
1^DBGINDXBR +
1^DBGLABLBR +
1^DBGTRACBR +
1^DBGBOUNBR ;
IF ( DEBUGFLGS AND .FLGREG<FULL> ) NEQ 0
THEN
BEGIN
STRNG7('/D:(');
IF .FLGREG<BOUNDS> THEN NXT("B");
IF .FLGREG<DBGTRAC> THEN NXT("T");
IF .FLGREG<DBGLABL> THEN NXT("L");
IF .FLGREG<DBGDIMN> THEN NXT("D");
IF .FLGREG<DBGINDX> THEN NXT("I");
NXT(")")
END
END;
!------------------------------------------------------------------------------------------------------------------
! DATE - DOESN'T CHANGE
!------------------------------------------------------------------------------------------------------------------
NXT(" ");
BASENO _ 10;
T[1]_(CALLI(T[0],#14) MOD 31)+1;DIGITS(.T[1]);
T[1]_@(PLIT('-JAN-','-FEB-','-MAR-','-APR-','-MAY-','-JUN-',
'-JUL-','-AUG-','-SEP-','-OCT-','-NOV-','-DEC-')
+(T[0]_.T[0]/31) MOD 12);
STRNG7(.T[1]);
T[1]_.T[0]/12 +64;DIGITS(.T[1]); NXT(" ");
!------------------------------------------------------------------------------------------------------------------
! TIME - DOESN'T CHANGE
!------------------------------------------------------------------------------------------------------------------
T[1]_CALLI(T[0],#23)/3600000;DIGITS(.T[1]); NXT(":");
T[1]_(T[0]_.T[0] MOD 3600000)/60000;IF.T[1] LSS 10 THEN NXT("0");DIGITS(.T[1]);
!------------------------------------------------------------------------------------------------------------------
! PAGE
!------------------------------------------------------------------------------------------------------------------
STRNG7(' PAGE'); NXT(" ");
PAGEPTR _ .HEADPTR; ! SAVE PAGE NUMBER POINTER
.VREG
END;
MACRO IOIMPM=17,1$,IODERR=16,1$,IODTER=15,1$,IOBKTL=14,1$,IODEND=13,1$;
MACRO RINGHDR = (.BUFPNT(SRC + .FLGREG<ININCLUD>)<RIGHT>) $;
MACRO RINGLENGTH = IF NOT FTTENEX
THEN .(RINGHDR )<RIGHT>
ELSE .XWORDCNT(SRC+.FLGREG<ININCLUD>) $;
MACRO RINGSTART = IF NOT FTTENEX
THEN (RINGHDR +1)
ELSE (.BUFFERS(SRC+.FLGREG<ININCLUD>)) $;
OWN LASTCHARACTER;
GLOBAL ROUTINE INSTAT =
% CHECK THE STATUS OF THE SOURECE INPUT DEVICE AND TERMINATE IF
ERROR OR RETURN EOF IF EOF %
BEGIN
IF NOT FTTENEX THEN
BEGIN
MACHOP GETSTS=#062;
REGISTER T1;
IF .FLGREG<ININCLUD>
THEN GETSTS(ICL,T1)
ELSE GETSTS(SRC,T1);
IF .T1<IODEND> THEN
BEGIN
% CHECK HERE FOR MULTIPLE FILES AND END OF INCLUDE%
IF NOT .FLGREG<EOCS> !END OF COMMAND STRING
THEN
BEGIN
%GET THE NEXT FILE%
EXTERNAL JOBFF,FFBUFSAV;
REGISTER SV;
EXTERNAL NXFILG;
LABEL CHK;
MACHOP INUUO = #056;
NXFILG();
%SEE IF WE GOT ANYTHING%
IF .FLGREG<ENDFILE> THEN RETURN EOF;
%NO MORE FILES%
% SET .JBFF BACK SO THE BUFFERS WILL BE
ALLOCATED IN THE SAME PLACE AS THE LAST ONES
AND NOT GET DESTROYED BY LATER PASSES %
SV _ .JOBFF;
JOBFF _ .FFBUFSAV;
IF SKIP( INUUO(SRC,0)) NEQ 0
THEN BEGIN
IF INSTAT() EQL EOF
THEN
BEGIN
%NOTHING%
FLGREG<ENDFILE> _ 1;
JOBFF _ .SV;
RETURN EOF;
END;
END;
%JUST CHECK TO MAKE SURE THAT EVERYTHING
IS OK %
BEGIN
EXTERNAL BGSTBF; !MAX BUF SIZE
IF (.FFBUFSAV+.BGSTBF) LSS .JOBFF
THEN ( EXTERNAL E61,LASTLINE,FATLERR;
FATLERR(.LASTLINE,PLIT'INSTAT',E61<0,0>)
)
END;
JOBFF _ .SV;
PAGEHEADER(); !CHANGE THE FILE NAME IN THE HEADING
RETURN 1; !GOT SOMETHING
END
ELSE
BEGIN
FLGREG<ENDFILE>_1;
RETURN EOF
END
END
ELSE
IF .T1<IOIMPM> THEN ERROR(0,SRC)
ELSE
IF .T1<IODERR> THEN ERROR(1,SRC)
ELSE
IF .T1<IODTER> THEN ERROR(2,SRC)
ELSE
IF .T1<IOBKTL> THEN ERROR(3,SRC);
RETURN 1
END ;
END;
ROUTINE TRANSFRING =
BEGIN
REGISTER T1,T2;
MACHOP BLT = #251;
% TRANSFER THE CURRENT RING BUFFER AND RETURN NEXT CHARACTER %
% IS THERE ENOUGH ROOM LEFT IN POOL FOR NEXT BUFFER %
% CONSISTANCY CHECK %
IF CURWORD NEQ .CURPOOLEND<RIGHT>
THEN INTERR('TRANSFRING');
VREG _ RINGLENGTH;
T2 _ .CURPOOLEND<RIGHT> + .VREG ;
!**;[342], TRANSFRING @703, DCE, 20-JAN-76
!**;[342], SET ARINGLEFT TO INDICATE PARTIAL BUFFER IS LEFT
%[342]% IF .T2 GTR POOLEND-1 THEN (ARINGLEFT_1; RETURN OVRFLO) ;
% THERE IS ENOUGH SPACE LEFT SO TRANSFER THE NEXT BUFFER %
VREG _ RINGSTART;
T1 _ .VREG^18 + .CURPOOLEND<RIGHT> ;
BLT(T1,-1,T2) ;
(@T2)<FULL> _ ENDBUFLAG ; % BUFFER TERMINATION FLAG %
CURPOOLEND _ .T2 ;
!**;[342], TRANSFRING @710, DCE, 20-JAN-76
!**;[342], RESET ARINGLEFT TO ALLOW NORMAL BUFFERING
%[342]% ARINGLEFT_0;
RETURN ..CURPTR ; % NEXT CHARACTER %
END ; % END OF TRANSFRING %
GLOBAL ROUTINE
CHK4MORE =
BEGIN
IF FTTENEX THEN
BEGIN
%SEE IF THERE ARE MORE INPUT FILES TO CONCATENATE %
IF NOT .FLGREG<EOCS>
THEN
BEGIN
%MIGHT BE%
EXTERNAL NXFILG;
NXFILG();
IF .FLGREG<ENDFILE> THEN RETURN EOF;
IF SINPUT(SRC) EQL EOF THEN RETURN .VREG;
PAGEHEADER();
RETURN 1 !GOT SOMETHING
END
ELSE
BEGIN
FLGREG<ENDFILE> _ -1;
RETURN EOF !NO MORE INPUT
END
END
END; %CHK4MORE%
GLOBAL ROUTINE
SINPUT ( DEV ) =
BEGIN
IF FTTENEX THEN
BEGIN
LOCAL VAL;
REGISTER R1=1,R2=2,R3=3;
MACHOP JSYS = #104 , JRST = #254 ;
MACRO SIN = JSYS(0,#52) $,
GTSTS = JSYS(0,#24) $;
LOCAL RSV[3];
%GET A BUFFER FULL OF INPUT %
RSV[0] _ .R1; RSV[1] _ .R2; RSV[2] _ .R3;
%TTY IS DONE A LITTLE DIFFERENTLY%
IF .FLAGS2<TTYINPUT>
THEN VAL _ READTXT()
ELSE
BEGIN
%SOME OTHER DEVICE%
EXTERNAL CLOSUP;
MACRO EOFBIT = 27,1 $;
R1 _ .XDEVJFN(.DEV);
R2 _ ( .BUFFERS(.DEV))<36,36> ;
R3 _ -XSINSIZ ;
SIN; !GET SOME
IF ( XWORDCNT(.DEV) _ .R3 + XSINSIZ ) EQL 0
THEN
BEGIN
%DIDN'T GET ANYTHING ???%
R1 _ .XDEVJFN(.DEV);
GTSTS;
IF .R2<EOFBIT>
THEN VAL _ CHK4MORE()
ELSE ( EXTERNAL JOBSA;
INTERR ('SINPUT');
CLOSUP();
JRST (0,.JOBSA<0,18>)
)
END
ELSE VAL _ 1;
END;
R1 _ .RSV[0]; R2 _ .RSV[1]; R3 _ .RSV[2];
RETURN .VAL
END
END; %SINPUT%
GLOBAL ROUTINE
READTXT =
BEGIN
IF FTTENEX THEN
BEGIN
%READ TTY INPUT - SRC ONLY %
REGISTER R1=1,R2=2,R3=3;
MACHOP JSYS = #104;
MACRO RDTXT = JSYS (0,#505) $;
BIND RDTOP = 34, !TOPS-10 BREAK CHARACTERS
RDJFN = 29; !USE JFN
%FIRST CHECK FOR END OF FILE%
IF .LASTCHARACTER EQL "?Z"
!**[541] READTXT @865 SJW 8-MAR-77
!**[541] -20 ONLY: CLEAR LASTCHARACTER AFTER ^Z SO MORE TTY: INPUT MAY BE DONE
%[541]% THEN BEGIN
%[541]% LASTCHARACTER _ 0;
%[541]% RETURN CHK4MORE ();
%[541]% END;
R1 _ .XDEVJFN(SRC);
R1<LEFT> _ .XDEVJFN(SRC);
R2 _ (.BUFFERS(SRC)<RIGHT>)<36,7>;
R3 _ 1^RDTOP + 1^RDJFN; !TOPS 10 BREAK
R3<RIGHT> _ XSINSIZ*5; !BYTE COUNT
IF SKIP(RDTXT) EQL 0
THEN
BEGIN
EXTERNAL FATLERR,E61,CLOSUP,JOBSA;
MACHOP JRST = #254;
FATLERR( PLIT'RDTXT',.LINELINE-1,E61<0,0>);
CLOSUP();
JRST(0,.JOBSA<0,18>) !HALT
END;
LASTCHARACTER _ ..R2; !SAVE LAST CHARACTER FOR EOF CHECK
%ZERO FILL%
(.R2<RIGHT>)<0,.R2<30,6>> _ 0;
XWORDCNT(SRC) _ .R2<RIGHT> - .BUFFERS(SRC) + 1;
RETURN 1;
END
END; %READTXT%
GLOBAL ROUTINE
GETBUF =
BEGIN
% READS IN THE NEXT RECORD OF THE INPUT FILE AND TRANSFERS IT
TO POOL. IF END OF FILE IT WILL RETURN EOF. IF NOT ENOUGH ROOM
IN POOL IT WILL RETURN OVRFLO. %
EXTERNAL ENTRY;
MACHOP INUUO=#056,BLT=#251;
LABEL CHK,CHK1;
IF .FLGREG<ENDFILE> THEN RETURN EOF; !CHECK FOR EOF
!**;[342], GETBUF @851, DCE, 20-JAN-76
!**;[342], CHECK FOR PARTIAL BUFFER STILL LEFT AND GO GET IT
%[342]% IF .ARINGLEFT NEQ 0 THEN RETURN TRANSFRING();
IF NOT FTTENEX
THEN
BEGIN
IF .FLGREG<ININCLUD>
THEN
BEGIN
IF SKIP( INUUO(ICL,0)) NEQ 0
THEN BEGIN
VREG_0;
IF INSTAT() EQL EOF THEN RETURN .VREG
END; %CHK%
END
ELSE
BEGIN
IF SKIP( INUUO(SRC,0)) NEQ 0
THEN BEGIN
IF INSTAT() EQL EOF THEN RETURN .VREG
END; %CHK%
END;
END
ELSE
BEGIN
IF SINPUT( IF .FLGREG<ININCLUD>
THEN ICL
ELSE SRC )
EQL EOF THEN RETURN .VREG
END;
% NO ERRORS OR EOF CONDITION DETECTED %
RETURN TRANSFRING() % TRANSFER THE RING BUFFER AND RETRUN NEXT CHARACTER %
END;
GLOBAL ROUTINE OVRESTORE =
BEGIN
% OVRESTORE WILL TRANSFER THE CURRENT RING BUFFER AREA TO THE INTERNAL
STATEMENT BUFFER (POOL) WITHOUT DOING AN INUUO. IT IS USED TO
CONTINUE PROCESSING AFTER AN INTERNAL STATEMENT BUFFER OVERFLOW,
WHICH WOULD HAVE PERFORMED AND INUUO BUT NOT TRANSFERED THE RING
BUFFER.
%
EXTERNAL ENTRY;
RETURN TRANSFRING() % TRANSFER THE RING BUFFER AND RETURN NEXT CHARACTER %
END ; % OVRESTORE %
GLOBAL ROUTINE EOPSVPOOL =
BEGIN
REGISTER T1,T2;
EXTERNAL CORMAN %()% ;
EXTERNAL ENTRY,NAME;
LABEL LOOP ,SEQNO;
MACRO P = .STLPTR<30,6> $,
BIT35 = 0,1 $,
STLWORD = STLPTR<RIGHT> $;
OWN SVFROM;
MACRO ADJUST = SVFROM $;
% SINCE EVERYONE ELSE WANTS TO USE POOL, EVERYTHING FROM THE BEGINNING
OF THE CURRENT STATEMENT AND ITS PRECEEDING LINE SEQUENCE NUMBER IF
ANY, MUST BE SAVED AWAY. THE LAST RING BUFFER ADDED IS STILL IN THE
RING BUFFER SO ONLY THAT WHICH COMES BEFORE IT NEED BE SAVED AND
IF WE ARE LUCKY THIS AMOUNT WILL BE NEGATIVE
%
% SEE IF THERE IS A LINE SEQUENCE NUMBER PRECEEDING, BY BACKING
UP IGNORING NULLS %
%CHECK PORTION OF THE CURRENT WORD TO THE LEFT OF THE CURRENT BYTE %
SVFROM _ .STLWORD;
SEQLAST _ 0; !CLEAR THE INTER PROGRAM UNIT SEQUENCE NUMBER SAVE FLAG
SEQNO:BEGIN
T1 _ .STLWORD;
IF .(.STLWORD) < P, 36-P > EQL 0
THEN T1 _ .T1 -1 ! NO FOLLOWING TAB
ELSE IF P LEQ 29 AND .(.STLWORD)<29,7> EQL " " %TAB% AND .(.STLWORD)<P,36-P-7> EQL 0
THEN % FOLLOWING TAB %
T1 _ .T1 -1
ELSE IF P NEQ 1
THEN LEAVE SEQNO ; ! NO LINE SEQUENCE NO
% WE HAVE A POSSIBLE LINE SEQ NO %
LOOP:BEGIN
WHILE @T1 GEQ POOLBEGIN
DO ( IF @@T1 NEQ 0
THEN ( IF .(@T1)<BIT35> EQL 1
THEN ( % WE HAVE A LINE SEQ# %
% SAVE LINESEQ NO JUST FOR
CONSISTENCY %
SVFROM _ .T1;
SEQLAST _ 1; ! FLAG LINESEQ NO
LEAVE SEQNO
);
SEQLAST _ 0;
LEAVE LOOP
)
ELSE T1 _ .T1-1
)
END %LOOP%
END %SEQNO% ;
% SVFROM IS NOW THE START OF WHAT MUST BE SAVED. %
% NOW WHAT HAS TO BE SAVED ? %
VREG _ RINGLENGTH;
IF ( T1_ .CURPOOLEND<RIGHT> - .VREG ) LEQ .SVFROM
THEN ( % WHAT IS NEEDED IS STILL IN THE RING BUFFER %
EOPSAVE _ 0 ;
)
ELSE ( % IN THIS CASE THE AREA FROM .SVFROM THROUGH .T1-1 MUST
BE SAVED %
SAVESIZE _ .T1 - .SVFROM ;
NAME <LEFT> _ .SAVESIZE ;
SAVESTART _ CORMAN();
T2<RIGHT> _ . SAVESTART ;
T2<LEFT> _ .SVFROM ;
T1 _ .SAVESTART + .SAVESIZE ;
BLT ( T2, -1 , T1 ) ;
);
% NOW FIX UP ALL THE LITTLE POINTERS %
ADJUST _ .SVFROM - POOLBEGIN;
CURPOOLEND _ .CURPOOLEND<RIGHT> - .ADJUST;
CURPTR _ .CURPTR - .ADJUST;
STLPTR _ .STLPTR - .ADJUST;
STPTR _ .STPTR - .ADJUST;
LINEPTR _ .LINEPTR - .ADJUST
END; % EOPSAVE %
GLOBAL ROUTINE EOPRESTORE =
BEGIN
REGISTER T1,T2;
EXTERNAL ENTRY;
OWN ADJUST; ! ADJUSTMENT OF RING BUFFER LENGTH AT TRANSFER TIME
EXTERNAL SAVSPACE %()% ,
LEXINIT %()% ;
%EOPRESTORE IS CALLED AT THE BEGINNING OF EACH PROGRAM UNIT. IT
WILL INITIALIZE POOL IN ORDER TO START PROCESSING THE PROGRAM UNIT.
IF .CURPOOLEND IS EQUAL TO POOLBEGIN THEN IT IMPLIES THAT THIS IS
THE FIRST PROGRAM UNIT IN THE COMPILATION. IN THIS CASE THE FIRST
RING BUFFER MUST BE READ IN AND TRANSFERED TO POOL BEFORE INITIALIZING
"LEXICAL()".
IF THIS IS NOT THE CASE THEN POOL HAS BEEN SAVED AWAY AFTER THE
LAST PROGRAM UNIT SO THE SPACE WOULD BE AVAILABLE TO THE LATER PASSES.
POOL MUST BE RESTORED. IF MORE THAN THE REMAINING CURRENT INPUT RING
BUFFER HAD TO BE SAVED IT WILL BE POINTED TO BY .EOPSAVE. THIS AREA
IS MOVED BACK TO THE BEGINNING OF POOL, FOLLOWED BY THE CONTENTS OF
THE CURRENT RING BUFFER.
THE SAVED AREA IS RESTORED STARTING AT POOLBEGIN. THE RING BUFFER
MUST END AT .CURPOOLEND-1. IF END OF FILE, EOF WILL BE RETURNED,
OTHERWISE 1.
%
MACHOP INUUO = #056 ;
LABEL CHK1,CHK;
OWN FFICLSV;
ROUTINE GETCORE =
BEGIN
EXTERNAL JOBFF,JOBREL;
UNTIL .JOBFF LSS .JOBREL
DO
BEGIN
EXTERNAL CORERR;
MACHOP CALLI = #047;
IF ( VREG _ .JOBREL + 1 ) GTR #400000 THEN CORERR();
%ALLOCATE%
CALLI(VREG,#11);
CORERR()
END
END; %GETCORE%
ROUTINE
BUFUP =
BEGIN
IF FTTENEX THEN
BEGIN
%SET UP OUTPUT BUFFERS%
IF .FLGREG<LISTING>
THEN
BEGIN
BUFFERS(LST) _ .JOBFF<RIGHT>;
BUFPNT(LST) _ (.JOBFF<RIGHT>)<36,7>;
BUFCNT(LST) _ XSOUTSIZ * 5;
JOBFF _ .JOBFF+ XSOUTSIZ;
GETCORE();
END;
IF .FLGREG<OBJECT>
THEN
BEGIN
BUFFERS(BIN) _ .JOBFF<RIGHT>;
BUFPNT(BIN) _ (.JOBFF<RIGHT>)<36,36>;
BUFCNT(BIN) _ XSOUTSIZ;
JOBFF _ .JOBFF+ XSOUTSIZ;
GETCORE();
END
END
END; %BUFUP%
IF .CURPOOLEND<RIGHT> EQL POOLBEGIN
THEN
BEGIN % COMPILATION INITIALIZATION %
GLOBAL FFBUFSAV;
EXTERNAL JOBFF;
%SAVE .JBFF SO THAT WHEN NEW INPUT FILES ARE OPENED
THEY CAN USE THE SAME LOW CORE SPACE %
IF FTTENEX
THEN
BEGIN
IF .FLGREG<ININCLUD>
THEN
BEGIN
IF .BUFFERS(ICL) EQL 0
THEN
BEGIN
%SET UP THE BUFFERS%
BUFFERS(ICL) _ .JOBFF<RIGHT>;
JOBFF_ .JOBFF + XSINSIZ;
GETCORE();
END;
IF SINPUT(ICL) EQL EOF THEN RETURN .VREG;
END
ELSE
BEGIN
%SOURCE INPUT INITIALIZATION%
BUFUP(); !SET UP OUTPUT BUFFERS NOW
BUFFERS(SRC) _ .JOBFF<RIGHT>;
BUFFERS(ICL) _ 0; !INITIALIZATION
JOBFF _ .JOBFF + XSINSIZ;
GETCORE();
IF SINPUT ( SRC ) EQL EOF THEN RETURN .VREG;
END
END
ELSE
BEGIN
IF .FLGREG<ININCLUD>
THEN
BEGIN
LOCAL SAVFF;
SAVFF _ .JOBFF;
IF .FFICLSV NEQ 0
THEN JOBFF _ .FFICLSV; !USE THE SAME BUFFER SPACE
IF SKIP( INUUO ( ICL,0 ) ) NEQ 0 ! FIRST INPUT BUFFER
THEN BEGIN
! OTHERWISE CHECK THE STATUS
% CHECKSTATUS RETURN EOF IF EOF
TERMINATE IF ERROR
OTHERWISE CONTINUE %
IF INSTAT() EQL EOF THEN RETURN .VREG
END ; %CHK1%
IF .FFICLSV EQL 0
THEN FFICLSV _ .SAVFF !FIRST INCLUDE
ELSE JOBFF _ .SAVFF;
END
ELSE
BEGIN
EXTERNAL BGSTBF; !MAXIMUM BUFFER SIZE - CALCULATED
! BY COMMAN
FFBUFSAV _ .JOBFF;
IF SKIP( INUUO ( SRC,0 ) ) NEQ 0 ! FIRST INPUT BUFFER
THEN BEGIN
! OTH