*COMDECK PGHALT 
_$J+  PAGE EJECT? 
_$R-,G-,I+? 
_ 
************************************************************************
*                                                                      *
*              * *   P G H A L T   * *                                 *
*                                                                      *
*                    SYSTEM HALT                                       *
*                                                                      *
*                                                                      ?
_***********************************************************************
*                                                                      *
** OVERVIEW - PGHALT HALTS THE SYSTEM AFTER A SERIOUS ERROR HAS        *
*             OCCURED.  THE HALT CODE AND THE HALT RETURN ADDRESS ARE  *
*             STORED STARTING AT $30.  IF TUP IS PRESENT, THE          *
*             REGISTERS ARE ALSO STORED IN THE TUP TABLE AND CAN BE    *
*             DISPLAYED USING THE TUP DR COMMAND.  THE A AND Q         *
*             REGISTERS HAVE BEEN OVERWRITTEN IN PBHALT.  (AN EXACT    *
*             COPY OF THE REGISTERS IS SAVED BY PBHALT WHEN IT IS      *
*             CALLED.) THE MLIA AND COUPLER ARE CLEARED.  IF CONSOLE   *
*             SUPPORT CODE IS PRESENT, THE HALT RETURN ADDRESS AND     *
*             HALT CODE ARE PRINTED AND THE CONSOLE INTERRUPT IS       *
*             ENABLED.  TUP IS THEN ENTERED IF IT IS PRESENT.          *
*                                                                      *
** INPUT    - HALT CODE                                                *
*                                                                      *
** OUTPUTS  - HALT MESSAGE                                             *
*             MLIA AND COUPLER ARE CLEARED                             *
*             DUMP ANALYSIS INFORMATION SAVED                          *
*                                                                      *
** EXTERNAL SUBROUTINES USED                                           *
*             PB18BITS  - CONVERT TO 18 BIT ADDRESS                    *
*             PBLSGET   - GET A WORKLIST ENTRY                         *
*             PBDF      - READ A FILE REGISTER                         *
*             PBWRITE   - WRITE TO CONSOLE - SET WRITE MODE            *
*             P1TOAH    - CONVERT TO ASCII - 1 WORD                    *
*             PBTOAH    - CONVERT TO ASCII - BUFFER                    *
*             PBQUICKIO - OUTPUT TO CONSOLE                            *
*             PBSMASK   - SET UP CONSOLE MASK                          *
*                                                                      *
************************************************************************
? 
_$J+? 
PROCEDURE PGHALT(HALT : INTEGER); 
  
CONST 
      STORE0   = $602B;                     _ SAVE (LOC 0) IN LOC 2B   ?
      STORE1   = $602C;                     _ SAVE (LOC 1) IN LOC 2C   ?
      STORE2   = $602D;                     _ SAVE (LOC 2) IN LOC 2D   ?
      STORE3   = $602E;                     _ SAVE (LOC 3) IN LOC 2E   ?
      GET1BF   = $3C;                       _ SAVE FOR PBGET1BF        ?
      REL1BF   = $3D;                       _ SAVE FOR RELEASE ONE BUFF?
      RELCHN   = $3E;                       _ SAVE FOR MULTIPLE RELEASE?
      RELZRO   = $3F;                       _ PBRELZRO SAVE ADDRESS    ?
      HALTBUF  = $0113;                     _ BUFFER ADDRESS, FILE 13  ?
      HALTRTN  = $0110;                     _ RETURN ADDRESS, FILE 10  ?
  
TYPE
      SAVEAREA = ARRAY [0..$3F] OF INTEGER; _ HALT INFO SAVE AREA      ?
  
VAR 
      HALTADDR : B018BITS;                  _ HALT ADDR POINTER        ?
      HALTCODE : B0HEXPTR;                  _ HALT CODE POINTER        ?
      R1TEMP   : B0OVERLAY;                 _ SAVE FOR HALT ADDRESS    ?
      R2TEMP   : B0OVERLAY;                 _ SAVE FOR HALT CODE       ?
      HLTBUF   : B0OVERLAY;                 _ BAD BUFFER ON BUFFER HALT?
      PORTCNT  : INTEGER;                   _ COUNTER FOR CONSEC PORTS ?
      PORTNO   : B0OVERLAY;                 _ PORT BEING CHECKED       ?
      POWERADD : B0BUFPTR;                  _ POINTER TO POWER INTERRPT?
      HALTTBL  : SAVEAREA;                  _ HALT INFO SAVE AREA FOR  ?
                                            _ CONTENTS OF LOC $0 - $3F ?
      TBLPTR   : 'SAVEAREA;                 _ POINTER TO SAVE AREA IN  ?
                                            _ LOW CORE                 ?
