         << LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION >>     00000001
$CONTROL CODE,MAP,NOWARN,LIST,USLINIT,PRIVILEGED               <<*1398>>00004000
         EQUATE CSTMAXENT=%4377,CSTMAXENT'=255,CSTSIZE=4;      <<*1398>>00458000
LOGICAL NEW'LOADMAP;                                           <<*1929>>00666200
LOGICAL OPT;  << LP OUTPUT FILE OPTIONS >>                     <<*1398>>00746250
INTEGER TAPEF,VMFILE;                                          <<*1398>>00746500
INTEGER DEVTYPE;                                               <<*1398>>00746600
LOGICAL CURRENTVOL := 0;                                       <<*1398>>00746700
INTEGER SPOOL'FILE'COUNT := 0;                                 <<*1398>>00746800
LOGICAL USE'PSEUDO'DST := FALSE;                               <<*1398>>00747000
LOGICAL VM'INUSE, PDSTNO, GET'FILES;                           <<*1398>>00747300
LOGICAL ARRAY DST'ENTRY(0:3);                                  <<*1398>>00747500
      DEFINE                                                   <<*1398>>00747510
        << DATA SEGMENT TABLE ENTRY >>                         <<*1398>>00747520
        DSABSENT = DST'ENTRY(0).(0:1) #,                       <<*1398>>00747530
        DSROC    = DST'ENTRY(1).(1:1) #,                       <<*1398>>00747540
        DSDCV    = DST'ENTRY(1).(0:1) #,                       <<*1398>>00747550
        DSIMI    = DST'ENTRY(1).(2:1) #;                       <<*1398>>00747560
      DEFINE                                                   <<*1398>>00747570
        MAXDOUBLE = %17777777777D #;                           <<*1398>>00747590
DOUBLE MAX'REAL'MEM, VM'MIN;                                   <<*1398>>00747600
LOGICAL DST'MIN, DST'MAX;                                      <<*1398>>00747610
LOGICAL FORMATTING'DSEG:=FALSE;                                <<*1398>>00747620
DOUBLE STACKADDR;                                              <<*1398>>00747630
        BYTE ARRAY LMAPNAME(0:16):="LOADMAP.PUB.SYS";          <<*1398>>00780000
        BYTE ARRAY CHCKNAME(0:16):="MPECHECK.PUB.SYS";         <<*1398>>00784000
        BYTE ARRAY CONFNAME(0:16):="CONFDATA.PUB.SYS";         <<*1398>>00786500
        BYTE ARRAY PMAPNAME(0:16):="HPPMAP.PUB.SYS";           <<*1398>>00787000
                 LOGICAL LAST'CHECK; << LAST REC CHECKSUM >>   <<*1398>>00825000
                 TIOGA        = 6,     << MM FAMILY >>         <<L2159>>00871000
                 MICROMOUSE   = 7,     << MM FAMILY >>         <<L2159>>00871500
                 LOR MACHINEID>=ICF55 )#;                      <<L2159>>00880000
              = ( MACHINEID >= ICF55 )#;                                00886000
ARRAY TAPEBUF(0:4095);                                         <<*1398>>00887000
   CNTAPEVERS         = COREBUF(%1525)       #,                <<*1398>>00923000
 EQUATE MAXIMUM'BANKS = 256;                                   <<*1180>>01090000
          USE'PSEUDO'DST := FALSE;                                      01267000
          IF VM'INUSE AND FORMATTING'DSEG                      <<*1398>>01307000
               AND LINESTART1 >= VM'MIN  THEN                  <<*1398>>01307200
            TOS := LINESTART1-TABLEBASE-STACKADDR              <<*1398>>01307400
          ELSE                                                 <<*1398>>01307600
            TOS := LINESTART1-TABLEBASE;                       <<*1398>>01308000
       USE'PSEUDO'DST := VM'INUSE;                                      01513000
DOUBLE MPE'REC;                                                <<*1929>>02525000
LDFNUM:=FOPEN(LMAPNAME,%3,0);                                  <<*1398>>02532000
FREADDIR(LDFNUM,TMPBUF,-20,2D);                                <<*1929>>02535000
IF <> THEN GO FINI;                                            <<*1929>>02535200
NEW'LOADMAP := NOT(BTMP = " ");                                <<*1929>>02535400
IF NEW'LOADMAP THEN MPE'REC := 2D                              <<*1929>>02535600
ELSE MPE'REC := 4D;                                            <<*1929>>02535800
FREADDIR(LDFNUM,TMPBUF,-20,MPE'REC);                           <<*1929>>02536000
  IF NEW'LOADMAP THEN TEMP1 := (TEMP MOD 51) + 2               <<*1929>>02567000
  ELSE TEMP1 := (TEMP MOD 50) + 4;                             <<*1929>>02568000
  IF NEW'LOADMAP THEN TEMP1 := ((TEMP/51)*25) + 4              <<*1929>>02575000
  ELSE TEMP1 := ((TEMP/50)*32) + 4;                            <<*1929>>02576000
$PAGE"      GET'PNAME: Return prog name from loader aux dseg"  <<*2017>>02626000
PROCEDURE GET'PNAME(CSTX'INDX,B'TARGET);                       <<*2017>>02626020
VALUE CSTX'INDX;                                               <<*2017>>02626040
INTEGER CSTX'INDX;                                             <<*2017>>02626060
BYTE ARRAY B'TARGET;                                           <<*2017>>02626080
                                                               <<*2017>>02626100
BEGIN                                                          <<*2017>>02626120
INTEGER I,J,K;                                                 <<*2017>>02626140
LOGICAL ARRAY TEMP(0:1);                                       <<*2017>>02626160
BYTE ARRAY B'TEMP(*) = TEMP;                                   <<*2017>>02626180
DOUBLE ADDR,LST'ADDR,LAX'ADDR,PNAMES'ADDR;                     <<*2017>>02626200
INTEGER ENT'LEN;                                               <<*2017>>02626220
LOGICAL NEXT'TABLE;                                            <<*2017>>02626230
DEFINE                                                         <<*2017>>02626240
  LST'DSTNO = %22#,                                            <<*2017>>02626260
  LAX'OFFSET = 38D#,                                           <<*2017>>02626280
  ENTRY'LEN'OFFSET = -7D#,                                     <<*2017>>02626300
  NEXT'TABLE'OFFSET = 4D#;                                     <<*2017>>02626320
                                                               <<*2017>>02626340
LST'ADDR := DSTTOADDR(LST'DSTNO);                              <<*2017>>02626360
IF LST'ADDR <> 0D THEN                                         <<*2017>>02626380
  LAX'ADDR := DSTTOADDR((CORE(LST'ADDR + LAX'OFFSET)).(1:15))  <<*2017>>02626400
ELSE LAX'ADDR := 0D;                                           <<*2017>>02626420
IF LAX'ADDR <> 0D THEN                                         <<*2017>>02626425
  NEXT'TABLE := CORE(LAX'ADDR + NEXT'TABLE'OFFSET);            <<*2017>>02626430
IF LAX'ADDR <> 0D AND CSTX'INDX > 0 AND NEXT'TABLE > 0 THEN    <<*2017>>02626440
  BEGIN                                                        <<*2017>>02626460
  PNAMES'ADDR := LAX'ADDR + DOUBLE(NEXT'TABLE);                <<*2017>>02626480
  ENT'LEN := CORE(PNAMES'ADDR + ENTRY'LEN'OFFSET);             <<*2017>>02626520
  ADDR := PNAMES'ADDR + DOUBLE(CSTX'INDX*ENT'LEN);             <<*2017>>02626540
                                                               <<*2017>>02626560
  @PBUF := @B'TARGET;                                          <<*2017>>02626580
  I := 0;                                                      <<*2017>>02626600
  WHILE I <= 2 DO                                              <<*2017>>02626620
    BEGIN                                                      <<*2017>>02626640
    J := 0;                                                    <<*2017>>02626660
    WHILE J <= 3 DO                                            <<*2017>>02626680
      BEGIN                                                    <<*2017>>02626700
      TEMP := CORE(ADDR + DOUBLE(I*4+J));                      <<*2017>>02626720
      K := 0;                                                  <<*2017>>02626740
      WHILE K <= 1 DO                                          <<*2017>>02626760
        BEGIN                                                  <<*2017>>02626780
        IF B'TEMP(K) = " " THEN GO NEXT'NAME;                  <<*2017>>02626800
        PBUF := B'TEMP(K);                                     <<*2017>>02626820
        @PBUF := @PBUF + 1;                                    <<*2017>>02626840
        K := K + 1;                                            <<*2017>>02626860
        END;  << K >>                                          <<*2017>>02626880
      J := J + 1;                                              <<*2017>>02626900
      END;  << J >>                                            <<*2017>>02626920
  NEXT'NAME:                                                   <<*2017>>02626940
    IF I < 2 THEN PBUF := ".";                                 <<*2017>>02626960
    @PBUF := @PBUF + 1;                                        <<*2017>>02626980
    I := I + 1;                                                <<*2017>>02627000
    END;  << I >>                                              <<*2017>>02627020
  END;                                                         <<*2017>>02627040
END;  << GET'PNAME >>                                          <<*2017>>02627060
                                                               <<*2017>>02814050
     GET'PNAME(CSTX,BBUF(57));                                 <<*2017>>02814100
     IF BBUF(57) >= "A" AND BBUF <= "Z" THEN                   <<*2017>>02814150
       BEGIN                                                   <<*2017>>02814200
       MOVE BBUF(42) := "PROGRAM NAME:  ";                     <<*2017>>02814250
       PRINTLINE;                                              <<*2017>>02814300
       PRINTLINE;                                              <<*2017>>02814350
       END                                                     <<*2017>>02814400
     ELSE BLANKBUF;                                            <<*2017>>02814450
     IF VM'INUSE AND SCRATCH >= VM'MIN  THEN                   <<*1398>>02954000
       BEGIN                                                   <<*1398>>02954600
       MOVE BBUF := "DB REL";                                  <<*1398>>02954800
       PRINTLINE;                                              <<*1398>>02955000
       END                                                     <<*1398>>02955200
     ELSE                                                      <<*1398>>02955300
       PRINTLINE;                                              <<*1398>>02955400
       IF VM'INUSE AND SCRATCH >= VM'MIN THEN                  <<*1398>>03044000
         TOS := SCRATCH2 - DOUBLE(CORE(SCRATCH+1D))            <<*1398>>03044500
       ELSE                                                    <<*1398>>03045000
         TOS := SCRATCH2;                                      <<*1398>>03045500
       IF VM'INUSE AND SCRATCH >= VM'MIN THEN                  <<*1398>>03054000
         MOVE BBUF(10) := "VIRTUAL"                            <<*1398>>03054500
       ELSE                                                    <<*1398>>03055000
         PUTNUMP(WORK3);                                       <<*1398>>03055500
      IF CSTENTRY <= %307  THEN   << WITHIN LOADMAP >>                  03358000
    IF NEW'LOADMAP THEN                                        <<*1929>>03366000
      BEGIN                                                    <<*1929>>03366500
      TEMP:=(CSTENTRY MOD 51)+2;                               <<*1929>>03367000
      FREADDIR(LDFNUM,TMPBUF,64,DOUBLE(TEMP));                 <<*1929>>03367500
      IF <> THEN RETURN;                                       <<*1929>>03368000
      IF SERIES=0 THEN TEMP:=4 ELSE                            <<*1929>>03368500
      TEMP:=((CSTENTRY/51)*25)+4;                              <<*1929>>03369000
      END                                                      <<*1929>>03369500
    ELSE                                                       <<*1929>>03370000
      BEGIN                                                    <<*1929>>03370500
      IF SERIES=0 THEN TEMP:=CSTENTRY                          <<*1929>>03371000
      ELSE TEMP:=(CSTENTRY MOD 50)+4;                          <<*1929>>03371500
      FREADDIR(LDFNUM,TMPBUF,64,DOUBLE(TEMP));                 <<*1929>>03372000
      IF <> THEN RETURN;                                       <<*1929>>03372500
      IF SERIES=0 THEN TEMP:=4 ELSE                            <<*1929>>03373000
      TEMP:=((CSTENTRY/50)*32)+4;                              <<*1929>>03374000
      END;                                                     <<*1929>>03376000
    @BYYT:=LOGICAL(@BTMP)+TEMP;                                <<*1929>>03378000
$PAGE"      PRINT'LOADMAP: Dump loadmap to the output device"  <<*1902>>03428000
PROCEDURE PRINT'LOADMAP;                                       <<*1902>>03428010
                                                               <<*1902>>03428020
BEGIN                                                          <<*1902>>03428030
                                                               <<*1902>>03428040
IF SAME'SYSTEM THEN                                            <<*1902>>03428050
  BEGIN                                                        <<*1902>>03428060
  FPOINT(LDFNUM,0D);                                           <<*1902>>03428070
  IF <> THEN RETURN;                                           <<*1902>>03428080
  NEWPAGE;                                                     <<*1902>>03428090
  BLANKBUF;                                                    <<*1902>>03428100
  MOVE DBUFFER(21) := "******    LOADMAP    ******";           <<*1902>>03428110
  PRINTLINE;                                                   <<*1902>>03428120
  WHILE TRUE DO                                                <<*1902>>03428140
    BEGIN                                                      <<*1902>>03428150
    FREAD(LDFNUM,DBUFFER,-128);                                <<*1902>>03428160
    IF <> THEN RETURN;                                         <<*1902>>03428170
    PRINTLINE;                                                 <<*1902>>03428180
    END;                                                       <<*1902>>03428190
  END;                                                         <<*1902>>03428200
                                                               <<*1902>>03428210
END;  << PRINT'LOADMAP >>                                      <<*1902>>03428220
<<     IF A DUMP WITH VIRTUAL STORAGE IS BEING PROCESSED AND >><<*1398>>04512100
<<     THE ADDRESS FALLS WITHIN THE DST, THE FETCH FROM THE  >><<*1398>>04512200
<<     REAL DST IS INTERCEPTED AND DATA FROM THE PSEUDO DST  >><<*1398>>04512300
<<     IS RETURNED INSTEAD.  IF THE ADDRESS FALLS WITHIN     >><<*1398>>04512400
<<     THE ASSIGNED VIRTUAL STORAGE RANGE, DATA FROM THE     >><<*1398>>04512500
<<     VIRTUAL STORAGE FILE, 'VIRTFILE', IS RETRUNED.        >><<*1398>>04512600
$EDIT VOID=4722000                                             <<*1398>>04582000
LOGICAL PROCEDURE CORE(ADR);                                   <<*1398>>04722010
  VALUE ADR;                                                   <<*1398>>04722020
  DOUBLE ADR;                                                  <<*1398>>04722030
                                                               <<*1398>>04722040
