@X @~
~V7 56 2 -5
~D10
~H                    MUSS
~
~
~D10
~H            MTL237
~D10
~MMANCHESTER UNIVERSITY  -  CONFIDENTIAL~
~
~
~V2 -16
                                                                       ISSUE 10~
~V2 0
~V9 -1
~P
~V9 1
~YMTL237
~Y
~P
~V9 -1
~D15
~HFLOWCHARTS
~
~
~H               MTL237
~V9 -1
~F
@T MTL23(7,10)
@COL 8S-1R-2R-3R-4R-6R-7F
@FLOW 8-1-2-3-4-6-7
@BOX 8.0
MODULE WHICH EXPORTS
TYPE STORE.ADDR.TY
@BOX 1.0
SECTION 23
STORAGE ALLOCATION
[IMPORTS MTL23/1]
@BOX 2.0
TYPE DECLARATIONS
@BOX 3.0
VARIABLE AND LITERAL
DECLARATIONS
@BOX 4.0
PROCEDURES

.1 ALLOCATE SEG
.2 TYPE SIZE
.3 ALLOCATE STK
.4 ST UNITS
.5 REAL.CONV
.6 STORE.LIT

.21 INIT VAR
@BOX 6.0
INITIALISATION
@BOX 7.0
END
@BOX 8.1
MODULE(STORE.ADDR.TY);
TYPE STORE.ADDR.TY IS
 $LO32 STORE.RA, STORE.CA, MUSS.SFNS
 ADDR[$LO8] STORE.DESC;
*END
@BOX 1.1
#MTL23/1
MODULE(ALLOCATE.SEG,ALLOCATE.STK,TYPE.SIZE,
C.TYPE.Z,C.TYPE.BOUNDARY,C.TYPE.OFFSET,INITVAR,STUNITS,REAL.CONV,
STORE.LIT);
@BOX 2.1
@BOX 3.1
*GLOBAL 9;
$IN C.TYPE.Z;
$IN C.TYPE.BOUNDARY,C.TYPE.OFFSET;
*GLOBAL 0;
@BOX 4.1
PSPEC ALLOCATE.SEG($IN32,$IN32,$IN32,$IN,ADDR STORE.E);
PSPEC ALLOCATE.STK($IN,$IN,$IN);
PSPEC TYPE.SIZE($IN,ADDR TYPE.E,$IN,$IN);
PSPEC INITVAR(ADDR VAR.E);
PSPEC STUNITS($IN)/$IN;
PSPEC REAL.CONV(ADDR [$LO64], $IN);
PSPEC STORE.LIT(ADDR STOREE,$IN32)/$LO32;
#MTL23.1
#MTL23.2
#MTL23.3
#MTL23.4
#MTL23.5
#MTL23.6
#MTL23.21
@BOX 6.1
@BOX 7.1
*END
::END 23
@END
@TITLE MTL23/1(7,8)
@COL 1S-2R-3R-4R-5F
@FLOW 1-2-3-4-5
@BOX 1.0
EXTERNAL
ENVIRONMENT
@BOX 2.0
TYPES
@BOX 3.0
VARIABLES &
LITERALS
@BOX 4.0
PROCEDURES
@BOX 5.0
END
@BOX 1.1
::EXTERNAL
::ENVIRONMENT
@BOX 2.1
TYPE FIELD.E;
TYPE TYPE.E IS ADDR FIELD.E TYPE.FIELD.P
               $LO8 TYPE.AL,TYPEFL
               $LO16 TYPE.Z,TYPE.LIB,TYPE.NAME;
TYPE FIELD.E IS ADDR FIELD.E NEXT.FIELD.P
                $LO16 FIELD.POS
                $LO16 FIELD.TYPE
                ADDR TYPE.E FIELD.TYPE.P
                $IN FIELD.TAG
                $IN FIELD.DIM;
TYPE STORE.ADDR.TY IS
 $LO32 STORE.RA, STORE.CA, MUSS.SFNS
 ADDR[$LO8] STORE.DESC;
TYPE STORE.E IS $IN STORE.I
                $IN STORE.Z
                $IN STORE.EQ.Z
                $LO8 STORE.KIND,SEG.NO
                STORE.ADDR.TY STORE.ADDR
                $LO8 STORE.TX
 ADDR STORE.C.ADDR
 $LO32 STORE.R.ADDR
 $LO8 STORE.BASE,STORE.ACCESS;

TYPE FWDREFTYPE IS
 $LO32 FWDADDRESS ADDR FWDREFTYPE FRLINK ADDR STOREE FWDSTORE;
TYPE VAR.UNDEF.TY IS
 ADDR FWDREFTYPE VARFWDREF,BOUNDFWDREF;
