%ROUTINE CSTREXP(%INTEGER MODE) !*********************************************************************** !* PLANT IN-LINE CODE FOR CONCATENATION. A WORK AREA IN THE * !* CURRENT STACK FRAME IS USUALLY REQUIRED. * !* ON ENTRY:- * !* MODE=0 NORMAL. WK AREA NOT USED FOR ONE OPERAND EXPSSNS * !* MODE=1 STRING MUST GO TO WORK AREA * !* 2**5 BIT OF MODE SET IF FULL VIRTUAL ADDRESS REQUIRED * !* 2**4 BIT OF MODE IS SET IF WK-AREA NOT TO BE FREED ON EXIT * !* ON EXIT:- * !* VALUE#0 %IF RESULT IN A WORK AREA(CCOND MUST KNOW) * !*********************************************************************** %INTEGER PP,WKAREA,DOTS,ERR,KEEPWA,FNAM,I,ENDFLAG %RECORD(RD) OPND1,OPND2,OPND3 %INTEGERFNSPEC STROP(%RECORD(RD) %NAME OPND) KEEPWA=MODE&16; MODE=MODE&15 PP=P; STRINGL=0; FNAM=0; WKAREA=0 P=P+3; ! LENGTH OF CONSTANT PART ERR=72; ->ERROR %UNLESS A(P)=4 P=P+1 DOTS=0; ! NO OPERATORS YET ENDFLAG=0 STRINGL=0 ERR=STROP(OPND2); ! GET FIRST OPERAND ->ERROR %UNLESS ERR=0 NEXT: %IF A(P)=2 %THEN ENDFLAG=1 %ELSESTART %IF A(P+1)#CONCOP %THEN ERR=72 %AND ->ERROR P=P+2 ERR=STROP(OPND3) ->ERROR %UNLESS ERR=0 %FINISH %IF ENDFLAG=0 %AND OPND2_FLAG=LCONST=OPND3_FLAG %START ! ! CAN FOLD OUT A CONCATENATION HERE ! I=CONCAT CTOP(I,ERR,0,OPND2,OPND3) %IF I=0 %THEN ->NEXT; ! FOLDED OUR %FINISH %IF DOTS=0 %START %IF MODE=0 %AND ENDFLAG#0 %START; ! NO RUN-TIME OPERATIONS OPND1=OPND2; ->TIDY %FINISH GET WSP(WKAREA,X'80000000'!268); ! GET NEXT OPERAND OPND1_PTYPE=X'35' OPND1_FLAG=LOCALIR OPND1_D=RBASE<<16!WKAREA I=BRECTRIP(PRECC,X'35',0,OPND1,OPND2) DOTS=1 %FINISH %IF ENDFLAG=0 %THENSTART I=BRECTRIP(CONCAT,X'35',0,OPND1,OPND3) ->NEXT %FINISH TIDY: ! FINISH OFF EXPOPND=OPND1; ! LEAVE REULT IN EXPOPND VALUE=WKAREA P=P+1; ! PAST REST OF EXPRN RETURN WSP(WKAREA,268) %IF KEEPWA=0 %AND WKAREA>0 STRINGL=0 %RETURN ERROR:FAULT(ERR,0,FNAM) BASE=RBASE; DISP=0 VALUE=0; ACCESS=0 P=PP; SKIP EXP %RETURN %INTEGERFN STROP(%RECORD(RD) %NAME OPND) !*********************************************************************** !* DEALS WITH OPERAND FOR CONCATENATION. RETURN RESULT=0 FOR * !* VALID OPERAND OTHERWISE AN ERROR NUMBER. * !*********************************************************************** %INTEGER CTYPE,MODE,I MODE=A(P); ! ALTERNATIVE OF OPERAND OPND=0 %RESULT=75 %IF MODE>2 %IF MODE#1 %THENSTART CTYPE=A(P+1); ! GET CONST TYPE & LOSE AMCK FLAGS %IF CTYPE=X'35' %THENSTART STRINGL=A(P+2) OPND_PTYPE=CTYPE OPND_FLAG=LCONST OPND_D=P+2 OPND_XTRA=STRINGL P=P+STRINGL+3 %FINISHELSERESULT=73 %FINISHELSESTART P=P+1; ! MUST CHECK FIRST %IF 5#TYPE#7 %THEN FNAM=FROMAR2(P) %ANDRESULT=71 %IF PTYPE=X'35' %AND A(P+2)=2=A(P+3) %START OPND_FLAG=DNAME OPND_PTYPE=PTYPE OPND_D=FROMAR4(P) P=P+4 %FINISHELSESTART CNAME(2) OPND_FLAG=REFTRIP OPND_PTYPE<-PTYPE OPND_D=TRIPLES(0)_BLINK %FINISH STRINGL=0 DISP=0 %FINISH %RESULT=0 %END; ! OF INTEGERFN STROP %END; ! OF ROUTINE CSTREXP %ENDOFFILE