@X @~
~V7 56 1 -5
~D 10
~H                    MUSS
~
~
~D 10
~H             MTL093
~D 10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL
~
~
                                                             ISSUE 12~
~V9 -1
~P
~V9 1
~YMTL093
~S~M~OMUTL IMPLEMENTATION DESCRIPTION
~S~M~OSection 9 Version 3
~S~OSection 9.3 Diagnostics
~S~O1. General Description
~BThis module is concerned with procedures that accumulate information
for supporting symbolic debuggers.  A complete map of data and procedures
addresses is optionally produced at compile time.
~S~O2. Interfaces
~
Other modules used:~
~
MUTL Procedures:~
   TL.LINE~
   TL.SOURCE~
   TL.END.SOURCE~
   TL.PRINT~
   TL.BOUNDS~
~
Interface Procedures:~
   INIT.9~
   END.9~
~
Configuration Parameters:~
   R.SEG.Z~
   V.SEG.Z~
   R.REL.CD.Z~
   R.ABS.CD.Z~
   R.SRC.Z~
   R.BLK.Z~
   R.PROP.Z~
   R.AREA.Z~
   R.SEG.Z~
~
This is a configuration literal that specifies the maximum size
in bytes of the symbol file information.
~SV.SEG.Z
~BThis is a configuration literal that specifies the size in bytes of a
virtual store segment.
~SR.REL.CD.Z~
~GR.ABS.CD.Z~G~
~GR.SRC.Z~G~
~GR.BLK.Z~G~
~GR.PROP.Z~G~
~GR.AREA.Z~G~
~BThe above configuration literals specify the number of elements
in tables for collecting run-time diagnostic information.  They
refer, respectively, to the following:~
~T% 14 25 29
~
%REL.CD.T%-%Relative code table~
%ABS.CD.T%-%Absolute code table~
%SRC.T%-%Source table~
%R.BLK.T%-%Block table~
%PROP.T%-%Property table~
%R.AREA.T%-%Area table~
~Y
~V9 -1
~P
~D 15
~HFLOWCHARTS
~
~
~H                MTL093
~V9 -1
~F
@TITLE MTL09(3, 12)
@COL 1S-2R-3R-4R-5R-6R
@FLOW 1-2-3-4-5-6
@BOX 1.0
SECTION 9
DIAGNOSTIC INFORMATION
@BOX 2.0
EXTERNAL ENVIRONMENT [MTL09/1]
MODULE HEADING
@BOX 3.0
TYPE DECLARATIONS
@BOX 4.0
VARIABLE AND LITERAL DECLARATIONS
@BOX 5.0
PROCEDURES
MUTL PROCEDURES
09.1 TL.LINE
09.2 TL.SOURCE
09.3 TL.END.SOURCE
09.4 TL.PRINT
09.5 TL.BOUNDS
INTERFACE PROCEDURES
09.10 INIT.9
09.11 END.9
09.12 SAVE.TYPE
09.13 SAVE.BLOCK
09.14 SAVE.PROPS
09.15 STAT.ADDR
COMMON PROCESSING PROCEDURES
09.20 UPD.CODE.ENTRY
09.21 PROP.ENTRY
09.22 ADD.NAME
@BOX 6.0
END
@BOX 1.1
::MTL09
#MTL09/1
MODULE (TL.LINE, TL.SOURCE, TL.END.SOURCE, TL.PRINT,
        TL.BOUNDS, INIT.9, END.9, SAVE.TYPE, SAVE.BLOCK,
        SAVE.PROPS, STAT.ADDR, NAME.MASK,
        TL.PR.M, C.P.L);
@BOX 3.1
TYPE R.DIR.E IS DIR.E ENTRY
               $IN16 LEVEL;
@BOX 4.1
LITERAL/ADDR [$LO8] NIL=;
LITERAL/ADDR TYPE.E NIL.TYPE=;
LITERAL/ADDR FIELD.E NIL.FIELD=;
LITERAL/ADDR PROC.E NIL.PROC=;
LITERAL/ADDR PAR.E NIL.PAR=;
LITERAL/ADDR STORE.E NIL.STORE=;
*GLOBALS 9;
$IN32 C.P.L;
$IN TL.PR.M, NAME.MASK;
$IN IN.STAT, STAT.INST.I, R.SEG;
$IN32 STAT.STORE.I, CUR.ABS.STORE.I;
ADDR STORE.E STAT.SEG.P, CUR.ABS.SEG.P;
$LO16 [HASH.Z] HASH;
ADDR [$IN32] TBL.P;
ADDR [CODE.E] CODE.T;
ADDR [BASE.E] BASE.T;
ADDR [$LO8] R.SYMB.T;
ADDR [$LO16] PROP.T;
ADDR [AREA.E] R.AREA.T;
$IN CODE.I, BASE.I, BLK.I, PROP.I, AREA.I,
   SRC.I, NAME.CNT, SYMB.I;
