! FILE 'DPAL7S' !***************** !* DPAL7S * !* DA: 05.MAR.81 * !* RL01 * !***************** ! STK = 1400, STRMS = 1 %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 NO CODE = 0; ! 1 - NO CODE DUMPED %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 %INTEGER SER, CM %IF COMM < 0 %START; ! TU58 READ REQUEST SER = 14; CM = 0 %ELSE SER = 3; CM = COMM %FINISH P2_SER = SER; P2_REPLY = ID P2_A1 = CM P2_A2 == ADD P2_A3 = BLOCK PONOFF(P2) %IF P2_A1 # 0 %START SELECT OUTPUT(0) PRINTSTRING("Disc Error ") SELECT OUTPUT(1) INT CH = 'A' %FINISH %END %ROUTINE MOVE DUMP FROM TU58 %INTEGER FROM, TO %OWNINTEGERARRAY BUF(0:255) TO=9301 %CYCLE FROM = 128, 1, 128+256 DA(FROM, BUF(0), -255); ! '-' IS TU58 READ DA(TO, BUF(0), 1); ! WRITE TO RL01 TO = TO+1 %REPEAT PRINTSTRING("DUMP MOVED FROM TU58 TO RL01 ") %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 + 9301; ! WAS 4672 FOR RK05, 9301 FOR RL01 %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) %ROUTINESPEC PRINT ITP DUMP %ROUTINESPEC PRINT BUFF MANAGER %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 PRINTSTRING("TU58 Version - Dump Tape on Unit 1 ") D3 == D1 P2 == P PROMPT("Title?") SELECT OUTPUT(1) %CYCLE READSYMBOL(I); PRINTSYMBOL(I) %EXIT %IF I = NL %REPEAT PRINTSYMBOL(12); NEWLINE %CYCLE INT CH = 0 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 %EXIT %REPEAT SKIPSYMBOL; SKIPSYMBOL %IF A = 'F' %START PRINTSTRING('KERNAL DATA AREAS ') DUMP(0, K'2000', 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 MOVE DUMP FROM TU58 SKIPSYMBOL; SKIPSYMBOL %CONTINUE %FINISH %IF A = 'N' %START NO CODE = NO CODE!!X'FFFF' SKIPSYMBOL; SKIPSYMBOL; %CONTINUE %FINISH %IF A = 'I' %START PRINT ITP DUMP SKIPSYMBOL; SKIPSYMBOL; %CONTINUE %FINISH %IF A = 'B' %START PRINT BUFF MANAGER 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= 0 %CYCLE %IF INT CH#0 %THEN %RETURN 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 %OR NO CODE # 0 PERM PRINTED = PERM PRINTED+1 %FINISH %IF I = 2 %AND NO CODE # 0 %THEN %CONTINUE 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 %INTEGERMAP VM(%INTEGER N) %INTEGER I, J, LEFT, K I = N>>13; ! PICK UP SEG NO LEFT = N&K'17777'; K=LEFT>>6 J = P_SEG(I)_PAR; ! STORE ADDR J = J+K EXT BITS = J&K'6000' %RESULT == CONT(N&K'77'+J<<6) %END %INTEGERFN FIND(%STRINGNAME S) %INTEGER C, B, K,I B = CONT(PSECT BASE PT) %CYCLE K = TASK LOW LIMIT, 1, TASKLIMIT C = CONT(B); B = B+2 %CONTINUE %IF C = 0 %CYCLE I = 1, 1, 4 %IF BYTECONT(C+I+3) # CHARNO(S, I) %THEN ->NO %REPEAT GET PSECT(K) %RESULT = K NO: %REPEAT PRINTSTRING("Can't find:"); PRINTSTRING(S); NEWLINE %RESULT = 0 %END %ROUTINE PRINT ITP DUMP %INTEGERARRAY A(0:119) %INTEGER K, NS %CONSTSTRING (5) ITPS = "ITPS" %CONSTINTEGER FREE DES = K'154130' %CONSTINTEGER FIRST FREE = K'143634' K = FIND(ITPS) %RETURN %IF K = 0 PRINTSTRING(" ITPS Task No of Users = ") WRITE(VM(K'100014'), 1) PRINTSTRING(" List of Free Descriptors ") K = FREE DES %CYCLE NS = 0, 1, 119 OCTAL(K); A(NS) = K %IF NS&15 = 15 %THEN NEWLINE %ELSE SPACE K = VM(K) %EXIT %IF K = 0 %REPEAT PRINTSTRING(" There were"); WRITE(NS, 1); PRINTSTRING(" Free Descriptors Remaining Descriptors Addr Hold Index State Cnsl Tcp Osta Outf ") K = FIRST FREE %CYCLE N = 0, 1, 120 %CYCLE I = 0, 1, NS %IF K = A(I) %THEN -> IGNORE %REPEAT OCTAL(K); PRINTSYMBOL('>') OCTAL(VM(K)) WRITE(VM(K+6)&X'FF', 3) WRITE(VM(K+2), 3) WRITE(VM(K+10)>>8, 6) WRITE(VM(K+8)>>8, 5) WRITE(VM(K+4), 5) WRITE(VM(K+6)>>8, 5) SPACES(3); OCTAL(VM(K+34)) NEWLINE IGNORE: K = VM(K) %REPEAT NEWLINES(5) %END %ROUTINE PRINT BUFF MANAGER %INTEGER I, J, K, L, M, B, C, BASE, NB, NS, BASEA, INC, START %INTEGER L3 %INTEGERARRAY BA, SA(0:100) %CONSTSTRING (5) BUFF = "BUFF" K = FIND(BUFF) %RETURN %IF K = 0 PRINTSTRING("BUFF MANAGER ="); WRITE(K, 1); NEWLINE %IF P_SEG(4)_PDR # 0 %START L = 4; BASE = P_SEG(4)_PAR; BASEA = K'100000' START = K'102700'; INC = K'20' PRINTSTRING("3 Seg BUFF Man ") %ELSE L = 5; BASE = P_SEG(5)_PAR; BASEA = K'120000' START = K'122600'; INC = K'100' PRINTSTRING("2 Seg BUFF Man ") %FINISH EXT BITS = BASE&K'6000' BASE = BASE<<6 PRINTSTRING("No of Big Buff =") WRITE(CONT(BASE+K'112'),3) PRINTSTRING(" No of small Buff =") WRITE(cont(base+k'114'),3) newline PRINTSTRING("Least Big"); WRITE(CONT(BASE+K'120'), 3) PRINTSTRING(" Least Small"); WRITE(CONT(BASE+K'122'), 3) I = CONT(BASE+K'110') %IF I#0 %START PRINTSTRING(" ** There are"); write(i, 1) PRINTSTRING(" requests outstanding") %FINISH I = CONT(BASE+K'116') %IF I # 0 %START PRINTSTRING(" ** Total requests queued were") WRITE(I, 1) %FINISH NEWLINES(2) PRINTSTRING("Big Buffer Pool ") K = CONT(BASE+K'104') OCTAL(K); BA(0) = K %IF K # 0 %START %CYCLE NB = 1, 1, 100 %IF NB&15=15 %THEN NEWLINE %ELSE SPACE K = VM(K) BA(NB) = K OCTAL(K) %EXIT %IF K = 0 %REPEAT PRINTSTRING(" There are "); WRITE(NB, 1); PRINTSTRING(" Big buffers ") %FINISH PRINTSTRING(" Small Buffer Pool ") K = CONT(BASE+K'106') OCTAL(K); SA(0) = K %IF K # 0 %START %CYCLE NS = 1, 1, 100 %IF NS&7 = 7 %THEN NEWLINE %ELSE SPACE K = VM(K) SA(NS) = K OCTAL(K) %EXIT %IF K = 0 %REPEAT PRINTSTRING(" There are "); WRITE(NS, 1); PRINTSTRING(" Small buffers ") %FINISH PRINTSTRING(" The rest of the buffers ") K = START %CYCLE L3 = VM(K+2)>>8 %CYCLE I = 0, 1, NS %IF SA(I) = K %THEN ->IGNORE %REPEAT %CYCLE I = 0, 1, NB %IF BA(I) = K %THEN -> IGNORE %REPEAT ! NOT ON FREE LIST NEWLINE OCTAL(K);PRINTSYMBOL('>') OCTAL(VM(K)); SPACE; OCTAL(VM(K+2)&X'FF') SPACE; OCTAL(L3) SPACES(3) %CYCLE I = 4, 2, 16 OCTAL(VM(K+I)); SPACE %REPEAT IGNORE: %RETURN %IF INT CH # 0 %IF L3 = 0 %THEN INC = K'400' K = K+INC %EXIT %IF K >= K'160000' %REPEAT NEWLINES(3) %END %ENDOFPROGRAM %INTEGERFN FIND(%STRINGNAME S) %REPEAT %IF L3 = 0 %THEN INC = K'400' %REPEAT