Google
 

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