!*********************************************************************** !* !* Program to dump virtual memory in EBCDIC !* !* Copyright (C) R.D. Eager University of Kent MCMLXXXI !* !*********************************************************************** ! ! !*********************************************************************** !* !* Constants !* !*********************************************************************** ! constantinteger no = 0, yes = 1 constantinteger outstream = 1; ! Stream for dump output constantstring (1) snl = " " constantbyteintegerarray hex(0:15) = c '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F' ! ! !*********************************************************************** !* !* Record and array formats !* !*********************************************************************** ! recordformat fdf(integer link,dsnum,byteinteger status,accessroute, valid action,cur state,byteinteger mode of use, mode,file org,dev code,byteinteger rec type,flags, lm,rm,integer asvar,arec,recsize,minrec,maxrec, maxsize,lastrec,conad,currec,cur,end,transfers, darecnum,cursize,datastart,string (31) iden) ! ownbyteintegerarrayformat trtf(0:255) ! ! !*********************************************************************** !* !* Subsystem references !* !*********************************************************************** ! systemintegermapspec comreg(integer i) systemroutinespec define(integer chan,string (31) iden, integername afd,flag) systemstringfunctionspec failuremessage(integer mess) systemroutinespec fill(integer length,from,filler) systemstringfunctionspec itos(integer n) systemintegerfunctionspec parmap systemroutinespec setfname(string (63) s) systemroutinespec setpar(string (255) s) externalroutinespec set return code(integer i) systemstringfunctionspec spar(integer n) externalintegerfunctionspec uinfi(integer entry) ! externalroutinespec clear(string (255) s) ! ! !*********************************************************************** !* !* Service routines !* !*********************************************************************** ! integerfunction getval(string (255) s) integer sign,l,c,n,i,j ! l = length(s) result = -1 if l = 0 ! n = 0 sign = 1; ! Positive by default c = charno(s,1) ! if c = 'X' then start ; ! Hexadecimal number result = -1 if l = 1 for i = 2,1,l cycle c = charno(s,i) for j = 0,1,15 cycle -> found if c = hex(j) repeat result = -1; ! Unrecognised digit ! found: n = (n << 4)!j repeat else for i = 1,1,l cycle c = charno(s,i) if c = '-' and i = 1 then start sign = -1 continue finish result = -1 unless '0' <= c <= '9' n = n*10 + c - '0' repeat finish ! result = n end ; ! of getval ! !----------------------------------------------------------------------- ! string (8)function htos(integer value,places) integer i string (8) s ! 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 htos ! ! !*********************************************************************** !* !* E D U M P !* !*********************************************************************** ! externalroutine edump(string (255) parms) integer start,finish,i,j,above integer flag,afd string (31) out string (32) s record (fdf)name f byteintegerarrayname trtab ! setpar(parms) ! if parmap = 1 and spar(1) = "?" then start printstring("Parameters are: start,finish,output".snl) set return code(0) return finish ! unless 3 <= parmap <= 7 then start flag = 263; ! Wrong number of parameters -> err finish ! out = spar(3) if out = "" then out = ".OUT" define(outstream,out,afd,flag) -> err if flag # 0 f == record(afd) f_maxsize = (uinfi(6) + 1)*1024 selectoutput(outstream) ! trtab == array(comreg(11),trtf); ! Address of master EBCDIC to ISO table ! ! Get start and length/finish values ! start = getval(spar(1)) if start = -1 then start setfname(spar(1)) flag = 202; ! Invalid parameter -> err finish finish = getval(spar(2)) if finish = -1 then start setfname(spar(2)) flag = 202; ! Invalid parameter -> err finish ! if finish < start or start < 0 < finish then start ! Start, length intended finish = (finish+(start & x'7FFFFFFF') - 1)!(start & x'80000000') finish ! length(s) = 32 newlines(2) start = start & x'FFFFFFFC' finish = ((finish+4)&x'FFFFFFFC') - 1 if finish < start then start flag = 177; ! Addresses inside out -> err finish ! above = no -> printline; ! First line must be printed in full ! nextline: -> printline if finish - start < 32; ! Must print last line ! ! Compare 32 bytes at 'start' with 32 bytes at 'start'-32: ! *ldtb _x'18000020' *lda _start *cyd _0 *inca _-32 *cps _l =dr *jcc _7,<printline> ! if above = no then start ; ! First line as above in this group above = yes spaces(50) printstring("Lines(s) as above".snl) finish ! start = start + 32 -> nextline ! printline: above = no printsymbol('*') fill(32,addr(s)+1,'_') for i = 32,-1,1 cycle j = trtab(byteinteger(start+i-1)) if 32 <= j < 127 then charno(s,i) = j repeat printstring(s."* (".htos(start,8).") ") for i = start,4,start + 28 cycle printstring(htos(integer(i),8)) spaces(2) repeat start = start + 32 newline -> nextline unless start > finish ! selectoutput(0) closestream(outstream) clear(itos(outstream)) ! set return code(0) stop ! err: selectoutput(0) printstring(snl."EDUMP fails -".failuremessage(flag)) set return code(flag) stop end ; ! of edump endoffile