@X @~
~L3 COUK1247
80
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H             BSC061
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL
~
~
                                                           ISSUE 11~
~V9 -1
~P
~V9 1
~YBSC061
~S~M~OBASIC COMPILER IMPLEMENTATION MANUAL
~S~M~OSection 6
~S~OSection 6. Imperative Statement Processing
~S~O1.1 General Description
~BThis section of the compiler deals with the processing of
imperative statements.  Each procedure deals with the syntax and
semantic checking of a particular type of statement, planting
code, and using section 7 to handle expressions.
~S~O2. Interfaces
~S~O2.1 Section Interfaces Used
~
   Section 2 :   (Configuration Section)~
   Section 3 :   (Lexical Analysis)~
   Section 4 :   (Declaration Processing)~
   Section 7 :   (Expression Processing)~
   Section 8 :   (Name List Management)~
   Section 9 :   (Fault and Reference Point Monitoring)~
~S~O2.2 Section Interface
~
Exported Procedures:~
   TRANS.DO~
   TRANS.END.IF~
   TRANS.ELSE.IF~
   TRANS.EXIT.DO~
   TRANS.SELECT~
   TRANS.CASE~
   TRANS.END.SELECT~
   TRANS.CALL~
   TRANS.LET~
   TRANS.IF~
   TRANS.ELSE~
   TRANS.LOOP~
   TRANS.FOR~
   TRANS.GOTO~
   TRANS.MAT~
   TRANS.EXIT~
   TRANS.GOSUB~
   TRANS.RETURN~
   TRANS.ON~
   TRANS.NEXT~
   TRANS.STOP~
   CALL~
   INIT.S6~
~
Exported Data Structures:~
   BLK.LEV~
   BLK.NO~
   BLK.STK~
~
Configuration Parameters:~
   GOSUBZ~
   BLKZ~
~S11) TRANS.CALL()
~BTranslates the call statement.
~S12) TRANS.LET()
~BTranslates the LET statement.
It uses section 7 to deal with the syntax and coding
of expressions.
~S13) TRANS.IF()
~S14) TRANS.ELSE.IF()
~S15) TRANS.END.IF()
~S16) TRANS.ELSE()
~BTranslates the IF statement as follows~
~
~MIF<condition>THEN<if clause>[ELSE<else clause>].
~
~
Without the ELSE, the statement is transposed to the form~
~
~NIF<condition>NOT TRUE THEN GOTO ENDLAB
~N<if clause>
~NENDLAB:
~
~
otherwise~
~
~NIF<condition>NOT TRUE THEN GOTO LAB1
~N<if clause>
~NGOTO ENDLAB
~NLAB1 : <else clause>
~NENDLAB:
~
~
An IF..THEN entry on CONSTK consists of~
~
~NELSE information
~N   > 0 MUTL name of ELSE label
~N   0 no active ELSE label
~N   -1 ELSE, ELSE IF statement not allowed
~NEND IF information
~N   > 0 MUTL name of END IF label
~N   0 END IF label not yet required
~N1
~S17) TRANS.DO()
~BTranslates the DO statement.~
~BA DO entry on CONSTK consists of the following~
~
~NMUTL name of START of LOOP LABEL
~NMUTL name of END of LOOP LABEL, 0 meaning that the
~Nlabel has not yet been declared.
~N3
~S18) TRANS.LOOP()
~BTranslates the LOOP statement that terminates
a DO loop.  A jump is planted to the start of the loop,
which is conditional if there is an exit-condition
specified.  The context stack entry for DO is removed.
~S19) TRANS.EXIT.DO()
~BTranslates an EXIT.DO statement.  After checking that
the context is correct, a jump to the end of the DO loop
is planted.
~S110) TRANS.FOR()
~BA FOR entry is made on CONSTK consisting of the following~
~Q 6
~
~NMUTL name of START of LOOP LABEL
~NMUTL name of CONTROL VARIABLE
~NCONTROL VARIABLE TYPE
~NMUTL name of INCREMENT
~N0
~S111) TRANS.NEXT()
~BTranslates the NEXT statement to terminate a FOR loop.
The context stack is reset and a jump planted to the
start of the loop.
~S112) TRANS.EXIT.FOR()
~BPlants a jump to the end of the FOR loop.
~S113) TRANS.GOTO()
~BThis procedure translates the GOTO statement.
~S114) TRANS.MAT()
~BTranslates the MAT statements, planting code to an external
library for the input/output and manipulation of arrays.
~S115) TRANS.EXIT(KIND)
~BPlants an unconditional jump to the end of the procedure.~
~T# 24 31 34
~
#KIND =#1#SUBEXIT~
##2#FNEXIT~
##3#FUNCTIONEXIT~
~S116) TRANS.GOSUB()
~BPlants a jump to the following label.  The return address is put
in the position in GOSUB.LABS indicated by GOSUB.PTR and then GOSUB.PTR
is incremented. There is no bound checking for overflow in GOSUB.LABS.
~S117) TRANS.RETURN()
~BGOSUB.PTR is decremented and a jump planted to the address in the
position in GOSUB.LABS indexed by GOSUB.PTR. There is no underflow
checking in GOSUB.LABS.
~S118) TRANS.ON()
~BTranslates the ON GOTO and ON GOSUB statements.
These statements are implemented by planting a data vector
(LABELS) containing the control addresses of the labels given.
The transfer of control is then effected by planting~
~
~MGOTO LABELS[COMPUTATION].
~
~
The return address is saved in GOSUB.LABS if the statement is ON GOSUB.
~S119) TRANS.STOP()
~BPlants a call to library procedure BIO.STOP.
~S120) INIT.S6()
~BInitialises the data structure for this section.
~S121) TRANS.SELECT()
~BThis procedure translates the SELECT statement.  A SELECT entry
on CONSTK consists of the following:~
~T# 10
~
~ILAST.CASE.ITEM index for enclosing select-block.~
~ILAST.SEL.CONST index for enclosing select-block.~
~ILAST.SEL.STR.CONST index for enclosing select block.~
~ICASE-ELSE indicator. Initially zero, set to MUTL name of case-else
block when case-else-line encountered.~
~IMUTLNAME of END SELECT label. Initially set
to zero, label declared when first case-line encountered.~
~IType of select expression.~
~IMUTLNAME of SELECT expression variable, the preceding MUTL
name is the label for the selection code.~
~I2~
~S122) TRANS.END.SELECT()
~S123) TRANS.CASE()
~S124) BLK.NO
~BThis variable holds the current control block number.
~S125) BLK.LEV
~BThis variable holds the current control block level.
~S126) BLK.STK
~BThis is a vector of control block numbers, it is indexed by
control block level to yield the control block number for that level.
~S127) BLKZ
~BConfiguration literal specifying size of BLK.STK.
~S~O3. Implementation
~S~O3.1 Outline of Operation
~S~O3.2 Data Structures
~T# 15
~
ENDPROG~IMUTL name of label assigned at the end of the program.~
~
GOSUB.PTR~IMUTL name of index to the next free location
in GOSUB.LABS.~
~
GOSUB.LABS~IMUTL name of vector of labels (held in the
run-time library global area) containing the
return addresses for the GOSUB/RETURN and
ONERROR GOTO/RESUME statements.~
~
GOSUBZ~INumber of elements in GOSUB.LABS.~
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                BSC061
~V9 -1
~F
///14
@TITLE BSC06(1,11)
@COL 1S-2R-3R-4R-6F
@FLOW 1-2-3-4-6
@BOX 1
IMPERATIVE PROCESSING
@BOX 2
GLOBAL VARIABLES
@BOX 3
PROCEDURES IN MODULE:
INIT.S6 [BSC06.0]
TRANS.IF [BSC06.2]
TRANS.DO [BSC06.3]
TRANS.FOR [BSC06.4]
TRANS.GOTO [BSC06.5]
TRANS.ON [BSC06.6]
TRANS.LOOP [BSC06.7]
TRANS.ELSE [BSC06.8]
TRANS.END.IF [BSC06.9]
TRANS.NEXT [BSC06.10]
TRANS.EXIT [BSC06.11]
TRANS.GOSUB [BSC06.12]
TRANS.RETURN [BSC06.13]
TRANS.ELSEIF [BSC06.14]
TRANS.EXIT.DO [BSC06.15]
TRANS.CALL [BSC06.16]
TRANS.EXIT.FOR [BSC06.17]
TRANS.MAT [BSC06.18]
TRANS.LET [BSC06.20]
GET.LAB [BSC06.21]
SRCH.CONSTK [BSC06.22]
PR.ELSE [BSC06.24]
PR.END.IF [BSC06.25]
PR.EXIT.COND [BSC06.26]
TRANS.STOP [BSC06.28]
INIT.GO.SUBS [BSC06.40]
END.GO.SUBS [BSC06.41]
SELECT [BSC06.42]
CASE [BSC06.43]
END.SELECT.LINE [BSC06.44]
@BOX 4
CHART DECLS
@BOX 5
INITIALISATION OF
EXTERNAL PROCS AS INTERNAL IDENTIFIERS
USERS VARIABLES FOR ERROR HANDLING
AND GOSUB RETURN ADDRESSES
AND STOP LABEL
@BOX 6
END
@BOX 1.1
*CODE 8;
#BSC06/1
MODULE(TRANS.CALL,TRANS.LET,TRANS.IF,TRANS.LOOP,TRANS.FOR,TRANS.GOTO,
TRANS.GOSUB,TRANS.RETURN,TRANS.EXIT.DO,TRANS.EXIT.FOR,TRANS.ELSE.IF,
TRANS.ON,TRANS.ELSE,TRANS.END.IF,TRANS.NEXT,
TRANS.STOP,TRANS.MAT,TRANS.EXIT,SRCH.CON.STK,
TRANS.DO,XSELECT,CASE,END.SELECT.LINE,
L.CASE.ITEM, L.SEL.CONST, L.SEL.STR,GET.LAB,INIT.S6,BLK.STK,
INIT.GO.SUBS, END.GO.SUBS, GOSUB.LABS, GO.SUB.PTR);
@BOX 2.1
TYPE CASE.E IS $LO8 REL $LO16 C1, C2, CASE.BLK.MN;
*GLOBAL 6;
DATAVEC GOSUB.CODE ($LO16)
%61 %8006      ::D=REF(GOSUB.LABS)
%2  %8007       ::B=GOSUB.PTR
%64 %0              ::SELECT ELEMENT 0
%46 %2C             ::AMODE=LABEL
%21 %800A       ::A=REF(LAB)
%20 %1004           ::A=>D[B]
%46 %44
%22 %8009
%38 %8007       ::1+>GOSUB.PTR
END

