; -*- MIDAS -*- TITLE BINPRT -- Print info in random info block of bin files ; Canonical source location is ; [MIT-MC] SYSEN1;BINPRT > ; Info file is ; [MIT-MC] INFO;BINPRT > ;;; Alan 1/11/85 ;;; Interaction with DDT's ^R defaults now resembles an ordinary DDT ;;; command as much as possible. There is also some hairy defaulting, ;;; and the ^R names are updated. ;;; Also added /S to set ^R names to source file if possible. ;;; Devon 4/26/83 ;;; Made it understand SYS: to search DSK:SYS*; ;;; KLH 11/12/82 ;;; Added /L to also print location of blocks in file. ;;; Alan 8/22/81 ;;; 1) If no filename is given in JCL then the DDT ^R default is ;;; used if possible. ;;; 2) Checksum errors are no longer fatal. ;;; 3) I left the text finding hack (the /T switch) slightly smarter. ;;; 4) I fixed a bug that was only to be found here in the source not in ;;; the installed object. I take no responsibilty for any bugs ;;; introduced by installing the only available source. Piss on ;;; RWK if something breaks because of this. a=1 b=2 c=3 d=4 e=5 f=6 ch=7 t=10 tt=11 p=17 binc=16 tyoc=15 outc=14 tyic=13 call=pushj p, ret=popj p, pdllen=100 define syscal op,args .call [setz ? sixbit /OP/ ? args ((setz))] termin argi=1000,,0 val=2000,,0 errv=3000,,0 cnt=4000,,0 cnti=5000,,0 define type &string move t,[440700,,[asciz string]] movei tt,<.length string> .call typblk .lose %lsfil termin define OUT &string move t,[440700,,[asciz string]] call $out termin loc 40 0 0 -intlng,,tsint loc 100 tsint: p %pimpv ? 0 ? -1 ? -1 ? mpvint 0 ? <1_tyoc>\<1_outc> ? -1 ? -1 ? morint intlng==.-tsint pdl: [.lose 1+.lz %pipdl] ;PDL underflow block pdllen $$RFN==1 ;We want the RFN routine $$PFN==1 ;We want the PFN routine $$SWITCH==1 ;Recognize switches IFBLK:: ;; In RFN ordering ifdev: 0 iffn1: 0 iffn2: 0 ifdir: 0 OFBLK:: ;; In RFN ordering ofdev: 0 offn1: 0 offn2: 0 ofdir: 0 TFBLK:: ;; In RFN ordering tfdev: 0 tffn1: 0 tffn2: 0 tfdir: 0 C.RBLK:: ;; In random DDT ordering c.rdev: sixbit /DSK/ c.rdir: 0 ; Filled in with SNAME c.rfn1: sixbit /FOO/ c.rfn2: sixbit /BIN/ sname: 0 ; Filled in with SNAME option: 0 ; %OP bits .insrt syseng;rfn > rsixtp: psixtp: cain a,"( ;( starts switches aos (p) caie a,"/ cain a,"_ ;_ is special aos (p) ; we skip ret switch: caie a,"a cain a,"A jrst allset ; Turn on all switches caie a,"l cain a,"L jrst locset ; Turn on switch for file-location format caie a,"s cain a,"S jrst srcset caie a,"d cain a,"D jrst datset ; Turn on switch for data area info caie a,"t cain a,"T jrst txtset ; Turn on switch for de-controlified type \AUnknown switch --/\ .iot tyoc,a type / / .logout 1, allset: call datset call txtset ret locset: setom locsw ret srcset: setom srcsw ret datset: setom datasw ret txtset: hllos textsw ;turn on rh, to indicate we want it. setom flast ;start out as if having flushed non-text movni t,-5 movem okcnt ret $$out==1 ;we want time output routines .insrt syseng;datime > go: move p,[-pdllen,,pdl] syscal OPEN,[cnti .uao\%tjdis ? argi tyoc ? [sixbit /TTY/]] .lose %lsfil syscal OPEN,[cnti .uai ? argi tyic ? [sixbit /TTY/]] .lose %lsfil .suset [.roption,,a] tlo a,%opint\%opopc move tt,[-4,,[ .soption,,a .smask,,[%pimpv\%pipdl] .smsk2,,[1_tyoc\1_outc] .rsname,,b ]] .suset tt movem a,option movem b,c.rdir movem b,sname tlne a,%opbrk .break 12,[..rpfi,,c.rblk] tlnn a,%opcmd jrst endjcl setzm jclbuf move tt,[jclbuf,,jclbuf+1] blt tt,jclbuf+ljclbuf-1 .break 12,[..rjcl,,jclbuf] move d,[440700,,jclbuf] movei b,ifblk ; Probably there are input filenames. call rfn"rfn caie a,"_ ; Was that actually the output filenames? jrst endjcl ; No: All done with JCL move tt,[ifblk,,ofblk] ; Yes: OK, so we put them in the wrong blt tt,ofblk+3 ; place. Put them in the right place. repeat 4, setzm ifblk+.rpcnt ; Clear the old place. movei b,ifblk ; And go get the real input names. call rfn"rfn jrst endjcl define default ac,loc skipn loc movem ac,loc termin sysdrs: irp dir,,[SYS,SYS1,SYS2,SYS3] sixbit /dir/ termin lsysdrs==:.-sysdrs endjcl: move a,c.rdev skipe ifdir ; If he typed a directory, default input movsi a,(sixbit /DSK/) ; device to "DSK". default a,ifdev move a,c.rdir default a,ifdir move a,c.rfn2 skipe iffn1 ; If he typed a FN1, default FN2 to "BIN". movsi a,(sixbit /BIN/) default a,iffn2 move a,c.rfn1 default a,iffn1 movsi a,(sixbit /TTY/) ; Default device to "TTY". skipe ofdir ; Unless he typed a directory, in which movsi a,(sixbit /DSK/) ; case use "DSK" default a,ofdev move a,sname ; Default directory to our SNAME default a,ofdir move a,iffn1 ; Default FN1 to input FN1 default a,offn1 move a,[sixbit /BININF/] ; Default FN2 to "BININF". default a,offn2 movei b,ifblk ;So FLOSS knows what to print move d,ifdev hrroi e,ifdir ; [-1,,ifdir] came d,[sixbit /SYS/] jrst openlp movsi d,(sixbit /DSK/) move e,[-lsysdrs,,sysdrs] openlp: syscal open,[cnti .uii ? argi binc ? d ? iffn1 ? iffn2 ? (e) ? errv c] jrst [ cain c,%ensfl aobjn e,openlp jrst floss] move a,option tlnn a,%opbrk jrst openo movem d,c.rdev move a,(e) movem a,c.rdir move a,iffn1 movem a,c.rfn1 move a,iffn2 movem a,c.rfn2 .break 12,[..spfi,,c.rblk] openo: movei b,ofblk syscal open,[cnti .uao ? argi outc ? ofblk ? [sixbit /_BINPR/] [sixbit /OUTPUT/] ? ofblk+3 ? errv c] jrst floss setzm bufcnt ;note our input buffer is empty movsi a,-1 ;we want one word call getwrd ;get one word call badfil ; Not binary? skipe datasw ;are we into displaying the data area? jrst ndatp1 ;No data area display move c,outptr ;type info starts here movem c,typptr out / File Type: / jumpe a,pdumpt ;If first word non-zero it's a SBLK file out /SBLK / jrst ndatp1 ;Otherwise pdumpt: out /PDUMP / ndatp1: setz c, idpb c,outptr ;mark end of type field ndatp2: jumpe a,pdumpf ;if first word 0, it's a pdump file skipn datasw ;Are we into displaying the data area? jrst rrim10 ; No, get to work on it right now move c,outptr ;Mark start of data area movem c,datptr out / -- Data Area -- File Type: SBLK SBLK # Start Address Size / rrim10: camn a,[jrst 1] ;JRST 1 ends RIM10 loader jrst rsblk ; At start of SBLK movsi a,-1 ;get 1 word call getwrd call badfil ; Not binary? jrst rrim10 ;try again rsblk: setzm page ;Counts SBLK's rsblk0: setzm chksum ;starting checksum afresh movsi a,-1 ;get AOBJN ptr for SBLK call getwrd ;get the word call badfil ; huh? jumpge a,start ;if 0 or positive, is the start instruction skipn datasw ;Are we into printing the data? jrst rsblk1 ; no, don't calculate it skipe locsw ; Wants to know file loc too? jrst [ call locprt ; Print it out /: / jrst .+1] aos t,page call decprt movei t,^I ;Tab over idpb t,outptr hrrz t,a ;Get start address call octprt movei t,^I ;Tab over idpb t,outptr idpb t,outptr hlre t,a ;Get length movns t call octprt out/ / rsblk1: move t, call datblk ;get each word in the block call badfil move b,chksum ;get the checksum for that block movsi a,-1 ;get the checksum from the file call getwrd call badfil came a,b ;are they equal? call chkerr ; no, note that we may be losing... jrst rsblk0 ; yes, it:s ok, get next SBLK chkerr: type /AChecksum error encountered. / ret start: setz ch, idpb ch,outptr start0: movsi a,-1 ;get AOBJN ptr for whatever setzm chksum ;initialize the checksum call getwrd jrst endfil ; end of file, no information jumpge a,endfil ;end of file? hrrz b,a ;get the type of info cain b,3 ;is it our cup of tea? jrst binfo ; yes, hack it call getwrd ;no, gobble it down call badfil ; not supposed to end in middle of SBLK chkchk: move b,chksum ;get our computed checksum movsi a,-1 ;get the checksum from the file call getwrd call badfil came a,b ;are they equal? call chkerr ;no, tell him. jrst start0 ;try next block. binfo: hllz b,a ;B <- AOBJN to outer block movsi a,-1 ;get AOBJN ptr to inner block call getwrd call badfil ; ending in the middle, lose! add b,[1,,0] ;account for that word hrrz c,a ;C <- type for inner block hllzs a ;A <- AOBJN for inner block sub b,a ;keep count of total words cain c,1 ;is this MIDAS's output? jrst mbinf ; yes, print it out call getwrd ;unknown, ignore it call badfil infchk: jumpl b,binfo ;if there's more to read, read it caile b, call badfil ;if they don't match up, complain! jrst chkchk ;go check the checksum and handle any ;more SBLK's ;;;comes here at the start of a block of midas-output info. ;;;A contains -,,0 ;;;B must be preserved. mbinf: push p,b ;B must be conserved move b,outptr ;this is the start of our info movem b,midptr move b,a ;Use B as our counter out / --- MIDAS Provided Info --- / skipe locsw jrst [ out / From file locs / call locprt move a,t ; Save value out /-/ movei t,7(a) ; 6 words plus header call octprt jrst .+1] movsi a,-1 ;get one word call getwrd ;get the word call badfil ; urk! out / Assembled by / call 6type ;type that word out out / on / movsi a,-1 ;get the next word call getwrd call badfil push p,b ;DATIME frob clobbers B move d,[440700,,jclbuf] call datime"twdasc move t,[440700,,jclbuf] ;send the date down call $out pop p,b ;restore B out / Assembled from file / movsi a,-1 ;get the device call getwrd call badfil movem a,tfdev movem a,c.rdev movsi a,-1 ;SNAME call getwrd call badfil movem a,tffn1 movem a,c.rfn1 movsi a,-1 ;FN1 call getwrd call badfil movem a,tffn2 movem a,c.rfn2 movsi a,-1 ;FN2 call getwrd call badfil movem a,tfdir movem a,c.rdir move a,option tlne a,%opbrk skipn srcsw skipa .break 12,[..spfi,,c.rblk] push p,b ;Need B for PFN movei b,tfblk move d,[440700,,jclbuf] call rfn"pfn ;cons up printing of name move t,[440700,,jclbuf] ;type the stuff in the JCLBUF call $out out / / pop p,b ;recover our B add b,[6,,0] ;account for words we've used move a,b ;and let's gobble down the rest call getwrd call badfil pop p,b ;recover outer block's B setz ch, ;mark end of this string idpb ch,outptr jrst infchk endfil: call outfrc syscal renmwo,[argi outc ? ofblk+1 ? ofblk+2] ;try to assign final jfcl ;names .close outc, .logout 1, outfrc: move a,ofblk ;check to see if we're talking to our TTY move t,[440700,,txtbuf] skipl txoptr ;If there has been any text found movem t,txtptr ; set up to output it move t,midptr ;output the various info call $type ; . move t,typptr ; . call $type ; . move t,datptr ; . call $type ; . move t,symptr ; . call $type ; . skipn textsw ret move t,[440700,,[asciz / --- Text Strings --- /]] skipl txoptr ;If there was any text found call $type ; type the header move t,txtptr skipl txoptr call $type ; and the text move t,[440700,,[asciz / /]] call $type ret $type: setz tt, push p,t ;save it to use another day $type1: ildb ch,t skipe ch ;until the end of the string aoja tt,$type1 ; count the chars pop p,t ;get pointer again syscal siot,[argi outc ? t ? tt] ;output it .lose %lsfil ret pdumpf: skipn datasw ;are we into displaying data? jrst pdump0 move c,outptr ;Mark start of data area movem c,datptr out / -- Data Area -- File Type: PDUMP Page Type Shared With Writable / setzm page ;page counter pdump0: move b,[-400,,filbuf+1] ;256 entries in the page map setz c, ;count data pages pdump1: move a,(b) ;get the map word tdnn a,[700000,,600000] ;non-existant? jrst pdump9 ; yes, ignore it skipn datasw ;are we into printing the data areas? jrst pdump8 ; no, don't calculate display move t,page ;print page number call octprt ;print it movei t,^I ;tab over idpb t,outptr tlne a,400000 ;absolute? jrst [out /System / jrst pdump5] tlne a,100000 ;Shared with other page? jrst [out \Shared w/ page \ jrst pdump5] tlne a,200000 ;copied? jrst [out /Unshared / jrst pdump5] trne a,400000 ;is it impure? jrst [out /Impure / jrst pdump4] ; no "shared with" trne a,200000 ;Is it at least readable? jrst [out /Pure / jrst pdump4] ; no "shared with" out /Weird!! / ;Shouldn't get here! hlrz t,a ;print lh,,rh for sake of debugging call octprt out /,,/ hrrz t,a call octprt movei t,^I ;tab over one idpb t,outptr jrst pdumpx ;and continue parsing pdump4: out /---/ ;No "shared with" jrst pdump6 pdump5: move t,a andi t,777 ;page # shared with call octprt ;print it pdump6: movei t,^I ;tab over two idpb t,outptr idpb t,outptr pdumpx: tlnn a,400000 ;If system page trnn a,400000 ; Or pure jrst pdump7 ; go say NO out /Yes / jrst pdump8 pdump7: out /No / pdump8: tlne a,600000 ;absolute or shared? jrst pdump9 ; yes, doesn't have data page trne a,600000 ;exists? aos c ; yes, count it pdump9: aos page ;count pages aobjn b,pdump1 ;do it for all pages in the map aos c ;count the initial page push p,c ;remember page count skipn textsw ;are we looking for text? call ptext ; yes, go hack text pop p,c ;recover page count setzm bufcnt ;invalidate the buffer lsh c,12 ;convert to word number .access binc,c ;get ready to read after last data page movsi a,-1 ;and read the start instruction call getwrd call badfil caige a, call badfil ;must be positive or 0 jrst start ;and handle as SBLK from starting adress ptext: movei c,1 ptext0: .access binc,c ;start on the first page move t,[444400,,filbuf] movei tt,2000 syscal siot,[argi binc ? t ? tt] ;read in the page .lose %lsfil caie tt, call badfil ;if EOF, die. move t,[-2000,,filbuf+1] ptext1: call texthk aobjn t,ptext1 ret getblk: syscal rfpntr,[argi binc ? movem bufloc] ; Get current file loc .lose %lsfil move t,[444400,,filbuf] movei tt,2000 syscal siot,[argi binc ? t ? tt] .lose %lsfil subi tt,2000 jumpe tt,cpopj2 ;EOF if can't get anything at all hrls tt hrri tt,filbuf movem tt,bufcnt ;BUFCNT gets AOBJN ptr into buffer move t,tt ;And T gets a copy too. ret cpopj2: sub p,[1,,1] ;return from caller ret getwrd: jumpge a,popj1 ;return immediately if none requested skipl t,bufcnt ;Get count of words in buffer call getblk ; out, get more move tt,chksum ;get old checksum rot tt,1 ;and compute new checksum add tt,(t) movem tt,chksum add t,[1,,1] ;account for that word movem t,bufcnt skipge textsw ;is TEXTSW full on? call texthk ; yes, hack text aobjn a,getwrd ;get next word if wanted move a,-1(t) ;get that word popj1: aos (p) cpopj: ret ;and return it datblk: skipe textsw ;are we hacking text? hrros textsw ; yes, turn on TEXTSW all the way call getwrd ;hack the stuff caia ; eof, don't skip aos (p) hrrzs textsw ;half-turn-off TEXTSW ret texthk: movei tt,-1(t) ;TT <== pointer to word just hacked move ch,(tt) trne ch,1 ;if low bit set, can't be ascii! jrst tflush ;jcall hrli tt,440700 ;make Byte Pointer to it ildb ch,tt ;get first char call termp ;do whatever with this char ildb ch,tt call termp ildb ch,tt call termp ildb ch,tt call termp ildb ch,tt call termp ret termp: cain ch,^M jrst ter.m cain ch,^J jrst ter.j setzm terflg ;note last char not ^M cain ch,^L jrst ter.l cain ch,^P ;Is it a ^P? jrst termp0 ; yes, it might be cursor control cail ch,40 ;real cain ch,177 ; not rubout? jrst tflush ; no, flush termp0: setzm flast ;This one was not flushed setzm terflg ;and not CR either idpb ch,@tttptr ;send output down whichever pointer aose okcnt ;have there been enough to call this a ;string? ret ; no change of state jrst nowok ;yes, it's now OK, make the switch ter.m: skipe flast ;was last one flushed? ret ; yes, so this must be garbage setom terflg ;note last char was ^M ret ter.j: skipn terflg ;was last thing a ^M? jrst tflush ; no, must be garbage setzm terflg ;last was not ^M movei ch,^M ;send down a idpb ch,@tttptr ;send output down whichever pointer movei ch,^J jrst termp0 ter.l: skipn flast ;was the last thing flushed? idpb ch,@tttptr ; No, send this down after it jrst termp0 nowok: move ch,@tttptr ;get the pointer we've been using movem ch,txoptr ;and make it the real output pointer movei ch,txoptr ;and continue using the real output pointer movem ch,tttptr ;for the rest of this string ret tflush: skipe flast ;have be already been flushing? ret ; yes. setom flast ;note that we're flushing movei ch,". ;output an elipsis idpb ch,@tttptr idpb ch,@tttptr idpb ch,@tttptr ; movei ch,^M ; idpb ch,@tttptr ; movei ch,^J ; idpb ch,@tttptr move ch,txoptr ;and flush if we haven't made it permanent movem ch,tmpptr ;by making the temp pointer same as perm movei ch,tmpptr ;and make it use the temp pointer again movem ch,tttptr movn ch,strcnt ;CH <== -<# alpahbetics needed for string> movem ch,okcnt ;and reset counter to require that many ret mpvint: push p,a ;an AC to use move a,-1(p) ;get PC hlrz a,(a) ;get instruction andi a,777000 ;isolate opcode caie a,(idpb) ;only IDPB is legal to create page jrst mpvlos ; Lossage! .suset [.rmpva,,a] ;A gets address lsh a,-12 ;turn into page # syscal corblk,[cnti %cbndw\%cbndr ? argi 0 argi %jself ? a ? argi %jsnew] .lose %lssys pop p,a dismis: syscal dismis,[p] .lose %lssys mpvlos: move a,-1(p) ;get PC hrlm a,intwrd pop p,a syscal dismis,[p ? (p) ? 0,,-1(p) ? 0,,-2(p) ? intwrd] .lose %lssys morint: push p,t push p,tt push p,a push p,ch type /HL--MORE--/ .iot tyic,a caie a,40 ;More? jrst [type /HL--FLUSHED-- / jrst delewo] type / / pop p,ch pop p,a pop p,tt pop p,t jrst dismis 6type: move tt,a ;copy word for shifting movei ch,^Q 6type1: setz t, ;clear character frob lshc t,6 ;get first character addi t,40 ;convert to ascii cain t,40 ;space? idpb ch,outptr idpb t,outptr ;and output it jumpn tt,6type1 ;and keep typing until end of frob ret ;all done ;;; LOCPRT - Type current file location in octal. ;;; Loc is that of word last read by getwrd. ;;; Leave in T. locprt: hrrz t,bufcnt subi t,filbuf+1 ; Get offset in buffer (allow for wd just read) add t,bufloc ; Get offset in file push p,t call octprt pop p,t ret ;;; type T in OCTAL octprt: setz tt, lshc t,-3 ;shift instead of IDIVI, don't forget lsh tt,-41 ;negative! push p,tt ;push remainder skipe t ;done? call octprt ;no compute next one octpn1: pop p,tt ;yes, take out in opposite order addi tt,60 ;make ascii idpb tt,outptr ret ;and return for the next one. decprt: call decpr0 ;Type the number movei t,". ;and end with a . so we know it's decimal idpb t,outptr ret decpr0: idivi t,10. push p,tt ;push remainder skipe t ;done? call decpr0 ;no, compute next one jrst octpn1 ;then print this and previous ones $out: ildb tt,t ;get a char jumpe tt,cpopj ;null ==> end idpb tt,outptr ;send it down the B.P. jrst $out badfil: call outfrc type /AError in file format - may not be binary file? / jrst delewo noinfo: call outfrc type /ANo Info in file. / jrst delewo floss: move a,[asciz /A/] movem a,jclbuf move d,[260700,,jclbuf] call rfn"pfn setz a, move d,[440700,,jclbuf] floss1: ildb b,d skipe b aoja a,floss1 move d,[440700,,jclbuf] syscal siot,[argi tyoc ? d ? a] .lose %lsfil type / -- / syscal open,[cnti .uai ? argi binc ? [sixbit /ERR/] ? argi 4 ? c] .lose %lsfil move a,[440700,,jclbuf] movei b,500 syscal siot,[argi binc ? a ? b] .lose %lsfil setz a, ;Do it this way to flush trailing ^L lossage move d,[440700,,jclbuf] floss2: ildb b,d skipe b cain b,^L jrst floss3 caie b,^C aoja a,floss2 floss3: move d,[440700,,jclbuf] syscal siot,[argi tyoc ? d ? a] .lose %lsfil type / / .logout 1, delewo: syscal delewo,[argi outc] .logout 1, .logout 1, typblk: setz ? sixbit /SIOT/ ? argi tyoc ? t ? setz tt page: 0 intwrd: 0,,1+.lz %pimpv ljclbuf==:100 jclbuf: block ljclbuf -1 locsw: 0 ;-1 ==> Include file-location info in printout srcsw: 0 ;-1 ==> Set ^R names to source file names datasw: 0 ;-1 ==> Print data areas textsw: 0 ;-1 ==> Print text chksum: 0 ;our running computed checksum bufloc: 0 ; Loc in file that current buffer came from bufcnt: 0 filbuf: block 2000 tttptr: tmpptr ;IDPB CH,@'d through, either ;through the temporary pointer or ;through the permanent pointer when ;it is determined that it is a bona-fide ;text string tmpptr: 440700,,txtbuf txoptr: 440700,,txtbuf okcnt: 0 strcnt: 5 ;count of alphabetics needed to output terflg: 0 ;-1 means last char was CR flast: 0 ;-1 means we flushed the last char variables constants ;;; **** No literals or variables after this point **** nil: 0 outptr: 440700,,outbuf ;ILDB ptr for our output midptr: 440700,,nil ;ptr to the block of MIDAS info typptr: 440700,,nil ;pointer to the type line datptr: 440700,,nil ;pointer to the page/sblk description symptr: 440700,,nil ;pointer to the info on the symbol table txtptr: 440700,,nil ;pointer to ascii text found outbuf: ;buffer for our output info. txtbuf=:400000 ;upper core is text buffer end go