Trailing-Edge
-
PDP-10 Archives
-
BB-D868C-BM
-
language-sources/rq1n.bli
There are 18 other files named rq1n.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: RQ1N.BLI
!DATE: 2 JANUARY 1974
!AUTHOR: CMU/FLD/KR
GLOBAL BIND H1REV=5; !MODULE VERSION NUMBER
!THIS MODULE HANDLES THE "REQUIRE" DECLARATION
! REVISION HISTORY
!
! 6-20-77 ROUTINE SREQUIRE AND RELREQ ARE MODIFIED SO THAT
! REQUIRE FILE NAME CAN BE IN SINGLE QUOTES.
! REQUIRE FILE CAN BE IN SINGLE QUOTES OR NO QUOTES
! AT ALL . NOW, THERE ARE TWO OPTIONS.
!
! 1/26/77 ADDED GARBAGE TO HANDLE LOAD& AND LIBRARY& COMMANDS
! THIS INCLUDES THE FOLLOWING ROUTINES: GET6,GET8,GETLS,
! LOOKFOR,RELREQ,SLOAD AND SLIBRARY.
!
FORWARD RELREQ; !6-16-77
EXTERNAL ?.JBFF,BXA;
MACRO
ELIF=ELSE IF$;
BIND
TRUE=1,
FALSE=0;
STRUCTURE STVEC1[I]=(TABLE+TIMXMF*(@.STVEC1 AND #77777)+.I)<0,36>;
MAP STVEC1 SYM:FUTSYM;
MACHOP CALLI=#47,XCT=#256;
GLOBAL REQDATA[#20],REQCHN;
MACRO
ABORT(NUM)=RETURN (REQRELEASE(); RECOVER(.NDEL,NUM))$,
SKIP(OP)=(VREG_1; (OP); VREG_0; .VREG)$,
EXECUTE(OP,AC,Y)=(N_(OP)^27 OR (AC)^23 OR (Y); XCT(0,N))$,
CMUDEC=-2$,
FILE=LOOKUPBLOCK[0]$,
EXT=LOOKUPBLOCK[1]$,
PPN=LOOKUPBLOCK[3]$,
JUNK=LOOKUPBLOCK[2]$,
DEVCHR=4$,
OUTPUTF=18,1$,
ASCIIMF=0,1$,
STATUS=OPENBLOCK[0]$,
ODEV=OPENBLOCK[1]$,
BUFW=OPENBLOCK[2]$;
BIND
OPEN=#50,
INBUF=#64,
LOOKUP=#76,
RELEASE=#71,
BUFFSIZE=#203,
HDRSIZE=2,
VREG=3<0,36>;
GLOBAL ROUTINE REQRELEASE=
(RELEASESPACE(.REQDATA[.REQCHN+1]<RIGHTHALF>,BUFFSIZE+HDRSIZE));
ROUTINE REQINIT(DEVICE)=
BEGIN
LOCAL OPENBLOCK[3],SAVFF;
REGISTER N;
ODEV_N_.DEVICE;
CALLI(N,DEVCHR);
IF .N EQL 0 THEN RETURN 0;
IF NOT .N<OUTPUTF> THEN RETURN 0;
IF NOT .N<ASCIIMF> THEN RETURN 0;
IF (.REQCHN+1) GTR #17 THEN (RECOVER(.NDEL,#505); RETURN 0);
REQDATA[.REQCHN+1]_GETSPACE(BUFFSIZE+HDRSIZE);
REQDATA[.REQCHN+1]<LEFTHALF>_BUFW_ST[.REQDATA[.REQCHN+1]<RIGHTHALF>,0]<0,0>;
STATUS_0;
IF NOT SKIP(EXECUTE(OPEN,.REQCHN+1,OPENBLOCK<0,0>))
THEN ( REQRELEASE();
RETURN 0 );
!GET BUFFERS
SAVFF_.?.JBFF;
?.JBFF_.REQDATA[.REQCHN+1]<LEFTHALF>+3;
EXECUTE(INBUF,.REQCHN+1,2);
?.JBFF_.SAVFF;
(@(BXA+#16))<0,36>_' '; !BLANKS TO SEQNUM
1
END; !OF REQINIT
ROUTINE CVSIX(POINTR)=
BEGIN LOCAL SYMPTR,SIXPTR,SIXSYM; REGISTER R; MACHOP ILDB=#134,IDPB=#136;
SIXSYM_0;
SYMPTR_(@POINTR)<36,7>;
SIXPTR_SIXSYM<36,6>;
DECR I FROM 5 TO 0 DO
(ILDB(R,SYMPTR);
IF .R EQL #177 THEN EXITLOOP;
IF .R LEQ #132 THEN R_.R-#40;
IDPB(R,SIXPTR) );
.SIXSYM
END;
GLOBAL ROUTINE SREQUIRE=
BEGIN
LOCAL DEVICE,LOOKUPBLOCK[4];
REGISTER N;
FILE_EXT_JUNK_PPN_0;
! ALLOW REQUIRE FILE NAME IN SINGLE QUOTES AS DEVICE:FILE.EXT[PPN]
! 6-16-77
IF .FSTRHED GTR 0 THEN
(RELREQ(DEVICE);
IF NOT REQINIT(.DEVICE) THEN RETURN RECOVER(.NDEL,#504) )
ELSE
BEGIN
DEVICE_IF .FUTDEL<LEFTHALF> EQL HCOLON
THEN (N_ IF LITP(.FUTSYM) THEN LITV(.FUTSYM)
ELSE CVSIX(FUTSYM[2]); SRUND(#22);
FILE_ CVSIX(ACCUM); .N)
ELSE (IF .FUTSYM EQL 0 THEN
(FILE_ CVSIX(ACCUM); SRUND(#12)) !IF THE FILENAME WAS PARSED
!AS A DELIMETER, THEN UPDATE
!THE WINDOW
ELSE (FILE_ IF LITP(.FUTSYM) THEN LITV(.FUTSYM)
ELSE CVSIX(FUTSYM[2]));
SIXBIT 'DSK ');
IF NOT REQINIT(.DEVICE) THEN RETURN RECOVER(.NDEL,#504);
IF .FUTDEL<LEFTHALF> EQL HDOT THEN (SRUND(#22); EXT_CVSIX(ACCUM));
IF .FUTDEL<LEFTHALF> EQL HSQOPEN
THEN
BEGIN
SKAN(#02);
IF .CHAR GEQ "0" AND .CHAR LEQ "7" THEN
BEGIN
SRUND(#40); IF .FUTDEL<LEFTHALF> NEQ HCOMMA
THEN ABORT(#503);
PPN<18,18>_ .VAL;
SRUND(#40);
PPN<0,18>_ .VAL
END
ELSE
BEGIN
HRUND();
IF .FUTDEL<LEFTHALF> EQL HCOMMA
THEN (IF NOT LITP(.FUTSYM) THEN ABORT(#503); PPN<18,18>_LITV(.FUTSYM); HRUND());
IF LITP(.FUTSYM) THEN PPN_.PPN OR LITV(.FUTSYM) ELSE
BEGIN
N<0,18>_ FUTSYM[2]<0,0>;
N<18,18>_ PPN<0,0>;
IF NOT SKIP(CALLI(N,CMUDEC)) THEN ABORT(#501);
END;
END;
IF .FUTDEL<LEFTHALF> NEQ HSQCLO THEN ABORT(#503);
HRUND()
END
END;
IF NOT SKIP(EXECUTE(LOOKUP,(.REQCHN+1),LOOKUPBLOCK<0,0>)) THEN ABORT(#502);
REQCHN_ .REQCHN + 1;
SKAN(1); HRUND(); !FORCE EOL AND GET NEW LINE FROM REQUIRED FILE
END; ! OF SREQUIRE
ROUTINE GET6(PNTPNT,LIMIT)=
BEGIN
LOCAL PNT,RET,C,GOAL;
RET_0;
PNT=..PNTPNT;
GOAL=(IF .LIMIT LSS 6 THEN 6 ELSE .LIMIT);
INCR COUNT FROM 1 TO .GOAL DO
IF .COUNT LEQ 6 THEN
BEGIN
RET=.RET^6;
IF .COUNT LEQ .LIMIT THEN
BEGIN
C=SCANN(PNT);
IF .C LSS " " THEN
C=0
ELIF .C LEQ "_" THEN
C=.C-" "
ELIF .C LSS #141 THEN ! SMALL A
C=0
ELIF .C LEQ #172 THEN ! SMALL Z
C=(.C-#40)-" "
ELSE
C=0;
RET_.RET OR .C;
INCP(PNT);
END;
END
ELSE INCP(PNT);
(.PNTPNT)=.PNT;
RETURN .RET;
END;
ROUTINE GET8(PNTPNT)=
BEGIN
LOCAL RET,C;
RET_0;
WHILE 1 DO
BEGIN
C_SCANN(.PNTPNT);
IF .C LSS "0" THEN RETURN(.RET);
IF .C GTR "7" THEN RETURN(.RET);
RET_(.RET^3) OR (.C-"0");
INCP(.PNTPNT);
END;
END;
ROUTINE GETLS(HDR)=
BEGIN
LOCAL STREL,STRIND,OSTREL,TRNSFR;
TRNSFR=1;
STREL=.CT[.HDR,1]<NEXTF>;
STRIND=0;
WHILE .STREL NEQ .HDR DO
BEGIN
IF .TRNSFR THEN
STRING[.STRIND]=.CT[.STREL,1];
OSTREL=.STREL;
STREL=.CT[.STREL,0]<NEXTF>;
STRIND=.STRIND+1;
IF .STRIND EQL 27 THEN
BEGIN
TRNSFR=FALSE;
STRING[.STRIND]=0;
END;
RELEASESPACE(.OSTREL,1);
END;
RELEASESPACE(.HDR,1);
.VREG
END;
ROUTINE LOOKFOR(PNTR,NPNTR,CHRCNT,TARGET)=
BEGIN
LOCAL C;
(.CHRCNT)=0;
WHILE (C=SCANN(PNTR)) NEQ 0 DO
BEGIN
IF .C EQL .TARGET THEN
BEGIN
(.NPNTR)=.PNTR;
RETURN TRUE;
END;
(.CHRCNT)=..CHRCNT+1;
INCP(PNTR);
END;
(.NPNTR)=.PNTR;
RETURN FALSE;
END;
ROUTINE RELREQ(COND)=
BEGIN
LOCAL CCNT,DPNTR,DEV,PPNFLG,PPNPNT,PPN,FLNCNT,PNTR,FLN,EXTYES;
EXTERNAL WRIT11;
IF
(IF NOT .B20FLG<0,1> AND (.COND LEQ 1 ) %6-16-77%
THEN 1
ELSE IF .FSTRHED EQL 0
THEN IF LITP(.FUTSYM)
THEN BEGIN
STRING=LITV(.FUTSYM);
(STRING+1)=0;
0
END
ELSE 1
ELSE (GETLS(.FSTRHED<0,18>); 0))
THEN BEGIN
ERROR(.NSYM,#437);
HRUND();
RETURN .VREG;
END;
FSTRHED=0;
PNTR=STRING<29,7>;
CCNT=-1;
IF LOOKFOR(.PNTR,DPNTR,CCNT,":")
THEN
BEGIN
DEV=GET6(PNTR,.CCNT);
INCP(PNTR);
END
ELSE
DEV=0;
CCNT=-1;
PPNFLG=LOOKFOR(.PNTR,PPNPNT,CCNT,"[");
FLNCNT=.CCNT;
EXTYES_LOOKFOR(.PNTR,DPNTR,FLNCNT,".");
FLN=GET6(PNTR,.FLNCNT);
! ALLOW REQUIRE FILE NAME IN SINGLE QUOTES 6-16-77
IF .COND GTR 1 THEN
IF .EXTYES THEN
(INCP(PNTR);(.COND+2)_GET6(PNTR,.CCNT-.FLNCNT-1));
IF .PPNFLG
THEN
BEGIN
INCP(PPNPNT);
PPN<18,18>=GET8(PPNPNT);
IF SCANN(PPNPNT) EQL "," THEN
BEGIN
INCP(PPNPNT);
PPN<0,18>=GET8(PPNPNT);
END
ELSE
PPN<0,18>=0;
END
ELSE
PPN=0;
! ALLOW REQUIRE FILE NAME IN SINGLE QUOTES. 6-16-77
IF .COND GTR 1 THEN
BEGIN
.COND_IF .DEV EQL 0 THEN SIXBIT 'DSK '
ELSE .DEV ;
(.COND+1)_.FLN;
(.COND+4)_.PPN
END
ELSE
( WRIT11(.COND,.DEV,.FLN,.PPN);
HRUND();
.VREG )
END;
GLOBAL ROUTINE SLOAD=RELREQ(0);
GLOBAL ROUTINE SLIBRARY=RELREQ(1);
!END OF RQ1N.BLI