DATAVEC CODE.EXCEPTION ($LO16)
%48 %C00D           ::STACK LINK TO BIO.EXCEPTION
%46 %44             ::AMODE=$IN16
%22 %8003        ::ACC=G.LIT.16.0
%41 %3000           ::STACK ACC
%42 %0              ::ENTER
END
*GLOBAL 5;
CASE.E[CASE.ITEM.Z] CASE.ITEM;
CLIST.E[SEL.CONST.Z] SEL.CONST;
$LO8[SEL.STR.Z] SEL.STR;
$IN BASICSTOP,GOSUB.PTR,GOSUB.LABS, PU.GOSUB.PTR, PU.GOSUB.LABS ;
$LO16[BLK.Z] BLK.STK;
$IN L.CASE.ITEM, L.SEL.CONST, L.SEL.STR;
$LI/ADDR[$LO8]NIL = ;
*GLOBAL 0;
@BOX 3.1
$PS PR.ELSE ($IN);
$PS PR.END.IF ($IN);
$PS TRANS.MAT();
$PS TRANS.CALL();
$PS TRANS.LET();
$PS TRANS.IF();
$PS TRANS.ELSE();
$PS TRANS.END.IF();
$PS TRANS.LOOP ();
$PS TRANS.ON();
$PS TRANS.DO();
$PS TRANS.FOR();
$PS TRANS.NEXT();
$PS TRANS.GOSUB();
$PS TRANS.RETURN();
$PS TRANS.GOTO();
$PS TRANS.EXIT($IN);
$PS TRANS.STOP();
$PS GET.LAB()/$LO32;
$PS TRANS.EXIT.DO ();
$PS TRANS.EXIT.FOR ();
$PS TRANS.ELSE.IF ();
$PS XSELECT ();
$PS CASE ();
$PS END.SELECT.LINE ();
$PS PR.EXIT.COND ()/$IN;
$PS SRCH.CONSTK($IN)/$IN;
$PS INIT.GO.SUBS($IN);
$PS END.GO.SUBS($IN);
*GLOBAL 0;
@BOX 4.1
#BSC06.0
#BSC06.2
#BSC06.3
#BSC06.4
#BSC06.5
#BSC06.6
#BSC06.7
#BSC06.8
#BSC06.9
#BSC06.10
#BSC06.11
#BSC06.12
#BSC06.13
#BSC06.14
#BSC06.15
#BSC06.16
#BSC06.17
#BSC06.18
#BSC06.20
#BSC06.21
#BSC06.22
#BSC06.24
#BSC06.25
#BSC06.26
#BSC06.28
#BSC06.40
#BSC06.41
#BSC06.42
#BSC06.43
#BSC06.44
@BOX 6.1
*END
@END

