CONSTINTEGER ATRANS = X'80C0008F'
EXTERNALSTRINGFNSPEC INTERRUPT
EXTERNALROUTINESPEC SKIPMT(INTEGER I)
EXTERNALROUTINESPEC DEFINE(STRING (255) S)
EXTERNALROUTINESPEC PROMPT(STRING (15) S)
EXTERNALSTRINGFNSPEC TIME
EXTERNALSTRINGFNSPEC DATE
EXTERNALINTEGERFNSPEC OUTPOS
EXTERNALROUTINESPEC UNLOADMT
EXTERNALROUTINESPEC OPENMT(STRING (7) S)
EXTERNALROUTINESPEC SKIPTMMT(INTEGER I)
EXTERNALROUTINESPEC READMT(INTEGER A, INTEGERNAME L, F)
!*
!*
STRING (15) FN I TO S(INTEGER N)
!**********************************************************************
!* *
!* TURNS AN INTEGER INTO A STRING USES MACHINE CODE *
!* *
!**********************************************************************
STRING (16) S
INTEGER D0, D1, D2, D3
*LSS_N; *CDEC_0
*LD_S; *INCA_1; ! PAST LENGTH BYTE
*CPB_B ; ! SET CC=0
*SUPK_L =15,0,32; ! UNPACK 15 DIGITS SPACE FILL
*STD_D2; ! FINAL DR FOR LENGTH CALCS
*JCC_8,<WASZERO>; ! N=0 CASE
*LSD_TOS ; *ST_D0; ! SIGN DESCRIPTOR STKED BY SUPK
*LD_S; *INCA_1
*MVL_L =15,15,48; ! FORCE IN ISO ZONE CODES
IF N < 0 THEN BYTEINTEGER(D1) = '-' AND D1 = D1-1
BYTEINTEGER(D1) = D3-D1-1
RESULT = STRING(D1)
WASZERO:
RESULT = "0"
END ; !OF STRINGFN I TO S
CONSTBYTEINTEGERARRAY HEX(0 : 15) = C
'0','1','2','3','4','5','6',
'7','8','9','A','B','C','D','E','F'
STRING (8) FN H TO S(INTEGER VALUE, PLACES)
!**********************************************************************
!* *
!* TURNS AN INTEGER INTO A HEXIDECIMAL STRING OF GIVEN LENGTH *
!* USES MACHINE CODE *
!* *
!**********************************************************************
STRING (8) S
INTEGER I
I = 64-4*PLACES
*LD_S; *LSS_PLACES; *ST_(DR )
*INCA_1; *STD_TOS ; *STD_TOS
*LSS_VALUE; *LUH_0; *USH_I
*MPSR_X'24'; ! SET CC=1
*SUPK_L =8
*LD_TOS ; *ANDS_L =8,0,15; ! THROW AWAY ZONE CODES
*LSS_HEX+4; *LUH_X'18000010'
*LD_TOS ; *TTR_L =8
RESULT = S
END ; !OF STRINGFN H TO S
ROUTINE DUMP(INTEGER START, FINISH, CONAD, CODE)
!**********************************************************************
!* *
!* DUMPS AREA SPECIFIED BY START AND FINISH IN HEXIDECIMAL *
!* ACCEPTS PARAMETERS AS START, FINISH OR AS START,LENGTH WITH CONAD *
!* SPECIFYING THE ACTUAL ADDRESS OF THE AREA BEING DUMPED *
!* *
!**********************************************************************
STRING (255) S
INTEGER I, J, ABOVE, ACTUAL START, TAB
IF CODE = 1 THEN TAB = INTEGER(ATRANS)+256; !ADDR ETOI TABLE
!TEST IS TO SEE IF LENGTH< START
FINISH = START+FINISH-1 IF FINISH < START
!MUST MEAN START, LENGTH
START = START&X'FFFFFFFC'
ACTUAL START = START
CONAD = CONAD&X'FFFFFFFC'
FINISH = ((FINISH+4)&X'FFFFFFFC')-1
RETURN IF FINISH < START
ABOVE = 0
-> PRINTLINE; !MUST PRINT FIRST LINE IN FULL
NEXTLINE:
-> PRINTLINE IF FINISH-START < 32
!MUST PRINT LAST LINE
*LDA_START; !CHECK IF SAME AS PREVIOUS LINE
*LDTB_X'18000020'
*CYD_0
*INCA_-32
*CPS_ L = DR
*JCC_7, < PRINTLINE >
ABOVE = ABOVE+1
START = START+32
-> NEXTLINE
PRINTLINE:
IF ABOVE # 0 START
SPACES(50)
IF ABOVE = 1 THEN PRINT STRING(" LINE ") C
ELSE PRINT STRING(I TO S(ABOVE)." LINES")
PRINT STRING(" AS ABOVE".TO STRING(NL))
ABOVE = 0
FINISH
S = "*"
CYCLE I = START,1,START+31
J = BYTEINTEGER(I)
IF CODE = 1 THEN J = BYTEINTEGER(TAB+J); !ETOI VALUE OF J
UNLESS 32 <= J < 127 THEN J = '_'
S = S.TO STRING(J)
REPEAT
S = S."* (".H TO S(CONAD+(START-ACTUAL START),8).") "
CYCLE I = START,4,START+28
S = S.H TO S(INTEGER(I),8)." "
REPEAT
START = START+32
PRINT STRING(S.TO STRING(NL))
-> NEXTLINE UNLESS START > FINISH
END ; ! OF DUMP
ROUTINE FAIL(STRING (255) S)
SELECTOUTPUT(0)
PRINTSTRING(S)
END ; !OF FAIL
EXTERNALROUTINE SHORTANAL(STRING (255) S)
INTEGER LEN, FLAG, COUNT, LAST, TM, I
BYTEINTEGERARRAY IN(1 : 20000)
INTEGER AIN
STRING (15) DUMMYS, OUTFILE, VOL
ROUTINE OUTPUT
RETURN IF COUNT = 0
IF OUTPOS > 60 THEN NEWLINE
WRITE(LAST,6)
PRINTSYMBOL('(')
WRITE(COUNT,1)
PRINTSYMBOL(')')
END ; !OF OUTPUT
DUMMYS = INTERRUPT; !CLEAR ANY INTERRUPT
AIN = ADDR(IN(1))
IF S -> VOL.(",").OUTFILE START
DEFINE("80,".OUTFILE.",1023")
SELECTOUTPUT(80)
FINISH ELSE VOL = S
UNLESS 6<= LENGTH(VOL)<=7 THEN FAIL("INVALID VOL LABEL
") C
AND RETURN
OPENMT(VOL)
LAST = -1; !IMPOSSIBLE LENGTH
COUNT = 0
TM = 1
PRINTSTRING("SHORT ANALYSIS OF TAPE: ".S." ON ".DATE." AT ". C
TIME)
NEWLINES(2)
CYCLE
LEN = 20000
IF INTERRUPT = "STOP" THEN -> INTSTOP
READMT(AIN,LEN,FLAG)
IF FLAG = 0 START
IF LEN = LAST THEN COUNT = COUNT+1 ELSE START
OUTPUT
LAST = LEN
COUNT = 1
FINISH
FINISH ELSE START
IF FLAG = 1 START ; !TAPE MARK
OUTPUT
PRINTSTRING("
TAPE MARK")
WRITE(TM,4)
NEWLINE
TM = TM+1
IF COUNT = 0 START ; !DOUBLE TAPE MARK
PROMPT("CONTINUE Y/N:")
UNTIL I = 'N' OR I = 'Y' THEN READSYMBOL(I)
IF I = 'N' THEN -> DOUBLE TAPE MARK
FINISH
COUNT = 0
FINISH ELSE -> READFAIL
FINISH
REPEAT
DOUBLETAPEMARK:
PRINTSTRING("
DOUBLE TAPE MARK - ANALYSIS ENDS
")
-> ERR
READFAIL:
OUTPUT
FAIL("
READ FAILURE - ANALYSIS ENDS
")
-> ERR
INTSTOP:
NEWLINES(3)
PRINTSTRING("STOP REQUESTED")
NEWLINES(2)
-> ERR
ERR:
UNLOADMT
END ; !OF SHORTANAL
EXTERNALROUTINE DUMPMT(STRING (255) S)
STRING (15) DUMMYS, OUTFILE, VOL
BYTEINTEGERARRAY IN(1 : 24096)
CONSTINTEGER MAXLEN = 20000
INTEGER LEN, FLAG, SKIP, I, CODE, AIN, COUNT, BLOCKS
COUNT = 0
DUMMYS = INTERRUPT; !CLEAR ANY OUTSTANDING INTERRUPT
AIN = (ADDR(IN(1))+4095)&X'FFFFF000'
IF S -> VOL.(",").OUTFILE START
FINISH ELSE OUTFILE = ".LP" AND VOL = S
DEFINE("80,".OUTFILE.",1023")
SELECTOUTPUT(80)
UNLESS 6<= LENGTH(VOL) <=7 THEN FAIL("INVALID VOL LABEL
") C
AND RETURN
OPENMT(VOL)
PRINTSTRING("DUMP FROM TAPE ".VOL." ON ".DATE." AT ".TIME)
NEWLINE
PRINTSTRING("_____________________________________________")
NEWLINES(3)
PROMPT("CODE I/E:")
UNTIL I = 'E' OR I = 'I' THEN READSYMBOL(I)
IF I = 'I' THEN CODE = 0 ELSE CODE = 1;!ISO OR EBCDIC CHAS IN DUMP
PROMPT("SKIP:")
READ(SKIP)
IF SKIP > 0 THEN SKIPMT(SKIP) AND COUNT = SKIP
PROMPT("BLOCKS:")
READ(BLOCKS)
-> ERR IF BLOCKS <= 0
CYCLE I = 1,1,BLOCKS
LEN = MAXLEN
IF INTERRUPT = "STOP" THEN -> INTSTOP
READMT(AIN,LEN,FLAG)
COUNT = COUNT+1
IF FLAG = 2 THEN -> READFAIL
IF FLAG = 1 START
NEWLINES(2)
PRINTSTRING("****TAPE MARK****")
FINISH ELSE START
NEWLINES(2)
PRINTSTRING("BLOCK:")
WRITE(COUNT,1)
PRINTSTRING(" LENGTH:")
WRITE(LEN,1)
PRINTSTRING(" BYTES")
NEWLINES(2)
DUMP(AIN,LEN,0,CODE)
FINISH
REPEAT
-> ERR
READFAIL:
FAIL("READ FAILURE - DUMP ENDS
")
-> ERR
INTSTOP:
NEWLINES(3)
PRINTSTRING("STOP REQUESTED")
NEWLINE
-> ERR
ERR:
UNLOADMT
END ; !OF DUMPMT
ENDOFFILE