diff --git a/README.md b/README.md index 9b66641e..811f076d 100644 --- a/README.md +++ b/README.md @@ -101,6 +101,7 @@ from scratch. - DSKUSE, disk usage information. - LISP, lisp interpreter and runtime library (autoloads only) - COMPLR, lisp compiler + - BINPRT, display information about binary executable file 6. A brand new host table is built from the host table source and installed into SYSBIN; HOSTS3 > using H3MAKE. diff --git a/build/build.tcl b/build/build.tcl index 731b9637..0e14d777 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -524,6 +524,10 @@ respond "*" ":kill\r" respond "*" ":link sys;ts complr,lspdmp;cl.dmp >\r" respond "*" ":link info;complr 1,info;lispc >\r" +# binprt +respond "*" ":midas sys3;ts binprt_sysen1;binprt\r" +expect ":KILL" + # ndskdmp tape respond "*" ":link kshack;good ram,.;ram ram\r" diff --git a/doc/info/binprt.5 b/doc/info/binprt.5 new file mode 100755 index 00000000..2f95e0cc --- /dev/null +++ b/doc/info/binprt.5 @@ -0,0 +1,36 @@ +BINPRT + +:BINPRT + prints out assembly information on a binary file (i.e. "xxx BIN" + or "TS xxx"). If no is specified, the current :PRINT + defaults are used. For example: + +*:BINPRT SYS:TS BINPRT + --- MIDAS Provided Info --- + +Assembled by ALAN on 08/22/81 02:19:54 +Assembled from file MC: SYSEN1; BINPRT 96 + +File Type: SBLK +:KILL +* + + +Switches: + +/A All info (both /D and /T) + +/D Data areas: + For SBLK (Small BLocK--absolute assembly): list of SBLK's specs + Block #, Starting address, and Length of block. + For PDUMP (Page DUMP): Page's purity, writability, and share + +/L Location: where appropriate, shows file location of + certain blocks. This can be used for example to verify + that binary compare failures are due to the MIDAS-provided + info, which varies between assemblies. + +/T Text: prints all constant text strings in program. + +/S Source: Sets DDT's ^R default filename to be the name of + the source file. diff --git a/src/sysen1/binprt.117 b/src/sysen1/binprt.117 new file mode 100755 index 00000000..813db7c1 --- /dev/null +++ b/src/sysen1/binprt.117 @@ -0,0 +1,956 @@ +; -*- 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