Trailing-Edge
-
PDP-10 Archives
-
tops20_version7_0_tools_tape_clock_tape
-
tools/blis10/dr0n.bli
There are 18 other files named dr0n.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) 1972,1973,1974,1977,1978 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 01754
!FILENAME: LODRIV.BLI
!DATE: 18 OCTOBER 73 MGM/FLD
%3.2% GLOBAL BIND LODRV=12; !MODULE VERSION NUMBER
! UTILITY ROUTINES FOR BLISS
! ------------------------------------------
!
! REVISION HISTORY:
!
! 7-14-77 ROUTINE READALINE IS MODIFIED TO FIX A BUG IN
! MULTIPLE MODULES.ANY ANYTHING FOLLOWED BY
! ELUDOM IS DISCARDED.IF MODULE FOLLOWS ELUDOM
! USER WILL GET AN ERROR FOR NEXT MODULE .
! 7-15-77 ROUITNE READALINE IS MODIFIED SO THAT NO EXTRA BLANK
! IS INSERTED IN QUOTED STRING EVER MORE THAN ONE
! SOURCE LINE.
! 6-2-77 ROUTINE EOCHAR IS MODIFIED SO THAT BLISS10 STATISTICS
! GETS LISTED ON TTY IF LISTING DEVICE IS NOT A TTY.
!
! 1/26/77 ADDED NECESSARY CODE TO FORCELINE TO HANDLE
! THE BLISS-36 LISTING DEMANDS. THIS INCLUDES A NEW
! ROUTINE LINOUT.
!
! 5-9-77 ROUTINE READALINE IS MODIFIED TO HAVE MORE THAN ONE
! MODULE IN A FILE.THIS DOES NOT ADVANCE THE INPUT
! BUFFER AND POINT TO CURRENT LINE IN INPUT BUFFER.
!
! IO ROUTINES
!-------------
%3.1% GLOBAL ROUTINE OUTPUT(DEV,CHUNK)=
! OUTPUT A CHUNK (ALLWORD OR CHAR) ON 'DEV', WHERE
! DEV= 1 BINARY DEVICE(HIGH SEGMENT)
! 2 LISTING DEVICE
BEGIN MACHOP IDPB=#136;
IF (DEVBUF[.DEV,2]_.DEVBUF[.DEV,2]-1) LEQ 0 THEN FORCE(.DEV);
3<0,36>_.CHUNK; IDPB(3,DEVBUF[.DEV,1])
END;
%3.1% GLOBAL ROUTINE OCHAR(CHAR)=
! OUTPUT ONE CHARACTER ON THE LISTING DEVICE
(IF NOT .LSTFLG THEN OUTPUT(2,.CHAR);1);
%3.1% GLOBAL ROUTINE OUTREL(ALLWORD)=
! OUTPUT ONE ALLWORD ON THE HIGH-SEG BINARY FILE
( IF NOT .BINFLG THEN OUTPUT(1,.ALLWORD);1);
%2.25%GLOBAL ROUTINE OUTPSTRING(PTR)=
%2.25% !OUTPUT THE ASCIZ STRING STARTING AT ADDRESS .PTR
%2.25% !TO THE LISTING DEVICE
%2.25%
%2.25% IF NOT .LSTFLG THEN
%2.25% BEGIN
%2.25% REGISTER BP, !BYTE POINTER TO OUTPUT STRING
%2.25% CHAR; !HOLDS CHAR TO BE OUTPUT
%2.25%
%2.25% BP_((.PTR)-1)<0,7>; !INIT BYTE POINTER
%2.25%
%2.25% !OUTPUT ASCIZ STRING UNTIL NULL CHAR
%2.25%
%2.25% UNTIL (CHAR_SCANI(BP)) EQL 0
%2.25% DO OUTPUT(2,.CHAR);
%2.25%
%2.25% END;
%3.1% GLOBAL ROUTINE OUTSTR(STR,N)=
IF NOT .LSTFLG THEN
BEGIN LOCAL P; MACHOP ILDB=#134;
! OUTPUT A (SHORT) STRING, N CHARS L.J., ON LISTING DEVICE
P_STR<7*.N,7>;
INCR I FROM 1 TO .N DO OUTPUT(2,ILDB(3,P));
.N
END;
%3.1% GLOBAL ROUTINE OUTSTN(I)=
IF NOT .LSTFLG THEN
BEGIN LOCAL P,N,C; MACHOP ILDB=#134;
! OUTPUT A NAME FROM THE ST, INDEX OF ENTRY IS 'I'.
P_ST[.I,1]<1,7>; N_0;
WHILE (C_ILDB(3,P)) NEQ #177 AND .N LSS 10 DO (OUTPUT(2,.C);N_.N+1);
.N
END;
%3.1% GLOBAL ROUTINE OUTBLANK(N)=
IF NOT .LSTFLG THEN
BEGIN ! OUTPUT 'N' BLANKS ON THE LISTING DEVICE
INCR I FROM 1 TO .N DO OUTPUT(2," ")
END;
%3.1% GLOBAL ROUTINE OUTMOC(ALLWORD)=
IF NOT .LSTFLG THEN
BEGIN LOCAL T; T_0;
! OUTPUT MINIMAL LENGTH OCTAL CONSTANT
DECR I FROM 11 TO 1 DO
IF .ALLWORD<3*.I,3> NEQ 0 THEN BREAK(T_.I);
DECR I FROM .T TO 0 DO OUTPUT(2,"0"+.ALLWORD<3*.I,3>);
.T+1
END;
%3.1% GLOBAL ROUTINE OUTCONOC(A)=
!OUTPUT-CONCISE-OCTAL. CALLED FOR 18BIT CONSTANTS. PUTS THEM IN
%3.19% !NEGATIVE FORMAT IF .A<15,3>=7.
%3.19% IF (.A<15,3> EQL 7) THEN (OCHAR("-"); OUTMOC(-(.A OR LEFTM)) + 1)
ELSE OUTMOC(.A);
%3.1% GLOBAL ROUTINE NEWLINE=
IF NOT .LSTFLG THEN
BEGIN
! WRITE NEW LINE SYMBOL, HANDLE REQ'D PAGINATION.
OCHAR(#15); OCHAR(#12); ! IF .TTYLST THEN (OCHAR(#15); OCHAR(#15));
IF (NLINES_.NLINES+1) GTR 56 THEN (PAGE(); NLINES_0);
IF .TTYLST THEN FORCE(2);
END;
! ERROR IO ROUTINES
!-------------------
%3.1% GLOBAL ROUTINE EOCHAR(CHAR)=
BEGIN
! ERROR OUTPUT (ONE CHARACTER). OUTPUT GOES TO THE LISTING
! DEVICE, IF THERE IS ONE, AND TO THE TTY -- IF: 1) TTY IS
! NOT THE LISTING DEVICE ALREADY, 2) ERROR MESSAGES TO TTY
! HAVE NOT BEEN SPECIFICALLY SUPRESSED.
IF NOT .LSTFLG THEN OUTPUT(2,.CHAR);
! OUTPUT BLISS-10 STATISTICS FOR BLISS-36C ALSO 6-1-77
IF NOT (.ERRBIT OR .TTYLST OR (.CCLCTL<2,1> AND NOT .B20FLG)) THEN TTYLIST(.CHAR);
1
END;
%2.25%GLOBAL ROUTINE EOUTPSTRING(PTR)=
%2.25% !OUTPUT THE ASCIZ STRING STARTING AT ADDRESS .PTR
%2.25%
%2.25% BEGIN
%2.25% REGISTER BP, !BYTE POINTER TO OUTPUT STRING
%2.25% CHAR; !HOLDS CHAR TO BE OUTPUT
%2.25%
%2.25% BP_((.PTR)-1)<0,7>; !INIT BYTE POINTER
%2.25%
%2.25% !OUTPUT ASCIZ STRING UNTIL NULL CHAR
%2.25%
%2.25% UNTIL (CHAR_SCANI(BP)) EQL 0
%2.25% DO EOCHAR(.CHAR);
%2.25%
%2.25% END;
%3.1% GLOBAL ROUTINE EOUTSTR(STR,N)=
BEGIN LOCAL P; MACHOP ILDB=#134;
! OUTPUT (SHORT) STRING ON ERROR DEVICE(S)
P_STR<7*.N,7>;
INCR I FROM 1 TO .N DO EOCHAR(ILDB(3,P));
END;
%3.1% GLOBAL ROUTINE EOSTN(I)=
BEGIN LOCAL P,N,C; MACHOP ILDB=#134;
!OUTPUT A NAME FROM THE ST. INDEX OF ENTRY 'I' ON ERROR DEVICES
P_ST[.I,1]<1,7>; N_0;
WHILE (C_ILDB(3,P)) NEQ #177 AND .N LSS 10 DO (EOCHAR(2,.C);N_.N+1);
.N
END;
ROUTINE EOUTBLANK(N)=
BEGIN
! OUTPUT SPECIFIED NO. BLANKS ON ERROR DEVICE(S)
DECR I FROM (.N - 1) TO 0 DO EOCHAR(" ");
END;
%3.20% GLOBAL ROUTINE OUTNUM(NUM, BASE, REQD, TOG)=
%3.20% BEGIN OWN N, B, RQ, T, OUTCHAR, ANUM;
%3.20%
%3.20% ROUTINE OUTXNUM=
%3.20% BEGIN LOCAL R;
%3.20%
%3.20% IF .N EQL 0 THEN
%3.20% (IF .RQ NEQ 0 THEN
%3.20% (DECR I FROM (.RQ - .T - .ANUM) TO 0 DO
%3.20% (.OUTCHAR)(IF .B EQL 10 THEN " " ELSE "0"));
%3.20% RETURN 0);
%3.20%
%3.20% R_ .N MOD .B; N_ .N / .B; T_ .T + 1;
%3.20% OUTXNUM(); (.OUTCHAR)("0" + .R);
%3.20% END;
%3.20%
%3.20%
%3.20% OUTCHAR_ IF .TOG THEN EOCHAR<0,0> ELSE OCHAR<0,0>;
%3.20%
%3.20% IF .NUM LSS 0 THEN (.OUTCHAR)("-");
%3.20%
%3.20% ANUM_ 1 + ((.NUM EQL 0) AND (.BASE EQL 10));
%3.20%
%3.20% B_ .BASE; RQ_ .REQD; T_ 0; N_ ABS(.NUM); OUTXNUM();
%3.20%
%3.20% IF (.NUM OR ((.REQD NEQ 0) AND (.BASE NEQ 10))) EQL 0 THEN (.OUTCHAR)("0");
%3.20%
%3.20% END;
%3.1% GLOBAL ROUTINE ENEWLINE=
BEGIN
! OUTPUT NEWLINE ON THE ERROR DEVICE(S). CHECK PAGINATION
EOCHAR(#15); EOCHAR(#12);
IF NOT .LSTFLG THEN
IF (NLINES_.NLINES+1) GTR 56 THEN (PAGE(); NLINES_0);
END;
%3.1% GLOBAL ROUTINE EMESSAGE(N)=
BEGIN
! WRITE OUT A LIST OF N ONE-FULLWORD STRINGS ON THE ERROR
! DEVICE(S). THE STRINGS ARE ASSUMED BELOW N ON THE
! STACK, AND HENCE THE CALL LOOKS LIKE:
!
! EMESSAGE( -STR-,-STR-, ... ,-STR-, N )
! <------ N OF 'EM ------>
!
!
DECR I FROM .N TO 1 DO EOUTSTR(@(N-.I),5);
END;
%3.1% GLOBAL ROUTINE FORCELINE(TOG)=
BEGIN REGISTER P,C; MACHOP ILDB=#134; EXTERNAL BXA;
%5.200.37% EXTERNAL BGNLINETAG;
EXTERNAL DLCNT; ! NUMBER OF DEL CHARS IN INPUT LINE.
! THIS ROUTINE FORCES OUT THE CURRENT INPUT BUFFER LINE
! IF IT IS VALID (IE, IT HASN'T BEEN PRINTED ALREADY.
! THE VALUE OF TOG SPECIFIES WHETHER THE LINE IS WRITTEN
! TO BOTH THE LISTING AND ERROR DEVICES. TOG=1 => ALSO
! TO THE ERROR DEVICE.
ROUTINE LINOUT(BUFPNT,TOG)=
! OUTPUT A STRING OF CHARACTERS STARTING WITH THE FIRST CHARACTER
! IN THE WORD POINTED TO BY BUFPNT AND ENDING WITH CHARACTER
! #177. IF TOG IS TRUE THIS IS AN ERROR OUTPUT.
BEGIN
LOCAL C,P;
P_(.BUFPNT-1)<1,7>;
WHILE (C _ SCANI(P)) NEQ #177 DO
IF .C GEQ " " OR .C EQL #11
THEN
IF .TOG
THEN
EOCHAR(.C)
ELSE
OCHAR(.C);
.VREG
END;
LOCAL PFXP,PFXCNT,PFXBUF[2];
IF .VALIDBUF THEN
BEGIN
VALIDBUF _ 0;
IF .B20FLG<0,1> AND .B20FLG<2,1> THEN
BEGIN
P _ BUFF<22,7>; ! 2ND CHAR. 1ST IS ALWAYS SPACE
C _ SCANN(P);
IF .C NEQ "!" THEN RETURN .VREG;
REPLACEN(P,1);
C _ SCANI(P);
IF .DLCNT GEQ 2 THEN RETURN .VREG;
PFXP=PFXBUF<29,7>;
REPLACEN(PFXP,#177);
PFXCNT=0;
IF .DLCNT EQL 0 THEN
IF .C EQL #11
THEN
WHILE .C NEQ #177 DO
BEGIN
REPLACEN(P,1);
IF (C _ SCANI(P)) EQL #11
THEN
EXITLOOP;
END
ELSE
BEGIN
WHILE .C NEQ #177 DO
BEGIN
REPLACEN(P,1);
IF "A" LEQ .C AND .C LEQ "Z" THEN
IF .PFXCNT LSS 7 THEN
BEGIN
REPLACEN(PFXP,.C);
REPLACEI(PFXP,#177);
PFXCNT _ .PFXCNT+1;
END;
IF (C_SCANI(P)) EQL #11
THEN
EXITLOOP;
END;
END;
END;
IF .RPAGE THEN (PAGER(); NLINES_ 0);
P_@@(BXA+#16)^(-1);
%2.25% OCHAR(";"); !MAKE IT A COMMENT FOR MACRO-10
IF .B20FLG<0,1> AND .B20FLG<2,1>
THEN
LINOUT(PFXBUF,.TOG)
ELSE
IF .TOG
THEN
(EOUTSTR(.P,5); EOCHAR(.BGNLINETAG); EOCHAR(#11); OUTNUM(.LINCNT^(-4),10,4,1); EOUTBLANK(3)) !5.200.37 3.20
ELSE
(OUTSTR(.P,5); OCHAR(.BGNLINETAG); OCHAR(#11); OUTNUM(.LINCNT^(-4),10,4,0); OUTBLANK(3)); !5.200.37 3.20
LINOUT(BUFF,.TOG);
IF .TOG THEN ENEWLINE() ELSE NEWLINE();
END;
END;
%3.12% GLOBAL ROUTINE SAVEMACSRC=IF NOT (.LSTFLG OR .TTYLST) THEN OUTPUT(2,";");
! THIS ENTIRE PAGE WAS GENERATED FOR CCO 3.18, UNLESS SPECIFICALLY
! OTHERWISE STATED, THAT IS THE CCO LEVEL FOR EACH LINE.
FORWARD GIVEDIAG;
GLOBAL ROUTINE IDERROR(NUM,STE)=
BEGIN
FORCELINE(1); ENEWLINE(); !PRINT LINE AND BLANK
GIVEDIAG(.NUM, 0); !GIVE DIAGNOSTIC WITH NO <CRLF>
EMESSAGE("; ID",": ",2); !TELL WHAT WE'RE GIVING
EOSTN(.STE); ENEWLINE(); ENEWLINE(); !GIVE BAD ID
WARNINGFOUND_ .WARNINGFOUND + 1;
END;
GLOBAL ROUTINE ERROUT(NUM, POSN)=
BEGIN
! 5.200.36 ... PROVIDE LIST OF ERROR LINES
GLOBAL HDERRLINE,ERRLINLNG;
MACRO EFIRSTB=HDERRLINE<18,18>$,
ELASTB=HDERRLINE<0,18>$,
EBLKN=CT[.ELASTB,0]<18,18>$,
EBLK1=CT[.ELASTB,0]<0,18>$,
EBLK2=CT[.ELASTB,1]<18,18>$,
EBLK3=CT[.ELASTB,1]<0,18>$;
GLOBAL ROUTINE PRNTERLNS=
BEGIN
ROUTINE PRNTERLNV(L16)=
BEGIN
BIND LNSIZE=130;
IF .ERRLINLNG EQL 0 THEN
(EOUTBLANK(10);ERRLINLNG_10);
IF .ERRLINLNG GTR LNSIZE-6 THEN
(ENEWLINE();ERRLINLNG_0;PRNTERLNV(.L16);RETURN);
EOUTBLANK(2);OUTNUM(.L16<4,14>,10,4,1);
ERRLINLNG_.ERRLINLNG+6;
RETURN
END;
LOCAL L1;
IF .EFIRSTB EQL 0 THEN RETURN;
L1_.EFIRSTB;
EFIRSTB_.ELASTB;
ELASTB_.L1;
ENEWLINE();ENEWLINE(); ERRLINLNG_0;
EMESSAGE("ERROR","S AND","/OR W","ARNIN","GS ON",
" LINE","S: ",7);
ENEWLINE();
WHILE (.EFIRSTB NEQ .ELASTB) DO
(PRNTERLNV(.EBLK1);
PRNTERLNV(.EBLK2);
PRNTERLNV(.EBLK3);
ELASTB_.EBLKN);
PRNTERLNV(.EBLK1); IF .EBLKN EQL 1 THEN RETURN (HDERRLINE_0);
PRNTERLNV(.EBLK2); IF .EBLKN EQL 2 THEN RETURN (HDERRLINE_0);
PRNTERLNV(.EBLK3); RETURN (HDERRLINE_0)
END;
IF .ELASTB EQL 0 THEN
(ELASTB_EFIRSTB_GETSPACE(1);
EBLKN_1;
EBLK1_.POSN<LEFTHALF>)
ELSE IF .EBLKN EQL 3 THEN
(EBLKN_GETSPACE(1);
ELASTB_.EBLKN; !WE NOW POINT TO THE NEW BLOCK
EBLKN_1;
EBLK1_.POSN<LEFTHALF>)
ELSE
(EBLKN_.EBLKN+1;
(IF .EBLKN EQL 2 THEN EBLK2 ELSE EBLK3)_.POSN<LEFTHALF>);
! ... 5.200.36
FORCELINE(1); SAVEMACSRC(); !PRINT BAD LINE
IF .POSN<LEFTHALF> EQL .LINCNT
THEN EOUTBLANK(9)
ELSE (EOUTSTR("LINE:",5);
%3.20% OUTNUM(.POSN<22,14>,10,4,1)); !INFORM THE USER OF WHICH LINE WE MEAN
EOUTBLANK(6); !POSITION
%5.200.23% DECR I FROM (.POSN<0,7>-2) TO 0 DO EOCHAR(".");
EOCHAR("^"); ENEWLINE(); !POINT TO ERROR
GIVEDIAG(.NUM, 1); ENEWLINE(); !GIVE DIAGNOSTIC
END;
GLOBAL ROUTINE ERROR(POS, NUM)=
BEGIN
IF NOT .ERRLEVEL THEN
(ERROUT(.NUM, .POS);
CODETOG_ LABIND_ 0;
ERRORFOUND_ .ERRORFOUND + 1);
0
END;
GLOBAL ROUTINE WARNEM(POS, NUM)= (ERROUT(.NUM, .POS); WARNINGFOUND_ .WARNINGFOUND + 1; 0);
! THIS ENTIRE PAGE WAS GENERATED FOR CCO 3.18. UNLESS SPECIFICALLY
! OTHERWISE STATED, THAT IS THE CCO LEVEL FOR EVERY LINE.
MACRO SKIP(OP)=(REGISTER Q; Q_ 1; (OP); Q_ 0; .Q)$;
FORWARD ERRRELEASE;
ROUTINE GETERRFILE(DEVICE,PPN)=
BEGIN LOCAL OPENBLOCK[3], SJBFF;
REGISTER REG;
EXTERNAL ?.JBFF;
MACHOP OPEN=#050, INBUF=#064, LOOKUP=#076;
IF .ERROPEN THEN RETURN 1; !RETURN IF ALREADY OPEN
ERRDAT_ GETSPACE(#205);
OPENBLOCK_ 0;
OPENBLOCK[1]_ .DEVICE;
ERRDAT<LEFTHALF>_ OPENBLOCK[2]_ ST[.ERRDAT<RIGHTHALF>,0]<0,0>;
IF NOT SKIP(OPEN(4,OPENBLOCK<0,0>)) THEN
RETURN (ERRRELEASE(); 0);
SJBFF_ .?.JBFF; ?.JBFF_ .ERRDAT<LEFTHALF>+3;
INBUF(4,1); ?.JBFF_ .SJBFF;
ERRFILE[3]_ .PPN;
IF NOT SKIP(LOOKUP(4,ERRFILE<0,0>)) THEN
RETURN (ERRRELEASE(); 0);
ERROPEN_ 1
END;
ROUTINE ERRRELEASE=(RELEASESPACE(.ERRDAT<RIGHTHALF>,#205); ERROPEN_ 0);
ROUTINE INERRCHAR=
BEGIN MACHOP IN=#056, STATZ=#063;
IF ((.ERRDAT<LEFTHALF>)[2]_ .(.ERRDAT<LEFTHALF>)[2] - 1) LEQ 0 THEN
IF SKIP(IN(4)) THEN
IF SKIP(STATZ(4,#740000)) THEN RETURN 0;
SCANI((.ERRDAT<LEFTHALF>)[1])
END;
! THIS ENTIRE PAGE WAS GENERATED FOR CCO 3.18. SEE COMMENTS ON
! THE PRECEEDING PAGES.
GLOBAL ROUTINE GIVERRDIAG(DISP, HEAD)=
BEGIN LOCAL TEMP, VALUE, NOTDONE;
REGISTER PTR;
MACHOP USETI=#074;
LABEL DIAGLOP;
USETI(4, .ERRTABLE[.DISP]<0,12>);
NOTDONE_ 1;
WHILE .NOTDONE DO
(PTR_ HEAD<36,7>;
(VALUE_ DIAGLOP: DECR I FROM 3 TO 0 DO
(IF (IF (TEMP_ INERRCHAR()) EQL 0
THEN RETURN 0
ELSE .TEMP) NEQ SCANI(PTR)
THEN LEAVE DIAGLOP WITH 0);
NOTDONE_ .VALUE + 1));
DECR I FROM 7 TO 0 DO INERRCHAR(); !SCAN PAST PARAMETERS
UNTIL (TEMP_ INERRCHAR()) EQL #15 DO EOCHAR(.TEMP); !GIVE DIAGNOSTIC
1
END;
! THE COMMENTS ON THE PRECEEDING PAGES CONCERNING CCO 3.18 REFER TO
! THIS PAGE TOO.
GLOBAL ROUTINE GIVEDIAG(NUM, CRLFFLAG)=
BEGIN LOCAL TYPE;
SAVEMACSRC(); ! MAKE A COMMENT OF THE MESSAGE
EOCHAR(IF (TYPE_ IF (TYPE_ .ERRTABLE[.NUM]<12,2>) EQL 0
THEN "%"
ELSE IF .TYPE EQL 1 THEN "??" ELSE "@") EQL "@" THEN "??" ELSE .TYPE); !MESSAGE TYPE
EOUTSTR("BLS",3); ! COMPILER ID
EOUTSTR(.ERRTABLE[.NUM]<15,21>, 3); ! MNEMONIC
IF .NOENGLISH THEN
RETURN (IF .CRLFFLAG THEN ENEWLINE()); ! DONE IF ONLY MNEMONIC
EOCHAR(#11); ! TAB
%3.31% IF .COREGONE THEN
%3.24% RETURN (EMESSAGE("The c","ompil","er is"," unab","le to",
%3.24% " acqu","ire a","dditi","onal ","core",10);
%3.24% ENEWLINE());
IF NOT GETERRFILE(.ERRDEV,.ERRPPN) THEN ! CAN'T LOCATE CORRECT .ERR FILE
IF NOT GETERRFILE(SIXBIT'SYS',0) THEN ! CHECK SYS
RETURN (ENEWLINE(); SAVEMACSRC();
EMESSAGE("%BLSN","ER Ca","nnot ","acces","s .ER",
"R fil","e", 7); ENEWLINE()); ! HACK MESSAGE
IF NOT GIVERRDIAG(.NUM, .TYPE^29 + (.ERRTABLE[.NUM]<15,21>^8))
THEN (ENEWLINE(); SAVEMACSRC();
EMESSAGE("%BLSN","MS Ca","nnot ","find ","appro",
"priat","e mes","sage",8); ENEWLINE());
IF .CRLFFLAG THEN ENEWLINE();
END;
! LOGICAL (?) IO ROUTINES
!-------------------------
%3.1% GLOBAL ROUTINE READALINE=
BEGIN LOCAL L1;
%5.200.37% GLOBAL EOLCONTEXT,BGNLINETAG;
% THE FOLLOWING LINE HAS THIS PURPOSE.IF TRUE, IT
JUST FINISHED PROCESSING ONE MODULE FROM A FILE.IT IS READY
TO PROCESS NEXT MODULE.IF FALSE IGNORE IT.DRIVER ROUTINE
SETS IT AND REINIT ROUTINE USES IT.
THERE MAY BE MORE THAN ONE MODULE IN A FILE.
THERE IS ALREADY AN INPUT LINE IN THE BUFFER AND DONOT READ NEXT LINE.
%
%3-24-77% EXTERNAL NOMOREINPUT; !TRUE MEANS JUST FINISHED ONE MODULE
!5.200.37 EOLCONTEXT IS TOP_OF_STACK OF CHAR DESCRIBING LEXICAL (OR OTHER ) STATE:
!5.200.37 "%" FOR INSIDE %-COMMENT
!5.200.37 "M" FOR INSIDE MACRO DEFINITION
!5.200.37 "S" FOR INSIDE STRING ("..", '...')
!5.200.37 "*" FOR INSIDE CODE NOT COMPILED DUE TO LITERAL TEST IN IF*THEN*ELSE
!5.200.37 (THESE ARE NOT ALL IMPLEMENTED: MARCH 1, 1976)
! READ THE NEXT INPUT LINE INTO 'BUFF', PRINTING THE PREVIOUS
! LINE IF THIS HAS NOT ALREADY BEEN DONE (EG., BY AN ERROR
! MESSAGE. A LINE NUMBER IS ASSIGNED TO THE INPUT LINE AND
! A RECORD OF THIS IS PLACED IN THE CODE STRING.
FORCELINE(0); VALIDBUF_1; LINCNT_.LINCNT+16;
%5.200.37% BGNLINETAG_.EOLCONTEXT; !EOLCONTEXT WILL BE RESET, IF NECESSARY, ELSEWHERE.
%5.200.37% IF .BGNLINETAG EQL 0 THEN IF NOT .CODETOG THEN
%5.200.37% BGNLINETAG_"*"; !INSIDE NON-COMPILING CODE
IF .CT[.CT[.CODEPTR,1]<PREVF>,1]<LEFTHALF> NEQ 0
THEN BEGIN
CT[L1_GETSPACE(1),1]_.LINCNT;
PUSHBOT(.CODEPTR,.L1);
END;
IF .NOMOREINPUT THEN NOMOREINPUT_0 %RESET IT AND GO %
ELSE
IF READTEXT() THEN RECOVER (.LINCNT^18,ERILTL); !IF 1 INPUT LINE IS LONGER THAN 135 CHARS
IF .FINFLG THEN ( BUFF_'END);'; BUFF+1_'$;%"'''; BUFF+2_#067777777777 );
IF .BUFF
THEN (PBUFF_IF .EOLCONTEXT EQL "S" THEN (BUFF+1)<29,7> ELSE BUFF<1,7>; NCBUFF_5+.LINCNT^18)
ELSE (PBUFF_IF .EOLCONTEXT EQL "S" THEN BUFF<29,7> ELSE (BUFF-1)<1,7>; NCBUFF_0+.LINCNT^18);
END;
!END OF LODRIV.BLI