TYPE VAR.ADDR.TY IS
 ADDR STORE.E VAR.STORE.P
 $IN VAR.OFF OR
 VAR.UNDEF.TY VAR.UNDEF;
TYPE VAR.E IS
 $LO16 VAR.TYP $IN VAR.DIM $LO16 VAR.F
 ADDR TYPE.E VAR.TYP.P
 VAR.ADDR.TY VAR.ADDR;
@BOX 3.1
IMPORT LITERAL SEGSHIFT,SEGSIZE;
$LI/ADDR FWDREFTYPE NILFWDREF=;
$IN PW0,PW1;
@BOX 4.1
$LS RELEASESEGMENT($IN);
$LS CREATESEGMENT($IN,$IN);
$LS CAPTION(ADDR[$LO8]);
$LS OUTHEX($LO32,$IN);
$LS OUTI($IN,$IN);
PSPEC MONTL($IN,$IN);
PSPEC FAULT($IN,ADDR[$LO8]);
PSPEC PLANTCODE($LO,$LO);
PSPEC PLANTV16CODE($LO);
PSPEC PLANTV32CODE($LO,$LO);
PSPEC ROUNDUP($IN,$IN)/$IN;
PSPEC GETFWDREF()/ADDR FWDREFTYPE;
PSPEC RUNADDR(ADDR STOREE,$IN)/ADDR;
@BOX 5.1
::END 27/1
@END
@TITLE MTL23.2.1(7,8)
@COL 1S-2T-3T-12N-4R-5F
@COL 6T-7R
@COL 8R
@COL 9T-10R
@COL 11R
@ROW 12-6-9
@ROW 4-7-8-10-11
@FLOW 1-2N-3N-12-4-5
@FLOW 2Y-9N-10-5
@FLOW 9Y-11-5
@FLOW 3Y-6N-7-5
@FLOW 6Y-8-5
@BOX 1.0
CTYPEZ =  -1 IF NOT PTR,
SIZE IN BYTES OTHERWISE
@BOX 2.0
^ OR [] VARIABLE ?
@BOX 3.0
^ PROC OR ^ LABEL ?
@BOX 4.0
SIZE = -1
@BOX 5.0
END
@BOX 6.0
ENVIRONMENT ?
@BOX 7.0
SIZE = V32
@BOX 8.0
SIZE = V64
@BOX 9.0
BOUNDED ?
@BOX 10.0
SIZE = V32
@BOX 11.0
SIZE = V64
@BOX 1.1
@BOX 2.1
IF PTYPE&%3/=0,
@BOX 3.1
IF PTYPE=%24 OR PTYPE=%28 OR PTYPE=%2C OR PTYPE=%30,
@BOX 4.1
-1 => CTYPEZ;
@BOX 5.1
@BOX 6.1
IF PTYPE&%4=0,
@BOX 7.1
4=>CTYPEZ;
@BOX 8.1
8=>CTYPEZ;
@BOX 9.1
IF PTYPE &%3=3,
@BOX 10.1
4 => CTYPEZ;
@BOX 11.1
8=>CTYPEZ;
@END
@TITLE MTL23.1(7,8)
@COL 9R
@COL 1S-2R-3T-4T-5R-6R-7R-8F
@COL 10T-11R
@COL 13R
@ROW 4-10
@ROW 9-5-11-13
@FLOW 1-2-3Y-4-5-6-7-8
@FLOW 3N-10Y-11-7
@FLOW 4N-9-8
@FLOW 10N-13-8
@BOX1.0
ALLOCATE.SEG
(SIZE,COMP.ADDR,RUN.ADDR,KIND,SEG.P)
@BOX2.0
SET UP SEGMENT SIZE
@BOX3.0
SEGMENT REQUIRED
AT COMPILE TIME?
@BOX4.0
CREATE SEGMENT
CREATED OK?
@BOX5.0
SET RUNTIME ADDRESS
IF NOT SET
@BOX6.0
CREATE POINTER TO
COMPILE TIME SEGMENT
@BOX7.0
FILL IN STORE
ENTRY
@BOX8.0
END
@BOX9.0
FAULT
@BOX10.0
RUN TIME
ADDRESS SET?
@BOX11.0
SET NIL POINTER
FOR COMPILE TIME
SEGMENT
@BOX13.0
FAULT
@BOX1.1
PROC ALLOCATE.SEG
(SIZ,CADDR,RADDR,KIND,SEG.P);
$IN I;
ADDR[$LO8] SEG.PTR;
$LI/ADDR[$LO8] NIL=;
IF STORECADDR OF SEGP^>0 THEN
 STORECADDR OF SEGP^->>SEGSHIFT=>I;
 FOR 1<<-SEGSHIFT-1+SIZE(STOREDESC OF STOREADDR OF SEGP^)->>SEGSHIFT DO
  RELEASESEGMENT(I);
  1+>I;
 OD;
