! 18/09/84 - insert switch for STFNID in ANAL and set QUAL(24) to "STFNID" ! 10/07/84 - new version of targetpnx_fptos ! 03/07/84 - put FPTOS in an include file ! - set up string REG1 in targ_target & substitute for "reg-1" ! 21/03/84 - amend arrays OPVALS, ST, SZTY & REG ! 19/03/84 - change some address increments to W! etc. ! 08.03.84 - change INTEGER mapping increments to W1 ! 28/02/84 - FPTOS inserted !* modified 14/11/83 !* ! 01/11/83 copied from ercs06.rel90_optextb15 !* %CONSTINTEGER OPSYS=0 ! =0 (Emas ISO) ! =1 (VME EBCDIC) !* %INCLUDE "host_host" !* %INCLUDE "targ_target" !* %INCLUDE "pf_version" !* %INCLUDE "bits_fmts" !* %INCLUDE "bits_consts" !* %INCLUDE "bits_triadops" !* %INCLUDE "pf_copy" !* %INCLUDE "targ_etoinitoe" !* %INCLUDE "targ_fptos" !* %CONSTSTRING(7) %ARRAY OPVALS(0:116)= %C "NULL", "REL", "+", "-", "*", "/", "NEG", "=", "CVT", "ARR", "ARR1", "BOP", "ASGN", "", "EXP", "", "AND", "OR", "NOT", "EQUIV", "NEQ", "GT", "LT", "NE", "EQ", "GE", "LE", "SUBSTR", "CHAR", "CONCAT", "CHHEAD", "", "STOD1", "STOD2", "STODA", "", "EOD1", "EOD2", "EODA", "EODB", "BRK", "DEFARR", "RSUB", "RDIV", "DCHAR", "ASH", "", "", "STRTIO", "IOITEM", "IODO", "IOSPEC", "IO", "DIOITEM", "ASGN", "ASMT", "SUBS", "ARGARR", "INIT", "INCR", "DECR", "DINIT", "PINCR", "", "NOOP", "FUN", "CALL", "ARG", "STRTSF", "ENDSF", "CALLSF", "IFUN", "DARG", "IARG", "REPL", "REF", "LOADB", "STOREB", "MOO", "", "JIT", "JIF", "JINN", "JINP", "JINZ", "JIN", "JIP", "JIZ", "CGT", "GOTO", "RET", "STOP", "PAUSE", "EOT", "NINT", "ANINT", "STMT", "ITS", "PA", "TOCHAR", "DIM", "DMULT", "AINT", "ABS", "MOD", "SIGN", "MIN", "MAX", "REAL", "IMAG", "CMPLX", "CONJG", "LEN", "ICHAR", "INDEX", "DCMPLX", "INTRIN" !* %CONSTSTRING(7) %ARRAY QUAL(0:66)= %C "NULL", "LABID", "PLABID", "PROCID", "STKLIT", "GLALIT", "SRTEMP", "Breg", "VALTEMP", "DESTEMP", "", "", "", "", "", "", "LSCALID", "OSCALID", "CSCALID", "ASCALID", "PSCALID", "ARRID", "TMPID", "PERMID", "STFNID", "", "", "", "", "", "", "", "TRIAD", "ARREL", "CHAREL", "CHVAL", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "LIT", "NEGLIT", "CNSTID" %CONSTBYTEINTEGERARRAY ST(0:15)= %C X'41',X'51',X'61',X'52',X'62',X'72',X'53',X'63', X'73',X'34',X'44',X'54',X'64',X'05',X'51',X'31' %CONSTSTRING(8) %ARRAY SZTY(0:15)= %C "INT2", "INT4", "INT8", "REAL4", "REAL8", "REAL16", "CMPLX4", "CMPLX8", "CMPLX16", "LOG1", "LOG2", "LOG4", "LOG8", "CHARMODE", "HOLMODE", "BYTE" %CONSTBYTEINTEGERARRAY C(0:15)='0','1','2','3','4','5','6','7', '8','9','A','B','C','D','E','F' %CONSTSTRING(2) %ARRAY COMPAR(1:6)="GT","LV","NE","EQ","GE","LE" %CONSTSTRING(5) %ARRAY LOG(0:1)="FALSE","TRUE" %CONSTBYTEINTEGERARRAY INDENT(1:9)=10,8,8,14,10,10,10,6,68 %CONSTSTRING(6) TMPRES="IR IN " %OWNINTEGER IRADR !* !* PSTRING *! !* %ROUTINE PSTRING(%INTEGER TAB,%STRING(32) S,%INTEGER LEVEL) %INTEGER LEN %SWITCH SW(0:1) LEN=LENGTH(S) -> SW(TAB) %IF TAB<2 %AND TAB>=0 -> PRINT SW(0): NEWLINE PRINTSTRING("TRIADNO LHS OP RHS") %IF LEVEL=2 %THEN %START SPACES(11) PRINTSTRING("QL QR MODE") %FINISH NEWLINE %RETURN SW(1): PRINTSTRING("p".S) SPACES(INDENT(TAB)-LEN-1) %RETURN PRINT: PRINTSTRING(S) %IF IRADR#0 %THENSTART WRITE(IRADR,12) IRADR=0 LEN=LEN+12 %FINISH SPACES(INDENT(TAB)-LEN) %RETURN %END !* *! !* ITOS *! !* *! %STRING(31) %FN ITOS(%INTEGER N) %CONSTINTEGERARRAY TENS(0:9)=%C 1,10,100,1000,10000,100000,1000000,10000000,100000000,1000000000 %STRING(11) RES %INTEGER M,R,I,STARTED,J %IF N=0 %THEN %RESULT="0"; %IF N<0 %THEN N=-N %AND RES="-" %ELSE RES="" STARTED=0 %CYCLE I=9,-1,0 R=TENS(I) %IF N>=R %OR STARTED#0 %START STARTED=1 M=N//R RES=RES.TOSTRING(M+'0') N=N-M*R %FINISH %REPEAT %RESULT=RES %END !* ANAL *! !* *! %ROUTINE ANAL(%INTEGER INDEX,OPD,TAB,ADICT,ANAMES,LEVEL) %SWITCH SW(0:66) %SWITCH T(0:14) %STRING(32) S %INTEGER J,LEN,ADR,IDEN,I,K %REAL X,Y %LONGREAL XX,YY %LONGLONGREAL XXX,YYY %RECORD (CONSTRECF) %NAME CNST %RECORD (PRECF) %NAME SCAL %RECORD (PRECF) %NAME PROC %RECORD (TMPF) %NAME TMP %RECORD (LABRECF) %NAME LAB %RECORD(PLABF)%NAME PLAB %RECORD(TERECF)%NAME TE %RECORD(DTRECF)%NAME DT -> SW(INDEX) SW(*):%RETURN SW(NULL): !NULL NULL PSTRING(TAB,QUAL(0),LEVEL) %RETURN SW(LIT): !LITERAL LIT S=ITOS(OPD) SW1: PSTRING(TAB,S,LEVEL) %RETURN SW(NEGLIT): S="-".ITOS(OPD) ->SW1 SW(CNSTID): !CONST RECORD IN DICT CNSTID CNST==RECORD(OPD< T(CNST_MODE) T(INT2): J=HALFINTEGER(ADR+ADICT) -> INT T(INT4): J=INTEGER(ADR+ADICT) -> INT T(INT8): J=INTEGER(ADR+ADICT+W1) INT: S=ITOS(J) SOUT: PSTRING(TAB,S,LEVEL) %RETURN T(REAL4): X=REAL(ADR+ADICT) S=FPTOS(ADDR(X),3) ->SOUT T(REAL8): XX=LONGREAL(ADR+ADICT) S=FPTOS(ADDR(XX),4) ->SOUT !* %INCLUDE "targ_text2" !* T(CMPLX8): X=REAL(ADR+ADICT) Y=REAL(ADR+ADICT+W1) S="(".FPTOS(ADDR(X),3).",".FPTOS(ADDR(Y),3).")" ->SOUT T(CMPLX16): XX=LONGREAL(ADR+ADICT) YY=LONGREAL(ADR+ADICT+W2) S="(".FPTOS(ADDR(XX),4).",".FPTOS(ADDR(YY),4).")" -> SOUT SP: %IF CNST_MODE<6 %THEN J=9 %ELSE J=21 SPACES(INDENT(TAB)-J) %RETURN T(LOG4): J=INTEGER(ADR+ADICT) -> LOG T(LOG8): J=INTEGER(ADR+ADICT+W1) LOG: %IF J#0 %THEN J=1 PSTRING(TAB,LOG(J),LEVEL) %RETURN T(CHARMODE): T(HOLMODE): LEN=INTEGER(ADR+ADICT) %IF LEN>4 %THEN LEN=4 COPY(LEN,ADR+ADICT,4,ADDR(S),1) LENGTH(S)=LEN S="'".S."'" LEN=LEN+2 %INCLUDE "targ_text1" PSTRING(TAB,S,LEVEL) %RETURN T(*): %RETURN SW(SRTEMP): ! strength reduction temporary S="sr".ITOS(OPD) ->SOUT SW(ARREL): ! ARRAY ELEMENT TRIAD SW(CHAREL): ! CHAR SUBSTRING TRIAD SW(TRIAD): !TRIAD TRIAD S=ITOS(OPD) S="p".S ->SOUT SW(LSCALID): !LOCAL SCALAR LSCALID SW(OSCALID): !OWN SCALAR OSCALID SW(CSCALID): !COMMON SCALAR CSCALID SW(ASCALID): ! scalar equivalenced to array SW(PSCALID): !PARAMETER SCALAR PSCALID SW(ARRID): !ARRAY ID ARRID SCAL==RECORD(OPD<SOUT SW(PERMID): SW(TMPID): !TEMP SCALAR TMPID TMP==RECORD(OPD<SOUT SW(LABID): !LABEL IDENTIFIER LABID LAB==RECORD(OPD<SOUT SW(PLABID): !PRIVATE LABEL IDENTIFIER PLABID PLAB==RECORD(ADICT+OPD<SOUT SW(PROCID): !PROCEDURE IDENTIFIER PROCID SW(STFNID): ! STMT. FUNCTION IDENTIFIER PROC==RECORD(ADICT+OPD<SOUT !SW(ARREL): !ARRAY ELEMENT REFERENCE ARREL PROC==RECORD(OPD<SOUT SW(VALTEMP): TE==RECORD(ADICT+OPD<SOUT SW(DESTEMP): DT==RECORD(ADICT+OPD<SOUT SW(BREG): S=REG1 ->SOUT %END !* !* PRINT TRIAD !* %CONSTBYTEINTEGERARRAY HEX(0 : 15) = %C '0','1','2','3','4','5','6', '7','8','9','A','B','C','D','E','F' %ROUTINE PRHEX(%INTEGER J) %INTEGER K %CYCLE K = 28,-4,0 PRINT SYMBOL(HEX((J>>K)&15)) %REPEAT %END %ROUTINE DUMP(%INTEGER AD,LEN) %INTEGER I %CYCLE I=1,1,3 SPACES(2) PRHEX(INTEGER(AD)) AD=AD+W1 %REPEAT %END;! DUMP !* %EXTERNALROUTINE PRINT TR( %C %INTEGER INDEX,ADICT,ANAMES,LEVEL, %RECORD (TRIADF) %NAME TRIADS) %INTEGER I,J,VAL %STRING(32) MODE,OP,NO,SPARE %STRING(1) P NO="" SPARE="" IRADR=0 %IF LEVEL<0 %THENSTART LEVEL=-LEVEL PSTRING(0,NO,LEVEL) %FINISH NO=ITOS(INDEX) PSTRING(1,NO,LEVEL) P="p" OP=OPVALS(TRIADS_OP&X'7F') %IF OP="PAUSE" %OR OP="STOP" %THENSTART PSTRING(2," ",LEVEL) ->SKIP %FINISH %IF OP="IOSPEC" %THENSTART PRINTSTRING(" IOSPEC ") ->OUT %FINISH %IF OP="IO" %THENSTART PRINTSTRING(" IO ") ->OUT %FINISH %IF OP="PA" %THENSTART PSTRING(2,"NULL",LEVEL) PSTRING(3,OP,LEVEL) PSTRING(4,"NULL",LEVEL) -> OUT %FINISH %IF OP="STMT" %THENSTART PSTRING(2,ITOS(TRIADS_SLN),LEVEL) MODE="NULL" %FINISHELSESTART ANAL(TRIADS_QOPD1,TRIADS_OPD1,2,ADICT,ANAMES,LEVEL) MODE=SZTY(TRIADS_MODE&15) %FINISH SKIP: PSTRING(3,OP,LEVEL) ANAL(TRIADS_QOPD2,TRIADS_OPD2,4,ADICT,ANAMES,LEVEL) %IF LEVEL=2 %THEN %START PSTRING(5,MODE,LEVEL) PSTRING(6,QUAL(TRIADS_QOPD1),LEVEL) PSTRING(7,QUAL(TRIADS_QOPD2),LEVEL) %IF SPARE#"" %THEN PSTRING(8,SPARE,LEVEL) %AND SPARE="" %FINISH OUT: DUMP(ADDR(TRIADS_OP),12) NEWLINE %END !* %ENDOFFILE