%INCLUDE "ERCS06.OPT_SPECS"
%INCLUDE "ERCS06.PERQ_TRIADOPS"

{2900} %CONSTINTEGER FRSIZE=8; ! FREELIST ENTRY SIZE IN BYTES

%CONSTINTEGER FUNCBIT=1;
%CONSTINTEGER RETBIT=4
%CONSTINTEGER LPEBIT=8

%ROUTINE PUSHFREE(%INTEGER VAL,%INTEGERNAME LINK)
%RECORD(SRECF)%NAME FREE
FREE==RECORD(ADICT+DPTR)
FREE_INF0=VAL
FREE_LINK1=LINK
LINK=DPTR
DPTR=DPTR+FRSIZE
%END

%ROUTINE PRBLHEAD(%RECORD(BLRECF)%NAME BL,%INTEGER BLIND)
BL==RECORD(ABLOCKS+BLIND*BLSIZE)
PRINTSTRING("BLOCK")
WRITE(BLIND,1)
NEWLINE;NEWLINE
%END

%ROUTINE PRBLFIELDS(%RECORD(BLRECF)%NAME BL)
PRINTSTRING("DEPTH                   ");WRITE(BL_DEPTH,1);NEWLINE
PRINTSTRING("BACK DOMINATOR BLOCK    ");WRITE(BL_BDOM,1);NEWLINE
PRINTSTRING("BACK TARGET BLOCK       ");WRITE(BL_BTARG,1);NEWLINE
PRINTSTRING("BLOCK FOLLOWING         ");WRITE(BL_CHAIN,1);NEWLINE
PRINTSTRING("1ST TRIAD OF BLOCK      ");WRITE(BL_TEXT,1);NEWLINE
PRINTSTRING("ADDRESS OF USE BIT STRIP");WRITE(BL_USE,1);NEWLINE
PRINTSTRING("ADDRESS OF DEF BIT STRIP");WRITE(BL_DEF,1);NEWLINE
PRINTSTRING("ADDRESS OF BOE BIT STRIP");WRITE(BL_BOE,1);NEWLINE
PRINTSTRING("FLAGS SET               ");WRITE(BL_FLAGS,1);NEWLINE
%IF BL_FCON#0 %START
%END

%EXTERNALROUTINE PRBLOCK(%INTEGER BLIND)
%RECORD(BLRECF)%NAME BL
%RECORD(CONRECF)%NAME CON
%INTEGER I

%IF BLIND=0 %THEN %RETURN
BL==RECORD(ABLOCKS+BLIND*BLSIZE)
PRINTSTRING("BLOCK");WRITE(BLIND,1);NEWLINE;NEWLINE
PRINTSTRING("DEPTH                   ");WRITE(BL_DEPTH,1);NEWLINE
PRINTSTRING("BACK DOMINATOR BLOCK    ");WRITE(BL_BDOM,1);NEWLINE
PRINTSTRING("BACK TARGET BLOCK       ");WRITE(BL_BTARG,1);NEWLINE
PRINTSTRING("BLOCK FOLLOWING         ");WRITE(BL_CHAIN,1);NEWLINE
PRINTSTRING("1ST TRIAD OF BLOCK      ");WRITE(BL_TEXT,1);NEWLINE
PRINTSTRING("ADDRESS OF USE BIT STRIP");WRITE(BL_USE,1);NEWLINE
PRINTSTRING("ADDRESS OF DEF BIT STRIP");WRITE(BL_DEF,1);NEWLINE
PRINTSTRING("ADDRESS OF BOE BIT STRIP");WRITE(BL_BOE,1);NEWLINE
PRINTSTRING("FLAGS SET               ");WRITE(BL_FLAGS,1);NEWLINE
%IF BL_FCON#0 %START
  CON==RECORD(ATABS+BL_FCON)
  PRINTSTRING("FORWARD CONNECTIONS TO BLOCKS")
  %FOR I=1,1,CON_COUNT %CYCLE
    WRITE(CON_BLOCK(I),1)
  %REPEAT
