*COMDECK PIPROTECT
_$J+? 
_*****************************************
*                                        *
*             PIPROTECT                  *
*  SET UP PROGRAM PROTECT SYSTEM         *
*                                        *
*****************************************?
_$R-,G-,I-     OPS LEVEL                 ?
_***********************************************************************
**OVERVIEW                                                             *
*    THIS PROCEDURE SETS UP ALL OF THE CORE EXCEPT FOR THE BUFFER AREA *
*    WITH THE PROGRAM PROTECT BIT SET. THIS ENABLES THE USE OF THE     *
*    PROTECT SYSTEM BY TUP TO CAUSE INTERRUPTS FOR BREAKPOINTS AND ALSO*
*    ALLOWS DMA DEVICES SUCH AS THE COUPLER TO WRITE INTO THE BUFFER   *
*    AREA AND NOWHERE ELSE.                                            *
*                                                                      *
**NO INPUTS OR OUTPUTS                                                 *
*                                                                      *
** EXTERNAL SUBROUTINES USED                                           *
*     PBSETPROT  SET CORE LOCATION AS PROTECTED                        *
*     PBPUTPAGE  WRITE PAGE REGISTER                                   *
*     ADDR       PUT MODULE ADDRESS INTO VARIABLE                      *
*                                                                      *
***********************************************************************?
PROCEDURE PIPROTECT;
VAR 
      ADDRESS : INTEGER;                    _ GENERAL ADDRESS POINTER  ?
      MEMADDR : INTEGER;                    _ ABSOLUTE ADDRESS         ?
      PAGE    : INTEGER;                    _ CURRENT PAGE             ?
      PAGENUM : INTEGER;                    _ PAGE TO CHANGE           ?
BEGIN 
_ 
*              ---- DETERMINE TOP OF BUFFER AREA ---- 
? 
  ADDR(PIBUF2,B3EBUF);
_ 
*              ---- SET UP PROTECT FOR MAIN MEMORY ---- 
? 
  ADDRESS := J1CORESIZE.B0WORD.BAINT;       _ SET UP END OF CORE VALUE ?
  INST ($E400,ADDRESS,                      _ LDQ   CURRENT ADDRESS    ?
        $0600,                              _ SPB   SET PROTECT BIT    ?
        $01C3,                              _ SPE   SKIP IF PARITY ERR ?
        $0DFE,                              _ INQ   -1                 ?
        $0147,                              _ SQZ   EXIT               ?
        $18FB,                              _ JMP   LOOP               ?
        $4400,ADDRESS,                      _ STQ   ADDRESS - SAVE     ?
                                            _ CALL NORMAL PROTECT RTN  ?
                                            _ TO CLEAR ERROR           ?
        $5400,PBSETPROTECT,ADDRESS,         _ RTJ   PBSETPROTECT       ?
        $18F3,                              _ JMP TOP                  ?
        $6400,$FFFF);                       _ SET PARITY IN LOC. $FFFF ?
_ 
*              ---- CLEAR PROTECT BITS FOR BUFFER AREA  ----
? 
  ADDRESS := B3SBUF.BAINT;                  _ START OF BUFFERS         ?
  REPEAT
    INST ($E400,ADDRESS,                    _ LDQ   ADDRESS            ?
          $0700);                           _ CPB   CLEAR PROTECT BIT  ?
    ADDRESS := ADDRESS + 1;                 _ INCREMENT ADDRESS        ?
  UNTIL ADDRESS = B3EBUF.BAINT + 1;         _ LOOP ON BUFFER WDS       ?
_ 
*              ---- SET PROTECT BITS ON PAGED MEMORY ---- 
? 
  PAGENUM := DYNAMICPAGE * $800;            _CALC ADDRESS WITHIN PAGE  ?
  FOR PAGE := $20 TO J1CORESISE.B0UPPER.
                   BA7BITS DO               _ LOOP ON ALL PAGES        ?
  BEGIN 
    PBPUTPAGE (DYNAMICPAGE,PAGE);           _ CHANGE TO NEW PAGE       ?
    ADDRESS := $800;                        _ SET UP END ADDRESS       ?
    INST ($E400,ADDRESS,                    _ LDQ   CURRENT INDEX      ?
          $0DFE,                            _ INQ   -1                 ?
          $017D,                            _ SQM   EXIT               ?
          $4400,ADDRESS,                    _ STQ   ADDRESS            ?
          $F400,PAGENUM,                    _ ADQ ADDRESS WITHIN PAGE  ?
          $0600,                            _ SPB   SET PROTECT        ?
          $01C1,                            _ SPE   SKIP ON PARITY ERR ?
          $18F5,                            _ JMP   TOP                ?
                                            _ CALL NORMAL PROTECT RTN  ?
                                            _ TO CLEAR PARITY ERR      ?
          $4400,MEMADDR,                    _ STQ   SET UP PARAM       ?
          $5400,PBSETPROTECT,MEMADDR,       _ RTJ   PBSETPROTECT       ?
          $18EF);                           _ JMP   TOP                ?
  END;
  PBPUTPAGE (DYNAMICPAGE,DYNAMICPAGE);      _ RESTORE DYNAMICPAGE REG. ?
END;_PIPROTECT? 