BEGIN                                                          <<*1398>>04722050
  LOGICAL BANK = ADR;                                          <<*1398>>04722060
  LOGICAL OFFSET = ADR + 1;                                    <<*1398>>04722070
  LOGICAL DLTAP=Q-2; <<FOR ERROR>>                             <<*1398>>04722080
  LOGICAL STAT=Q-1;  <<FOR ERROR>>                             <<*1398>>04722090
  DOUBLE BLOCK'NUMBER, VM'BLOCK'NUMBER;                        <<*1398>>04722100
  INTEGER BLOCK'OFFSET;                                        <<*1398>>04722110
  OWN DOUBLE OLD'BLOCK'NUMBER:=-1;                             <<*1398>>04722120
                                                               <<*1398>>04722130
  IF ADR < 0D  OR  ADR > MAXMEM  THEN                          <<*1398>>04722140
    BEGIN                                                      <<*1398>>04722170
    MOVE BBUF:="INVALID ADDRESS GENERATED  XXXXXX";            <<*1398>>04722180
    @PBUF:=@BBUF+27;                                           <<*1398>>04722190
    PUTDNUM(ADR);                                              <<*1398>>04722200
    MOVE PBUF:="    DPAN DELTA P=";                            <<*1398>>04722210
    @PBUF:=@PBUF+18;                                           <<*1398>>04722220
    PUTNUM(DLTAP);                                             <<*1398>>04722230
    MOVE PBUF:="    DPAN SEGMENT=";                            <<*1398>>04722240
    @PBUF:=@PBUF+18;                                           <<*1398>>04722250
    PUTNUM(STAT.(10:6)-1);                                     <<*1398>>04722260
    IF SERIES'33'THRU'MM THEN PRINTLINE;                       <<*1398>>04722270
    CORE:=0;                                                   <<*1398>>04722280
    RETURN;                                                    <<*1398>>04722290
    END;                                                       <<*1398>>04722300
                                                               <<*1398>>04722310
  IF USE'PSEUDO'DST  AND                                       <<*1398>>04722315
     DOUBLE(DST'MIN) <= ADR  AND  ADR <= DOUBLE(DST'MAX)  THEN <<*1398>>04722320
    BEGIN                                                      <<*1398>>04722330
    CORE := LFDS(PDSTNO,OFFSET-DST'MIN);                       <<*1398>>04722340
    RETURN;                                                    <<*1398>>04722350
    END;                                                       <<*1398>>04722360
                                                               <<*1398>>04722370
  BLOCK'OFFSET := OFFSET.(4:12);                               <<*1398>>04722380
  BLOCK'NUMBER := ADR&DLSR(12);                                <<*1398>>04722390
                                                               <<*1398>>04722400
  IF BLOCK'NUMBER <> OLD'BLOCK'NUMBER  THEN                    <<*1398>>04722410
    BEGIN                                                      <<*1398>>04722420
    OLD'BLOCK'NUMBER := BLOCK'NUMBER;                          <<*1398>>04722430
    IF  VM'INUSE  AND  ADR >= VM'MIN  THEN                     <<*1398>>04722440
      BEGIN                                                    <<*1398>>04722450
      VM'BLOCK'NUMBER := (ADR-VM'MIN)&DLSR(12);                <<*1398>>04722460
      FREADDIR(VMFILE,COREBUF,4096,VM'BLOCK'NUMBER);           <<*1398>>04722470
      IF <> THEN                                               <<*1398>>04722480
        BEGIN                                                  <<*1398>>04722490
        MOVE DBUFFER:="CC <> ON FREAD TO DISK";                <<*1398>>04722500
        PRINTLINE;                                             <<*1398>>04722510
        PRINT'FILE'INFO(VMFILE);                               <<*1398>>04722520
        ERROR;                                                 <<*1398>>04722530
        END;                                                   <<*1398>>04722540
      END                                                      <<*1398>>04722550
    ELSE                                                       <<*1398>>04722560
      BEGIN                                                    <<*1398>>04722570
      FREADDIR(COREF,COREBUF,4096,BLOCK'NUMBER);               <<*1398>>04722580
      IF <> THEN                                               <<*1398>>04722590
        BEGIN                                                  <<*1398>>04722600
        MOVE DBUFFER:="CC <> ON FREAD TO DISK";                <<*1398>>04722610
        PRINTLINE;                                             <<*1398>>04722620
        PRINT'FILE'INFO(COREF);                                <<*1398>>04722630
        ERROR;                                                 <<*1398>>04722640
        END;                                                   <<*1398>>04722650
      END;                                                     <<*1398>>04722660
                                                               <<*1398>>04722670
    IF DPANSWAP <> 0 THEN                                      <<*1398>>04722680
      BEGIN                <<MONITORING SWAPS>>                <<*1398>>04722690
      MSWLIN:=" ";  MOVE MSWLIN(1):=MSWLIN,(49);               <<*1398>>04722700
      MSWAPS:=MSWAPS+1;  <<NEXT TAG>>                          <<*1398>>04722710
      ASCII(MSWAPS,-10,MSWLIN(9));                             <<*1398>>04722720
      ASCII(BANK,-10,MSWLIN(11));                              <<*1398>>04722730
      ASCII(INTEGER(OLD'BLOCK'NUMBER),-10,MSWLIN(24));         <<*1398>>04722740
      ASCII(INTEGER(BLOCK'NUMBER),-10,MSWLIN(21));             <<*1398>>04722750
      ASCII(BLOCK'OFFSET,8,MSWLIN(13));                        <<*1398>>04722760
      ASCII(STAT.(10:6)-1,8,MSWLIN(34));  <<STATUS>>           <<*1398>>04722770
      MOVE MSWLIN(34):="    ";                                 <<*1398>>04722780
      DASCII(MFETCH,8,MSWLIN(25));                             <<*1398>>04722790
      MSWLIN(25):=" ";                                         <<*1398>>04722800
      ASCII(DLTAP,8,MSWLIN(41));                               <<*1398>>04722810
      ASCII(MACTAG,10,MSWLIN(49));                             <<*1398>>04722820
      FWRITE(DPANSWAP,LMSWLIN,-50,0);                          <<*1398>>04722830
      MFETCH:=0D;             <<NUMBER OF FETCHES>>            <<*1398>>04722840
      END;                    <<SWAP IS MONITORED>>            <<*1398>>04722850
    END;                                                       <<*1398>>04722860
  MFETCH := MFETCH + 1D;      <<ANOTHER FETCH DONE>>           <<*1398>>04722870
  CORE := COREBUF(BLOCK'OFFSET);                               <<*1398>>04722880
END;                                                           <<*1398>>04722890
$PAGE"                           PROCEDURE  LFDS"              <<*1398>>04836000
<<  PROCEDURE   Load From Data Segment   >>                    <<*1398>>04836010
                                                               <<*1398>>04836020
    INTEGER  PROCEDURE LFDS(DST'NO,WORD'OFFSET);               <<*1398>>04836030
    VALUE  DST'NO,WORD'OFFSET;                                 <<*1398>>04836031
    INTEGER  DST'NO,WORD'OFFSET;                               <<*1398>>04836040
    BEGIN                                                      <<*1398>>04836050
                                                               <<*1398>>04836060
      INTEGER RETURN'VALUE=LFDS;                               <<*1398>>04836070
                                                               <<*1398>>04836080
             TOS := @RETURN'VALUE;                             <<*1398>>04836090
             TOS := DST'NO;                                    <<*1398>>04836100
             TOS := WORD'OFFSET;                               <<*1398>>04836110
             TOS := 1;                                         <<*1398>>04836120
             ASSEMBLE(MFDS 4);                                 <<*1398>>04836130
                                                               <<*1398>>04836140
    END;                                                       <<*1398>>04836150
                                                               <<*1398>>04836160
                                                               <<*1398>>04836170
                                                               <<*1398>>04836180
<<  PROCEDURE   Store To Data Segment  >>                      <<*1398>>04836190
                                                               <<*1398>>04836200
    PROCEDURE STDS(DST'NO,WORD'OFFSET,WORD);                   <<*1398>>04836210
    VALUE  DST'NO,WORD'OFFSET,WORD;                            <<*1398>>04836211
    INTEGER  DST'NO,WORD'OFFSET,WORD;                          <<*1398>>04836220
                                                               <<*1398>>04836230
    BEGIN                                                      <<*1398>>04836240
                                                               <<*1398>>04836250
         TOS := DST'NO;         <<  TARGET DATA SEGMENT NO.  >><<*1398>>04836260
         TOS := WORD'OFFSET;    <<  OFFSET INTO DATA SEGMENT >><<*1398>>04836270
         TOS := @WORD;          <<  ADDR OF WORD TO BE STORED>><<*1398>>04836280
         TOS := 1;              <<  COUNT TO BE MOVED        >><<*1398>>04836290
         ASSEMBLE(MTDS 4);                                     <<*1398>>04836300
    END;                                                       <<*1398>>04836310
LOGICAL PROCEDURE COMPUTE'CHECKSUM(REC'BUF);                   <<*1398>>05131000
  ARRAY REC'BUF;                                               <<*1398>>05131100
BEGIN                                                          <<*1398>>05131200
  INTEGER I;                                                   <<*1398>>05131600
  LOGICAL J;                                                   <<*1398>>05131800
                                                               <<*1398>>05132000
  J := 0;                                                      <<*1398>>05132200
  FOR I := 0 UNTIL 4095 DO                                     <<*1398>>05132400
    J := J + REC'BUF(I);                                       <<*1398>>05132600
  COMPUTE'CHECKSUM := J;                                       <<*1398>>05132800
END;                                                           <<*1398>>05133000
         REC'NUM,                                              <<*1398>>05249000
 BYTE ARRAY SYSFNAME(0:19);                                    <<*1398>>05257000
   IF DUPLICATIVE THEN                                         <<*1398>>05270200
     BEGIN                                                     <<*1398>>05270400
     MOVE BBUF:="WRITING OUT ";                                <<*1398>>05270600
     MOVE BBUF(8):=FILENAME,(16);                              <<*1398>>05270800
     PRINT(DBUFFER,-24,0);                                     <<*1398>>05271000
     END;                                                      <<*1398>>05271200
   REC'NUM := 0;                                               <<*1398>>05327000
       IF REC'NUM=0 AND DUPLICATIVE THEN                       <<*1398>>05336200
         BEGIN                                                 <<*1398>>05336400
         MOVE BBUF:="READING IN ";                             <<*1398>>05336600
         MOVE BBUF(11):=SYSFNAME,(8);                          <<*1398>>05336800
         PRINT(DBUFFER,-19,0);                                 <<*1398>>05337000
         END;                                                  <<*1398>>05337200
           TAPE'MODIFY'ERROR(1,DFILENUM);                      <<*1398>>05346000
     REC'NUM := REC'NUM + 1;                                   <<*1398>>05385000
         MOVE FILENAME:="LOADMAP.PUB.SYS  ";                   <<*1398>>05484000
         MOVE FILENAME:="MPECHECK.PUB.SYS ";                   <<*1398>>05496000
         MOVE FILENAME:="CONFDATA.PUB.SYS ";                   <<*1398>>05508000
         MOVE FILENAME:="DPANLMP.PUB.SYS  ";                   <<*1398>>05586000
         MOVE SYSFNAME:="LOADMAP  ";                           <<*1398>>05587000
         MOVE LMAPNAME:="DPANLMP.PUB.SYS  ";                   <<*1398>>05594000
         MOVE FILENAME:="DPANCHCK.PUB.SYS ";                   <<*1398>>05602000
         MOVE SYSFNAME:="MPECHECK ";                           <<*1398>>05603000
         MOVE CHCKNAME:="DPANCHCK.PUB.SYS ";                   <<*1398>>05610000
                                                               <<*1398>>05630000
                                                               <<*1398>>05632000
$EDIT VOID=7022000                                             <<*1398>>05640000
$PAGE"         INVALIDTAPE: Bad tape, so printmessage and stop"<<*1398>>07022002
PROCEDURE INVALIDTAPE;                                         <<*1398>>07022004
                                                               <<*1398>>07022006
<< THE DUMP TAPE HAS BEEN FOUND TO BE INVALID.  PRINT >>       <<*1398>>07022008
<< AN ERROR MESSAGE AND TERMINATE.                    >>       <<*1398>>07022010
                                                               <<*1398>>07022012
BEGIN                                                          <<*1398>>07022014
                                                               <<*1398>>07022016
   MOVE BBUF :=                                                <<*1398>>07022018
      "***INVALID DUMP TAPE.  UNABLE TO PROCESS DUMP.  ";      <<*1398>>07022020
   PRINT( DBUFFER, -48, 0 );                                   <<*1398>>07022022
   MOVE BBUF :=                                                <<*1398>>07022024
      "   SEE THE CONSOLE OPERATOR'S GUIDE FOR FURTHER ";      <<*1398>>07022026
   PRINT( DBUFFER, -48, 0 );                                   <<*1398>>07022028
   MOVE BBUF := "   INFORMATION.";                             <<*1398>>07022030
   PRINT( DBUFFER, -15, 0 );                                   <<*1398>>07022032
                                                               <<*1398>>07022034
   TERMINATE;                                                  <<*1398>>07022036
                                                               <<*1398>>07022038
END;  << INVALID TAPE >>                                       <<*1398>>07022040
$PAGE "  FREAD'MULTIVOL: FREAD with multiple volume capability"<<*1398>>07022042
INTEGER PROCEDURE FREAD'MULTIVOL(FILENO, BUFFER, COUNT);       <<*1398>>07022044
                                                               <<*1398>>07022046
<<  THIS PROCEDURE IS USED IN PLACE OF FREAD'S FROM TAPE  >>   <<*1398>>07022048
<<  WHERE IS IS DESIRED TO HAVE MULTI-VOLUME INPUT        >>   <<*1398>>07022050
<<  CAPABILITY.                                           >>   <<*1398>>07022052
                                                               <<*1398>>07022054
    VALUE FILENO, COUNT;                                       <<*1398>>07022056
    INTEGER FILENO, COUNT;                                     <<*1398>>07022058
    LOGICAL ARRAY BUFFER;                                      <<*1398>>07022060
                                                               <<*1398>>07022062
BEGIN                                                          <<*1398>>07022064
  EQUATE FORWARDTOMARK  = 7,                                   <<*1398>>07022066
         BACKWARDTOMARK = 8,                                   <<*1398>>07022068
         REWINDUNLOAD   = 9;                                   <<*1398>>07022070
  ARRAY TRAILBUF(0:10);                                        <<*1398>>07022072
  INTEGER TLOG;                                                <<*1398>>07022074
  LOGICAL STATUS = Q-1, PROPER'VOLUME, PARM;                   <<*1398>>07022076
                                                               <<*1398>>07022078
  TLOG := FREAD(FILENO,BUFFER,COUNT);                          <<*1398>>07022080
  IF < THEN                                                    <<*1398>>07022082
    BEGIN                                                      <<*1398>>07022084
    FREAD'MULTIVOL := TLOG;                                    <<*1398>>07022085
    CC:= CCL;                                                  <<*1398>>07022086
    RETURN;                                                    <<*1398>>07022088
    END                                                        <<*1398>>07022090
  ELSE IF > THEN                                               <<*1398>>07022092
    DO                                                         <<*1398>>07022094
      BEGIN                                                    <<*1398>>07022096
      TLOG := FREAD(FILENO,TRAILBUF,10);                       <<*1398>>07022098
      CURRENTVOL := CURRENTVOL + 1;                            <<*1398>>07022100
      IF TLOG <> 10 OR TRAILBUF <> CURRENTVOL THEN             <<*1398>>07022102
        BEGIN                                                  <<*1398>>07022104
        CC := CCG;                                             <<*1398>>07022106
        FCONTROL(FILENO,BACKWARDTOMARK,PARM);                  <<*1398>>07022108
        FSPACE(FILENO,1);                                      <<*1398>>07022110
        RETURN;                                                <<*1398>>07022112
        END;                                                   <<*1398>>07022114
      DO                                                       <<*1398>>07022116
        BEGIN                                                  <<*1398>>07022118
        FCONTROL(FILENO,REWINDUNLOAD,PARM);                    <<*1398>>07022120
        PRINTOP(MNV,9,0);                                      <<*1398>>07022122
        IF DEVTYPE.(8:8) = SERDISC THEN                        <<*1398>>07022124
          FCONTROL(FILENO,FORWARDTOMARK,PARM);                 <<*1398>>07022126
        TLOG := FREAD(FILENO,TRAILBUF,10);                     <<*1398>>07022128
        PROPER'VOLUME :=                                       <<*1398>>07022130
          IF TLOG = 10 AND TRAILBUF = CURRENTVOL THEN          <<*1398>>07022132
            TRUE                                               <<*1398>>07022134
          ELSE                                                 <<*1398>>07022136
            FALSE;                                             <<*1398>>07022138
        IF NOT PROPER'VOLUME THEN                              <<*1398>>07022140
          PRINTOP(IMPV,8,PARM);                                <<*1398>>07022142
        END                                                    <<*1398>>07022144
      UNTIL PROPER'VOLUME;                                     <<*1398>>07022146
                                                               <<*1398>>07022148
      << READ AND CHECK NEXT RECORD >>                         <<*1398>>07022150
      TLOG := FREAD(FILENO,BUFFER,COUNT);                      <<*1398>>07022152
      IF < THEN                                                <<*1398>>07022154
        BEGIN                                                  <<*1398>>07022156
        FREAD'MULTIVOL := TLOG;                                <<*1398>>07022157
        INVALIDTAPE;                                           <<*1398>>07022158
        RETURN;                                                <<*1398>>07022160
        END;                                                   <<*1398>>07022162
      END                                                      <<*1398>>07022164
    UNTIL = ;                                                  <<*1398>>07022166
  FREAD'MULTIVOL := TLOG;                                      <<*1398>>07022167
  CC := CCE;                                                   <<*1398>>07022168
END; << FREAD'MULTIVOL >>                                      <<*1398>>07022170
$PAGE"   VERS0'TAPETODISK: Handle remainder of version 0 tape" <<*1398>>07022172
PROCEDURE VERS0'TAPETODISK;                                    <<*1398>>07022174
                                                               <<*1398>>07022176
COMMENT                                                        <<*1398>>07022178
                                                               <<*1398>>07022180
    THIS PROCEDURE IS CALLED BY TAPETODISK, AFTER MAIN         <<*1398>>07022182
    MEMORY HAS BEEN READ IN, TO PROCESS THE REMAINDER OF       <<*1398>>07022184
    A VERSION ZERO DUMP TAPE.  IF SYSTEM FILES ALREADY         <<*1398>>07022186
    EXIST, THEY ARE COPIED TO TEMPORARY DISK FILES FOR         <<*1398>>07022188
    USE BY THE FORMATTING ROUTINES.  IF THEY ARE NOT           <<*1398>>07022190
    YET PRESENT, THEY ARE APPENDED AFTER THE MAIN              <<*1398>>07022192
    MEMORY FILE.                                               <<*1398>>07022194
                                                               <<*1398>>07022196
                                                               <<*1398>>07022198
Following are diagrams of the softdump VERSION 0               <<*1398>>07022200
(without virtual storage) tape format:                         <<*1398>>07022202
                                                               <<*1398>>07022204
                                                               <<*1398>>07022206
               DUMP TAPE FORMAT                                <<*1398>>07022208
                                                               <<*1398>>07022210
  Immediately after           After DPAN has been              <<*1398>>07022212
  dump is taken               run at least once                <<*1398>>07022214
                              on dump tape                     <<*1398>>07022216
                                                               <<*1398>>07022218
   ---------------             ---------------                 <<*1398>>07022220
   |  BOT        |             |  BOT        |                 <<*1398>>07022222
   |-------------|             |-------------|                 <<*1398>>07022224
   |  Real       |             |  Real       |                 <<*1398>>07022226
   |  Memory     |             |  Memory     |                 <<*1398>>07022228
   |  Area       |             |  Area       |                 <<*1398>>07022230
   |-------------|             |-------------|                 <<*1398>>07022232
                               |  EOF        |                 <<*1398>>07022234
                               |-------------|                 <<*1398>>07022236
                               |  Verify     |                 <<*1398>>07022238
                               |  Record     |                 <<*1398>>07022240
                               |-------------|                 <<*1398>>07022242
                               |  EOF        |                 <<*1398>>07022244
                               |-------------|                 <<*1398>>07022246
                               |  Loadmap    |                 <<*1398>>07022248
                               |-------------|                 <<*1398>>07022250
                               |  EOF        |                 <<*1398>>07022252
                               |-------------|                 <<*1398>>07022254
                               |  MPECheck   |                 <<*1398>>07022256
                               |-------------|                 <<*1398>>07022258
                               |  EOF        |                 <<*1398>>07022260
                               |-------------|                 <<*1398>>07022262
                               |  Confdata   |                 <<*1398>>07022264
                               |-------------|                 <<*1398>>07022266
                               |  EOF        |                 <<*1398>>07022268
                               |-------------|                 <<*1398>>07022270
                               |  Tape       |                 <<*1398>>07022272
                               |  Completion |                 <<*1398>>07022274
                               |  Record     |                 <<*1398>>07022276
                               |-------------|                 <<*1398>>07022278
                               |  EOF        |                 <<*1398>>07022280
                               |-------------|                 <<*1398>>07022282
                                                               <<*1398>>07022284
                                                               <<*1398>>07022286
                                                               <<*1398>>07022288
                                                               <<*1398>>07022290
                                                               <<*1398>>07022292
                                                               <<*1398>>07022294
END OF COMMENT;                                                <<*1398>>07022296
                                                               <<*1398>>07022298
BEGIN                                                          <<*1398>>07022300
                                                               <<*1398>>07022302
         LOGICAL DUMMY;                                        <<*1398>>07022304
         INTEGER TNUM;           << # WORDS READ >>            <<*1398>>07022306
         INTEGER PMAPCODE;       <<FOR CHECKING FILETYPE>>     <<*1398>>07022308
         DOUBLE SCANP;           <<PMAP SCAN POINTER>>         <<*1398>>07022310
         INTEGER SCANL;          <<CST INDEX>>                 <<*1398>>07022312
         LOGICAL ARRAY PMAPBUF(0:50);  <<PMAP BUFFER>>         <<*1398>>07022314
         BYTE ARRAY BPMAPBUF(*)=PMAPBUF;                       <<*1398>>07022316
         LOGICAL ARRAY LOADBUF(0:19);  <<LOAD MAP BUFFER>>     <<*1398>>07022318
         BYTE ARRAY BLOADBUF(*)=LOADBUF;                       <<*1398>>07022320
                                                               <<*1398>>07022322
                                                               <<*1398>>07022324
SUBROUTINE CHECK'TAPE'FILES;                                   <<*1398>>07022326
                                                               <<*1398>>07022328
    << IN SUBROUTINE CHECK'TAPE'FILES TESTS ARE MADE FOR  >>   <<*1398>>07022330
    << DETERMINING THE PRESENT TAPE ORGANIZATION. FIRST,  >>   <<*1398>>07022332
    << THE RECORD AFTER THE END OF THE MEMORY DUMP IS READ>>   <<*1398>>07022334
    << IF IT IS NOT AN END OF FILE MARK AN EOF IS ADDED,  >>   <<*1398>>07022336
    << THE VERIFICATION RECORD IS ADDED AND THE LOGICAL   >>   <<*1398>>07022338
    << FILES'REQUIRED IS SET TRUE TO INDICATE THE SYSTEM  >>   <<*1398>>07022340
    << FILES ARE TO BE ADDED TO TAPE. OTHERWISE THE NEXT  >>   <<*1398>>07022342
    << RECORD IS READ AND COMPARED TO THE VERIFICATION    >>   <<*1398>>07022344
    << RECORD CONFIGURED PREVIOUSLY. IF A MATCH IS FOUND  >>   <<*1398>>07022346
    << AND THE COMPLETE TAPE INDICATOR IS SET THE LOGICAL >>   <<*1398>>07022348
    << FILES REQUIRED IS SET FALSE TO INDICATE FILES ARE  >>   <<*1398>>07022350
    << TO BE COPIED FROM TAPE TO DISC.  IF THE VERIFI-    >>   <<*1398>>07022352
    << CATION RECORD IS NOT FOUND OR IS INCORRECT THE     >>   <<*1398>>07022354
    << VALID VERIFICATION RECORD IS WRITEN AND THE LOGICAL>>   <<*1398>>07022356
    << FILES'REQUIRED IS SET TRUE.  IF THE COMPLETE TAPE  >>   <<*1398>>07022358
    << INDICATOR IS NOT SET THE TAPE IS PREPARED FOR AN   >>   <<*1398>>07022360
    << ATTEMP TO WRITE THE SYSTEM FILES TO TAPE AGAIN     >>   <<*1398>>07022362
    << ASSUMING AN ERROR WAS FOUND IN THE LAST ATTEMPT.   >>   <<*1398>>07022364
                                                               <<*1398>>07022366
BEGIN                                                          <<*1398>>07022368
                                                               <<*1398>>07022370
    << SET UP VERIFICATION RECORD TO BE ADDED TO TAPE  >>      <<*1398>>07022372
                                                               <<*1398>>07022374
MOVE CHECKBUF:=24("  ");                                       <<*1398>>07022376
MOVE BCHECKBUF:="DPAN HP/3000    ";                            <<*1398>>07022378
RECOVER'DATE(TBUF);                                            <<*1398>>07022380
MOVE BCHECKBUF(18):=STRING,(17);                               <<*1398>>07022382
FILE'REQUIRED:=FALSE;                                          <<*1398>>07022384
TNUM:=FREAD(TAPEF,COREBUF,4096);                               <<*1398>>07022386
IF <= THEN                                                     <<*1398>>07022388
  BEGIN                                                        <<*1398>>07022390
  FSPACE(TAPEF,-2);                                            <<*1398>>07022392
  FREAD(TAPEF,COREBUF,4096);                                   <<*1398>>07022394
  IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                       <<*1398>>07022396
  IF LAST'CHECK <> COMPUTE'CHECKSUM(COREBUF) THEN              <<*1398>>07022398
    BEGIN                                                      <<*1398>>07022400
    FREAD(TAPEF,COREBUF,4096);                                 <<*1398>>07022402
    IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                     <<*1398>>07022404
    IF LAST'CHECK <> COMPUTE'CHECKSUM(COREBUF) THEN            <<*1398>>07022406
      BEGIN                                                    <<*1398>>07022408
      TAPE'MODIFY'ERROR(10,TAPEF);                             <<*1398>>07022410
      GO EXIT;                                                 <<*1398>>07022412
      END;                                                     <<*1398>>07022414
    END;                                                       <<*1398>>07022416
  FCONTROL(TAPEF,6,DUMMY);                                     <<*1398>>07022418
  IF <> THEN                                                   <<*1398>>07022420
    TAPE'MODIFY'ERROR(9,TAPEF);                                <<*1398>>07022422
  FWRITE(TAPEF,CHECKBUF,23,0);                                 <<*1398>>07022424
  IF <> THEN                                                   <<*1398>>07022426
    TAPE'MODIFY'ERROR(9,TAPEF);                                <<*1398>>07022428
  FCONTROL(TAPEF,6,DUMMY);                                     <<*1398>>07022430
  IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                       <<*1398>>07022432
  FILE'REQUIRED:=TRUE;                                         <<*1398>>07022434
  END                                                          <<*1398>>07022436
ELSE                                                           <<*1398>>07022438
  BEGIN                                                        <<*1398>>07022440
  COREBUF:="  "; MOVE COREBUF(1):=COREBUF,(4095);              <<*1398>>07022442
  TNUM:=FREAD(TAPEF,COREBUF,18);                               <<*1398>>07022444
  IF <> OR BCOREBUF <> BCHECKBUF,(34) THEN                     <<*1398>>07022446
    BEGIN                                                      <<*1398>>07022448
    FSPACE(TAPEF,-1);                                          <<*1398>>07022450
    IF > AND DEVTYPE.(8:8) = SERDISC  THEN                     <<*1398>>07022452
      FSPACE(TAPEF,1);                                         <<*1398>>07022454
    IF < THEN                                                  <<*1398>>07022456
      TAPE'MODIFY'ERROR(9,TAPEF);                              <<*1398>>07022458
    FWRITE(TAPEF,CHECKBUF,23,0);                               <<*1398>>07022460
    IF <> THEN                                                 <<*1398>>07022462
      TAPE'MODIFY'ERROR(9,TAPEF);                              <<*1398>>07022464
    FCONTROL(TAPEF,6,DUMMY);                                   <<*1398>>07022466
    IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                     <<*1398>>07022468
    FILE'REQUIRED:=TRUE;                                       <<*1398>>07022470
    END                                                        <<*1398>>07022472
  ELSE                                                         <<*1398>>07022474
    BEGIN                                                      <<*1398>>07022476
    FSPACE(TAPEF,1);                                           <<*1398>>07022478
    IF <= THEN                                                 <<*1398>>07022480
      BEGIN                                                    <<*1398>>07022482
      FSPACE(TAPEF,-1);                                        <<*1398>>07022484
      IF <> THEN TAPE'MODIFY'ERROR(4,TAPEF);                   <<*1398>>07022486
      FCONTROL(TAPEF,6,DUMMY);                                 <<*1398>>07022488
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<*1398>>07022490
      FILE'REQUIRED:=TRUE;                                     <<*1398>>07022492
      END                                                      <<*1398>>07022494
    ELSE                                                       <<*1398>>07022496
      BEGIN                                                    <<*1398>>07022498
                                                               <<*1398>>07022500
     << IN THIS SECTION OF CODE THE ADDITIONAL FILES ARE >>    <<*1398>>07022502
     << CHECKED FOR COMPLETENESS.  THE TAPE IS SEARCHED  >>    <<*1398>>07022504
     << TO FIND THE COMPLETE TAPE INDICATOR WHICH IS     >>    <<*1398>>07022506
     << PLACED AFTER THE THIRD ADDITIONAL FILE.  AFTER   >>    <<*1398>>07022508
     << THE COMPLETE TAPE INDICATOR IS FOUND THE TAPE IS >>    <<*1398>>07022510
     << REWOUND AND PLACED AT THE BEGINNING OF THE FIRST >>    <<*1398>>07022512
     << ADDITIONAL FILE SO THAT THE COPYING PROCEDURE CAN>>    <<*1398>>07022514
     << BEGIN.                                           >>    <<*1398>>07022516
                                                               <<*1398>>07022518
      FCONTROL(TAPEF,7,DUMMY);                                 <<*1398>>07022520
      IF <> THEN                                               <<*1398>>07022522
         BEGIN                                                 <<*1398>>07022524
         TAPE'MODIFY'ERROR(10,TAPEF);                          <<*1398>>07022526
         GO EXIT;                                              <<*1398>>07022528
         END;                                                  <<*1398>>07022530
      FCONTROL(TAPEF,7,DUMMY);                                 <<*1398>>07022532
      IF <> THEN                                               <<*1398>>07022534
         BEGIN                                                 <<*1398>>07022536
         TAPE'MODIFY'ERROR(10,TAPEF);                          <<*1398>>07022538
         GO EXIT;                                              <<*1398>>07022540
         END;                                                  <<*1398>>07022542
      FCONTROL(TAPEF,7,DUMMY);                                 <<*1398>>07022544
      IF <> THEN                                               <<*1398>>07022546
         BEGIN                                                 <<*1398>>07022548
         TAPE'MODIFY'ERROR(10,TAPEF);                          <<*1398>>07022550
         GO EXIT;                                              <<*1398>>07022552
         END;                                                  <<*1398>>07022554
      FREAD(TAPEF,COREBUF,-47);                                <<*1398>>07022556
      IF <> THEN                                               <<*1398>>07022558
         BEGIN                                                 <<*1398>>07022560
         TAPE'MODIFY'ERROR(10,TAPEF);                          <<*1398>>07022562
         GO EXIT;                                              <<*1398>>07022564
         END;                                                  <<*1398>>07022566
      IF BCOREBUF <> BCHECKBUF,(23) THEN                       <<*1398>>07022568
        FILE'REQUIRED:=TRUE;                                   <<*1398>>07022570
      FCONTROL(TAPEF,8,DUMMY);                                 <<*1398>>07022572
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<*1398>>07022574
      FCONTROL(TAPEF,8,DUMMY);                                 <<*1398>>07022576
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<*1398>>07022578
      FCONTROL(TAPEF,8,DUMMY);                                 <<*1398>>07022580
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<*1398>>07022582
      FCONTROL(TAPEF,8,DUMMY);                                 <<*1398>>07022584
      IF <> THEN TAPE'MODIFY'ERROR(9,TAPEF);                   <<*1398>>07022586
      FSPACE(TAPEF,1);                                         <<*1398>>07022588
      IF < THEN TAPE'MODIFY'ERROR(4,TAPEF);                    <<*1398>>07022590
    EXIT:                                                      <<*1398>>07022592
      END;                                                     <<*1398>>07022594
    END;                                                       <<*1398>>07022596
  END;                                                         <<*1398>>07022598
END;                                                           <<*1398>>07022600
                                                               <<*1398>>07022602
                                                               <<*1398>>07022604
<<   P R O C E D U R E   M A I N   >>                          <<*1398>>07022606
                                                               <<*1398>>07022608
   CHECK'TAPE'FILES;                                           <<*1398>>07022610
                                                               <<*1398>>07022612
    << THE FOLLOWING CODE WAS ADDED TO PREVENT DUMPS  >>       <<*1398>>07022614
    << FROM ONE SYSTEM LEVEL (I.E. 44'S, 30/33'S)     >>       <<*1398>>07022616
    << HAVING THE NECESSARY SYSTEM FILES OF ANOTHER   >>       <<*1398>>07022618
    << SYSTEM LEVEL APPENDED TO THE END OF THE MEMORY >>       <<*1398>>07022620
    << DUMP TAPE.  THE NECESSARY INFORMATION COULD    >>       <<*1398>>07022622
    << NOT BE OBTAINED TO IMPLEMENT THIS TYPE OF CHECK>>       <<*1398>>07022624
    << ON SYSTEMS OF THE SAME LEVEL.                  >>       <<*1398>>07022626
                                                               <<*1398>>07022628
  CPUMACHINECODE:=THISCPU;                                     <<*1398>>07022630
  CASE CPUMACHINECODE OF                                       <<*1398>>07022632
    BEGIN                                                      <<*1398>>07022634
    ;                                                          <<*1398>>07022636
    ;                                                          <<*1398>>07022638
    CPUMACHINECODE:=3;                                         <<*1398>>07022640
    CPUMACHINECODE:=2;                                         <<*1398>>07022642
    ;                                                          <<*1398>>07022644
    END;                                                       <<*1398>>07022646
  IF FILE'REQUIRED AND CPUMACHINECODE -1 <> MACHINEID          <<*1398>>07022648
    THEN GO ERRLEAVE;                                          <<*1398>>07022650
  MODIFY'TAPE(TAPEF,FILE'REQUIRED);                            <<*1398>>07022652
                                                               <<*1398>>07022654
ERRLEAVE:                                                      <<*1398>>07022656
END;  << VERS0'TAPETODISK  >>                                  <<*1398>>07022658
$PAGE"            VMTODISK: Copy Virtual Storage to 'VIRFILE' "<<*1398>>07022660
PROCEDURE VMTODISK;                                            <<*1398>>07022662
COMMENT                                                        <<*1398>>07022664
                                                               <<*1398>>07022666
    For the tape format used for dumps including virtual       <<*1398>>07022668
    storage see the comment in the VERS1'TAPETODISK            <<*1398>>07022670
    procedure.                                                 <<*1398>>07022672
                                                               <<*1398>>07022674
                                                               <<*1398>>07022676
    This procedure reads the variable length records           <<*1398>>07022678
    from the virtual storage tape file and writes them         <<*1398>>07022680
    to the temp disk file 'VIRTFILE'.  This file has           <<*1398>>07022682
    fixed length 4K records with zero padding used             <<*1398>>07022684
    for segments whose lengths are not integer multiples       <<*1398>>07022686
    of 4K.                                                     <<*1398>>07022688
                                                               <<*1398>>07022690
    As the segments are read in, memory address are            <<*1398>>07022692
    assigned to them and these addresses are used when         <<*1398>>07022694
    each of the segments are 'swapped in' to the               <<*1398>>07022696
    pseudo DST.  The starting address for virtual              <<*1398>>07022698
    storage is immediately after the highest real              <<*1398>>07022700
    memory address.  MAXMEM is increased to include            <<*1398>>07022702
    virtual storage after it has all been read from            <<*1398>>07022704
    tape and swapped in.  The header and trailer records       <<*1398>>07022706
    from tape for each data segment are not included           <<*1398>>07022708
    in VIRTFILE.  Only the data segments and the above         <<*1398>>07022710
    zero padding are in VIRTFILE.                              <<*1398>>07022712
                                                               <<*1398>>07022714
END OF COMMENT;                                                <<*1398>>07022716
                                                               <<*1398>>07022718
BEGIN                                                          <<*1398>>07022720
        DEFINE                                                 <<*1398>>07022722
        << DATA SEGMENT TABLE ENTRY >>                         <<*1398>>07022724
        RL'DSABSENT = RL'DST'ENTRY(0).(0:1) #,                 <<*1398>>07022726
        RL'DSROC    = RL'DST'ENTRY(1).(1:1) #,                 <<01532>>07022728
        RL'DSIMI    = RL'DST'ENTRY(1).(2:1) #;                 <<01532>>07022729
                                                               <<*1398>>07022730
  INTEGER VM'REC'NUM,LEN,NUM'DS'RECS,DSTNO,DUMMY,I;            <<*1398>>07022732
  DOUBLE VM'ADDR;                                              <<*1398>>07022734
  LOGICAL VM'BANK = VM'ADDR, VM'BASE = VM'ADDR+1;              <<*1398>>07022736
  LOGICAL ARRAY RL'DST'ENTRY(0:3);                             <<*1398>>07022738
                                                               <<*1398>>07022740
  SUBROUTINE VM'ERROR(ERR'NUM);                                <<*1398>>07022742
  VALUE ERR'NUM;  INTEGER ERR'NUM;                             <<*1398>>07022744
  BEGIN                                                        <<*1398>>07022746
    CASE ERR'NUM OF                                            <<*1398>>07022748
      BEGIN                                                    <<*1398>>07022750
      << 0>> MOVE BBUF:=                                       <<*1398>>07022752
               "READ ERROR FROM TAPE";                         <<*1398>>07022754
      << 1>> MOVE BBUF:=                                       <<*1398>>07022756
               "INVALID HEADER RECORD - VM TAPE FILE";         <<*1398>>07022758
      << 2>> MOVE BBUF:=                                       <<*1398>>07022760
               "DATA SEGMENT LENGTH ERROR - VM TAPE FILE";     <<*1398>>07022762
      << 3>> MOVE BBUF:=                                       <<*1398>>07022764
               "BAD RECORD LENGTH - VM TAPE FILE";             <<*1398>>07022766
      << 4>> MOVE BBUF:=                                       <<*1398>>07022768
               "CC <> CCE ON FWRITE TO VM DISK FILE";          <<*1398>>07022770
      << 5>> MOVE BBUF:=                                       <<*1398>>07022772
               "INVALID TRAILER RECORD - VM TAPE FILE";        <<*1398>>07022774
      << 6>> MOVE BBUF:=                                       <<*1398>>07022776
               "EXPECTED EOF MARK - REAL MEMORY";              <<*1398>>07022778
      END;                                                     <<*1398>>07022780
    PRINTLINE;                                                 <<*1398>>07022782
    MOVE BBUF := "  LAST VALID HEADER RECORD WAS FOR DST#   "; <<*1902>>07022783
    @PBUF := @BBUF + 39;                                       <<*1902>>07022784
    PUTNUMP(DSTNO);                                            <<*1902>>07022785
    PRINTLINE;                                                 <<*1902>>07022786
    << SKIP TO NEXT TAPE FILE >>                               <<*1902>>07022787
    FCONTROL(TAPEF,7,DUMMY);                                   <<*1902>>07022788
    << DISABLE THE USE OF VIRTUAL MEMORY FOR THE REMAINDER >>  <<*1902>>07022789
    VM'INUSE := FALSE;                                         <<*1398>>07022790
    ASSEMBLE( EXIT 0 );  << RETURN FROM VMTODISK >>            <<*1398>>07022792
  END;   << VM'ERROR >>                                        <<*1398>>07022794
                                                               <<*1398>>07022796
SUBROUTINE SDF'ERROR(ERROR'WORD);                              <<*1398>>07022798
VALUE ERROR'WORD;  LOGICAL ERROR'WORD;                         <<*1398>>07022800
BEGIN                                                          <<*1398>>07022802
  IF ERROR'WORD.(0:1) THEN                                     <<*1398>>07022804
    BEGIN                                                      <<*1398>>07022806
    MOVE BBUF := "SDF ERROR - INVALID LDEV NUMBER";            <<*1398>>07022808
    PRINTLINE;                                                 <<*1398>>07022810
    END;                                                       <<*1398>>07022812
  IF ERROR'WORD.(1:1) THEN                                     <<*1398>>07022814
    BEGIN                                                      <<01532>>07022815
    IF RL'DSIMI = 1  THEN                                      <<01532>>07022816
      MOVE BBUF := ("SDF WARNING - NOT ABLE TO DUMP IMI DATA ",<<01532>>07022817
                   "SEGMENT")                                  <<01532>>07022818
    ELSE                                                       <<01532>>07022819
      MOVE BBUF:= "SDF ERROR - INVALID VIRTUAL MEMORY ADDRESS";<<01532>>07022820
    PRINTLINE;                                                 <<01532>>07022821
    END;                                                       <<*1398>>07022822
  IF ERROR'WORD.(2:1) THEN                                     <<*1398>>07022824
    BEGIN                                                      <<*1398>>07022826
    MOVE BBUF := "SDF ERROR - DISC READ ERROR";                <<*1398>>07022828
    PRINTLINE;                                                 <<*1398>>07022830
    END;                                                       <<*1398>>07022832
  IF ERROR'WORD.(3:1) THEN                                     <<*1398>>07022834
    BEGIN                                                      <<*1398>>07022836
    MOVE BBUF := "SDF ERROR - INVALID TABLE STRUCTURE";        <<*1398>>07022838
    PRINTLINE;                                                 <<*1398>>07022840
    END;                                                       <<*1398>>07022842
END;   << SDF'ERROR >>                                         <<*1398>>07022844
                                                               <<*1398>>07022846
  <<   P R O C E D U R E    M A I N   >>                       <<*1398>>07022848
  BLANKBUF;                                                    <<*1398>>07022850
  VM'INUSE := TRUE;                                            <<*1398>>07022852
  DSTNO := 0;                                                  <<*1902>>07022853
  VM'REC'NUM := 0;                                             <<*1398>>07022854
  IF DUPLICATIVE THEN                                          <<*1398>>07022856
    BEGIN                                                      <<*1398>>07022858
    MOVE BBUF:="READING VIRTUAL STORAGE";                      <<*1398>>07022860
    PRINTLINE;                                                 <<*1902>>07022862
    END;                                                       <<*1398>>07022864
  LEN := FREAD(TAPEF,TAPEBUF,4096);                            <<*1398>>07022866
  IF <= THEN VM'ERROR(6);  << SHOULD BE EOF >>                 <<*1398>>07022868
  WHILE TRUE DO                                                <<*1398>>07022870
    BEGIN   << READ DATA SEGMENTS >>                           <<*1398>>07022872
    LEN := FREAD'MULTIVOL(TAPEF,TAPEBUF,4096);                 <<*1398>>07022874
    IF < THEN  << READ ERROR >>                                <<*1398>>07022876
      VM'ERROR(0);                                             <<*1398>>07022878
    IF > THEN    << END OF VIRTUAL MEMORY FILE >>              <<*1398>>07022880
      BEGIN                                                    <<*1398>>07022882
      << CALC NEW MAXMEM TO INCLUDE VM >>                      <<*1398>>07022884
      MAXMEM := MAXMEM + DOUBLE(VM'REC'NUM) * 4096D;           <<*1398>>07022886
      IF VM'REC'NUM = 0 THEN                                   <<*1398>>07022888
        BEGIN                                                  <<*1398>>07022890
        VM'INUSE := FALSE;                                     <<*1398>>07022892
        IF DUPLICATIVE THEN                                    <<*1398>>07022894
          BEGIN                                                <<*1398>>07022896
          MOVE BBUF := "NO VIRTUAL MEMORY";                    <<*1398>>07022898
          PRINT(DBUFFER,-17,0);                                <<*1398>>07022900
          END;                                                 <<*1398>>07022902
        END                                                    <<*1398>>07022904
      ELSE                                                     <<*1398>>07022906
        IF DUPLICATIVE THEN                                    <<*1398>>07022908
          BEGIN                                                <<*1398>>07022910
          MOVE BBUF := "READING OF VIRTUAL STORAGE COMPLETE";  <<*1398>>07022912
          PRINT(DBUFFER,-35,0);                                <<*1398>>07022914
          END;                                                 <<*1398>>07022916
      RETURN;                                                  <<*1398>>07022918
      END;                                                     <<*1398>>07022920
    << CHECK FOR TAPE BEING APPENDED BY AN OLD DPAN5 >>        <<*1398>>07022922
    IF LEN = 23 THEN                                           <<*1398>>07022924
      BEGIN                                                    <<*1398>>07022926
      MOVE BBUF :=                                             <<*1398>>07022928
        "TAPE HAS BEEN WRITTEN ON BY OLDER VERSION OF DPAN";   <<*1398>>07022930
      PRINT(DBUFFER,-49,0);                                    <<*1398>>07022932
      MOVE BBUF :=                                             <<*1398>>07022934
        "VIRTUAL STORAGE AND SYSTEM FILES ARE LOST";           <<*1398>>07022936
      PRINT(DBUFFER,-42,0);                                    <<*1398>>07022938
      VM'INUSE := FALSE;                                       <<*1398>>07022940
      GET'FILES := FALSE;                                      <<*1398>>07022942
      RETURN;                                                  <<*1398>>07022944
      END;                                                     <<*1398>>07022946
    << THIS RECORD SHOULD BE A HEADER RECORD >>                <<*1398>>07022948
    IF TAPEBUF(0) <> 0 OR LEN <> 12 THEN                       <<*1398>>07022950
      VM'ERROR(1);                                             <<*1398>>07022952
    DSTNO := TAPEBUF(1); << DST # FROM HEADER RECORD >>        <<*1398>>07022954
      << GET DST ENTRY FROM HEADER >>                          <<*1398>>07022956
    MOVE DST'ENTRY := TAPEBUF(3), (4);                         <<*1398>>07022958
    IF TAPEBUF(2) = 0 THEN                                     <<*1398>>07022960
      NUM'DS'RECS := 0                                         <<*1398>>07022962
    ELSE                                                       <<*1398>>07022964
      BEGIN   << NON-ZERO DATA SEG LEN >>                      <<*1398>>07022966
        << CALCULATE # 4K RECORDS IN SEG >>                    <<*1398>>07022968
      NUM'DS'RECS := (TAPEBUF(2) - 1)/4096 + 1;                <<*1398>>07022970
      FOR I := 1 UNTIL NUM'DS'RECS DO                          <<*1398>>07022972
        BEGIN  << COPY ALL RECORDS FOR ONE DATA SEG >>         <<*1398>>07022974
        LEN := FREAD'MULTIVOL(TAPEF,TAPEBUF,4096);             <<*1398>>07022976
        IF < THEN  << READ ERROR >>                            <<*1398>>07022978
          VM'ERROR(0);                                         <<*1398>>07022980
        IF > THEN  << UNEXPECTED EOF >>                        <<*1398>>07022982
          BEGIN                                                <<*1398>>07022984
          MOVE BBUF := "UNEXPECTED EOF IN VM FILE";            <<*1398>>07022986
          PRINTLINE;                                           <<*1398>>07022988
          VM'INUSE := FALSE;                                   <<*1398>>07022990
          RETURN;                                              <<*1398>>07022992
          END;                                                 <<*1398>>07022994
        << CHECK FOR CORRECT RECORD LENGTH >>                  <<*1398>>07022996
        IF I = NUM'DS'RECS THEN << LAST REC IN THIS DATA SEG >><<*1398>>07022998
          BEGIN                                                <<*1398>>07023000
          IF LEN < 4096  AND                                   <<*1398>>07023002
            LEN <> INTEGER(DST'ENTRY.(3:13)*4) MOD 4096  OR    <<*1398>>07023004
            LEN = 4096  AND                                    <<*1398>>07023006
            INTEGER(DST'ENTRY.(3:13)*4) MOD 4096 <> 0  THEN    <<*1398>>07023008
            VM'ERROR(2);                                       <<*1398>>07023010
          << PAD LAST DATA SEG RECORD WITH ZEROS >>            <<*1398>>07023012
          IF LEN <> 4096 THEN                                  <<*1398>>07023014
            BEGIN                                              <<*1398>>07023016
            TAPEBUF(LEN) := 0;                                 <<*1398>>07023018
            MOVE TAPEBUF(LEN+1) := TAPEBUF(LEN), (4095-LEN);   <<*1398>>07023020
            END;                                               <<*1398>>07023022
          END                                                  <<*1398>>07023024
        ELSE   << OTHER THAN LAST RECORD IN DATA SEG >>        <<*1398>>07023026
          IF LEN <> 4096 THEN                                  <<*1398>>07023028
            VM'ERROR(3);                                       <<*1398>>07023030
        FWRITE(VMFILE,TAPEBUF,4096,0);                         <<*1398>>07023032
        IF <> THEN                                             <<*1398>>07023034
          VM'ERROR(4);                                         <<*1398>>07023036
        VM'REC'NUM := VM'REC'NUM + 1;                          <<*1398>>07023038
        END;  << COPY ALL RECORDS FOR ONE DATA SEG >>          <<*1398>>07023040
      END; << NON-ZERO DATA SEG LEN >>                         <<*1398>>07023042
    LEN := FREAD'MULTIVOL(TAPEF,TAPEBUF,4096);                 <<*1398>>07023044
    IF < THEN    << READ ERROR >>                              <<*1398>>07023046
      VM'ERROR(0);                                             <<*1398>>07023048
    IF > THEN    << UNEXPECTED EOF >>                          <<*1398>>07023050
      BEGIN                                                    <<*1398>>07023052
      MOVE BBUF := "UNEXPECTED EOF IN VM FILE";                <<*1398>>07023054
      PRINTLINE;                                               <<*1398>>07023056
      VM'INUSE := FALSE;                                       <<*1398>>07023058
      RETURN;                                                  <<*1398>>07023060
      END;                                                     <<*1398>>07023062
    << THIS RECORD SHOULD BE A TRAILER RECORD >>               <<*1398>>07023064
    IF TAPEBUF(0) <> 1 OR LEN <> 4  THEN                       <<*1398>>07023066
      VM'ERROR(5);  << NOT A TRAILER RECORD >>                 <<*1398>>07023068
    << SET UP FOR FOLLOWING CONDITIONALS >>                    <<*1398>>07023070
    GET'DST'ENTRY(DSTNO,RL'DST'ENTRY);                         <<*1398>>07023072
    << ANY SDF ERRORS FOR THIS DATA SEG? >>                    <<*1398>>07023074
    IF TAPEBUF(2) <> 0 OR NUM'DS'RECS = 0  THEN                <<*1398>>07023076
      BEGIN                                                    <<*1398>>07023078
      SDF'ERROR(TAPEBUF(2));                                   <<*1398>>07023080
      MOVE BBUF := "DATA SEG        REMAINS ABSENT";           <<*1398>>07023082
      @PBUF := @BBUF + 8;                                      <<*1398>>07023084
      PUTNUMP(DSTNO);                                          <<*1398>>07023086
      PRINTLINE;                                               <<*1398>>07023088
      END                                                      <<*1398>>07023090
    <<DST ENTRY FROM REAL MEMORY SHOULDN'T SHOW PRESENT STATE>><<*1398>>07023092
    ELSE IF RL'DSABSENT = 0 OR RL'DSROC = 1  THEN              <<*1398>>07023094
      BEGIN                                                    <<*1398>>07023096
      MOVE BBUF :=                                             <<*1398>>07023098
        "VM DATA SEG       IS ALSO PRESENT IN REAL MEMORY";    <<*1398>>07023100
      @PBUF := @BBUF + 11;                                     <<*1398>>07023102
      PUTNUMP(DSTNO);                                          <<*1398>>07023104
      PRINTLINE;                                               <<*1398>>07023106
      END                                                      <<*1398>>07023108
    ELSE                                                       <<*1398>>07023110
      BEGIN                                                    <<*1398>>07023112
      << CONVERT DST ENTRY TO LOOK LIKE PRESENT STATE >>       <<*1398>>07023114
      DSABSENT := 0;                                           <<*1398>>07023116
      DSIMI := 0;                                              <<*1398>>07023118
      << CALC BEGINNING VIRTUAL ADDR OF THIS DATA SEG >>       <<*1398>>07023120
      VM'ADDR := VM'MIN + DOUBLE(VM'REC'NUM - NUM'DS'RECS) *   <<*1398>>07023122
          4096D;                                               <<*1398>>07023124
      << PUT THIS ADDRESS INTO THE NEW DST ENTRY >>            <<*1398>>07023126
      DST'ENTRY(2) := VM'BANK;                                 <<*1398>>07023128
      DST'ENTRY(3) := VM'BASE;                                 <<*1398>>07023130
      << UPDATE PDST WITH NEW DST ENTRY >>                     <<*1398>>07023132
      FOR I := 0 UNTIL 3 DO                                    <<*1398>>07023134
        STDS(PDSTNO,DSTNO*4+I,DST'ENTRY(I));                   <<*1398>>07023136
      END;                                                     <<*1398>>07023138
    END;  << READ DATA SEGMENTS >>                             <<*1398>>07023140
END;  << VMTODISK >>                                           <<*1398>>07023142
$PAGE"                       PROCEDURE  GET'SYSTEM'FILES"      <<*1398>>07023144
PROCEDURE GET'SYSTEM'FILES;                                    <<*1398>>07023146
                                                               <<*1398>>07023148
<<  THIS PROCEDURE IS CALLED BY VERS1'TAPETODISK.   >>         <<*1398>>07023150
<<  THE SYSTEM FILES ARE READ FROM TAPE AND STORED  >>         <<*1398>>07023152
<<  INTO TEMPORARY DISK FILES FOR LATER USE BYE     >>         <<*1398>>07023154
<<  THE FORMATTING ROUTINES.                        >>         <<*1398>>07023156
                                                               <<*1398>>07023158
BEGIN                                                          <<*1398>>07023160
                                                               <<*1398>>07023162
 INTEGER DFILENUM,                                             <<*1398>>07023164
         RLENGTH,                                              <<*1398>>07023166
         REC'LENGTH,                                           <<*1398>>07023168
         FILECODE,                                             <<*1398>>07023170
         FILECOUNT,                                            <<*1398>>07023172
         DEVTYPE,                                              <<*1398>>07023174
         LDEV,                                                 <<*1398>>07023176
         REC'NUM;                                              <<*1398>>07023178
 DOUBLE  FILE'SIZE;                                            <<*1398>>07023180
 ARRAY   FILEBUF(0:127);                                       <<*1398>>07023182
 BYTE ARRAY FILENAME(0:19);                                    <<*1398>>07023184
 BYTE ARRAY SYSFNAME(0:19);                                    <<*1398>>07023186
 BYTE ARRAY BFILEBUF(*)=FILEBUF;                               <<*1398>>07023188
 LOGICAL FILEOPTIONS,                                          <<*1398>>07023190
         EOF;                                                  <<*1398>>07023192
                                                               <<*1398>>07023194
 SUBROUTINE FILES'TO'DISC;                                     <<*1398>>07023196
 BEGIN                                                         <<*1398>>07023198
   EOF:=FALSE;                                                 <<*1398>>07023200
   REC'NUM := 0;                                               <<*1398>>07023202
   WHILE NOT EOF DO                                            <<*1398>>07023204
     BEGIN                                                     <<*1398>>07023206
     RLENGTH:=FREAD(TAPEF,FILEBUF,128);                        <<*1398>>07023208
     IF = THEN                                                 <<*1398>>07023210
       BEGIN                                                   <<*1398>>07023212
       IF REC'NUM=0 AND DUPLICATIVE THEN                       <<*1398>>07023214
         BEGIN                                                 <<*1398>>07023216
         MOVE BBUF := "READING IN ";                           <<*1398>>07023218
         MOVE BBUF(11) := SYSFNAME, (8);                       <<*1398>>07023220
         PRINT(DBUFFER,-19,0);                                 <<*1398>>07023222
         END;                                                  <<*1398>>07023224
       IF BFILEBUF <> "MPECHECK.PUB.SYS NOT PRESENT" THEN      <<*1398>>07023226
         BEGIN                                                 <<*1398>>07023228
         IF REC'NUM <> 0 THEN  << THROW FILE LABEL AWAY >>     <<*1398>>07023230
           BEGIN                                               <<*1398>>07023232
           FWRITE(DFILENUM,FILEBUF,128,0);                     <<*1398>>07023234
           IF <> THEN                                          <<*1398>>07023236
             TAPE'MODIFY'ERROR(1,DFILENUM);                    <<*1398>>07023238
           END;                                                <<*1398>>07023240
         END                                                   <<*1398>>07023242
       ELSE                                                    <<*1398>>07023244
         BEGIN                                                 <<*1398>>07023246
         FCLOSE(DFILENUM,0,0);                                 <<*1398>>07023248
         IF <> THEN TAPE'MODIFY'ERROR(6,DFILENUM);             <<*1398>>07023250
         EOF:=TRUE                                             <<*1398>>07023252
         END;                                                  <<*1398>>07023254
       END                                                     <<*1398>>07023256
     ELSE                                                      <<*1398>>07023258
       BEGIN                                                   <<*1398>>07023260
       IF > THEN                                               <<*1398>>07023262
         BEGIN                                                 <<*1398>>07023264
         FCLOSE(DFILENUM,%2,0);                                <<*1398>>07023266
         IF <> THEN TAPE'MODIFY'ERROR(6,DFILENUM);             <<*1398>>07023268
         EOF:=TRUE;                                            <<*1398>>07023270
         END                                                   <<*1398>>07023272
       ELSE                                                    <<*1398>>07023274
         TAPE'MODIFY'ERROR(8,TAPEF);                           <<*1398>>07023276
       END;                                                    <<*1398>>07023278
     REC'NUM := REC'NUM + 1;                                   <<*1398>>07023280
     END;                                                      <<*1398>>07023282
 END;                                                          <<*1398>>07023284
                                                               <<*1398>>07023286
<<   P R O C E D U R E    M A I N   >>                         <<*1398>>07023288
  FILECOUNT:=0;                                                <<*1398>>07023290
  << LOOP TO PREPARE FOR COPYING OF FOUR TAPE FILES TO DISC >> <<*1398>>07023292
  WHILE FILECOUNT < 4 DO                                       <<*1398>>07023294
    BEGIN                                                      <<*1398>>07023296
    CASE FILECOUNT OF                                          <<*1398>>07023298
      BEGIN                                                    <<*1398>>07023300
        BEGIN                                                  <<*1398>>07023302
        MOVE FILENAME:="DPANLMP.PUB.SYS  ";                    <<*1398>>07023304
        MOVE SYSFNAME:="LOADMAP  ";                            <<*1398>>07023306
        REC'LENGTH:=-128;                                      <<*1398>>07023308
        FILEOPTIONS:=%4;  << ASCII >>                          <<*1398>>07023310
        FILE'SIZE:=1023D;                                      <<*1398>>07023312
        FILECODE:=0;                                           <<*1398>>07023314
        MOVE LMAPNAME:="DPANLMP.PUB.SYS  ";                    <<*1398>>07023316
        END;                                                   <<*1398>>07023318
                                                               <<*1398>>07023320
        BEGIN                                                  <<*1398>>07023322
        MOVE FILENAME:="DPANCHCK.PUB.SYS ";                    <<*1398>>07023324
        MOVE SYSFNAME:="MPECHECK ";                            <<*1398>>07023326
        REC'LENGTH:=128;                                       <<*1398>>07023328
        FILEOPTIONS:=%0;  << BINARY >>                         <<*1398>>07023330
        FILE'SIZE:=1023D;                                      <<*1398>>07023332
        FILECODE:=1023;                                        <<*1398>>07023334
        MOVE CHCKNAME:="DPANCHCK.PUB.SYS ";                    <<*1398>>07023336
        END;                                                   <<*1398>>07023338
                                                               <<*1398>>07023340
        BEGIN                                                  <<*1398>>07023342
        MOVE FILENAME:="DPANCONF.PUB.SYS ";                    <<*1398>>07023344
        MOVE SYSFNAME:="CONFDATA ";                            <<*1398>>07023346
        REC'LENGTH:=128;                                       <<*1398>>07023348
        FILEOPTIONS:=%0;  << BINARY >>                         <<*1398>>07023350
        FILE'SIZE:=1023D;                                      <<*1398>>07023352
        FILECODE:=0;                                           <<*1398>>07023354
        MOVE CONFNAME:="DPANCONF.PUB.SYS ";                    <<*1398>>07023356
        END;                                                   <<*1398>>07023358
                                                               <<*1398>>07023360
        BEGIN                                                  <<*1398>>07023362
        MOVE FILENAME:="DPANPMAP.PUB.SYS ";                    <<*1398>>07023364
        MOVE SYSFNAME:="HPPMAP   ";                            <<*1398>>07023366
        REC'LENGTH:=-64;                                       <<*1398>>07023368
        FILEOPTIONS:=%4;  << ASCII >>                          <<*1398>>07023370
        FILE'SIZE:=4095D;                                      <<*1398>>07023372
        FILECODE:=0;                                           <<*1398>>07023374
        MOVE PMAPNAME:="DPANPMAP.PUB.SYS ";                    <<*1398>>07023376
        END;                                                   <<*1398>>07023378
      END;                                                     <<*1398>>07023380
<< SOFTDUMP WRITES THE SYSTEM FILES OUT WITH 128 WORD RECORDS>><<*1398>>07023382
<< ON TAPE REGARDLESS OF "REAL" RECORD SIZE.  THE TEMPORARY  >><<*1398>>07023384
<< DISK FILES THAT THE TAPE FILES ARE TO BE COPIED TO HERE   >><<*1398>>07023386
<< ARE OPENED WITH NO-BUF AND MULTI-RECORD TO ALLOW WRITING  >><<*1398>>07023388
<< THESE SECTOR SIZED AMOUNTS EVEN THOUGH THE ACTUAL RECORD  >><<*1398>>07023390
<< SIZE MIGHT BE ONLY 64 BYTES.                              >><<*1398>>07023392
    DFILENUM:=FOPEN(FILENAME,FILEOPTIONS,%424,                 <<*1398>>07023394
                    REC'LENGTH,,,,,,FILE'SIZE,,,FILECODE);     <<*1398>>07023396
    IF <> THEN                                                 <<*1398>>07023398
      TAPE'MODIFY'ERROR(5,DFILENUM);                           <<*1398>>07023400
    FILES'TO'DISC;                                             <<*1398>>07023402
    FILECOUNT:=FILECOUNT+1;                                    <<*1398>>07023404
    END;                                                       <<*1398>>07023406
                                                               <<*1398>>07023408
END;                                                           <<*1398>>07023410
$PAGE"                     PROCEDURE  VERS1'TAPETODISK"        <<*1398>>07023412
PROCEDURE VERS1'TAPETODISK;                                    <<*1398>>07023414
                                                               <<*1398>>07023416
COMMENT                                                        <<*1398>>07023418
                                                               <<*1398>>07023420
    THIS PROCEDURE IS CALLED BY TAPETODISK, AFTER MAIN         <<*1398>>07023422
    MEMORY HAS BEEN READ IN, TO PROCESS THE REMAINDER OF       <<*1398>>07023424
    A VERSION ONE DUMP TAPE.  AN EXTRA DATA SEGMENT IS         <<*1398>>07023426
    OBTAINED AND THE DST COPIED INTO IT.  THIS IS CALLED       <<*1398>>07023428
    THE PSEUDO DST.  VMTODISK WILL 'SWAP IN' THE VIRTUAL       <<*1398>>07023430
    DATA SEGMENTS BY MAKING THE RESPECTIVE DST ENTRIES         <<*1398>>07023432
    LOOK LIKE THE PRESENT STATE.  THIS PSEUDO DST WILL         <<*1398>>07023434
    BE USED BY CORE WHERE IT REPLACES THE REAL DST             <<*1398>>07023436
    IN ORDER TO MAKE THE ADDITION OF THE VIRTUAL               <<*1398>>07023438
    DATA SEGMENTS TRANSPARENT TO ALL THE FORMATTING            <<*1398>>07023440
    ROUTINES.                                                  <<*1398>>07023442
                                                               <<*1398>>07023444
                                                               <<*1398>>07023446
Following are diagrams of the softdump VERSION 1               <<*1398>>07023448
(with virtual storage) tape format:                            <<*1398>>07023450
                                                               <<*1398>>07023452
           Dump Tape Format                                    <<*1398>>07023454
                                                               <<*1398>>07023456
           --------------                                      <<*1398>>07023458
           |  BOT       |                                      <<*1398>>07023460
           |------------|                                      <<*1398>>07023462
           |  Real      |                                      <<*1398>>07023464
           |  Memory    |                                      <<*1398>>07023466
           |  Area      |                                      <<*1398>>07023468
           |------------|                                      <<*1398>>07023470
           |  EOF       |                                      <<*1398>>07023472
           |------------|    \                                 <<*1398>>07023474
           |  Virtual   |     |                                <<*1398>>07023476
           |  Storage   |     |  Result of DSEG=ALL            <<*1398>>07023478
           |  Area      |     >  parameter of the              <<*1398>>07023480
           |------------|     |  DUMP command.                 <<*1398>>07023482
           |  EOF       |     |                                <<*1398>>07023484
           |------------|    /                                 <<*1398>>07023486
           |  Loadmap   |                                      <<*1398>>07023488
           |------------|                                      <<*1398>>07023490
           |  EOF       |                                      <<*1398>>07023492
           |------------|                                      <<*1398>>07023494
           |  MPECheck  |                                      <<*1398>>07023496
           |------------|                                      <<*1398>>07023498
           |  EOF       |                                      <<*1398>>07023500
           |------------|                                      <<*1398>>07023502
           |  Confdata  |                                      <<*1398>>07023504
           |------------|                                      <<*1398>>07023506
           |  EOF       |                                      <<*1398>>07023508
           |------------|                                      <<*1398>>07023510
           |  HPPmap    |                                      <<*1398>>07023512
           |------------|                                      <<*1398>>07023514
           |  EOF       |                                      <<*1398>>07023516
           |------------|                                      <<*1398>>07023518
           |  EOF       |                                      <<*1398>>07023520
           |------------|                                      <<*1398>>07023522
                                                               <<*1398>>07023524
                                                               <<*1398>>07023526
                                                               <<*1398>>07023528
                                                               <<*1398>>07023530
           Memory Dump Tape                                    <<*1398>>07023532
           Virtual Storage Area                                <<*1398>>07023534
                                                               <<*1398>>07023536
           --------------                                      <<*1398>>07023538
           |  Header    |                                      <<*1398>>07023540
           |  Record    |                                      <<*1398>>07023542
           |------------|                                      <<*1398>>07023544
           |  Data      |                                      <<*1398>>07023546
           |  Segment   |                                      <<*1398>>07023548
           |------------|                                      <<*1398>>07023550
           |  Trailer   |                                      <<*1398>>07023552
           |  Record    |                                      <<*1398>>07023554
           |------------|    \                                 <<*1398>>07023556
           |  Header    |     |                                <<*1398>>07023558
           |  Record    |     |  No data seg contents          <<*1398>>07023560
           |------------|     >  because of error.             <<*1398>>07023562
           |  Trailer   |     |                                <<*1398>>07023564
           |  Record    |     |                                <<*1398>>07023566
           |------------|    /                                 <<*1398>>07023568
           |            |                                      <<*1398>>07023570
           .     o      .                                      <<*1398>>07023572
           .            .                                      <<*1398>>07023574
           .     o      .                                      <<*1398>>07023576
           .            .                                      <<*1398>>07023578
           .     o      .                                      <<*1398>>07023580
           |            |                                      <<*1398>>07023582
           |------------|                                      <<*1398>>07023584
           |  Header    |                                      <<*1398>>07023586
           |  Record    |                                      <<*1398>>07023588
           |------------|                                      <<*1398>>07023590
           |  Data      |                                      <<*1398>>07023592
           |  Segment   |                                      <<*1398>>07023594
           |------------|                                      <<*1398>>07023596
           |  Trailer   |                                      <<*1398>>07023598
           |  Record    |                                      <<*1398>>07023600
           |------------|                                      <<*1398>>07023602
                                                               <<*1398>>07023604
                                                               <<*1398>>07023606
                                                               <<*1398>>07023608
                    Memory Dump Tape                           <<*1398>>07023610
                    Virtual Storage Area                       <<*1398>>07023612
                    Header Record Format                       <<*1398>>07023614
                                                               <<*1398>>07023616
          0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15       <<*1398>>07023618
        |--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|      <<*1398>>07023620
Word 0  |                      0                        |      <<*1398>>07023622
        |-----------------------------------------------|      <<*1398>>07023624
Word 1  |                     DST#                      |      <<*1398>>07023626
        |-----------------------------------------------|      <<*1398>>07023628
Word 2  |            LENGTH OF DST IN WORDS             |      <<*1398>>07023630
        |-----------------------------------------------|      <<*1398>>07023632
Word 3  |A |0 |R |               SIZE/4                 | FIRM <<*1398>>07023634
        |-----------------------------------------------| INFO <<*1398>>07023636
Word 4  |D |R |I |S |M |F |S |C |W |                    |      <<*1398>>07023638
        |C |O |M |T |O |W |Y |O |D |   VMALLOC          | FLAGS<<*1398>>07023640
        |V |C |I |K |D |I |S |R |  |                    |      <<*1398>>07023642
        |  |  |  |  |  |P |  |E |  |                    |      <<*1398>>07023644
        |-----------------------------------------------|      <<*1398>>07023646
Word 5  |     LDEV#             |        HODA           | HODA <<*1398>>07023648
        |-----------------------------------------------|      <<*1398>>07023650
Word 6  |                  LODA                         | LODA <<*1398>>07023652
        |-----------------------------------------------|      <<*1398>>07023654
Word 7  |         D             |          S            |      <<*1398>>07023656
        |-----------------------------------------------|      <<*1398>>07023658
Word%10 |         T             |          #            |      <<*1398>>07023660
        |-----------------------------------------------|      <<*1398>>07023662
Word%11 |         X             |          X            |      <<*1398>>07023664
        |-----------------------------------------------|      <<*1398>>07023666
Word%12 |         X             |          X            |      <<*1398>>07023668
        |-----------------------------------------------|      <<*1398>>07023670
Word%13 |         X             |          X            |      <<*1398>>07023672
        |-----------------------------------------------|      <<*1398>>07023674
                                                               <<*1398>>07023676
                                                               <<*1398>>07023678
                                                               <<*1398>>07023680
                                                               <<*1398>>07023682
                   Memory Dump Tape                            <<*1398>>07023684
                   Virtual Storage Area                        <<*1398>>07023686
                   Trailer Record Format                       <<*1398>>07023688
                                                               <<*1398>>07023690
          0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15       <<*1398>>07023692
        |--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|--|      <<*1398>>07023694
Word 0  |                      1                        |      <<*1398>>07023696
        |-----------------------------------------------|      <<*1398>>07023698
Word 1  |                     DST#                      |      <<*1398>>07023700
        |-----------------------------------------------|      <<*1398>>07023702
Word 2  |I |I |D |I |///////////////////////////////////|      <<*1398>>07023704
        |L |A |R |T |///////////////////////////////////| FLAGS<<*1398>>07023706
        |D |D |E |S |///////////////////////////////////|      <<*1398>>07023708
        |E |D |  |  |///////////////////////////////////|      <<*1398>>07023710
        |V |R |  |  |///////////////////////////////////|      <<*1398>>07023712
        |-----------------------------------------------|      <<*1398>>07023714
Word 3  |  NUMBER OF RECORDS WRITTEN FOR DST CONTENTS   |      <<*1398>>07023716
        |-----------------------------------------------|      <<*1398>>07023718
                                                               <<*1398>>07023720
                                                               <<*1398>>07023722
                                                               <<*1398>>07023724
         Trailer Record Field Descriptions                     <<*1398>>07023726
                                                               <<*1398>>07023728
         ILDEV = invalid LDEV                                  <<*1398>>07023730
         IADDR = invalid virtual storage address               <<*1398>>07023732
         DRE   = disc read error                               <<*1398>>07023734
         ITS   = invalid table structure                       <<*1398>>07023736
                                                               <<*1398>>07023738
END OF COMMENT;                                                <<*1398>>07023740
                                                               <<*1398>>07023742
    BEGIN                                                      <<*1398>>07023744
                                                               <<*1398>>07023746
      DEFINE                                                   <<*1398>>07023748
        ABSENT = ENTRY'WORD0.(0:1)#,                           <<*1398>>07023750
        ROC    = ENTRY'WORD1.(1:1)#;                           <<*1398>>07023752
      EQUATE MAX'XDS'SIZE'ADR = %1111;                         <<*1398>>07023754
      LOGICAL MAX'XDS'SIZE, NUMDSTENTRIES;                     <<*1398>>07023756
      INTEGER ENTRY'WORD0, ENTRY'WORD1, DUMMY, I;              <<*1398>>07023758
      DOUBLE VMRECS;                                           <<*1398>>07023760
                                                               <<*1398>>07023762
      USE'PSEUDO'DST := FALSE;                                 <<*1398>>07023764
      MAX'REAL'MEM := MAXMEM;                                  <<*1398>>07023766
      VM'MIN := MAXMEM + 1D;                                   <<*1398>>07023768
      NUMDSTENTRIES := CORE(DOUBLE(DST'MIN));                  <<*1398>>07023770
                                                               <<*1398>>07023772
    << GET AN XDS FOR THE PSEUDO DST >>                        <<*1398>>07023774
                                                               <<*1398>>07023776
      MAX'XDS'SIZE := ABSOLUTE(MAX'XDS'SIZE'ADR);              <<*1398>>07023778
      ABSOLUTE(MAX'XDS'SIZE'ADR) := (NUMDSTENTRIES+1)*4 + 128; <<*1398>>07023780
      PDSTNO := GETDATASEG((NUMDSTENTRIES+1)*4,0);             <<*1398>>07023782
      IF < THEN                                                <<*1398>>07023784
        BEGIN                                                  <<*1398>>07023786
        MOVE BBUF := "COULDN'T GET XDS FOR PSEUDO DST";        <<*1398>>07023788
        PRINTLINE;                                             <<*1398>>07023790
        MOVE BBUF := "VIRTUAL MEMORY NOT PROCESSED";           <<*1398>>07023792
        PRINTLINE;                                             <<*1398>>07023794
        FCONTROL(TAPEF,7,DUMMY);  << SPACE TO NEXT FILE >>     <<*1398>>07023796
        VM'INUSE := FALSE;                                     <<*1398>>07023798
        GOTO GSF;                                              <<*1398>>07023800
        END;                                                   <<*1398>>07023802
      ABSOLUTE(MAX'XDS'SIZE'ADR) := MAX'XDS'SIZE;              <<*1398>>07023804
                                                               <<*1398>>07023806
    << COPY DST INTO THE PDST >>                               <<*1398>>07023808
                                                               <<*1398>>07023810
      FOR I := 0 UNTIL INTEGER(NUMDSTENTRIES*4+3) DO           <<*1398>>07023812
        STDS(PDSTNO,I,                                         <<*1398>>07023814
             INTEGER(CORE(DOUBLE(DST'MIN + LOGICAL(I)))));     <<*1398>>07023816
                                                               <<*1398>>07023818
    << CALCULATE TOTAL NUMBER OF 4K RECORDS FOR VM SPACE >>    <<*1398>>07023820
    << ZERO PADDING IS INCLUDED                          >>    <<*1398>>07023822
                                                               <<*1398>>07023824
      VMRECS := 0D;                                            <<*1398>>07023826
      FOR I := 1 UNTIL INTEGER(NUMDSTENTRIES)  DO              <<*1398>>07023828
        BEGIN                                                  <<*1398>>07023830
        ENTRY'WORD0 := LFDS(PDSTNO,I*4);                       <<*1398>>07023832
        ENTRY'WORD1 := LFDS(PDSTNO,I*4+1);                     <<*1398>>07023834
        IF ENTRY'WORD0 <> %100000                              <<*1398>>07023836
             AND ABSENT = 1  AND  ROC = 0  THEN  << VIRT >>    <<*1902>>07023838
          VMRECS :=                                            <<*1398>>07023840
            VMRECS + DOUBLE((ENTRY'WORD0.(3:13)-1)/1024 + 1);  <<*1398>>07023842
        END;                                                   <<*1398>>07023844
                                                               <<*1398>>07023846
    << OPEN VM FILE >>                                         <<*1398>>07023848
                                                               <<*1398>>07023850
      MOVE BBUF := "VIRTFILE ";                                <<*1398>>07023852
      VMFILE := FOPEN(BBUF,0,%504,4096,,,,,,VMRECS,32,1);      <<*1398>>07023854
      IF <> THEN                                               <<*1398>>07023856
        BEGIN                                                  <<*1398>>07023858
        MOVE BBUF :=                                           <<*1398>>07023860
          "CC <> ON FOPEN TO DISK - VIRTUAL MEM FILE";         <<*1398>>07023862
        PRINT(DBUFFER,-41,0);                                  <<*1398>>07023864
        PRINT'FILE'INFO(VMFILE);                               <<*1398>>07023866
        ERROR;                                                 <<*1398>>07023868
        END;                                                   <<*1398>>07023870
                                                               <<*1398>>07023872
    << COPY VM FROM TAPE TO VMFILE WHILE ENTERING EACH VM >>   <<*1398>>07023874
    << DATA SEGMENT'S DST ENTRY INTO THE PDST             >>   <<*1398>>07023876
                                                               <<*1398>>07023878
      VM'INUSE := TRUE;                                        <<*1398>>07023880
      GET'FILES := TRUE;                                       <<*1398>>07023882
      VMTODISK;                                                <<*1398>>07023884
                                                               <<*1398>>07023886
    << PRINT VIRTUAL ADDRESS RANGE >>                          <<*1398>>07023888
                                                               <<*1398>>07023890
      IF VM'INUSE THEN                                         <<*1398>>07023892
        BEGIN                                                  <<*1398>>07023894
        BLANKBUF;                                              <<*1398>>07023896
        MOVE BBUF :=                                           <<*1398>>07023898
          "VIRTUAL 'ADDRESS' RANGE   =        000000 TO ";     <<*1398>>07023900
        @PBUF := @BBUF + 28;                                   <<*1398>>07023902
        PUTNUM(MEMSIZE);                                       <<*1398>>07023904
        @PBUF := @BBUF + 45;                                   <<*1398>>07023906
        PUTNUM(INTEGER(MAXMEM&DLSR(16)));                      <<*1398>>07023908
        PUTNUM(INTEGER(MAXMEM));                               <<*1398>>07023910
        PRINTLINE;                                             <<*1398>>07023912
        END;                                                   <<*1398>>07023914
                                                               <<*1398>>07023916
    << COPY SYSTEM FILES FROM TAPE TO TEMP DISK FILES >>       <<*1398>>07023918
GSF:                                                           <<*1398>>07023920
      IF GET'FILES THEN  GET'SYSTEM'FILES;                     <<*1398>>07023922
                                                               <<*1398>>07023924
      USE'PSEUDO'DST := VM'INUSE;                              <<*1398>>07023926
                                                               <<*1398>>07023928
    END;   << VERS1'TAPETODISK >>                              <<*1398>>07023930
$PAGE "            TAPETODISK: Copy dump to disc file"         <<*1398>>07023932
COMMENT                                                        <<*1398>>07023934
                                                               <<*1398>>07023936
Purpose:                                                       <<*1398>>07023938
<<    THIS PROCEDURE WILL READ THE COLD DUMP TAPE AND BUILD  >><<*1398>>07023940
<<    A CORE IMAGE DISK FILE REPRESENTING MEMORY AS IT WAS   >><<*1398>>07023942
<<    AT THE TIME THE COLD DUMP TAPE WAS CREATED.            >><<*1398>>07023944
                                                               <<*1398>>07023946
Input parameters:                                              <<*1398>>07023948
                                                               <<*1398>>07023950
Output parameters:                                             <<*1398>>07023952
                                                               <<*1398>>07023954
Globals Referenced:                                            <<*1398>>07023956
                                                               <<*1398>>07023958
Globals Altered:                                               <<*1398>>07023960
                                                               <<*1398>>07023962
Data Structures:                                               <<*1398>>07023964
                                                               <<*1398>>07023966
Algorithm:                                                     <<*1398>>07023968
                                                               <<*1398>>07023970
;                                                              <<*1398>>07023972
                                                               <<*1398>>07023974
PROCEDURE TAPETODISK;                                          <<*1398>>07023976
      BEGIN                                                    <<*1398>>07023978
                                                               <<*1398>>07023980
         INTEGER TLOG,BUFSAV,ADDRD,S;                          <<*1398>>07023982
         DOUBLE CURREC;                                        <<*1398>>07023984
         LOGICAL SMODE,PRM,JNK,PROPERVOLUME;                   <<*1398>>07023986
         REAL TIME:=1.0;                                       <<*1398>>07023988
         LOGICAL RETRYCNT:=0;    <<RETRY COUNT ON TAPE>>       <<*1398>>07023990
         LOGICAL EOF;                                          <<*1398>>07023992
         LOGICAL INCOMPLETE'TAPE := FALSE;                     <<*1398>>07023994
         LOGICAL CHECK'MULTI'VOL;                              <<*1398>>07023996
         LOGICAL TAPE'VERSION;                                 <<*1398>>07023998
         INTEGER CHECKSUM,LEN,LDEV,I;                         <<<*1398>>07024000
         BYTE ARRAY SLDEV(0:6);                                <<*1398>>07024002
         ARRAY TRAILBUF(0:10);                                 <<*1398>>07024004
         EQUATE REWINDUNLOAD=9;                                <<*1398>>07024006
         DOUBLE T'CONVERT;                                     <<*1398>>07024008
         REAL TICK'TO'MS := 9.14566375E-2;                     <<*1398>>07024010
                                                               <<*1398>>07024012
                                                               <<*1398>>07024014
LOGICAL SUBROUTINE FIXIT(W);                                   <<*1398>>07024016
VALUE W; LOGICAL W;                                            <<*1398>>07024018
BEGIN                                                          <<*1398>>07024020
   << CHECK EACH BYTE OF W TO SEE THAT IT IS >>                <<*1398>>07024022
   << A PRINTABLE ASCII CHARACTER.  IF NOT,  >>                <<*1398>>07024024
   << REPLACE WITH BLANK                     >>                <<*1398>>07024026
   IF W.(0:8)<%40 OR W.(0:8)>%176 THEN W.(0:8):=%40;           <<*1398>>07024028
   IF W.(8:8)<%40 OR W.(8:8)>%176 THEN W.(8:8):=%40;           <<*1398>>07024030
   FIXIT:=W;                                                   <<*1398>>07024032
END;                                                           <<*1398>>07024034
                                                               <<*1398>>07024036
                                                               <<*1398>>07024038
      SUBROUTINE GET35CONTEXT;                                 <<*1398>>07024040
         BEGIN                                                 <<*1398>>07024042
         XREG:=M35XREG;                                        <<*1398>>07024044
         DLREG:=M35DLREG;                                      <<*1398>>07024046
         DBBANKREG:=M35DBANKREG;                               <<*1398>>07024048
         DBREG:=M35DBREG;                                      <<*1398>>07024050
         QREG:=M35QREG;                                        <<*1398>>07024052
         SREG:=M35SMREG;                                       <<*1398>>07024054
         ZBANKREG:=M35SBANKREG;                                <<*1398>>07024056
         ZREG:=M35ZREG;                                        <<*1398>>07024058
         STAREG:=M35STATUSREG;                                 <<*1398>>07024060
         PBBANKREG:=M35PBANKREG;                               <<*1398>>07024062
         PBREG:=M35PBREG;                                      <<*1398>>07024064
         PREG:=M35PREG;                                        <<*1398>>07024066
         PLREG:=M35PLREG;                                      <<*1398>>07024068
         CIRREG:=M35CIREG;                                     <<*1398>>07024070
         CPX1:=M35CPX1;                                        <<*1398>>07024072
         CPX2:=M35CPX2;                                        <<*1398>>07024074
         SP1:=M35SP1REG;                                       <<*1398>>07024076
         SP2:=M35SP2REG;                                       <<*1398>>07024078
         IF CNSTARFISH <> 0 THEN                               <<*1398>>07024080
            BEGIN                                              <<*1398>>07024082
            I := CNSTARFISH*4; << COMPUTE LOCATION OF DRT >>   <<*1398>>07024084
            COREBUF(I) := CNDRT0;                              <<*1398>>07024086
            COREBUF(I+1) := CNDRT1;                            <<*1398>>07024088
            COREBUF(I+2) := CNDRT2;                            <<*1398>>07024090
            COREBUF(I+3) := CNDRT3;                            <<*1398>>07024092
            END                                                <<*1398>>07024094
         ELSE                                                  <<*1398>>07024096
            COREBUF(24) := M35CONTENTS24;                      <<*1398>>07024098
         TOS:=M35NUMBANKS; TOS:=0;                             <<*1398>>07024100
         MAXMEM:=TOS-1D;                                       <<*1398>>07024102
         MEMSIZE:=M35NUMBANKS;                                 <<*1398>>07024104
         END  <<GET35CONTEXT>>;                                <<*1398>>07024106
                                                               <<*1398>>07024108
      SUBROUTINE GET25CONTEXT;                                 <<*1398>>07024110
         BEGIN                                                 <<*1398>>07024112
         XREG:=M25XREG;                                        <<*1398>>07024114
         DLREG:=M25DLREG;                                      <<*1398>>07024116
         DBBANKREG:=M25DBANKREG;                               <<*1398>>07024118
         DBREG:=M25DBREG;                                      <<*1398>>07024120
         QREG:=M25QREG;                                        <<*1398>>07024122
         SREG:=M25SREG;                                        <<*1398>>07024124
         ZBANKREG:=M25SBANKREG;                                <<*1398>>07024126
         ZREG:=M25ZREG;                                        <<*1398>>07024128
         STAREG:=M25STATUSREG;                                 <<*1398>>07024130
         PBBANKREG:=M25PBANKREG;                               <<*1398>>07024132
         PBREG:=M25PBREG;                                      <<*1398>>07024134
         PREG:=M25PREG;                                        <<*1398>>07024136
         PLREG:=M25PLREG;                                      <<*1398>>07024138
         CIRREG:=M25CIREG;                                     <<*1398>>07024140
         NIR:=M25NIRREG;                                       <<*1398>>07024142
         ISR:=M25ISR;                                          <<*1398>>07024144
         IF MACHINEID = ICF55                                  <<*1398>>07024146
         THEN BEGIN                                            <<*1398>>07024148
           NIR := M55NIRREG;                                   <<*1398>>07024150
           CPX1 := M55CPX1;                                    <<*1398>>07024152
           CPX2 := M55CPX2;                                    <<*1398>>07024154
         END;                                                  <<*1398>>07024156
         TOS:=M25NUMBANKS; TOS:=0;                             <<*1398>>07024158
         MAXMEM:=TOS-1D;                                       <<*1398>>07024160
         MEMSIZE:=M25NUMBANKS;                                 <<*1398>>07024162
         END  <<GET25CONTEXT>>;                                <<*1398>>07024164
                                                               <<*1398>>07024166
                                                               <<*1398>>07024168
SUBROUTINE INVALIDTAPE;                                        <<*1398>>07024170
                                                               <<*1398>>07024172
<< THE DUMP TAPE HAS BEEN FOUND TO BE INVALID.  PRINT >>       <<*1398>>07024174
<< AN ERROR MESSAGE AND TERMINATE.                    >>       <<*1398>>07024176
                                                               <<*1398>>07024178
BEGIN                                                          <<*1398>>07024180
                                                               <<*1398>>07024182
   MOVE BBUF :=                                                <<*1398>>07024184
      "***INVALID DUMP TAPE.  UNABLE TO PROCESS DUMP.  ";      <<*1398>>07024186
   PRINT( DBUFFER, -48, 0 );                                   <<*1398>>07024188
   MOVE BBUF :=                                                <<*1398>>07024190
      "   SEE THE CONSOLE OPERATOR'S GUIDE FOR FURTHER ";      <<*1398>>07024192
   PRINT( DBUFFER, -48, 0 );                                   <<*1398>>07024194
   MOVE BBUF := "   INFORMATION.";                             <<*1398>>07024196
   PRINT( DBUFFER, -15, 0 );                                   <<*1398>>07024198
                                                               <<*1398>>07024200
   TERMINATE;                                                  <<*1398>>07024202
                                                               <<*1398>>07024204
END;  << INVALID TAPE >>                                       <<*1398>>07024206
                                                               <<*1398>>07024208
                                                               <<*1398>>07024210
$PAGE                                                          <<*1398>>07024212
SUBROUTINE INCOMPLETE;                                         <<*1398>>07024214
                                                               <<*1398>>07024216
<< THE INPUT DUMP FILE HAS BEEN FOUND TO BE INCOMPLETE.  >>    <<*1398>>07024218
<< PRINT ERROR MESSAGE AND HANDLE CONTINUATION OPTION.   >>    <<*1398>>07024220
                                                               <<*1398>>07024222
BEGIN                                                          <<*1398>>07024224
   MOVE BBUF := "INCOMPLETE DUMP:    K WORDS SHORT";           <<*1398>>07024226
   @PBUF := @BBUF + 17;                                        <<*1398>>07024228
   ASCII( (NUMREC*4), 10, PBUF );                              <<*1398>>07024230
   PRINT( DBUFFER, -33, 0 );                                   <<*1398>>07024232
   MOVE BBUF := "  ";                                          <<*1398>>07024234
   PRINT( DBUFFER, -2, 0 );                                    <<*1398>>07024236
                                                               <<*1398>>07024238
<< IF IN A SESSION, THERE IS THE OPTION OF CONTINUING.   >>    <<*1398>>07024240
   IF DUPLICATIVE THEN                                         <<*1398>>07024242
   BEGIN                                                       <<*1398>>07024244
      MOVE BBUF :=                                             <<*1398>>07024246
         "THE DUMP TAPE HAS BEEN FOUND TO BE INCOMPLETE.";     <<*1398>>07024248
      PRINT( DBUFFER, -46, 0 );                                <<*1398>>07024250
      MOVE BBUF :=                                             <<*1398>>07024252
         "THE RESULTING DUMP LISTING IS OFTEN OF LITTLE ";     <<*1398>>07024254
      PRINT( DBUFFER, -46, 0 );                                <<*1398>>07024256
      MOVE BBUF :=                                             <<*1398>>07024258
         "VALUE.  SEE THE CONSOLE OPERATOR'S GUIDE FOR  ";     <<*1398>>07024260
      PRINT( DBUFFER, -46, 0 );                                <<*1398>>07024262
      MOVE BBUF :=                                             <<*1398>>07024264
         "FURTHER INFORMATION.                          ";     <<*1398>>07024266
      PRINT( DBUFFER, -46, 0 );                                <<*1398>>07024268
      MOVE BBUF :=                                             <<*1398>>07024270
         "    ";                                               <<*1398>>07024272
      PRINT( DBUFFER, -4, 0 );                                 <<*1398>>07024274
      MOVE BBUF :=                                             <<*1398>>07024276
         "DO YOU WISH TO PRINT THIS INCOMPLETE DUMP (Y OR N)?";<<*1398>>07024278
      PRINT( DBUFFER, -52, 0 );                                <<*1398>>07024280
                                                               <<*1398>>07024282
   << READ THE RESPONSE FROM THE USER.                   >>    <<*1398>>07024284
      READX (DBUFFER,-1);                                      <<*1398>>07024286
      IF BBUF = "Y"  OR BBUF = "y"                             <<*1398>>07024288
         THEN INCOMPLETE'TAPE := TRUE                          <<*1398>>07024290
         ELSE TERMINATE;                                       <<*1398>>07024292
                                                               <<*1398>>07024294
   END     << USER WAS IN A SESSION. >>                        <<*1398>>07024296
   ELSE                                                        <<*1398>>07024298
   BEGIN   << USER WAS IN A JOB.     >>                        <<*1398>>07024300
                                                               <<*1398>>07024302
      MOVE BBUF :=                                             <<*1398>>07024304
         "RUN DPAN4 FROM A SESSION TO PRINT INCOMPLETE DUMPS"; <<*1398>>07024306
      PRINT( DBUFFER, -50, 0 );                                <<*1398>>07024308
      TERMINATE;                                               <<*1398>>07024310
                                                               <<*1398>>07024312
   END;                                                        <<*1398>>07024314
                                                               <<*1398>>07024316
END;  << INCOMPLETE. >>                                        <<*1398>>07024318
$PAGE                                                          <<*1398>>07024320
SUBROUTINE GET'SERIESII'CONTEXT;                               <<*1398>>07024322
                                                               <<*1398>>07024324
<< THE DEFAULT MACHINE CONTEXT IS THE OLD SERIES II.     >>    <<*1398>>07024326
<< OTHER OPTIONS (HANDLED ELSEWHERE) ARE MODELS 25 & 35. >>    <<*1398>>07024328
                                                               <<*1398>>07024330
BEGIN                                                          <<*1398>>07024332
                                                               <<*1398>>07024334
   ADDRD := COREBUF( 0 );                                      <<*1398>>07024336
   IF LOGICAL( ADDRD ) > %1010 THEN                            <<*1398>>07024338
   BEGIN                                                       <<*1398>>07024340
      MOVE BBUF := "INVALID DUMP TAPE.";                       <<*1398>>07024342
      PRINT( DBUFFER, -19, 0 );                                <<*1398>>07024344
      ERROR;                                                   <<*1398>>07024346
   END;                                                        <<*1398>>07024348
                                                               <<*1398>>07024350
<< SAVE PERTENIENT PARTS OF FIRST RECORD.                >>    <<*1398>>07024352
   MOVE SCRBUF := COREBUF(1), (26);                            <<*1398>>07024354
   BUFSAV := ADDRD + 1;                                        <<*1398>>07024356
                                                               <<*1398>>07024358
<< READ NEXT RECORD AND RESTORE SAVED INFORMATION.       >>    <<*1398>>07024360
   TLOG := FREAD( TAPEF, COREBUF, 4096 );                      <<*1398>>07024362
   IF <> THEN INCOMPLETE;                                      <<*1398>>07024364
   MOVE REGSAVE := COREBUF( BUFSAV+1 ), (26);                  <<*1398>>07024366
   MOVE COREBUF( BUFSAV ) := SCRBUF, (26);                     <<*1398>>07024368
   MOVE COREBUF( BUFSAV-7 ) := REGSAVE, (6);                   <<*1398>>07024370
   COREBUF( BUFSAV-1 ) := REG6;                                <<*1398>>07024372
   COREBUF( BUFSAV )   := REG7;                                <<*1398>>07024374
                                                               <<*1398>>07024376
   TOS := MEMSIZE LAND %7770;                                  <<*1398>>07024378
   DEL;                                                        <<*1398>>07024380
                                                               <<*1398>>07024382
   TOS := 0;                                                   <<*1398>>07024384
   TOS := MEMSIZE;                                             <<*1398>>07024386
   TOS := TOS&DCSR(3)&LSL(3);                                  <<*1398>>07024388
   ASB( XCH );                                                 <<*1398>>07024390
   TOS := TOS&CSL(3);                                          <<*1398>>07024392
   ASB( XCH );                                                 <<*1398>>07024394
   TOS := TOS - 1D;                                            <<*1398>>07024396
   IF < THEN BEGIN DDEL; TOS := %777777D; END;  << 256 K >>    <<*1398>>07024398
   MAXMEM := TOS;                                              <<*1398>>07024400
                                                               <<*1398>>07024402
END;  << GET'SERIESII'CONTEXT >>                               <<*1398>>07024404
$PAGE                                                          <<*1398>>07024406
                                                               <<*1398>>07024408
<<  M A I N    B O D Y                                   >>    <<*1398>>07024410
                                                               <<*1398>>07024412
      USE'PSEUDO'DST := FALSE;                                 <<*1398>>07024414
      VM'INUSE := FALSE;                                       <<*1398>>07024416
      WHO( JSM );                                              <<*1398>>07024418
      IF JSM.(15:1) = 1 THEN OPT := %400                       <<*1398>>07024420
      ELSE OPT:=%410;     <<STDLIST>>                          <<*1398>>07024422
      IF DUPLICATIVE THEN                                      <<*1398>>07024424
      BEGIN                                                   <<<*1398>>07024426
         TBUF:="  ";                                          <<<*1398>>07024428
         MOVE TBUF(1):=TBUF,(74);                             <<<*1398>>07024430
         MOVE TBUF:=DPN4,(5);                                  <<*1398>>07024432
         MOVE LVL(VUFF'COL):=OFFICIAL'VUUFF;                   <<*1398>>07024434
         MOVE TBUF(5):=LVL,(4);                               <<<*1398>>07024436
         MOVE TBUF(9):=COPYRITE,(14);                         <<<*1398>>07024438
         PRINT(TBUF,24,0);                                    <<<*1398>>07024440
      END; <<PRINT IDENTIFIER ON SESSION DEVICE>>             <<<*1398>>07024442
      IF NOT PRTNPRT THEN BEGIN                                <<*1398>>07024444
      LPF := FOPEN(LPN,OPT,1,,LPND,,,,16,4096D,32);            <<*1398>>07024446
      IF <> THEN                                               <<*1398>>07024448
      BEGIN                                                    <<*1398>>07024450
        PRINT'FILE'INFO(LPF);                                  <<*1398>>07024452
        ERROR;                                                 <<*1398>>07024454
      END;                                                     <<*1398>>07024456
      END;                                                     <<*1398>>07024458
         DPANSWAP:=FOPEN(MSWLIN,%64,1,-50);                    <<*1398>>07024460
          IF = THEN  MOVE MSWLIN:="        ";   <<BLANK NAME>> <<*1398>>07024462
   TAPEF:=FOPEN(COREDUMP,%3,%504,4096);                        <<*1398>>07024464
         IF = THEN GO TAPET;                                   <<*1398>>07024466
   MOVE COREDUMP(5):=".PUB.SYS";                               <<*1398>>07024468
   TAPEF:=FOPEN(COREDUMP,%3,%504,4096);                        <<*1398>>07024470
   IF = THEN GO TAPET;                                         <<*1398>>07024472
   TAPEF:=FOPEN(DPANIN,%200,%504,4096,TAPE);                   <<*1398>>07024474
         IF <> THEN                                            <<*1398>>07024476
         BEGIN                                                 <<*1398>>07024478
            MOVE DBUFFER:="CC <> ON FOPEN TO TAPE";            <<*1398>>07024480
            PRINT(DBUFFER,-22,0);                              <<*1398>>07024482
            PRINT'FILE'INFO(TAPEF);                            <<*1398>>07024484
            ERROR;                                             <<*1398>>07024486
         END;                                                  <<*1398>>07024488
                                                               <<*1398>>07024490
TAPET:                                                         <<*1398>>07024492
         FGETINFO(TAPEF,,,,,DEVTYPE,LDEV);                    <<<*1398>>07024494
         IF DEVTYPE.(8:8)=3 THEN GO BOTFOUND;                  <<*1398>>07024496
         IF DEVTYPE.(8:8)=0 THEN                               <<*1398>>07024498
            GOTO BOTFOUND;                                     <<*1398>>07024500
         IF DEVTYPE.(8:8) = SERDISC THEN                       <<*1398>>07024502
            BEGIN                                              <<*1398>>07024504
            FCONTROL(TAPEF,7,JNK);                             <<*1398>>07024506
            GO BOTFOUND;                                       <<*1398>>07024508
            END;                                               <<*1398>>07024510
         IF DEVTYPE.(8:8) <> MAGTAPE THEN                      <<*1398>>07024512
            BEGIN  <<INVALID DPAN DEVICE>>                     <<*1398>>07024514
            MOVE DBUFFER:="INVALID INPUT DEVICE";              <<*1398>>07024516
            PRINT(DBUFFER,-20,0);                              <<*1398>>07024518
            PRINT'FILE'INFO(TAPEF);                            <<*1398>>07024520
            ERROR;                                             <<*1398>>07024522
            END;                                               <<*1398>>07024524
BOTFOUND:                                                      <<*1398>>07024526
                                                               <<*1398>>07024528
<< PRINT PROGRESS MESSAGE TO TERMINAL >>                       <<*1398>>07024530
   IF DUPLICATIVE THEN                                         <<*1398>>07024532
     BEGIN                                                     <<*1398>>07024534
     PRINT(DBUFFER,0,0);                                       <<*1398>>07024536
     MOVE BBUF := "READING REAL MEMORY";                       <<*1398>>07024538
     PRINT(DBUFFER,-19,0);                                     <<*1398>>07024540
     END;                                                      <<*1398>>07024542
                                                               <<*1398>>07024544
<< READ THE FIRST RECORD OF THE DUMP FROM TAPE >>              <<*1398>>07024546
   TLOG := FREAD( TAPEF, COREBUF, 4096 );                      <<*1398>>07024548
   IF <> THEN       << FREAD ERROR ON FIRST RECORD >>          <<*1398>>07024550
     INVALIDTAPE;                                              <<*1398>>07024552
                                                               <<*1398>>07024554
<< GET MACHINE ID AND APPROPRIATE MACHINE CONTEXT. >>          <<*1398>>07024556
   MACHINEID := CNMACHINEID;                                   <<*1398>>07024558
   IF      MACHINEID = MODEL35                                 <<*1398>>07024560
      THEN GET35CONTEXT                                        <<*1398>>07024562
   ELSE IF SERIES'33'THRU'MM                                   <<*1398>>07024564
      THEN GET25CONTEXT                                        <<*1398>>07024566
   ELSE    GET'SERIESII'CONTEXT;                               <<*1398>>07024568
                                                               <<*1398>>07024570
<< GET TAPE VERSION >>                                         <<*1398>>07024572
   TAPE'VERSION := CNTAPEVERS;                                 <<*1398>>07024574
                                                               <<*1398>>07024576
<< PRINT SDF TAPE VERSION >>                                   <<*1398>>07024578
   BLANKBUF;                                                   <<*1398>>07024580
   MOVE BBUF := "SDF TAPE VERSION = ";                         <<*1398>>07024582
   LEN := ASCII(TAPE'VERSION,10,BBUF(19));                     <<*1398>>07024584
   PRINTLINE;                                                  <<*1398>>07024586
                                                               <<*1398>>07024588
     <<THE FOLLOWING FWRITE OF ZERO LENGTH IS USED   >>        <<*1398>>07024590
     <<ON A VERSION ZERO TAPE TO                     >>        <<*1398>>07024592
     <<FORCE THE FILE SYSTEM TO VERIFY THAT A WRITE  >>        <<*1398>>07024594
     <<RING IS PRESENT ON THE TAPE (SINCE WE WILL BE >>        <<*1398>>07024596
     <<WRITING ON THE TAPE TO APPEND FILES).  IT     >>        <<*1398>>07024598
     <<SHOULD LEAVE THE TAPE AT THE LOAD POINT.  IT  >>        <<*1398>>07024600
     <<IS IMPORTANT THAT THE FILE BE OPENED WITH     >>        <<*1398>>07024602
     <<UNDEFINED LENGTH RECORDS SPECIFIED, OTHERWISE >>        <<*1398>>07024604
     <<THIS FWRITE WILL OVERWRITE PART OF THE TAPE   >>        <<*1398>>07024606
   IF TAPE'VERSION = 0 AND (DEVTYPE.(8:8) = MAGTAPE            <<*1398>>07024608
       OR DEVTYPE.(8:8) = SERDISC)  THEN                       <<*1398>>07024610
     BEGIN                                                     <<*1398>>07024612
     FWRITE(TAPEF,COREBUF,0,0);                                <<*1398>>07024614
     IF <> THEN                                                <<*1398>>07024616
       BEGIN                                                   <<*1398>>07024618
       MOVE DBUFFER:="CC <> ON FWRITE TO TAPE";                <<*1398>>07024620
       PRINT(DBUFFER,-23,0);                                   <<*1398>>07024622
       PRINT'FILE'INFO(TAPEF);                                 <<*1398>>07024624
       ERROR;                                                 <<<*1398>>07024626
       END;                                                    <<*1398>>07024628
     << START OVER IN CASE OF NO WRITE RING >>                 <<*1398>>07024630
     IF DEVTYPE.(8:8) = SERDISC THEN  FCONTROL(TAPEF,5,JNK);   <<*1398>>07024632
     FCONTROL(TAPEF,5,JNK);                                    <<*1398>>07024634
     IF DEVTYPE.(8:8) = SERDISC THEN  FCONTROL(TAPEF,7,JNK);   <<*1398>>07024636
     TLOG := FREAD(TAPEF,COREBUF,4096);                        <<*1398>>07024638
     END;                                                      <<*1398>>07024640
                                                               <<*1398>>07024642
<< DELINEATE DST FOR CORE PROCEDURE >>                         <<*1398>>07024644
   DST'MIN := COREBUF(2);                                      <<*1398>>07024646
   DST'MAX := DST'MIN + COREBUF(DST'MIN)*4 + 3;                <<*1398>>07024648
                                                               <<*1398>>07024650
<< CALC NUMBER OF 4K RECORDS - 1 IN REAL MEMORY DUMP >>        <<*1398>>07024652
   NUMREC := INTEGER( MAXMEM&DLSR(12) );                       <<*1398>>07024654
                                                               <<*1398>>07024656
<< OPEN TEMP DISK FILE FOR REAL MEMORY DUMP >>                 <<*1398>>07024658
   MOVE BBUF:="COREFILE ";       <<TEMP DISK FILE>>            <<*1398>>07024660
   COREF:=FOPEN(BBUF,0,%504,4096,,,,,,                         <<*1398>>07024662
                DOUBLE(NUMREC+1),32,1);                        <<*1398>>07024664
   IF <> THEN                                                  <<*1398>>07024666
     BEGIN                                                     <<*1398>>07024668
     MOVE DBUFFER:="CC <> ON FOPEN TO DISK";                   <<*1398>>07024670
     PRINT(DBUFFER,-22,0);                                     <<*1398>>07024672
     PRINT'FILE'INFO(COREF);                                   <<*1398>>07024674
     ERROR;                                                    <<*1398>>07024676
     END;                                                      <<*1398>>07024678
                                                               <<*1398>>07024680
<< COPY THE FIRST RECORD TO THE TEMP CORE DISK FILE. >>        <<*1398>>07024682
   FWRITEDIR( COREF, COREBUF, 4096, 0D );                      <<*1398>>07024684
   IF <> THEN                                                  <<*1398>>07024686
   BEGIN                                                       <<*1398>>07024688
      MOVE DBUFFER := "* CC <> ON FWRITE TO DISK.";            <<*1398>>07024690
      PRINT( DBUFFER, -26, 0 );                                <<*1398>>07024692
      PRINT'FILE'INFO( COREF );                                <<*1398>>07024694
      ERROR;                                                   <<*1398>>07024696
   END;                                                        <<*1398>>07024698
                                                               <<*1398>>07024700
<< COPY THE REMAINDER OF THE DUMP TO THE TEMP CORE DISK FILE>> <<*1398>>07024702
   WHILE  NUMREC > 0  AND  NOT INCOMPLETE'TAPE   DO            <<*1398>>07024704
     BEGIN                                                     <<*1398>>07024706
                                                               <<*1398>>07024708
  << READ AND CHECK THE NEXT RECORD. >>                        <<*1398>>07024710
     TLOG := FREAD'MULTIVOL( TAPEF, COREBUF, 4096 );           <<*1398>>07024712
     IF <> THEN INCOMPLETE;    << FREAD ERROR. >>              <<*1398>>07024714
     IF INCOMPLETE'TAPE THEN                                   <<*1398>>07024716
       BEGIN                                                   <<*1398>>07024718
       FCLOSE(TAPEF,0,0);                                      <<*1398>>07024720
       RETURN;                                                 <<*1398>>07024722
       END;  << FREAD SHORT. >>                                <<*1398>>07024724
                                                               <<*1398>>07024726
  << WRITE THE RECORD TO THE CORE DISK FILE. >>                <<*1398>>07024728
     FWRITE( COREF, COREBUF, 4096, 0 );                        <<*1398>>07024730
     IF <> THEN                                                <<*1398>>07024732
       BEGIN                                                   <<*1398>>07024734
       MOVE DBUFFER := "**CC <> ON FWRITE TO DISK";            <<*1398>>07024736
       PRINT( DBUFFER, -25, 0 );                               <<*1398>>07024738
       PRINT'FILE'INFO( COREF );                               <<*1398>>07024740
       ERROR;                                                  <<*1398>>07024742
       END;                                                    <<*1398>>07024744
                                                               <<*1398>>07024746
     NUMREC := NUMREC - 1;                                     <<*1398>>07024748
     IF NUMREC = 0 THEN                                        <<*1398>>07024750
       LAST'CHECK := COMPUTE'CHECKSUM(COREBUF);                <<*1398>>07024752
                                                               <<*1398>>07024754
     END;  << COPYING LOOP >>                                  <<*1398>>07024756
                                                               <<*1398>>07024758
<< PRINT PROGRESS AND ADDRESS RANGE MESSAGES >>                <<*1398>>07024760
                                                               <<*1398>>07024762
   IF DUPLICATIVE THEN                                         <<*1398>>07024764
     BEGIN                                                     <<*1398>>07024766
     MOVE BBUF := "READING OF REAL MEMORY COMPLETE";           <<*1398>>07024768
     PRINT(DBUFFER,-31,0);                                     <<*1398>>07024770
     END;                                                      <<*1398>>07024772
   BLANKBUF;                                                   <<*1398>>07024774
   MOVE BBUF :=                                                <<*1398>>07024776
"REAL MEMORY ADDRESS RANGE = 000000 000000 TO        177777";  <<*1398>>07024778
   @PBUF := @BBUF + 45;                                        <<*1398>>07024780
   PUTNUM(MEMSIZE-1);                                          <<*1398>>07024782
   PRINTLINE;                                                  <<*1398>>07024784
                                                               <<*1398>>07024786
   IF TAPE'VERSION = 0 THEN  VERS0'TAPETODISK                  <<*1398>>07024788
   ELSE IF TAPE'VERSION = 1 THEN  VERS1'TAPETODISK             <<*1398>>07024790
   ELSE                                                        <<*1398>>07024792
     BEGIN                                                     <<*1398>>07024794
     MOVE DBUFFER := "INVALID TAPE VERSION NUMBER";            <<*1398>>07024796
     PRINT(DBUFFER,-27,0);                                     <<*1398>>07024798
     ERROR;                                                    <<*1398>>07024800
     END;                                                      <<*1398>>07024802
                                                               <<*1398>>07024804
   FCLOSE(TAPEF,0,0);                                          <<*1398>>07024806
   CHKLDMAP;                                                   <<*1398>>07024808
                                                               <<*1398>>07024810
   TBUF:="  ";     <<ITS A WORD NOT A BYTE>>                   <<*1398>>07024812
   MOVE TBUF(1):=TBUF,(74);     <<BLANK BUFFER>>               <<*1398>>07024814
   MOVE TBUF:="HP3000     MEMORY DUMP";                        <<*1398>>07024816
   MOVE LVL(VUFF'COL):=OFFICIAL'VUUFF;                         <<*1398>>07024818
   MOVE TBUF(11):=LVL, (4);                                    <<*1398>>07024820
   MOVE TBUF(15):="OF SYS VER";                                <<*1398>>07024822
   MOVE TBUF(22):="UPDATE      FIX     DUMP TIME ";            <<*1398>>07024824
   TBUF(20):=FIXIT(CORE(VERNO));                               <<*1398>>07024826
   TBUF(26):=FIXIT(CORE(UPNO));                                <<*1398>>07024828
   TBUF(30):=FIXIT(CORE(FNO));                                 <<*1398>>07024830
   RECOVER'DATE(TBUF);                                         <<*1398>>07024832
   PAGENO:=0;                                                  <<*1398>>07024834
   BANKNO:=0;                                                  <<*1398>>07024836
   INDXARAY:=0;                                                <<*1398>>07024838
   MOVE INDXARAY (1) := INDXARAY, ((LSTSYSDST+2) * 2);         <<*1398>>07024840
   MPEMIT2:=FOPEN(MPEMIT2N,5,0);     <<OPEN MPEMIT2>>          <<*1398>>07024842
   IF = THEN                                                   <<*1398>>07024844
     BEGIN          <<SEE IF CUSTOM, IF NOT FCLOSE>>           <<*1398>>07024846
     FGETINFO(MPEMIT2,,,,,,,,MPEFCODE);                        <<*1398>>07024848
     IF MPEFCODE<>1020 THEN                                    <<*1398>>07024850
       BEGIN        <<NOT TO BE LISTED>>                       <<*1398>>07024852
       FCLOSE(MPEMIT2,0,0);   <<CLOSE IT>>                     <<*1398>>07024854
       MPEMIT2:=0;                                             <<*1398>>07024856
       END          <<NOT TO BE LISTED>>                       <<*1398>>07024858
     ELSE                                                      <<*1398>>07024860
       BEGIN        <<READ HEADER LINES>>                      <<*1398>>07024862
       FREAD(MPEMIT2,COPYRITE(16),-56);                        <<*1398>>07024864
       FREAD(MPEMIT2,COPYRITE(45),-40);                        <<*1398>>07024866
       END;         <<READ HEADER LINES>>                      <<*1398>>07024868
     END;           <<SEE IF CUSTOM, IF NOT FCLOSE>>           <<*1398>>07024870
                                                               <<*1398>>07024872
END;  << TAPETODISK >>                                         <<*1398>>07024874
$PAGE                                                          <<*1398>>07027900
          MOVE LMAPNAME:="LOADMAP.PUB.SYS  ";                  <<*1398>>07412000
          MOVE CHCKNAME:="MPECHECK.PUB.SYS ";                  <<*1398>>07414000
$PAGE"        LPF'WRITE: Fwrite replacement - to LP file"      <<*1398>>07936000
$CONTROL SEGMENT=UTIL                                          <<*1398>>07936050
PROCEDURE LPF'WRITE(FNUM,BUFFER,COUNT,CCTL);                   <<*1398>>07936100
VALUE FNUM,COUNT,CCTL;                                         <<*1398>>07936150
INTEGER FNUM,COUNT;                                            <<*1398>>07936200
LOGICAL CCTL;                                                  <<*1398>>07936250
LOGICAL ARRAY BUFFER;                                          <<*1398>>07936300
                                                               <<*1398>>07936350
COMMENT                                                        <<*1398>>07936400
                                                               <<*1398>>07936450
Purpose:                                                       <<*1398>>07936500
          LPF'WRITE                                            <<*1398>>07936550
     THIS PROCEDURE REPLACES FWRITE'S TO THE LPF FILE.         <<*1398>>07936600
     THIS WAS DONE SO THAT IF THE MAXIMUM SPOOL FILE           <<*1398>>07936650
     SIZE IS REACHED, THAT FILE IS CLOSED AND A NEW            <<*1398>>07936700
     ONE OPENED.                                               <<*1398>>07936750
;                                                              <<*1398>>07936800
BEGIN                                                          <<*1398>>07936850
  IF NOT PRTNPRT THEN                                          <<*1955>>07936860
  BEGIN                                                        <<*1955>>07936870
  FWRITE(FNUM,BUFFER,COUNT,CCTL);                              <<*1398>>07936900
  IF < THEN                                                    <<*1398>>07936950
    BEGIN                                                      <<*1398>>07937000
    MOVE BBUF:="DPANLIST WRITE ERROR";                         <<*1398>>07937050
    PRINT(DBUFFER,-20,0);                                      <<*1398>>07937100
    PRINT'FILE'INFO(LPF);                                      <<*1398>>07937150
    ERROR;                                                              07937170
    END;                                                       <<*1398>>07937200
  IF > THEN                                                    <<*1398>>07937250
    BEGIN                                                      <<*1398>>07937310
    IF SPOOL'FILE'COUNT >= 10 THEN ERROR                       <<*1398>>07937320
    ELSE                                                       <<*1398>>07937330
      BEGIN                                                    <<*1398>>07937340
      FCLOSE(LPF,0,0);                                         <<*1398>>07937350
      LPF:=FOPEN(LPN,OPT,1,,LPND,,,,16,4096D,32);              <<*1398>>07937400
      MOVE BBUF:="EOF ON DPANLIST - CLOSED AND REOPENED";      <<*1398>>07937450
      PRINT(DBUFFER,-37,0);                                    <<*1398>>07937500
      SPOOL'FILE'COUNT := SPOOL'FILE'COUNT + 1;                <<*1398>>07937510
      END;                                                     <<*1398>>07937550
    END;                                                       <<*1398>>07937560
  END;                                                         <<*1955>>07937570
END;                                                           <<*1398>>07937600
         LPF'WRITE(LPF,DBUFFER,66,0);                          <<*1398>>08000000
                                                               <<*1398>>08002000
                                                               <<*1398>>08004000
                                                               <<*1398>>08006000
                                                               <<*1398>>08008000
                                                               <<*1398>>08010000
         LPF'WRITE(LPF,DBUFFER,0,(NLINES+%200));               <<*1398>>08104000
                                                               <<*1398>>08106000
                                                               <<*1398>>08108000
                                                               <<*1398>>08110000
                                                               <<*1398>>08112000
                                                               <<*1398>>08114000
         LPF'WRITE(LPF,DBUFFER,0,%61);                         <<*1398>>08192000
           IF VM'INUSE AND                                     <<*1398>>08200000
               BANKNO > LOGICAL(MAX'REAL'MEM&DLSR(16)) THEN    <<*1398>>08200500
             MOVE BBUF(99) := "VIRTUAL STORAGE"                <<*1398>>08201000
           ELSE                                                <<*1398>>08202000
             BEGIN                                             <<*1398>>08203000
             IF ASCII(BANKNO,8,BBUF(108)) = 1 THEN             <<*1398>>08204000
               MOVE BBUF(104) := "    BANK "                   <<*1398>>08205000
             ELSE                                              <<*1398>>08206000
               MOVE BBUF(104) := " BANK %";                    <<*1398>>08207000
             END;                                              <<*1398>>08207500
   UNTIL INDX >= INTEGER(CORE(LOCPCB)) OR INDX >= 1026;        <<*9332>>08514000
   IF INDX >= 1026 THEN                                        <<*9332>>08516000
    IF NOT DUPLICATIVE  THEN BEGIN                             <<*1398>>08739000
    END;                                                       <<*1398>>08751000
    IF NOT DUPLICATIVE  THEN BEGIN                             <<*1398>>08935000
    END;                                                       <<*1398>>08947000
$control segment=util                                          <<*1398>>09044000
IF NOT DUPLICATIVE  THEN  BEGIN                                <<*1398>>09397000
END;                                                           <<*1398>>09409000
$include INCLDNPT                                                       10569000
