Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/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,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: D. B. TOLMAN/DCE/SJW/RDH/TFV/EGM
MODULE LISTNG(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4)=
BEGIN %LISTNG%
GLOBAL BIND LISTNV = 6^24 + 0^18 + 26; ! Version Date: 28-Sep-81
%(
***** 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.
***** End Revision History *****
)%
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;
EXTERNAL MSNGTIC; !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
EXTERNAL ARINGLEFT; !USED FOR HANDLING BUFFERS CORRECTLY
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 %
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
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 %
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
!
![767] PRINT /G OR /F77 IF APPROPRIATE
IF .F2<GFL> THEN STRNG7('/G'); ![767]
%1133% IF .F2<STA> THEN STRNG7('/ST'); ! Statistics
IF F77 THEN STRNG7('/F77');![767]
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');
IF .FLGREG<EXPAND> THEN STRNG7('/E');
IF .FLGREG<NOERRORS> THEN STRNG7('/NOER');
!ADD /L TO PAGE HEADERS IF LINE NUMBER/OCTAL MAP REQUESTED
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;
%[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
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 ;
!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%
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"
! -20 ONLY: CLEAR LASTCHARACTER AFTER ^Z SO MORE TTY: INPUT MAY BE DONE
THEN BEGIN
LASTCHARACTER _ 0;
RETURN CHK4MORE ();
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
!CHECK FOR PARTIAL BUFFER STILL LEFT AND GO GET IT
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
! OTHERWISE CHECK THE STATUS
% CHECKSTATUS RETURN EOF IF EOF
TERMINATE IF ERROR
OTHERWISE CONTINUE %
IF INSTAT() EQL EOF THEN RETURN .VREG
END ; %CHK%
IF (.FFBUFSAV+.BGSTBF) LSS .JOBFF
THEN (EXTERNAL E61,FATLERR,LASTLINE;
FATLERR(.LASTLINE,PLIT'EOPRES',E61<0,0>));
JOBFF _ .FFBUFSAV + .BGSTBF; !LEAVE ENOUGH SPACE SO THE LARGEST
!DEVICE BUFFERS WILL FIT LATER
%CHECK TO SEE THAT WE HAVE ENOUGH CORE %
GETCORE();
FFICLSV _ 0; !INITIALIZE FOR INCLUDE
END;
END; %NOT FTTENEX%
% INITIALIZE POINTERS %
CURPTR _ 0;
T2 _ POOLBEGIN ; ! RING BUFFER TRANSFER POINT
VREG _ RINGLENGTH;
CURPOOLEND _ POOLBEGIN + .VREG ;
ADJUST _ 0 ; ! TRANSFER ENTIRE RING BUFFER
END % COMPILATION INITIALIZATION %
ELSE
BEGIN % RESTORE POOL AFTER PREVIOUS END OF PROGRAM %
IF FTTENEX
THEN BUFFERS(ICL) _ 0
ELSE FFICLSV _ 0; !INITIALIZE FOR INCLUDE
IF .EOPSAVE NEQ 0
THEN ( % RESTORE SAVED PORTION %
T1 _ .SAVESTART ^18 + POOLBEGIN;
T2 _ POOLBEGIN + .SAVESIZE ;
BLT ( T1, -1 , T2 ) ;
SAVSPACE ( .SAVESIZE-1, .SAVESTART );
ADJUST _ 0; ! TRANSFER ENTIRE RING BUFFER
)
ELSE ( % ONLY THE RING BUFFER NEED BE RESTORED %
T2 _ POOLBEGIN ;
% HOW MUCH OF THE RING BUFFER SHOULD BE TRANSFERED%
VREG _ RINGLENGTH;
IF (ADJUST _ POOLBEGIN - ( .CURPOOLEND<RIGHT> - .VREG ) ) LSS 0
THEN ADJUST _ 0 ;
)
END ; % RESTORE POOL %
% NOW RESTORE THE RING BUFFER STARTING AT .T2, BUT ONLY RESTORE
THE LAST (RINGLENGTH - .ADJUST) WORDS. %
T1 _ .T2;
VREG _ RINGSTART;
T1<LEFT> _ .VREG + .ADJUST ;
VREG _ RINGLENGTH;
T2 _ .T2<RIGHT> + .VREG - .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 EOF MAY BE RETURNED.
SOMEWHAT UNLIKELY THOUGH %
RETURN LEXINIT()
END; % EOPRESTORE %
GLOBAL ROUTINE
OVERFLOW ( INCLASS, CLASSERR ) =
BEGIN
EXTERNAL E51,E61,SHIFTPOOL,FATLEX;
% THIS ROUTINE IS CALLED WHEN A STATEMENT COMPLETELY
FILLS THE STATEMENT BUFFER POOL %
IF .INCLASS NEQ 0
THEN
% 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);
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%
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 %
REGISTER T1,T2;
OWN ADJUST; ! POINTER ADJUSTMENT VALUE
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;
% SHIFT TO THE TOP OF POOL %
ADJUST _ .T1 - POOLBEGIN ;
T2 _ .CURPOOLEND - .T1 + POOLBEGIN ;
T1 _ .T1^18 + POOLBEGIN;
BLT ( T1,-1,T2);
%NOW ADJUST ALL THE LITTLE POINTERS %
STLPTR _ .STLPTR - .ADJUST;
CURPTR _ .CURPTR - .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 (LINENUM) =
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 _ .LINENUM;
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 =
BEGIN %PRINT%
LOCAL MSGTOTTY; ! IF 1 INDICATES THAT ANY ERROR MESSAGES SHOULD BE TYPED AS WELL AS PRINTED
LABEL LINEPR;
IF (.MSGNOTYPD OR .ERRFLAG ) AND NOT .FLGREG<TTYDEV> AND NOT .FLGREG <NOERRORS>
THEN % THERE ARE ERROR MESSAGES OR LINES TO BE OUTPUT TO THE TTY %
BEGIN
% TYPE ANY EARILER UNTYPED LINES AND CURRENT LINE, WITH LINE NUMBERS%
BACKTYPE ( ALLCHAR );
MSGTOTTY _ 1
END
ELSE MSGTOTTY _ 0;
% 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 );
NOCR _ 0
END ; %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;
REGISTER C;
LABEL TYPELINES,BUFLOOP;
IF NOT .ERRFLAG
THEN
BEGIN % START AT THE BEGINNING OF THE LINE %
LINE _ .ISN; ! BEGINNING LINE NUMBER
BTPTR _ .STPTR; !
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>;
IF .POS NEQ 72
THEN
BEGIN % BLANK FILL FOR PARTIAL LINES %
DECR I FROM 72-.POS-1 TO 0
DO REPLACEI ( TTYPTR, " " );
POS _ 72
END;
TYPELINES:BEGIN
% ISOLATE THE NEXT LINE %
WHILE 1 DO
BUFLOOP:BEGIN
DECR I FROM 99 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 %
END %LISTNG%
ELUDOM