///9
@TITLE BSC06.0(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1
PROC INIT.S6
@BOX 2.0
INIT CASE CONTEXT
@BOX 3.0
END
@BOX 1.1
$PS INIT.S6();
$PR INIT.S6;
@BOX 2.1
0 => CASE.ST;
@BOX 3.1
END;
@END
//17 22.JUL.83
@TITLE BSC06/1(1,11)
@COL 1S-2R-3R-4R-5R
@BOX 1.0
EXTERNAL ENVIRONMENT
@BOX 2.0
LITERALS
@BOX 3.0
TYPES
@BOX 4.0
VARS
@BOX 5.0
PROCS
@BOX 1.1
@BOX 3.1
TYPE ITYPE IS $LO8 TAG, ST $LO16 IND;
TYPE NLIST.ENT IS $LO16 BASICN, HASH, MUTLN, DETAIL, DETAIL1
                  $LO8 K, T;
$PS PROCESS.STAT ($IN)/$IN;
TYPE C.LIST.E IS $IN32 INT.C OR
                 $RE64 REAL.C;
@BOX 5.1
$PS EVAL.EXPR ($IN, ADDR C.LIST.E, $IN) / $IN;
$PS DECL.NUM.CONST ($IN, ADDR C.LIST.E) / $IN;
$PS SAVE.NODE.SUBS ($IN);
$PS LAB ($LO32, $IN) / $LO16;
$PS PL.COND.JUMP ($IN,$IN);
$PS EXPR($IN,$IN)/$IN;
$PS IN.EXPR ($IN)/$IN;
$PS CODE.NODE ($IN,$IN);
$PS PL.CD.SEQ (ADDR [$LO16]);
$PS CODE.EXPR($IN,$IN)/$IN;
$PS SET.A.TYPE($IN);
$PS DECL.PROC($IN);
$PS CHECK.TYPE($IN,$IN)/$IN;
$PS COMPTYPE($IN)/$IN;
$PS GET.N (ITYPE) / $IN;
$PS GET.CONST();
$PS GENN($LO16)/ADDR[$LO8];
@BOX 4.1
ITYPE EOS,DTHEN,DELSE,COMMA,DGOTO,DTO,LB,RB,EQUALS,AST,DSTEP,SCOLON,
COLON,DSUB,DGOSUB,DLINE,HASH.D,DFOR,DINPUT,DOUTPUT,
D.ORGANIZATION,DKEY,D.USING,DWHILE,DUNTIL,DIF,DGO,DCASE,DIS;
$IM $LI CASE.ITEM.Z, SEL.CONST.Z, SEL.STR.Z;
$IM $LI NLIST.Z, TCONST, DEF.STR.Z, STR.LIST.Z;
$LO8[STR.LIST.Z] STR.LIST;
NLIST.ENT [NLIST.Z] N.LIST;
$LO8 [2000] SBUFF;
$IM $LI AS.Z;
$IN16 [AS.Z] AS;
$IM $LI M.ONE,ZERO;
$IM $LI $LO16 ONE;
$LO16 G.LIT.16.0;
$LO32 G.LIT.32.0;
$IM $LI CHLISTZ;
$IN BLK.NO, BLK.LEV;
$LO8[CHLISTZ] CHLIST;
$LO8[32] TL.TYP;
$IM $LI CLISTZ;
C.LIST.E[CLISTZ] CLIST;
$IM $LI LBUFFZ;
ITYPE[LBUFFZ] LBUFF;
$IM $LI CONSTKZ, CON.Z, BLK.Z;
$IN [CONSTKZ] CONSTK;
$LO8 [CON.Z] CON.SIZE;
$IN CASE.ST;
$IM $LI GOSUBZ, EXCEPTION.L;
$PS MONITOR($IN);
$PS MONITOR.N($IN, $IN);
$PS MONITOR.S($IN, ADDR[$LO8]);
$IN CURPROC,LASTMN,CWORD,IPTR,CONPTR,CON.BASE, A.AP,
SPTR,LASTCH;
$LO16 DEF.POSTLUDE, PU.POSTLUDE, PU.POSTLUDE.VAR;
$LO16 DEF.N, FUNCTION.N;
$IN CPROC.K, PU.PROC.K, PU.RES.MN, DEF.RES.MN, RES.ASSIGNED;
$IM $LI TLAB,TADPROC,TLO8,TSTR,BSTR,TSTRING,T.OPNON.KEY;
$IM $LI KVAR,KCONST;
$IN WP,AP, BINT;
ADDR[$LO8] INPUT;
$PS CODE.STR.EXPR($IN, $IN);
$PS DECL.D($IN)/$IN;
$PS CODE.LET(ADDR[$IN],$IN,$IN);
$PS CODE.MAT($IN,$IN);
$PS PL.STR.COMP($IN, ADDR [$LO8], $IN);
$PS DECL.ARITH.CONST(ADDR C.LIST.E, $IN);
@END
//17 22.JUL.83
@TITLE BSC06.2(1,11)
@COL 23R-24R
@COL 1S-3R-4R-5T-8T-21R-22T-9R-10T-11T-12R-13T-14R-15R-6F
@COL 16R-17R-20C-18R-19R
@ROW 22-16
@ROW 23-11
@FLOW 1-3-4-5N-8N-21-22N-9-10N-11N-12R-13N-14-15-6
@FLOW 5Y-20
@FLOW 22Y-23-24-6
@FLOW 8Y-16-17-10
@FLOW 10Y-15
@FLOW 11Y-20
@FLOW 13Y-18-19-15
@BOX 1.0
TRANS IF
@BOX 3.0
INITIALISE CONTEXT STACK BUT DON'T
ALLOCATE YET. NOTE 'ELSEIF' 'ELSE'
'ENDIF' EXPECTED ON CONTEXT STACK
@BOX 4.0
COMPILE CONDITION [BSC07]
@BOX 5.0
NEXT ITEM NOT 'THEN'
@BOX 6.0
END
@BOX 8.0
NEXT ITEM A LABEL?
@BOX 9.0
PROCESS IMPERATIVE
STATEMENT [BSC1]
@BOX 10.0
NEXT ITEM EOS?
@BOX 11.0
NEXT ITEM NOT 'ELSE'
@BOX 12.0
PROCESS 'ELSE' [6.24]
@BOX 13.0
NEXT ITEM A LABEL?
@BOX 14.0
PROCESS IMPERATIVE
STATEMENT [BSC1]
@BOX 15.0
PROCESS END OF IF
STATEMENT [6.25]
@BOX 16.0
PROCESS LABEL REF
[BSC08]
@BOX 17.0
PLANT IF TRUE,
 GO TO LABEL
@BOX 18.0
PROCESS LABEL REF
[BSC08]
@BOX 19.0
PLANT GO TO LABEL
@BOX 20.0
FAULT
@BOX 21.0
DECLARE ELSE LABEL
PLANT IF FALSE,->ELSE
@BOX 22.0
END OF STATEMENT
@BOX 23.0
INCREMENT CONTROL
BLOCK NO. & LEVEL
@BOX 24.0
ALLOCATE CONTEXT STACK ENTRY
@BOX 1.1
PROC TRANS.IF;
$IN END.LAB, N, K;
ITYPE ITEM;
@BOX 3.1
0 => CON.STK [1 + CONPTR]
  => CON.STK [2 + CONPTR];
1 => CON.STK [3 + CONPTR];
@BOX 4.1
EXPR (3,0) => K;
@BOX 5.1
IF LBUFF[1+>IPTR]/=DTHEN
@BOX 6.1
END;
@BOX 8.1
IF TAG OF LBUFF[1+IPTR] = TCONST
AND ST OF LBUFF[IPTR+1] & %C7 = %40
@BOX 9.1
PROCESS.STAT (%10);
@BOX 10.1
IF LBUFF[1+IPTR] => ITEM = EOS OR ITEM = COLON
@BOX 11.1
IF ITEM /= DELSE
@BOX 12.1
1 +> IPTR;
PR.ELSE(CONPTR+3);
@BOX 13.1
IF TAG OF LBUFF[1 + IPTR] = 3 AND
   ST OF LBUFF[IPTR] & %C7 = %40
@BOX 14.1
PROCESS.STAT (%10);
@BOX 15.1
PR.END.IF(CONPTR+3);
@BOX 16.1
LAB(GET.LAB(),0) => N;
@BOX 17.1
PL.COND.JUMP (K, N);
@BOX 18.1
LAB(GET.LAB(),0) => N;
@BOX 19.1
TL.PL(%4F,N);
@BOX 20.1
MONITOR(%1000);
@BOX 21.1
1 +> LAST.MN => CON.STK[1 + CONPTR];
TL.LABEL.SPEC (NIL, 3);
PL.COND.JUMP (K ! %100, LAST.MN);
@BOX 22.1
IF LBUFF [1 + IPTR] => ITEM = EOS OR ITEM = COLON
@BOX 23.1
1 +> BLK.NO => BLK.STK [1 +> BLK.LEV];
@BOX 24.1
3 +> CONPTR;
@E
///11
@TITLE BSC06.3(1,11)
@COL 1S-2R-3R-4R-5T-6R-7R-9R-10F
@FLOW 1-2-3-4-5N-6-7-9-10
@FLOW 5Y-9
@BOX 1.0
TRANS.DO ()
@BOX 3.0
PROCESS EXIT CONDITION
[BSC06.26]
@BOX 2.0
DECLARE AND DEFINE LABEL FOR START OF LOOP
@BOX 4.0
ALLOCATE AND INITIALISE
CONTEXT STACK ENTRY
@BOX 5.0
NO JUMP REQUIRED ?
@BOX 6.0
DECLARE END OF LOOP LABEL ?
@BOX 7.0
PLANT CONDITIONAL JUMP
@BOX 9.0
INCREMENT BLOCK.NO, BLOCK.LEV
@BOX 10.0
END
@BOX 1.1
PROC TRANS.DO;
$IN K, N;
@BOX 3.1
PR.EXIT.COND () => K;
@BOX 2.1
1 +> LAST.MN => N;
TL.LABEL.SPEC (NIL, 2);
TL.LABEL(N);
@BOX 4.1
LAST.MN => CON.STK [1+>CON.PTR];
0 => CON.STK [1+>CON.PTR];
3 => CON.STK[1+>CON.PTR];
@BOX 5.1
IF K = -1
@BOX 6.1
1 +> LAST.MN => CON.STK [CONPTR - 1];
TL.LABEL.SPEC (NIL, 2);
@BOX 7.1
PL.COND.JUMP (K, LAST.MN);
@BOX 9.1
1 +> BLK.NO => BLK.STK [1 +> BLK.LEV];
@BOX 10.1
END
@END
///11
@TITLE BSC06.4(1,11)
@COL 15R-16R-22R
@COL 1S-2R-4T-5R-6T-7R-9T-10R-21T-11R-12R-13R-23T-14R-20R-18F
@ROW 15-7
@ROW 16-10
@ROW 22-14
@FLOW 1-2-4N-5-6N-7-9N-10-21N-11-12-13-23N-14-20-18
@FLOW 21Y-12
@FLOW 4Y-15
@FLOW 6Y-15
@FLOW 9Y-16-12
@FLOW 23Y-22
@BOX 1.0
TRANS FOR
@BOX 2.0
READ IN CONTROL VAR
AS EXPESSION [BSC07]
NOTE CV TYPE AND MUTL NAME
@BOX 4.0
NEXT ITEM NOT '='?
@BOX 5.0
READ IN INITIAL VALUE
EXPRESSION [BSC07]
@BOX 6.0
NEXT ITEM NOT 'TO'?
@BOX 7.0
READ IN LIMIT EXPRESSION
[BSC07]
@BOX 9.0
NEXT ITEM NOT STEP?
@BOX 10.0
READ IN STEP EXPRESSION
[BSC07]
@BOX 11.0
NOTE IF STEP SIZE = +1
OR -1
@BOX 12.0
PLANT CODE FOR 'FOR'
[06.4.1]
@BOX 13.0
SET UP CONTEXT STACK ENTRY
@BOX 14.0
NOTE VAR IN USE AS CV
IN PROPERTIES
@BOX 15.0
FAULT
@BOX 16.0
NOTE DEFAULT STEP SIZE = 1
@BOX 18.0
END
@BOX 20.0
INCREMENT BLOCK LEVEL
AND BLOCK NUMBER
@BOX 21.0
CV NOT INTEGER ?
@BOX 22.0
FAULT
@BOX 23.0
IS CV ALREADY IN CONTROL OF A FOR LOOP
@BOX 1.1
PROC TRANS.FOR;
$IN M, STLAB,CV.AP,CV.T,INIT.AP,LIM.AP,CV.MN,
STEP.AP,LIM.T,STEP.T,STEP.MN,LIM.MN,
FLAG, SIGN.MN, K, TST, CV.ID, INIT.T;
C.LIST.E CONST, STEP.CONST;
@BOX 2.1
IN.EXPR (%85) => CV.AP;
AS [CV.AP] ->> 11 => CV.T;
MUTLN OF N.LIST [AS [CV.AP + 2] => CV.ID] => CV.MN;
@BOX 4.1
IF LBUFF[1+>IPTR] /= EQUALS
@BOX 5.1
IN.EXPR (5) => INIT.AP;
@BOX 6.1
IF LBUFF[1+>IPTR] /= DTO
@BOX 7.1
IN.EXPR (5) => LIM.AP;
@BOX 9.1
IF LBUFF[1+IPTR] /= DSTEP
@BOX 10.1
1 +> IPTR;
IN.EXPR (5) => STEP.AP;
@BOX 11.1
IF EVAL.EXPR (8, ^CONST, STEP.AP) => STEP.T /= 0 THEN
   IF INT.C OF CONST = 1 THEN
      1 => M
   ELSE
      IF INT.C OF CONST = -1 THEN
         2 => M
      FI
   FI
FI
@BOX 12.1
#BSC06.4.1
@BOX 13.1
ST.LAB => CON.STK[1 +> CON.PTR];
CV.MN => CON.STK [1 +> CON.PTR];
CV.T => CON.STK [1 +> CON.PTR];
STEP.MN => CON.STK [1 +> CON.PTR];
0 => CON.STK [1 +> CONPTR];
@BOX 14.1
%800 !> DETAIL1 OF N.LIST [CV.ID];
@BOX 15.1
MONITOR(%1000);
@BOX 16.1
IF CV.T & %18 /= %8 THEN
   -1 => M;
   1.0 => REAL.C OF STEP.CONST;
ELSE
   1 => M;
   1 => INT.C OF STEP.CONST;
FI;
0 => STEP.AP;
@BOX 18.1
END;
@BOX 20.1
1 +> BLK.NO => BLK.STK [1 +> BLK.LEV];
@BOX 21.1
-1 => M;
IF CV.T & %18 /= %8
@BOX 22.1
MONITOR.N(%103F, CV.ID);
@BOX 23.1
IF DETAIL1 OF N.LIST[CV.ID] & %800 /= 0
@END
///17 22.JUL.83
@TITLE BSC06.4.1(1,11)
@COL 25R-28R
@COL 12R-23T-24R-13R-26T-27R-14R
@COL 1S-2T-3R-4R-5T-6R-18T-19R-20R-21R-7R-29T-10R-30R-11F
@COL 15R-31R-22R
@ROW 25-24
@ROW 28-27
@ROW 12-3
@ROW 6-15
@ROW 19-22
@FLOW 1-2N-3-4-5N-6-18N-19-20-21-7-29N-10-30-11
@FLOW 2Y-12-23N-24-13-26N-27-14-11
@FLOW 23Y-25-13
@FLOW 26Y-28-14
@FLOW 29Y-30-11
@FLOW 5Y-15-18
@FLOW 18Y-31-22-21
@BOX 1.0
PLANT CODE FOR 'FOR'
@BOX 2.0
IS CV INTEGER WITH A
UNIT STEP SIZE?
@BOX 3.0
DECLARE START LOOP LABEL
AND END LOOP LABEL
@BOX 4.0
CODE INITIAL EXPR AND CONVERT
IF NECESSARY
ASSIGN INITIAL VALUE TO CV
@BOX 5.0
LIMIT EXPR A LITERAL?
@BOX 6.0
DECLARE LIMIT TEMP OF CV TYPE
CODE LIMIT EXPR
PLANT CONVERT IF NECESSARY
AND ASSIGN TO TEMP
@BOX 7.0
PLANT AMODE = CVTYPE
      A = CV
      A - LIMIT
@BOX 10.0
PLANT A * SIGN
      SET TEST TO >
@BOX 30.0
      A COMP 0
      IF(TEST) 0, -> END.LAB
@BOX 11.0
END
@BOX 12.0
NOTE LABELS NOT NEEDED
@BOX 13.0
PLANT CV CYCLE
@BOX 14.0
PLANT CV LIMIT
@BOX 15.0
ALLOCATE MUTL NAME FOR LITERAL
@BOX 18.0
STEP A LITERAL ?
@BOX 19.0
DECLARE STEP TEMP
CODE STEP EXPRESSION [BSC07]
CONVERT TO CV TYPE AND
ASSIGN TO TEMP
@BOX 20.0
DECLARE SIGN TEMP AND
PLANT CODE TO SET SIGN
@BOX 21.0
DEFINE START OF LOOP LABEL
@BOX 22.0
ALLOCATE MUTL NAME
FOR LITERAL
@BOX 23.0
INITIAL EXPR A LITERAL ?
@BOX 24.0
CODE EXPR
@BOX 25.0
DECLARE CURRENT
LITERAL
@BOX 26.0
LIMIT EXPR A LITERAL ?
@BOX 27.0
CODE EXPR
@BOX 28.0
DECLARE CURRENT
LITERAL
@BOX 29.0
STEP A LITERAL ?
@BOX 31.0
SET TEST TO > IF POSITIVE
ELSE SET TEST TO <
@BOX 1.1
::PLANT CODE FOR 'FOR'
@BOX 2.1
IF M >= 0
@BOX 3.1
TL.LABEL.SPEC(NIL,2);
TL.LABEL.SPEC(NIL,2);
LASTMN+1=> ST.LAB +1 => LASTMN;
@BOX 4.1
CODE.EXPR (INIT.AP, CV.T);
CODE.NODE (19, CV.AP);
-1 => A.AP;
@BOX 5.1
IF EVAL.EXPR
(CV.T, ^CONST, LIM.AP) => LIM.T /= 0
@BOX 6.1
DECL.D(TL.TYP[CV.T]) => LIM.MN;
CODE.EXPR (LIM.AP, CV.T);
TL.PL (%20, LIM.MN);
-1 => A.AP;
@BOX 7.1
SET.A.TYPE(CV.T);
TL.PL(%22,CV.MN);
TL.PL(%29,LIM.MN);
@BOX 10.1
TL.PL(%2B,SIGN.MN);
%4E => TST;
@BOX 30.1
TL.PL(%2F,ZERO);
-1 => A.AP;
TL.PL (TST, ST.LAB + 1);
@BOX 11.1
::END
@BOX 12.1
0 => ST.LAB;
@BOX 13.1
TL.CV.CYCLE(CV.MN,K,M);
@BOX 14.1
TL.CV.LIMIT(K);
@BOX 15.1
DECL.NUM.CONST
(CV.T <<- 3 ! %8000,^CONST) => LIM.MN;
@BOX 18.1
IF STEP.AP = 0 OR
EVAL.EXPR (CV.T, ^STEP.CONST, STEP.AP) => FLAG /= 0
@BOX 19.1
DECL.D (TL.TYP[CV.T]) => STEP.MN;
CODE.EXPR (STEP.AP, CV.T);
TL.REG (2);
TL.PL (%20, STEP.MN);
@BOX 20.1
DECL.D(TL.TYP[CV.T]) => SIGN.MN;
TL.PL(%32, %1C);  ::XSIGN
TL.PL(%20, SIGN.MN);
-1 => A.AP;
@BOX 21.1
TL.LABEL (ST.LAB);
@BOX 22.1
DECL.NUM.CONST
(CV.T <<- 3 ! %8000,^STEP.CONST) => STEP.MN;
@BOX 23.1
IF EVAL.EXPR (8, ^CONST,INIT.AP) => INIT.T /= 0
@BOX 24.1
CODE.EXPR (INIT.AP, CV.T);
%3000 => K;
-1 => A.AP;
@BOX 25.1
DECL.NUM.CONST (INIT.T <<- 3, ^CONST);
0 => K;
@BOX 26.1
IF EVAL.EXPR
(8, ^CONST, LIM.AP) => LIM.T /= 0
@BOX 27.1
CODE.EXPR (LIM.AP, CV.T);
%3000 => K;
-1 => A.AP;
@BOX 28.1
DECL.NUM.CONST (LIM.T <<- 3, ^CONST);
0 =>  K;
@BOX 29.1
IF STEP.AP = 0 OR FLAG /= 0
@BOX 31.1
IF CV.T & %C0 = 0 THEN
  IF REAL.C OF STEP.CONST >= 0 THEN
     %4E => TST
  ELSE
     %4C => TST
  FI
ELSE
  IF INT.C OF STEP.CONST >= 0 THEN
     %4E => TST
  ELSE
     %4C => TST
  FI
FI
@END
///1
@TITLE BSC06.5(1,11)
@COL 1S-2R-7R-8F
@FLOW 1-2-7-8
@BOX 1
TRANS.GOTO()
@BOX 2
GET MUTL NAME OF
LABEL [6.38]
@BOX 7
FOR GOTO STMT
PLANT '-> NAME'
@BOX 8
END
@BOX 9
FAULT
@BOX 1.1
$PR TRANS.GOTO;
$IN DEST.LAB,ID;
@BOX 2.1
LAB(GET.LAB(),0) => DEST.LAB;
@BOX 7.1
TL.PL(%4F, DEST.LAB)
@BOX 8.1
$EN
@END
///11
@TITLE BSC06.6(1,11)
@COL 22R
@COL 1S-3R-4T-5R-7T-9R-10R-11T-12R-13R-14R-15R-16R-19R-17T-18R-20F
@COL 21C
@ROW 5-21
@ROW 18-22
@FLOW 1-3-4N-5-7N-9-10-11N-12-13-14-15-16-19-17N-18-20
@FLOW 4Y-21
@FLOW 7Y-5
@FLOW 11Y-13
@FLOW 17Y-22-20
@BOX 1.0
TRANS.ON ()
@BOX 3.0
RECOGNISE INDEX EXPR
[BSC07]
@BOX 4.0
GO TO
GO SUB
NOT PRESENT ?
@BOX 5.0
GET MUTL NAME OF LABEL &
STORE IT
INCREMENT LABEL COUNT
@BOX 7.0
IS IT ',' ?
@BOX 9.0
START A MUTL BLOCK
@BOX 10.0
DECLARE FAIL LABEL
@BOX 11.0
ON GOTO ?
@BOX 12.0
PUT RETURN ADDRESS
INTO GOSUB.LABS
@BOX 13.0
DECLARE SWITCH VECTOR OF LABELS
@BOX 14.0
PLANT CODE:
CODE INDEX EXPR [BSC07]
B - 1
TL.REG (1)
B COMP 0
IF < 0 => FAIL
TL.REG (1)
B COMP LABEL.CNT
IF >= 0,-> FAIL
D = REF(SWITCH VECTOR)
SELECT ELEMENT
-> D[]
@BOX 15.0
ASSIGN LABEL VALUES
TO SWITCH VECTOR
@BOX 16.0
PLANT
FAIL :
@BOX 17.0
NEXT ITEM ELSE ?
@BOX 18.0
PLANT BIO.EXCEPTION (10001)
@BOX 19.0
END TL BLOCK
@BOX 20.0
END
@BOX 21.0
FAULT
@BOX 22.0
PROCESS IMPERATIVE STATEMENT
@BOX 1.1
PROC TRANS.ON ;
$IN GOTO;
ITYPE I1,I2;
$IN END.LAB,LAB.CNT,I,PTR,AP;
$IN[1000]LABS;
-1 => LAB.CNT;
@BOX 3.1
IN.EXPR(5) => AP;
TL.PL (9, ONE);
@BOX 4.1
-1 => GOTO;
IF LBUFF[1 +> IPTR] => I1 = DGO THEN
   IF LBUFF[1 +> IPTR] => I2 = DTO THEN
      1 => GO.TO;
   ELSE IF I2 = DSUB THEN
      0 => GO.TO;
   FI FI
ELSE IF I1 = D.GOTO THEN
   1 => GOTO;
ELSE IF I1 = DGOSUB THEN
   0 => GOTO;
FI FI FI
IF GOTO < 0
@BOX 5.1
LAB (GET.LAB (),0) => LABS [1+>LAB.CNT];
@BOX 7.1
IF LBUFF[1 +> IPTR] => I1 = COMMA
@BOX 9.1
TL.BLOCK ();
@BOX 10.1
TL.LABEL.SPEC (NIL, 3);
@BOX 11.1
IF GOTO = 1
@BOX 12.1
PL.CD.SEQ (^GOSUB.CODE);
@BOX 13.1
TL.S.DECL (NIL,%2C,-1);
LAB.CNT => G.LIT.32.0;
@BOX 14.1
CODE.EXPR(AP, B.INT ->> 3 ! %100);
DATAVEC CODE.JMP ($LO16)
%9 %8009    :: B - 1
%8000 %1         ::TL.REG(1)
%F %8008         ::B COMP 0
%4C %800A        ::IF < 0 -> FAIL
%8000 %1         ::TL.REG(1)
%F %800B         ::B COMP LAB.CNT
%4E %800A        ::IF > 0 -> FAIL
%61 %800C        :: D = REF(SWITCH VECTOR)
%64 %0           ::SELECT ELEMENT 0
%4F %1004        ::-> D[]
END

PL.CD.SEQ (^CODE.JMP);
@BOX 15.1
TL.ASS (LAST.MN + 2, -1);
FOR I < LAB.CNT + 1 DO
   TL.ASS.VALUE (LABS [I], 1);
OD;
TL.ASS.END ();
@BOX 16.1
TL.LABEL (LAST.MN + 1);
@BOX 17.1
IF I1 = DELSE
@BOX 18.1
1 -> IPTR;
EXCEPTION.L => G.LIT.16.0;
PL.CD.SEQ (^CODE.EXCEPTION);
@BOX 19.1
TL.END.BLOCK ();
@BOX 20.1
END
@BOX 21.1
MONITOR (%1000);
@BOX 22.1
PROCESS.STAT(%10);
@END
///10
@TITLE BSC06.7(1,11)
@COL 1S-2R-3T-4T-5R-11R-6R-7R-8F
@COL 9C-10R
@ROW 4-9
@FLOW 1-2-3N-4N-5-11-6-7-8
@FLOW 3Y-9
@FLOW 4Y-10-11
@BOX 1.0
TRANS.LOOP ()
@BOX 2.0
PROCESS EXIT CONDITION [BSC06.26]
@BOX 3.0
ENTRY ON TOP OF CONTEXT
STACK NOT A DO ENTRY
@BOX 4.0
NO EXIT CONDITION ?
@BOX 5.0
PLANT COND JUMP TO
START OF LOOP
@BOX 6.0
REMOVE CONTEXT ENTRY
@BOX 7.0
DECREMENT BLOCK LEVEL
@BOX 8.0
END
@BOX 9.0
FAULT
@BOX 10.0
PLANT JUMP TO START OF LOOP
@BOX 11.0
DECLARE END OF LOOP LABEL
@BOX 1.1
PROC TRANS.LOOP ;
$IN K, N;
@BOX 2.1
PR.EXIT.COND () => K;
@BOX 3.1
IF CONSTK [CONPTR] /= 3
@BOX 4.1
IF K = -1
@BOX 5.1
PL.COND.JUMP (K -= %100, CONSTK[CONPTR-2]);
@BOX 6.1
3 -> CONPTR;
@BOX 7.1
1 -> BLK.LEV;
@BOX 8.1
END
@BOX 9.1
MONITOR.S (%103A, %"DO");
@BOX 10.1
TL.PL (%4F, CONSTK[CONPTR-2]);
@BOX 11.1
IF CON.STK[CON.PTR - 1] => N /= 0 THEN
   TL.LABEL(N);
FI
@E
//14
@TITLE BSC06.8(1,11)
@COL 1S-2T-3T-4R-5R-6F
@COL 7C-8C
@ROW 3-7
@FLOW 1-2N-3N-4-5-6
@FLOW 2Y-7
@FLOW 3Y-8
@BOX 1.0
TRANS.ELSE ()
@BOX 2.0
CURRENT CONTEXT NOT IF ?
@BOX 3.0
ELSE ALREADY SEEN ?
@BOX 4.0
PROCESS ELSE [BSC06.24]
@BOX 5.0
INCREMENT CONTROL BLOCK NO.
@BOX 6.0
END
@BOX 7.0
FAULT
@BOX 8.0
FAULT
@BOX 1.1
PROC TRANS.ELSE ;
@BOX 2.1
IF CON.STK [CONPTR] /= 1
@BOX 3.1
IF CON.STK [CONPTR - 2] = -1
@BOX 4.1
PR.ELSE (CONPTR);
@BOX 5.1
1 +> BLK.NO => BLK.STK [BLK.LEV];;
@BOX 6.1
END
@BOX 7.1
MONITOR.S (%103A, %"if-block");
@BOX 8.1
MONITOR.S (%103D, %"else-line");
@END
///11
@TITLE BSC06.9(1,11)
@COL 1S-2T-3R-4R-5R-6F
@COL7C
@ROW 3-7
@FLOW 1-2N-3-4-5-6
@FLOW 2Y-7
@BOX 1.0
TRANS.END.IF ()
@BOX 2.0
CURRENT CONTEXT NOT IF ?
@BOX 3.0
PROCESS END.IF [BSC06.25]
@BOX 4.0
REMOVE CONTEXT STACK ENTRY
@BOX 5.0
DECREMENT CONTROL BLOCK LEVEL
@BOX 6.0
END
@BOX 7.0
FAULT
@BOX 1.1
PROC TRANS.END.IF ;
@BOX 2.1
IF CON.STK [CONPTR] /= 1
@BOX 3.1
PR.END.IF (CONPTR);
@BOX 4.1
3 -> CONPTR;
@BOX 5.1
1 -> BLK.LEV;
@BOX 6.1
END
@BOX 7.1
MONITOR.S (%103A, %"if-block");
@END
///3
@TITLE BSC06.10(1,11)
@COL 16R
@COL 1S-2R-3T-4T-5T-6R-7R-8R-9R-10R-11R-12F
@COL 14C-15C
@ROW 16-6
@ROW 4-14
@FLOW 1-2-3N-4N-5N-6-7-8-9-10-11-12
@FLOW 3Y-14
@FLOW 4Y-15
@FLOW 5Y-16-9
@BOX 1.0
TRANS NEXT
@BOX 2.0
GET NEXT ITEM
@BOX 3.0
CURRENT CONTEXT NOT 'FOR' ?
@BOX 4.0
WRONG LOOP VARIABLE SPECIFIED ?
@BOX 5.0
TL.CV.CYCLE IN USE FOR THIS LOOP ?
@BOX 6.0
PLANT CODE TO ADD
'STEP' TO CV
@BOX 9.0
RESET 'VAR IN USE AS CONTROL VAR'
BIT IN PROPERTIES
@BOX 7.0
PLANT UNCONDITIONAL JUMP
TO START OF LOOP LABEL
@BOX 8.0
DEFINE END OF LOOP LABEL
@BOX 10.0
REMOVE 'FOR' ENTRY FROM
CONTEXT STACK
@BOX 11.0
DECREMENT BLOCK LEVEL
@BOX 12.0
END
@BOX 14.0
FAULT
@BOX 15.0
FAULT
@BOX 16.0
PLANT TL.REPEAT
@BOX 1.1
PROC TRANS.NEXT;
$IN ST.LAB, NL.I;
@BOX 2.1
GETN (LBUFF [1 +> IPTR]) => NL.I;
@BOX 3.1
IF CONSTK [CONPTR] /= 0
@BOX 4.1
IF MUTLN OF N.LIST [NL.I] /= CONSTK [CONPTR-3]
@BOX 5.1
IF CONSTK [CONPTR-4] => ST.LAB = 0
@BOX 6.1
SET.A.TYPE(CONSTK[CONPTR - 2]);
TL.PL (%22, CONSTK [CONPTR - 1]);
TL.PL (%38, CONSTK[CONPTR - 3]);
@BOX 7.1
TL.PL (%4F,ST.LAB);
@BOX 8.1
TL.LABEL (ST.LAB+1);
@BOX 9.1
%800 -=> DETAIL1 OF N.LIST [NL.I];
@BOX 10.1
5 -> CONPTR;
@BOX 11.1
1 -> BLK.LEV;
@BOX 12.1
END
@BOX 14.1
MONITOR.S (%103A, %"for-loop");
@BOX 15.1
MONITOR.N (%103E, NL.I);
@BOX 16.1
TL.REPEAT ();
@END
///12
@TITLE BSC06.11(1,11)
@COL 6R
@COL 1S-2T-3T-4R-5F
@COL 7R
@ROW 6-4-7
@FLOW 1-2N-3N-4-5
@FLOW 2Y-7
@FLOW 3Y-6-4
@BOX 1.0
TRANS.EXIT(PROC KIND)
PROC.KIND
1  EXIT SUB
2  EXIT DEF
3  EXIT FUNCTION
@BOX 2.0
IN MAIN PROGRAM
@BOX 3.0
WRONG KIND OF EXIT STATEMENT
@BOX 4.0
PLANT JUMP TO POSTLUDE CODE
USE JUMP VIA VARIABLE IF EXIT FN/SUB WITHIN
AN INTERNAL FUNCTION
@BOX 5.0
END
@BOX 6.0
FAULT
@BOX 7.0
FAULT
@BOX 1.1
PROC TRANS.EXIT(PROC.K);
$IN S,F;
$LO16 L;
DATAVEC M($LO8)
"SUB"
"DEF"
"FUNCTION"
END
DATAVEC P($LO8)
0 3 6 14
END
@BOX 2.1
IF CPROC.K = 0
@BOX 3.1
IF PROC.K /= CPROC.K AND
   PROC.K /= PU.PROC.K
@BOX 4.1
IF PROC.K = 2 THEN
   DEF.POSTLUDE => L;
ELSE
   IF CPROC.K = 2 THEN
      IF PU.POSTLUDE.VAR = 0 THEN
         TL.S.DECL(NIL, %30, 0);
         1 +> LAST.MN => PU.POSTLUDE.VAR;
      FI
      PU.POSTLUDE.VAR => L;
   ELSE
      PU.POSTLUDE => L;
   FI
FI
TL.PL(%4F, L);
@BOX 5.1
END
@BOX 6.1
P[CPROC.K -1] => S;
P[CPROC.K] => F;
MONITOR.S(%4D, PART(^M, S, F));
@BOX 7.1
MONITOR(%104C);
@END
///11
@TITLE BSC06.12(1,11)
@COL 1S-7R-2R-3R-4R-5R-6F
@FLOW 1-7-2-3-4-5-6
@BOX 1.0
TRANS GOSUB
@BOX 2.0
START TL BLOCK
DECLARE RETURN LABEL
@BOX 3.0
PUT PTR TO RETURN LABEL
IN VECTOR GOSUB.LABS
@BOX 4.0
PLANT JUMP TO SUBROUTINE
@BOX 5.0
DEFINE RETURN LABEL
INCREMENT GOSUB.PTR
END TL BLOCK
@BOX 6.0
END
@BOX 7.0
GET LABEL
@BOX 1.1
PROC TRANS.GOSUB;
$IN N;
@BOX 2.1
TL.BLOCK ();
TL.LABEL.SPEC(NIL,2);
@BOX 3.1
PL.CD.SEQ (^GOSUB.CODE);
@BOX 4.1
TL.PL (%4F, N);
@BOX 5.1
TL.LABEL(LAST.MN + 1);
TL.END.BLOCK ();
@BOX 6.1
END;
@BOX 7.1
LAB(GET.LAB(), 0) => N;
@E
///10
@TITLE BSC06.13(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
TRANS RETURN ()
@BOX 2.0
DECREMENT GOSUB.PTR
PLANT JUMP TO
RETURN ADDRESS
FROM GOSUBLABS
@BOX 3.0
END
@BOX 1.1
PROC TRANS.RETURN;
@BOX 2.1
DATAVEC CODE1 ($LO16)
%46 %44     ::AMODE = $IN16
%22 %8009   ::ACC = ONE
%8000 %2    ::TL.REG (2)
%3A %8007   ::ACC -> GOSUB.PTR
%2F %8008   ::ACC COMP 0
%4C %800A   ::IF < 0 -> LAB
%2 %8007   ::B = GOSUB.PTR
%61 %8006   ::D = REF(GOSUB.LABS)
%64 %0      ::SELECT ELEMENT 0
%4F %1004   ::JUMP RETURN LABEL
END

TL.BLOCK ();
TL.LABEL.SPEC (NIL, 2);
EXCEPTION.L + 1 => G.LIT.16.0;
PL.CD.SEQ (^CODE1);
TL.LABEL (LAST.MN + 1);
PL.CD.SEQ (^CODE.EXCEPTION);
TL.END.BLOCK ();
@BOX 3.1
END;
@E
///11
@TITLE BSC06.14(1,11)
@COL 16C
@COL 1S-2T-3T-4T-5T-6R-7R-8R-9R-10R-11T-12R-13R-14R-15F
@COL 17C-18C
@ROW 3-17
@ROW 16-13
@FLOW 1-2N-3N-4N-5N-6-7-8-9-10-11N-12-13-14-15
@FLOW 2Y-17
@FLOW 3Y-18
@FLOW 4Y-10
@FLOW 5Y-7
@FLOW 11Y-16
@BOX 1.0
TRANS.ELSE.IF ()
@BOX 2.0
CURRENT CONTEXT NOT IF ?
@BOX 3.0
'ELSEIF' NOT ALLOWED ?
@BOX 4.0
ELSE LABEL NOT REQUIRED ?
@BOX 5.0
ENDIF LABEL DECLARED ?
@BOX 6.0
DECLARE ENDIF LABEL &
UPDATE CONTEXT ENTRY
@BOX 7.0
PLANT -> END.LABEL
@BOX 8.0
DEFINE ELSE LABEL
@BOX 9.0
RESET ELSE LABEL FIELD
IN CONTEXT STACK
@BOX 10.0
COMPILE RELATIONAL EXPRESSION
[BSC07]
@BOX 11.0
'THEN' NOT PRESENT ?
@BOX 12.0
DECLARE LABEL FOR NEXT ELSE/ELSEIF
& UPDATE CONTEXT STACK
@BOX 13.0
PLANT IF FALSE, -> NEXT ELSE LABEL
@BOX 14.0
INCREMENT CONTROL BLOCK NO.
@BOX 15.0
END
@BOX 16.0
FAULT
@BOX 17.0
FAULT
@BOX 18.0
FAULT
@BOX 1.1
PROC TRANS.ELSE.IF;
$IN K, ELSE.LAB, END.IF.LAB;
@BOX 2.1
IF CON.STK [CONPTR] /= 1
@BOX 3.1
IF CON.STK [CONPTR - 2] => ELSE.LAB = -1
@BOX 4.1
IF ELSE.LAB = 0
@BOX 5.1
IF CON.STK [CONPTR - 1] => END.IF.LAB /= 0
@BOX 6.1
1 +> LAST.MN => CON.STK [CONPTR - 1] => END.IF.LAB;
TL.LABEL.SPEC (NIL, 2);
@BOX 7.1
TL.PL (%4F, END.IF.LAB);
@BOX 8.1
TL.LABEL (ELSE.LAB);
@BOX 9.1
0 => CONSTK [CONPTR - 2];
@BOX 10.1
EXPR (%3, 0) => K;
@BOX 11.1
IF LBUFF [1 +> IPTR] /= DTHEN
@BOX 12.1
1 +> LAST.MN => CON.STK [CONPTR - 2];
TL.LABEL.SPEC (NIL, 2);
@BOX 13.1
PL.COND.JUMP (K ! %100, LAST.MN);
@BOX 14.1
1 +> BLK.NO => BLK.STK [1 +> BLK.LEV];;
@BOX 15.1
END
@BOX 16.1
MONITOR (%1000);
@BOX 17.1
MONITOR.S (%103A, %"if-block");
@BOX 18.1
MONITOR.S (%103D, %"elseif-then-line");
@END
///10
@TITLE BSC06.15(1,11)
@COL 1S-2T-3T-4R-5R-6F
@COL 7C
@FLOW 1-2N-3N-4-5-6
@FLOW 2Y-7
@FLOW 3Y-5
@ROW 3-7
@BOX 1.0
TRANS.EXIT.DO ()
@BOX 2.0
SEARCH CONTEXT STACK FOR MOST RECENT DO ENTRY
[BSC06.22]
NOT FOUND ?
@BOX 3.0
END LABEL DECLARED ?
@BOX 4.0
DECLARE END LABEL
@BOX 5.0
PLANT -> END.LABEL
@BOX 6.0
END
@BOX 7.0
FAULT
@BOX 1.1
PROC TRANS.EXIT.DO;
$IN PTR, N;
@BOX 2.1
IF SRCH.CONSTK(3) => PTR < 0
@BOX 3.1
IF CONSTK [PTR - 1] => N > 0
@BOX 4.1
1 +> LAST.MN => N => CONSTK [PTR - 1];
TL.LABEL.SPEC (NIL, 2);
@BOX 5.1
TL.PL (%4F, N);
@BOX 6.1
END
@BOX 7.1
MONITOR (%103B);
@END
///10
@TITLE BSC06.16(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
TRANS CALL ()
@BOX 2.0
CALL EXPR [BSC07] TO
COMPILE CALL
@BOX 3.0
END
@BOX 1.1
PROC TRANS.CALL;
@BOX 2.1
EXPR (%20,0);
@BOX 3.1
END
@END
///10
@TITLE BSC06.17(1,11)
@COL 1S-2T-3R-4F
@COL 5C
@ROW 3-5
@FLOW 1-2N-3-4
@FLOW 2Y-5
@BOX 1.0
TRANS EXIT FOR
@BOX 2.0
SEARCH CONTEXT STACK FOR MOST
RECENT 'FOR' ENTRY
NOT FOUND ?
@BOX 3.0
PLANT UNCONDITIONAL JUMP
TO END LOOP LABEL
@BOX 4.0
END
@BOX 5.0
FAULT
@BOX 1.1
PROC TRANS.EXIT.FOR ;
$IN PTR;
@BOX 2.1
IF SRCH.CONSTK(0) => PTR < 0
@BOX 3.1
TL.PL (%4F, CONSTK [PTR-4] + 1);
@BOX 4.1
END
@BOX 5.1
MONITOR (%103C);
@END
///17 8-AUG-83
@TITLE BSC06.18(1,11)
@COL 10C-11C
@COL 1S-2R-3T-5T-6R-7T-8R-9F
@COL 13C
@ROW 10-5
@ROW 8-13
@FLOW 1-2-3N-5N-6-7N-8-9
@FLOW 3Y-10
@FLOW 7Y-13
@FLOW 5Y-11
@BOX 1.0
TRANS MAT ()
@BOX 2.0
READ IN L.H.S. EXPRESSION
[BSC07]
@BOX 3.0
NEXT ITEM NOT '=' ?
@BOX 5.0
L.H.S. NOT A VALID ARRAY ?
@BOX 6.0
READ IN R.H.S. NUMERIC ARRAY
EXPRESSION [BSC07]
@BOX 7.0
NOT A VALID RHS ARRAY EXPRESSION?
@BOX 8.0
CODE ASSIGNATION [BSC07]
@BOX 9.0
END
@BOX 10.0
FAULT
@BOX 11.0
FAULT
@BOX 13.0
FAULT
@BOX 1.1
PROC TRANS.MAT;
$IN L.AP, L.T, R.AP, R.T, W0, T;
@BOX 2.1
IN.EXPR (%354) => L.AP;
@BOX 3.1
IF LBUFF [1 +> IPTR] /= EQUALS
@BOX 5.1
IF AS[L.AP] => W0 & %F88F /= %C083
       AND W0 & %E28F /= %83
@BOX 6.1
IF W0 & %C000 /= %C000 THEN
   %45 => T;
ELSE
   %46 => T;
FI
IN.EXPR(K OF NLIST[AS[L.AP+2]] <<- 8 ! (W0 & %F800) ! T) => R.AP;
@BOX 7.1
IF AS[R.AP] => R.T & %FF /= %83 /= %84 /= %85
    AND RT & %280 /= %200
@BOX 8.1
CODE.MAT (L.AP, R.AP);
@BOX 9.1
END
@BOX 10.1
MONITOR (%1000);
@BOX 11.1
MONITOR (%106A);
@BOX 13.1
MONITOR (%106B);
@END
///12
@TITLE BSC06.20(1,11)
@COL 1S-17T-18T-2R-15T-3T-4T-5T-6T-7R-8T-9R-10F
@COL 19R-16R-11R-12R-13R-14R
@ROW 4-16
@ROW 2-19
@FLOW 1-17N-18N-2-15N-3N-4N-5N-6N-7-8N-9-10
@FLOW 17Y-2
@FLOW 18Y-19
@FLOW 3Y-11
@FLOW 4Y-2
@FLOW 6Y-13
@FLOW 5Y-12
@FLOW 8Y-14
@FLOW 15Y-16
@BOX 1.0
PROCESS LET STATEMENT
@BOX 2.0
READ IN LHS ITEM [07]
ADD TO LIST OF LHS ITEMS
NOTE ITS TYPE
@BOX 3.0
INVALID LHS ITEM?
@BOX 4.0
NEXT ITEM COMMA?
@BOX 5.0
ANY MIXING OF STRING AND NUMERIC
TYPES IN LHS ITEMS?
@BOX 6.0
NEXT ITEM NOT '='
@BOX 7.0
INPUT RHS EXPRESSION [07]
@BOX 8.0
RHS TYPE NOT COMPATIBLE WITH LHS
TYPE?
@BOX 9.0
CODE LET STATEMENT [07]
@BOX 10.0
END
@BOX 11.0
FAULT
@BOX 12.0
FAULT
@BOX 13.0
FAULT
@BOX 14.0
FAULT
@BOX 15.0
TOO MANY LHS ITEMS?
@BOX 16.0
FAULT
@BOX 17.0
LHS NOT JUST A SINGLE NAME
@BOX 18.0
DEF LET STATEMENT
@BOX 19.0
PROCESS DEF LET STATEMENT [BSC06.20.1]
@BOX 1.1
PROC TRANS.LET;
$IN [256] LHS;
$IN I, AP, LH.T, N0, RH.AP, N, RT, MN;
$IN T;
0 => I;
ITYPE ITEM;
0 => LH.T;
@BOX 2.1
IN.EXPR(%14) => LHS[I] => AP;
AS[AP] => N0 ->> 14 => T;
1 <<- T !> LH.T;
@BOX 3.1
IF N0 & %8F /= %81 /= %82
@BOX 4.1
IF LBUFF[1 +> IPTR] => ITEM = COMMA
@BOX 5.1
IF LH.T > 8
@BOX 6.1
IF ITEM /= EQUALS
@BOX 7.1
IN.EXPR(%4) => RH.AP;
@BOX 8.1
AS[RHAP] ->> 14 => T;
IF 1 <<- T ! LH.T > 8
@BOX 9.1
CODE.LET(^LHS,I,RH.AP);
@BOX 10.1
END
@BOX 11.1
MONITOR(%102D);
@BOX 12.1
MONITOR(%102E);
@BOX 13.1
MONITOR(%1000);
@BOX 14.1
MONITOR(%102F);
@BOX 15.1
IF 1 +> I >= 256
@BOX 16.1
MONITOR(%102C);
@BOX 17.1
IF LBUFF[IPTR + 2] /= EQUALS
@BOX 18.1
IF GET.N(LBUFF[IPTR+1]) => N < 0 THEN
   0 -:> N;
FI
IF N = DEF.N AND C.PROC.K = 2
   OR N = FUNCTION.N AND CPROC.K >= 2
@BOX 19.1
2 +> IPTR;
#BSC06.20.1
@E
///12
@TITLE BSC06.20.1(1,11)
@COL 1S-2R-3T-4R-5F
@COL 6R-7R
@ROW 4-6
@FLOW 1-2-3N-4-5
@FLOW 3Y-6-7-5
@BOX 1.0
PROCESS DEF LET STATEMENT
@BOX 2.0
NOTE RESULT ASSIGNED
@BOX 3.0
STRING RESULT?
@BOX 4.0
CODE EXPR IN A[BSC07]
PLANT A => RESULT VAIABLE
@BOX 5.0
EXIT
@BOX 6.0
RECOGNISE STRING EXPR [BSC07]
@BOX 7.0
ASSIGN STRING EXPRESSION VALUE
TO RESULT STRING [BSC07]
@BOX 1.1
::BSC06.20.1
@BOX 2.1
IF N = DEF.N THEN
   DEF.RES.MN => MN;
   4 !> RES.ASSIGNED;
ELSE
   8 !> RES.ASSIGNED;
   PU.RES.MN => MN;
FI
@BOX 3.1
IF T OF NLIST[N] => RT = BSTR
@BOX 4.1
EXPR(5, RT ->> 3);
TL.PL(%20, MN);
@BOX 5.1
EXIT;
@BOX 6.1
IN.EXPR(6) => AP;
@BOX 7.1
CODE.STR.EXPR(AP, MN);
@END
//17 22.JUL.83
@TITLE BSC06.21(1,11)
@COL 1S-2R-4T-5R-8T-6F
@COL 7R-9R
@ROW 6-7
@FLOW 1-2-4N-5-8N-6
@FLOW 4Y-7
@FLOW 8Y-9
@BOX 1.0
GET LABEL VALUE
@BOX 2.0
DECLARATIONS
@BOX 4.0
CURRENT ITEM NOT
INTEGER?
@BOX 5.0
GET LABEL VALUE
@BOX 6.0
END
@BOX 7.0
FAULT
@BOX 8.0
LABEL OUT OF RANGE
@BOX 9.0
FAULT
@BOX 1.1
PROC GET.LAB;
@BOX 2.1
$IN I;
@BOX 4.1
SELECT LBUFF[1+IPTR];
IF TAG/= TCONST OR
ST & %C7 /= %40
@BOX 5.1
1 +> IPTR;
INT.C OF CLIST[IND] => GET.LAB;
@BOX 6.1
END;
@BOX 7.1
MONITOR(%100D);
@BOX 8.1
IF GET.LAB > 99999
@BOX 9.1
MONITOR (%100E);
@E
///10
@TITLE BSC06.22(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
SRCH.CON.STK (KIND) INDEX
RESULT = -1 means required control
            entry not found
@BOX 2.0
SEARCH CONTEXT STACK FOR
REQUIRED CONTROL ENTRY
@BOX 3.0
END
@BOX 1.1
PROC SRCH.CONSTK(K);
$IN I;
@BOX 2.1
-1 => SRCH.CONSTK;
CON.PTR => I;
WHILE I > CON.BASE AND SRCH.CONSTK < 0 DO
   IF CON.STK[I] = K THEN
      I => SRCH.CONSTK;
   ELSE
      CON.SIZE[CON.STK[I]] -> I;
    FI
OD
@BOX 3.1
END
@END
///1
@TITLE BSC06.24(1,11)
@COL 1S-2T-3T-4R-5R-6R-7R-8F
@FLOW 1-2N-3N-4-5-6-7-8
@FLOW 2Y-7
@FLOW 3Y-5
@BOX 1.0
PROCESS.ELSE (CONTEXT.STACK.PTR)
@BOX 2.0
LABEL NOT REQUIRED FOR ELSE ?
@BOX 3.0
END LABEL ALREADY DECLARED ?
@BOX 4.0
DECLARE LABEL FOR END IF
@BOX 5.0
PLANT -> ENDIF LABEL
@BOX 6.0
DEFINE LABEL FOR ELSE
@BOX 7.0
UPDATE CONTEXT ENTRY TO SAY
ELSE NOT ALLOWED
@BOX 8.0
END
@BOX 1.1
PROC PR.ELSE (PTR);
$IN ELSE.LAB, ENDIF.LAB;
@BOX 2.1
IF CON.STK [PTR - 2]  => ELSE.LAB = 0
@BOX 3.1
IF CON.STK [PTR - 1]  => ENDIF.LAB > 0
@BOX 4.1
1 +> LAST.MN => CON.STK [PTR - 1]
           => ENDIF.LAB;
TL.LABEL.SPEC (NIL, 2);
@BOX 5.1
TL.PL (%4F, ENDIF.LAB);
@BOX 6.1
TL.LABEL (ELSE.LAB);
@BOX 7.1
-1 => CON.STK [PTR - 2];
@BOX 8.1
END
@END
///1
@TITLE BSC06.25(1,11)
@COL 1S-2T-3R-4T-5R-6F
@FLOW 1-2N-3-4N-5-6
@FLOW 2Y-4
@FLOW 4Y-6
@BOX 1.0
PROCESS.ENDIF (CONTEXT.STACK.PTR)
@BOX 2.0
ENDIF LABEL NOT REQUIRED ?
@BOX 3.0
DEFINE ENDIF LABEL
@BOX 4.0
ELSE LABEL NOT REQUIRED ?
@BOX 5.0
DEFINE ELSE LABEL
@BOX 6.0
END
@BOX 1.1
PROC PR.ENDIF (PTR);
$IN ELSE.LAB, ENDIF.LAB;
@BOX 2.1
IF CON.STK [PTR - 1] => ENDIF.LAB = 0
@BOX 3.1
TL.LABEL (ENDIF.LAB);
@BOX 4.1
IF CON.STK [PTR - 2] => ELSE.LAB =< 0
@BOX 5.1
TL.LABEL (ELSE.LAB);
@BOX 6.1
END
@END
///10
@TITLE BSC06.26(1,11)
@COL 8R
@COL 1S-2T-3T-4R-5R-7F
@COL 9R
@ROW 8-4-9
@FLOW 1-2N-3N-4-5-7
@FLOW 2Y-9-5
@FLOW 3Y-8-7
@BOX 1.0
PR.EXIT.COND () JUMP REQUIRED
   RESULT OF -1 : NO EXIT CONDITION
   OTHERWISE BITS 0-7 CONTAIN RESULT OF EXPR FOR
   COMPILATION OF RELATIONAL EXPRESSION
   - BIT 8 = 0/1 FOR UNTIL/WHILE
@BOX 2.0
NEXT ITEM WHILE ?
@BOX 3.0
NEXT ITEM NOT UNTIL ?
@BOX 4.0
NOTE UNTIL EXIT
@BOX 5.0
COMPILE RELATIONAL EXPRESSION
@BOX 7.0
END
@BOX 8.0
NOTE NO EXIT CONDITION
@BOX 9.0
NOTE WHILE EXIT
@BOX 1.1
PROC PR.EXIT.COND;
ITYPE ITEM;
@BOX 2.1
IF LBUFF [1 +> IPTR] => ITEM = DWHILE
@BOX 3.1
IF ITEM /= DUNTIL
@BOX 4.1
%0 => PR.EXIT.COND;
@BOX 5.1
EXPR (%3, 0) !> PR.EXIT.COND;
@BOX 7.1
END
@BOX 8.1
1 -> IPTR;
-1 => PR.EXIT.COND;
@BOX 9.1
%100 => PR.EXIT.COND;
@END
///9
@TITLE BSC06.28(1,11)
@COL 1S-3R-4F
@FLOW 1-3-4
@BOX 1.0
TRANS STOP ()
@BOX 3.0
PLANT CALL TO BIO.STOP
[BSC21]
@BOX 4.0
END
@BOX 1.1
PROC TRANS.STOP;
DATAVEC STOP.CODE ($LO16)
%48   %C00E    ::STACK LINK TO BIO.STOP
%42   %0       ::ENTER
END
@BOX 3.1
PL.CD.SEQ (^STOP.CODE);
@BOX 4.1
END
@E
///10
@TITLE BSC06.40(1,11)
@COL 1S-2T-3R-4R-5R-6F
@FLOW 1-2N-3-4-5-6
@FLOW 2Y-4
@BOX 1.0
INIT.GO.SUBS(LEVEL)
LEVEL 0/1 : PROGRAM UNIT/INTERNAL FUNCTION
@BOX 2.0
PROGRAM UNIT LEVEL ?
@BOX 3.0
SAVE GOSUB LABELS FOR PU ?
@BOX 4.0
DECLARE GOSUB LABEL VECTOR
        GOSUB POINTER
@BOX 5.0
PLANT A = 0
      A => GOSUB POINTER
@BOX 6.0
END
@BOX 1.1
PROC INIT.GOSUBS(LEV);
@BOX 2.1
IF LEV = 0
@BOX 3.1
GO.SUB.LABS => PU.GO.SUB.LABS;
GO.SUB.PTR => PU.GO.SUB.PTR;
@BOX 4.1
TL.S.DECL(NIL,%2C,GO.SUB.Z);
TL.S.DECL(NIL,%44,0);
LAST.MN + 1 => GO.SUB.LABS + 1 => GO.SUB.PTR
            => LAST.MN;
@BOX 5.1
BEGIN
DATAVEC CD.SEQ($LO16)
%46  %44
%22  %8008  ::A = 0
%20  %8007  ::A => GO.SUB.PTR
END
PL.CD.SEQ(^CD.SEQ);
END
@BOX 6.1
END
@END
///10
@TITLE BSC06.41(1,11)
@COL 1S-2T-3R-4F
@FLOW 1-2N-3-4
@FLOW 2Y-4
@BOX 1.0
END.GO.SUBS(LEVEL)
@BOX 2.0
END OF PROGRAM UNIT ?
@BOX 3.0
RESET GOSUB GLOBALS
FOR PROGRAM UNIT
@BOX 4.0
END
@BOX 1.1
PROC END.GO.SUBS(LEV);
@BOX 2.1
IF LEV = 0
@BOX 3.1
PU.GO.SUB.LABS => GO.SUB.LABS;
PU.GO.SUB.PTR => GO.SUB.PTR;
@BOX 4.1
END;
@END
///14
@TITLE BSC06.42(1,11)
@COL 1S-2T-3R-14R-4T-5R-6R-7R-8R-9R-10F
@COL 11R-12R-13R
@ROW 5-12
@ROW 3-11
@FLOW 1-2N-3-14-4N-5-6-7-8-9-10
@FLOW 2Y-11
@FLOW 4Y-12-13-6
@BOX 1.0
SELECT
COMPILES select-statement
@BOX 2.0
NEXT ITEM NOT CASE?
@BOX 3.0
RECOGNISE EXPRESSION [BSC07]
NOTE ITS TYPE
@BOX 4.0
SELECT EXPRESSION A STRING
@BOX 5.0
DECLARE NUMERIC VAR
PLANT
A = SELECT EXPR
A => SELECT EXPR VAR
@BOX 6.0
DECLARE LABEL FOR SELECTION CODE
PLANT JUMP TO SELECTION CODE
@BOX 7.0
ADD SELECT ENTRY TO CONTROL STACK
@BOX 8.0
ADD BLOCK STACK ENTRY
@BOX 9.0
NOTE NEXT STATEMENT
MUST BE CASE STATEMENT
@BOX 10.0
END
@BOX 11.0
FAULT
@BOX 12.0
DECLARE STRING VAR
@BOX 13.0
PLANT CODE TO ASSIGN
STRING EXPRESSION TO SELECT EXPR VARIABLE
@BOX 14.0
DECLARE LABEL FOR SELECTION
CODE
@BOX 1.1
PROC XSELECT;
$IN E.AP, ET, E.MN;
@BOX 2.1
IF LBUFF[1+>IPTR] /= D.CASE
@BOX 3.1
IN.EXPR(4) => E.AP;
AS[E.AP] ->> 11 & %1F => E.T;
@BOX 4.1
IF E.T = %18
@BOX 5.1
DECL.D(TL.TYP[E.T]) => E.MN;
CODE.EXPR(E.AP,E.T);
TL.PL(%20,E.MN);
@BOX 6.1
TL.PL(%4F, E.MN - 1);
@BOX 7.1
L.CASE.ITEM => CON.STK[1+>CON.PTR];
L.SEL.CONST => CON.STK[1+>CON.PTR];
L.SEL.STR => CON.STK[1+>CON.PTR];
0 => CON.STK[1+>CON.PTR];
0 => CON.STK[1+>CON.PTR];
E.T => CON.STK[1+>CON.PTR];
E.MN => CON.STK[1+>CON.PTR];
2 => CON.STK[1+>CON.PTR];
@BOX 8.1
1 +> BLK.NO => BLK.STK[1+>BLK.LEV];
@BOX 9.1
1 => CASE.ST;
@BOX 10.1
END;
@BOX 11.1
MONITOR(%1000);
@BOX 12.1
TL.S.DECL(NIL,%80,DEF.STR.Z+1);
1 +> LAST.MN => E.MN;
@BOX 14.1
TL.LABEL.SPEC(NIL, 1);
1 +> LAST.MN;
@BOX 13.1
CODE.STR.EXPR(E.AP,%4000 ! E.MN);
@END
///14
@TITLE BSC06.43(1,11)
@COL 11R
@COL 1S-2T-18T-3R-4T-5R-6T-7R-8T-17R-9R-16R-10F
@COL 12R-19T-13T-14R-15R
@ROW 3-12
@ROW 11-5
@ROW 7-13
@FLOW 1-2N-18N-3-4N-5-6N-7-8Y-9-16-10
@FLOW 2Y-12
@FLOW 18Y-19
@FLOW 4Y-11-7
@FLOW 6Y-13N-14
@FLOW 13Y-15-9
@FLOW 8N-17-7
@BOX 1.0
CASE
COMPILES case-statement
@BOX 2.0
TOP OF CONTROL STACK
NOT SELECT?
@BOX 3.0
DECLARE LABEL
FOR THIS case-block
@BOX 4.0
FIRST CASE BLOCK
@BOX 5.0
PLANT JUMP TO END OF
SELECT
@BOX 6.0
NEXT ITEM ELSE
@BOX 7.0
PROCESS CASE ITEM [BSC06.43.1]
@BOX 8.0
NEXT ITEM NOT ','
@BOX 9.0
INCREMENT BLOCK.NO
@BOX 10.0
END
@BOX 11.0
DECLARE LABEL FOR END
OF SELECT
@BOX 12.0
FAULT
@BOX 13.0
FIRST case-else-line FOR
THIS SELECT
@BOX 14.0
FAULT
@BOX 15.0
UPDATE CONTROL STACK WITH
LABEL FOR case-else-block
@BOX 16.0
DEFINE LABEL FOR THIS
case-block
@BOX 17.0
INCREMENT IPTR
@BOX 18.0
CASE ELSE ALREADY GIVEN
@BOX 19.0
FAULT
@BOX 1.1
PROC CASE;
$IN BLK.MN,T,NC1,NC2,R,I,F,M,N;
PSPEC CASE.ITEM.CONST()/$IN;
#BSC06.43.2
PSPEC CHECK($IN)/$IN;
#BSC06.43.3
@BOX 2.1
IF CON.STK[CON.PTR] /= 2
@BOX 3.1
TL.LABEL.SPEC(NIL,2);
1 +> LAST.MN => BLK.MN;
@BOX 4.1
IF CON.STK[CON.PTR-3] => T = 0
@BOX 5.1
TL.PL(%4F,T);
@BOX 6.1
IF LBUFF[1+IPTR] = D.ELSE
@BOX 7.1
#BSC06.43.1
@BOX 8.1
IF LBUFF[1+IPTR] /= COMMA
@BOX 9.1
1 +> BLK.NO => BLK.STK[BLK.LEV];
@BOX 10.1
END
@BOX 11.1
TL.LABEL.SPEC(NIL,2);
1 +> LAST.MN => CON.STK[CON.PTR-3];
@BOX 12.1
MONITOR.S(%103A,%"select-block");
@BOX 13.1
1 +> IPTR;
IF CON.STK[CON.PTR-4] = 0
@BOX 14.1
MONITOR(%1063);
@BOX 15.1
BLK.MN => CON.STK[CON.PTR-4];
@BOX 16.1
TL.LABEL(BLK.MN);
@BOX 17.1
1 +> IPTR;
@BOX 18.1
IF CON.STK[CON.PTR - 4] /= 0
@BOX 19.1
MONITOR(%1068);
@END
///14
@TITLE BSC06.43.1(1,11)
@COL 1S-2T-3R-4T-5R-13T-14R-6T-7R-8F
@COL 9T-10R-11R-12R
@ROW 3-9
@ROW 6-11
@ROW 7-12
@FLOW 1-2N-3-4N-5-13Y-6N-7-8
@FLOW 2Y-9N-10-6Y-12-8
@FLOW 9Y-11
@FLOW 4Y-6
@FLOW 13N-14-7
@BOX 1.0
PROCESS case-list
@BOX 2.0
NEXT ITEM 'IS'
@BOX 3.0
GET CONSTANT
[BSC06.43.2]
@BOX 4.0
NEXT ITEM NOT 'TO'
@BOX 5.0
GET CONSTANT
[BSC06.43.2]
@BOX 6.0
SEARCH CASE LIST FOR
OVERLAPPING CASE CONSTANT?
@BOX 7.0
UPDATE CASE LIST
@BOX 8.0
END
@BOX 9.0
NEXT ITEM NOT A
VALID RELATION?
@BOX 10.0
GET CONSTANT
[BSC06.43.2]
@BOX 11.0
FAULT
@BOX 12.0
FAULT
@BOX 13.0
SECOND CONSTANT OF RANGE GREATER THAN FIRST?
@BOX 14.0
FAULT
@BOX 1.1
::BSC06.43.1
DATAVEC CHK($LO16)
%1624 %0624     0   %24     3     6   %25
%0416     2     1     4     3     6     5
    0     1     0     0     0     0     0
  %16     6     0     0     6     6     0
  %25     5     0     4     0     0     5
  %24     4     0     4     0     0     4
  %13     3     0     0     3     6     0
END;
::0 -----    FAIL
:: otherwise elements of above encode as
:: Bits 0-3 specify relation
:: Bit  4 = 0/1  ----  OP1 =C1/C2
:: Bit  5 = 0/1  ---- OP2 = NC1/NC2
:: Bit  6 =   1  ---- OP1 = NC1
:: OK if OP1 relation OP2 is TRUE
:: Some elements contain 2 encodings
:: Bits 8-15 encoded as above - OK if either is TRUE
@BOX 2.1
IF LBUFF[1+>IPTR] = D.IS

@BOX 3.1
1 => R;
1 -> IPTR;
CASE.ITEM.CONST()=>NC1;
@BOX 4.1
IF LBUFF[1+IPTR] /= D.TO
@BOX 5.1
1 +> IPTR;
CASE.ITEM.CONST() => NC2;
0 => R;
@BOX 6.1
CON.STK[CON.PTR-7] => I;
0 => F
WHILE 1+>I =< L.CASE.ITEM AND F = 0 DO
IF CHK[R * 7 + REL OF CASE.ITEM[I]] => M = 0 THEN
   1 => F;
ELSE  IF M & %FF00 => N = 0 THEN
   CHECK(M) => F;
ELSE IF CHECK(M) /= 0 AND CHECK(N ->> 8) /= 0 THEN
   1 => F;
FI FI FI
OD
IF F /= 0
@BOX 7.1
BEGIN
SELECT CASE.ITEM[1+>L.CASE.ITEM];
R => REL;
NC1 => C1;
NC2 => C2;
BLK.MN => CASE.BLK.MN;
END
@BOX 8.1
::END
@BOX 9.1
IF TAG OF LBUFF [1+>IPTR] /= T.OP.NON.KEY
   OR IND OF LBUFF[IPTR] & %FF => R > 6
@BOX 10.1
CASE.ITEM.CONST() => NC1;
@BOX 11.1
MONITOR(%1000);
@BOX 12.1
MONITOR(%64);
@BOX 13.1
IF CHECK(%44) = 0
@BOX 14.1
MONITOR(%67);
@END
///14
@TITLE BSC06.43.2(1,11)
@COL 1S-2T-6R-3T-4R-5F
@COL 7R
@ROW 4-7
@FLOW 1-2N-6-3N-4-5
@FLOW 2Y-3
@FLOW 3Y-7
@BOX 1.0
CASE.ITEM.CONST
@BOX 2.0
NEXT ITEM A STRING CONSTANT?
@BOX 3.0
TYPE OF CONSTANT
INCOMPATIBLE WITH SELECT EXPRESSION TYPE?
@BOX 4.0
COPY CONSTANT TO SELECT CONSTANT LIST
AND CONVERT TYPE IF NECESSARY
@BOX 5.0
END
@BOX 6.0
GET SIGNED CONSTANT [BSC03]
@BOX 7.0
FAULT
@BOX 1.1
PROC CASE.ITEM.CONST;
$IN ST, CT, CI, ET, T, Z, I, E, C;
@BOX 2.1
IF TAG OF LBUFF[1+>IPTR] = TSTRING
@BOX 3.1
ST OF LBUFF[IPTR] => Z ->> 3 => CT;
IF TAG OF LBUFF[IPTR] => T = T.STRING THEN
   %18 => C.T;
FI
IND OF LBUFF[IPTR] => CI;
CON.STK[CON.PTR-2] => E.T;
IF E.T & %18 => E /= C.T & %18 => C
   AND [E = %18 OR C = %18 OR E = %8]
@BOX 4.1
IF E /= %18 THEN
   CLIST[C.I] => SEL.CONST [1+>L.SEL.CONST => CASE.ITEM.CONST];
   IF E = 0 AND C = %8 THEN
      INT.C OF SEL.CONST[L.SEL.CONST]
         => REAL.C OF SEL.CONST[L.SEL.CONST];
   FI
ELSE
   FOR I < Z + 1 DO
      STR.LIST[C.I+I] => SEL.STR[1+L.SEL.STR+I];
   OD
   L.SEL.STR + 1 => CASE.ITEM.CONST + Z => L.SEL.STR;
FI
@BOX 5.1
END
@BOX 6.1
1 -> IPTR;
GET.CONST();
@BOX 7.1
MONITOR(%1065);
@END
///14
@TITLE BSC06.43.3(1,11)
@COL 7R
@COL 1S-9R-2T-3T-4R-5R-6F
@COL 8R
@ROW 7-4-8
@FLOW 1-9-2N-3N-4-5-6
@FLOW 2Y-8-5
@FLOW 3Y-7-5
@BOX 1.0
CHECK(INFO)STATUS
@BOX 2.0
STRING CONSTANTS?
@BOX 3.0
REAL CONSTANTS?
@BOX 4.0
COMPARE INTEGERS
@BOX 5.0
SET FAULT STATUS IF
RELATION TRUE
@BOX 6.0
END
@BOX 7.0
COMPARE REALS
@BOX 8.0
COMPARE STRINGS
@BOX 9.0
DECODE INFO
@BOX 1.1
PROC CHECK (M);
$IN COMP, E.T, J, C1, C2, R;
$RE64 R1, R2;
$LO8 CH1, CH2;
@BOX 2.1
IF CON.STK [CON.PTR-2] => E.T = %18
@BOX 3.1
IF E.T & %18 = 0
@BOX 4.1
INT.C OF SEL.CONST[C1] - INT.C OF SEL.CONST[C2] => COMP;
@BOX 5.1
0 => CHECK;
ALTERNATIVE R-1 FROM
   COMP => CHECK;
   BEGIN IF COMP = 0 THEN 1 => CHECK FI END
   BEGIN IF COMP < 0 THEN 1 => CHECK FI END
   BEGIN IF COMP >=0 THEN 1 => CHECK FI END
   BEGIN IF COMP > 0 THEN 1 => CHECK FI END
   BEGIN IF COMP =<0 THEN 1 => CHECK FI END
END
@BOX 6.1
END
@BOX 7.1
IF REAL.C OF SEL.CONST[C1] => R1 >
       REAL.C OF SEL.CONST[C2] => R2 THEN
      1 => COMP;
ELSE IF R1 < R2 THEN
      -1=> COMP;
ELSE
      0 =>COMP;
FI FI
@BOX 8.1
-1 => J;
WHILE SEL.STR[1+>J+C1] => CH1 = SEL.STR [J+C2] => CH2 AND
             [CH1/= 0 OR CH2 /= 0]  DO OD
CH1 - CH2 => COMP;
@BOX 9.1
M & %F => R;
IF M & %10 = 0 THEN
   C1 OF CASE.ITEM[I] => C2;
ELSE
   C2 OF CASE.ITEM[I] => C2;
FI
IF M & %20 = 0 THEN
   NC1 => C1
ELSE
   NC2 => C1
FI
IF M & %40 /= 0 THEN
   NC2 => C2;
FI
@END
///14
@TITLE BSC06.44(1,11)
@COL 14R
@COL 1S-2T-16R-4R-3T-5R-6T-7R-8R-15R-9R-10R-11F
@COL 12R-13R
@ROW 3-12
@ROW 7-14
@FLOW 1-2N-16-4-3N-5-6N-7-8-15-9-10-11
@FLOW 2Y-12
@FLOW 3Y-13-8
@FLOW 6Y-14-8
@BOX 1.0
END.SELECT.LINE
COMPILE end-select-line
@BOX 2.0
CURRENT CONTROL STRUCTURE
NOT select-block?
@BOX 3.0
NO case-blocks?
@BOX 4.0
DEFINE LABEL FOR SELECTION CODE
@BOX 5.0
PLANT CASE-BLOCK SELECTION CODE
[BSC06.44.1]
@BOX 6.0
NO case-else-block?
@BOX 7.0
PLANT JUMP TO case-else-block
@BOX 8.0
RESET SELECT DATA STRUCTURES
@BOX 9.0
REMOVE CONTROL STACK ENTRY
@BOX 10.0
REMOVE BLOCK STACK ENTRY
@BOX 11.0
END
@BOX 12.0
FAULT
@BOX 13.0
FAULT
@BOX 14.0
PLANT EXCEPTION 10004
@BOX 15.0
DEFINE END OF SELECT
CODE LABEL
@BOX 16.0
PLANT JUMP TO END
OF SELECT CODE
@BOX 1.1
PROC END.SELECT.LINE;
$IN L, E.T, E.MN, FIRST, CASE, END.L, NEXT;
@BOX 2.1
IF CON.STK[CON.PTR] /=2
@BOX 3.1
IF END.L = 0
@BOX 4.1
TL.LABEL(CON.STK[CON.PTR-1] => E.MN - 1);
@BOX 5.1
#BSC06.44.1
@BOX 6.1
IF CON.STK[CON.PTR-4] => L = 0
@BOX 7.1
TL.PL(%4F,L);
@BOX 8.1
CON.STK[CONPTR-7] => L.CASE.ITEM;
CON.STK[CONPTR-6] => L.SEL.CONST;
CON.STK[CONPTR-5] => L.SEL.STR;
@BOX 9.1
8 -> CON.PTR;
@BOX 10.1
1 -> BLK.LEV;
@BOX 11.1
END;
@BOX 12.1
MONITOR.S(%103A,%"select-block");
@BOX 13.1
MONITOR(%66);
@BOX 14.1
EXCEPTION.L + 2 => G.LIT16.0;
PL.CD.SEQ(^CODE.EXCEPTION);
@BOX 15.1
IF END.L /= 0 THEN
   TL.LABEL(END.L);
FI
@BOX 16.1
IF CON.STK[CON.PTR -3] => END.L /= 0 THEN
   TL.PL(%4F, END.L);
FI
@END
///14
@TITLE BSC06.44.1(1,11)
@COL 12R
@COL 1S-2T-3T-4R-5T-6R-7R-8T-9R-10R-11R
@COL 13F-14R-15R
@ROW 3-13
@ROW 4-14
@ROW 12-6
@ROW 9-15
@FLOW 1-2N-3N-4-5N-6-7-8N-9-10-11-2Y-13
@FLOW 3Y-14-5Y-12-2
@FLOW 8Y-15-10
@BOX 1.0
PLANT case-block SELECTION CODE
@BOX 2.0
GET NEXT CASE ITEM
NO MORE ITEMS?
@BOX 3.0
NUMERIC SELECT VARIABLE?
@BOX 4.0
PLANT CODE TO COMPARE
CONST1 WITH SELECT STRING [BSC07]
@BOX 5.0
CASE ITEM WITH RELATION OR
SINGLE CONSTANT?
@BOX 6.0
DECLARE 'NEXT' LABEL
@BOX 7.0
PLANT IF <, -> 'NEXT'
@BOX 8.0
NUMERIC SELECT VARIABLE?
@BOX 9.0
PLANT CODE TO COMPARE
CONST2 WITH SELECT STRING [BSC07]
@BOX 10.0
PLANT IF =<, -> CASE.BLOCK
@BOX 11.0
DECLARE 'NEXT LABEL'
@BOX 12.0
PLANT IF RELATION, -> CASE.BLOCK
@BOX 13.0
END
@BOX 14.0
PLANT A = SELECT EXPR VAR
      A COMP CONST1
@BOX 15.0
PLANT A = SELECT EXPR VAR
      A COMP CONST2
@BOX 1.1
::BSC06.44.1
BEGIN
CON.STK[CON.PTR-2] => E.T;
CON.STK[CON.PTR-7] => CASE;
0 => FIRST;
@BOX 2.1
IF 1 +> CASE > L.CASE.ITEM
@BOX 3.1
SELECT CASE.ITEM[CASE];
IF E.T /= %18
@BOX 4.1
PL.STR.COMP(E.MN ! FIRST,^SEL.STR,C1);
%4000 => FIRST;
@BOX 5.1
IF REL > 0
@BOX 6.1
TL.LABEL.SPEC(NIL,2);
@BOX 7.1
TL.PL(%4C, 1+> LAST.MN => NEXT);
@BOX 8.1
IF E.T /= %18
@BOX 9.1
PL.STR.COMP(E.MN ! %4000, ^SEL.STR, C2);
@BOX 10.1
TL.PL(%4D, CASE.BLK.MN);
@BOX 11.1
TL.LABEL(NEXT);
@BOX 12.1
TL.PL(REL+%48,CASE.BLK.MN);
@BOX 13.1
END
@BOX 14.1
SET.A.TYPE(E.T);
TL.PL(%22, E.MN);
DECL.ARITH.CONST(^SEL.CONST[C1], E.T);
TL.PL(%2F,0);
@BOX 15.1
TL.PL(%22,E.MN);
DECL.ARITH.CONST(^SEL.CONST[C2],E.T);
TL.PL(%2F,0);
@END