%FINISHELSE PRINTSTRING("NO FORWARD CONNECTIONS")
NEWLINE
%IF BL_BCON#0 %START
  CON==RECORD(ATABS+BL_BCON)
  PRINTSTRING("BACKWARD CONNECTIONS TO BLOCKS")
  %FOR I=1,1,CON_COUNT %CYCLE
    WRITE(CON_BLOCK(I),1)
  %REPEAT
%FINISHELSE PRINTSTRING("NO BACKWARD CONNECTIONS")
NEWLINE
NEWLINE
%END

%EXTERNALROUTINESPEC SETBITS(%RECORD(RESF) RES,%INTEGER ADDR,USEORDEF)

%EXTERNALROUTINE BLOCKS(%INTEGER GTOLABPTR)


%RECORD(BLRECF)%NAME BL,TMPBL
%RECORD(TRIADF)%NAME TR
%RECORD(CONRECF)%NAME CON
%RECORD(SRECF)%NAME GTOLABS,BLKS
%RECORD(LABRECF)%NAME LAB
%INTEGERARRAYNAME ENTBTAB,EXBTAB
%INTEGERARRAYFORMAT TABF(0:100)

%CONSTBYTEINTEGERARRAY BSDO(0:20)=
                       0,0,0,0,1,1,1,1,1,1,0,0,0,0,0,1,1,1,0,1,1

%SWITCH SWTR(0:98)
%INTEGER CURBLK,LASTBLK,LABCOUNT,NEXTLAB,I
%INTEGER NEWBLFLAG,CONNECT
%INTEGER BLADDR,BLIND

%ROUTINE NEWBLOCK
%INTEGER BLLEN
BLIND=BLIND+1
BLLEN=BLIND*BLSIZE
%IF BLLEN>=MAXBLOCKS %THEN BLOCKSFULL
TMPBL==RECORD(ATABS+BLLEN)
TMPBL_BCON=0
%END

BLIND=0
FREETABS=0
CURBLK=0
NEWBLFLAG=0
CONNECT=0
ENTBPTR=0
EXBPTR=0
LABCOUNT=0

BL==RECORD(ABLOCKS)
CON==RECORD(ATABS)

%FOR I=1,1,NEXTTRIAD-1 %CYCLE
  TR==RECORD(ATRIADS+I*TRIADLENGTH)
  ->SWTR(TR_OP)