$LO16 [64] SRC.STK, BLK.STK;
$IN SRC.LEV.I, BLK.LEV.I, FILL.IN.ST, FILL.IN.END;
R.DIR.E [R.SRC.Z] SRC.T;
R.BLK.E [R.BLK.Z] R.BLK.T;
R.DIR.E [R.BLK.Z] BLK.T;
$LO16 [64] SRC.LEV, BLK.LEV;
$IN32 [128] FILL.IN;
$IN CUR.ABS.PG, CUR.ABS.LN;
SPACE SPAC [2];
$IN32 CODE.SPAC;
*GLOBALS 0;
@BOX 5.1
L.SPEC TL.LINE ($IN32) /$IN;
L.SPEC TL.SOURCE (ADDR [$LO8], $IN);
L.SPEC TL.END.SOURCE ();
L.SPEC TL.BOUNDS ($IN, ADDR [$IN]);
L.SPEC TL.PRINT ($IN);
P.SPEC INIT.9 ();
P.SPEC END.9 (ADDR [$LO8], $IN);
P.SPEC SAVE.TYPE ($IN, ADDR [$IN]);
P.SPEC SAVE.BLOCK($IN);
P.SPEC SAVE.PROPS ($IN, $IN, $IN);
P.SPEC STAT.ADDR (ADDR);
P.SPEC UPD.CODE.ENTRY ($IN32, $IN, ADDR);
P.SPEC PROP.ENTRY (ADDR [$LO8], $LO16, ADDR TYPE.E, $IN32, $IN32);
P.SPEC ADD.NAME (ADDR [$LO8]) /$IN;
*CODE 3;
#MTL09.1
#MTL09.2
#MTL09.3
#MTL09.4
#MTL09.5
#MTL09.10
#MTL09.11
#MTL09.12
#MTL09.13
#MTL09.14
#MTL09.15
#MTL09.20
#MTL09.21
#MTL09.22
@BOX 6.1
*END
@END
@TITLE MTL09/1(3, 12)
@COL 1S-2R-3R-4R-5F
@FLOW 1-2-3-4-5
@BOX 1.0
EXTERNAL ENVIRONMENT
@BOX 2.0
TYPES
@BOX 3.0
LITERALS AND VARIABLES
@BOX 4.0
PROCEDURES
@BOX 5.0
END
@BOX 1.1
::BEGIN
@BOX 2.1
IMPORT TYPE STORE.ADDR.TY, TRAP.E, VAR.UNDEF.TY, PROC.ENTRY.TY;
IMPORT TYPE OPD.E;
TYPE STORE.E IS
ADDR STORE.I, STORE.Z, STORE.EQ.Z
   $LO8 STORE.KIND, SEG.NO
   STORE.ADDR.TY STORE.ADDR
   $LO8 STORE.TY
   ADDR STORE.L.ADDR
   $LO32 STORE.R.ADDR
   $LO8 STORE.BASE, STORE.ACCESS;
TYPE FIELD.E;
TYPE TYPE.E IS
   ADDR FIELD.E TYPE.FIELD.P
   $LO8 TYPE.AL, TYPE.FL
   $LO16 TYPE.Z, TYPE.LIB, TYPE.RD, TYPE.NAME;
TYPE FIELD.E IS
   ADDR FIELD.E NEXT.FIELD.P
   $LO16 FIELD.POS, FIELD.TYPE
   ADDR TYPE.E FIELD.TYPE.P
   $IN FIELD.TAG
   ADDR FIELD.DIM;
TYPE VAR.ADDR.TY IS
   ADDR STORE.E VAR.STORE.P
   ADDR VAR.OFF OR
   VAR.UNDEF.TY VAR.UNDEF;
TYPE VAR.E IS
   $LO16 VAR.TYP ADDR VAR.DIM $LO16 VAR.F
   ADDR TYPE.E VAR.TYP.P
   VAR.ADDR.TY VAR.ADDR;
TYPE PAR.E IS
   ADDR PAR.E N.PAR.P
   $LO8 PAR.TYP
   ADDR PAR.DIM
   ADDR TYPE.E PAR.TYP.P
   ADDR VAR.E PAR.REF.V.P, PAR.VAL.V.P;
TYPE PROC.E IS
   $LO8 PROC.NAT, PROC.RES.TYP, PROC.INFO
   ADDR PAR.E PROC.PAR.P
   ADDR TYPE.E PROC.RES.TYP.P
   PROC.ENTRY.TY ENTRY;
TYPE INST.SEQ.E IS
   $LO16 OP.CODE
   $LO8 STAT, REG.SPEC, OPD.KIND
   OPD.E OPD;
TYPE CODE.E IS
   $LO8 LINE.POS, REL.LINE, REL.STORE.I;
TYPE BASE.E IS
   $LO16 CODE.I, PAGE, LINE
   $IN32 AREA.POS;
TYPE R.BLK.E IS
   $LO8 BLK.KIND, TEX.LEV
   $IN16 PROPS, PROPSEND, PARAM
   TRAP.E TRAP;
TYPE DIR.E IS $IN16 SYMB.I, CODE.ST, CODE.END;
TYPE AREA.E IS $IN32 VA.ST, VA.END
               $IN16 BASE.ST, BASE.END;
