Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
listng.bli
There are 26 other files named listng.bli in the archive. Click here to see a list.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1973, 1985
!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.
!AUTHOR: D. B. TOLMAN/DCE/SJW/RDH/TFV/EGM/CDM/AHM/PLB/PY/AlB
MODULE LISTNG(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN %LISTNG%
GLOBAL BIND LISTNV = #10^24 + 0^18 + #2527; !Version Date: 28-Mar-85
%(
***** Begin 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), (DCE)
11 351 MAKE THE LAST PATCH WORK, (DCE)
12 422 18493 IMBEDDED NULLS (MANY) CAUSE LOOPING
PREVENT THIS, AND CHANGE MESSAGE, (DCE)
13 467 VER5 REQUIRE FTTENX.REQ, SJW
14 506 10056 FIX FILES WITH LINE SEQUENCE NUMBERS
WHICH OCCUR AT BUFFER BOUNDARIES, (DCE)
***** Begin Version 5A *****
15 537 21811 LEXEME SPLIT ACROSS LINES GIVES BAD ERROR MSG, (DCE)
16 541 ----- -20 ONLY: CLEAR LASTCHARACTER IN READTXT AFTER
^Z SEEN SO MORE TTY: INPUT MAY BE DONE, (SJW)
17 556 ----- PUT /L IN HEADER IF LINE NUMBER/OCTAL MAP REQUESTED,
(DCE)
18 561 10429 PAGE MARKS SHOULD BE IGNORED DURING CONTINUATION
LINE PROCESSING, (DCE)
19 621 QAR2120 MODIFY EDIT 561 IN CASE PAGE MARK ENDS FILE., (DCE)
20 667 25664 ONE MORE TIME FOR PAGE MARKS - IF NULL WORD
FOLLOWS IT (END OF BUFFER), (DCE)
***** Begin Version 5B *****
21 677 25573 PRINT A P IF PARAMETER OPTION SPECIFIED, (DCE)
***** Begin Version 6 *****
22 750 TFV 1-Jan-80 ------
Remove Debug:Parameters (edit 677)
23 761 TFV 1-Mar-80 ------
Print /GFL if specified
24 767 DCE 20-May-80 -----
Add /F77 (future usage) to listing
25 1047 EGM 22-Jan-81 Q10-05325
Add support for TOPS-10 execute only.
26 1133 TFV 28-Sep-81 ------
Add /STatistics to listing. It is disabled in the released V6.
***** Begin Version 6A *****
1162 PY 29-Jun-82 ------
Replace oblsolete RDTXT JSYS with TEXTI. Add routine WRITECRLF
to type a CRLF when control-Z is read from a terminal. CONVERT
the ENDOFILE returned by LEXINI to EOF.
***** Begin Version 7 *****
27 1466 CDM 1-Feb-82
Printing /D(A) for /DEBUG:ARGUMENTS in listings.
1504 AHM 26-Feb-82
Display "/EXT" for /EXTEND in listing headers, change the
EXPAND switch to display "/EXP" to lessen confusion and print
"/NOF77" when not doing "/F77".
1600 PLB 9-Jul-82
Use ODTIM JSYS for header time & date. Make -Mth- be
mixed case so the -10 & -20 are identical. Use CORUUO routine
to manage core.
1613 CDM 13-Aug-82
Change /DEBUG:PARAMETERS to /DEBUG:ARGUMENTS
***** End V7 Development *****
2064 PLB 22-Jun-84 10-34728
Fix BACKTYPE of very very long lines.
***** Begin Version 10 *****
2447 PLB 10-Aug-84
Add support for nested INCLUDE files. Added many form feeds,
fixed spacing, moved FORWARDS, EXTERNALS, GLOBALS, OWNS, and
BINDS to top of MODULE.
2474 TFV 21-Sep-84, AlB 17-Oct-84
Fix continuation processing to handle unlimited numbers of blank
and comment lines between continuation lines. The lines are
recorded in a linked list of four word entries, defined in
LEXAID.BLI. If there are too many blank and comment lines, the
buffer will get an overflow. When this happens, the buffer is
compacted using the information in the linked list. The info is
also used to speed up continuation processing in the lexeme
scan.
2500 AlB 14-Nov-84
Change the list of entries for source lines from a linked list
in dynamic memory to a fixed-length list in static memory.
2501 AlB 20-Nov-84
Special handling of errors found in comment lines. Since these
errors can be detected while scanning unprinted comment lines, they
cannot go through the normal error queueing process.
2505 AlB 28-Nov-84
Adjust BACKLINE when the source pool is jiggled.
The BACKPRINT routine was taken out of LEXSUP, rewritten and
put into this module.
2527 AlB 28-Mar-85
The DISCARD routine was causing all trailing comments
to be displayed whenever a preceding source line had an error.
However, the BACKTYPE routine gets confused if one attempts to
type a line which does not (yet) have a line terminator.
Solution is not to use BACKTYPE when compacting the buffer.
***** End V10 Development *****
***** End Revision History *****
)%
SWITCHES NOLIST;
REQUIRE LEXAID.BLI; ![1600] REQUIRES FTTENX AUTOMATICALLY
SWITCHES LIST;
EXTERNAL
ARINGLEFT, !Used for handling buffers correctly
%2505% BACKLINE,
BASENO,
BGSTBF, !MAX BUF SIZE -- CALCULATED BY COMMAN
BLDMSG,
CHAROUT,
%2474% CLASLCUR, ! Entry for classification backup line
CLOSUP,
CORERR,
CORMAN,
CORUUO,
DIGITS,
E61, !COMPILER ERROR IN ROUTINE <BLETCH>
E112, !ILLEGAL CHARACTER IN L.S.N.
ENTRY,
ERRLINK,
ERRMSG,
ERROR,
FATLERR,
FATLEX,
FNDFF,
HEADING,
HEADPTR,
HEADSTR,
%2447% ICLEVEL, !CURRENT INCLUDE LEVEL (0 BASED) VALID IF <ININCLUD>
JOBREL,
JOBSA,
JOBFF,
LASTLINE,
LINEOUT,
MSGNOTYPD,
MSNGTIC, !Need access when returning bogus character
NAME,
NOCR,
NUMFATL,
NUMWARN,
PAGE,
PAGEPTR,
SAVSPACE,
STRNG6,
STRNG7,
STRNGOUT,
%2501% WARNCOMT,
WARNERR,
WARNOPT;
REQUIRE IOFLG.BLI; ! IO AND FLGREG DEFINITIONS
FORWARD
%2505% BACKPRINT,
BACKTYPE,
CHK4MORE,
GETBUF,
OVERFLOW,
%2474% COMPACT, ! Compact buffer after overflow
%2500% DISCARD, ! Compact buffer
%2474% BLTLINL, ! Routine to BLT codelines to top of POOL
OVRESTORE,
READTXT,
SHIFTPOOL,
SINPUT,
PRINT;
OWN SVFROM;
MACRO ADJUST = SVFROM$;
%2474% OWN CBUFPTR, ! Pointer to current available word in pool
%2474% CPREVPTR, ! Pointer to end of latest line that was moved
%2500% LINLNEXT; ! Place where next source list cell will go
%2527% OWN DISCARDING; ! TRUE if we are in the DISCARD routine
OWN BTPTR; ! POINTER FOR BACK TYPE WHICH CONTAINS THE BYTE
! POSTION OF THE NEXT PORTION OF THE STATEMENT
! IN ERROR, TO BE TYPED
OWN LASTCHARACTER;
GLOBAL FFBUFSAV; ! TOUCHED BY MRP1 IN DRIVER
! (BUT SPELLED WRONG! (FFBUFSV))
MACHOP CALLI=#047,ROTC=#245,MOVEI=#201,HLLZ=#510;
MACHOP ROT=#241,HLRZ=#554,HRLZ=#514;
BIND JOBVER=#137;
MACRO NXT(C) = REPLACEI ( HEADPTR, C ) $;
MACRO IOIMPM=17,1$,IODERR=16,1$,IODTER=15,1$,IOBKTL=14,1$,IODEND=13,1$;
%2447% MACRO WHICHCHAN = (IF .FLGREG<ININCLUD>
%2447% THEN ICL + .ICLEVEL
%2447% ELSE SRC) $;
%2447% MACRO RINGHDR = (.BUFPNT(WHICHCHAN)<RIGHT>) $;
MACRO RINGLENGTH = (IF NOT FTTENEX
THEN .(RINGHDR)<RIGHT>
%2447% ELSE @XWORDCNT(WHICHCHAN)) $;
MACRO RINGSTART = (IF NOT FTTENEX
THEN (RINGHDR+1)
%2447% ELSE @BUFFERS(WHICHCHAN)) $;
%2447% MACRO FILOP&(AC) = CALLI(AC,#155) $; !GENERAL FILE OPERATOR
%2447% BIND &FOINP = #17, !FILOP. INPUT FUNCTION
%2447% &FOGET = #22; !FILOP. GETSTS FUNCTION
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 %
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
LOCAL LINESAVE;
%[667]% EXTERNAL INCLAS;
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;
!BE SURE THAT THE TAB FOLLOWING THE LINE SEQUENCE NUMBER DOES NOT
! OCCUR IN THE NEXT BUFFER IN WHICH CASE WE HAVE TO
! GO THROUGH ALL KINDS OF CONTORTIONS HERE
! TO GET THE BUFFERS SET UP RIGHT AND THE TAB SKIPPED.
LINESAVE_.VREG;
T1_SCANI(@PTRPTR);
IF .T1 EQL #177 !END OF BUFFER CHARACTER?
THEN IF CURWORD EQL .CURPOOLEND !REALLY BUFFER END?
THEN IF (T1_GETBUF()) EQL OVRFLO
THEN(SHIFTPOOL();
IF (T1_OVRESTORE()) EQL OVRFLO
THEN T1_OVERFLOW(0,0)
);
! NOW WE HAVE THE REAL NEXT CHAR IN T1
!WE HAVE JUST SCANNED PAST A LINE SEQUENCE NUMBER, AND NOW ARE
! LOOKING FOR A POTENTIAL TAB. IT IS POSSIBLE THAT THE LINE
! SEQUENCE NUMBER WAS REALLY PART OF A PAGE MARK IN WHICH CASE
! THE NEXT WORD IS A CARRIAGE RETURN, FORM FEED, NUL, NUL, NUL.
! IF THIS IS THE CASE, SCAN PAST THIS ENTIRE WORD, PUTTING OUT
! A NEW PAGE HEADER AS WE GO, AND LOOK FOR THE NEXT LINE SEQUENCE
! NUMBER INSTEAD OF THE ZERO ONE WHICH WE HAVE JUST SEEN.
IF .T1 NEQ " "
THEN
IF (@@@PTRPTR EQL #643^#30 AND .LINESAVE EQL 0) THEN
BEGIN ! A PAGE MARK HAS BEEN SEEN
(@PTRPTR)<RIGHT>_@@PTRPTR+1;
(@PTRPTR)<LEFT>_#440700;
FNDFF_1;
![667] CATCH ALL THE FUNNY CASES WHERE PAGE MARKS PRESENT:
![667] 1. NULL WORD FOLLOWS (END OF BUFFER FROM SOS)
![667] 2. END OF BUFFER ITSELF (NEED TO GET NEXT BUFFER)
![667] 3. END OF FILE
![667] 4. FINALLY MAY GET THE "REAL" LINE SEQUENCE NUMBER!
%[667]% IF .FLGREG<LISTING> AND NOT .INCLAS THEN (CHAROUT(FF); HEADING());
%[667]% WHILE @@@PTRPTR EQL 0 DO
%[667]% (@PTRPTR)<RIGHT>_@@PTRPTR+1;
%[667]% IF SCANI(@PTRPTR) EQL #177
%[667]% THEN IF CURWORD EQL .CURPOOLEND !REALLY BUFFER END?
%[667]% THEN IF (T1_GETBUF()) EQL OVRFLO
%[667]% THEN(SHIFTPOOL();
%[667]% IF (T1_OVRESTORE()) EQL OVRFLO
%[667]% THEN T1_OVERFLOW(0,0)
%[667]% );
%[667]% (@PTRPTR)<LEFT>_#440700;
!BEFORE RECURSION, CHECK LINE SEQUENCE BIT
! (MAY BE AT END OF FILE).
IF @@@PTRPTR THEN RETURN LINESEQNO(@PTRPTR); ! GET REAL LSN
END
ELSE DECREMENT(@PTRPTR);
RETURN .LINESAVE ;
END; % LINESEQNO %
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
!
![767] PRINT /G OR /F77 IF APPROPRIATE
IF .F2<GFL> THEN STRNG7('/G'); ![767]
%1133% IF .F2<STA> THEN STRNG7('/ST'); ! Statistics
%767% IF F77
%767% THEN STRNG7('/F77')
%1504% ELSE
%1504% BEGIN
%1504% STRNG7('/NO');
%1504% STRNG7('F77')
%1504% END;
IF .FLGREG<OPTIMIZE> THEN STRNG7( '/OPT');
IF .FLGREG<NOWARNING> THEN STRNG7('/NOWA');
IF .FLGREG<CROSSREF> THEN STRNG7('/C');
%1133% IF .FLGREG<SYNONLY> THEN STRNG7('/SY');
IF .FLGREG<INCLUDE> THEN STRNG7('/I');
IF .FLGREG<MACROCODE> THEN STRNG7('/M');
%1504% IF .FLGREG<EXPAND> THEN STRNG7('/EXP');
IF .FLGREG<NOERRORS> THEN STRNG7('/NOER');
!ADD /L TO PAGE HEADERS IF LINE NUMBER/OCTAL MAP REQUESTED
IF .FLGREG<MAPFLG> THEN STRNG7('/L');
%1504% IF EXTENDED THEN STRNG7('/EXT');
BEGIN
% Check debug flags %
BIND DEBUGFLGS =
% FLGREG bit positions for the various
modifiers %
1^DBGDIMNBR +
1^DBGINDXBR +
1^DBGLABLBR +
1^DBGTRACBR +
1^DBGBOUNBR +
%1613% 1^DBGARGMBR ;
IF ( DEBUGFLGS AND .FLGREG<FULL> ) NEQ 0
THEN
BEGIN
! Print "/D:(" then each initial as needed,
! then ")".
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");
%1613% IF .FLGREG<DBGARGMNTS> THEN NXT("A");
NXT(")")
END
END;
!------------------------------------------------------------------------------------------------------------------
! DATE - DOESN'T CHANGE
! TIME - DOESN'T CHANGE
!------------------------------------------------------------------------------------------------------------------
NXT(" ");
%1600% IF FTTENEX
%1600% THEN
%1600% BEGIN
%1600% LOCAL RSV[3];
%1600% REGISTER R1=1,R2=2,R3=3;
%1600% MACHOP JSYS = #104;
%1600% MACRO ODTIM = JSYS(0,#220) $;
%1600%
%1600% RSV[0] _ .R1; RSV[1] _ .R2; RSV[2] _ .R3; !SAVE REGS
%1600%
%1600% R1 _ .HEADPTR; !DESTINATION DESIGNATOR
%1600% R2 _ -1; !CURRENT TIME
%1600% R3 _ #400^18; !OT%NTM - NO TIME
%1600% ODTIM; !NO ERRORS POSSIBLE EXCEPT NO TIME SET..
%1600%
%1600% REPLACEI(R1, " "); !TAB
%1600%
%1600% R2 _ -1;
%1600% R3 _ #400200^18; !OT%NDA+OT%NSC - NO DATE, NO SECONDS
%1600% ODTIM;
%1600%
%1600% HEADPTR _ .R1; !RESTORE UPDATED BP
%1600%
%1600% R1 _ .RSV[0]; R2 _ .RSV[1]; R3 _ .RSV[2] !RESTORE REGS
%1600% END !TOPS-20
%1600% ELSE
%1600% BEGIN !TOPS-10
BASENO _ 10;
T[1]_(CALLI(T[0],#14) MOD 31)+1;DIGITS(.T[1]);
%1600% T[1]_@(UPLIT('-Jan-','-Feb-','-Mar-','-Apr-','-May-','-Jun-',
%1600% '-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(" ");
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])
%1600% END; !TOPS-10
!------------------------------------------------------------------------------------------------------------------
! PAGE
!------------------------------------------------------------------------------------------------------------------
%1600% STRNG7(' Page'); NXT(" ");
PAGEPTR _ .HEADPTR; ! SAVE PAGE NUMBER POINTER
.VREG
END;
GLOBAL ROUTINE INSTAT =
% CHECK THE STATUS OF THE SOURECE INPUT DEVICE AND TERMINATE IF
ERROR OR RETURN EOF IF EOF %
BEGIN !INSTAT
IF NOT FTTENEX THEN
BEGIN !TOPS-10
%2447% LOCAL ARG; !ARG BLOCK FOR FILOP.
REGISTER T1; !AC FOR FILOP.
%2447% ARG = WHICHCHAN^18 + &FOGET; !CHAN,,FUNCTION
%2447% T1 = 1^18 + ARG<0,0>; !LEN,,ADR
%2447% IFSKIP FILOP&(T1) !PERFORM GETSTS
%2447% THEN .VREG; !IGNORE ERROR
IF .T1<IODEND> THEN
BEGIN !.T1<IODEND> NEQ 0
% CHECK HERE FOR MULTIPLE FILES AND END OF INCLUDE%
IF NOT .FLGREG<EOCS> !END OF COMMAND STRING
THEN
BEGIN
%GET THE NEXT FILE%
REGISTER SV;
%[1047]% EXTERNAL XNXFILG;
LABEL CHK;
MACHOP INUUO = #056;
%[1047]% XNXFILG();
%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
IF (.FFBUFSAV+.BGSTBF) LSS .JOBFF
%2447% THEN 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 !.T1<IODEND>
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; !TOPS-10
END; !INSTAT
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 ;
!SET ARINGLEFT TO INDICATE PARTIAL BUFFER IS LEFT
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 ;
!RESET ARINGLEFT TO ALLOW NORMAL BUFFERING
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%
%[1047]% EXTERNAL XNXFILG;
%[1047]% XNXFILG();
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%
MACRO EOFBIT = 27,1 $;
%2447% R1 _ @XDEVJFN(.DEV);
%2447% 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 ( 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;
%1162% MACRO TEXTI = JSYS (0,#524) $;
%1162% OWN TEXTIARGBLOCK[5];
%1162% BIND RDCWB = 0, !COUNT OF WORDS FOLLOWING IN ARG BLOCK
%1162% RDFLG = 1, !FLAG WORD
%1162% RDIOJ = 2, !INPUT,,OUTPUT JFN
%1162% RDDBP = 3, !DESTINATION BYTE POINTER
%1162% RDDBC = 4; !DESTINATION NUMBER OF BYTES AVAILABLE
BIND RDTOP = 34, !TOPS-10 BREAK CHARACTERS
RDJFN = 29; !USE JFN
%FIRST CHECK FOR END OF FILE%
IF .LASTCHARACTER EQL "?Z"
! -20 ONLY: CLEAR LASTCHARACTER AFTER ^Z SO MORE TTY: INPUT MAY BE DONE
THEN BEGIN
LASTCHARACTER _ 0;
RETURN CHK4MORE ();
END;
%1162% TEXTIARGBLOCK[RDCWB] _ 4; !BLOCK SIZE
%1162% TEXTIARGBLOCK[RDFLG] _ 1^RDTOP + 1^RDJFN; !FLAGS
%1162% TEXTIARGBLOCK[RDIOJ]<LEFT> _ .XDEVJFN(SRC); !INPUT JFN
%1162% TEXTIARGBLOCK[RDIOJ]<RIGHT> _ .XDEVJFN(SRC); !OUTPUT JFN
%1162% TEXTIARGBLOCK[RDDBP] _ (.BUFFERS(SRC)<RIGHT>)<36,7>; !DEST PTR
%1162% TEXTIARGBLOCK[RDDBC] _ XSINSIZ*5; !BYTE COUNT
%1162% R1 _ TEXTIARGBLOCK[0]<0,0>;
%1162% IF SKIP(TEXTI) EQL 0
THEN
BEGIN
MACHOP JRST = #254;
%1162% FATLERR( PLIT'TEXTI',.LINELINE-1,E61<0,0>);
CLOSUP();
JRST(0,.JOBSA<0,18>) !HALT
END;
%1162% LASTCHARACTER _ ..TEXTIARGBLOCK[RDDBP]; !SAVE LAST CHARACTER
%1162% !FOR EOF CHECK
%ZERO FILL%
%1162% (.TEXTIARGBLOCK[RDDBP]<RIGHT>)<0,.TEXTIARGBLOCK[RDDBP]<30,6>> _ 0;
%1162% XWORDCNT(SRC) _ .TEXTIARGBLOCK[RDDBP]<RIGHT> - .BUFFERS(SRC) + 1;
RETURN 1;
END
END; %READTXT%
GLOBAL ROUTINE GETBUF =
!++
! Cleaned up [2447] /PLB
! FUNCTIONAL DESCRIPTION:
!
! READS IN THE NEXT RECORD OF THE INPUT FILE AND TRANSFERS IT TO
! POOL.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! FLGREG, WHICHCHAN
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! If end of file, return EOF.
! If not enough room in POOL, return OVRFLO.
!
! SIDE EFFECTS:
!
! Read next input buffer.
!
!--
BEGIN
IF .FLGREG<ENDFILE>
THEN RETURN EOF; !CHECK FOR EOF
!CHECK FOR PARTIAL BUFFER STILL LEFT AND GO GET IT
IF .ARINGLEFT NEQ 0
THEN RETURN TRANSFRING();
IF NOT FTTENEX
THEN
BEGIN !TOPS-10
LOCAL ARG; !BLOCK FOR FILOP.
REGISTER T1; !AC FOR FILOP.
ARG = WHICHCHAN^18 + &FOINP; !CHAN,,FUNCTION
T1 = 1^18 + ARG<0,0>; !LENGTH,,ADR
IFSKIP FILOP&(T1)
THEN .VREG
ELSE IF INSTAT() EQL EOF
THEN RETURN .VREG
END !TOPS-10
ELSE
BEGIN !TOPS-20
IF SINPUT( WHICHCHAN ) EQL EOF
THEN RETURN .VREG
END; !TOPS-20
!NO ERRORS OR EOF CONDITION DETECTED
!TRANSFER THE RING BUFFER AND RETURN NEXT CHARACTER
RETURN TRANSFRING()
END; !GETBUF
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.
%
RETURN TRANSFRING() % TRANSFER THE RING BUFFER AND RETURN NEXT CHARACTER %
END ; % OVRESTORE %
GLOBAL ROUTINE EOPSVPOOL =
!++
! Cleaned up [2447] /PLB
! FUNCTIONAL DESCRIPTION:
!
! 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.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! Unknown
!
! IMPLICIT OUTPUTS:
!
! Unknown
!
! ROUTINE VALUE:
!
! Unknown
!
! SIDE EFFECTS:
!
! Shoves POOL around, allocates core.
!
!--
BEGIN
REGISTER T1,T2;
EXTERNAL CORMAN %()% ;
EXTERNAL NAME;
LABEL LOOP,SEQNO;
MACRO P = .STLPTR<30,6>$,
BIT35 = 0,1$,
STLWORD = STLPTR<RIGHT>$;
!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 !SEQNO
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 "?I" AND
.(.STLWORD)<P,36-P-7> EQL 0
THEN T1 _ .T1 - 1 !FOLLOWING TAB
ELSE IF P NEQ 1
THEN LEAVE SEQNO; !NO LINE SEQUENCE NO
LOOP: BEGIN !WE HAVE A POSSIBLE LINE SEQ NO [LOOP]
WHILE @T1 GEQ POOLBEGIN
DO
BEGIN !WHILE
IF @@T1 NEQ 0
THEN
BEGIN !@@T1 NEQ 0
IF .(@T1)<BIT35> EQL 1
THEN
BEGIN !WE HAVE A LINE SEQ#
!SAVE LINESEQ NUMBER
!JUST FOR CONSISTENCY
SVFROM _ .T1;
SEQLAST _ 1; !FLAG LINESEQ NO
LEAVE SEQNO
END; !WE HAVE A LINE SEQ#
SEQLAST _ 0;
LEAVE LOOP
END !@@T1 NEQ 0
ELSE T1 _ .T1 - 1
END !WHILE
END !WE HAVE A POSSIBLE LINE SEQ NO [LOOP]
END; !SEQNO
!SVFROM IS NOW THE START OF WHAT MUST BE SAVED. NOW WHAT HAS
!TO BE SAVED?
T1 _ .CURPOOLEND<RIGHT> - RINGLENGTH;
IF .T1 LEQ .SVFROM
THEN EOPSAVE _ 0 !WHAT IS NEEDED IS STILL IN THE RING BUFFER
ELSE
BEGIN !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)
END; !IN THIS CASE THE AREA FROM .SVFROM THROUGH .T1-1 MUST BE SAVED
!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; !EOPSVPOOL
GLOBAL ROUTINE EOPRESTORE =
!++
! Cleaned up [2447] /PLB
! FUNCTIONAL DESCRIPTION:
!
! 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.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! Unknown
!
! IMPLICIT OUTPUTS:
!
! Unknown
!
! ROUTINE VALUE:
!
! IF END OF FILE, EOF WILL BE RETURNED,
! OTHERWISE 1.
!
! SIDE EFFECTS:
!
! Messes with POOL, performs file input operations
!
!--
BEGIN !EOPRESTORE
REGISTER T1,T2; !REGISTERS FOR BLT
OWN FFICLSV; !INCLUDE FILE SAVED JOBFF
EXTERNAL SAVSPACE %()%,
LEXINIT %()%;
ROUTINE GETCORE = ![1600] Re-written /PLB
IF FTTENEX
THEN CORUUO(.JOBFF) !TOPS-20 simulated version
ELSE
BEGIN
REGISTER R1;
MACRO CORE(AC) = CALLI(AC,#011) $;
R1 = .JOBFF;
CORE(R1); !CORE UUO
CORERR() !** DANGER ** ERROR RETURN **
END; %GETCORE%
ROUTINE BUFUP =
BEGIN
IF FTTENEX THEN
BEGIN !TOPS-20
!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;
!SET UP OBJECT BUFFERS
IF .FLGREG<OBJECT>
THEN
BEGIN
BUFFERS(BIN) _ .JOBFF<RIGHT>;
BUFPNT(BIN) _ (.JOBFF<RIGHT>)<36,36>;
BUFCNT(BIN) _ XSOUTSIZ;
JOBFF _ .JOBFF + XSOUTSIZ;
GETCORE();
END
END !TOPS-20
END; !BUFUP
IF .CURPOOLEND<RIGHT> EQL POOLBEGIN
THEN
BEGIN !COMPILATION INITIALIZATION
!SAVE .JBFF SO THAT WHEN NEW INPUT FILES ARE OPENED
!THEY CAN USE THE SAME LOW CORE SPACE
IF FTTENEX
THEN
BEGIN !TOPS-20
IF .FLGREG<ININCLUD>
THEN
%2447% BEGIN !IN INCLUDE
%2447% IF @BUFFERS(ICL + .ICLEVEL) EQL 0
THEN
BEGIN !SET UP THE BUFFERS
%2447% BUFFERS(ICL+.ICLEVEL) _ .JOBFF<RIGHT>;
JOBFF_ .JOBFF + XSINSIZ;
GETCORE()
END; !SET UP THE BUFFERS
%2447% IF SINPUT(ICL + .ICLEVEL) EQL EOF
%2447% THEN RETURN .VREG;
END !IN INCLUDE
ELSE
BEGIN !NOT ININCLUDE
!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;
%2447% END !NOT ININCLUDE
END !TOPS-20
ELSE
BEGIN !TOPS-10
IF .FLGREG<ININCLUD>
THEN
BEGIN !IN INCLUDE
LOCAL SAVFF, !SAVED END OF CORE
%2447% ARG; !BLOCK FOR FILOP.
%2447% REGISTER T1; !AC FOR FILOP
SAVFF _ .JOBFF; !SAVE END OF CORE
IF .FFICLSV NEQ 0 !IF SAVED INCL BUFFERS
THEN JOBFF _ .FFICLSV; !USE THEM
%2447% ARG = (ICL + .ICLEVEL)^18 + &FOINP;
%2447% T1 = 1^18 + ARG<0,0>; !LENGTH,,ADDR
%2447% IFSKIP FILOP&(T1) !FIRST INPUT BUFFER
%2447% THEN .VREG !SUCCESS!
%2447% ELSE IF INSTAT() EQL EOF !FIRST INPUT FAILED
THEN RETURN .VREG; !RETURN EOF IF EOF
!TERMINATE IF ERROR
!OTHERWISE CONTINUE
IF .FFICLSV EQL 0 !IF NO SAVED BUFFERS
THEN FFICLSV _ .SAVFF !WAS FIRST INCLUDE
ELSE JOBFF _ .SAVFF; !ELSE RESET JOBFF
END !IN INCLUDE
ELSE
BEGIN !NOT IN INCLUDE
MACHOP INUUO = #056;
FFBUFSAV _ .JOBFF;
IFSKIP INUUO(SRC,0) !INPUT FIRST BUFFER
THEN IF INSTAT() EQL EOF !FIRST INPUT FAILED
THEN RETURN .VREG; !RETURN EOF IF EOF
!TERMINATE IF ERROR
!OTHERWISE CONTINUE
IF (.FFBUFSAV+.BGSTBF) LSS .JOBFF
%2447% THEN FATLERR(.LASTLINE,PLIT'EOPRES',E61<0,0>);
!LEAVE ENOUGH SPACE SO THE LARGEST
!DEVICE BUFFERS WILL FIT LATER
JOBFF _ .FFBUFSAV + .BGSTBF;
!CHECK TO SEE THAT WE HAVE ENOUGH CORE
GETCORE();
FFICLSV _ 0; !INITIALIZE FOR INCLUDE
END; !NOT IN INCLUDE
END; !TOPS-10
!INITIALIZE POINTERS
CURPTR _ 0;
T2 _ POOLBEGIN; !RING BUFFER TRANSFER POINT
CURPOOLEND _ POOLBEGIN + RINGLENGTH;
ADJUST _ 0; !TRANSFER ENTIRE RING BUFFER
END !COMPILATION INITIALIZATION
ELSE
BEGIN !RESTORE POOL AFTER PREVIOUS END OF PROGRAM
%2447% IF NOT FTTENEX
%2447% THEN FFICLSV = 0 !TOPS-10: INITIALIZE FOR INCLUDE
%2447% ELSE IF .FLGREG<ININCLUD> !TOPS-20: IF NOT CURRENTLY IN INCLUDE
%2447% THEN BUFFERS(ICL+.ICLEVEL+1) = 0; !TOPS-20: CLEAR BUFFER PTR
IF .EOPSAVE NEQ 0
THEN
BEGIN !RESTORE SAVED PORTION
T1 _ .SAVESTART^18 + POOLBEGIN;
T2 _ POOLBEGIN + .SAVESIZE;
BLT(T1,-1,T2);
SAVSPACE(.SAVESIZE-1,.SAVESTART);
ADJUST _ 0; !TRANSFER ENTIRE RING BUFFER
END !RESTORE SAVED PORTION
ELSE
BEGIN !ONLY THE RING BUFFER NEED BE RESTORED
T2 _ POOLBEGIN;
!HOW MUCH OF THE RING BUFFER SHOULD BE TRANSFERED
ADJUST _ POOLBEGIN-(.CURPOOLEND<RIGHT>-RINGLENGTH);
IF .ADJUST LSS 0 THEN ADJUST _ 0
END !ONLY THE RING BUFFER NEED BE RESTORED
END; !RESTORE POOL AFTER PREVIOUS END OF PROGRAM
!NOW RESTORE THE RING BUFFER STARTING AT .T2, BUT ONLY RESTORE
!THE LAST (RINGLENGTH - .ADJUST) WORDS.
T1 _ .T2;
T1<LEFT> _ RINGSTART + .ADJUST;
T2 _ .T2<RIGHT> + RINGLENGTH - .ADJUST<RIGHT>;
BLT(T1,-1,T2);
(@T2)<FULL> _ ENDBUFLAG; !STORE END OF BUFFER FLAG
!CONSISTENCY CHECK
IF .T2 NEQ .CURPOOLEND<RIGHT>
THEN INTERR('EOPRESTORE');
!INITIALIZE "LEXICAL". IT IS POSSIBLE THAT AN END OF FILE MAY
!BE RETURNED. SOMEWHAT UNLIKELY THOUGH.
%1162% IF LEXINIT() EQL ENDOFILE<0,0>
%1162% THEN RETURN EOF
%1162% ELSE RETURN 1
END; !EOPRESTORE
GLOBAL ROUTINE OVERFLOW ( INCLASS, CLASSERR ) =
BEGIN
EXTERNAL E51,SHIFTPOOL,FATLEX;
% THIS ROUTINE IS CALLED WHEN A STATEMENT COMPLETELY
FILLS THE STATEMENT BUFFER POOL %
IF .INCLASS NEQ 0
THEN
%2474% BEGIN
%2474% IF COMPACT() EQL OVRFLO
%2474% THEN
%2474% BEGIN ! Line too long
% IN CLASSIFICATION - - THE STATEMENT IS TOO LARGE
TO CLASSIFY
RETURN SOME ILLEGAL CHARACTER AND KILL
THE CLASSIFICATION. THEN WHEN WE GET BACK HERE AGAIN
AFTER DURING THE SKIPPING OF THE STATEMENT
PUT OUT THE FATAL ERROR MESSAGE %
!WE WISH TO RETURN ILLEGAL CHARACTER TO TRIGGER
! THE TERMINATION OF THIS STATEMENT - MAKE SURE THAT
! WE ARE NOT IN A QUOTED STRING AND RETURN APPROPRIATE
! ILLEGAL CHARACTER FOR THE CURRENT CONTEXT.
IF .MSNGTIC EQL 0 THEN RETURN "_" ELSE (MSNGTIC_0; RETURN EOS);
%2474% END ! Line too long
%2474% ELSE RETURN .VREG ! Buffer was compacted
%2474% END;
IF @.CLASSERR NEQ 0
THEN FATLERR (.LASTLINE,E51<0,0>);
% THIS WILL TYPE OUT ALL LINES UP TO THE CURRENT
ONE AND THEN THE MESSAGE %
% IF THE STATEMENT WAS CLASSIFIED JUST DRIVE ON.
THE ONLY NOTICEABLE EFFECT WILL BE IF IT GETS AND
ERROR LATER THE WHOLE STATEMENT WILL NOT BE TYPED TO
THE TTY: %
!WE HAVE PRINTED ERROR MESSAGE - CLEAR FLAG TO PREVENT
! EXTRANEOUS ERROR MESSAGES
(.CLASSERR)<0,36>_0;
%DUMP THE FIRST PART OF THE STATEMENT %
STPOS _ 72;
STPTR _ .LINEPTR;
STLPTR _ .LINEPTR;
SHIFTPOOL();
!RESET BTPTR TO PREVENT LOSS OF PARTIAL LINE IN
! PRINTING ERROR LINE
BTPTR_.LINEPTR;
IF OVRESTORE() EQL OVRFLO
THEN (FATLEX(PLIT'OVERFLOW, LINE TOO LONG',
E61<0,0>); ARINGLEFT_0); !POSSIBLE INTERNAL ERROR
RETURN .VREG
END; %OVERFLOW%
ROUTINE COMPACT=
!++
! FUNCTIONAL DESCRIPTION:
!
! Compact buffer of source lines after overflow.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! None
!
! ROUTINE VALUE:
!
! If the pool is still overflown, return the OVRFLO character.
! Otherwise return the next source character.
!
! SIDE EFFECTS:
!
! None
!
!--
%2500% ! Restructured by AlB on 14-Nov-84
BEGIN
REGISTER TEMP; ! Convenient temporary
DISCARD(); ! Compact the buffer
IF (TEMP = GETBUF()) EQL OVRFLO
THEN
BEGIN ! Try to shift down POOL
SHIFTPOOL();
TEMP = OVRESTORE();
END; ! Try to shift down POOL
RETURN .TEMP;
END; ! of COMPACT
GLOBAL ROUTINE DISCARD=
!++
! FUNCTIONAL DESCRIPTION:
!
! Compact buffer of source lines and the source line list.
! Print the lines in the buffer and BLT the code lines together.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! CURPTR - Points to current source byte
!
! CURPOOLEND - Address of end of pool of source
!
! Entries in the linked list of source lines are updated
!
! ROUTINE VALUE:
!
! None
!
! SIDE EFFECTS:
!
! Lines may be printed.
!
!--
%2500% ! Written by AlB on 14-Nov-84
%2500% ! This is most of what was COMPACT
BEGIN
REGISTER
CELL, ! Pointer to entry in linked list of lines
TEMP; ! Convenient temp
LOCAL SAVPTR; ! To save CURPTR
SAVPTR = .CURPTR;
CBUFPTR = POOLBEGIN; ! Start filling at top of pool
CPREVPTR = (POOLBEGIN -1)<1,7>; ! Where previous line would have ended
%2527% DISCARDING = 1; ! So we don't type discarded lines
%2500% CELL = LINLNEXT = LINLLIST<0,0>; ! Start at head of source list
! Skip over lines already printed and compacted
! Blank out beginning of multiple statements on initial line
IF NOT .PRINTED(CELL)
THEN
BEGIN ! Blank fill partial line
TEMP = .FIRSTBP(CELL); ! First char of line
DECR I from 71 to .FCHARPOS DO REPLACEI(TEMP," ");
END; ! Blank fill partial line
%2500% WHILE .CELL LSS .LINLLAST
DO
BEGIN ! More entries on linked list
%2500% PRINT(.CELL); ! Print the line
%2500% IF .HASCODE(CELL)
%2500% THEN BLTLINL(.CELL); ! Copy the code line
%2500% CELL = .CELL + LINLSENT; ! Next entry
END; ! More entries on linked list
%2500% LINLLAST = .LINLNEXT; ! Where we end up
%2500% BLTLINL(.CELL); ! Copy last line even if comment
%2527% DISCARDING = 0; ! Reset so error typouts happen
! Reached end of linked list
TEMP = .CPREVPTR;
%2500% UNTIL .TEMP<30,1> EQL 1
DO REPLACEI(TEMP,0); ! Null fill after end of final line
TEMP = .CPREVPTR<RIGHT>; ! Last used word in pool
WHILE @@TEMP EQL 0 and .TEMP GEQ POOLBEGIN
DO (TEMP = .TEMP - 1); ! Back over null words
TEMP = .TEMP + 1; ! First null word
ADJUST = .CURPOOLEND - .TEMP; ! Amount to adjust
CURPTR = .SAVPTR - .ADJUST; ! Reset CURPTR
CURPOOLEND = .TEMP; ! Back to null word
(.CURPOOLEND)<FULL> = ENDBUFLAG; ! Set word to all 1's
! Fix the pointers
LINEPTR = .FIRSTBP(LINLCURR);
LINELINE = .LINENUM(LINLCURR);
CONTPTR = .FIRSTBP(CONTLCUR);
TEMP = .CLASLPT<RIGHT>;
CLASLPT = .FIRSTBP(CLASLCUR);
CLASPTR = .CLASPTR + .CLASLPT<RIGHT> - .TEMP;
END; ! of DISCARD
ROUTINE BLTLINL(CELL)=
!++
! FUNCTIONAL DESCRIPTION:
!
! Copy one source line to a place lower in the pool.
!
! FORMAL PARAMETERS:
!
! CELL - Index to an entry in the linked list of pooled source
!
! IMPLICIT INPUTS:
!
! CBUFPTR - Address of word to which the line is to be moved
! CPREVPTR - Pointer to last moved byte
! LINLNEXT - Address for next entry in source list
!
! IMPLICIT OUTPUTS:
!
! CBUFPTR, CPREVPTR and LINLNEXT will be updated
! The source list and its pointers will be modified
!
! ROUTINE VALUE:
!
! None
!
! SIDE EFFECTS:
!
! None
!
!--
%2474% ! Rewritten by AlB on 17-Oct-84
BEGIN
MACHOP BLT = #251;
REGISTER
T1,
T2,
TEMP;
LOCAL ENDPTR; ! Pointer to end of this line
IF (T2 = .LASTBP(CELL)) EQL 0
THEN ! Unfinished line, so use end of buffer
T2 = (.CURPOOLEND - 1)<1,7>;
ENDPTR = .T2;
T1 = .FIRSTBP(CELL); ! Pointer to first byte on line
IF .T1<RIGHT> EQL .CPREVPTR<RIGHT>
THEN ! No need to move
BEGIN
CBUFPTR = .T2<RIGHT> + 1;
ADJUST = 0
END
ELSE
BEGIN ! Move the line
IF (.T1 AND #76^30) EQL 0 ! If on last byte of a word,
THEN T1<LEFT> = .T1<RIGHT>+1 ! start at next word
ELSE T1<LEFT> = .T1<RIGHT>; ! otherwise this is the word
T1<RIGHT> = .CBUFPTR; ! Address of destination
ADJUST = .T1<RIGHT> - .T1<LEFT>; ! Number of words to adjust
T2 = .T2<RIGHT> + .ADJUST; ! Last address
CBUFPTR = .T2 + 1; ! Next free word
BLT(T1,0,T2); ! Move it
END; ! Move the line
T2 = .CPREVPTR; ! Where previous line ended
T1 = FIRSTBP(CELL) = .FIRSTBP(CELL) + .ADJUST; ! New start pointer
WHILE .T2 NEQ .T1 ! Stash nulls from end of previous
DO REPLACEI(T2,0); ! line to beginning of this one
CPREVPTR = .ENDPTR + .ADJUST; ! New end pointer
IF .LASTBP(CELL) NEQ 0 ! Reset any valid pointer to last byte
THEN LASTBP(CELL) = .CPREVPTR;
%2500% ! Move the source list entry
%2500% T1 = .LINLNEXT;
%2500% IF .CELL EQL .LASTCODELINE THEN LASTCODELINE = .T1;
%2500% IF .CELL EQL .LINLCURR THEN LINLCURR = .T1;
%2500% IF .CELL EQL .CONTLCUR THEN CONTLCUR = .T1;
%2500% IF .CELL EQL .CLASLCUR THEN CLASLCUR = .T1;
%2505% IF .CELL EQL .BACKLINE THEN BACKLINE = .T1;
%2500% T2 = LINLNEXT = .T1 + LINLSENT;
%2500% T1<LEFT> = .CELL;
%2500% BLT(T1,-1,T2);
END; ! of BLTLINL
GLOBAL ROUTINE SHIFTPOOL =
BEGIN
% THIS ROUTINE IS USED BY ACMEOB TO SHIFT THE CURRENT STATEMENT TO THE
TOP OF THE POOL BUFFER.
%
% STLPTR POINTS TO FIRST CHARACTER-1 OF THE LINE IN WHICH THE CURRENT STATEMENT BEGINS %
% BACK UP TO THE FIRST NON-ZERO WORD PRECEEDING THE CURRENT ONE JUST
IN CASE WE NEED THE LINE SEQUENCE NUMBER IN ORDER TO SAVE AND
RESTORE POOL BETWEEN PROGRAM UNITS %
BEGIN %SHIFT POOL %
%2500% REGISTER T1,T2,T3;
OWN
%2500% LADJUST, ! Source list index adjustment value
%2500% ADJUST; ! Pointer adjustment value
%2474% LOCAL SAVECUR; ! Save CURPTR while printing
%2474% LOCAL SAVELINE; ! Save LINELINE while printing
T1 _ .STLPTR<RIGHT>;
IF .STLPTR<PFLD> NEQ 1
THEN T1 _ .T1 -1 ;
% BACK UP TO THE NEXT NON-ZERO WORD. IT WILL BE THE LINESEQNO IF THERE IS ONE %
WHILE @@T1 EQL 0 AND .T1 GTR POOLBEGIN
DO ( T1 _ .T1 -1 );
IF .T1 LEQ POOLBEGIN THEN RETURN OVRFLO;
ADJUST _ .T1 - POOLBEGIN ;
%2474% ! Print any unprinted lines that will be removed
%2474% SAVECUR = .CURPTR;
%2474% SAVELINE = .LINELINE;
%2500% T2 = LINLLIST<0,0>;
%2474% WHILE .FIRSTBP(T2)<RIGHT> LSS .T1
%2474% DO
%2474% BEGIN
%2500% PRINT(.T2); ! Print the lines
%2500% T2 = .T2 + LINLSENT; ! Step to next entry
%2474% END;
%2474% ! Fix up remainder of the linked list
%2500% T3 = LINLLIST<0,0>; ! Where list will be moved
%2500% LADJUST = .T2 - .T3; ! Amount to shift
%2500% T3<LEFT> = .T2; ! Where list is now
%2500% WHILE .T2 LEQ .LINLLAST
%2474% DO
%2474% BEGIN
%2474% FIRSTBP(T2) = .FIRSTBP(T2) - .ADJUST;
%2474% IF .LASTBP(T2) NEQ 0
%2474% THEN LASTBP(T2) = .LASTBP(T2) - .ADJUST;
%2500% T2 = .T2 + LINLSENT;
%2474% END;
%2474% ! Shift source to top of pool
T2 _ .CURPOOLEND - .T1 + POOLBEGIN ;
T1 _ .T1^18 + POOLBEGIN;
BLT ( T1,-1,T2);
%2500% ! Shift source list to top of LINLLIST
%2500% T2 = .T2 - .LADJUST; ! Where list will end, plus 1
%2500% BLT (T3,-1,T2); ! Move it
%2500% ! Adjust indices into the source list
%2500% IF .LASTCODELINE NEQ 0
%2500% THEN LASTCODELINE = .LASTCODELINE - .LADJUST;
%2500% IF .LINLCURR NEQ 0
%2500% THEN LINLCURR = .LINLCURR - .LADJUST;
%2505% IF .BACKLINE NEQ 0
%2505% THEN BACKLINE = .BACKLINE - .LADJUST;
%2500% LINLLAST = .LINLLAST - .LADJUST;
%2500% CONTLCUR = .CONTLCUR - .LADJUST;
%2500% CLASLCUR = .CLASLCUR - .LADJUST;
%NOW ADJUST ALL THE LITTLE POINTERS %
%2474% LINELINE = .SAVELINE;
STLPTR _ .STLPTR - .ADJUST;
%2474% CURPTR = .SAVECUR - .ADJUST;
LINEPTR = .LINEPTR - .ADJUST;
STPTR _ .STPTR - .ADJUST;
CLASPTR _ .CLASPTR - .ADJUST;
CLASLPT _ .CLASLPT - .ADJUST;
CONTPTR _ .CONTPTR - .ADJUST;
BTPTR _ .BTPTR - .ADJUST;
CURPOOLEND _ .CURPOOLEND - .ADJUST;
!REMEMBER TO SET FLAG
(.CURPOOLEND)<FULL>_ENDBUFLAG;
END % SHIFTPOOL %
END; %SHIFTPOOL %
GLOBAL ROUTINE DECODELINE (LINENUMB) =
BEGIN
% TRANSLATE LINE NUMBER TO ASCII AND PLACE IN LINENO[0]
LINENO[1] CONTAINS <TAB>0000. %
REGISTER T1=1,T2=2,T3=3;
LOCAL SV[3];
% SAVE REGS %
SV[0] _ .T1; SV[1] _ .T2; SV[2] _ .T3;
T1 _ .LINENUMB;
DECR I FROM 4 TO 0 DO
BEGIN
MACHOP IDIVI = #231, MOVEI = #201, ROTC = #245;
IDIVI ( T1,10 );
MOVEI ( T2,"0",T2 );
ROTC ( T2,-7 )
END;
% THE LINE NUMBER IN ASCII, IS NOW IN T3 %
LINENO[0] _ .T3;
% RESTORE %
T1 _ .SV[0]; T2 _ .SV[1]; T3 _ .SV[2];
END;
GLOBAL ROUTINE ERLSTR ( MSGTOTTY ) =
BEGIN
% CLEAR AND PRINT THE ERROR MESSAGE QUEUE -
DON'T TYPE IF NOT .MSGTOTTY %
UNTIL .ERRLINK<RIGHT> EQL 0
DO
BEGIN
REGISTER MSG;
MSG _ BLDMSG (.ERRMSG[.EMSGNUM(ERRLINK)],.ERRLINK<RIGHT>);
%LISTING%
IF .FLGREG<LISTING>
THEN
BEGIN
IF .PAGELINE LEQ 0
THEN HEADING();
PAGELINE _ .PAGELINE - 1;
STRNGOUT (.MSG)
END;
%TTY%
IF NOT .ERRTYPD(ERRLINK) AND .MSGTOTTY
THEN OUTTYX ( MSG ) ;
MSG _ .ERRLINK<RIGHT>;
ERRLINK _ @@ERRLINK;
SAVSPACE (ENODSIZ-1,.MSG)
END
END; % ROUTINE ERLSTR %
GLOBAL ROUTINE PRINT(CELL) =
BEGIN
! Formats a source line for /LISTING
%2474% ! If the parameter CELL is non-zero, it contains a pointer to the
%2474% ! entry in the linked list of source lines. If CELL is zero, then
%2474% ! the following globals have already been set:
!
! CURPTR End of line to type
! LINEPTR Beginning of line to type
! LINELINE Line number of line to type
! NOCR Flag of whether a <cr> is in the line to type
LOCAL MSGTOTTY; ! If 1 indicates that any error messages
! should be typed as well as printed
LABEL LINEPR;
%2474% ! Don't print if the source line is in the linked list, and has
%2474% ! already been printed
%2474% IF .CELL NEQ 0
%2474% THEN ! Line is in linked list
%2474% BEGIN
%2474% IF .PRINTED(CELL)
%2474% THEN RETURN; ! Already printed
%2474% PRINTED(CELL) = 1; ! So we won't print it again
%2474% LINELINE = .LINENUM(CELL); ! Line number
%2474% LINEPTR = .FIRSTBP(CELL); ! First byte position
%2474% CURPTR = .LASTBP(CELL); ! Last byte position
%2474% END;
%2527% MSGTOTTY = 0; ! Assume this
%2527% IF (.MSGNOTYPD OR .ERRFLAG )
%2527% THEN IF NOT .FLGREG<TTYDEV>
%2527% THEN IF NOT .FLGREG<NOERRORS>
THEN
BEGIN ! There are error messages or lines to be output to the
! TTY. Type any eariler untyped lines and current line,
! with line numbers.
%2527% IF NOT .DISCARDING THEN BACKTYPE ( ALLCHAR );
%2527% MSGTOTTY = 1;
END;
% NOW CHECK THE LISTING %
IF .FLGREG<LISTING>
THEN
LINEPR:BEGIN
IF .PAGELINE LEQ 0
THEN HEADING(); ! PRINT THE HEADING
%OUTPUT THE LINE NUMBER %
DECODELINE(.LINELINE);
STRNGOUT ( LINENO ); ! PRINT LINE NUMBER
% NOW INCREMENT THE LINE COUNTER %
IF ..CURPTR EQL LF
THEN PAGELINE _ .PAGELINE -1
ELSE
IF ..CURPTR EQL FF
THEN ( PAGELINE _ -1; FNDFF _ 1 )
ELSE
IF ..CURPTR EQL VT
THEN
BEGIN
REGISTER T[2];
MACHOP IDIVI = #231;
T[0] _ .PAGELINE;
IDIVI ( T[0],20 );
PAGELINE _ .PAGELINE -.T[1] - 1;
END
ELSE
%OTHER%
( PAGELINE _ .PAGELINE -1;
LINEOUT ( .LINEPTR, .CURPTR ); ! PRINT THE LINE
CHAROUT (CR);CHAROUT(LF);
LEAVE LINEPR !BECAUSE WE ALREADY PRINTED THE LINE
)
;
% NOW PRINT THE LINE%
IF .NOCR
THEN
BEGIN %PUT CR BEFORE LINE TERMINATOR TO KEEP THE
OLD TIME PRINTERS HAPPY %
DECREMENT ( CURPTR );
IF .LINEPTR NEQ .CURPTR
THEN LINEOUT ( .LINEPTR, .CURPTR ); ! PRINT THE LINE
INCP ( CURPTR ); !INCREMENT THE POINTER AGAIN
CHAROUT(CR);
CHAROUT( ..CURPTR ); !LINE TERMINATOR
END
ELSE
LINEOUT ( .LINEPTR, .CURPTR ); ! PRINT THE LINE
END;
MSGNOTYPD _ 0; ! ALL MESSAGES WILL BE TYPED HERE
% NOW OUTPUT THE ERROR MESSAGES AND CLEAR THE QUEUE %
IF .ERRLINK<RIGHT> NEQ 0
THEN ( ERLSTR ( .MSGTOTTY ); ERRFLAG _ -1 );
%2501% ! If this is a comment line with an error, put out the error message
%2501% IF .CELL NEQ 0
%2501% THEN IF .ERRCOMNT(CELL) NEQ 0
%2501% THEN WARNCOMT(.CELL);
NOCR _ 0
END; ! of PRINT
GLOBAL ROUTINE BACKTYPE ( LINESORALL ) =
BEGIN
% THIS ROUTINE WILL OUTPUT ALL LINES OR ALL CHARACTERS STARTING
AT THE BEGINNING OF THE STATEMENT UP TO THE CURRENT POSITION.
WHAT IS OUTPUT IS DEPENDENT ON THE VALUE OF LINESORALL
%
OWN LINE,LINEND,POS,TTYBUF[21],TTYPTR,LINEWASOUT;
%2064% LOCAL CHARLIM;
REGISTER C;
LABEL TYPELINES,BUFLOOP;
IF NOT .ERRFLAG
THEN
BEGIN % START AT THE BEGINNING OF THE LINE %
LINE _ .ISN; ! BEGINNING LINE NUMBER
%2527% BTPTR = LINLLIST<0,0>; ! Start at the first line
%2527% BTPTR = .FIRSTBP(BTPTR);! for this statement
POS _ .STPOS; ! LINE CHARACTER POSTION
ERRFLAG _ 1 ! SET ERRORS ENCOUNTERED AND PRINTED FLAG
END;
% ELSE THIS IS THE SECOND CALL TO BACK TYPE FOR A SINGLE STATEMENT
SO USE THE PREVIOUS VALUES %
IF .BTPTR EQL .CURPTR THEN RETURN .VREG;
TTYPTR _ TTYBUF<36,7>;
%2064% CHARLIM _ 99;
IF .POS NEQ 72
THEN
BEGIN % BLANK FILL FOR PARTIAL LINES %
DECR I FROM 72-.POS-1 TO 0
DO REPLACEI ( TTYPTR, " " );
%2064% CHARLIM _ .CHARLIM - (72 - .POS);
POS _ 72
END;
TYPELINES:BEGIN
% ISOLATE THE NEXT LINE %
WHILE 1 DO
BUFLOOP:BEGIN
%2064% DECR I FROM .CHARLIM TO 0
DO
BEGIN %LOOP UNTIL BUFFER IS FILLED%
LOCAL SBTPTR;
IF (C_SCANI(BTPTR)) GEQ LF AND .C LEQ FF
THEN % END OF A LINE %
BEGIN
%CHECK FOR NO CR %
IF ..TTYPTR NEQ CR
THEN REPLACEI (TTYPTR,CR);
%INSERT LINETERMINATOR AND BUFFER TERMINATOR %
REPLACEI (TTYPTR, LF); !ALWAYS LF
REPLACEI (TTYPTR,0);
IF NOT .LINEWASOUT
THEN
BEGIN %OUTPUT THE LINE NUMBER %
DECODELINE(.LINE);
OUTTY ( LINENO)
END;
LINEWASOUT _ 0;
% OUTPUT THE LINE%
OUTTY ( TTYBUF );
TTYPTR _ TTYBUF<36,7>;
% IGNORE CR'S AND NULLS %
LINEND _ .BTPTR;
DO C _ SCANI(BTPTR)
UNTIL .C NEQ CR AND .C NEQ 0;
% DETERMINE THE NEXT LINE NUMBER IN CASE WE COME BACK THROUGH HERE %
% CHECK FOR LINE SEQUENCE NO %
IF @@BTPTR
THEN LINE _ LINESEQNO(BTPTR)
ELSE ( LINE _ .LINE+1; DECREMENT (BTPTR) );
SBTPTR_.BTPTR;
% CHECK FOR END OF PRINTING %
IF .LINEND EQL .CURPTR OR .BTPTR EQL .CURPTR
%BOTH MUST BE CHECKED SINCE WE DON'T KNOW
IF CURPTR IS BEFORE OR AFTER THE
THE LINESEQUENCE NUMBER. LINE SEQUENCE
NUMBERS ARE A PAIN IN THE ASS %
THEN LEAVE TYPELINES
ELSE LEAVE BUFLOOP; !NEW BUFFER
END
ELSE
BEGIN % PLACE NON-NULL CHARACTERS IN TTY BUFFER %
IF .C NEQ 0
THEN REPLACEI(TTYPTR,.C);
IF .CURPTR EQL .BTPTR
THEN (IF .LINESORALL NEQ ALLCHAR THEN BTPTR_.SBTPTR;
LEAVE TYPELINES) ! END OF TYPING
END;
END %BUFFER LOOP % ;
% ONE CAN ASSUME THAT THE END OF LINE WILL BE REACHED
BEFORE .BTPTR EQL .CURPTR SINCE THE LINE IS ALREADY
100 CHARACTERS LONG SO OUTPUT THE LINE # FOLLOWED
BY THIS PORTION OF THE LINE AND THEN NOTE THAT FACT %
IF NOT .LINEWASOUT
THEN
BEGIN %OUTPUT THE LINE NUMBER %
DECODELINE(.LINE);
OUTTY ( LINENO );
LINEWASOUT _ 1
END;
% CLOSE OUT THE BUFFER %
REPLACEI(TTYPTR,0);
OUTTY ( TTYBUF );
TTYPTR _ TTYBUF<36,7>
END % WHILE 1 LOOP - BUFLOOP: - LOOP BACK FOR NEW TTY BUFFER %
END; % TYPELINES %
% CHECK FOR PARTIAL LINE OUTPUT %
IF .LINESORALL EQL ALLCHAR AND .TTYPTR NEQ TTYBUF<36,7>
THEN
BEGIN % OUTPUT PARTIAL LINE %
IF NOT .LINEWASOUT
THEN
BEGIN %OUTPUT LINE NUMBER %
DECODELINE(.LINE);
OUTTY ( LINENO )
END;
% OUTPUT LINE %
% FINAL CRLF %
REPLACEI(TTYPTR,CR);
REPLACEI(TTYPTR,LF);
REPLACEI(TTYPTR,0);
OUTTY ( TTYBUF)
END
ELSE IF .LINEWASOUT THEN INTERR ('BACKTYPE');
% THERE MUST BE A LOT OF NULLS IN THE LINE BECAUSE
ITS OVER 100 CHARACTERS LONG AND WE ARE STILL
IN THE STATEMENT FIELD %
END; % BACKTYPE %
GLOBAL ROUTINE BACKPRINT=
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine is called if a line terminator was encountered
! during some lookahead, and no backup was required. Since
! the lines were not printed during the lookahead, they must be
! printed now.
!
! FORMAL PARAMETERS:
!
! None
!
! IMPLICIT INPUTS:
!
! The source line list, and the source pool.
!
! IMPLICIT OUTPUTS:
!
! BACKLINE is reset to zero.
!
! ROUTINE VALUE:
!
! None
!
! SIDE EFFECTS:
!
! Source lines get printed
!
!--
%2505% ! Taken from LEXSUP.BLI and rewritten
BEGIN
REGISTER CELL; ! Index into source list
LOCAL TLINE,TCUR,TPTR;
! Save current line attributes
TLINE = .LINELINE;
TCUR = .CURPTR;
TPTR = .LINEPTR;
! Print the lines
CELL = .BACKLINE;
WHILE .CELL LSS .LINLCURR
DO
BEGIN
IF NOT .PRINTED(CELL) THEN PRINT(.CELL);
CELL = .CELL + LINLSENT;
END;
BACKLINE = 0; ! Nothing saved now
! Restore line attributes
LINELINE = .TLINE;
CURPTR = .TCUR;
LINEPTR = .TPTR;
END; ! of BACKPRINT
!
! Routine to write CRLF after ^Z on the -20
!
%1162% GLOBAL ROUTINE WRITECRLF =
%1162% BEGIN
%1162% IF FTTENEX THEN
%1162% BEGIN
%1162% REGISTER R1=1,R2=2,R3=3;
%1162% LOCAL RSV[3];
%1162% MACHOP JSYS = #104;
%1162% MACRO SOUT = JSYS (0,#53) $;
%1162% RSV[0] _ .R1; RSV[1] _ .R2; RSV[2] _ .R3;
%1162% R1 _ .XDEVJFN(SRC); !SOURCE JFN
%1162% R2 _ UPLIT (ASCIZ '?M?J')<36,7>; !POINT TO CR,LF
%1162% R3 _ 0; !TERMINATE ON NULL
%1162% SOUT;
%1162% R1 _ .RSV[0]; R2 _ .RSV[1]; R3 _ .RSV[2];
%1162% END
%1162% END; % WRITECRLF %
END %LISTNG%
ELUDOM