@X @~
~L3 COUK1247
80
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H             BSC041
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL
~
~
                                                           ISSUE 11~
~V9 -1
~P
~V9 1
~YBSC041
~S~M~OBASIC COMPILER IMPLEMENTATION DESCRIPTION
~S~M~OSection 4
~S~OSection 4. Declaration Statement Processing
~S~O1.1 General Description
~BThis section of the compiler deals with the processing of declarative statemen
ts
and implicit declarations of variables and procedures.  A set
of property list information is built up.
~S~O2. Interfaces
~S~O2.1 Section Interfaces Used
~
   Section 1 :   (Statement Driver)~
   Section 2 :   (Configuration Section)~
   Section 3 :   (Lexical Analysis)~
   Section 6 :   (Imperative Statement Processing)~
   Section 8 :   (Name List Management)~
   Section 9 :   (Fault and Reference Point Monitoring)~
~S~O2.2 Section Interface
~
Exported Scalars:~
   LASTMN~
   CURRES~
   CUR.PROC~
   M.ONE~
   ZERO~
   ONE~
~
Exported Vectors:~
   PARAMS~
   ARRAYS~
~Q 4
~
Exported Procedures:~
   DECL.PROC~
   DECL.IMP.PROC~
   DECL.VAR~
   DECL.DIM~
   DECL.LAB~
   DECLARE~
   ADD.X.PROC~
   PROC.HEAD~
   END.ST~
   COMP.TYPE~
   FIND~
   CHECK.TYPE~
   INIT.S4~
   DECL.NUM.CONST~
   DECL.STR.CONST~
~
Exported Literals:~
   KVAR~
   KVEC~
   KMAT~
   KCONST~
   KSUB~
   KFN~
   KEXFN~
   KEXSUB~
~
Configuration Parameters:~
   PARAMSZ~
   ARRAYSZ~
~S11) DECL.PROC(KIND)
~BDeclares a specification to MUTL for a procedure
by the DEF, FUNCTION
or SUB statements, depending
of the value of KIND.~
~3
~T# 24
~
#KIND  =  1  SUB~
#         2  DEF~
#         3  FUNCTION~
~0
~S12) DECL.VAR(INTID,DIM,KIND)PN
~BThis procedure takes the internal identifier INTID and returns
its property index (declaring the variable implicitly
if necessary) or zero if the
name is a function name.  DIM is the number of dimensions of the
variable - 0 (scalar), 1 (vector), 2 (matrix).  KIND is bit
significant and dictates the action taken should there by any
discrepancy in the size or type of the object as follows:-~
~3
~
   KIND  Bit 0 = 1  means fault if real~
             1 = 1  means fault if integer~
             2 = 1  means fault if string~
             3 = 1  means allow function names~
             4 = 1  means allow dimension fault~
~0
~S13) DECL.DIM()
~BDeals with the DIM statement, declaring each array a size which has been speci
fied
by its subscripts.
~S14) DECL.LAB()
~BDefines the current item in LBUFF as a label.
~S15) DECLARE(KIND)
~BDeals with the DECLARE statement for KIND=0 or the EXTERNAL
statement for KIND=%8008.  All names are declared to MUTL, except in the case of
FUNCTIONs in the DECLARE statements, when type information is
stored in NLIST.
~S16) ADD.X.PROC(INTID)TL.NAME
~BThis procedure searches libraries already open for
the external procedure, known internally to the compiler by INTID.
The MUTL name of the procedure is returned, with property list information
stored in PLIST, otherwise zero if the procedure is not found.
~S17) PROC.HEAD(PROCN,SUB.OR.FN)
~BThis procedure whose MUTL name is PROCN is defined as follows:~
~3
~
#SUB.OR.FN = 0 SUB~
#            1 DEF~
#            2 FUNCTION~
~0
~
PROC.HEAD puts a proc entry on CON.STK and declares the procedure begin
to MUTL.  The CONSTK entry consists of the following global variables:~
~3
~
#CURGLB~
#CURLEV~
#CURRES~
#CURPROC~
#CURBLK~
#GLEV~
#LASTN~
#LASTCH~
#4,5,6     (SUB,DEF,FUNCTION)~
~0
~BThe variable ERROR.PTR is incremented and the current
ERROR.HANDLER initialised to zero (system error handling).
~S18) END.ST()
~BProcesses END statements.
~S19) COMP.TYPE()TYPE
~BComputes the type of the current item.
~S110) DECL.IMP.PROC(IND,^[PARAM.TYPES])TLNAME
~BThis procedure declares the procedure known internally
by IND to MUTL.  PARAM.TYPES is a bounded pointer to a vector
containing the following:~
~3
~
   Element [0]      :-  n, the number of parameters~
           [1->n]   :-  MUTL type of each parameter~
           [n+1]    :-  if non-zero, MUTL type of result.~
~0
~S111) CHECK.TYPE(ENTITY.TYPE,REQD.TYPE)OK
~BChecks the compatibility of the two types, returning 0 for compatible,
-1 for faulty.
~S112) INIT.S4()
~BInitialises the data structures of this module.
~S113) DECL.NUM.CONST(CONST.TYPE,CONST.PTR)TL.NAME
~BThis procedure declares to MUTL a constant of the type
specified by P1.   If bit 15=1 then a MUTL name is allocated
for the constant otherwise the constant is passed to MUTL as the current
literal.  P2 is a pointer to a CLIST.E item containing the
constants value.
~S114) DECL.STR.CONST(STR.SIZE,STR.LIST.INDEX)TL.NAME
~BThis procedure declares a character string to MUTL as an
in-code vector of bytes.  P2 is an index into STR.LIST to
the start of the character string value and P1 specifies
the byte counts less one for the string.
~S~O3. Implementation
~S~O3.1 Outline of Operation
~S~O3.2 Data Structures
~3
~T# 18
~
PARAMS~IThis vector of bytes contains the specifications for
user defined procedures.  It is indexed by the DETAIL field of a NLIST entry for
 a
procedure specification.~
~
PARAMSZ~INumber of elements in PARAMS.~
~
ARRAYS~IThis is vector of integers containing additional array
properties to that in NLIST entry.  It is indexed by the DETAIL field
of an NLIST entry.  The general format of an entry is:~
~T# 18 37
~
#~IString element size (non-parametric procs only)~
#DETAIL index ---->~IMUTL name of first select variable~
#~Iallocated for first element of array descriptor.  2 MUTL names
are allocated for a vector, and 4 for a matrix.~
~T# 31
~IInitial lower bound of first dimension (non-parametric arrays only)~
~IInitial upper bound of first dimension~
~IInitial lower bound of second dimension (non-parametric matrix only)~
~IInitial upper bound of second dimension.~
~T# 18
~
ARRAYS.Z~INumber of elements in ARRAYS~
~
LAST.A~IIndex to last element used in ARRAYS.~
~
LASTP~IIndex to the last used entry in PARAMS.~
~
OPTION~ISpecifies currently selected BASIC options~
~IBit  0 = 0/1 ANGLE RADIANS/DEGREES~
~IBit  1 = 0/1 ARITHMETIC DECIMAL/NATIVE~
~IBit  2 = 0/1 COLLATE STANDARD/NATIVE~
~IBit  3 = 0/1 BASE         0/1~
~
~IBit  8 = 1   ANGLE option given in this PU~
~IBit  9 = 1   ARITHMETIC option given in this PU~
~IBit 10 = 1  COLLATE option given in this PU~
~IBit 11 = 1  BASE option given in this PU~
~
PROCLEV~IIndicates the textual level (initially 0),
only values 0, 1 and 2 used.~
~
CPROC.K~IKind of current procedure, 0 means main program unit,
1 means internal function,
otherwise KSUB or KFN as in K of NLISTENT.~
~
CURPROC~IIndex into NLIST of the procedure whose body is currently
being compiled (or -1 if none).~
~
CUR.RES~IMUTL name of result variable for current procedure.~
~
PROC.CODE.MN~IMUTL name of label declared at start of current
procedure (or main program) code body.~
~
FIRST.PAR.N~IValue of LAST.N before and after processing of~
LAST.PAR.N~Iparameter list of current procedure.~
~
PU.LOCAL.N~IValue of LAST.N immediately after processing procedure
statement (or at start of main p.u), i.e. before any local names declared.~
~
PU.N~IValues of LAST.N, LAST.CH, LAST.P and LAST.MN,~
PU.CH~Irespectively at start of current program unit.~
PU.PAR~
PU.MN~
~
PU.PROC~IThese variables are set on entry to textual level~
PU.PROC.K~I2 (i.e. Basic internal function) from CUR.PROC,~
PU.RES~ICUR.PROC.K, CUR.RES, PROC.CODE.MN respectively and~
PU.PROC.CODE.MN~Iused to reset them on exit from textual level 2.~
~
INT.FN.N~IValues of LAST.N and LAST.MN at start of current~
INT.FN.MN~Iinternal function.~
~
~
M.ONE~IMUTL names of dummy literals for the values -1, 0, 1.~
ZERO~
ONE~
~0
~S~MProcedure specification encoding.
~BThe specification of user defined procedures are maintained in
PARAMS, while the specification of Basic supplied functions are
contained in data structures of section 7.  However the encoding
of both specifications is the same and consists of a byte sequence.
The first byte gives the result specification, the second byte
specifies the number of parameters, this is followed by a list of
bytes, one for each parameter.  The result and parameter bytes
are encoded as follows:~
~3
~T# 14
~
Bits 0 - 2~I0  scalar value~
~I1  1-D array value~
~I2  2-D array value~
~I3  channel~
~I4  constant~
~
Results are limited to scalar value results.~
~
Bits 6, 7~IData type where appropriate~
~I0  Real~
~I1  Integer~
~I2  Reserved for logical data type~
~I3  String~
~
Bits 3 - 5~ISize of numeric type~
~I0 -  8bit~
~I1 - 16bit~
~I2 - 32bit~
~I3 - 64bit~
~
In addition there are these special encodings~
~
~I%FE  Array with any number of dimensions.~
~0
~Y
~V9 -1
~P
~D15
~HFLOWCHARTS
~
~
~H                BSC041
~V9 -1
~F
///17 22.JUL.83
@TITLE BSC04(1,11)
@COL 1S-2R-3R-4R-5R-6F
@FLOW 1-2-3-4-5-6
@BOX 1
DECLARATIVE STATEMENT
PROCESSING SECTION
@BOX 2.0
TYPE DECL
@BOX 3.0
VARIABLE DECLS
@BOX   4.0
PROCEDURES IN THIS MODULE:
DECLARE [BSC04.1]
DECL.PROC [BSC04.2]
UNDEF.PROCS[BSC04.4]
PR.ARRAY.DECL[BSC04.5]
DECL.DIM [BSC04.6]
TRANS.OPTION [BSC04.7]
DECL.LAB [BSC04.9]
END.ST [BSC04.10]
COMP.TYPE [BSC04.11]
CHECK.TYPE [BSC04.12]
DECL.NUM.CONST [BSC04.13]
IMPL.S.VAR [BSC04.15]
READ.DATA.TYPE [BSC04.16]
DECL.TL.SPEC [BSC04.17]
DECL.TL.S.VAR [BSC04.18]
GET.TYPED.NAME [BSC04.19]
INIT.PU.LEV [BSC04.20]
DECL.D [BSC04.21]
INIT.INT.FN.LEV [BSC04.22]
LENGTH [BSC04.23]
END.PU.LEV [BSC04.24]
END.INT.FN.LEV [BSC04.25]
INIT.PROG [BSC04.26]
@BOX 5.0
INITIALISATION PROC
@BOX 6.0
END
@BOX 1.1
#BSC04/1
MODULE(DECL.PROC,PROC.HEAD,END.ST,B.INT,B.RE,OPTIONS,TRANS.OPTION,
DECLARE,DECL.DIM,IMPL.S.VAR,DECL.LAB,DECL.NUM.CONST,
DEF.BASE,PARAMS,COMP.TYPE,CHK.PSPEC,DECL.D,ARRAYS,DECL.TL.PSPEC,
LASTMN,PU.RES.MN,DEF.RES.MN,CURPROC,CHECK.TYPE,CPROC.K,PU.PROC.K,UNDEF.PROCS,
RES.ASSIGNED,PU.POSTLUDE,DEF.POSTLUDE,PU.POSTLUDE.VAR,FUNCTION.N,DEF.N,
PROCLEV,EVAL.LIT,DECL.IMP.PROC,INIT.S.4,C.EXIT.LAB,INIT.PROG,PU.N);
@BOX 2.1
@BOX 3.1
*GLOBAL 5;
$LI/$RE64 DEGREES.L = 57.2957795131,
         RADIANS.L = 0.017453292519943,
         PI.L = 3.141592653589793,
         PIBY2.L = 1.570796326794896;