IMPORT LITERAL $IN32 R.SEG.Z, SEG.SIZE;
IMPORT LITERAL R.CODE.Z, R.BASE.Z, R.BLK.Z, R.PROP.Z, SEG.SHIFT;
IMPORT LITERAL R.AREA.Z, R.SRC.Z, INST.SEQ.Z, SEG.Z, R.SYMB.Z, HASH.Z;
@BOX 3.1
ADDR STORE.E CODE.SEG.P;
$IN INST.I, TL.M;
$IN LAST.G.NAME;
ADDR PW0, PW1;
ADDR VAR.E CUR.VAR.P;
ADDR PROC.E CUR.PROC.P;
ADDR TYPE.E CUR.TYPE.P;
INST.SEQ.E [INST.SEQ.Z] INST;
STORE.E [SEG.Z] SEG.T;
@BOX 4.1
P.SPEC PRINT.TYPE ($IN, ADDR [$IN]);
P.SPEC PRINT.VARS ($IN, $IN, $IN);
P.SPEC PRINT.SEGS();
P.SPEC YIELD.SYMB.NAME ($IN) /ADDR [$LO8];
P.SPEC GET.KIND($IN) /$IN;
P.SPEC SYMB.NAME($IN) /ADDR [$LO8];
P.SPEC ADDRESS (ADDR STORE.E, $IN32) /$LO32;
P.SPEC PROP.PTR ($IN, $IN);
P.SPEC FAULT($IN, ADDR [$LO8]);
L.SPEC CREATE.FILE.SEGMENT ($IN, $IN, ADDR[$LO8], $LO64);
L.SPEC RELEASE.SEGMENT ($IN);
L.SPEC FILE (ADDR [$LO8], $LO64, $IN);
@BOX 5.1
::END
@END
@TITLE MTL09.1(3, 12)
@COL 1S-2R-3T-4R-5T-6R-7R-8F
@COL 9R
@ROW 6-9
@FLOW 1-2-3N-4-5N-6-7-8
@FLOW 3Y-6
@FLOW 5Y-9-7
@BOX 1.0
TL.LINE (PAGE.LINE.POS)
@BOX 2.0
NOTE CURRENT PAGE AND LINE
@BOX 3.0
CODE POSITION OF THIS STATEMENT SAME
AS LAST STATEMENT
@BOX 4.0
ALLOCATE CODE TABLE ENTRY
@BOX 5.0
ACTUAL ADDRESS NOT YET KNOWN
@BOX 6.0
UPDATE CODE ENTRY [MTL09.21]
@BOX 7.0
NOTE CODE POSITION OF STATEMENT
@BOX 8.0
END
@BOX 9.0
ADD ENTRY TO FILL IN TABLE
TAG LAST INSTRUCTION OF PREVIOUS STATEMENT,
TO RETURN ADDRESS OF STATEMENT
@BOX 1.1
PROC TL.LINE (P.L.P);
@BOX 2.1
P.L.P => C.P.L;
@BOX 3.1
IF STORE.I OF CODE.SEG.P^ = STAT.STORE.I AND
   INST.I = STAT.INST.I AND
   CODE.SEG.P = STAT.SEG.P
@BOX 4.1
1 +> CODE.I;
@BOX 5.1
IF INST.I => STAT.INST.I /= 0
@BOX 6.1
UPD.CODE.ENTRY (C.P.L, CODE.I,STORE.I OF CODE.SEG.P^);
@BOX 7.1
STORE.I OF CODE.SEG.P^ => STAT.STORE.I;
CODE.SEG.P => STAT.SEG.P;
INST.I => STAT.INST.I;
@BOX 8.1
END
@BOX 9.1
C.P.L => FILL.IN [2 + FILL.IN.END & %7F => FILL.IN.END];
CODE.I => FILL.IN [1 + FILL.IN.END];
1 !> STAT OF INST [INST.I];
@END
@TITLE MTL09.2(3, 12)
@COL 1S-4T-5R-6R-7R-8F
@FLOW 1-4N-5-6-7-8
@FLOW 4Y-6
@BOX 1.0
TL.SOURCE (NAME, KIND)
@BOX 4.0
IMPLICIT CALL OF TL.END.SOURCE
NOT REQUIRED AT CURRENT SOURCE LEVEL
@BOX 5.0
PROCESS IMPLICIT TL.END.SOURCE
@BOX 6.0
SAVE SYMBOLIC NAME
@BOX 7.0
ADD SOURCE TABLE ENTRY
UPDATE SOURCE STACK
UPDATE SOURCE LEVEL TABLE
@BOX 8.0
END
@BOX 1.1
PROC TL.SOURCE (NAM, K);
$LO16 T;
$IN I, L;
@BOX 4.1
IF K = 0
@BOX 5.1
TL.END.SOURCE();
@BOX 6.1
ADD.NAME(NAM) => I;
@BOX 7.1
SELECT SRC.T [1+>SRC.I];
CODE.I + 1 => CODE.ST OF ENTRY;
I => SYMB.I OF ENTRY;
1 +> SRC.LEV.I => LEVEL;
SRC.I => SRC.STK [SRC.LEV.I];
1+>SRC.LEV [SRC.LEV.I];
@BOX 8.1
END
@END
@TITLE MTL09.3(1, 12)
@COL 1S-6R-7F
@FLOW 1-6-7
@BOX 1.0
TL.END.SOURCE()
@BOX 6.0
UPDATE SOURCE TABLE ENTRY
REMOVE SOURCE STACK ENTRY
@BOX 7.0
END
@BOX 1.1
PROC TL.END.SOURCE;
@BOX 6.1
CODE.I + 1 => CODE.END OF ENTRY OF SRC.T [SRC.STK [SRC.LEV.I]];
1 -> SRC.LEV.I;
@BOX 7.1
END;
@END
@TITLE MTL09.4(3, 12)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
TL.PRINT(MODE)
@BOX 2.0
SAVE MODE
@BOX 3.0
END
@BOX 1.1
PROC TL.PRINT(M);
@BOX 2.1
M => TL.PR.M;
@BOX 3.1
END
@END
@TITLE MTL09.5(3, 12)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
TL.BOUNDS(NAME, BOUNDS)
@BOX 2.0
NO ACTION
@BOX 3.0
END
@BOX 1.1
PROC TL.BOUNDS(NAM, BNDS);
@BOX 2.1
::NOT IMPLEMENTED
@BOX 3.1
END
@END
@TITLE MTL09.10(3, 12)
@COL 1S-2T-3R-4T-5R-6R-7F
@COL 8R
@ROW 5-8
@FLOW 1-2N-3-4N-5-6-7
@FLOW 2Y-7
@FLOW 4Y-8
@BOX 1.0
INIT.9
@BOX 2.0
RUNTIME
DIAGNOSTIC NOT REQUESTED
@BOX 3.0
CREATE DATASPACE FOR SYMBOL
INFORMATION
@BOX 4.0
UNABLE TO CREATE DATASPACE
@BOX 5.0
MAKE PTRS TO ALL SYMBOL TABLES
@BOX 6.0
INITIALISE SYMBOL TABLES
@BOX 7.0
END
@BOX 8.0
FAULT
@BOX 1.1
PROC INIT.9;
$IN I;
ADDR Z;
@BOX 2.1
IF TLM & 1 /= 0
@BOX 3.1
CREATE.FILE.SEGMENT (-1, R.SEG.Z, NIL, 0);
@BOX 4.1
IF PW0 /= 0
@BOX 5.1
PW1 => R.SEG <<- SEG.SHIFT => SPAC;
MAKE ($IN32, 22 => Z, SPAC) => TBL.P;
SPAC => CODE.SPAC;
MAKE (CODE.E, R.CODE.Z => Z, SPAC) => CODE.T;
MAKE (BASE.E, R.BASE.Z => Z, SPAC) => BASE.T;
MAKE ($LO16, R.PROP.Z => Z, SPAC) => PROP.T;
MAKE (AREA.E, R.AREA.Z => Z, SPAC) => R.AREA.T;
MAKE ($LO8, R.SYMB.Z => Z, SPAC) => R.SYMB.T;
@BOX 6.1
0 => CODE.I => BLK.I => PROP.I
   => SRC.I;