FI;
@BOX2.1
IF SIZ = 0 THEN
SEGSIZE => SIZ;
FI;
@BOX3.1
IF CADDR = -2 OR CADDR = -3,
@BOX4.1
IF CADDR => I >= 0 THEN
CADDR ->> SEG.SHIFT => I FI
CREATE.SEGMENT(I,SIZ) ::!
IF PW0 < 0,
@BOX5.1
;PW1 => I;
CAPTION(%"SEGMENT");OUTI(I,4);
CAPTION(%" CREATED$L");
I <<- SEG.SHIFT => CADDR;
IF RADDR = -1 THEN
CADDR => RADDR FI
@BOX6.1
MAKE($LO8,SIZ,CADDR) => SEG.PTR;
@BOX7.1
RADDR =>STORERADDR OF SEGP^=> STORERA OF STORE.ADDR OF SEGP^;
CADDR=>STORECADDR OF SEGP^=>STORECA OF STORE.ADDR OF SEGP^;
SEG.PTR => STOREDESC OF STORE.ADDR OF SEG.P^;
-1=>MUSS.SFNS OF STOREADDR OF SEGP^;
@BOX8.1
END
@BOX9.1
FAULT(0,%"CANT CREATE SEGMENT");
@BOX10.1
IF RADDR = -1,
@BOX11.1
;NIL => SEG.PTR;
@BOX13.1
FAULT(0,%"RUN TIME ADDRESS UNSET");
@END
@TITLE MTL23.2(7,8)
@COL 1S-2T-3T-4R-12N-13N-5T-6R-7F
@COL 8R-9T-14R-10R
@COL 11R-15R
@ROW 4-8-11
@ROW 13-14-15
@ROW 6-10
@FLOW 1-2N-3N-4-12-13-5N-6-7
@FLOW 2Y-11-9N-14-5Y-10-7
@FLOW 3Y-8-9Y-15-5
@BOX 1.0
TYPE SIZE (TYPE, ^TYPE, DIM, KIND)
@BOX 2.0
IS TYPE A POINTER ?
@BOX 3.0
IS TYPE BASIC ?
@BOX 4.0
LOOK UP SIZE AND BOUNDARY
@BOX 5.0
PARAMETER ?
@BOX 6.0
OFFSET = 0
IF DIM /= 0, SIZE * DIM
@BOX 7.0
END
@BOX 8.0
SET SIZE
@BOX 9.0
EQUIVALENCE ALLOWED?
@BOX 10.0
ROUND SIZE UP TO MULTIPLE OF V64
BOUNDARY = V64
OFFSET = EXTRA BYTES USED
@BOX 11.0
SET SIZE
@BOX 14.0
BOUNDARY = SIZE
(IF /=V32/=V64, BOUNDARY=V8)
@BOX 15.0
IF SIZE /=64, BOUNDARY = SIZE
         ELSE BOUNDARY = V32
(IF /=V32/=V64, BOUNDARY = V8)
@BOX 1.1
PROC TYPESIZE(PTYPE,TYPEINFO,DIM,KIND);
$IN TEMP;
SELECT TYPEINFO^;
$LI/ADDR TYPEE BASICTYPE=;
@BOX 2.1
#MTL23.2.1
IF CTYPEZ/=-1,
@BOX 3.1
IF TYPEINFO=BASICTYPE,
@BOX 4.1
TYPEZ => CTYPEZ;
TYPEAL => CTYPEBOUNDARY;
@BOX 5.1
IF DIM/=0 THEN
 DIM*>CTYPEZ;
FI;
IF KIND=3,
@BOX 6.1
0 => CTYPEOFFSET;
@BOX 7.1
END
@BOX 8.1
IF PTYPE>=256 THEN
 PTYPE->>9&%C!PTYPE&%FF=>PTYPE;
FI;
IF PTYPE=%20 THEN
1 => CTYPEZ;
ELSE
PTYPE ->> 2 & %F+1 => CTYPEZ;
FI;
@BOX 9.1
::FAULT IN SPEC
@BOX 10.1
CTYPEZ+7&%FFFFFF8=>TEMP;
IF TYPEINFO=BASICTYPE AND PTYPE=%C THEN:: $RE32 PARAM
 0=>CTYPEOFFSET;
ELSE
 TEMP-CTYPEZ=>CTYPEOFFSET;