$LI/ADDR [$LO8] NIL = ;
$LO8[6] DATA.TYPE;
$LO8 [PARAMSZ] PARAMS;
$IN [ARRAYS.Z] ARRAYS;
$IN PU.N,PU.MN,PU.PROC.CODE,C.EXIT.LAB;
$IN PU.RES,PU.PROC.K,PU.PROC,PU.PROC.CODE.MN,DEF.PROC.CODE.MN;
$IN DEF.FIRST.PAR.N,DEF.LAST.PAR.N,LAST.P,GL.LASTP,LAST.A;
$IN B.INT, B.RE;
$IN PU.FIRST.PAR.N, PU.LAST.PAR.N;
$IN LASTMN,PU.RES.MN,DEF.RES.MN,CURPROC,DEF.BASE,RES.ASSIGNED;
$IN PROCLEV,CPROC.K,GL.PROC.IND;
$LO16 PSPEC.N,PSPEC.CNT;
$LO16 DEF.POSTLUDE, DEF.PRELUDE;
$LO16 PU.POSTLUDE,PU.PRELUDE,PU.POSTLUDE.VAR,FUNCTION.N,DEF.N;
$IN EX.SUB,EX.FN;
$IN OPTIONS;
*GLOBAL 0;
@BOX 4.1
$PS DECL.PROC($IN);
$PS DECL.DIM();
$PS PR.ARRAY.DECL($IN,$IN,$IN);
$PS IMPL.S.VAR($IN);
$PS DECL.LAB()/$IN;
$PS END.ST($IN);
$PS CHECK.TYPE($IN,$IN)/$IN;
$PS DECL.NUM.CONST ($IN, ADDR CLISTE) / $IN;
$PS COMP.TYPE($IN)/$IN;
$PS DECLARE();
$PS UNDEF.PROCS();
$PS TRANS.OPTION();
$PS READ.DATA.TYPE()/$LO;
$PS DECL.TL.PSPEC($IN,ADDR[$LO8]);
$PS DECL.TL.S.VAR($IN,$LO8,$LO8);
$PS GET.TYPED.NAME($IN)/$IN;
$PS DECL.D($IN)/$IN;
$PS INIT.PU.LEV();
$PS INIT.INT.FN.LEV();
$PS LENGTH()/$IN;
$PS END.PU.LEV();
$PS END.INT.FN.LEV();
$PS INIT.PROG();
#BSC04.1
#BSC04.2
#BSC04.4
#BSC04.5
#BSC04.6
#BSC04.7
#BSC04.9
#BSC04.10
#BSC04.11
#BSC04.12
#BSC04.13
#BSC04.15
#BSC04.16
#BSC04.17
#BSC04.18
#BSC04.19
#BSC04.20
#BSC04.21
#BSC04.22
#BSC04.23
#BSC04.24
#BSC04.25
#BSC04.26
@BOX 5.1
$PS INIT.S4();
$PR INIT.S4;
$IN I,J;
0 => CPROC.K;
0  => PROCLEV;
0 => LAST.P;
PARAMS.Z => GL.LASTP;
TLCLIT32(%40,-1);
TLLIT(NIL,0);
TLCLIT32(%40,0);
TLLIT(NIL,0);
TLCLIT32(%40,1);
TLLIT(NIL,0);
TL.C.NULL(%83);
TL.LIT(NIL, 0);
TLCLIT64(%1C,RADIANS.L);
TL.LIT(NIL,0);
TLCLIT64(%1C,DEGREES.L);
TL.LIT(NIL,0);
TL.CLIT64(%1C,PI.L);
TL.LIT(NIL,0);
TL.CLIT64(%1C,PIBY2.L);
TL.LIT(NIL,0);
0 => PSPEC.CNT;
%48 => DATA.TYPE[0];
%50 => DATA.TYPE[1];
B.INT => DATA.TYPE[2];
B.RE => DATA.TYPE[3];
BSTR => DATA.TYPE[4];
B.RE => DATA.TYPE[5];
TL.TYPE(NIL,0);
TL.TYPE.COMP(%83,0,NIL);
TL.TYPE.COMP(%44,0,NIL);
TL.TYPE.COMP(%44,0,NIL);
TL.END.TYPE(0);
TL.TYPE(NIL, 0);
TL.TYPE.COMP(%80, 0, NIL);
TL.TYPE.COMP(%83, 0, NIL);
TL.TYPE.COMP(TADDR, 0, NIL);
TL.TYPE.COMP(TADDR, 0, NIL);
TL.TYPE.COMP(TADDR ! 3, 0, NIL);
TL.TYPE.COMP(%44, 0, NIL);
TL.END.TYPE(0);
TL.S.DECL(NIL, %80, -1);
TL.ASS(12, -1);
TL.CLIT.16(%80, 0);
TL.ASS.VALUE(0, 2);
TL.ASS.END();
TL.LABEL.SPEC(NIL,1);
13 => LAST.MN => C.EXIT.LAB;
$EN
@BOX 6.1
*END
@END
///16
@TITLE BSC04/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 5.1
$PS GET.TEMP($IN,$IN)/$LO16;
$PS LAB ($LO32, $IN) / $LO16;
$PS GET.LAB () / $LO32;
$PS INIT.GOSUBS($IN);
$PS END.GOSUBS($IN);
$PS IMPL.TYPE ($IN)/$LO8;
$PS TRANS.NEXT();
$PS TRANS.STOP();
$PS MONITOR($IN);
$PS MONITOR.N($IN,$IN);
$PS MONITOR.I($IN, $IN16);
$PS MONITOR.S($IN,ADDR[$LO8]);
$PS MONITOR.P($IN, $IN);
$PS GENN($LO16)/ADDR[$LO8];
$PS ADD.NLIST ()/$IN;
$PS ITEMISE();
$PS INIT.LABS();
$PS END.LABS();
$PS SET.A.TYPE($IN);
$PS PL.CD.SEQ(ADDR [$LO16]);
$PS PL.STK.LB($IN);
$PS IN.EXPR($IN)/$IN;
$PS CODE.EXPR($IN,$IN)/$IN;
$PS CODE.STR.EXPR($IN,$IN);
$PS PL.XH.CODE();
$PS PL.XH.PRE.CODE();
$PS PL.XH.POST.CODE();
@BOX 4.1
$LA CEXIT;
$TY CLIST.E IS $IN32 INT.C
            OR $RE64 REAL.C;
$TY ITYPE IS $LO8 TAG,ST $LO16 IND;
PSPEC GETN(ITYPE)/$IN;
ITYPE LB,COMMA,RB,EQUALS,EOS,D.DEF,D.FUNCTION,D.SUB,AST,
      D.DEGREES,D.RADIANS,D.NATIVE,D.DECIMAL,D.COLLATE,
       D.ARITHMETIC,D.BASE,D.ANGLE,D.STANDARD,
     HASH.D, PLUS,MINUS,D.TO,D.NUMERIC;