-1 => SRC.LEV.I => BLK.LEV.I;
0 => FILL.IN.ST;
-2 => FILL.IN.END;
FOR I < 64 DO
   0 => SRC.LEV [I] => BLK.LEV [I];
OD
NIL.STORE => CUR.ABS.SEG.P;
0 => AREA.I;
0 => NAME.CNT => SYMB.I;
%FFFF => CODE.I OF BASE.T^ [1];
@BOX 7.1
END
@BOX 8.1
FAULT (%80, %"UNABLE TO CREATE SEGMENT");
@END
@TITLE MTL09.11(3, 12)
@COL 1S-14R-2T-4R-5R-6T-7R-8T-10T-11R-12R-13F
@FLOW 1-14-2N-4-5-6N-7-8-10N-11-12-13
@FLOW 8Y-11
@FLOW 2Y-13
@FLOW 6Y-11
@BOX 1.0
END.9 (FILE.NAME, STATUS)
@BOX 2.0
NO RUN TIME DIAGNOSTICS
@BOX 4.0
COMPACT SYMBOL TABLES
 [MTL09.11.1]
SUBPROCEDURE ADD.DIR
 [MTL09.11.2]
@BOX 5.0
SET UP SYMBOL FILE NAME
FOR EACH SEG IN DATASPACE
@BOX 6.0
FILE NOT REQUIRED
@BOX 7.0
CHANGE SIZE IF NECESSARY
@BOX 8.0
FILE SEGMENT
UPDATE FILE.NAME
OK?
@BOX 10.0
FAULT
@BOX 11.0
RELEASE SEGMENT
@BOX 12.0
REPEAT
@BOX 13.0
END
@BOX 14.0
PRINT SEGMENT MAP IF REQUESTED
@BOX 1.1
PROC END.9(FN, STAT);
$LO8 [256] NAME;
$IN Z, I, J, S, K, M, N,FRIG;
$IN32 F.Z, A.Z, R.Z, ST, S.Z;
@BOX 2.1
IF TL.M & 1 /= 0
@BOX 4.1
PSPEC ADD.DIR (ADDR [R.DIR.E], ADDR [$LO16], $IN);
#MTL09.11.1
#MTL09.11.2
@BOX 5.1
SIZE (FN) => Z;
FOR I < Z DO
   FN^ [I] => NAME [I];
OD
'Z => NAME [Z];
'0 => NAME [1+>Z];
PART (^NAME, 0, Z) => FN;
0 => A.Z;
WHILE A.Z < R.SEG.Z DO
@BOX 6.1
IF F.Z - A.Z => S.Z =< 0 OR STAT /= 0
@BOX 7.1
IF S.Z < SEG.SIZE THEN
   CHANGE.SIZE(R.SEG, S.Z)
FI
@BOX 8.1
FILE (FN, 0, R.SEG);
1 +> NAME [Z];
IF PW0 = 0
@BOX 10.1
FAULT(0, %"UNABLE TO FILE");
@BOX 11.1
RELEASE.SEGMENT (R.SEG);
1 +> R.SEG;
@BOX 12.1
SEG.SIZE +> A.Z;
OD
@BOX 13.1
END
@BOX 14.1
IF TL.PR.M & %4 /= 0 THEN
   PRINT.SEGS();
