Trailing-Edge
-
PDP-10 Archives
-
BB-4157D-BM
-
sources/inout.bli
There are 12 other files named inout.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) 1973,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: F.J. INFANTE, D. B. TOLMAN/MD/SJW
MODULE INOUT (RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4,GLOROUTINES)=
BEGIN
GLOBAL BIND INOUV = 5^24 + 1^18 + 40; !VERSION DATE: 16-MAY-77
%(
REVISION HISTORY
29 ----- ----- ADD HEADCHK TO CHECK FOR HEADINGS WHEN OUTPUTING
INFORMATION AT THE END OF PROGRAM AND FOR MACRO LISTNG
30 ----- ----- OUTPUT CRLF FOR ERROR MESSAGES AFTER PHASE 1
BEFORE THE MESSAGE
31 ----- ----- ROUTINE ERROR - DELETE ALL MESSAGES THAT ARE
NOT USED ( LEAVING 4 )
CHANGE THEM TO ?FTN FORMAT
CHANGE ALL CALLS TO NEW NUMBERS
32 ----- ----- SET ERRFLAG IN FATLERR WHEN THE MESSAGE
IS NOT PUT IN THE QUEUE. BACKTYPE DOES THIS
BUT SOMETIMES IT DOESNT GET CALLED, MAKING
FOR SOME APPARRENT INCONSISTANCY
CHANGE OUTUUO TO USE SKIP MACRO
33 ----- ----- CHANGE RELOUT TO USE OUUOBIN FOR MORE MODULARITY
34 ----- ----- PUT FTTENEX I/O IN
35 ----- ----- FIXUP SOUTPUT A BIT
36 335 17377 FIX FATLERR SO THAT IT PRESERVES NAME
AS SET BY LEXICAL.
37 467 VER5 REQUIRE FTTENX.REQ
********** BEGIN VERSION 5A **********
40 573 ----- REQUIRE DBUGIT.REQ
)%
EXTERNAL ENTRY;
REQUIRE FTTENX.REQ;
REQUIRE DBUGIT.REQ; ![573] SJW 16-MAY-77
REQUIRE LEXAID.BLI;
REQUIRE IOFLG.BLI;
BIND BMODE= #14,AMODE= 0,
BINARYOUTP= 1^18+1^BMODE,
ASCIIOUTP= 1^18+1^AMODE,
ASCIIINP= 1^19+1^AMODE;
EXTERNAL FLGWRD;
MACRO ADVANCEN= 30,6$,
BACKSPACEN= 24,6$,
FULL= 0,36$;
EXTERNAL JOBREL,JOBSA,JOBFF;
EXTERNAL CCLSW,INDEX;
EXTERNAL JOBFFSAVE;
MACRO SKIP(OP)=
BEGIN
VREG_1;
OP;
VREG_0;
.VREG
END$,
NOSKIP(OP)=
BEGIN
VREG_0;
OP;
VREG_1;
.VREG
END$;
MACHOP IDIVI = #231, MOVEI = #201, ROTC = #245;
MACRO E1=1$,E2=2$,E3=3$,E4=4$,E5=5$,E6=6$,E7=7$,E8=8$,E9=9$,E10=10$,E11=11$,E12=12$,E13=13$,E14=14$,E15=15$,
E16=16$,E17=17$,E18=18$,E19=19$,E20=20$,E21=21$,E22=22$,E23=23$,E24=24$,E25=25$,E26=26$,E27=27$,E28=28$,
E29=29$,E30=30$;
EXTERNAL ERRLINK,SAVSPACE;
FORWARD STRNGOUT,LINEOUT,CHAROUT,FATLERR,WARNERR,CLOSUP,SOUTPUT;
EXTERNAL NAME,CORMAN,MSGNOTYPD,ERRMSG,NUMFATL,NUMWARN,WARNOPT;
EXTERNAL NOCR,PAGE;
EXTERNAL BASENO,HEADPTR,BACKTYPE;
FORWARD BLDMSG;
%(-----------------------------------------------------------------------------------------------------------------
ROUTINE ERROR(N,CHNL)= TYPE ERROR NUMBER N USING CHNL TO SPECIFY WHICH FIELD,
DEVICE, FILE, OR PROJECT PROGRAMMER NUMBER TO TYPE.
RETURNS TO JOB STARTING ADDRESS (.JOBSA) SO THAT
ANOTHER COMMAND STRING MAY BE TYPED. CALLED BY I/O ROUTINES TO
TYPE FATAL I/O ERRORS ONLY.
GLOBAL ROUTINE GETBUF= RETURNS NEXT CHARACTER FROM SOURCE IN VREG AND AS ITS VALUE,
IF AND END OF FILE OCCURS THEN IT RETURNS EOF AS ITS VALUE
IF ANY OTHER ERROR CONDITION OCCURS THE ERROR ROUTINE IS CALLED
TO TYPE OUT THE APPROPRIATE ERROR MESSAGE.
GLOBAL ROUTINE LSTOUT= OUTPUTS THE CONTENTS OF REGISTER C AS THE NEXT LISTING CHARACTER.
THE ERROR ROUTINE IS CALLED IF AN ERROR OCCURS.
GLOBAL ROUTINE RELOUT= OUTPUTS THE CONTENTS OF REGISTER C AS THE NEXT WORD OF THE
OBJECT FILE. THE ERROR ROUTINE IS CALLED IF AN ERROR OCCURS.
-----------------------------------------------------------------------------------------------------------------)%
MACRO NXT(C) = REPLACEI ( HEADPTR, C ) $;
GLOBAL ROUTINE
DIGITS(NUM)=
BEGIN
LOCAL N;
GLOBAL NUMODIG; !USED TO COUNT UP THE DIGITS IF THE CALLER ZEROS IT
N_.NUM MOD @BASENO;
IF (NUM_.NUM/@BASENO) NEQ 0 THEN DIGITS(@NUM);
NUMODIG _ .NUMODIG + 1; !COUNT UP THE NUMBER OF DIGITS
NXT ( .N + "0" );
.VREG
END;
GLOBAL ROUTINE
STRNG6 ( ST ) =
BEGIN
REGISTER T[2];
T[0] _ .ST;
VREG_0; !COUNT THE LETTERS
DO (MOVEI(T[1],0);ROTC(T[0],6);MOVEI(T[1]," ",T[1]);NXT( .T[1] ); VREG_.VREG+1) UNTIL .T[0] EQL 0;
.VREG
END;
GLOBAL ROUTINE
STRNG7 ( ST ) =
BEGIN
REGISTER T[2];
T[0] _ .ST;
DO (MOVEI(T[1],0);ROTC(T[0],7);NXT( .T[1] )) UNTIL .T[0] EQL 0;
.VREG
END;
GLOBAL ROUTINE
HEADCHK =
BEGIN % WHEN CALLED WILL CHECK TO SEE IF THE END OF PAGE HAS
BEEN REACHED AND IF SO PUT OUT A HEADING %
EXTERNAL PAGELINE,HEADING;
IF NOT .FLGREG<LISTING> THEN RETURN;
IF .PAGELINE LEQ 0
THEN HEADING();
PAGELINE _ .PAGELINE -1;
END; %HEADCHK%
GLOBAL ROUTINE
HEADING =
BEGIN
% PUT THE ROUTINE NAME AND PAGE NUMBER IN THE HEADING AND PRINT IT %
EXTERNAL FNDFF,HEADSTR,HEADPTR,BASENO,PAGEPTR,PROGNAME;
% PUT BLANKS IN WHERE THE NAME WILL GO %
HEADSTR[0] _ ' ';
HEADSTR[1]<29,7> _ " ";
HEADPTR _ HEADSTR<36,7>;
STRNG6( .PROGNAME );
HEADPTR _ .PAGEPTR;
IF .FNDFF EQL 0
THEN CHAROUT ( FF ) ! OUTPUT FF IF USER DIDN'T PUT ONE IN
ELSE ( FNDFF _ 0; PAGE<LEFT> _ .PAGE<LEFT> + 1; PAGE<RIGHT> _ 0); ! RESET PAGE
BASENO _ 10;
DIGITS ( .PAGE<LEFT> );
IF .PAGE<RIGHT> NEQ 0
THEN ( NXT("-"); DIGITS( .PAGE<RIGHT> ) );
NXT("?0");
PAGE _ .PAGE + 1;
PAGELINE _ LINESPERPAGE - 3;
STRNGOUT ( HEADSTR<ADRS> ); STRNGOUT( PLIT'?M?J?M?J?M?J?0');
END; % HEADING %
GLOBAL ROUTINE
FATLERR (ENT2,ENT1,LINE,ERRNUM ) =
% THIS ROUTINE WILL QUEUE OR PRINT THE ERROR MESSAGE DEPENDING ON THE
CURRENT LINE NUMBER AND THE ONE ASSOCIATED WITH THE MESSAGE. IF THE TWO
NUMBERS ARE NOT EQUAL THEN THE MESSAGE IS PRINTED BECAUSE IT RELATES
TO SOME PREVIOUSLY UNPRINTED LINE. IF THEY ARE EQUAL THEN IT RELATES
TO THE CURRENT AND UNPRINTED LINE AND SO WILL BE QUEUED UNTIL THE LINE
IS PRINTED. %
% PARAMETERS:
ENT1 - FIRST MESSAGE PARAMETER( 7BIT,6BIT , OR NUMBER)
ENT2 - SECOND MESSAGE PARAMETER
THE PARAMETER INDICATOR IN THE MESSAGE SKELETON
SPECIFIES THE TYPE OF PARAMETER.
LINE - LINE NUMBER ASSOCIATED WITH THE MESSAGE
ERRNUM - ERROR NUMBER
WARNFATL - IF 1 INDICATES A FATAL ERROR, 0 A WARNING
NOTE THAT ONLY THE LAST THREE PARAMETERS ARE REQUIRED
%
BEGIN
REGISTER T1,
ENODE;
EXTERNAL SEGINCORE;
OWN ERRNODE [4]; ! TEMPORARY ERRNODE AREA
EXTERNAL WARMSG,WOPTMSG;
%DETERMINE IF WARNING OR FATAL ERROR %
IF .ERRNUM<RIGHT> LSS WARMSG<0,0>
THEN
BEGIN %WARNING%
NUMWARN _ .NUMWARN + 1;
IF .ERRNUM<RIGHT> GEQ WOPTMSG<0,0>
THEN WARNOPT _ -1; !WARNING MAY AFFECT OPTIMIZED CODE
IF .FLGREG<NOWARNING> THEN RETURN -1
END
ELSE
BEGIN %FATAL%
NUMFATL _ .NUMFATL + 1;
FLGREG<ERRSW> _ -1
END;
IF .LINE EQL .LINELINE AND .SEGINCORE EQL 1 % ALWAYS PRINT MESSAGES FOR LATER PASSES %
THEN % ASSOCIATED WITH CURRENT LINE SO QUEUE IT %
BEGIN
%**;[335],MODULE INOUT,MD,08-DEC-75%
%**;[335],ROUTINE FATLERR @ 584 , ADD CODE TO PRESERVE NAME%
LOCAL SAVNAME; ![335] TO SAVE NAME AS SET BY LEXICAL
SAVNAME_.NAME; ![335]
MSGNOTYPD _ 1; ! SET MESSAGE TO BE TYPED FLAG
NAME<LEFT> _ ENODSIZ;
ENODE _ CORMAN(); ! GET A BLOCK OF FREE STORAGE FOR THE NODE
NAME_.SAVNAME; ![335] RESTORE NAME
% ERRLINK<RIGHT> CONTAINS A POINTER TO THE BEGINNING
OF THE LIST AND .ERRLINK<LEFT> A POINTER TO THE END OF THE LIST %
IF .ERRLINK<RIGHT> EQL 0
THEN ( ERRLINK<LEFT> _ .ENODE;
ERRLINK<RIGHT> _ .ENODE
)
ELSE ( ENODLINK(ERRLINK<LEFT>) _ .ENODE;
ERRLINK<LEFT> _ .ENODE
)
END
ELSE % THE MESSAGE WILL BE PRINTED NOW SO JUST BUILD THE BLOCK IN TEMPORARY STORAGE%
ENODE _ ERRNODE ;
%BUILD THE NODE %
EMSGNUM(ENODE) _ .ERRNUM;
ERRTYPD(ENODE) _ 0;
ERRLINE (ENODE) _ .LINE;
ERRENT1(ENODE) _ .ENT1;
ERRENT2(ENODE) _ .ENT2;
IF .LINE NEQ .LINELINE OR .SEGINCORE NEQ 1
THEN % PRINT MESSAGE NOW , IT RELATES TO PREVIOUS LINE %
BEGIN
% BUILD THE MESSAGE %
ENODE _ BLDMSG (ERRNODE);
% PRINT MESSAGE ON LISTING %
IF .FLGREG<LISTING>
THEN
BEGIN
%PUT OUT CRLF IF AFTER PHASE1%
IF .SEGINCORE NEQ 1
THEN ( STRNGOUT(PLIT'?M?J');
PAGELINE _ .PAGELINE - 1
);
IF .PAGELINE LEQ 0
THEN HEADING();
PAGELINE _ .PAGELINE -1;
STRNGOUT(.ENODE)
END;
IF NOT .FLGREG<TTYDEV> AND NOT .FLGREG<NOERRORS>
THEN % THE MESSAGE CAN BE OUTPUT TO TTY AS WELL AS THE LISTING %
BEGIN
IF NOT .ERRFLAG AND .SEGINCORE EQL 1
THEN (%THIS IS THE FIRST ERROR IN THIS
STATEMENT SO TYPE ALL LINES TO THIS POINT%
BACKTYPE(LINESONLY)
);
% OUTPUT THE MESSAGE TO TTY %
OUTTYX (ENODE)
END;
%NOTE THAT A MESSAGE IS GOING OUT THAT WILL
NOT SHOW UP IN THE QUEUE %
ERRFLAG _ -1;
END;
RETURN -1
END; % ROUTINE FATLERR %
GLOBAL ROUTINE
WARNERR ( ENT2,ENT1,LINE,ERRNUM ) =
% PROCESS WARNING ERROR MESSAGE REQUESTS %
BEGIN
FATLERR (.ENT2,.ENT1,.LINE,.ERRNUM )
END;
EXTERNAL LEXLINE;
GLOBAL ROUTINE
FATLEX ( ENT2, ENT1, ERRNUM ) =
BEGIN
% FOR ERRORS ASSOCIATED WITH LEXEMES %
RETURN FATLERR( .ENT2,.ENT1,.LEXLINE,.ERRNUM )
END;
GLOBAL ROUTINE
WARNLEX ( ENT2,ENT1,ERRNUM ) =
BEGIN
% FOR WARNING ERRORS ASSOCIATIED WITH LEXEMES %
RETURN FATLERR ( .ENT2, .ENT1, .LEXLINE, .ERRNUM )
END;
GLOBAL ROUTINE
BLDMSG(ENODE)=
BEGIN !BUILDS MSG POINTED TO BY EPTR AND RETURNS A POINTER TO IT
EXTERNAL WARMSG;
REGISTER T[3];
MACRO T1=T[0]$, T2=T[1]$, T3=T[2]$, C=T[2]$;
LABEL PARAM;
LOCAL N,EPTR;
OWN TTYMSG[20];
BIND TTYPTR= TTYMSG;
EPTR _ ERRMSG[C_.EMSGNUM(ENODE)]<36,7>; ! FORM THE BYTE POINTER
TTYPTR _ (TTYMSG+1)<8,7>;
N _ 0;
IF .C LSS WARMSG<0,0>
THEN TTYMSG[1] _ '%FTN'
ELSE TTYMSG[1] _ '??FTN'; !FATAL
WHILE 1 DO
PARAM: IF (C_SCANI(EPTR)) LSS " " THEN CASE .C OF SET
%0:% EXITLOOP; !UNDEFINED CHARACTERS IN LAST WORD OF PLIT ARE NULLS
%"?A":% BEGIN !INSERT THE RIGHTMOST FIVE DECIMAL DIGITS SUPPLIED BY THE NEXT PARAMETER
T1_.(.ENODE<RIGHT>)[N_.N+1];T2_T3_0;
DECR J FROM 4 TO 0 DO
BEGIN
MACHOP IDIVI=#231,ADDI=#271,LSHC=#246;
IDIVI(T1,10); !REMAINDER IN T2
ADDI(T2,"0"); !ASCII-DIGIT_REMAINDER+"0"
LSHC(T2,-7); !T3<29,7>_ASCII-DIGIT
END;
T1_T3<36,7>;
DECR J FROM 4 TO 0 DO COPYII (T1,TTYPTR ) ;
END;
%"?B":% BEGIN !INSERT THE ASCII STRING POINTED TO BY THE NEXT PARAMETER
% CHECK TO SEE IF ITS A CHARACTER OR BYTE POINTER%
IF (T2 _ ( T1 _ .(.ENODE<RIGHT>)[N_.N+1]) AND NOT #377) EQL 0
THEN
BEGIN % ITS A CHARACTER %
BIND EOSLEX = 4;
EXTERNAL LEXNAME;
IF .T1 LSS #200
THEN
BEGIN
REPLACEI(TTYPTR,.T1); ! ITS ONLY A CHARACTER
LEAVE PARAM
END
ELSE T1 _ .LEXNAME[EOSLEX];
END;
T1 _ (.T1)<36,7>;
UNTIL(C_SCANI(T1)) EQL 0 DO REPLACEI(TTYPTR,.C)
END;
%"?C":% BEGIN !INSERT THE SIXBIT NAME POINTED TO BY THE NEXT PARAMETER
T1_(.(.ENODE<RIGHT>)[N_.N+1])<36,6>;
DECR X FROM 5 TO 0 DO (C _ SCANI(T1)+" "; REPLACEI(TTYPTR,.C))
END;
%"?D":% BEGIN ! INSERT THE SIXBIT NAME IN THE NEXT PARAMETER
T1 _ (.ENODE<RIGHT>)[N_.N+1]<36,6>;
DECR X FROM 5 TO 0 DO (C _ SCANI(T1)+" "; REPLACEI(TTYPTR,.C))
END;
%"?E"% BEGIN ! INSERT "LINE:"
T1 _ (PLIT' LINE:')<36,7>;
UNTIL (C_SCANI(T1)) EQL 0 DO REPLACEI(TTYPTR,.C)
END
TES ELSE REPLACEI(TTYPTR,.C);
REPLACEI(TTYPTR,CR);
REPLACEI(TTYPTR,LF);
REPLACEI(TTYPTR,0);
RETURN (TTYMSG+1)<ADRS>
END; !OF BLDMSG
GLOBAL ROUTINE ERROR (N,CHNL) =
BEGIN
IF NOT FTTENEX THEN
BEGIN
REGISTER T1=1,T2=2,C=3;
BIND DEVMODE=PLIT(PLIT('BINARY OUTPUT'),PLIT('ASCII OUTPUT'),PLIT('ASCII INPUT'))-1;
BIND FIELD=PLIT(PLIT('OBJECT'),PLIT('LISTING'),PLIT('SOURCE'))-1;
%ERROR% BIND ERRORS=PLIT(
!%0% PLIT('I/O#0 1 FILE 2 COULD NOT BE FOUND'),
!%1% PLIT('I/O#1 3 UFD DOES NOT EXITS'),
!%2% PLIT('I/O#2 PROTECTION FAILUTE OR DIRECTORY FULL ON 1 DEVICE 4'),
!%3% PLIT('I/O#3 1 FILE 2 IS BEING MODIFIED'),
!%4% PLIT('I/O#4 ENTER FOLLOWS LOOKUP OF 1 FILE 2'),
!%5% PLIT('I/O#5 LOOKUP FOLLOWS ENTER OF 1 FILE 2'),
!%6% PLIT('I/O#6 DEVICE ERROR, DATA ERROR, OR DATA INCONSISTENCY IN 1 UFD'),
!%7% PLIT('I/O#7 DSK ERROR NUMBER SEVEN'),
!%8% PLIT('I/O#8 DSK ERROR NUMBER TEN'), %OCTAL DISK ERRORS %
!%9% PLIT('I/O#9 DSK ERROR NUMBER ELEVEN'),
!%10% PLIT('I/O#10 DSK ERROR NUMBER TWELVE'),
!%11% PLIT('I/O#11 DSK ERROR NUMBER THIRTEEN'),
!%12% PLIT('I/O#12 1 FILE STRUCTURE 4 HAS NO ROOM OR HAS EXCEEDED ITS QUOTA'),
!%13% PLIT('I/O#13 1 DEVICE 4 IS WRITE LOCKED'),
!%14% PLIT('I/O#14 NOT ENOUGH TABLE SPACE IN MONITOR FREE CORE FOR 1 DEVICE 4'),
!%15% PLIT('I/O#15 1 FILE 2 ONLY PARTIALLY ALLOCATED'),
!%16% PLIT('I/O#16 1 FILE 2 BLOCK NOT FREE ON ALLOCATED POSITION'),
!%17% PLIT('I/O#17 1 DEVICE 4 NOT AVAILABLE'),
%0% PLIT('?FTNDWL 1 DEVICE 4 WRITE LOCKED'),
%1% PLIT('?FTNHDE HARDWARE DEVICE ERROR ON 1 DEVICE 4'),
%2% PLIT('?FTNCPE CHECKSUM OR PARITY ERROR IN 1 FILE 2'),
%3% PLIT('?FTNQEX BLOCK TOO LARGE OR QUOTA EXCEEDED FOR 1 FILE 2'),
!%22% PLIT('I/O#22 NOT ENOUGH ROOM IN CORE FOR COMMAND STRING'),
!%23% PLIT('I/O#23 WILD CHARACTERS IN OUTPUT SPECIFICATION ARE NOT SUPPORTED'),
!%24% PLIT('I/O#24 SUBFILE OUTPUT IS NOT SUPPORTED'),
!%25% PLIT('I/O#25 1 DEVICE 4 CANNOT DO 5'),
!%26% PLIT('I/O#26 NON-EXISTANT INPUT FILE'),
!%27%