$IN CONPTR,CON.BASE,IPTR,MSTR,
DATA.MN,LASTB,RESTORE.DV.MN;
$IM $LI ZERO;
$IM $LI $LO16 ONE;
$IN LAST.R, LAST.T,BLK.NO,BLK.LEV;
$IM $LI CONSTKZ,PARAMSZ,ARRAYS.Z,CON.Z,DATA.B.Z,RESTORE.B.Z;
$IN [CONSTKZ] CONSTK;
$LO8[32] TL.TYP;
$LO8[CON.Z]CON.SIZE;
$LO8 [DATA.B.Z] DATA.B;
$LO16 [RESTORE.B.Z] RESTORE.B;
$IM $LI CHLISTZ, BLK.Z, AS.Z;
$LO8 [CHLISTZ] CHLIST;
$LO16[BLK.Z] BLK.STK;
$IN16[AS.Z] AS;
$IM $LI LBUFFZ;
ITYPE [LBUFFZ] LBUFF;
$IM $LI TDELIM,TCONST,TNAME;
$IM $LI NLISTZ;
$TY NLIST.ENT IS $LO16 BASICN,HASH,MUTLN,DETAIL,DETAIL1 $LO8 K,T;
NLIST.ENT[NLISTZ] NLIST;
$IN LASTN,LASTCH, GL.LASTCH;
$IM $LI KUNDEF,KMAT,KVAR,KVEC,KSUB,KFN,KFNSUB,KCONST,KINV,K.XH;
$IM $LI BSTR;
$IM $LI TTYPE,TADPROC,TSTR,TRE32,TRE64,TIN16,TIN32,TLO8,TLAB,TADDR;
$IM $LI CLISTZ,STR.LISTZ;
CLIST.E [CLISTZ] CLIST;
$LO8 [STR.LISTZ] STR.LIST;
$IN LAST.L, LAST.XH, PROT.ST, IN.XH, CUR.XH.ID, PU.LAST.L,XH.SW.MN,EXIT.XH.LAB.M
N;
$IN MAXMUTLN,MAXN,MAXCH,RECOVERY,STAT.LAST.N;
$LO16 CD.MN.0, G.LIT16.0;
$IM $LI DEF.STR.Z;
$IM $LI $LO8  BIO.END.RUN.FN,BIO.CLOSE.ALL.FN;
$IN L.CASE.ITEM, L.SEL.CONST, L.SEL.STR;
@END
///7
@TITLE BSC04.1(1,11)
@COL 1S-3R-4T-5T-2T-6R-9T-7R-10R-21T-15R-16T-17T-11T-12R-13F
@COL 19R-8R-18T-20R-14C-22R
@ROW 10-14
@ROW 5-19
@ROW 6-8
@FLOW 1-3-4N-5N-2N-6-9N-7-10-21N-15-16N-17N-11N-12-9Y-18N-20-7
@FLOW 5Y-8-9
@FLOW 16Y-13
@FLOW 8-9
@FLOW 17Y-9
@FLOW 11Y-9
@FLOW 2Y-14
@FLOW 18Y-14
@FLOW 4Y-19-9
@FLOW 21Y-22-15
@BOX 1.0
PROCESS DECLARE STATEMENT
@BOX 2.0
DATATYPE NOT PRESENT?
@BOX 3.0
READ OPTIONAL DATA TYPE[
@BOX 4.0
NEXT ITEM NUMERIC
@BOX 5.0
NEXT ITEM 'FUNCTION'?
@BOX 6.0
SET KIND AS VARIABLE
SET DEFAULT STRING SIZE
@BOX 7.0
GET NAME[03]
@BOX 8.0
SET KIND TO FUNCTION
@BOX 9.0
NEXT ITEM *?
@BOX 10.0
GET IMPLICIT TYPE
SET TYPE IF NECESSARY
@BOX 11.0
NOT A DATATYPE?
@BOX 12.0
READ IN DATA TYPE
@BOX 13.0
END
@BOX 14.0
SYNTAX FAULT
@BOX 15
PROCESS ACCORDING TO KIND
VARIABLE [04.1.1]
FUNCTION [04.1.3]
@BOX 16
NEXT ITEM NOT ','
@BOX 17
NOT DECLARING VARIABLES?
@BOX 18.0
NOT A STRING VARIABLE
@BOX 19.0
NOTE NUMERIC ARRAYS ONLY
@BOX 20.0
SET STRING LENGTH
[04.23]
@BOX 21.0
INCONSISTENT USE OF DATATYPE
@BOX 22.0
FAULT
@BOX 1.1
PROC DECLARE;
$IN V.IN,KIND,STR.Z,V.STR.Z,IN,NEW.IN,MTLN,SZ;
$LO8 CH,TYP,IM.TYP,EX.TYP;
ITYPE ITEM;
@BOX 2.1
IF TYP = 0
@BOX 3.1
IF TAG OF LBUFF[1+>IPTR] = T.TYPE  THEN
   DATA.TYPE[IND OF LBUFF[IPTR] & %FF] => TYP => EX.TYP;
ELSE
   1 -> IPTR;
   0 => TYP => EX.TYP;
FI
@BOX 4.1
IF L.BUFF[1+>IPTR] => ITEM = D.NUMERIC
@BOX 5.1
IF ITEM = D.FUNCTION
@BOX 6.1
1 -> IPTR;
DEF.STR.Z => STR.Z;
KVAR => KIND;
@BOX 7.1
GETN(LBUFF[1+>IPTR])=>IN => V.IN;
IF IN < 0 THEN
   0 - IN => IN;
FI
@BOX 8.1
KFN=>KIND;
@BOX 9.1
IF LBUFF[1+IPTR] = AST
@BOX 10.1
IMPL.TYPE(IN) => IM.TYP;
IF EX.TYP = 0 THEN
   IM.TYP => TYP;
FI
@BOX 14.1
MONITOR(%1000);
@BOX 15.1
SELECT NLIST[IN];
IF KIND = KVAR OR KIND = KMAT THEN
   #BSC04.1.1
ELSE
   #BSC04.1.3
FI
@BOX 16.1
IF LBUFF [IPTR+1] /= COMMA
@BOX 17.1
1 +> IPTR;
IF KIND /= KVAR
@BOX 11.1
IF TAG OF LBUFF[IPTR+1] /= T.TYPE
@BOX 12.1
1+>IPTR;
DATA.TYPE[IND OF LBUFF[IPTR] & %FF] => TYP => EX.TYP;
@BOX 13.1
END;
@BOX 18.1
IF TYP /= BSTR
@BOX 19.1
KMAT => KIND;
@BOX 20.1
LENGTH() => STR.Z;
@BOX 21.1
IF TYP /= 0 AND
   [[TYP = BSTR AND IM.TYP /= BSTR] OR
    [TYP /= BSTR AND IM.TYP = BSTR]]
@BOX 22.1
MONITOR.N(%11,IN);
@END
///6
@TITLE BSC04.1.1(1,11)
@COL 13R-10R
@COL 1S-2R-3T-14T-15R-12T-4T-5T-7R-16T-17R-8R-9F
@COL 11R
@ROW 10-8
@ROW 13-4
@ROW 4-11
@FLOW 1-2-3N-14N-15-12N-4N-5N-7-16N-17-9
@FLOW 3Y-11-9
@FLOW 4Y-16Y-8-9
@FLOW 5Y-10
@FLOW 14Y-12Y-13-9
@BOX 1.0
DECLARE VARIABLE
@BOX 2.0
SET VAR STRING SIZE
@BOX 3.0
NEXT ITEM (
@BOX 4.0
NEXT SYMBOL NOT *
@BOX 5.0
NOT STRING TYPE
@BOX 7.0
SET STRING SIZE
[04.23]
@BOX 8.0
DECLARE VARIABLE TO MUTL
[04.18]
@BOX 9.0
END
@BOX 10.0
SYNTAX FAULT
@BOX 11.0
PROCESS ARRAY DECLARATION
[04.5]
@BOX 12.0
IDENTIFIER NOT ALLOWED AS A SIMPLE
VARIABLE
@BOX 13.0
FAULT
@BOX 14.0
NOT NUMERIC DECLARE
@BOX 15.0
FAULT
@BOX 16.0
VARIABLE NOT DEFINED
@BOX 17.0
FAULT
@BOX 1.1
::DECLARE VARIABLE
@BOX 2.1
STR.Z => V.STR.Z;
@BOX 3.1
IF LBUFF[1+IPTR] => ITEM = LB
@BOX 4.1
IF ITEM /= AST
@BOX 5.1
IF TYP /= BSTR
@BOX 7.1
LENGTH() => V.STR.Z;
@BOX 8.1
DECL.TL.S.VAR(IN,TYP,V.STR.Z);
@BOX 9.1
::END
@BOX 10.1
MONITOR(%1000);
@BOX 11.1
PR.ARRAY.DECL(IN,TYP,STR.Z);
@BOX 12.1
IF VIN < 0
@BOX 13.1
MONITOR.N(%14, IN);
@BOX 14.1
IF KIND /= KMAT
@BOX 15.1
MONITOR(%15);
@BOX 16.1
IF K OF NLIST[IN] = KUNDEF
@BOX 17.1
MONITOR.N(%16,IN);
@END
///15
@TITLE BSC04.1.3(1,11)
@COL 11R
@COL 1S-5T-6T-7T-8R-9R-10F
@COL 12R
@ROW 11-9-12
@FLOW 1-5N-6N-7Y-9-10
@FLOW 5Y-11-10
@FLOW 6Y-12-10
@FLOW 7N-8-9
@BOX 1.0
DECLARE FUNCTION
@BOX 5.0
ENTITY KIND NOT YET DEFINED?
@BOX 6.0
PROPERTIES EXIST AT PROGRAM UNIT LEVEL?
@BOX 7.0
KIND AND TYPE IDENTICAL
@BOX 8.0
FAULT
ALLOCATE NEW PROPERTIES
@BOX 9.0
COPY PROPERTIES TO PROGRAM UNIT LEVEL
@BOX 10.0
END
@BOX 11.0
SET UP PROPERTIES
@BOX 12.0
FAULT
@BOX 1.1
::DECLARE FUNCTION
@BOX 5.1
IF K = KUNDEF
@BOX 6.1
::END
@BOX 6.1
IF IN > PU.N
@BOX 7.1
IF K = KFN AND T = TYP
@BOX 8.1
MONITOR(%53);
ADD.NLIST() => NEWIN;
KFN => K OF NLIST [NEWIN];
TYP => T OF NLIST[NEWIN];
BASIC.N => BASIC.N OF NLIST[NEW.IN];
HASH => HASH OF NLIST[NEW.IN];
@BOX 9.1
ADD.NLIST() => NEW.IN;
@BOX 10.1
::END
@BOX 11.1
KFN => K;
TYP => T;
%400 !> DETAIL1;
@BOX 12.1
MONITOR(%54);
@END
///16 22.JUL.83
@TITLE BSC04.2(1,11)
@COL 19R
@COL 1S-3R-4R-39T-40R-5T-6T-7R-8R-9T-10T-11T-12R-36T-37T-38R-15R-35R-41R-2R-16T-
17R-18F
@COL 23T-24T-25C-26T-27C-28R-29R-30T-31R-32T-33R-34C
@ROW 19-8
@ROW 7-23
@ROW 20-14
@FLOW 1-3-4-39N-40-5N-6N-7-8-9N-10N-11N-12-36N-37N-38-15-35-41-2-16N-17-18
@FLOW 5Y-19-12
@FLOW 39Y-5
@FLOW 6Y-23N-24N-25
@FLOW 9Y-29-30N-31-32N-33-10
@FLOW 10Y-6
@FLOW 11Y-34
@FLOW 23Y-25
@FLOW 24Y-26N-27
@FLOW 30Y-32-33
@FLOW 32Y-34
@FLOW 26Y-28-10
@FLOW 16Y-18
@FLOW 36Y-15
@FLOW 37Y-15
@BOX 1.0
DECL.PROC(KIND)
KIND IS ENCODED
   3 - FUNCTION STATEMENT
   2 - DEF STATEMENT
   1 - SUB STATEMENT
@BOX 2.0
NOTE PROC KIND
CLEAR RESULT ASSIGNED STATUS
@BOX 3.0
GET NAME [BSC03]
@BOX 4.0
FIND RESULT TYPE [BSC04.11]
SET DEFAULT PARAM TYPE
@BOX 5.0
NOTE NLIST INDEX OF FIRST PARAM
NEXT ITEM NOT '('
@BOX 6.0
NEXT ITEM '#'
@BOX 7.0
READ DATA TYPE & NAME
[04.19]
FAULTING IF % $ PRESENT
ON EXPLICIT TYPE
@BOX 8.0
UPDATE PARAMETER LIST
ADD TYPE TO PROC SPEC
@BOX 9.0
NEXT ITEM '('
@BOX 10.0
NEXT ITEM ','
@BOX 11.0
ITEM NOT ')'
@BOX 12.0
ADD PARAM COUNT AND
RESULT TYPE TO PROC SPEC
@BOX 15.0
UPDATE AND CHECK PROPERTIES
[04.2.1]
@BOX 16.0
NOT A SINGLE STATEMENT INTERNAL FN
@BOX 17.0
PROCESS ONE LINE INTERNAL FN
[BSC04.2.2]
@BOX 18.0
END
@BOX 19.0
MOVE IPTR BACK
@BOX 20.0
REFN SPEC MATCHES
ACTUAL SPEC?
@BOX 21.0
FAULT
@BOX 23.0
NEXT ITEM NOT INTEGER?
@BOX 24.0
INTEGER > 0?
@BOX 25.0
FAULT
@BOX 26.0
IN A SUB?
@BOX 27.0
FAULT
@BOX 28.0
UPDATE PARAMETER
LIST
@BOX 29.0
SET DIM COUNT = 1
@BOX 30.0
NEXT ITEM NOT ','
@BOX 31.0
SET DIM COUNT = 2
@BOX 32.0
NEXT ITEM NOT ')'
@BOX 33.0
SET PARAM TO
FORMAL ARRAY
@BOX 34.0
FAULT
@BOX 35.0
START PROCEDURE BODY
[BSC04.2.3]
NOTE NLIST INDEX OF LAST PARAM
@BOX 36.0
NOT DEF STATEMENT?
@BOX 37.0
NEXT ITEM NOT =?
@BOC 38.0
NOTE ONE LINE INTERNAL FUNCTION
@BOX 39.0
NOT CHARACTER FUNCTION
@BOX 40.0
READ OPTIONAL CHARACTER LENGTH
[4.23]
@BOX 41.0
INIT LEVEL
INIT.PU LEVEL [BSC04.20]
INIT.INT.FN LEVEL [BSC04.22]
NOTE POSITION OF PARAMETER LIST
@BOX 1.1
PROC DECL.PROC(NAT);
ITYPE ITEM;
$LO16 [128] PARS.IND;
$IN TT, NEW.IN,DEF.AP,RMN, FIRST.PAR.N, LAST.PAR.N;
$IN FI.PTR, P, D, CHAN, DIM, J, N, LEN, PROG.PIND;
$LO8[128] PARS;
$IN RT,PIND,TY,I;
#BSC04.2.3
@BOX 2.1
NAT => C.PROC.K;
1 <<- NAT -= 7 &> RES.ASSIGNED;
@BOX 3.1
1 +> IPTR=> FI.PTR;
IF GETN(LBUFF[IPTR]) => PIND < 0 THEN
   0 -:> PIND;
FI
@BOX 4.1
IF NAT /= 1 THEN
   COMPTYPE(PIND) => RT;
ELSE
   0 => RT;
FI
0 => LEN;
1 => I;
@BOX 5.1
0 => TY;
STAT.LASTN => FIRST.PAR.N;
IF LBUFF[1+>IPTR] /= LB
@BOX 6.1
IF LBUFF[1+IPTR] = HASH.D
@BOX 7.1
GET.TYPED.NAME (TY ! %8000) => TY;
@BOX 8.1
TY & %F8 => PARS [1 +> I];
IND OF LBUFF [IPTR] => PARS.IND [I];
@BOX 9.1
IF LBUFF [1 + IPTR] = LB
@BOX 10.1
IF LBUFF[1 +> IPTR] => ITEM = COMMA
@BOX 11.1
IF ITEM /= RB
@BOX 12.1
I - 1 => PARS [1];
RT => PARS [0];
@BOX 15.1
#BSC04.2.1
@BOX 16.1
IF DEF.AP = 0
@BOX 17.1
#BSC04.2.2
@BOX 18.1
END
@BOX 19.1
1 -> IPTR;
@BOX 23.1
1 +> IPTR;
IF TAG OF LBUFF [1 +> IPTR] /= 3
   OR ST OF LBUFF[IPTR] & %C0 /= %40
@BOX 24.1
IF INT.C OF CLIST[IND OF LBUFF[IPTR]] => CHAN > 0
@BOX 25.1
MONITOR (%1040);
@BOX 26.1
IF NAT = 1
@BOX 27.1
MONITOR (%1041);
@BOX 28.1
3 => PARS [1 +> I];
CHAN => PARS.IND [I];
@BOX 29.1
1 +> IPTR;
1 => DIM;
@BOX 30.1
IF LBUFF [1 + IPTR] /= COMMA
@BOX 31.1
2 => DIM;
1 +> IPTR;
@BOX 32.1
IF LBUFF [1 +> IPTR] /= RB
@BOX 33.1
DIM !> PARS [I];
@BOX 34.1
MONITOR (%1000);
@BOX 35.1
PROC.HEAD(PIND,NAT,^PARS.IND,^PARS,LEN);
LASTN => LAST.PAR.N;
@BOX 36.1
0 => DEF.AP;
IF NAT /= 2
@BOX 37.1
IF LBUFF[1 + IPTR] /= EQUALS
@BOX 38.1
1 +> IPTR;
1 => DEF.AP;
@BOX 39.1
IF RT /= BSTR
@BOX 40.1
LENGTH() => LEN;
@BOX 41.1
IF NAT /= 2 THEN
   INIT.PU.LEV();
   FIRST.PAR.N => PU.FIRST.PAR.N;
   LAST.PAR.N => PU.LAST.PAR.N;
ELSE
   INIT.INT.FN.LEV();
   FIRST.PAR.N => DEF.FIRST.PAR.N;
   LAST.PAR.N => DEF.LAST.PAR.N;
FI
@END
@TITLE BSC04.2.1(1,11)
@COL 1S-22T-2T-3R-4T-5R-6T-7T-8T-9R-10T-11T-12R-13R-14R-15R-18F
@COL 23R-19R-20R-21R
@ROW 5-19
@ROW 2-23
@ROW 8-20
@ROW 11-21
@FLOW 1-22N-2N-3-4N-5-6N-7N-8N-9-21-14-15-18
@FLOW 2Y-6Y-14
@FLOW 4Y-19-6
@FLOW 7Y-20-21
@FLOW 8Y-10N-11N-12-13-14
@FLOW 10Y-14
@FLOW 11Y-14
@FLOW 22Y-23-2
@BOX 1.0
PROCESS PROCEDURE PROPERTY ENTRY
@BOX 2.0
PROC NAME NOT DEFINED AT PROGRAM LEVEL?
@BOX 3.0
COPY PROC PROPS TO PU LEVEL [BSC08]
@BOX 4.0
PROC AN INTERNAL FN?
@BOX 5.0
NOTE INDEX OF PROPS AT PROGRAM LEVEL
@BOX 6.0
PROPERTY KIND UNDEFINED?
@BOX 7.0
INCONSISTENT USE OF PROCEDURE NAME?
@BOX 8.0
PROC NOT DEFINED?
@BOX 9.0
FAULT
@BOX 10.0
NO PREVIOUS CALL OF PROC
@BOX 11.0
CONSISTENT USE OF PROC
@BOX 12.0
FAULT
@BOX 13.0
RESET PU PROPS
RESET PROGRAM PROPS IF ANY
@BOX 14.0
SET KIND IN PU PROPS
@BOX 15.0
DECLARE SPEC OF PROC TO MUTL [BSC04.17]
IF NECESSARY
@BOX 18.0
END
@BOX 19.0
RESET PU PROPS
@BOX 20.0
FAULT
@BOX 21.0
ALLOCATE AN ANONYMOUS NLIST ENTRY [BSC08]
@BOX 22.0
INTERNAL FN IN AN EXCEPTION HANDLER ?
@BOX 23.0
FAULT
@BOX 1.1
::BSC04.2.1
@BOX 2.1
0 => PROG.PIND;
IF PIND > PU.N
@BOX 3.1
PIND => PROG.PIND;
ADD.N.LIST() => PIND;
NLIST[PROG.PIND] => NLIST[PIND];
@BOX 4.1
IF NAT = 2
@BOX 5.1
:: IN BOX 3
@BOX 6.1
SELECT NLIST[PIND];
IF K = KUNDEF OR K = KFNSUB
@BOX 7.1
IF [NAT=1 AND K /= KSUB]
   OR[NAT /= 1 AND K /= KFN]
   OR[NAT = 2 AND DETAIL1 & %800 /= 0]
@BOX 8.1
IF DETAIL1 & %200 = 0
@BOX 9.1
MONITOR.N(%43, PIND);
@BOX 10.1
IF DETAIL => D = 0
@BOX 11.1
PARAMS[D+1] => N;
0 => I;
WHILE PARAMS[D+I+1] = PARS[I+1] AND
      1 +> I = < N DO OD
IF I > N
@BOX 12.1
MONITOR.N(%44,P.IND);
@BOX 13.1
0 => T => DETAIL => DETAIL1 => MUTLN;
BEGIN
SELECT NLIST[PROG.PIND];
   KUNDEF => K;
   0 => BASICN => HASH;
END
0 => PROG.PIND;
@BOX 14.1
IF NAT = 1 THEN
   KSUB => K;
ELSE
   KFN => K;
FI
RT => T;
IF NAT = 2 THEN
   %1200 !> DETAIL1;
ELSE
   %A00 !> DETAIL1;
   IF PROG.PIND = 0 THEN
      %400 !> DETAIL1;
   ELSE
      %200 !> DETAIL1 OF NLIST[PROG.PIND];
   FI
FI
@BOX 15.1
IF DETAIL = 0 THEN
   DECL.TL.PSPEC(PIND,^PARS);
FI
@BOX 18.1
::END
@BOX 19.1
0 => PROG.PIND;
BEGIN
SELECT NLIST[PIND];
KUNDEF => K;
0 => T => DETAIL1 => MUTLN => DETAIL;
END
@BOX 20.1
MONITOR.N(%42,PIND);
@BOX 21.1
ADD.NLIST() => PIND;
@BOX 22.1
IF NAT = 2 AND IN.XH /= 0
@BOX 23.1
MONITOR(%5E);
@END
///12
@TITLE BSC04.2.2(1,11)
@COL 10R
@COL 1S-11R-12R-9T-2T-3R-4R-5R-6F
@COL 7R
@ROW 10-4
@ROW 3-7
@FLOW 1-11-12-9N-2N-3-4-5-6
@FLOW 2Y-7-5
@FLOW 9Y-10-5
@BOX 1.0
PROCESS ONE LINEINTERNAL FUNCTION
@BOX 2.0
STRING INTERNAL FN ?
@BOX 3.0
CODE NUMERIC EXPRESSION
[BSC07]
@BOX 4.0
NOTE RESULT IN A REGISTER
@BOX 5.0
PLANT RETURN
END INTERNAL FUNCTION [BSC04.10]
@BOX 6.0
END
@BOX 7.0
ASSIGN STRING EXPR VALUE
TO RESULT STRING PARAMETER
@BOX 9.0
NOTE NO RESULT
EXPR TYPE INCONSISTENT WITH
INTERNAL FN TYPE ?
@BOX 10.0
FAULT
@BOX 11.0
SET FAULT RECOVERY ACTION TO TIDY UP
IF FAULTS OCCUR IN EXPR
@BOX 12.0
RECOGNISE EXPRESSION [BSC07]
@BOX 1.1
::BSC04.2.2
@BOX 2.1
IF RT = BSTR
@BOX 3.1
CODE.EXPR(DEF.AP,RT->>3);
@BOX 4.1
%3000 => R.MN;
@BOX 5.1
TL.PL(%43,R.MN);
4 !> RES.ASSIGNED;
END.ST(2);
@BOX 6.1
::END
@BOX 7.1
CODE.STR.EXPR(DEF.AP,DEF.RES.MN);
0 => R.MN;
@BOX 9.1
IF [AS[DEF.AP] ->> 8 & %C0 => TT = %C0
   OR RT & %C0 = %C0]
   AND [TT & RT & %C0 /= %C0]
@BOX 10.1
MONITOR.P(%1A, AS[DEF.AP+1]);
@BOX 11.1
1 => RECOVERY;
@BOX 12.1
IN.EXPR(4) => DEF.AP;
@END
///17 22.JUL.83
@TITLE BSC04.2.3(1,11)
@COL 30R-24T-15T-16T-25R-17R-18R-14F
@COL 1S-2T-3R-5R-6R-7T-9R-11T-21T-26R-27T-28R-29R-8R-22T-23R-12R-13R
@ROW 30-26
@ROW 24-8
@FLOW 1-2N-3-5-6-7N-9-11N-21N-26-27N-28-29-8-13-7
@FLOW 2Y-5
@FLOW 7Y-30-24N-15N-16N-25-18-14
@FLOW 11Y-22N-23-13
@FLOW 22Y-12-13
@FLOW 21Y-27Y-8
@FLOW 24Y-14
@FLOW 15Y-17-18
@FLOW 16Y-18
@BOX 1.0
PROC.HEAD(PN,PROC.KIND, PARAM.IND.LIST, PARAM.TYP.LIST, RES.LEN)
@BOX 2.0
INTERNAL FUNCTION
@BOX 3.0
RESET CHAN COUNT
@BOX 5.0
IF NOT INTERNAL FUNCTION THEN
    TOP UP POOL OF PSPECS
DECLARE PROC HEAD TO MUTL
@BOX 6.0
GET PARAMETER COUNT
@BOX 7.0
NO MORE PARAMETERS?
@BOX 8.0
SET UP PROPERTIES
NOTE IN PROPS IF
PARAMETER REQUIRES
DREFERENCING - I.E.
FORMAL ARRAYS, NUMERIC
PARAMETERS IN SUBPROGS
@BOX 9.0
ALLOCATE MUTL NAME(S) FOR
PARAMETER
@BOX 11.0
CHANNEL
PARAMETER?
@BOX 12.0
NOTE CHANNEL ALLOCATED
PLANT
BIO.PAR.CHAN(ACTUAL.CHAN, FORMAL.CHAN)
@BOX 13.0
GET NEXT PARAMETER
@BOX 14.0
END
@BOX 15.0
STRING FUNCTION ?
@BOX 16.0
ONE LINE INTERNAL FUNCTION ?
@BOX 17.0
ALLOCATE MUTL NAME FOR RESULT
PASSED AS LAST PARAMETER
@BOX 18.0
SET RESULT GLOBAL
@BOX 21.0
PROPERTIES AT CURRENT
PROC LEVEL ?
@BOX 22.0
CHANNEL NOT PREVIOUSLY DEFINED
@BOX 23.0
FAULT
@BOX 24.0
SUBPROGRAM
@BOX 25.0
DECLARE RESULT VARIABLE
@BOX 26.0
ALLOCATE AN NLIST ENTRY[BSC08]
AND INITIALISE
@BOX 27.0
PARAMETER NAME UNIQUE ?
@BOX 28.0
FAULT
@BOX 29.0
ALLOCATE AN ANONYMOUS NLIST ENTRY[BSC08]
@BOX 30.0
SCAN PARAMETER LIST AND
DECLARE SELECT VARIABLE FOR
EACH ELEMENT OF ARRAY DESCRIPTOR
@BOX 1.1
$PS PROC.HEAD($IN,$IN, ADDR[$LO16], ADDR[$LO8], $IN);
$PR PROC.HEAD(P,NAT,P.IND,P.TYP,LEN);
$IN N,I,J,M,MN,L,RES, S;
$LO16 D;
$IN PP, LCHN;
$LO8 TT,TT3;
$LO16[256] CHN.T;
SELECT NLIST [P];
@BOX 2.1
IF NAT = 2
@BOX 3.1
-1 => L.CHN;
@BOX 5.1
IF NAT /= 2 THEN
   WHILE PSPEC.CNT < 128 DO
      TL.PROC.SPEC(NIL, %2000);
      1 +> LAST.MN;
      1 +> PSPEC.CNT;
   OD
FI
P => CUR.PROC;
MUTLN => M;
IF NAT = 2 THEN
   %8000 !> M;
ELSE
   LAST.MN => PU.MN
FI
TL.PROC(M);
@BOX 6.1
1 => I; P.TYP^ [1] => N;
@BOX 7.1
IF 1 +> I >= N + 2
@BOX 8.1
TT3 => K OF NLIST[PP];
TT & %F8 => T OF NLIST[PP];
MN => MUTLN OF NLIST[PP];
%10 => D;
IF TT3 /= 0 OR K = KSUB OR TT & %C0 = %C0 THEN
   %30 => D;
FI
D => DETAIL1 OF NLIST [PP];
@BOX 9.1
IF P.TYP^[I] => TT & %F8 = %C0 AND TT & 3 /= 0 THEN
   1 +> LAST.MN;
FI
1 +> LAST.MN => MN;
IF TT & %3 => TT3 /=0/=3 THEN
   1+>LASTMN;
FI
@BOX 11.1
P.IND ^[I] => PP;
IF TT3 = 3
@BOX 12.1
PP => CHN.T [1 +> L.CHN];
BEGIN
DATAVEC CD.SEQ($LO16)
%1065 ::STK LB BIO.PAR.CHAN
%46 %44 ::AMODE $IN16
%22 %800E :: A = ACTUAL.CHAN
%6000     :: STACK A
%22 %8003 :: A = FORMAL CHAN
%6000     :: STACK A
%A000     :: ENTER
END;
MN => CD.MN.0;
PP => G.LIT.16.0;
PL.CD.SEQ(^CD.SEQ);
END;
@BOX 13.1
::NO CODE
@BOX 14.1
END
@BOX 15.1
IF RT & %C0 = %C0
@BOX 16.1
IF DEF.AP /= 0
@BOX 17.1
1 +> LAST.MN => RES;
@BOX 18.1
IF NAT = 2 THEN
   RES => DEF.RES.MN;
   P => DEF.N;
ELSE
   RES => PU.RES.MN;
   P => FUNCTION.N;
FI
@BOX 21.1
IF PP > FIRST.PAR.N
@BOX 22.1
0 => J;
WHILE J =< L.CHN AND CHN.T [J] /= PP DO
   1  +> J;
OD
IF J > L.CHN
@BOX 23.1
MONITOR.I (%47,PP);
@BOX 24.1
0 => RES;
IF NAT = 1
@BOX 25.1
TL.S.DECL(NIL,TL.TYP[RT->>3],0);
   1+>LAST.MN => RES;
@BOX 26.1
ADDNLIST() => L;
BASIC.N OF NLIST[L] => BASIC.N OF NLIST[PP];
HASH OF NLIST[L] => HASH OF NLIST[PP];
L => PP;
@BOX 27.1
IF K OF NLIST[PP] = KUNDEF
@BOX 28.1
MONITOR.N(%46,PP);
@BOX 29.1
ADDNLIST() => PP;
@BOX 30.1
FIRST.PAR.N => S;
WHILE 1 +> S =< LAST.N DO
   BEGIN
   SELECT NLIST[S];
   IF K = KVEC OR K = KMAT THEN
      1 +> LAST.A => DETAIL;
      1 + LAST.MN => ARRAYS[LASTA];
      FOR I < K + K DO
         TL.SELECT.VAR();
         TL.CLIT.16(%44, I);
         TL.PL(%62, MUTLN + 1);
         TL.PL(%02, 0);
         TL.PL(%64, 0);
         TL.PL(%60, 1 +> LAST.MN);
      OD
   FI
   END
OD
@END
//16
@TITLE BSC04.4(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
UNDEF.PROCS()
@BOX 2.0
MONITOR ANY UNDEFINED PROCEDURES
@BOX 3.0
END
@BOX 1.1
PROC UNDEF.PROCS;
$IN I;
@BOX 2.1
0 => I;
WHILE 1+> I =< PU.N DO
   IF K OF NLIST[I] /= KUNDEF AND DETAIL1 OF NLIST[I] & %200 = 0 THEN
      MONITOR.N(%4B, I);
   FI
OD
@BOX 3.1
END
@END
///15
@TITLE BSC04.5(1,11)
@COL 16R-20R
@COL 1S-2R-3T-4R-5T-6T-7T-8T-9T-10R-18T-11T-12R-13R-14R-21R-15F
@COL 17R-19R
@ROW 16-8
@ROW 11-17
@ROW 20-13-19
@FLOW 1-2-3N-4-5N-6N-7N-8N-9N-10-18N-11N-12-13-14-21-15
@FLOW 3Y-5Y-17
@FLOW 6Y-16-18
@FLOW 11Y-20-15
@FLOW 7Y-18
@FLOW 8Y-17
@FLOW 9Y-17
@FLOW 18Y-19-15
@BOX 1.0
PR.ARRAY.DECL(NL.I,TYPE,STR.Z)
PROCESS ARRAY DECLARATIONS
STR >=0 CALL FROM DECLARE
STR =-1 CALL FROM DIM
@BOX 2.0
GET BOUNDS OF FIRST DIMENSION
SET KIND TO VECTOR
@BOX 3.0
NEXT ITEM NOT ,
@BOX 4.0
GET BOUNDS OF SECOND DIMENSION
SET KIND OF MATRIX
@BOX 5.0
NEXT ITEM NOT )?
@BOX 6.0
DIM STATEMENT?
@BOX 7.0
NEXT ITEM NOT *
@BOX 8.0
NOT STRING ARRAY
@BOX 9.0
NEXT ITEM NOT INTEGER?
@BOX 10.0
SET STRING SIZE
@BOX 11.0
NAME NOT AN UNDEFINED
ENTITY
@BOX 12.0
UPDATE PROPS
DECLARE ARRAY TO MUTL
@BOX 13.0
DECLARE ARRAY DESCRIPTOR TO MUTL
@BOX 14.0
DECLARE SELECT VARIABLES ONE FOR
EACH ELEMENT IN ARRAY DESCRIPTOR
@BOX 15.0
END
@BOX 16.0
SET DEFAULT STR SIZE
@BOX 17.0
SYNTAX FAULT
@BOX 18.0
BOUNDS FAULTY
@BOX 19.0
FAULT
@BOX 20.0
FAULT
@BOX 21.0
SAVE LOWER BOUNDS OF DIMENSION
AND STRING SIZE IN ADDITIONAL
ARRAY PROPS
@BOX 1.1
PROC PR.ARRAY.DECL(NL.I,TYP,STR.Z);
$IN32[4] BNDS;
$LO8 KND;
PSPEC PR.BOUNDS(ADDR[$IN32],$IN);
#BSC04.5.1
ADDR Z;
$IN I,MN,N;
@BOX 2.1
1 +> IPTR;
PR.BOUNDS(^BNDS,0);
KVEC => KND;
2 => N;
@BOX 3.1
IF LBUFF[1+IPTR]/= COMMA
@BOX 4.1
1 +> IPTR;
PR.BOUNDS(^BNDS,2);
KMAT => KND;
4 => N;
@BOX 5.1
IF LBUFF[1+>IPTR] /= RB
@BOX 6.1
IF STR.Z < 0
@BOX 7.1
IF LBUFF[1+IPTR] /= AST
@BOX 8.1
IF TYP/= BSTR
@BOX 9.1
IF TAG OF LBUFF[2+>IPTR] /= TCONST
@BOX 10.1
INT.C OF CLIST[IND OF LBUFF[IPTR]] => STR.Z;
@BOX 11.1
SELECT NLIST[NL.I];
IF K /= KUNDEF
@BOX 12.1
KND => K;
TYP => T;
BNDS[1] => Z;
IF KND = KMAT THEN
   BNDS[3] *> Z;
FI
IF TYP = BSTR THEN
   STRZ + 1 *> Z;
FI
TL.S.DECL(GENN(NL.I),TL.TYP[TYP->>3],Z);
1 +> LAST.MN => MUTLN => MN;
@BOX 13.1
TL.S.DECL(NIL,TADDR,N);
1 +> LAST.MN;
@BOX 14.1
FOR I < N DO
   TL.SELECT.VAR();
   TL.CLIT.16(%44,I);
   TL.PL(%61, MN + 1);
   TL.PL(%2, 0);
   TL.PL(%64, 0);
   TL.PL(%60,1 +> LAST.MN);
OD
@BOX 15.1
END
@BOX 16.1
DEF.STR.Z => STR.Z;
@BOX 17.1
MONITOR(%1000);
@BOX 18.1
IF BNDS[1] =< 0 OR
   KND = KMAT AND BNDS[3] =< 0
@BOX 19.1
MONITOR.N(%17,NL.I);
@BOX 20.1
MONITOR.N(%16, NL.I);
@BOX 21.1
IF TYP = BSTR THEN
   STR.Z + 1 => ARRAYS[1+>LAST.A]
FI
1 +> LAST.A => DETAIL;
MN + 2 => ARRAYS[LAST.A];
FOR I < N DO
   BNDS[I] => ARRAYS[1 +> LASTA];
OD
@END
///17 22.JUL.83
@TITLE BSC04.5.1(1,11)
@COL 1S-2T-3R-4T-5R-6T-7R-8T-9R-10T-11R-12R-13F
@COL 14R-17R
@ROW 5-14
@FLOW 1-2N-3-4N-5-6N-7-8N-9-10N-11-12-13
@FLOW 4Y-14
@FLOW 6Y-17-12
@FLOW 8Y-10Y-14
@FLOW 2Y-4
@BOX 1.0
PR.BOUNDS(VECTOR,INDEX)
@BOX 2.0
NEXT ITEM NOT A SIGN
@BOX 3.0
NOTE SIGNED
@BOX 4.0
NEXT ITEM NOT AN INTEGER
@BOX 5.0
SET UPPER BOUND TO
SIGNED VALUE
@BOX 6.0
NEXT ITEM NOT 'TO'
@BOX 7.0
SET LOWER BOUND FROM
UPPER BOUND
@BOX 8.0
NEXT ITEM NOT A SIGN?
@BOX 9.0
NOTE SIGN
@BOX 10.0
NEXT ITEM NOT AN INTEGER?
@BOX 11.0
SET UPPER BOUND FROM
SIGNED VALUE
@BOX 12.0
SET LOWER BOUND AND
SIZE IN RESULT VECTOR
@BOX 13.0
END
@BOX 14.0
FAULT
@BOX 17.0
SET LOWER BOUND
TO DEFAULT
@BOX 1.1
PROC PR.BOUNDS(V,I);
$IN32 LB,UB,Z;
ITYPE ITEM;
$LO8 S;
@BOX 2.1
0 => S;
IF LBUFF [1+IPTR] => ITEM /= PLUS /= MINUS
@BOX 3.1
1 +> IPTR;
@BOX 4.1
IF TAG OF LBUFF[1+>IPTR] /= TCONST
    OR ST OF LBUFF[IPTR] & %C0 /= %40
@BOX 5.1
INT.C OF C.LIST[IND OF LBUFF[IPTR]] => UB;
IF ITEM = MINUS THEN
   0 -:> UB;
FI
@BOX 6.1
IF LBUFF[1+IPTR] /= D.TO
@BOX 7.1
1 +> IPTR;
UB => LB;
@BOX 8.1
IF LBUFF[1+IPTR] => ITEM /= PLUS /= MINUS
@BOX 9.1
1 +> IPTR;
@BOX 10.1
IF TAG OF LBUFF[1+>IPTR] /= TCONST
   OR ST OF LBUFF[IPTR] & %C0 /= %40
@BOX 11.1
INT.C OF CLIST[IND OF LBUFF[IPTR]] => UB;
IF ITEM = MINUS THEN
   0 -:> UB;
FI
@BOX 12.1
LB => V^[I];
UB-LB+1 => V^[I+1];
@BOX 13.1
END
@BOX 14.1
MONITOR(%1000);
@BOX 17.1
DEF.BASE => LB;
@END
///17 22.JUL.83
@TITLE BSC04.6(1,11)
@COL 14R
@COL 1S-2R-4R-5T-9R-11T-13F
@ROW 14-13
@FLOW 1-2-4-5N-9-11N-13
@FLOW 5Y-14
@FLOW 11Y-4
@BOX 1.0
PROCESS DIM STATEMENT
@BOX 2.0
RESET TYPE
@BOX 4.0
READ OPTIONAL DATA TYPE AND NAME
SET TYPE [04.19]
@BOX 5.0
NEXT ITEM NOT '('?
@BOX 9.0
PROCESS ARRAY DECLARATION
[04.5]
@BOX 11.0
NEXT ITEM ',' ?
@BOX 12.0
NOT EOL?
@BOX 13.0
END
@BOX 14.0
FAULT
@BOX 1.1
PROC DECL.DIM;
$IN T;
@BOX 2.1
0 => T;
@BOX 4.1
GET.TYPED.NAME (%8000 ! T) => T;
@BOX 5.1
IF LBUFF[1+IPTR] /= LB
@BOX 9.1
PR.ARRAY.DECL(IND OF LBUFF[IPTR],T & %FF,-1);
@BOX 11.1
IF LBUFF[1+>IPTR] = COMMA
@BOX 13.1
1->IPTR;
END
@BOX 14.1
MONITOR(%1000);
@END
//17 22.JUL.83
@TITLE BSC04.7(1,11)
@COL 1S-2T-3T-4T-5T-6T-7T-8T-9R-10R-11R-12T-13F
@COL 14T-24N-15T-25N-16T-26N-17R-18R
@ROW 3-14
@FLOW 1-2N-3N-4N-5N-6N-7N-8N-9-10-11-12N-13
@FLOW 2Y-14N-24-7
@FLOW 14Y-17
@FLOW 3Y-15N-25-7
@FLOW 15Y-17
@FLOW 4Y-16N-26-7
@FLOW 16Y-17
@FLOW 7Y-18-12Y-2
@FLOW 8Y-10
@FLOW 6Y-17
@FLOW 5Y-17
@BOX 1.0
TRANS OPTION
@BOX 2.0
NEXT ITEM 'ANGLE'?
@BOX 3.0
'ARITHMETIC'?
@BOX 4.0
'COLLATE'?
@BOX 5.0
NOT 'BASE'
@BOX 6.0
NEXT ITEM NOT 0 OR 1
@BOX 7.0
OPTION ALREADY GIVEN IN THIS PU
@BOX 8.0
FACILITY OF OPTION NOT USED IN PU
@BOX 9.0
FAULT
@BOX 10.0
NOTE OPTION SEEN
@BOX 11.0
PROCESS OPTION
@BOX 12.0
NEXT ITEM COMMA
@BOX 13.0
END
@BOX 14.0
NEXT ITEM NOT DEGREES/RADIANS
@BOX 15.0
NEXT ITEM NOT DECIMAL/NATIVE
@BOX 16.0
NEXT ITEM NOT STANDARD/NATIVE
@BOX 17.0
FAULT
@BOX 18.0
FAULT
@BOX 1.1
PROC TRANS.OPTION;
$IN OPT,K;
ITYPE IT,N.IT;
@BOX 2.1
-1 => OPT;
LBUFF[2+IPTR] => N.IT;
IF LBUFF[1+>IPTR] => IT = D.ANGLE
@BOX 3.1
IF IT = D.ARITHMETIC
@BOX 4.1
IF IT = D.COLLATE
@BOX 5.1
IF IT /= D.BASE
@BOX 6.1
3 => K;
IF TAG OF NIT /= TCONST
   OR ST OF NIT & %C7 /= %40
   OR INT.C OF CLIST[IND OF NIT] => OPT > 1
   OR OPT < 0
@BOX 7.1
IF %100 <<- K & OPTIONS /= 0
@BOX 8.1
::TBC INVOLVES SIMPLE BOOK KEEPING
@BOX 9.1
::TBC
@BOX 10.1
%100 ! OPT <<- 3 !> OPTIONS;
@BOX 11.1
IF K = 3 THEN
   OPT => DEF.BASE;
FI
@BOX 12.1
IF LBUFF[1+>IPTR] = COMMA
@BOX 13.1
END
@BOX 14.1
IF NIT = D.RADIANS THEN
   0 => OPT;
ELSE IF NIT = D.DEGREES THEN
   1 => OPT;
FI FI
IF OPT < 0
@BOX 15.1
IF NIT = D.DECIMAL THEN
   0 => OPT;
ELSE IF NIT = D.NATIVE THEN
   1 => OPT;
FI FI
IF OPT < 0
@BOX 16.1
IF NIT = D.STANDARD THEN
   0 => OPT;
ELSE IF NIT = D.NATIVE THEN
   1 => OPT;
FI FI
IF OPT < 0
@BOX 17.1
MONITOR(%1000);
@BOX 18.1
MONITOR(%55);
@END
///6
@TITLE BSC04.9(1,11)
@COL 1S-4R-6F
@FLOW 1-4-6
@BOX 1.0
DECL.LAB
@BOX 4
DEFINE LABEL
@BOX 6.0
END
@BOX 1.1
$PR DECL.LAB;
@BOX 4.1
LAB (GET.LAB () => DECL.LAB, 1);
@BOX 6.1
$EN
@END
//17 22.JUL.83
@TITLE BSC04.10(1,11)
@COL 10R
@COL 1S-2T-12T-14T-15R-3R-18R-4R-16T-5R-6T-8R-9F
@COL 13R-17R-11R
@ROW 10-14-13
@ROW 5-17
@ROW 8-11
@FLOW 1-2N-12N-14N-15-14Y-3-18-4-16N-5-6N-8-9
@FLOW 2Y-10-12Y-13-14
@FLOW 16Y-17-8
@FLOW 6Y-11-9
@BOX 1.0
END.ST(PROC KIND)
PROC KIND:
   0  PROGRAM
   1  SUBPROGRAM
   2  INTERNAL FUNCTION
   3  FUNCTION
@BOX 2.0
WRONG KIND OF END
FOR CURRENT PROC
@BOX 3.0
PLANT POSTLUDE CODE
[4.10.1]
@BOX 4.0
PLANT PRELUDE CODE
[4.10.2]
@BOX 5.0
REMOVE PROGRAM UNIT TEXTUAL LEVEL
[4.24]
@BOX 6.0
MAIN PROGRAM UNIT?
@BOX 8.0
END MUTL PROC
@BOX 9.0
END
@BOX 10.0
FAULT
@BOX 11.0
END MUTL BLOCK
@BOX 12.0
END OF A FUNCTION AND
NO DEF-LET STATEMENT ENCOUNTERED ?
@BOX 13.0
FAULT
@BOX 14.0
NO INCOMPLETE CONTROL
STRUCTURES?
@BOX 15.0
FAULT
@BOX 16.0
END OF INTERNAL FUNCTION?
@BOX 17.0
REMOVE INTERNAL FUNCTION
TEXTUAL LEVEL
[4.25]
@BOX 18.0
PLANT EXCEPTION HANDLER CODE [BSC11]
@BOX 1.1
PROC END.ST(PROC.K);
DATAVEC CM($LO8);
"for-loop"
"if-block"
"select-block"
"do-loop"
"when-block"
"exception handler"
END
DATAVEC CP($LO8)
0 8 16 28 35 45 62
END
DATAVEC M($LO8)
" "
"SUB"
"DEF"
"FUNCTION"
END
DATAVEC Q($LO8)
0 1 4 7 15
END
$LO8 TY, TY3;
$IN T,N,P,I,J,S,F,L,AMN,T.MN,AK, RES.T;
$IN BT,MN,CV;
ITYPE ITEM;
@BOX 2.1
IF PROC.K/= C.PROC.K
@BOX 3.1
#BSC04.10.1
@BOX 4.1
#BSC04.10.2
@BOX 5.1
END.PU.LEV();
@BOX 6.1
IF CPROC.K = 0
@BOX 8.1
TL.END.PROC();
@BOX 9.1
END
@BOX 10.1
Q[CPROCK] => S;
Q[CPROC.K+1] -1 => F;
MONITOR.S(%49,PART(^M,S,F));
@BOX 11.1
TL.END.BLOCK();
@BOX 12.1
IF C.PROC.K >= 2 AND
   1 <<- C.PROC.K & RES.ASSIGNED = 0
@BOX 13.1
IF C.PROC.K = 2 THEN
   DEF.N => N;
ELSE
   FUNCTION.N => N;
FI
MONITOR.N(%4E,N);
@BOX 14.1
IF CON.PTR =< CON.BASE
@BOX 15.1
CP[CON.STK[CON.PTR] => T] => S;
CP[T+1] - 1 => F;
MONITOR.S(%4A,PART(^CM,S,F));
CON.SIZE[T] -> CON.PTR;
@BOX 16.1
IF C.PROC.K = 2
@BOX 17.1
END.INT.FN.LEV();
@BOX 18.1
PL.XH.CODE();
@END
//17 22.JUL.83
@TITLE BSC04.10.1(1,11)
@COL 1S-2R-4T-6R-3R-13T-15T-16R-17R-18F
@COL 19R
@ROW 15-19
@FLOW 1-2-4N-6-3-13
@FLOW 4-13N-15N-16-17-18
@FLOW 4Y-3
@FLOW 13Y-19-18
@FLOW 15Y-17
@BOX 1.0
PLANT POSTLUDE CODE
@BOX 2.0
DEFINE POSTLUDE CODE LABEL
@BOX 3.0
PLANT EXCEPTION HANDLER POSTLUDE CODE [BSC11]
@BOX 4.0
INTERNAL FN
@BOX 6.0
PLANT CALL TO
BIO.CLOSE.ALL()
@BOX 13.0
MAIN PROGRAM UNIT?
@BOX 15.0
SUBPROGRAM,
STRING FUNCTION OR
ONE LINE INTERNAL FUNCTION
@BOX 16.0
PLANT RESULT VAR => ACC
@BOX 17.0
PLANT RETURN
@BOX 18.0
END
@BOX 19.0
PLANT END OF PROGRAM CODE
PLANT CALL TO BIO.END.RUN
DEFINE END OF PROGRAM LABEL
@BOX 1.1
::BSC04.10.1
@BOX 2.1
IF CPROC.K = 2 THEN
   TL.LABEL(DEF.POSTLUDE);
ELSE
   TL.LABEL(PU.POSTLUDE);
FI
@BOX 3.1
PL.XH.POST.CODE();
@BOX 4.1
IF CPROC.K = 2
@BOX 6.1
PL.STK.LB(BIO.CLOSE.ALL.FN);
TL.PL(%42,0);
@BOX 13.1
IF CPROC.K = 0
@BOX 15.1
0 => N => T;
IF T OF NLIST[CUR.PROC] => RES.T & %C0 /= %C0 THEN
   IF C.PROC.K = 2 THEN
      DEF.RES.MN => T;
   ELSE IF C.PROC.K = 3 THEN
       PU.RES.MN => T;
  FI FI
FI
IF T = 0
@BOX 16.1
TL.PL(%46,TL.TYP[RES.T->>3]);
TL.PL(%22,T);
%3000 => N;
@BOX 17.1
TL.PL(%43,N);
@BOX 18.1
::END
@BOX 19.1
TRANS.STOP();
@END
//16 21.JUL.83
@TITLE BSC04.10.2(1,11)
@COL 26R-20T-21R-12T-13R
@COL 1S-2R-19T-14R-9T-3R-4T-8T-5T-6R-7R-16R-22T-23R-24T-25R-17F
@ROW 26-2
@FLOW 1-2-19N-14-9N-3-4N-8N-5N-6-7-4
@FLOW 8Y-7
@FLOW 5Y-7
@FLOW 19Y-26-20N-21-12N-13-14
@FLOW 20Y-12Y-14
@FLOW 22Y-24
@FLOW 9Y-16
@FLOW 4Y-16-22N-23-24N-25-17
@FLOW 24Y-17
@BOX 1.0
PLANT PRELUDE CODE
@BOX 2.0
DEFINE PRELUDE CODE LABEL
@BOX 3.0
GET FIRST PROPERTY ENTRY
AT THIS TEXTUAL LEVEL
@BOX 4.0
NO MORE PARAMETER PROPERTIES
@BOX 5.0
NOT FORMAL VALUE ARRAY PARAMETER
 WITH WRITE ACCESS
@BOX 6.0
MAKE INSTANCE OF OBJECT ON
A => TEMPND COPY AND STORE ITS
POINTER
AMODE = [ARRAY]
A = PARAM
A CONV INT
TEMP A
B = A
TL.MAKE(ARRAY COPY)
DECLARE ARRAY POINTER
A => ARRAY.PTR
DECLARE CV
A = STACK
TL.CV.CYCLE
AMODE = ARRAY EL KIND
A = PARAM[CV]
A => COPY.ARRAY[CV]
TL.REPEAT
AMODE = [ARRAY]
A = ARRAY.PTR
A => PARAM

DECLARE ARRAY DESCRIPTOR
PLANT
AMODE = ARRAY
A=ARRAY DESC
A=>ARRAY DESC COPY
AMODE = ARRAY DESC PTR
A = REF ARRAY DESC


A => PARAM
@BOX 7.0
GET NEXT PROPERTY ENTRY
@BOX 8.0
NOT A PARAMETER ?
@BOX 9.0
END OF MAIN PROGRAM UNIT ?
@BOX 12.0
NO EXIR SUB/FUNCTION FROM
AN INTERNAL FN ?
@BOX 13.0
PLANT
PU.POSTLUDE.LAB => PU.POSTLUDE.VAR
@BOX 14.0
PLANT EXCEPTION HANDLER PRELUDE CODE [BSC11]
@BOX 16.0
PLANT JUMP TO CODE BODY
@BOX 17.0
END
@BOX 19.0
NOT END OF INTERNAL FUNCTION ?
@BOX 20.0
PROGRAM UNIT CONTAINS NO
DATA STATEMENTS
@BOX 21.0
PLANT
0 => DATA.BUFFER POSITION
@BOX 22.0
END OF INTERNAL FUNCTION?
OR NO DATA STATEMENTS
@BOX 23.0
PLANT 'DATA DV' INCODE DATAVEC FOR
DATA
@BOX 24.0
INCODE RESTORE VECTOR NOT
REQUIRED
@BOX 25.0
PLANT 'RESTORE DV' INCODE VECTOR
@BOX 26.0
PLANT CODE TO SET UP ARRAY DESCRIPTORS
OF ALL NON-PARAMETRIC ARRAYS
@BOX 1.1
::BEGIN
@BOX 2.1
IF CPROC.K = 2 THEN
   DEF.PRELUDE => L;
ELSE
   PU.PRELUDE => L;
FI
TL.LABEL(L);
@BOX 3.1
PU.FIRST.PAR.N => P;
@BOX 4.1
IF 1 +> P > PU.LAST.PAR.N
@BOX 5.1
IF [K OF NLIST[P] => AK /= KVEC /= KMAT] OR
   DETAIL1 OF NLIST[P] & %8 = 0 OR
   C.PROC.K = 1
@BOX 6.1
TL.PL(%46,TL.TYP[T OF NLIST[P]->>3] => T!3);
TL.PL(%22, MUTLN OF NLIST[P] => AMN);
TL.PL(%45,TL.TYP[BINT->>3] => BT ! %4000);
TL.REG(2);
TL.PL(%20, GET.TEMP(BT, 0) => T.MN);
TL.PL(%02,%3000);
TL.MAKE(0,T,-1);
GET.TEMP(T ! 3, 0) => MN;
TL.PL(%20,MN);
GET.TEMP(BT, 0)=> CV;
TL.CV.CYCLE(CV,ZERO,0);
TL.PL(%46,BT);
TL.PL(%22,T.MN);
TL.CV.LIMIT(%3000);
TL.PL(%46,T);
TL.PL(%2,CV);
TL.PL(%62,AMN);
TL.PL(%64,0);
TL.PL(%22,%1004);
TL.PL(%2,CV);
TL.PL(%62,MN);
TL.PL(%64,0);
TL.PL(%20,%1004);
TL.REPEAT();
TL.PL(%46,T ! 3);
TL.PL(%22,MN);
TL.PL(%20,AMN);
TL.S.DECL(NIL, TADDR, AK +> AK);
1 +> LAST.MN;
TL.CLIT.16(%44, AK);
TL.PL(%46, TADDR ! 2);
TL.PL(%62, AMN + 1);
TL.PL(%22, %1004);
TL.PL(%20, LAST.MN);
TL.PL(%46, TADDR ! 3);
TL.PL(%21, LAST.MN);
TL.PL(%20, AMN + 1);
@BOX 7.1
::IN BOX 4
@BOX 8.1
IF DETAIL1 OF NLIST[P] & %10 = 0
@BOX 9.1
IF C.PROC.K = 0
@BOX 14.1
PL.XH.PRE.CODE();
@BOX 16.1
IF C.PROC.K = 2 THEN
  DEF.PROC.CODE.MN => L;
ELSE
  PU.PROC.CODE.MN => L;
FI
TL.PL(%4F, L);
@BOX 12.1
IF PU.POSTLUDE.VAR = 0
@BOX 13.1
TL.PL(%46,%30);
TL.PL(%21,PU.POSTLUDE);
TL.PL(%20,PU.POSTLUDE.VAR);
@BOX 17.1
::END
@BOX 19.1
IF C.PROC.K /= 2
@BOX 20.1
IF LAST.B < 0
@BOX 21.1
SET.A.TYPE(%11);
TL.PL(%22,ZERO);
TL.PL(%20,DATAMN + 1);
@BOX 22.1
IF C.PROC.K = 2 OR
   LAST.B < 0
@BOX 23.1
TL.ASS(DATA.MN,-1);
TL.C.LITS (TLO8, PART (^DATA.B, 0, LASTB));
TL.ASS.VALUE (0,1);
TL.ASS.END();
@BOX 24.1
IF RESTORE.DV.MN = 0
@BOX 25.1
-1 => P;
TL.ASS (RESTORE.DV.MN, -1);
WHILE 1 +> P =< LAST.R DO
   TL.C.LIT.16 (%84, RESTORE.B [P] );
   TL.ASS.VALUE (0, 1);
OD
TL.ASS.END ();
@BOX 26.1
PU.LAST.PAR.N => P;
TL.PL(%46, TADDR);
WHILE 1 +> P =< LASTN DO
   BEGIN
   SELECT NLIST[P];
   IF K = KVEC OR K = KMAT THEN
      ARRAYS[DETAIL=>J] => MN;
      FOR I < K + K DO
         TL.PL(%62, MN+I);
         TL.CLIT.32(TADDR, ARRAYS[J + I + 1]);
         TL.PL(%22, 0);
         TL.PL(%20, %1004);
      OD
   FI
   END
OD
@END
@TITLE BSC04.11(1,11)
@COL 13R
@COL 1S-12T-5R-6F
@ROW 13-5
@FLOW 1-12N-5-6
@FLOW 12Y-13-6
@BOX 1.0
COMPUTE TYPE(INTID)
@BOX 5.0
CHECK LAST CHAR OF NAME
$ - STRING
% - INTEGER
OTHERWISE REAL
@BOX 6.0
END
@BOX 12.0
PROPS ALREADY DECLARED AT THIS LEVEL?
@B13.0
RETURN DECLARED TYPE
@BOX 1.1
$PR COMP.TYPE(INTID);
$IN S,MTLN;
ADDR[$LO8] NAME;
@BOX 5.1
SIZE(GENN(INTID)=>NAME)=>S;
IF NAME^[S-1]=>S='$$ THEN
  BSTR=>COMPTYPE
ELSE
  (IF S='% THEN
  B.INT ELSE B.RE) => COMPTYPE;
FI
@BOX 6.1
END
@BOX 12.1
IF MUTLN OF NLIST [INT.ID] > 0
@BOX 13.1
T OF NLIST[INT.ID] => COMP.TYPE;
@END
@TITLE BSC04.12(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
CHECK.TYPE(ENT.TYPE,REQD.TYPE)
@BOX 2.0
SET RESULT TO 0 IF ENTITY TYPE OK
SET RESULT TO -1 OTHERWISE
@BOX 3.0
END
@BOX 1.1
$PR CHECK.TYPE(ENT.TYP,REQD.TYP);
@BOX 2.1
(IF ENT.TYP=BSTR AND REQD.TYP/=BSTR OR
ENT.TYP/=BSTR AND REQD.TYP=BSTR THEN
-1ELSE 0)=>CHECK.TYPE;
@BOX 3.1
END
@END
///3
@TITLE BSC04.13(1,11)
@COL 8R
@COL 1S-2T-3T-4R-5T-6R-7F
@COL 9T-10R-11R
@ROW 3-9
@ROW 8-4
@FLOW 1-2N-3N-4-5N-6-7
@FLOW 3Y-8-5Y-7
@FLOW 2Y-9N-10-5
@FLOW 9Y-11-5
@BOX 1.0
DECL.NUM.CONST (CONST.TYPE, CONST.PTR) TL.NAME
@BOX 2.0
INTEGER CONST
@BOX 3.0
32 BIT?
@BOX 4.0
CALL TL.CLIT.64 TO
DEFINE CURRENT LIT
@BOX 5.0
MUTL NAME NOT REQUIRED
@BOX 6.0
DECLARE LITERAL AND
ALLOCATE MUTL NAME FOR IT
@BOX 7.0
END
@BOX 8.0
CALL TL.CLIT.32 TO
DECLARE CURRENT LITERAL
@BOX 9.0
16 BIT?
@BOX 10.0
CALL TL.C.LIT32 TO
DEFINE CURRENT LIT
@BOX 11.0
CALL TL.C.LIT16 TO
DEFINE CURRENT LIT
@BOX 1.1
PROC DECL.NUM.CONST (TYP, CP);
$LO32 R32;
$IN T;
TL.TYP[TYP & %FF ->> 3] => T;
@BOX 2.1
IF TYP & %C0 = %40
@BOX 3.1
IF TYP & %38 =< %10
@BOX 4.1
TL.CLIT.64 (T, REAL.C OF CP^);
@BOX 5.1
0 => DECL.NUM.CONST;
IF TYP & %8000 = 0
@BOX 6.1
TL.LIT (NIL, 0);
1 +> LAST.MN => DECL.NUM.CONST;
@BOX 7.1
END
@BOX 8.1
REAL.C OF CP^ => R32;
TL.CLIT.32 (T, R32);
@BOX 9.1
IF TYP & %38 =< %8
@BOX 10.1
TL.CLIT.32 (T, INT.C OF CP^);
@BOX 11.1
TL.CLIT.16 (T, INT.C OF CP^);
@END
///6
@TITLE BSC04.15(1,11)
@COL 1S-2T-3R-4F
@FLOW 1-2N-3-4
@FLOW 2Y-4
@BOX 1.0
CHECK FOR IMPLICIT DECLARATION OF
SIMPLE VARIABLE
IMPL.S.VAR(NL.IND)
@BOX 2.0
VARIABLE DECLARED
@BOX 3.0
DECLARE VARIABLE TO MUTL
@BOX 4.0
END
@BOX 1.1
PROC IMPL.S.VAR(NL.I);
@BOX 2.1
IF K OF NLIST[NL.I] /= KUNDEF
@BOX 3.1
DECL.TL.S.VAR(NL.I,0,DEF.STR.Z) ;
@BOX 4.1
END
@END
@TITLE BSC04.16(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
PROC READ.DATA.TYPE
@BOX 2.0
IF NEXT ITEM NOT
SINGLE
DOUBLE
WORD
LONG
STRING
THEN FAULT
ELSE RETURN MUTL TYPE ENCODING
@BOX 3.0
END
@BOX 1.1
PROC READ.DATA.TYPE;
$IN IN;
@BOX 2.1
IF TAG OF LBUFF[1+>IPTR]=TTYPE THEN
DATA.TYPE[IND OF LBUFF[IPTR] & %FF] => READ.DATA.TYPE;
ELSE MONITOR(3) FI;
@BOX 3.1
END
@END
///17 22.JUL.83
@TITLE BSC04.17(1,11)
@COL 1S-12T-2R-3R-4R-10T-5R-6R-7R-8R-9F
@COL 13R-11R
@ROW 6-11
@ROW 2-13
@FLOW 1-12N-2-3-4-10N-5-6-7-8-9
@FLOW 10Y-11
@FLOW 12Y-13
@BOX 1
DECL.TL.PSPEC(PIND,^PARAMS)
@BOX 2
ALLOCATE EMPTY PSPEC
@BOX 3
FIND NO OF PARAMS
@BOX 4
UPDATE PROPERTIES
@BOX 5
DECLARE PROC
SPEC TO MUTL
@BOX 6
COPY SPEC TO PARAMS
@BOX 7
DECLARE PARAMETERS
TO MUTL
SIMPLE STRING VARS BY REFN
FN / NUM SIMPLE VARS BY VALUE
SUB / NUM SIMPLE VARS BY PTR
ARRAYS BY BOUNDED PTR,
       FN / ARRAY BOUNDS BY VALUE
       SUB / ARRAY BOUNDS BY REFN
CHANNELS INT16 VALUE
@BOX 8
DECLARE RESULT TO MUTL
@BOX 9
RETURN PROC MUTLN
END
@BOX 10.0
PARAM LIST FULL?
@BOX 11.0
FAULT
@BOX 12.0
POOL OF PSPEC NAMES EMPTY?
@BOX 13.0
FAULT
@BOX 1.1
PROC DECL.TL.PSPEC(PIND,PARS);
$IN I,N,TY,TY2,TL.TY;
$IN PAR.N, VK;
SELECT NLIST [PIND];
@BOX 2.1
1 +> PSPEC.N;
@BOX 3.1
PARS^[1]=>N;
@BOX 4.1
PSPECN => MUTLN;
LASTP + 1 => DETAIL;
@BOX 5.1
TL.PROC.SPEC(GENN(PIND),%1000 ! PSPECN);
@BOX 6.1
FOR I < N + 2 DO
   PARS^[I] => PARAMS [1 +> LASTP];
OD
@BOX 7.1
0 => VK;
IF K = KSUB THEN
   1 => VK;
FI
FOR I < N DO
   IF PARS^[2 + I] => TY & %F8 = %C0 AND TY & 3 /= 0 THEN
      TL.PROC.PARAM(%44, 0);
   FI
   IF TY & 3 => TY2 = 0 THEN
   IF TY & %C0 /= %C0 THEN
      TL.TYP[TY ->> 3] ! VK => TL.TY;
   ELSE
      %83 => TL.TY;
   FI
ELSE IF TY2 = 3 THEN
   %44 => TL.TY;
ELSE
   TL.PROC.PARAM (TL.TYP[TY ->> 3] ! 3, 0);
   TL.TYP[BINT ->> 3] ! 3 => TL.TY;
FI FI
TL.PROC.PARAM (TL.TY, 0);
OD
@BOX 8.1
IF K = KSUB THEN
   0 => TL.TY;
ELSE IF PARS^[0] => TY & %C0 /= %C0 THEN
      TL.TYP[TY ->> 3] => TL.TY;
     ELSE
      TL.PROC.PARAM(%83,0);
      0 => TL.TY;
    FI
FI
TL.PROC.RESULT(TL.TY);
@BOX 9.1
END
@BOX 10.1
IF LASTP + N + 1 >= GL.LAST.P
@BOX 11.1
MONITOR.S (%200F, %"PARAMETER");
@BOX 12.1
IF 1 -> PSPEC.CNT < 0
@BOX 13.1
MONITOR.N (%2045,0);
@END
///6
@TITLE BSC04.18(1,11)
@COL 1S-5T-6R-3R-4F
@FLOW 1-5N-6-3-4
@FLOW 5Y-3
@BOX 1.0
TYPE OF 0 MEANS IMPLICIT TYPE
DECL.TL.S.VAR(N.IND,TYPE,STR.Z)
DECLARE SIMPLE VARIABLE TO MUTL
@BOX 3.0
DECLARE VARIABLE TO MUTL
@BOX 4.0
END
@BOX 5.0
EXPLICIT TYPE
@BOX 6.0
SET IMPLICIT TYPE
@BOX 1.1
PROC DECL.TL.S.VAR(N.IND,TYP,STR.Z);
SELECT NLIST[N.IND];
@BOX 3.1
1+> STR.Z;
IF TYP /= BSTR THEN
   0 => STR.Z
FI
TL.S.DECL(GENN(N.IND),TL.TYP[TYP ->> 3],STR.Z);
1 +> LASTMN => MUTLN;
KVAR => K;
TYP => T;
@BOX 4.1
END
@BOX 5.1
IF TYP/= 0
@BOX 6.1
IMPL.TYPE(N.IND) => TYP;
@END
///7
@TITLE BSC04.19(1,11)
@COL 11T-12R
@COL 1S-2T-4R-5R-8R-7T-10F
@ROW 11-8
@FLOW 1-2N-4-5-8-7N-10
@FLOW 2Y-5
@FLOW 7Y-11N-12-10
@FLOW 11Y-10
@BOX 1.0
GET.TYPED.NAME(DEF.TYPE) NEW.DEF.TYPE
DEF.TYPE Bits 14 = 0 IMPLICIT TYPING
              14 = 1 SPECIFIES EXPLICIT TYPE IN BITS 0-7
         Bit  15 = 0 IF EXPLICIT TYPE SET
                     NAMES MUST NOT END IN % OR $
@BOX 2.0
NEXT ITEM NOT A DATATYPE KEYWORD
@BOX 4.0
SET TYPE
[04.16]
@BOX 5.0
GET NAME[03]
@BOX 7.0
EXPLICIT TYPE GIVEN AND
% $ CHECK REQUESTED
@BOX 8.0
DETERMINE IMPLICIT TYPE
[08]
SET IMPLICIT TYPE IN RESULT
IF NO PREVIOUS EXPLICIT TYPE
@BOX 10.0
END
@BOX 11.0
NAME DOES NOT
END IN % OR $
@BOX 12.0
FAULT
@BOX 1.1
PROC GET.TYPED.NAME(TYP);
$IN IN;
$LO8 IM.TYP;
$IN K,P;
TYP => GET.TYPED.NAME;
@BOX 2.1
IF TAG OF LBUFF[1+IPTR] /= TTYPE
@BOX 4.1
DATA.TYPE[IND OF LBUFF[1+>IPTR] & %FF] ! %4000 => GET.TYPED.NAME;
@BOX 5.1
IF GET.N(LBUFF[1 +> IPTR]) => IN < 0 THEN
 0 - IN => IN;
FI;
IN => IND OF LBUFF[IPTR];
@BOX 7.1
IF TYP & %8000 = 0 AND GET.TYPED.NAME & %4000 /= 0
@BOX 8.1
IMPL.TYPE(IN) => IM.TYP;
IF GET.TYPED.NAME & %4000 = 0 THEN
   GET.TYPED.NAME & %FF00 ! IM.TYP => GET.TYPED.NAME;
FI
@BOX 10.1
END
@BOX 11.1
IF IM.TYP = B.RE
@BOX 12.1
MONITOR.N(11,IN);
@END
///14
@TITLE BSC04.20(1,11)
@COL 1S-7R-4R-5R-8R-10R-9R-11R-6F
@FLOW 1-7-4-5-8-10-9-11-6
@BOX 1.0
INIT PU TEXTUAL LEVEL
@BOX 4.0
SAVE PROGRAM TEXTUAL LEVEL
GLOBALS
@BOX 5.0
SET UP PU TEXTUAL LEVEL
GLOBALS
RESET OPTIONS
INIT CONTEXT STACK
INIT BLOCK STACK
INIT SELECT STACK
@BOX 6.0
END
@BOX 7.0
RESET TEMP VARIABLE PTR
INIT DATA VARIABLES
CHANNEL VARIABLES
@BOX 8.0
INITIALISE LABEL PROPERTIES
[08]
@BOX 9.0
INITIALISE GOSUB CONTROL [BSC06]
@BOX 10.0
DECLARE LABEL FOR PRELUDE
PLANT JUMP TO PRELUDE
DECLARE LABEL FOR POSTLUDE
RESET VARIABLE FOR POSTLUDE JUMP
FROM INTERNAL FUNCTION
DECLARE AND DEFINE PU CODE BODY LABEL
@BOX 11.0
INIT EXCEPTION HANDLER VARIABLES
@BOX 1.1
PROC INIT.PU.LEV;
@BOX 4.1
@BOX 5.1
-1=>LAST.A;
1=>PROC.LEV;
0=> CON.PTR => CON.BASE;
0 => BLK.LEV => BLK.NO => BLK.STK[0];
0 => OPTIONS;
0 => DEF.BASE;
-1 => L.CASE.ITEM => L.SEL.CONST => L.SEL.STR;
@BOX 10.1
TL.LABEL.SPEC(NIL, 1);
TL.PL(%4F, 1 +> LAST.MN => PU.PRELUDE);
TL.LABEL.SPEC(NIL, 1);
1 +> LAST.MN => PU.POSTLUDE;
0 => PU.POSTLUDE.VAR => PU.PROC.K;
TL.LABEL.SPEC(NIL,1);
1+>LAST.MN => PU.PROC.CODE.MN;
TL.LABEL(PU.PROC.CODE.MN);
@BOX 6.1
END
@BOX 7.1
0 => DATA.MN;
-1 => LAST.B => LAST.R => LAST.T;
0 => RESTORE.DV.MN;
@BOX 8.1
INIT.LABS();
@BOX 9.1
INIT.GOSUBS(0);
@BOX 11.1
0 => XH.SW.MN => IN.XH => PROT.ST => EXIT.XH.LAB.MN;
-1 => LAST.L => LAST.XH => CUR.XH.ID;
@END
@TITLE BSC04.21(1,11)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
DECL DUMMY VARIABLE (TYPE)
@BOX 2.0
DECLARE VARIABLE TO MUTL
@BOX 3.0
END
@BOX 1.1
PROC DECL.D(T);
@BOX 2.1
TL.S.DECL(NIL,T,0);
1+>LASTM.N => DECL.D;
@BOX 3.1
END
@END
///12
@TITLE BSC04.22(1,11)
@COL 1S-2R-3R-6R-7R-5R-4F
@FLOW 1-2-3-6-7-5-4
@BOX 1.0
INIT INTERNAL FUNCTION TEXTUAL LEVEL
@BOX 2.0
SAVE NECESSARY PU GLOBALS
@BOX 3.0
INIT INTERNAL FUNCTION TEXTUAL LEVEL
GLOBALS
DECLARE LABEL FOR START OF PROC CODE
@BOX 4.0
END
@BOX 5.0
INIT GOSUB CONTROL
@BOX 6.0
DECLARE PRELUDE LABEL AND
PLANT JUMP TO IT
DECLARE POSTLUDE LABEL
DECLARE AND DEFINE CODE BODY LABEL
@BOX 7.0
SELECT STACK FRAME OF PROGRAM UNIT
FOR DATA DECLARATIONS
@BOX 1.1
PROC INIT.INT.FN.LEV;
@BOX 2.1
CUR.PROC=>PU.PROC;
C.PROC.K => PU.PROC.K;
LAST.L => PU.LAST.L;
@BOX 3.1
2 => PROC.LEV;
@BOX 6.1
TL.LABEL.SPEC(NIL, 1);
TL.PL(%4F, 1 +> LAST.MN => DEF.PRELUDE);
TL.LABEL.SPEC(NIL, 1);
1 +> LAST.MN => DEF.POSTLUDE;
@BOX 7.1
TL.DATA.AREA(-1);
TL.LABEL.SPEC(NIL,1);
1+>LAST.MN =>DEF.PROC.CODE.MN;
TL.LABEL(DEF.PROC.CODE.MN);
@BOX 4.1
END
@BOX 5.1
INIT.GOSUBS(1);
@END
//17 22.JUL.83
@TITLE BSC04.23(1,11)
@COL 7R
@COL 1S-2T-3T-4R-10T-11R-8T-9R-5F-6R
@ROW 7-3
@FLOW 1-2N-3N-4-10Y-8N-5
@FLOW 8Y-9-7-5
@FLOW 2Y-7
@FLOW 3Y-6
@FLOW 10N-11-5
@BOX 1.0
LENGTH()STRING LENGTH
@BOX 2.0
NEXT ITEM NOT *
@BOX 3.0
NEXT ITEM NOT INTEGER
@BOX 4.0
SET STRING LENGTH
@BOX 5.0
END
@BOX 6.0
SYNTAX FAULT
@BOX 7.0
STRING LENGTH = DEFAULT
@BOX 8.0
LENGTH NOT ZERO
@BOX 9.0
FAULT
@BOX 10.0
STRING LENGTH < 256
@BOX 11.0
FAULT SET STRING LENGTH = 255
@BOX 1.1
PROC LENGTH;
@BOX 2.1
IF LBUFF[1+IPTR] /= AST
@BOX 3.1
IF TAG OF LBUFF[2+>IPTR] /= TCONST OR ST OF LBUFF [IPTR] & %C0 /= %40
@BOX 4.1
INT.C OF C.LIST [IND OF LBUFF [IPTR]] => LENGTH;
@BOX 5.1
END
@BOX 6.1
MONITOR(%1000);
@BOX 7.1
DEF.STRZ => LENGTH;
@BOX 8.1
IF LENGTH /= 0
@BOX 9.1
MONITOR(%12);
@BOX 10.1
IF LENGTH < 256
@BOX 11.1
MONITOR(%13);
255=>LENGTH;
@END
//16
@TITLE BSC04.24(1,11)
@COL 1S-8R-9R-10T-11T-12R-14R-15R-16R-17F
@COL 18T-19R
@ROW 12-18
@FLOW 1-8-9-10N-11N-12-14-15-10
@FLOW 10Y-16-17
@FLOW 11Y-18N-19-15
@FLOW 18Y-15
@BOX 1.0
END PROGRAM UNIT TEXTUAL LEVEL
@BOX 8.0
MONITOR ANY UNDEF LABELS [08]
@BOX 9.0
GET FIRST NON PARAMETER PROPERTY ENTRY
AT PU LEVEL
@BOX 10.0
NO MORE PROPERTY ENTRIES
@BOX 11.0
NOT NEW GLOBAL PROCEDURE ?
@BOX 12.0
COPY PROPERTY ENTRY BACK TO
OUTER LEVEL
@BOX 14.0
SAVE PARAMS AND SYMBOLIC
NAME
@BOX 15.0
GET NEXT PROPERTY ENTRY
@BOX 16.0
RESET GLOBALS FOR TEXTUAL LEVEL
@BOX 17.0
END
@BOX 18.0
NOT AN UNDEFINED EXCEPTION HANDLER ?
@BOX 19.0
FAULT
@BOX 1.1
PROC END.PU.LEV;
$IN P,I,J,Z,M;
@BOX 8.1
END.LABS();
@BOX 9.1
PU.N+1 => P;
@BOX 10.1
IF P> LASTN
@BOX 11.1
IF DETAIL1 OF NLIST[P] & %400 = 0
@BOX 12.1
NLIST[P] => NLIST[1+>PU.N];
BEGIN
SELECT NLIST[PU.N];
%FBFF & DETAIL1 ! %800 => DETAIL1;
@BOX 14.1
BASIC.N OF NLIST[P] => I -1 => M;
WHILE CH.LIST[1 +> M] /= 0 DO OD;
WHILE M >= I DO
   CH.LIST[M] => CH.LIST[1 -> GL.LASTCH];
   1 -> M;
OD
GL.LASTCH => BASIC.N;
DETAIL OF NLIST[P] => I;
PARAMS[I+1]+2 => Z -> GL.LASTP => DETAIL;
FOR J < Z DO
   PARAMS[I+J]=> PARAMS[J+GL.LASTP];
OD;
END;
@BOX 15.1
1 +> P;
@BOX 16.1
0 => PROC.LEV;
PU.MN =>LAST.MN;
PU.N => LAST.N;
0 =>LAST.CH;
0 =>LAST.P;
@BOX 17.1
END
@BOX 18.1
IF K OF NLIST[P] /= K.XH
   OR DETAIL1 OF NLIST[P] & %200 /= 0
@BOX 19.1
MONITOR.N(%5F,P);
@END
///11
@TITLE BSC04.25(1,11)
@COL 1S-2R-3R-5R-4F
@FLOW 1-2-3-5-4
@BOX 1.0
END INTERNAL FUNCTION TEXTUAL
LEVEL
@BOX 2.0
SCAN PARAMS AND LOCAL PROPERTIES
AND MARK AS ILLEGAL ALL PARAMS
@BOX 3.0
RESET PROGRAM UNIT GLOBALS
END GO SUBS [BSC06]
@BOX 4.0
END
@BOX 5.0
SELECT DATA AREA 0
@BOX 1.1
PROC END.INT.FN.LEV;
$IN P;
$LO8 KN;
@BOX 2.1
DEF.FIRST.PAR.N =>P;
WHILE 1+> P =< DEF.LAST.PAR.N DO
   IF DETAIL1 OF NLIST[P] & %10 /= 0 THEN
      BEGIN
         SELECT NLIST[P];
         KUNDEF => K;
         0 => T => DETAIL => DETAIL1 => MUTLN;
         0 => BASICN => HASH
     END
   FI
OD
@BOX 3.1
PU.PROC => CUR.PROC;
PU.PROC.K => C.PROC.K;
PU.LAST.L => LAST.L;
2 &> PROT.ST;
1 => PROC.LEV;
END.GO.SUBS(1);
@BOX 4.1
END
@BOX 5.1
TL.DATA.AREA(0);
@END
//14
@TITLE BSC04.26(1,11)
@COL 1S-2R-3R-4R-5R-6F
@FLOW 1-2-3-4-5-6
@BOX 1.0
INIT.PROG()
@BOX 2.0
PLANT CALL  TO BIO.INIT.RUN
@BOX 3.0
TOP UP POOL OF SPECS
@BOX 4.0
START A MUTL BLOCK
@BOX 5.0
INIT PU LEVEL [BSC04.20]
@BOX 6.0
END
@BOX 1.1
PROC INIT.PROG;
@BOX 2.1
DATAVEC CD.SEQ($LO16)
%102B
%46  %30
%21  %800D
%6000
%A000
END;
PL.CD.SEQ(^CD.SEQ);
@BOX 3.1
LAST.MN => PSPEC.N;
LAST.N => PU.N;
-1 => FUNCTION.N;
WHILE PSPEC.CNT < 128 DO
   TL.PROC.SPEC(NIL, %2000);
   1 +> LAST.MN;
   1 +> PSPEC.CNT;
OD
@BOX 4.1
LAST.MN => PU.MN;
TL.BLOCK();
@BOX 5.1
INIT.PU.LEV();
@BOX 6.1
END
@END