FI
@END
@TITLE MTL09.11.1(3, 12)
@COL 1S-2R-3R-5R-6R-10R-8R-9R-4R-11R-12F
@FLOW 1-2-3-5-6-10-8-9-4-11-12
@BOX 1.0
COMPACT SYMBOL TABLES
@BOX 2.0
NOTE POSITION AND SIZE OF CODE TABLE
@BOX 3.0
COPY BACK BASE TABLE
NOTE ITS POSITION AND SIZE
@BOX 4.0
ADD BLOCK PROPERTY TABLE
NOTE ITS POSITION AND SIZE
@BOX 5.0
COPY BACK PROPERTY TABLE
NOTE ITS POSITION AND SIZE
@BOX 6.0
COPY BACK AREA TABLE
NOTE ITS POSITION AND SIZE
@BOX 8.0
ADD SOURCE LEVEL TABLE
ADD SOURCE SUB DIRECTORIES [MTL09.11.2]
@BOX 9.0
ADD BLOCK LEVEL TABLE
ADD BLOCK SUB DIRECTORIES [MTL09.11.2]
@BOX 10.0
COPY SYMBOLIC NAME TABLE
NOTE ITS POSITION AND SIZE
@BOX 11.0
GET SIZE OF SYMBOL INFO
SET SIZE AND NO. OF FILES
@BOX 12.0
END
@BOX 1.1
::BEGIN
BYTE (TBL.P) => ST;
@BOX 2.1
BYTE (CODE.T) - ST => TBL.P^ [2];
CODE.I+1 => TBL.P^ [3];
CODE.SPAC => SPAC;
MAKE (CODE.E, CODE.I+1=>FRIG, SPAC);
@BOX 3.1
ADDR [BASE.E]C.BASE.T;
MAKE (BASE.E, BASE.I+1=>FRIG, SPAC) => C.BASE.T;
BYTE (C.BASE.T) - ST => TBL.P^ [4];
BASE.I + 1 => TBL.P^ [5];
FOR J < BASE.I + 1 DO
   BASE.T^ [J] => C.BASE.T^ [J];
OD;
@BOX 4.1
ADDR [R.BLK.E] C.R.BLK.T;
MAKE (R.BLK.E, BLK.I+1=>FRIG, SPAC) => C.R.BLK.T;
BYTE (C.R.BLK.T) - ST => TBL.P^ [20];
BLK.I + 1 => TBL.P^ [21];
FOR J < BLK.I DO
   R.BLK.T [J+1] => C.R.BLK.T^ [1+>BLK.LEV [LEVEL OF BLK.T [J+1]]-1]
OD
@BOX 5.1
ADDR [$LO16] C.PROP.T;
MAKE ($LO16, PROP.I+1=>FRIG, SPAC) => C.PROP.T;
BYTE (C.PROP.T) - ST => TBL.P^ [6];
PROP.I+1 => TBL.P^ [7];
FOR J < PROP.I + 1 DO
   PROP.T^ [J] => C.PROP.T^ [J];
OD
@BOX 6.1
ADDR [AREA.E] C.R.AREA.T;
BEGIN
   SELECT R.AREA.T^[AREA.I];
   BASE.I + 1 => BASE.END;
   ADDRESS(CUR.ABS.SEG.P,STORE.I OF CUR.ABS.SEG.P^) => VA.END;
END
MAKE(AREA.E, AREA.I+1=>FRIG, SPAC) => C.R.AREA.T;
BYTE (C.R.AREA.T) - ST => TBL.P^ [8];
AREA.I + 1 => TBL.P^ [9];
FOR J < AREA.I+1 DO
   R.AREA.T^ [J] => C.R.AREA.T^ [J]
OD
@BOX 8.1
ADD.DIR (^SRC.T, ^SRC.LEV, 12);
@BOX 9.1
ADD.DIR (^BLK.T, ^BLK.LEV, 16);
@BOX 10.1
ADDR [$LO8] C.SYMB.T;
MAKE ($LO8, SYMB.I+1=>FRIG, SPAC) => C.SYMB.T;
BYTE (C.SYMB.T) - ST => TBL.P^ [10];
SYMB.I + 1 => TBL.P^ [11];
FOR J < SYMB.I + 1 DO
   R.SYMB.T^ [J] => C.SYMB.T^ [J];
OD
@BOX 11.1
ADDR $LO8 PEND;
MAKE($LO8, 0, SPAC) => PEND;
BYTE(PEND) - ST => FZ;
F.Z + SEG.SIZE-1/SEG.SIZE => TBL.P^ [0];
F.Z => TBL.P^ [1];
@BOX 12.1
::END
@END
@TITLE MTL09.11.2(1, 12)
@COL 1S-2R-3R-4R-5F
@FLOW 1-2-3-4-5
@BOX 1.0
ADD.DIR(^DIR, ^LEVEL.TABLE, POSITION)
@BOX 2.0
COUNT NO OF SUBDIRECTORY LEVELS
@BOX 3.0
ADD LEVEL TABLE TO FILE
NOTE ITS SIZE AND POSITION
@BOX 4.0
ADD SUB DIRECTORIES TO FILE
NOTE POSITION AND SIZE OF DIRECTORY
@BOX 5.0
END
@BOX 1.1
PROC ADD.DIR(DIR, LEV, I);
$IN J, N, L,FRIG,T;
ADDR [$LO16] C.LEV;
ADDR [DIR.E] C.DIR;
$LO16 [64] SD;
@BOX 2.1
-1 => J;
1 => N;
WHILE LEV^ [1+>J] /= 0 DO
   LEV^[J] => T;
   N => LEV^[J] => SD[J] + T => N;
OD
N => LEV^ [J];
@BOX 3.1
MAKE($LO16, J+1=>FRIG, SPAC) => C.LEV;
BYTE(C.LEV)-ST => TBL.P^ [I];
J+1 => TBL.P^ [I+1];
FOR K < J + 1 DO
   LEV^ [K] => C.LEV^ [K];
