!MODIFIED 16.10.80 TO MAKE CALLS ON DMAGIO AND DMAGCLAIM.
!MODIFIED 16.11.79 TO CLAIM TAPE WITH OPTIONAL RING.
OWNINTEGER LOADED
CONSTSTRING (1) SNL="
"
CONSTINTEGER ATRANS = X'80C0008F'
SYSTEMROUTINESPEC OUTFILE(STRING (31) FILE, C
INTEGER SIZE, HOLE, PROT, INTEGERNAME CONAD, FLAG)
EXTERNALROUTINESPEC DEFINE(STRING (255) S)
EXTERNALROUTINESPEC PROMPT(STRING (15) S)
EXTERNALINTEGERFNSPEC DMAGCLAIM(STRING (6) VOL, C
INTEGERNAME SNO, INTEGER REQ, MODE)
EXTERNALINTEGERFNSPEC DMAGIO( C
INTEGERNAME REPLY, CONTROL, LEN, INTEGER TYPE, SNO, ADR)
!*
!*
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 GETNUM(INTEGERNAME I)
INTEGER J, SIGN
AGAIN:
READCH(J) UNTIL ' ' # J # NL
I = 0
-> LHEX IF J = 'X'
IF J = '-' THEN SIGN = -1 AND READCH(J) ELSE SIGN = 1
WHILE ' ' # J # NL CYCLE
UNLESS '0' <= J <= '9' START
READCH(J) UNTIL J = ' ' OR J = NL
-> AGAIN
FINISH
I = 10*I+J&15
READCH(J)
REPEAT
I = SIGN*I
RETURN
LHEX:
READCH(J)
WHILE ' ' # J # NL CYCLE
UNLESS '0' <= J <= '9' OR 'A' <= J <= 'F' START
READCH(J) UNTIL J = ' ' OR J = NL
-> AGAIN
FINISH
IF J > '9' THEN J = J-55 ELSE J = J-48
I = (I<<4)!J
READCH(J)
REPEAT
END ; ! GETNUM
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 = 'E' 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 = 'E' 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
EXTERNALROUTINE PRINTHWDUMP(STRING (255) VOL)
CONSTSTRING (7) DUMPFILE = "T#HDUMP"
CONSTINTEGER SEGSIZE = X'40000'
INTEGER I, N, TRIES
RECORDFORMAT SEGTF(INTEGER STE1, STE2)
RECORD (SEGTF)ARRAYFORMAT SEGTAF(0 : 255)
RECORD (SEGTF)ARRAYNAME PUBLIC SEGMENT TABLE
INTEGER PSTL
INTEGERFN REAL ADDRESS(INTEGER VADDR)
CONSTINTEGER PUBLIC = X'80000000', AVAIL = X'80000000', C
PAGED = X'40000000'
INTEGER SEGNO
RECORD (SEGTF)NAME SEGMENT
SEGNO = (VADDR&X'7FFC0000')>>18
IF VADDR&PUBLIC = 0 START
PRINTSTRING("Not a public address".SNL)
RESULT = -1
FINISH
UNLESS 0 <= SEGNO <= PSTL START
PRINTSTRING("Invalid segment no.".SNL)
RESULT = -1
FINISH
SEGMENT == PUBLIC SEGMENT TABLE(SEGNO)
IF SEGMENT_STE2&AVAIL = 0 START
PRINTSTRING("Segment not available".SNL)
RESULT = -1
FINISH
IF SEGMENT_STE1&X'3FF80' < VADDR&X'3FF80' START
PRINTSTRING("Byte-within-segment too large".SNL)
RESULT = -1
FINISH
RESULT = SEGMENT_STE2&X'FFFFF80'+VADDR&X'3FFFF' C
IF SEGMENT_STE1&PAGED = 0
PRINTSTRING("Paged segment - cannot handle".SNL)
RESULT = -1
END ; ! OF REAL ADDRESS.
INTEGER START, RSTART, DUMPLENGTH, BLOCKLENGTH, FLAG, BASE, CODE, C
SKIP, SNO
INTEGER CONTROL, REPLYFLAG, SAVE
INTEGERARRAY ST, LNGTH(1 : 50)
ROUTINE FAIL(STRING (255) S)
INTEGER DUMMY
PRINTSTRING(S.SNL)
IF LOADED # 0 THEN DUMMY = DMAGCLAIM(VOL,SNO,1,0)
!UNLOAD
MONITOR
STOP
END ; !OF FAIL
PROMPT("TAPE:")
WHILE LENGTH(VOL) < 6 OR LENGTH(VOL) > 7 CYCLE
READCH(I) UNTIL ' ' # I # NL
VOL = TOSTRING(I)
CYCLE
READCH(I)
EXIT IF I = ' ' OR I = NL
VOL = VOL.TOSTRING(I)
REPEAT
REPEAT
FLAG = DMAGCLAIM(VOL,SNO,0,3); !CLAIM WITH RING OPTIONAL
IF FLAG # 0 THEN FAIL("Failure to claim ".VOL)
LOADED = 1; !TAPE LOADED
PROMPT("SKIP BLOCKS:")
READ(SKIP)
IF SKIP > 0 START
CONTROL = 1; !TREAT TAPE MARKS AS BLOCKS
FLAG = DMAGIO(REPLYFLAG,CONTROL,SKIP,8,SNO,0)
!SKIP BLOCKS
UNLESS FLAG = 0 = REPLYFLAG THEN FAIL("Skip fails")
FINISH
OUTFILE(DUMPFILE,SEGSIZE,SEGSIZE,0,BASE,FLAG)
IF FLAG # 0 THEN FAIL("Cannot create dump buffer")
TRIES=0
CYCLE
BLOCKLENGTH = SEGSIZE-1; !CURRENT TAPE SOFTWARE DOES NOT ALLOW FULL SEGMENT
CONTROL = 12; ! Suppress short block and long block indication
FLAG = DMAGIO(REPLYFLAG,CONTROL,BLOCKLENGTH,1,SNO,BASE); ! Read
UNLESS FLAG = 0 = REPLYFLAG START
IF REPLYFLAG = 1 AND BLOCKLENGTH>100000 START ; ! Try backwards read.
BLOCKLENGTH = -BLOCKLENGTH
SAVE = INTEGER(BASE)
FLAG = DMAGIO(REPLYFLAG,CONTROL,BLOCKLENGTH,1,SNO,BASE)
INTEGER(BASE) = SAVE; BLOCKLENGTH = -BLOCKLENGTH
FAIL("Backwards read fails") UNLESS FLAG = 0 = REPLYFLAG
PRINTSTRING("Backwards read required - successful".SNL)
FINISHELSE PRINTSTRING("Read failure")
FINISH
WRITE(BLOCKLENGTH,1)
PRINTSTRING(" BYTES READ (BLOCK MAY HAVE BEEN LONGER)")
NEWLINE
TRIES=TRIES+1
REPEAT UNTIL BLOCKLENGTH>100000 OR TRIES>5
DEFINE("1,.LP,1023")
PROMPT("CODE I/E?")
SKIPSYMBOL WHILE 'I' # NEXTSYMBOL # 'E'
READSYMBOL(CODE)
SKIPSYMBOL WHILE NEXTSYMBOL # NL
PSTL = 256
PUBLIC SEGMENT TABLE == ARRAY(BASE+X'8400',SEGTAF)
N = 0
CYCLE
PROMPT("DUMP FROM BYTE:")
GETNUM(START) UNTIL START <= BLOCKLENGTH
EXIT IF START = 0
RSTART = REAL ADDRESS(START)
CONTINUE IF RSTART=-1; ! Rejection by REAL ADDRESS.
PROMPT("DUMP LENGTH:")
GETNUM(DUMPLENGTH) UNTIL 0 <= DUMPLENGTH <= BLOCKLENGTH- C
START
CONTINUE IF DUMPLENGTH=0
N = N+1
ST(N) = START; LNGTH(N) = DUMPLENGTH
REPEAT
SELECTOUTPUT(1)
I = 0
WHILE I < N CYCLE
I = I+1
START = ST(I); DUMPLENGTH = LNGTH(I)
DUMP(BASE+REAL ADDRESS(START),DUMPLENGTH,START,CODE)
NEWPAGE
REPEAT
FLAG = DMAGCLAIM(VOL,SNO,1,0); !UNLOAD TAPE
SELECTOUTPUT(0)
END ; !OF PRINTHWDUMP
ENDOFFILE