_  *****  CAUTION - HIDDEN *IF DEF,CONSOLE  *****                      ?
*IF DEF,CONSOLE 
      I        : INTEGER;                   _ INDEX                    ?
      PORTMSG  : ARRAY [1..8 ] OF INTEGER;  _ CLA STATUS FLOODING      ?
      HALTMSG  : PACKED ARRAY [-7..18] OF 
                 CHAR;                      _ HALT MESSAGE ARRAY       ?
      BUFMSG   : ARRAY [1..11] OF INTEGER;
*ENDIF
_  *****  CAUTION - HIDDEN *ENDIF FOR CONSOLE CODE  *****              ?
  
VALUE 
      HALTADDR = (0,$31);                   _ HALT RETURN ADDRESS SAVE ?
      HALTCODE = $30;                       _ HALT CODE SAVE           ?
      POWERADD = $0100;                     _ POWER FAIL INTERRUPT LOC ?
_  *****  CAUTION - HIDDEN *IF DEF,CONSOLE  *****                      ?
*IF DEF,CONSOLE 
      PORTMSG  = ($1104,0,J1CRLF,#*PORT     #); 
      HALTMSG  = ($1904,0,J1CRLF,J1CRCR,    _ HEADER                   ?
                  #*HALT CODE ADDRR#);      _ HALT MESSAGE             ?
      BUFMSG   = ($1304,0,J1CRLF,J1CRCR,
                  #BUFFER ADDR #);
*ENDIF
_  *****  CAUTION - HIDDEN *ENDIF FOR CONSOLE CODE  *****              ?
  
BEGIN 
_  *****  CAUTION - HIDDEN *IF DEF,TUP  *****                          ?
*IF DEF,TUP 
IF TOTUP                                    _ IF TUP PRESENT           ?
THEN
  STREGS (JUTUPTABLE.JUREGSAVE);            _ SAVE CURRENT REGISTERS   ?
*ENDIF
_  *****  CAUTION - HIDDEN *ENDIF FOR TUP CODE  *****                  ?
INST   ($E000,$0519,$0B04);                 _ SIO - CLEAR MLIA         ?
INST   ($E000,$060C,$0B04);                 _ SIO - CLEAR COUPLER ONE  ?
INST   ($E000,$068C,$0B04);                 _ SIO - CLEAR COUPLER TWO  ?
INST   ($E000,$00F0,$0B00,$02FE);           _ IDLE CLOCK INTERRUPT     ?
_ 
*              ---- SAVE LOCATION 0, 1, 2, 3 IMAGES ----
? 
INST ($C400,$0000,STORE0,                   _ SAVE LOC 0 IMAGE         ?
      $C001,STORE1,                         _ SAVE LOC 1 IMAGE         ?
      $C002,STORE2,                         _ SAVE LOC 2 IMAGE         ?
      $C003,STORE3);                        _ SAVE LOC 3 IMAGE         ?
_ 
*              ---- SAVE BUFFER INFORMATION ----
? 
INST ($C400,PBGET1BF,                       _ LDA   LAST GET           ?
      $6400,GET1BF,                         _ STA   SAVE               ?
      $C400,PBREL1BF,                       _ LDA   LAST RELEASE 1 BUF ?
      $6400,REL1BF,                         _ STA   SAVE               ?
      $C400,PBRELCHN,                       _ LDA   LAST MULTIPLE REL  ?
      $6400,RELCHN,                         _ STA   SAVE               ?
      $C400,PBRELZRO,                       _ LDA   LAST MULTIPLE ZER0 ?
      $6400,RELZRO);                        _ STA   SAVE               ?
_ 
*              ---- GET CALLERS RETURN ADDRESS ---- 
? 
R1TEMP.BAINT := B0ORGHALT;                  _ SAVE CALLERS             ?
                                            _ RETURN ADDRESS           ?
_ 
*              ---- GET HALT CODE ----
? 
R2TEMP.BAINT := HALT;                       _ SAVE HALT CODE           ?
_ 
*              ---- PROCESS SPECIAL HALT CODES ---- 
? 
CASE R2TEMP.BAINT OF                        _ CASE HALT CODE           ?
  
_ 
*              ---- OUT OF BUFFERS ---- 
? 
  J0NOBUFRS : 
  
  IF BYWLCB[MMEWLQ].BYCNT < QENTLIM         _ HAS LIMIT BEEN REACHED   ?
  THEN
    BEGIN                                   _ NO - SET UP RTN ADDRESS  ?
    INST ($C400,PBGET1BF,                   _ LDA   GET CALLERS ADDR   ?
          $6400,R1TEMP);                    _ STA   SAVE RETURN        ?
    END 
  ELSE
_ 
*              ---- CHECK FOR CLA STATUS OVERFLOW ----
? 
    BEGIN 
    WHILE NOT PBLSGET (BWWLENTRY[LEVELN0],
                       BYWLCB[MMEWLQ])      _ EVENT WORKLIST ENTRIES   ?
                    & (PORTCNT < QENTLIM)   _ OVERFLOW NOT FOUND       ?
      DO
      WITH BWWLENTRY[LEVELNO].B0EWLQ DO     _ WORKLIST ENTRY           ?
        IF PORTNO.BARBYT = MMPORT           _ CHECK FOR SAME PORT      ?
        THEN
          PORTCNT := PORTCNT + 1            _ INCREMENT COUNT          ?
        ELSE
          BEGIN                             _ NOT THE SAME             ?
          PORTNO.BARBYT := MMPORT;          _ SET UP NEW PORT          ?
          PORTCNT       := 1;               _ INITIALIZE COUNT         ?
          END;  _ WHILE ? 
    IF PORTCNT \ QENTLIM                    _ CHECK FOR OVERFLOW       ?
    THEN
      R2TEMP.BAINT := J0QFLOOD              _ CHANGE HALT CODE         ?
    ELSE
      PORTNO.BAINT := 0;                    _ CLEAR PORT NUMBER        ?
  END;  _ J0NOBUFRS ? 
_ 
*              ---- BUFFER HALTS, NOT OUT OF BUFFERS ---- 
? 
  J0BFDREL,                                 _ DUPLICATE RELEASE        ?
  J0BFCERR  :                               _ CHAIN ERROR              ?
  
  BEGIN 
  PBDF (HALTBUF,HLTBUF.BAINT);              _ GET BUFFER IN ERROR      ?
  PBDF (HALTRTN,R1TEMP.BAINT);              _ GET USER RETURN ADDRESS  ?
  INST ($C400,HLTBUF,                       _ GET BUFFER ADDRESS       ?
        $6400,$32);                         _ STORE IN LOCATION 32     ?
  END;  _ BUFFER HALTS ?
_ 
*              ---- POWER FAILURE INTERRUPT ----
? 
  J0POWERFAIL : 
  
    IF POWERADDR'.BIINT[1] = 0              _ CHECK FOR SPURIOUS HALT  ?
    THEN
      R2TEMP.BAINT := J0INVPWRFL;           _ YES - CHANGE TO INVALID  ?
_ 
*              ---- MEMORY PARITY ERROR ----
? 
  J0MEMPARITY:  
  
    BEGIN 
    R1TEMP.BAINT := $100;                   _ SAVE LOC OF MEM PAR ADDR ?
    R1TEMP.BAINT := R1TEMP.BAINTPTR';       _ SAVE MEM PARITY ADDRESS  ?
    END;
_ 
*              ---- MONITOR TIMED OUT ----
? 
  J0OPSTO:                                  _ MONITOR TIMEOUT          ?
  
  INST($C400,$120,                          _ LDA   GET LOST ADDRESS   ?
       $6400,R1TEMP);                       _ STA   SAVE THE ADDRESS   ?
  
END;  _ CASE R2TEMP ? 
_ 
*              ---- SET UP HALT ADDRESS AND CODE ---- 
? 
HALTADDR.B0WORD.BAINTPTR' := R1TEMP.BAINT;  _ SET UP HALT RETURN ADDR  ?
HALTCODE'                 := R2TEMP.BAHEX;  _ SET UP HALT CODE         ?
WITH NHNDCB DO                              _ WITH NDCB                ?
  BEGIN 
  NDHLTCOD := R2TEMP.BAINT;                 _ STORE HALT CODE IN NDCB  ?
  NDHLTADD := R1TEMP.BAINT;                 _ STORE HALT ADDR IN NDCB  ?
  END;
_ 
*              ---- SET UP LOCAL HALT INFO SAVE AREA ---- 
? 
HALTTBL := TBLPTR';                         _ SAVE (LOC $0) - (LOC $3F)?
                                            _ IN THE LOCAL SAVE AREA   ?
_ 
*              ---- SET UP FOR CONSOLE MESSAGES ----
? 
_  *****  CAUTION - HIDDEN *IF DEF,CONSOLE  *****                      ?
*IF DEF,CONSOLE 
HALTADDR.B0WORD.BAINT := R1TEMP.BAINT;      _ HALT RETURN ADDRESS      ?
I := HALTADDR.B0WORD.BAPAGE;                _ EXTRACT PAGE NUMBER      ?
IF (I \ DYNAMICPAGE) & (I < DYNAMICPAGE+4)  _ IF CALL FROM PAGED PROG  ?
THEN                                        _ GET PAGE NR FROM SAVE LOC?
  BEGIN 
  INST ($C400,$002F,                        _ LDA   SAVED PAGE ADDRESS ?
        $6400,HALTADR);                     _ STA   HALT PAGE DISPLAY  ?
  HALTADDR.B0UPPER7.BAINT :=                _ ADJUST FOR OFFSET        ?
    HALTADDR.B0UPPER7.BAINT + 
      I - DYNAMICPAGE;
  END 
ELSE                                        _ GET PAGE FROM 16 BIT ADDR?
  HALTADDR.B0UPPER7.BAINT := I; 
ADDR (HALTMSG,R1TEMP.BABUFPTR);             _ SET UP HALT MSG          ?
IF TOCONSOLE                                _ IF CONSOLE DRIVER PRESENT?
THEN
  P1TOAH (HALTADDR,R1TEMP.BABUFPTR,         _ MOVE ADDRESS TO HALT MSG ?
          19,J1LST64);
PBTOAH (HALTCODE',R1TEMP.BABUFPTR,          _ MOVE HALT CODE TO BUFFER ?
        14,J1LST64);
_ 
*              ---- OUTPUT HALT MESSAGE ----
? 
INST($E400,                                 _ LOAD Q REGISTER          ?
     B1DMTA,                                _ WITH ADDRESS OF DEAD     ?
                                            _ TIMER RESET CODE AND     ?
     $0BA2);                                _ EXECUTE THE MICROSEQUENCE?
JACT[TTY].JAINPROGFLG := FALSE;             _ RESET INPUT BUSY         ?
IF TOCONSOLE                                _ IF CONSOLE DRIVER PRESENT?
THEN
  BEGIN 
  REPEAT UNTIL PBTESTIORDY(NODEVICE);       _ ENSURE TTY READY         ?
  PBWRITE (TTYSTAT,TTYRITE,TTY);            _ CLEAR THE TTY            ?
  PBQUICKIO (TTY,R1TEMP.BABUFPTR);          _ OUTPUT HALT MESSAGE      ?
  END;
_ 
*              ---- CHECK FOR CLA OR BUFFER RELATED HALTS ----
? 
IF PORTNO.BAINT " 0                         _ CHECK FOR CLA RELATED    ?
THEN
  BEGIN 
  ADDR      (PORTMSG,R1TEMP.BAINT);         _ PORT MESSAGE ADDRESS     ?
  PBTOAH    (PORTNO.BAHEX,R1TEMP.BABUFPTR,  _ PUT CLA ADDR IN MSG      ?
             13,J1LST32); 
  IF TOCONSOLE                              _ IF CONSOLE DRIVER PRESENT?
  THEN
    PBQUICKIO (TTY,R1TEMP.BABUFPTR);        _ OUTPUT THE MESSAGE       ?
  END;
_ 
*              ---- CHECK FOR BUFFER HALT ----
? 
IF HLTBUF.BAINT " 0                         _ CHECK FOR BUFFER PRESENT ?
THEN
  BEGIN 
  INST($E400,                               _ LOAD Q REGISTER          ?
       B1DMTA,                              _ WITH ADDRESS OF DEAD     ?
                                            _ TIMER RESET CODE AND     ?
       $0BA2);                              _ EXECUTE THE MICROSEQUENCE?
  ADDR      (BUFMSG,R1TEMP.BABUFPTR);       _ MESSAGE ADDRESS          ?
  PBTOAH    (HLTBUF.BAHEX,R1TEMP.BABUFPTR,  _ BUFFER ADDRESS TO ASCII  ?
             15,J1LST32); 
  IF TOCONSOLE                              _ IF CONSOLE DRIVER PRESENT?
  THEN
    PBQUICKIO (TTY,R1TEMP.BABUFPTR);        _ OUTPUT THE MESSAGE       ?
  END;
PBSMASK ([J8TTY,J8LP,J8LP30]);              _ ALLOW CONSOLE INTERRUPTS ?
*ENDIF
_  *****  CAUTION - HIDDEN *ENDIF FOR CONSOLE CODE  *****              ?
_ 
*              ---- LOOP UNTIL MASTER CLEAR ----
? 
_  *****  CAUTION - HIDDEN *IF DEF,TUP  *****                          ?
*IF DEF,TUP 
REPEAT
IF TOTUP                                    _ IF TUP IN SYSTEM         ?
THEN
  BEGIN 
  EINT;                                     _ ENABLE INTERRUPTS        ?
  PBTUP;                                    _ CALL CONSOLE ROUTINE     ?
  END;
UNTIL FALSE;                                _ LOOP INDEFINITELY        ?
*ENDIF
_  *****  CAUTION - HIDDEN *ENDIF FOR TUP CODE  *****                  ?
  
INST   (LOOPFOREVER);                       _ INDEFINITE LOOP UNTIL M/C?
END;  _ PGHALT ?