OD
@BOX 4.1
MAKE(DIR.E, N, SPAC) => C.DIR;
BYTE (C.DIR)-ST => TBL.P^ [I+2];
N => TBL.P^ [I+3];
0 => J;
WHILE 1 +> J < N DO
   SD [LEVEL OF DIR^ [J] => L] => K;
      ENTRY OF DIR^ [J] => C.DIR^ [K];
      1 +> SD [L];
OD
@BOX 5.1
END
@END
@TITLE MTL09.12(3, 12)
@COL 1S-2R-3T-14T-4T-5R-6R-7R-9T-10R-8T-13R-11F
@COL 12R
@ROW 10-12
@FLOW 1-2-3N-14N-4N-5-6-7-9N-10-8N-13-11
@FLOW 3Y-11
@FLOW 4Y-12-11
@FLOW 8Y-9Y-12
@FLOW 14Y-11
@BOX 1.0
SAVE TYPE (MUTL.NAME, PTR TO FIELD NAMES)
@BOX 2.0
PRINT TYPE IN COMPILE MAP
IF NECESSARY
@BOX 3.0
RUN TIME DIAGNOSTICS NOT REQUIRED?
@BOX 4.0
PROPERTY TABLE FULL?
@BOX 5.0
ADD TYPE HEADER ENTRY TO
PROPERTY TABLE
@BOX 6.0
NOTE IN MUTL PROPS
IDENTIFIER FOR RUNTIME DIAGNOSTIC INFO
@BOX 7.0
GET FIRST FIELD OF TYPE
@BOX 8.0
MORE FIELDS
@BOX 9.0
PROPERTY TABLE FULL
@BOX 10.0
ADD FIELD ENTRY TO PROPERTY
TABLE
@BOX 11.0
END
@BOX 12.0
FAULT
RESET TABLE
@BOX 13.0
TAG LAST FIELD
@BOX 14.0
DETAILS OF TYPE ALREADY SAVED?
@BOX 1.1
PROC SAVE.TYPE(MN, NAMES);
ADDR FIELD.E FP;
$IN I, LAST, T;
ADDR TYPE.E TYP;
@BOX 2.1
IF TL.PR.M & %20 /=0 THEN
   PRINT.TYPE(MN, NAMES);
FI
@BOX 3.1
IF TL.M & 1 /= 0
@BOX 4.1
IF PROP.I + 10 > R.PROP.Z
@BOX 5.1
ADD.NAME(SYMB.NAME(TYPE.NAME)) => PROP.T^ [1+PROP.I];
TYPE.Z => PROP.T^ [2+>PROP.I];
@BOX 6.1
PROP.I - 1 => TYPE.RD;
@BOX 7.1
TYPE.FIELD.P => FP;
-1 => I;
@BOX 8.1
IF NEXT.FIELD.P OF FP^ => FP /= NIL.FIELD
@BOX 9.1
IF PROP.I+10 > R.PROP.Z
@BOX 10.1
1 + PROP.I => LAST;
PROP.ENTRY (SYMB.NAME(NAMES^ [1+>I]), FIELD.TYPE OF FP^,
   FIELD.TYPE.P OF FP^, FIELD.DIM OF FP^,
   FIELD.POS OF FP^);
@BOX 11.1
END
@BOX 12.1
FAULT(19, %"MURD PROP.T");
@BOX 13.1
%8000 !> PROP.T^ [LAST];
@BOX 14.1
PROP.PTR(MN, 9);
SELECT CUR.TYPE.P^;
IF TYPE.RD  /= 0
@END
@TITLE MTL09.13(3, 12)
@COL 1S-2T-3T-4R-5R-6F
@COL 7R
@ROW 4-7
@FLOW 1-2N-3N-4-5-6
@FLOW 2Y-6
@FLOW 3Y-7-4
@BOX 1.0
SAVE.BLOCK(KIND)
@BOX 2.0
RUN TIME DIAGNOSTICS NOT REQUIRED?
@BOX 3.0
BLOCK TABLE FULL?
@BOX 4.0
ADD BLOCK TABLE ENTRY
ADD BLOCK DIRECTORY ENTRY
@BOX 5.0
UPDATE BLOCK STACK
UPDATE BLOCK LEVEL COUNT
@BOX 6.0
END
@BOX 7.0
FAULT
RESET TABLE
@BOX 1.1
PROC SAVE.BLOCK(MN);
@BOX 2.1
IF TL.M & 1 /= 0
@BOX 3.1
IF 1 +> BLK.I > R.BLK.Z
@BOX 4.1
SELECT R.BLK.T [BLK.I];
SELECT BLK.T [BLK.I];
IF MN < 2 THEN
   0 => SYMB.I OF ENTRY;
   MN => BLK.KIND;
   0 => TEX.LEV;
ELSE
   PROP.PTR(MN, 6);
   ADD.NAME(YIELD.SYMB.NAME(MN)) => SYMB.I OF ENTRY;
   (IF PROC.NAT OF CUR.PROC.P^ & 1 = 0 THEN
      2 ELSE 3) => BLK.KIND;
   0 => TEX.LEV;  ::FIX
