! FILE 'SYS_DPAL6S'
!************
!* DPAL6S *
!*14.SEP.79*
!************
PERMROUTINESPEC SVC(INTEGER EP, INTEGERNAME P1, INTEGER P2)
PERMINTEGERMAPSPEC INTEGER(INTEGER X)
PERMBYTEINTEGERMAPSPEC BYTEINTEGER(INTEGER X)
PERMINTEGERFNSPEC ADDR(INTEGERNAME X)
PERMINTEGERFNSPEC ACC
CONSTINTEGERNAME DUMMY = 0
BEGIN
RECORDFORMAT SEGF(INTEGER PAR, PDR, PT, X)
RECORDFORMAT PSECTF(INTEGER Q, BYTEINTEGER ID, STATE, C
BYTEINTEGERARRAY NAME(0:3), C
BYTEINTEGER PRIO, INTEGER POFFQ, R0, R1, R2, R3, C
R4, R5, PC, PS, SP, TRPV, RECORD (SEGF) ARRAY SEG(0:7))
RECORDFORMAT PSECT2F(INTEGERARRAY A(0:47))
RECORD (PSECTF) P
RECORD (PSECT2F) NAME P2
CONSTBYTEINTEGERNAME INT CH = K'160060'
OWNINTEGERARRAY MAX(0:7)
OWNINTEGER PERM PRINTED=0
OWNINTEGER EXT BITS = 0
OWNINTEGER PPT = 0
OWNINTEGERARRAY PRIN(0:100)
INTEGER N
RECORDFORMAT D1F(INTEGERNAME X)
RECORDFORMAT D3F(RECORD (PSECTF) NAME P)
RECORD (D1F)D1
RECORD (D3F) NAME D3
ROUTINE DA(INTEGER BLOCK, INTEGERNAME ADD, INTEGER COMM)
CONSTBYTEINTEGERNAME ID = K'160030'
RECORDFORMAT P2F(BYTEINTEGER SER, REPLY, INTEGER A1, C
INTEGERNAME A2, INTEGER A3)
RECORD (P2F)P2
P2_SER = 3; P2_REPLY = ID
P2_A1 = 0
P2_A2 == ADD
P2_A3 = BLOCK
PONOFF(P2)
IF P2_A1 # 0 THEN PRINTSTRING('DISC ERROR
') ANDSTOP
END
INTEGERMAP CONT(INTEGER J)
CONSTINTEGER READ = 0
OWNINTEGERARRAY BUF(0:255)
OWNINTEGER CURR =- 1
INTEGER BNUM, SECTOR, K, L
L = J >> 6
BNUM = (L+EXT BITS)>>3+520+K'020000'; ! + 4672
IF CURR # BNUM START
CURR = BNUM
DA(BNUM, BUF(0), READ)
FINISH
RESULT == BUF((J&511) >> 1)
END
ROUTINESPEC PSECT
ROUTINESPEC DREG
ROUTINESPEC DSTACK
ROUTINESPEC REGISTERS
INTEGERFNSPEC ROCTAL
ROUTINESPEC DUMP(INTEGER LOW, QUANT, DISP)
ROUTINESPEC OCTAL(INTEGER I)
BYTEINTEGERFNSPEC BYTECONT(INTEGER ADR)
ROUTINESPEC VIRT MEMORY
ROUTINESPEC PRINT MESSAGES
ROUTINESPEC GET PSECT(INTEGER B)
CONSTINTEGER PSECT BASE PT = K'130'
CONSTINTEGER LAST32BASE = K'132'
CONSTINTEGER CPUQ BASE = K'124'
CONSTINTEGER TASK LOW LIMIT = 30
CONSTINTEGER TASK LIMIT = 55
INTEGER A, B, C, I, TFLAG, PST, IST, STACK
D3 == D1
P2 == P
PROMPT("Title?")
SELECT OUTPUT(1)
CYCLE
READSYMBOL(I); PRINTSYMBOL(I)
EXIT IF I = NL
REPEAT
PRINTSYMBOL(12); NEWLINE
CYCLE
SELECT OUTPUT(0)
EXT BITS = 0
PROMPT('DPAL:')
SELECT OUTPUT(1)
A = NEXTSYMBOL
IF A = 'T' OR A = 'F' START
! DUMP PSECTS
PRINT MESSAGES IF A = 'F'
B = CONT(PSECT BASE PT)
N = TASK LOW LIMIT
CYCLE
EXITIF N > TASK LIMIT
C = CONT(B)
-> BOT IF C = 0
PRINTSYMBOL(BYTECONT(C+I)) FOR I = 4, 1, 7
SPACE; OCTAL(C); SPACE; OCTAL(CONT(C))
SPACE; OCTAL(CONT(C+2))
PRINTSTRING(' PC = '); OCTAL(CONT(C+K'30'))
NEWLINE
IF A = 'F' START
GET PSECT(N)
PSECT
VIRT MEMORY
PRINTSYMBOL(12)
FINISH
BOT: B = B+2; N = N+1
IF INT CH#0 THEN INT CH=0 AND EXIT
REPEAT
SKIPSYMBOL; SKIPSYMBOL
IF A = 'F' START
PRINTSTRING('KERNAL DATA AREAS
')
DUMP(0, K'1000', 0)
DUMP(K'65', K'5000', 0)
FINISH
CONTINUE
FINISH
IF A = 'P' OR A = 'Q' START ; ! DUMP A PSECT
READSYMBOL(I); IF I = NL THEN PROMPT('PSECT?')
B = ROCTAL; SKIPSYMBOL
GET PSECT(B)
PRINTSYMBOL(12); ! NEWPAGE
NEWLINE
PSECT
IF A = 'Q' THEN VIRT MEMORY
CONTINUE
FINISH
IF A = 'M' START
PRINT MESSAGES
SKIPSYMBOL; SKIPSYMBOL
CONTINUE
FINISH
A = ROCTAL; STOPIF A = 1 OR A = 'S'
READSYMBOL(B); IF B = NL THEN PROMPT('LEN?:')
B = ROCTAL; SKIPSYMBOL
DUMP(A, B, 0)
NEWLINE
REPEAT
ROUTINE DREG
STACK = PST+K'14'
TFLAG = 1
REGISTERS
PRINTSTRING('STACK='); OCTAL(CONT(PST+K'34'))
NEWLINE
END
ROUTINE DSTACK
NEWLINES(2)
DUMP(IST, K'13776', 0)
END
!!
ROUTINE REGISTERS
OWNBYTEINTEGERARRAY REGS(0:15) = C
'R', '0', 'R', '1', 'R', '2', 'R', '3',
'R', '4', 'R', '5', 'P', 'C', 'P', 'S'
INTEGER I
NEWLINE
CYCLE I = 0, 2, 14
PRINTSYMBOL(REGS(I)); PRINTSYMBOL(REGS(I+1))
PRINTSTRING(' = ')
OCTAL(CONT(STACK+I))
SPACES(3)
IF I = 6 THEN NEWLINE
REPEAT
NEWLINE
END
!!
INTEGERFN ROCTAL
INTEGER N, I, J
N = 0
WHILE NEXTSYMBOL < '0' OR NEXTSYMBOL > '7' CYCLE
STOPIF NEXTSYMBOL = 'S'
SKIPSYMBOL
REPEAT
CYCLE I = 1, 1, 6
J = NEXTSYMBOL-'0'
IF J < 0 OR J > 7 THENRESULT = N
N = N << 3+J
SKIPSYMBOL
REPEAT
RESULT = N
END
ROUTINE DUMP(INTEGER LOW, QUANT, DISP)
INTEGER I, J, N, N1, CHAR, NE, ZFLAG, INITF
EXT BITS = LOW&K'6000'; ! LOW IS IN PAGES
LOW = LOW<<6; ! NOW DUMP TOP BITS
ZFLAG = 0; ! SET TO PRINT MESSAGE IF ALL
! ZEROES
INITF = 0; ! TO SUPPRESS N<LOW
N = LOW&X'FFF0'; ! START ON BDRY
WHILE QUANT >= 0 CYCLE
IF INT CH#0 THEN EXT BITS=0 AND RETURN
IF INT CH # 0 START
INT CH = 0; RETURN
FINISH
N1 = N; NE = 8; J = 0
WHILE NE # 0 CYCLE
J = J!CONT(N)
N = N+2; NE = NE-1
REPEAT
IF J = 0 START ; ! ALL ZEROES
IF ZFLAG = 0 START
PRINTSTRING(' ZEROES
')
ZFLAG = ZFLAG+1
FINISH
FINISHELSESTART
ZFLAG = 0; N = N1; ! ENSURE ZFLAG IS OK
OCTAL(N+DISP); PRINTSYMBOL('>')
NE = 8
WHILE NE # 0 CYCLE
IF N >= LOW OR INITF # 0 THEN OCTAL(CONT(N)) C
ELSE SPACES(6)
SPACE
N = N+2; NE = NE-1
REPEAT
PRINTSTRING('*')
NE = 16
WHILE NE # 0 CYCLE
CHAR = BYTECONT(N1)&127
IF CHAR < 32 OR CHAR > 126 THEN CHAR = ' '
PRINTSYMBOL(CHAR)
N1 = N1+1; NE = NE-1
REPEAT
NEWLINE
FINISH
QUANT = QUANT-16
INITF = INITF+1
IF N = 0 START ; ! OVER 32K BDRY
EXT BITS = EXT BITS+K'2000'
FINISH
REPEAT
EXT BITS = 0
END
ROUTINE OCTAL(INTEGER N)
INTEGER I
CYCLE I = 15, -3, 0
PRINTSYMBOL((N >> I)&7+'0')
REPEAT
END
BYTEINTEGERFN BYTECONT(INTEGER ADR)
INTEGER X
X = CONT(ADR&K'177776')
IF ADR&1 # 0 THEN X = X >> 8 ELSE X = X&X'FF'
RESULT = X
END
ROUTINE PSECT
INTEGER I
RECORD (SEGF) NAME SEG
TFLAG = 1
PRINTSYMBOL(BYTECONT(PST+I)) FOR I=4, 1, 7
PRINTSTRING(' STATE = '); OCTAL(BYTECONT(PST+3))
PRINTSTRING(' POFFQ: '); OCTAL(CONT(PST+10))
IF CONT(PST)#0 START
PRINTSTRING(" ON CPU Q, LINK =")
OCTAL(CONT(PST))
FINISH
DREG
PRINTSTRING('SEGMENTS
NO ADDR LEN
')
CYCLE I = 0, 1, 7
IF MAX(I) > 0 START
SEG == P_SEG(I)
WRITE(I, 1); SPACE; OCTAL(SEG_PAR)
SPACE; OCTAL(MAX(I))
SPACES(2)
IF SEG_PDR&7 = 2 THEN PRINTSYMBOL('R') ELSE C
PRINTSYMBOL('W')
NEWLINE
FINISH
REPEAT
END
ROUTINE VIRT MEMORY
INTEGER I, ADD, K
CYCLE I = 0, 1, 7
IF MAX(I) # 0 START
IF I = 1 START
CONTINUE IF PERM PRINTED # 0
PERM PRINTED = PERM PRINTED+1
FINISH
NEWLINES(5)
ADD = P_SEG(I)_PAR
IF ADD = K'7600' THEN CONTINUE
IF PPT # 0 START
CYCLE K = 0, 1, PPT-1
IF ADD = PRIN(K) START
PRINTSTRING("
ALREADY PRINTED
")
->SKIP
FINISH
REPEAT
FINISH
PRIN(PPT) = ADD; PPT = PPT+1
DUMP(ADD, MAX(I), (I << 13)-(ADD<<6))
FINISH
SKIP:
REPEAT
END
ROUTINE PRINT MESSAGES
INTEGER A
A = CONT(LAST32BASE)
CYCLE I = A, K'10', A+128
IF CONT(I) # 0 OR CONT(I+2) # 0 START
WRITE(BYTECONT(I), 3); WRITE(BYTECONT(I+1), 3)
CYCLE B = I+2, 2, I+6
SPACE; OCTAL(CONT(B))
REPEAT
NEWLINE
IF INT CH#0 THEN INT CH=0 AND RETURN
FINISH
REPEAT
END
ROUTINE GET PSECT(INTEGER B)
INTEGER I, N
PST = CONT(CONT(PSECT BASE PT)+(B-TASK LOW LIMIT)*2)
CYCLE I = 0, 1, 47
P2_A(I) = CONT(PST+I*2)
REPEAT
CYCLE I = 0, 1, 7
N = P_SEG(I)_PDR
IF N&7 = 0 THEN N = 0 ELSE N = (N+K'400') >> 2&K'177700'
MAX(I) = N
REPEAT
END
ENDOFPROGRAM