SWTR(STMT):
  %IF TR_VAL2<2 %START
    LAB==RECORD(TR_OPD2<<DSCALE+ADICT)
{    %IF LAB_X1=0 %AND NEWBLFLAG=0 %THEN %CONTINUE }
    %IF LAB_BLKIND=0 %START
      NEWBLOCK
      LAB_BLKIND=BLIND
    %FINISH
    LASTBLK=CURBLK
    CURBLK=LAB_BLKIND
  %FINISHELSEIF NEWBLFLAG=1 %START
    LASTBLK=CURBLK
    NEWBLOCK
    CURBLK=BLIND
  %FINISHELSE %CONTINUE
  NEWBLFLAG=0
  BL_CHAIN=CURBLK
  %IF OPTFLAGS&BDUMP#0 %THEN PRBLOCK(LASTBLK)
  BLADDR=ABLOCKS+CURBLK*BLSIZE
  BL==RECORD(BLADDR)
  BL_TEXT=I+1
  BL_FLAGS=0
  %IF CONNECT=1 %START
    LABCOUNT=LABCOUNT+1
    CON_BLOCK(LABCOUNT)=CURBLK
    CONNECT=0
    PUSHFREE(LASTBLK,BL_BCON)
  %FINISH
  %UNLESS LABCOUNT=0 %START
    CON_COUNT=LABCOUNT
    FREETABS=FREETABS+(LABCOUNT+1)<<BSCALE
    LABCOUNT=0
  %FINISH
{  %IF LAB_X1=LPEBIT %START
{    PUSHFREE(0,BL_BCON)
{    PUSHFREE(BLIND,ENTBPTR)
{    BL_FLAGS=BL_FLAGS!LPEBIT
{    BL_BDOM=0
{    BL_DEPTH=0
{    BL_BTARG=0
{  %FINISH
  BL_USE=BLADDR+BLRECSIZE
  BL_DEF=BLADDR+BLRECSIZE+BSSIZE
  BL_BOE=BLADDR+BLRECSIZE+BSSIZE+BSSIZE
  %CONTINUE

SWTR(JIT):  SWTR(JIF):
  CONNECT=1

SWTR(JINN):  SWTR(JINP):
SWTR(JINZ): SWTR(JIN):  SWTR(JIP):   SWTR(JIZ):
  LAB==RECORD(TR_OPD2<<DSCALE+ADICT)
  %IF BSDO(TR_QOPD1)=1 %THEN SETBITS(TR_RES1,BLADDR,USE)
  JMP1:
  %IF LABCOUNT=0 %START
    BL_FCON=FREETABS
    CON==RECORD(ATABS+FREETABS)
  %FINISH
  %IF LAB_BLKIND=0 %START
    NEWBLOCK
    LAB_BLKIND=BLIND
  %FINISHELSE TMPBL==RECORD(ATABS+LAB_BLKIND*BLSIZE)
  LABCOUNT=LABCOUNT+1
  CON_BLOCK(LABCOUNT)=LAB_BLKIND
  PUSHFREE(CURBLK,TMPBL_BCON)
  %IF TR_USE=1 %START
    NEWBLFLAG=1
    CONNECT=1
  %FINISH
  %CONTINUE

SWTR(GOTO):
  %IF TR_QOPD1=LABID %OR TR_QOPD1=PLABID %START
    LAB==RECORD(TR_OPD1<<DSCALE+ADICT)
    NEWBLFLAG=1
    ->JMP1
  %FINISH
  NEXTLAB=GTOLABPTR
  GOTO1:
  %IF BSDO(TR_QOPD1)=1 %THEN SETBITS(TR_RES1,BLADDR,USE)
  BL_FCON=FREETABS
  CON==RECORD(ATABS+FREETABS)
  %WHILE NEXTLAB#0 %CYCLE
    GTOLABS==RECORD(NEXTLAB+ADICT)
    LAB==RECORD(GTOLABS_INF0)
    %IF LAB_BLKIND=0 %START
      NEWBLOCK
      LAB_BLKIND=BLIND
    %FINISHELSE TMPBL==RECORD(ATABS+LAB_BLKIND*BLSIZE)
    LABCOUNT=LABCOUNT+1
    CON_BLOCK(LABCOUNT)=LAB_BLKIND
    NEXTLAB=GTOLABS_LINK1
    PUSHFREE(CURBLK,TMPBL_BCON)
  %REPEAT
  NEWBLFLAG=1
  %CONTINUE

SWTR(CGT):
  CONNECT=1
  NEXTLAB=TR_OPD2<<DSCALE
  ->GOTO1

SWTR(STOP):
  NEWBLFLAG=1
  BL_FCON=0
  %CONTINUE

SWTR(RET):
  BL_FLAGS=BL_FLAGS!RETBIT
  %IF BSDO(TR_QOPD1)=1 %THEN SETBITS(TR_RES2,BLADDR,USE)
  BL_FCON=FREETABS
  CON==RECORD(ATABS+FREETABS)
  CON_COUNT=1
  CON_BLOCK(1)=0
  FREETABS=FREETABS+2<<BSCALE
  PUSHFREE(BLIND,EXBPTR)
  %CONTINUE

SWTR(ASMT):
{ SWTR(DARR):
SWTR(CVT):
  %IF BSDO(TR_QOPD1)=1 %OR TR_QOPD1=PROCID %THEN %C
    SETBITS(TR_RES1,BLADDR,DEF)
  ASMT1:
  %IF BSDO(TR_QOPD2)=1 %THEN SETBITS(TR_RES2,BLADDR,USE)
  %CONTINUE

SWTR(ASGN):
{ SWTR(DCHAR):
  %IF BSDO(TR_QOPD1)=1 %OR TR_QOPD1=PROCID %THEN %C
    SETBITS(TR_RES1,BLADDR,DEF)
  %CONTINUE

SWTR(ARR):
  %IF BSDO(TR_QOPD1)=1 %THEN SETBITS(TR_RES1,BLADDR,USE)
  %IF BSDO(TR_QOPD2)=1 %THEN SETBITS(TR_RES2,BLADDR,USE)
  %CONTINUE

SWTR(ADD):  SWTR(SUB):  SWTR(MULT): SWTR(DIV):  SWTR(EXP):
SWTR(AND):  SWTR(OR):   SWTR(EQUIV):SWTR(NEQ):
SWTR(GT):   SWTR(LT):   SWTR(NE):   SWTR(EQ):   SWTR(GE):   SWTR(LE):
SWTR(SUBSTR):
  %IF BSDO(TR_QOPD2)=1 %THEN SETBITS(TR_RES2,BLADDR,USE)

SWTR(NEG):  SWTR(NOT):  SWTR(CHAR):
  %IF BSDO(TR_QOPD1)=1 %THEN SETBITS(TR_RES1,BLADDR,USE)
  %CONTINUE

SWTR(FUN):  SWTR(SUBR):
  BL_FLAGS=BL_FLAGS!FUNCBIT
  %CONTINUE

SWTR(ARG):
  %IF BSDO(TR_QOPD1)=1 %THEN SETBITS(TR_RES1,BLADDR,USE)
  %CONTINUE

SWTR(EOT):
  %EXIT

SWTR(*):
  %IF OPTFLAGS&BDUMP#0 %START
   PRINTSTRING("TRIAD WITH OPERAND, ")
    WRITE(TR_OP,4)
    PRINTSTRING(", NOT DEALT WITH")
    NEWLINE
  %FINISH
  %CONTINUE

%REPEAT
BL_CHAIN=0
%IF OPTFLAGS&BDUMP#0 %THEN PRBLOCK(CURBLK)
%CYCLE I=1,1,BLIND
  CON==RECORD(ATABS+FREETABS)
  LABCOUNT=0
  BL==RECORD(ABLOCKS+I*BLSIZE)
  NEXTLAB=BL_BCON
  %WHILE NEXTLAB#0 %CYCLE
    LABCOUNT=LABCOUNT+1
    BLKS==RECORD(ADICT+NEXTLAB)
    NEXTLAB=BLKS_LINK1
    CON_BLOCK(LABCOUNT)=BLKS_INF0
  %REPEAT
  %IF LABCOUNT=0 %THEN BL_BCON=0 %ELSESTART
    BL_BCON=FREETABS
    CON_COUNT=LABCOUNT
    FREETABS=FREETABS+(LABCOUNT+1)<<BSCALE
  %FINISH
%REPEAT
NEXTBLOCK=BLIND+1

ENTBTAB==ARRAY(ATABS+FREETABS,TABF)
I=1
%WHILE ENTBPTR#0 %CYCLE
  BLKS==RECORD(ADICT+ENTBPTR)
  ENTBTAB(I)=BLKS_INF0
  I=I+1
  ENTBPTR=BLKS_LINK1
%REPEAT
ENTBPTR=FREETABS
FREETABS=FREETABS+I<<BSCALE
ENTBTAB(0)=I-1
EXBTAB==ARRAY(ATABS+FREETABS,TABF)
I=1
%WHILE EXBPTR#0 %CYCLE
  BLKS==RECORD(ADICT+EXBPTR)
  EXBTAB(I)=BLKS_INF0
  I=I+1
  EXBPTR=BLKS_LINK1
%REPEAT
EXBPTR=FREETABS
FREETABS=FREETABS+I<<BSCALE
EXBTAB(0)=I-1
%END
%ENDOFFILE