FI
CODE.I+1 => CODE.ST OF ENTRY;
@BOX 5.1
BLK.I => BLK.STK [1 +> BLK.LEV.I => LEVEL];
1 +> BLK.LEV [BLK.LEV.I];
@BOX 6.1
END
@BOX 7.1
FAULT(19, %"MURD BLK.PROP.T");
-1 => BLK.I;
@END
@TITLE MTL09.14(3, 12)
@COL 15R-16C
@COL 1S-2R-3T-5R-6T-7R-8F-9T-18T-10T-11T-12R-13R
@COL 17R
@ROW 15-10
@ROW 17-12
@FLOW 1-2-3N-5-6N-7-8
@FLOW 6Y-9N-18N-10N-11N-12-13-6
@FLOW 9Y-15-16
@FLOW 10Y-17-13
@FLOW 11Y-13
@FLOW 18Y-13
@FLOW 3Y-8
@BOX 1.0
SAVE.PROPS (FIRST.NAME, LAST.NAME, PROC.MN)
@BOX 2.0
PRINT DATA MAP IF NECESSARY
@BOX 3.0
RUN TIME DIAGNOSTICS NOT REQUIRED?
@BOX 5.0
REMOVE BLOCK STACK ENTRY
COUNT NO OF PARAMETERS
@BOX 6.0
MORE MUTL NAMES?
@BOX 7.0
COMPLETE PROPERTIES
@BOX 8.0
END
@BOX 9.0
PROPERTY TABLE FULL
@BOX 10.0
NAME A TYPE?
@BOX 11.0
NOT A VARIABLE OR
VARIABLE HAS NO NAME?
@BOX 12.0
ADD VARIABLE ENTRY TO PROPERTY
UPDATE COUNT OF NAMED PARAMS
TABLE
@BOX 13.0
GET NEXT MUTL NAME
@BOX 15.0
FAULT
RESET TABLE
@BOX 16.0
EXIT
@BOX 17.0
ADD TYPE ENTRY TO PROP TABLE
@BOX 18.0
IMPORT ENTITY
@BOX 1.1
PROC SAVE.PROPS (FN, LN, MN);
$IN I, PN, CNT, J, K;
ADDR [$LO8] N;
ADDR PAR.E PP;
@BOX 2.1
IF TL.PR.M & %24 /= 0 THEN
   PRINT.VARS (FN, LN, MN);
   IF MN = 0 THEN
      PRINT.VARS(LAST.G.NAME,1983,0);
   FI
FI
@BOX 3.1
IF TL.M & 1 /= 0
@BOX 5.1
SELECT R.BLK.T [BLK.STK [BLK.LEV.I] => J];
1 -> BLK.LEV.I;
1 + PROP.I => PROPS;
FN => PN;
0 => CNT;
IF MN >= 2 THEN
   PROP.PTR(MN, 6);
   PROC.PAR.P OF CUR.PROC.P^ => PP;
   WHILE PP /= NIL.PAR DO
      1 +> PN;
      N.PAR.P OF PP^ => PP;
   OD
FI
@BOX 6.1
IF FN > LN AND MN = 0 AND LN /= 1983 THEN
   1983 => LN;
   LAST.G.NAME => FN;
FI
IF FN =< LN
@BOX 7.1
PROP.I => PROPS.END;
CODE.I => CODE.END OF ENTRY  OF BLK.T [J];
CNT => PARAM;
@BOX 8.1
END
@BOX 9.1
IF PROP.I + 10 > R.PROP.Z
@BOX 10.1
IF K & %F = 9
@BOX 11.1
IF K /= 4 OR YIELD.SYMB.NAME (FN) => N = NIL
@BOX 12.1
IF FN < PN THEN
   1 +> CNT;
FI
PROP.PTR(FN, 4);
SELECT VAR.ADDR OF CUR.VAR.P^;
PROP.ENTRY(N, VAR.TYP OF CUR.VAR.P^, VAR.TYP.P OF CUR.VAR.P^,
             VAR.DIM OF CUR.VAR.P^, ADDRESS (VAR.STORE.P, VAR.OFF));
@BOX 13.1
1 +> FN;
@BOX 15.1
FAULT(19, %"MURD PROP.T");
@BOX 16.1
EXIT;
@BOX 17.1
PROP.PTR(FN, 9);
TYPE.RD OF CUR.TYPE.P^ ! %8000 !> PROP.T^ [1+>PROP.I];
@BOX 18.1
GET.KIND(FN) => K;
IF K & %80 /= 0
@END
@TITLE MTL09.15(3, 12)
@COL 1S-2R-3R-4F
@FLOW 1-2-3-4
@BOX 1.0
STAT.ADDR(STORE.INDEX)
@BOX 2.0
GET PAGE, LINE, POS OF
HELD BACK INSTRUCTION
AND UPDATE CODE TABLE ENTRY
@BOX 3.0
ADVANCE TO NEXT HELD BACK
STATEMENT
@BOX 4.0
END
@BOX 1.1
PROC STAT.ADDR(ST.I);
@BOX 2.1
UPD.CODE.ENTRY (FILL.IN [FILL.IN.ST], FILL.IN [FILL.IN.ST+1],ST.I);
@BOX 3.1
2 + FILL.IN.ST & %7F => FILL.IN.ST;
@BOX 4.1
END
@END
@TITLE MTL09.20(3, 12)
@COL 10R
@COL 1S-2T-3T-8T-9T-4R-5R-6F
@COL 7R
@ROW 10-4
@ROW 3-7
@FLOW 1-2N-3N-8N-9N-4-5-6
@FLOW 2Y-7-4
@FLOW 3Y-4
@FLOW 8Y-10-5
@FLOW 9Y-5
@BOX 1.0
UPD.CODE.ENTRY (PAGE.LINE.POS, CODE.INDEX,STORE.INDEX)
@BOX 2.0
CHANGE IN MUTL SEGMENT?
@BOX 3.0
CODE POSITION NOT IN RANGE
@BOX 4.0
ADD ENTRY TO BASE TABLE
@BOX 5.0
FILL IN CODE ENTRY
@BOX 6.0
END
@BOX 7.0
ADD ENTRY TO AREA TABLE
@BOX 8.0
PAGE = 1 AND LINE NO < 256
@BOX 9.0
NO RESET REQUIRED OF PAGE AND LINE
@BOX 10.0
NOTE CODE ENTRY HAS
ABSOLUTE PAGE AND LINE
@BOX 1.1
PROC UPD.CODE.ENTRY (P.L.P, CD.I,ST.I);
$LO PG, LN, POS;
@BOX 2.1
P.L.P & %FFFF => LN;
P.L.P ->> 16 & %1FF => PG;
P.L.P ->> 7 & %25 => POS;
IF CODE.SEG.P /= CUR.ABS.SEG.P
@BOX 3.1
IF ST.I - CUR.ABS.STORE.I >= 256
@BOX 4.1
IF CODE.I OF BASE.T^ [BASE.I] /= CD.I THEN
   1 +> BASE.I;
   CD.I => CODE.I OF BASE.T^ [BASE.I]
