Trailing-Edge
-
PDP-10 Archives
-
BB-H311D-RM
-
swskit-tools/mtest.mac
There are 4 other files named mtest.mac in the archive. Click here to see a list.
;<SWSKIT>MTEST.MAC.2, 10-Jan-82 00:36:09, EDIT BY ZIMA
;[1] Require SYS:CMD so build works.
;[2] Use VI%DEC for decimal edit number.
;[3] Use standard ACs.
;[4] Use DEFAULT-EXEC: in PUSH command for release 6.
TITLE MTEST
SEARCH CMD,MONSYM,MACSYM
.REQUIRE SYS:CMD,SYS:MACREL
SUBTTL Richard A. Schmitt/RAS/JGZ
SALL
STDAC. ;Standard ACs.
.ADDOP==0
.SUBOP==1
VMAJOR==1
VMINOR==0
VEDIT==^D4
VWHO==0
VMON==<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+<VI%DEC+VEDIT>
ENTVEC: JRST MONTST ; Entry Vector, Start test
JRST MNTST0 ; Reenter address
VMON ; version number
CMDSTG ; Macro to define all COMND JSYS storage
MONSTK: BLOCK 200 ; Stack for this program
SYMSTK: BLOCK 20 ; Stack for decode of radix 50 symbol
MODNAM: BLOCK 1 ; Holds SIXBIT Module name for symbol lookup
UTBASE: BLOCK 1 ; Holds base address for MTEST test
TSTLEN: BLOCK 1 ; Holds the current size of the test window
FLAGS: BLOCK 1
; There are two MTEST argument block, one for each function (.UTSET, .UTCLR)
; This allows us to preserve the bit map specifying the locations being tested
; as well as creating the bit map specifying which instructions were executed.
UBTLEN==^D30 ; Length of the MTEST bit map
UABLEN==UBTLEN+2 ; Length of the MTEST argument block
XCTBLK: BLOCK 2 ; Argument block used with .UTCLR
XCTMAP: BLOCK UBTLEN ; Bit map specifying which inst were executed
TSTBLK: BLOCK 2 ; Argument block used with .UTSET
TSTMAP: BLOCK UBTLEN ; Bit map specifying which inst are tested
; COMND JSYS Keyword table - Main Level
KEYS: XWD 16,16 ; Keyword Table (Macro T defined in CMD)
T(Clear) ; Clear Lookup Module Name
T(Examine) ; Examine section of Monitor code
T(Exit) ; Exit from MTEST
T(Help) ; Help routine
T(Insert) ; Insert test into UTEST Data base
T(Push) ; Push to new EXEC
T(Reset) ; Reset UTEST data base
T(Results) ; List results of Test
T(Run) ; Run a program
T(SDDT) ; Push into SDDT
T(Set) ; Set Lookup Module name
T(Start) ; Start testing
T(Stop) ; Stop testing
T(Toggle) ; Toggle character changing
T(Translate) ; Translate Monitor symbol to a value
YESNO: XWD 2,2 ; Yes, No Keyword table
T(No,0) ; No has a value of zero
T(Yes,1) ; While Yes has a value of one
TOGKEY: XWD ^D15,^D15 ; Toggle character keyword table
T(,.TICCA) ; CTRL/A
T(,.TICCB) ; CTRL/B
T(,.TICCD) ; CTRL/D
T(,.TICCE) ; CTRL/E
T(
,.TICCL) ; CTRL/L
T(,.TICCN) ; CTRL/N
T(,.TICCO) ; CTRL/O
T(,.TICCP) ; CTRL/P
T(,.TICCQ) ; CTRL/Q
T(,.TICCS) ; CTRL/S
T(,.TICCT) ; CTRL/T
T(,.TICCV) ; CTRL/V
T(,.TICCX) ; CTRL/X
T(,.TICCY) ; CTRL/Y
T(,.TICCZ) ; CTRL/Z
; Break set for input of toggle control character
BRINI. KEYB0.,KEYB1.,KEYB2.,KEYB3. ; Initialize to std keyword break
UNBRK. (.CHCNA,.CHCNE) ; Don't break on CTRL/A - CTRL/E
UNBRK. (.CHFFD) ; Don't break on CTRL/L
UNBRK. (.CHCNN,.CHCNQ) ; Don't break on CTRL/N - CTRL/Q
UNBRK. (.CHCNS,.CHCNT) ; Don't break on CTRL/S or CTRL/T
UNBRK. (.CHCNV) ; Don't break on CTRL/V
UNBRK. (.CHCNX,.CHCNZ) ; Don't break on CTRL/X - CTRL/Z
TOGBRK: W0.
W1.
W2.
W3.
.ICTOG==1 ; Toggle channel is Channel 1
; COMND JSYS parse fields...
TERM: FLDDB. (.CMNUX,,^D8,,,SYMPRS) ; parse a number
SYMPRS: FLDBK. (.CMFLD,,,<Monitor Symbol>,<0>,SYMBRK) ; symbol
ADDFLD: FLDDB. (.CMTOK,,<POINT 7,[ASCIZ/+/]>,,,SUBFLD) ; add token
SUBFLD: FLDDB. (.CMTOK,,<POINT 7,[ASCIZ/-/]>,,,CFMFLD) ; sub token
CFMFLD: FLDDB. (.CMCFM) ; confirm
; Break Mask for parsing of a Monitor Symbol
SYMBRK: 777777,,777760
740160,,001760
400000,,000740
400000,,000740
TOGCHR: .TICCD ; Place which holds toggle character
; Initialized to control D
; PSI Storage
LEVTAB: 0,,PCLEV1 ; Address to save PC
Z ; No level 2
Z ; or level 3
CHNTAB: Z ; No channel zero
1,,PSITOG ; PSITOG is routine that toggles tests
BLOCK ^D34
PCLEV1: BLOCK 1 ; Storage for address
WDWLEN==2000 ; Window length
EXMPAG: BLOCK WDWLEN ; Storage For Block Of Monitor Code
MSKSTR (TSTVLD,FLAGS,400000000000) ; Specifies whether we have valid test data
MSKSTR (TSTPRG,FLAGS,200000000000) ; Specifies whether a test is in progress
MSKSTR (TSTDON,FLAGS,100000000000) ; Specifies whether a new INSERT should
; reset the UTEST data base
DEFSTR (INSTR,(P1),8,9) ; Defstrs For fields of instruction
DEFSTR (AC,(P1),12,4) ; AC instruction field
DEFSTR (INDRCT,(P1),13,1) ; Indirect Bit
DEFSTR (INDEX,(P1),17,4) ; Index Register
DEFSTR (OPRND,(P1),35,18) ; Operand field
DEFINE ERET (STRING) ; error return macro
<IFNB <STRING>,<
JRST [ TMSG <?'STRING> ; Print out message
RET]> ; And return down the stack
IFB <STRING>,<
JRST [ MOVEI T1,"?" ; Get Question mark
PBOUT ; Print it out
MOVEI T1,.PRIOU ; Outputting to primary output
HRLOI T2,.FHSLF ; Our selves and last error
SETZ T3, ; Output all of the message
ERSTR
JFCL
JFCL
RET]>> ; And return
DEFINE OPC (STRING), ; macro for defining opcode table
<POINT 7,[ASCIZ/STRING/]>
OPCTBL: REPEAT 104,< Z > ; opcode table
OPC (JSYS) ; a zero means undefined opcode
OPC (ADJSP) ; otherwise a pointer to the opcode
Z ; symbol corresponding to the offset
Z ; in the table is contained in the
OPC (DFAD) ; location
OPC (DFSB)
OPC (DFMP)
OPC (DFDV)
OPC (DADD)
OPC (DSUB)
OPC (DMUL)
OPC (DDIV)
OPC (DMOVE)
OPC (DMOVN)
OPC (FIX)
OPC (EXTEND)
OPC (DMOVEM)
OPC (DMOVNM)
OPC (FIXR)
OPC (FLTR)
OPC (UFA)
OPC (DFN)
OPC (FSC)
OPC (IBP)
OPC (ILDB)
OPC (LDB)
OPC (IDPB)
OPC (DPB)
OPC (FAD)
OPC (FADL)
OPC (FADM)
OPC (FADB)
OPC (FADR)
OPC (FADRI)
OPC (FADRM)
OPC (FADRB)
OPC (FSB)
OPC (FSBL)
OPC (FSBM)
OPC (FSBB)
OPC (FSBR)
OPC (FSBRI)
OPC (FSBRM)
OPC (FSBRB)
OPC (FMP)
OPC (FMPL)
OPC (FMPM)
OPC (FMPB)
OPC (FMPR)
OPC (FMPRI)
OPC (FMPRM)
OPC (FMPRB)
OPC (FDV)
OPC (FDVL)
OPC (FDVM)
OPC (FDVB)
OPC (FDVR)
OPC (FDVRI)
OPC (FDVRM)
OPC (FDVRB)
OPC (MOVE)
OPC (MOVEI)
OPC (MOVEM)
OPC (MOVES)
OPC (MOVS)
OPC (MOVSI)
OPC (MOVSM)
OPC (MOVSS)
OPC (MOVN)
OPC (MOVNI)
OPC (MOVNM)
OPC (MOVNS)
OPC (MOVM)
OPC (MOVMI)
OPC (MOVMM)
OPC (MOVMS)
OPC (IMUL)
OPC (IMULI)
OPC (IMULM)
OPC (IMULB)
OPC (MUL)
OPC (MULI)
OPC (MULM)
OPC (MULB)
OPC (IDIV)
OPC (IDIVI)
OPC (IDIVM)
OPC (IDIVB)
OPC (DIV)
OPC (DIVI)
OPC (DIVM)
OPC (DIVB)
OPC (ASH)
OPC (ROT)
OPC (LSH)
OPC (JFFO)
OPC (ASHC)
OPC (ROTC)
OPC (LSHC)
Z
OPC (EXCH)
OPC (BLT)
OPC (AOBJP)
OPC (AOBJN)
OPC (JRST)
OPC (JFCL)
OPC (XCT)
OPC (MAP)
OPC (PUSHJ)
OPC (PUSH)
OPC (POP)
OPC (POPJ)
OPC (JSR)
OPC (JSP)
OPC (JSA)
OPC (JRA)
OPC (ADD)
OPC (ADDI)
OPC (ADDM)
OPC (ADDB)
OPC (SUB)
OPC (SUBI)
OPC (SUBM)
OPC (SUBB)
OPC (CAI)
OPC (CAIL)
OPC (CAIE)
OPC (CAILE)
OPC (CAIA)
OPC (CAIGE)
OPC (CAIN)
OPC (CAIG)
OPC (CAM)
OPC (CAML)
OPC (CAME)
OPC (CAMLE)
OPC (CAMA)
OPC (CAMGE)
OPC (CAMN)
OPC (CAMG)
OPC (JUMP)
OPC (JUMPL)
OPC (JUMPE)
OPC (JUMPLE)
OPC (JUMPA)
OPC (JUMPGE)
OPC (JUMPN)
OPC (JUMPG)
OPC (SKIP)
OPC (SKIPL)
OPC (SKIPE)
OPC (SKIPLE)
OPC (SKIPA)
OPC (SKIPGE)
OPC (SKIPN)
OPC (SKIPG)
OPC (AOJ)
OPC (AOJL)
OPC (AOJE)
OPC (AOJLE)
OPC (AOJA)
OPC (AOJGE)
OPC (AOJN)
OPC (AOJG)
OPC (AOS)
OPC (AOSL)
OPC (AOSE)
OPC (AOSLE)
OPC (AOSA)
OPC (AOSGE)
OPC (AOSN)
OPC (AOSG)
OPC (SOJ)
OPC (SOJL)
OPC (SOJE)
OPC (SOJLE)
OPC (SOJA)
OPC (SOJGE)
OPC (SOJN)
OPC (SOJG)
OPC (SOS)
OPC (SOSL)
OPC (SOSE)
OPC (SOSLE)
OPC (SOSA)
OPC (SOSGE)
OPC (SOSN)
OPC (SOSG)
OPC (SETZ)
OPC (SETZI)
OPC (SETZM)
OPC (SETZB)
OPC (AND)
OPC (ANDI)
OPC (ANDM)
OPC (ANDB)
OPC (ANDCA)
OPC (ANDCAI)
OPC (ANDCAM)
OPC (ANDCAB)
OPC (SETM)
OPC (XMOVEI)
OPC (SETMM)
OPC (SETMB)
OPC (ANDCM)
OPC (ANDCMI)
OPC (ANDCMM)
OPC (ANDCMB)
OPC (SETA)
OPC (SETAI)
OPC (SETAM)
OPC (SETAB)
OPC (XOR)
OPC (XORI)
OPC (XORM)
OPC (XORB)
OPC (IOR)
OPC (IORI)
OPC (IORM)
OPC (IORB)
OPC (ANDCB)
OPC (ANDCBI)
OPC (ANDCBM)
OPC (ANDCBB)
OPC (EQV)
OPC (EQVI)
OPC (EQVM)
OPC (EQVB)
OPC (SETCA)
OPC (SETCAI)
OPC (SETCAM)
OPC (SETCAB)
OPC (ORCA)
OPC (ORCAI)
OPC (ORCAM)
OPC (ORCAB)
OPC (SETCM)
OPC (SETCMI)
OPC (SETCMM)
OPC (SETCMB)
OPC (ORCM)
OPC (ORCMI)
OPC (ORCMM)
OPC (ORCMB)
OPC (ORCB)
OPC (ORCBI)
OPC (ORCBM)
OPC (ORCBB)
OPC (SETO)
OPC (SETOI)
OPC (SETOM)
OPC (SETOB)
OPC (HLL)
OPC (HLLI)
OPC (HLLM)
OPC (HLLS)
OPC (HRL)
OPC (HRLI)
OPC (HRLM)
OPC (HRLS)
OPC (HLLZ)
OPC (HLLZI)
OPC (HLLZM)
OPC (HLLZS)
OPC (HRLZ)
OPC (HRLZI)
OPC (HRLZM)
OPC (HRLZS)
OPC (HLLO)
OPC (HLLOI)
OPC (HLLOM)
OPC (HLLOS)
OPC (HRLO)
OPC (HRLOI)
OPC (HRLOM)
OPC (HRLOS)
OPC (HLLE)
OPC (HLLEI)
OPC (HLLEM)
OPC (HLLES)
OPC (HRLE)
OPC (HRLEI)
OPC (HRLEM)
OPC (HRLES)
OPC (HRR)
OPC (HRRI)
OPC (HRRM)
OPC (HRRS)
OPC (HLR)
OPC (HLRI)
OPC (HLRM)
OPC (HLRS)
OPC (HRRZ)
OPC (HRRZI)
OPC (HRRZM)
OPC (HRRZS)
OPC (HLRZ)
OPC (HLRZI)
OPC (HLRZM)
OPC (HLRZS)
OPC (HRRO)
OPC (HRROI)
OPC (HRROM)
OPC (HRROS)
OPC (HLRO)
OPC (HLROI)
OPC (HLROM)
OPC (HLROS)
OPC (HRRE)
OPC (HRREI)
OPC (HRREM)
OPC (HRRES)
OPC (HLRE)
OPC (HLREI)
OPC (HLREM)
OPC (HLRES)
OPC (TRN)
OPC (TLN)
OPC (TRNE)
OPC (TLNE)
OPC (TRNA)
OPC (TLNA)
OPC (TRNN)
OPC (TLNN)
OPC (TDN)
OPC (TSN)
OPC (TDNE)
OPC (TSNE)
OPC (TDNA)
OPC (TSNA)
OPC (TDNN)
OPC (TSNN)
OPC (TRZ)
OPC (TLZ)
OPC (TRZE)
OPC (TLZE)
OPC (TRZA)
OPC (TLZA)
OPC (TRZN)
OPC (TLZN)
OPC (TDZ)
OPC (TSZ)
OPC (TDZE)
OPC (TSZE)
OPC (TDZA)
OPC (TSZA)
OPC (TDZN)
OPC (TSZN)
OPC (TRC)
OPC (TLC)
OPC (TRCE)
OPC (TLCE)
OPC (TRCA)
OPC (TLCA)
OPC (TRCN)
OPC (TLCN)
OPC (TDC)
OPC (TSC)
OPC (TDCE)
OPC (TSCE)
OPC (TDCA)
OPC (TSCA)
OPC (TDCN)
OPC (TSCN)
OPC (TRO)
OPC (TLO)
OPC (TROE)
OPC (TLOE)
OPC (TROA)
OPC (TLOA)
OPC (TRON)
OPC (TLON)
OPC (TDO)
OPC (TSO)
OPC (TDOE)
OPC (TSOE)
OPC (TDOA)
OPC (TSOA)
OPC (TDON)
OPC (TSON)
OPC (BLKI)
OPC (DATAI)
OPC (CONO)
; Initialization routine called at program start
MONINI: CALL CMDINI ; Initialize the COMND JSYS
SETZRO TSTPRG ; Say no test in progress
SETZRO TSTVLD ; Say no valid test
SETONE TSTDON ; Say Reset UTEST data base
CALL PSIINI ; Initialize the PSI system
RET ; and done
; Entry vectory start comes here
MONTST: MOVE P,[XWD -200,MONSTK] ; Set up stack
CALL MONINI ; And call the all purpose init routine
CALL PRVINI ; Initialize Privileges
HALTF ; Can't get wheel. Die quietly.
; If he CONTinues, He'll get prompt
MNTST0: ; entry for restart
PROMPT (MTEST>) ; give prompt
MOVEI T1,[FLDDB. (.CMKEY,,KEYS)]
CALL RFIELD ; read the keyword
HRRZ T3,0(T2) ; get dispatch address
CALL @T3 ; dispatch to routine
JRST MNTST0 ; Loop for next command
; RESET - Command Dispatch Routine
;
; This routine will reset the UTEST Data Base. This includes the
; flags which define the state of the data base, removing any tests
; in progress internally in the MONITOR and initializing the bit maps
; for the UTEST tests.
.RESET: NOISE (Utest Data Base) ; Give Noise word
CONFRM ; And Confirm Command
SETZRO TSTVLD ; Say no valid test addresses
SETZRO TSTPRG ; Say no test in progress
SETONE TSTDON ; Say Time to Init Utest Data base
HRLZI T1,.UTCLR ; Clear the monitor
UTEST ; ...
ERJMP .+1 ; in case one wasn't set
CALL RSTBTM ; Clear the bit tables
RET ; And Return
; TRANSLATE - Command Dispatch Routine
;
; This routine will transalate a monitor symbol which is parsed from
; The Primary I/O and print it out to the Primary output.
.TRANS: NOISE (Monitor Symbol) ; Output noise word
CALL EVAL ; Evaluate the symbol
RET ; error
MOVE T2,T1 ; get address in t2
MOVEI T1,.PRIOU ; primary i/o in t1
MOVEI T3,^D8 ; and output in octal
NOUT ; Output the number to the primary I/O
JSERR ; error
CALL PCRLF ; print a crlf
RET ; and return
; CLEAR - Command Dispatch Routine
;
; This Routine will Clear the Lookup Module Name which is stored
; in MODNAM. This value is used in the SNOOP JSYS to specify which
; MONITOR module symbol table to search for the symbol. It is set using
; the SET command.
.CLEAR: NOISE (Lookup Module) ; Output noise word
CONFRM ; Confirm the command
SETZM MODNAM ; clear the module name
RET ; And return
; EXAMINE - Command Dispatch Routine
;
; This routine will map a section of MONITOR code, deassemble
; it and print it out to the Primary output. The subroutine
; RANGE inputs the first and last address of the section
; and the subroutine DASSEM will deassemble the section of code.
.EXAMI: NOISE (Monitor Code) ; Give noise word
CONFRM ; confirm the command
CALL RANGE ; First Adr in T1, length in T2
RET ; some error
CAILE T2,WDWLEN ; Less than window length?
ERET (Examine Area Greater Than two Pages)
HRL T1,T2 ; Get length of the area in LH of T1
MOVEI T2,EXMPAG ; Get address of our page
PEEK ; Get the code
ERET () ; Failed
CALL DASSEM ; Interprete code and print it out
RET ; And done
; RANGE -
;
; This Routine will parse from the Primary input, a range of monitor
; code. It will prompt for starting address and last address.
;
; CALL RANGE
;
; RETURNS +1 Error, Message has already been typed
; +2 Success, T1 holds the first address of the range
; T2 Holds the length of the section
RANGE: STKVAR <ADDR1,ADDR2> ; Temporary storage
PROMPT (Starting At: ) ; another noise word
CALL EVAL ; Evaluate expression
RET ; some error
MOVEM T1,ADDR1 ; Save First Address
PROMPT (Ending At: ) ; another noise word
CALL EVAL ; Evaluate to
RET ; some error
MOVEM T1,ADDR2 ; Save second address
SUB T1,ADDR1 ; Get word count in T1
AOS T2,T1 ; incr so we get last word
MOVE T1,ADDR1 ; get starting address in t1
RETSKP ; And return to Calling routine
; EVAL -
;
; This routine will eventually be a general evaluation routine.
; At present, all I will have it do is evaluate an expression
; such as..
;
; <expression> ::= <term>
; ::= <term> <add-operator> <expression>
; <term> ::= <monitor symbol>
; ::= <constant>
; <add-operator> ::= +
; ::= -
;
; This routine expects to parse the expression from the primary
; I/O using the COMND JSYS.
;
; CALL EVAL
;
; RETURNS +1 Always, with T1 holding integer result.
EVAL: SAVEAC <T2,T3,T4>
STKVAR <SUM,LASTOP>
SETZM SUM ; initialize the sum
MOVEI T1,.ADDOP ; get the add symbol
MOVEM T1,LASTOP ; and initialize last op
; Loop to read expressions until CRLF
EVAL1: MOVEI T1,TERM ; parse symbol or constant
CALL RFIELD ; ...
HRRZS T3 ; get address of FDB parsed
CAIN T3,SYMPRS ; Did we parse a symbol?
JRST [ CALL EVLSYM ; Yes, evaluate the symbol
RET ; Error, pass it down
JRST .+1] ; continue - T2 holds symbol value
MOVE T1,LASTOP ; get last op
EXCH T2,SUM ; exchange these values for ease
XCT [ ADDM T2,SUM ; either add or sub the term
SUBM T2,SUM](T1) ; depend on last op
MOVEI T1,ADDFLD ; parse "+","-", or <CRLF>
CALL RFIELD ; ...
HRRZS T3 ; get field actually parsed
CAIN T3,CFMFLD ; was it a confirm
JRST [ MOVE T1,SUM ; yes, get sum in AC1
RETSKP] ; and return
MOVEI T1,.ADDOP ; get addop code in T1
CAIE T3,ADDFLD ; did we parse a "+"?
MOVEI T1,.SUBOP ; no, get subop code
MOVEM T1,LASTOP ; and save as last op
JRST EVAL1 ; and loop till see confirm
; EVLSYM -
;
; This routine will evaluate the ASCIZ monitor symbol located
; in the COMND JSYS atom buffer and return the value to the
; calling routine
;
; CALL EVLSYM
;
; RETURNS +1 Error
; +2 Success, Symbol value returned in T1
EVLSYM: MOVEI T1,ATMBUF ; get address of atom buffer
HRLI T1,440700 ; make standard byte pointer
CALL ASCR50 ; convert to radix 50
MOVEI T1,.SNPSY ; obtain address of mon sym
MOVE T3,MODNAM ; get module name if any
SNOOP ; get the address
JRST [ MOVEI T1,.SNPSY ; Error, try again
SETZ T3, ; seaching entire symbol table
SNOOP ; ...
ERET () ; Still error, Give up
JRST .+1] ; this time successful
RETSKP ; success, ADR in T2
; DASSEM -
; Routine to deassemble a section of monitor code in user address
; space and type out code on the primary output designator.
;
; CALL DASSEM
;
; ACCEPTS T1 Number of words,,user address of start of block
; T2 Monitor address of start of section
;
; RETURNS +1 Always, Line has been typed out
DASSEM: SAVEAC <P1,P2> ; save pointer acs
HLRZ P1,T1 ; Get AOBJN pointer into P1
MOVNS P1 ; make negative
HRLZS P1 ; move in left half
HRR P1,T2 ; and move first address in
HRRZ P2,T1 ; Get Index for addresses
DASSM1: CALL TRNLIN ; Translate line
CALL PCRLF ; Print a CR & LF
AOS P2 ; Increment address
AOBJN P1,DASSM1 ; Loop till done
RET ; Finished
; TRNLIN -
; Deassembles one line of code pointed to by the RH of P1
; uses monitor address supplied in P2
;
; CALL TRNLIN
;
; ACCEPTS P1 RH - address of code to deassemble
; P2 Monitor address of code
;
; RETURNS +1 always
TRNLIN: SAVEAC <T1> ; save ac for space index
CALL TRNADR ; Translate and print the address
MOVEI T1,4 ; print four spaces
TRNLN1: CALL PSPACE ; before instruction
SOJG T1,TRNLN1 ; Loop till four spaces
CALL TRNINS ; Translate and print the instruction
RET ; And return
; TRNADR -
;
; Obtains a monitor symbol and offset for monitor address in P2
; and prints it out
;
; CALL TRNADR
;
; ACCEPTS P2 Monitor address to interpret
;
; RETURNS +1 always
TRNADR: SAVEAC <T1>
MOVE T1,P2 ; Get address in T1
CALL TRNSYM ; Translate the symbol
RET ; and return
; TRNINS -
;
; Will deassemble the instruction pointed to by RH of P1 with
; monitor symbols.
;
; CALL TRNINS
;
; ACCEPTS P1 RH address of instruction to deassemble
;
; RETURNS +1 always
TRNINS: SAVEAC <T1>
LOAD T1,INSTR ; Get 9 bit instruction code
MOVE T1,OPCTBL(T1) ; Get Pointer to instruction
SKIPN T1 ; Is it valid?
JRST NOINST
PSOUT ; Output the instruction
CALL PSPACE ; Print out a space
LOAD T1,AC ; Get the AC field
JUMPE T1,TRNIN1 ; If zero, skip the AC field
CALL NUMOUT ; output the number
CALL PCOMMA ; Print a comma
TRNIN1: LOAD T1,INDRCT ; get indirect bit
SKIPE T1 ; is it indirect?
JRST [ MOVEI T1,"@" ; yes, print out at sign
PBOUT
JRST .+1]
LOAD T1,OPRND ; Get the operand
CALL TRNSYM ; Translate the Symbol and Print it
LOAD T1,INDEX ; Get Index field
SKIPN T1 ; Is there a field
RET ; No, Just return
CALL LPAREN ; Print Left Paren
CALL NUMOUT ; output the number
CALL RPAREN ; Print Right Paren
RET ; And Return
; TRNSYM -
;
; Obtains the monitor symbol for an address supplied in T1 and
; prints it out
;
; CALL TRNSYM
;
; ACCEPTS T1 Value of the symbol
;
; RETURNS +1 always
TRNSYM: SAVEAC <T2,T3>
MOVE T2,T1 ; Get Symbol value in T2
MOVEI T1,.SNPAD ; Obtain Monitor Symbol
MOVE T3,MODNAM ; Module name to give preference
SNOOP ; Find the symbol
JRST [ MOVEI T1,.SNPAD ; Try again
SETZ T3, ; With general Symbol Table
SNOOP ; ...
ERET () ; give up
JRST TRNSY1]
TRNSY1: MOVE T1,T2 ; Get Radix 50 symbol in T1
CALL R50ASC ; Convert to ascii
SKIPN T2,T3 ; Is there an offset
RET ; No
CALL PPLUS ; Print a Plus sign
MOVEI T1,.PRIOU ; Output offset to Primary output
MOVEI T3,^D8 ; And in octal
NOUT ; Perform the output
ERET ()
RET ; And return
; NOINST -
;
; This routine will treat a word as a full word constant and
; type it out
NOINST: MOVE T1,EXMPAG(P1) ; Get whole word
CALL TRNSYM ; translate as a symbol
RET ; And return
; The PRINT Routines -
;
; Each routine prints out on the terminal a small string of ascii char
;
; PCRLF : Prints <CRLF>
; PPLUS : Prints a plus sign
; PTAB : Prints a tab
; PSPACE : Prints out a space
; LPAREN : Prints out a left parentheses
; RPAREN : Prints out a right parentheses
; PCOMMA : Prints a comma
; PCRLF -
PCRLF: SAVEAC <T1> ; Save T1
HRROI T1,[ASCIZ/
/] ; CRLF
PSOUT ; type it out
RET ; And return
; PPLUS -
PPLUS: SAVEAC <T1> ; Save T1
MOVEI T1,"+" ; Get plus sign
PBOUT ; Output it
RET ; And return
; PTAB -
PTAB: SAVEAC <T1> ; Save T1
MOVEI T1," " ; get a TAB
PBOUT ; Print it out
RET ; And return
; PSPACE -
PSPACE: SAVEAC <T1> ; Save T1
MOVEI T1," " ; Get space
PBOUT ; Output it
RET ; And Return
; LPAREN -
LPAREN: SAVEAC <T1> ; Save T1
MOVEI T1,"(" ; Get left paren
PBOUT ; Output it
RET ; And Return
; RPAREN -
RPAREN: SAVEAC <T1> ; Save T1
MOVEI T1,")" ; Get a Right Paren
PBOUT ; Print it out
RET ; and return
; PCOMMA -
PCOMMA: SAVEAC <T1> ; Save T1
MOVEI T1,"," ; get a comma
PBOUT ; Print it out
RET ; and return
; R50ASC -
;
; Routine to convert the radix 50 value in T1 to ASCII and print
; it out. This routine was borrowed from DDT's symbol evaluation
; routine
;
; CALL R50ASC
;
; ACCEPTS T1 Radix 50 symbol
;
; RETURNS +1 always
R50ASC: SAVEAC <T2,T3,p3> ; Radix 50 symbol print
MOVE P3,[XWD -20,SYMSTK] ; set up symbol stack
LDB T1,[POINT 32,T1,35] ; Get symbol
SPT1: IDIVI T1,50 ; get remainder = character
PUSH P3,T2 ; save symbol value
JUMPE T1,SPT2 ; if null, we're done
PUSHJ P,SPT1 ; continue recursively
SPT2: POP P3,T2 ; get back symbol value
SKIPN T2 ; Null?
RET ; flush nulls
ADDI T2,260-1 ; Krptic algorithm copied
CAILE T2,271 ; from ddt
ADDI T2,301-272 ; ...
CAILE T2,332 ; ...
SUBI T2,334-244 ; ...
CAIN T2,243 ; ...
MOVEI T2,256 ; ...
MOVE T1,T2 ; Get ascii character
PBOUT ; Print it out
RET ; and return recursively
; R50CNV -
; Routine to convert input to radix50 value. This routine was copied
; from JGZ's WS program. Terminates on first out of range character.
;
; CALL R50CNV
;
; ACCEPTS T1 Bytepointer to string to be translated
;
; RETURNS +1 Always, with value in T2.
ASCR50: SAVEAC <T1,T3,T4> ; Save some ACs
SETZ T2, ; start with zero
MOVEI T4,6 ; max chars to read
R50CNL: ILDB T3,T1 ; get next byte
CAIL T3,"A"+40 ; make the usual
CAILE T3,"Z"+40 ; lower to upper case
SKIPA ; conversion
SUBI T3,40 ; for alphapbetics
CAIL T3,"A" ; check for a letter
CAILE T3,"Z" ; ...
JRST R50CN1 ; try digits
SOJL T4,R50CNL ; just loop if more than six
IMULI T2,50 ; make room and
ADDI T2,-<"A"-^D11>(T3) ; include this character in RADIX50
JRST R50CNL ; and loop
R50CN1: CAIL T3,"0" ; check for a digit
CAILE T3,"9" ; ...
JRST R50CN2 ; try the special chars
SOJL T4,R50CNL ; just loop if more than six
IMULI T2,50 ; make room and
ADDI T2,-<"0"-1>(T3) ; add in RADIX50 value for this digit
JRST R50CNL ; and loop
R50CN2: CAIN T3,"." ; period perhaps?
HRROI T3,45 ; yes
CAIN T3,"$" ; dollar sign?
HRROI T3,46 ; yes
CAIN T3,"%" ; or finally percent?
HRROI T3,47 ; yes
JUMPGE T3,[ret] ; if not a RADIX50 char, LH is still pos, so go
SOJL T4,R50CNL ; but check for more than six
IMULI T2,50 ; make room
ADDI T2,0(T3) ; and include the RADIX50 character
JRST R50CNL ; and loop
; RSTBTM -
;
; This routine will reset the Bit Maps (both the Test Bit map and the
; Execute Bit map).
;
; CALL RSTBTM
;
; RETURNS +1 Always
RSTBTM: SAVEAC <T1,T2>
SETZM TSTMAP ; clear first word of table
HRLI T1,TSTMAP ; get first address
HRRI T1,TSTMAP+1 ; plus one
BLT T1,TSTMAP+UBTLEN-1 ; clear the table
SETOM XCTMAP ; init xct map say not xcted
HRLI T1,XCTMAP ; get first address
HRRI T1,XCTMAP+1 ; plus one
BLT T1,XCTMAP+UBTLEN-1 ; init table
SETZM UTBASE ; and clear the base
RET
; INSERT - Command Dispatch Routine
;
; This routine will insert a section of Monitor code to test using
; the UTEST JSYS. This routine does not actually insert the test
; into the MONITOR, rather it sets up our data base so we know which
; instructions are to be tested. It enforces the fact that all the tests
; which are in the UTEST data base fit in a two page window.
.INSER: NOISE (Code Test)
CONFRM ; confirm command string
LOAD T3,TSTPRG ; is test in progress
SKIPE T3 ; ...
ERET (Test already in progress)
CALL RANGE ; returns from in t1, len in t2
RET ; error
LOAD T3,TSTDON ; is this first time since test done?
SKIPE T3 ; ...
JRST [ CALL RSTBTM ; reset the bit map
HRRM T1,UTBASE ; save new base address
SETONE TSTVLD ; say addresses are valid
SETZRO TSTDON ; and than we're working on a new one
JRST .+1] ; and contnue in line
MOVE T3,UTBASE ; get current base
SUBM T1,T3 ; subtract new address
SKIPGE T3 ; Is new address less than current base
JRST [ MOVMS T3 ; get absolute value of t3
ADD T3,TSTLEN ; add current length
CAILE T3,WDWLEN ; will it fit?
JRST INSERE ; insert error
CALL ADJBTB ; Adjust the bit map
JRST INSER2]
ADD T3,T2 ; add current length to get total
CAILE T3,WDWLEN ;
JRST INSERE ; insert error
INSER2: MOVEM T3,TSTLEN ; Save new test length
SUB T1,UTBASE ; get offset into bit map
MOVE T3,[POINT 1,TSTMAP] ; get pointer to bit map
ADJBP T1,T3 ; adjust it by t1 bits
MOVEI T3,1 ; get a one
INSER1: IDPB T3,T1 ; and set bit in map
SOJG T2,INSER1 ; loop till entire test is entered
RET ; and return
INSERE: ERET (Inserts must not exceed two page window)
; ADJBTB -
;
; This routine will adjust the bit maps so that the two
; page window will start at the lowest Monitor address to test.
;
; CALL ADJBTB
;
; ACCEPTS T1 New Base address
;
; RETURNS +1 Always
ADJBTB: SAVEAC <T1,T2,T3,T4>
STKVAR <OLDLEN>
MOVE T3,TSTLEN ; get old test length
MOVEM T3,OLDLEN ; and save the old length
EXCH T1,UTBASE ; make new base
SUB T1,UTBASE ; get offset
MOVE T2,[POINT 1,TSTMAP] ; get pointer to bit map
SETZ T4, ; initialize a zero bit
ADD T1,T3 ; get new length
ADJBP T3,T2 ; incr bp to point to old last bit
ADJBP T1,T2 ; and this to point to new last bit
ADJBT1: LDB T2,T3 ; get old bit
DPB T2,T1 ; and make new bit
DPB T4,T3 ; clear old bit
MOVE Q1,[-1] ; back pointer up one
ADJBP Q1,T3 ; ...
MOVEM Q1,T3 ; and save it
MOVE Q1,[-1] ; back pointer up onq
ADJBP Q1,T1 ; ...
MOVEM Q1,T1 ; and save this one
SOSLE OLDLEN ; decrement index
JRST ADJBT1 ; keep looping till we've moved all
RET ; done
; PUSH -
;
; Routine will push to another EXEC and clean up when done.
; It uses the same routine as SDDT
.PUSH: NOISE (To New EXEC)
CONFRM
HRROI T2,[ASCIZ/DEFAULT-EXEC:/] ; Try this for release 6
CALL DOFORK ; Try to run it
SKIPA ; FAILED - try old way quietly
RET ; Worked
HRROI T2,[ASCIZ/SYSTEM:EXEC.EXE/] ; Get pointer to EXEC
CALL DOFORK ; Create fork, start, and kill when done
ERET (Cannot PUSH to new EXEC)
RET ; and then return
; RUN -
;
; This routine will run a program which will be parsed from COMND
.RUN: NOISE (Program) ; Give noise word
HRROI T1,[ASCIZ/EXE/] ; Get default extenstion
MOVEM T1,CJFNBK+.GJEXT ; Save as default extension
MOVX T1,GJ%OLD ; We want an existing generation
MOVEM T1,CJFNBK+.GJGEN ; Save flag in GTJFN block
MOVEI T1,[FLDDB. (.CMFIL)] ; get file
CALL CFIELD ; and end with CRLF
CONFRM ; Confirm the command
CALL DOFORK ; Now execute the program
ERET (Error attempting to run file)
RET ; Then return
; RESULTS - Command Dispatch Routine
;
; This routine will type out the results of the Test. If an instruction
; has been executed, it will be preceeded by an 'X'.
.RESUL: NOISE (Of Previous Test)
CONFRM ; Confirm command string
LOAD T1,TSTVLD ; is there a valid test
SKIPN T1 ; ...
ERET (No valid test, Use INSERT first)
LOAD T1,TSTPRG ; is a test in progress?
SKIPE T1 ; ...
ERET (Test still in progress)
MOVE P3,[POINT 1,TSTMAP] ; pointer to bits in map
MOVE P4,[POINT 1,XCTMAP] ; pointer to words xcted
HRL T1,TSTLEN ; get length of section
HRR T1,UTBASE ; and start in t1
MOVEI T2,EXMPAG ; where it should go
PEEK ; get the code
ERET () ; an error
HRRZ T1,TSTLEN ; get length of section
MOVNS T1 ; make negative
HRLZ P1,T1 ; get in lh of p1
HRRI P1,EXMPAG ; and start of user page
HRRZ P2,UTBASE ; monitor address here
; loop to type out all instructions in test
RESUL1: ILDB T1,P3 ; get bit which says we've tested
ILDB T2,P4 ; get bit which says xcted
SKIPN T1 ; have we tested this instr
JRST RESUL2 ; no, skip line
HRROI T1,[ASCIZ/ /] ; default is not tested
SKIPN T2 ; has this word been executed?
HRROI T1,[ASCIZ/ X /] ; it has been executed
PSOUT ; print out this little info
CALL TRNLIN ; translate the line
CALL PCRLF ; type out a crlf
RESUL2: AOS P2 ; increment monitor symbol
AOBJN P1,RESUL1 ; and loop for all of them
RET ; and return
; SDDT - Command Dispatch Routine
;
; This routine will push to SDDT. Uses the same routine as
; PUSH
.SDDT: CONFRM ; make user confimr string
HRROI T2,[ASCIZ/SYS:SDDT.EXE/]
CALL DOFORK ; Do the fork
ERET (Cannot run SDDT)
RET ; And ret when done
; DOFORK -
;
; This routine will create a fork and load the program specified
; in the call into it, start the program, wait for it to complete
; and kill it when it is done.
;
; CALL DOFORK
;
; ACCEPTS T2 Pointer to file name string to map into process
; or JFN of file to map in.
;
; RETURNS +1 on GTJFN failure (file failure)
; +2 when fork halts, other errors ERET
DOFORK: STKVAR (FHNDL)
MOVX T1,CR%CAP ; same privs
CFORK ; create a fork
ERET ()
MOVEM T1,FHNDL ; save fork handle
TLNN T2,777777 ; Do we have a pointer or a JFN
JRST [ MOVE T1,T2 ; A JFN - Get JFN in T1
JRST DOFRK1] ; And skip GTJFN
MOVX T1,GJ%OLD+GJ%SHT
GTJFN ; get a jfn
RET ; Take bad return
DOFRK1: HRL T1,FHNDL ; get process handle in lh
GET ; get the file
MOVE T1,FHNDL ; get process handle again
SETZ T2, ; start at primary start address
SFRKV ; ...
WFORK ; wait for it to stop
KFORK ; and kill it when it does
RETSKP ; Then return good
; SET - Command Dispatch Routine
;
; This routine will set the lookup module name to some module
; name parsed from the terminal. This is used during all lookups
; of Monitor Symbols using the SNOOP JSYS.
.SET: NOISE (Lookup Module Name to) ; noise
MOVEI T1,SYMPRS ; parse a symbol
CALL RFIELD ; ...
MOVEI T1,ATMBUF ; get address of atom buffer
HRLI T1,440700 ; make standard byte pointer
CALL ASCR50 ; convert to radix 50
PUSH P,T2 ; save it for a little
CONFRM ; confirm the command
POP P,T2 ; get back the symbol
MOVEM T2,MODNAM ; and save it
RET ; and return
; START - Command Dispatch Routine
;
; This routine will start the test using the data in our
; Utest Data Base
.START: NOISE (Testing)
CONFRM ; confirm command line
LOAD T1,TSTPRG ; is test in progress
SKIPE T1 ; ...
ERET (Test already in progress)
LOAD T1,TSTVLD ; do we have a valid test?
SKIPN T1 ; ...
ERET (No valid Addresses. Use INSERT first)
CALL TOGSTR ; Toggle start the test
RET ; And return
TOGSTR: MOVEI T2,TSTBLK ; get addr of arg blk in t2
MOVE T1,UTBASE ; get test from
MOVEM T1,.UTADR(T2) ; save start of test
MOVE T1,TSTLEN ; and length
MOVEM T1,.UTLEN(T2) ; and save this in arg blk
MOVE T1,[XWD .UTSET,UABLEN] ; start test function
SETONE TSTPRG ; lock the test facility
UTEST ; start the test
RET ; and return
; STOP - Command Dispatch Routine
;
; This routine will stop the MTEST test and update the EXECTUTE
; bit table to reflect the instructions actually executed
.STOP: NOISE (Testing)
CONFRM ; confirm the command
LOAD T1,TSTPRG ; is a test in progress?
SKIPN T1 ; ...
ERET (No test in progress)
CALL TOGSTP ; Toggle stop the test
RET ; And return
TOGSTP: MOVE T1,[XWD .UTCLR,UABLEN] ; stop testing
MOVEI T2,XCTBLK ; get address of argument block
MOVE T3,UTBASE ; get base address
MOVEM T3,.UTADR(T2) ; save the base address
MOVE T3,TSTLEN ; get length of test
MOVEM T3,.UTLEN(T2) ; save the length
UTEST ; ...
SETZRO TSTPRG ; say no test in progress
SETONE TSTDON ; say test is done
RET ; and return
; EXIT - Command Dispatch Routine
;
; This routine will Exit MONTST. It will not let one
; exit unless they have removed all tests
.EXIT: NOISE (Program) ; output noise word
CONFRM ; confirm the command
LOAD T1,TSTPRG ; is a test in progress
SKIPE T1 ; ...
ERET (Test still in progress, Stop test first)
HALTF ; and halt the program
RET ; if continued
; NUMOUT -
;
; This routine will type out a number to the primary output in octal
;
; CALL NUMOUT
;
; ACCEPTS T1 Number to be output
;
; RETURNS +1 Always
NUMOUT: SAVEAC <T1,T2,T3>
MOVE T2,T1 ; Get number in T2
MOVEI T1,.PRIOU ; And output to primary output
MOVEI T3,^D8 ; In octal
NOUT ; ...
ERET () ; problem
RET ; Return
; PRVINI -
;
; Routine initializes WHEEL privileges. If the user does not have
; Wheel privs, this routine will give the +1 Return. If the user
; has Wheel but is not enabled, then this routine will prompt the user
; as to whether wheel should be enabled.
;
; CALL PRVINI
;
; RETURNS +1 Privs not enabled
; +2 WHEEL enabled
PRVINI: SAVEAC <T1,T2>
STKVAR <PRIVS>
MOVEI T1,.FHSLF ; Get our Process Handle
RPCAP ; Read the Capabilities
TXNN T2,SC%WHL ; Is user a Wheel
ERET <Need to be WHEEL>
TXNE T3,SC%WHL ; Is user enabled
RETSKP ; Yes
MOVEM T2,PRIVS ; Save Privs possible
TMSG <You need to be an enabled WHEEL to run this program>
PROMPT (Do You Want to be enabled?)
MOVEI T1,[FLDDB. (.CMKEY,,YESNO)]
CALL CFIELD ; Read field and require confirm
HRRZ T1,0(T2) ; Get RH of keyword parsed
SKIPN T1 ; He said yes
RET ; He doesn't want to enable. Loose
MOVEI T1,.FHSLF ; Get our process handle
MOVE T2,PRIVS ; Get the privs
SETZ T3, ; Clear T3
TXO T3,SC%WHL ; And set WHEEL
EPCAP ; And enable it
RETSKP ; And return success
; PSIINI -
;
; Initialize the PSI system for this process to recieve CONTROL/D
; Interrupts from the terminal which will toggle Start Test, Stop
; Test.
;
; CALL PSIINI
;
; RETURNS +1 Always
PSIINI:
MOVEI T1,.FHSLF ; Get our process Handle
MOVE T2,[LEVTAB,,CHNTAB] ; Get the tables
SIR ; Specify them
EIR ; Enable the interrupt system
MOVE T2,[1B<.ICTOG>] ; Get toggle channel
AIC ; And enable toggle channel
MOVE T1,.TICCD ; Get control d code
MOVEM T1,TOGCHR ; And initialize Toggle character
MOVE T1,[.TICCD,,.ICTOG] ; Assign control D to toggle channel
ATI ; ...
RET ; And return
; TOGGLE - Command dispatch routine
;
; This routine will change the toggle interrupt character
.TOGGL: NOISE (Character is) ; Output noise
MOVEI T1,[FLDBK. (.CMKEY,,TOGKEY,,<>,TOGBRK)]
CALL CFIELD ; Parse the toggle character
MOVE T1,TOGCHR ; Get old toggle character
DTI ; Deassign the interrupt character
HRL T1,0(T2) ; Get New toggle code
HRRI T1,.ICTOG ; And put on .ICTOG channel
ATI ; Assign it
RET ; And finished
; PSITOG -
;
; This routine toggles the tests, if the test is currently on, the test
; is turned off, if the test is currently off, the test is turned on.
; If no valid test, the interrupt quietly goes away.
PSITOG: CALL PSITG0 ; Do the work lower so we have stack ACs
DEBRK ; Debreak when done
PSITG0: SAVEAC <T1,T2,T3,T4> ; Save some ACs
LOAD T1,TSTVLD ; Get test valid flag
SKIPN T1 ; is a test valid
RET ; No valid test
LOAD T1,TSTPRG ; Get test in progress flag
SKIPN T1 ; Is one in progress?
JRST [ CALL TOGSTR ; No, Toggle start it
TMSG <[MTEST Test Started]
> ; output message
RET] ; And return
CALL TOGSTP ; Toggle stop it
TMSG <[MTEST Test Stopped]
> ; output message
RET ; and return
; HELP -
;
; This routine will print out the file MTEST.HLP from device HLP:
; It maps a page at a time to HLPBUF then types it out.
.HELP: STKVAR <HLPBUF,HLPJFN>
CONFRM
MOVX T1,GJ%OLD+GJ%SHT ; GTJFN flags
HRROI T2,[ASCIZ/HLP:MTEST.HLP/] ;Help file
GTJFN ;Get a JFN for it
ERET () ;Some problem
HRRZM T1,HLPJFN ;Save Help JFN
MOVX T2,OF%RD ;Want to read the file
OPENF ;Open it.
ERJMP [MOVE T1,HLPJFN ;Get back jfn
RLJFN ;Release it
JFCL ;Maybe not there
ERET ()] ;And return the error
SIZEF ;Find number of pages in file
ERET () ;some error
MOVN P1,T3 ;Get negative number of pages in P1
HRLZS P1 ;And put in left half (AOBJN Pointer)
CALL FFFPAG ;find first free page in process
RET ;No free pages
MOVEM T1,HLPBUF ;Save page # of help buffer
HLPLOP: HRLZ T1,HLPJFN ;Get source JFN in LH
HRR T1,P1 ;And page in RH
HRLZI T2,.FHSLF ;Get our process handle as destination
HRR T2,HLPBUF ;And get page for help buffer
MOVX T3,PM%RD ;Read only
PMAP ;Map the page
MOVE T2,HLPBUF ;get help buffer page
IMULI T2,1000 ;Find word address
HRROS T2 ;And make pointer to help string
MOVEI T1,.PRIOU ;Output to primary output
MOVEI T3,5000 ;Write out this many bytes
SETZ T4, ;or terminate on NULL byte
SOUT ;output it
SKIPN T3 ;have we encountered a NULL byte
AOBJN P1,HLPLOP ;no, loop till no more pages
SETOM T1 ;unmap the help buffer
HRLZI T2,.FHSLF ;In our process
HRR T2,HLPBUF ;At this address
PMAP
MOVE T1,HLPJFN ;Get back JFN
CLOSF ;And close it
ERET ()
RET
FFFPAG: HRLZI T1,.FHSLF ;Get pointer to page
FFFPG0: RPACS ;Find access
ERJMP [ERET ()] ;Pass down error
TXNE T2,PA%PEX ;Does page exist
AOJA T1,FFFPG0 ;Yes, loop for more
HRRZS T1 ;Clear left half of T1
RETSKP
END <3,,ENTVEC>