FI;
TEMP=>CTYPEZ;
@BOX 11.1
@BOX 14.1
IF CTYPEZ => CTYPEBOUNDARY /=4/=8 THEN
1 => CTYPEBOUNDARY;
FI;
@BOX 15.1
IF CTYPEZ => CTYPEBOUNDARY /=4/=8 THEN
1 => CTYPEBOUNDARY;
ELSE
4 => CTYPEBOUNDARY;
FI;
@END
@TITLE MTL23.3(7,8)
@COL 1S-2R-3T-4T-5R-6R-7F
@COL 8R-9R
@ROW 5-8
@FLOW 1-2-3N-4N-5-6-7
@FLOW 3Y-6
@FLOW 4Y-8-9-7
@BOX 1.0
ALLOCATE STK (SIZE, DIM, BOUNDARY)
@BOX 2.0
PLANT DO = SF
@BOX 3.0
SCALAR ?
@BOX 4.0
USE B ?
@BOX 5.0
PLANT DB = DIM
SIZE * DIM
@BOX 6.0
ROUND SIZE UP TO V64 BOUNDARY
PLANT SF + SIZE
@BOX 7.0
END
@BOX 8.0
PLANT DB = B
@BOX 9.0
PLANT B * SIZE
PLANT ROUND B UP TO V64 BOUNDARY
PLANT SF + B
@BOX 1.1
PROC ALLOCATESTK(PSIZE,DIM,BOUNDARY);
@BOX 2.1
PLANTV16CODE(%DE43):: BA15 (DO) = SF
@BOX 3.1
IF DIM=0,
@BOX 4.1
IF DIM=-1,
@BOX 5.1
PLANTCODE(%DD00,DIM):: BA14 (DB) = DIM
DIM*>PSIZE;
@BOX 6.1
PLANTCODE(%E73C,ROUNDUP(PSIZE,3)):: SF =REF V64 .../SF
@BOX 7.1
END;
@BOX 8.1
PLANTV16CODE(%DC51):: BA14 (DB) = BM1 (B)
@BOX 9.1
IF PSIZE>0 THEN
PLANTCODE(%3700,PSIZE):: BM1 (B) * #...
ELSE
PLANTV16CODE(%3007):: BM1 (B) + #7
PLANTV16CODE(%3C03):: BM1 (B) ->> #3
FI;
PLANTV16CODE(%3007):: BM1 (B) + #7
PLANTV16CODE(%3C03):: BM1 (B) ->> #3
PLANTV32CODE(%E73D,0):: SF =REF V64 0/SF/BM1 (B)
@END
@TITLE MTL23.4(7,8)
@COL 1S-2R-3F
@BOX1.0
ST UNITS (SIZE)
@BOX2.0
RESULT = SIZE
@BOX3.0
END
@BOX1.1
PROC STUNITS(PSIZE);
@BOX2.1
PSIZE=>STUNITS;
@BOX3.1
END;
@END
@TITLE MTL23.5(7,10)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX 1.0
REAL.CONV(PTR.TO.VALUE,SIZE)
@BOX 2.0
CONVERSION
@BOX 3.0
END
@BOX 1.1
PROC REAL.CONV(P,Z);
::VAX $LO64 TEMP64;
::VAX $IN TEMP;
@BOX 2.1
::VAX IF P^[0]=>TEMP64/=0 THEN
::VAX  TEMP64&%F(4)<<-16!(TEMP64->>16&%F(4))<<-16!
::VAX  (TEMP64->>32&%F(4))<<-16!(TEMP64->>48)=>TEMP64;
::VAX  TEMP64&%80(15)=>P^[0];
::VAX  TEMP64->>55&%FF=>TEMP:: EXPONENT
::VAX  (3+TEMP->>2+32)<<-56!>P^[0];
::VAX  3&>TEMP;
::VAX  4-TEMP&%3=>TEMP;
::VAX  TEMP64&%7F(13)!%80(13)->>TEMP!>P^[0];
::VAX FI;
@BOX 3.1
END;
@END
@TITLE MTL23.6(7,8)
@COL 1S-2R-3F
@FLOW 1-2-3
@BOX1.0
STORE LIT (^STORE, OFFSET)
@BOX2.0
CALCULATE RUN TIME BIT ADDRESS
@BOX3.0
END
@BOX1.1
PROC STORE.LIT(PSTORE,OFFSET);
@BOX2.1
RUNADDR(PSTORE,OFFSET)<<-3=>STORELIT;
@BOX3.1
END;
@END
@TITLE MTL23.21(7,8)
@COL 1S-2T-3R-4F
@FLOW 1-2N-3-4
@FLOW 2Y-4
@BOX 1.0
INIT VAR (^VAR)
@BOX 2.0
IS VAR INITIALISED?
@BOX 3.0
INITIALISE VARADDR
@BOX 4.0
END
@BOX 1.1
PROC INITVAR(PVAR);
SELECT PVAR^;
@BOX 2.1
IF VARF & 3 /= 0,
@BOX 3.1
SELECT VARUNDEF OF VARADDR;
GETFWDREF()=>VARFWDREF;
GETFWDREF()=>BOUNDFWDREF;
2 !> VARF;
@BOX 4.1
END;
@END