FI
SELECT BASE.T^ [BASE.I];
PG => CUR.ABS.PG => PAGE;
LN => CUR.ABS.LN => LINE;
ST.I  => CUR.ABS.STORE.I;
@BOX 5.1
SELECT CODE.T^ [CD.I];
   POS => LINE.POS;
   LN => CUR.ABS.LN => REL.LINE;
   ST.I - CUR.ABS.STORE.I => REL.STORE.I;
@BOX 6.1
END
@BOX 7.1
IF AREA.I >= 0 THEN
   BEGIN
   SELECT R.AREA.T^[AREA.I];
   BASE.I + 1 => BASE.END;
   ADDRESS(CUR.ABS.SEG.P,STORE.I OF CUR.ABS.SEG.P^)=>VA.END;
   END
FI
SELECT R.AREA.T^[1 +> AREA.I];
BASE.I + 1 => BASE.ST;
ADDRESS(CODE.SEG.P,ST.I) => VA.ST;
CODE.SEG.P => CUR.ABS.SEG.P;
@BOX 8.1
IF PG = 1 AND LN < 256
@BOX 9.1
IF PG = CUR.ABS.PG AND LN - CUR.ABS.LN >= 0 < 256
@BOX 10.1
%80 !> POS;
@END
@TITLE MTL09.21(3, 12)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
PROP.ENTRY (NAME, TYPE, TYPE.PTR, DIMENSION, POSITION)
@BOX 2.0
ADD PROP.T ENTRY
@BOX 3.0
END
@BOX 1.1
PROC PROP.ENTRY (NAME, TYP, T.P, DIM, POS);
$IN P;
@BOX 2.1
ADD.NAME(NAME) => PROP.T^ [1+>PROP.I=>P];
IF T.P /= NIL.TYPE THEN
   TYPE.RD OF T.P^ !> TYP;
FI
IF DIM /= 0 THEN
   %8000 !> TYP;
   DIM ->> 16 => PROP.T^ [3+PROP.I];
   DIM & %FFFF => PROP.T^ [4+PROP.I];
   2 +> PROP.I;
FI
3 +> PROP.I;
TYP => PROP.T^ [1+P];
POS => PROP.T^ [2+P];
@BOX 3.1
END
@END
@TITLE MTL09.22(3,12)
@COL 1S-2T-3R-4T-5T-10R-6R
@COL 7C-8R-9F
@ROW 3-7
@ROW 5-8
@FLOW 1-2N-3-4N-5N-10Y-9
@FLOW 5Y-6-4Y-8-9
@FLOW 2Y-7
@BOX 1.0
ADD.NAME(NAME)
@BOX 2.0
HASH TABLE FULL?
@BOX 3.0
CALCULATE FIRST PROBE
@BOX 4.0
NO NAME AT PROBE ?
@BOX 5.0
NAMES DIFFERENT ?
@BOX 6.0
CALCULATE NEXT PROBE
@BOX 7.0
FAULT
@BOX 8.0
ADD NAME
@BOX 9.0
END
@BOX 10.0
SET RESULT
@BOX 1.1
PROC ADD.NAME(N);
$IN32 H,Q,R;
$IN I,Z,P,F;
@BOX 2.1
IF NAME.CNT + 20 > HASH.Z
@BOX 3.1
0 => H;
FOR I < SIZE(N) => Z DO
   H <<- 3 + N^[I] & %F(7) => H;
OD
H / HASH.Z => Q * HASH.Z -: H => R;
@BOX 4.1
IF HASH[R] => P = 0
@BOX 5.1
Z - 1 => F;
IF R.SYMB.T^[P+Z] = 0 THEN
   WHILE F >= 0 AND N^[F] = R.SYMB.T^[P+F] DO
      1 -> F;
   OD
FI
IF F >= 0
@BOX 6.1
IF Q = 0 THEN 1 => Q FI;
R + Q => R / HASH.Z * HASH.Z -> R;
@BOX 7.1
FAULT(%93,%"MURD HASH");
@BOX 8.1
1 +> NAME.CNT;
1 + SYMB.I => ADD.NAME => HASH[R];
FOR I < Z DO
   N^[I] => R.SYMB.T^[1 +> SYMB.I];
OD
0 => R.SYMB.T^[1 +> SYMB.I];
@BOX 9.1
END
@BOX 10.1
P => ADD.NAME;
@END
