.TITLE CPA - CRASH POOL ANALYZER .IDENT /JN3.20/ .LIST MEB ; Need to see all code for debugging .ENABL LC ; Allow lower-case I/O and listing ; Last modified 800420. ; Written by J. Neeland ; Modified 27-Jan-80 by Wayne R. Graves ; Run on 3.2 & from crash dumps ; Protection from writing out of map area ; Handle the null task properly ; Increased vcb label by 6 words ; Increased tcb label by 4 words ; Use FCS for listing rather than QIO's (output to a file) ; Added mount control blocks ; Added checkpoint pcb ; Added minor tests for validity of data ; Corected size of window blocks ; Added support for Stammerjohn's vd: driver ;MODIFIED 800419. BY J. NEELAND TO BE APPROX. EQUIV TO OPA (ONLINE ; POOL ANALYZER) ; .MCALL QIOW$,DIR$,EXIT$S .MCALL F11DF$,UCBDF$,DCBDF$,TCBDF$,PCBDF$,SCBDF$ ; ; ; define lun to be used for gcml INLUN=1 ; Lun for input file OUTLUN=2 ; Lun for output file GCMLUN=4 TILUN=5 ; Terminal lun TIEVF=5 ; Terminal event flag ; .MCALL FSRSZ$,FDBDF$,FDRC$A,FDBK$A,FDOP$A,NMBLK$,FDAT$A,FDOF$L .MCALL GCMLB$,GCML$,CSI$,CSI$1,CSI$2,CSI$SW,CSI$ND .MCALL FINIT$,OPEN$R,CLOSE$,READ$,WAIT$,OPEN$W,PUT$S ; .MACRO MSGOUT MESSAG .NLIST .PSECT $$$MSG $$$=. .ASCIZ ^MESSAG^ .PSECT .LIST CALL OUTMSG .WORD $$$ .ENDM ; F11DF$ UCBDF$ DCBDF$ TCBDF$ SCBDF$ ; MAXFRG=100. ; Max # of pool fragments handled HEMSK=1 ; /HE switch mask POLSIZ=120000 ; Area reserved for copy of EXEC, up to ; top of pool FIRSTH=51000 ; Size of first large chunk to read FIRSTB=FIRSTH/512. ; Number of blocks in firsth SECONH=44000 ; Second large chunk to read SECONB=SECONH/512. ; Number of blocks in second chunk VECSIZ=512. ; Size of vector area to read in ; Should be on a block boundry ; ; buffer ; bufi0=2000 .BLKB POLSIZ ; Leave space for copy of EXEC including POOL ; CPA:: ; Entry point for Crash Pool Analyzer CALL GCMLIN ; Go asn file names .NLIST MEB ; Don't expand FCS calls MOV #1,BKVB+2 ; Initialize block number READ$ #FDB,#BUFI0,#VECSIZ,#BKVB ; get a buffer full BCC 10$ ; If C set error IOT 1 10$: WAIT$ #FDB,#10.;,IOST BCC 20$ ; If C set error IOT 2 20$: ADD #/512.,BKVB+2 ; Skip block 2-3 READ$ #FDB,#BUFI0+VECSIZ,#FIRSTH,#BKVB ; get a buffer full BCC 15$ ; If C set error IOT 1 15$: WAIT$ #FDB,#10.;,IOST BCC 25$ ; If C set error IOT 2 25$: ADD #FIRSTB,@#BKVB+2 ; Now for second half READ$ #FDB,#BUFI0+VECSIZ+FIRSTH,#SECONH,#BKVB ; Second half starts ; after end of 1st transfer BCC 30$ ; If C set error IOT 3 30$: WAIT$ #FDB,#10.;,IOST BCC 300$ ; If C set error IOT 4 300$: CLOSE$ #FDB MSGOUT .LIST MEB ; Restore expansion for debugging ; POOLST: MOV #64.,R0 ; Clear 64. bytes in front of map area MOV MAP,R1 ; used for prettier output format 1$: MOVB #40,-(R1) SOB R0,1$ MOV @#$EXSIZ,R0 ; Calc. total pool space .ENABL LSB CMP R0,#120000 ; Check that it's a valid value BHI 2$ ; Can't do anything if not valid BIT #1,R0 ; Also must be even BNE 2$ SUB #$POOL,R0 MOV R0,POOLWD ; Save value BGT OKSIZ ; Top had better be larger than bottom 2$: MSGOUT FATXIT: EXIT$S OKSIZ: MOV POOLWD,MAPSIZ ; Set size of our map ASR MAPSIZ ; In # segments of 4 bytes ea. ASR MAPSIZ MOV MAP,R0 ; Set map to all '?????' for unknown/used MOV MAPSIZ,R2 5$: MOVB #'?,(R0)+ SOB R2,5$ MOV #FRLIST,R5 ; Get pointer to buffer area CLR R4 ; Zero count of fragments MOV #MAXFRG,R3 ; Get maximum # entries MOV $CRAVL,R2 ; Get listhead of free pool 10$: MOV R2,R0 ; Save current address INC R4 ; Found free segment; count it ; Now lets do some checking for validity CMP R2,#$POOL ; Is the segment below pool bottom ? BLO 20$ ; If yes, branch CMP R2,@#$EXSIZ ; Is it above upper limit ? BLO 30$ ; OK if below 20$: MSGOUT ; Put out error message & end poolst BR ENDFRE ; Use what we have 30$: BIT #1,R2 ; Is it an even address ? BEQ 40$ ; If yes, branch MSGOUT ; Put out error message & end poolst BR ENDFRE ; Use what we have 40$: SUB #$POOL,R0 ; Calc. addr. relative to start of pool MOV R2,(R5)+ ; Save rel. address CMP 2(R2),@#POOLWD ; Is size of pool segment smaller then pool ? BMI 50$ ; If yes, branch MSGOUT ; Error msg & end poolst BR ENDFRE ; Use what we have 50$: MOV 2(R2),R1 ; Get segment size MOV R1,(R5)+ ; Then save it CALL MRKMP1 ; Mark the map .WORD '- ; With '-----' for free pieces MOV (R2),R2 ; Get the next free segment addr. BEQ ENDFRE ; End if pointer to next is zero SOB R3,10$ ; Continue if more room in list area ; ENDFRE: MOV R4,FRGMNT ; Save # fragments .DSABL LSB ;+ ; Now mark TCB's w/ their names ;- .ENABL LSB MOV $TSKHD,R4 ; Get first TCB 10$: MOV R4,R0 ; Copy addr. for distructive use ASR R0 ; Check for odd address BCS ENDTCB ; Quit chain if so CALL GTMOFA ; Get map offset BCS 20$ ; If outside pool, just ignore it MOV #TCBSTG,R1 ; Insert ',(R0) ; Finish off w/ closing bracket 12$: MOV T.ATT(R4),R3 ; Look for attachment descriptor list BEQ 20$ ; None if zero 15$: MOV R3,R0 ; Make a copy for destructive use SUB #A.TCBL,R0 ; Adjust to beginning of block ASR R0 ; Check for odd address BCS 185$ CALL GTMOFA ; Get the offset from beginning of pool BCS 18$ ; Ignore if outside of pool MOVB #'<,(R0)+ ; Mark area with '' MOVB #'A,(R0)+ MOVB #'>,(R0)+ 18$: MOV (R3),R3 ; Look for more attachments BNE 15$ ; And continue with them ;Check for 'simple' AST control blocks 185$: MOV T.SAST(R4),R3 ; Are there any specified AST control blocks? BEQ 20$ ; No if pointer is zero CALL VFYADR ; Check that it points to something in pool BCS 20$ ; If not, can't follow this TST A.CBL(R3) ; Is it a funny type? 19$: BEQ 20$ ; Ignore if so (don't know size) TSTB A.CBL(R3) ; Is it a 'specified AST' control block? BNE 20$ ; If not, don't bother w/ it for now MOV R3,R0 ; OK, let's mark it w/ '' ASR R0 ; Check for odd address BCS 20$ ; Quit chain if so CALL GTMOFA ; Get address in map BCS 195$ ; Go to next possible one if out of pool MOVB #'<,(R0)+ MOVB #'A,(R0)+ MOVB A.CBL+1(R3),R1 ; Get the AST code CALL CNVASC ; Convert to ASCII & insert in map MOVB #'>,(R0)+ ; Close area 195$: MOV (R3),R3 ; See if there's another AST block BR 19$ ; & go test it 20$: MOV T.TCBL(R4),R4 ; Get next TCB BEQ ENDTCB ; Until end of list TST T.TCBL(R4) ; Is this the null task BNE 10$ ; If no continue ; ENDTCB: ; Ref. label .DSABL LSB ; + ; Now do clock-queue control blocks (an easy one) ; - .ENABL LSB MOV $CLKHD,R3 ; Get first control block BEQ ENDCLQ ; Maybe there aren't any???? 10$: ; Check for odd link address BIT #1,R3 ; Is it odd ? BEQ 100$ ; If not, branch MSGOUT ; Put out error message BR ENDCLQ ; End clq scan 100$: CMP R3,@#$EXSIZ ; Is link above pool ? BLO 120$ ; If yes, branch MSGOUT ; Put out error message BR ENDCLQ ; And end clq check 120$: MOV R3,R0 ; We need to get this into an offset CALL GTMOFF ; Get map offset BCS 15$ ; Ignore if outside pool area MOVB #'<,(R0)+ ; Mark just as '' MOVB #'C,(R0)+ ; where n is request type MOVB C.RQT(R3),R1 ; Get the request type CALL CNVASC ; Put out as ASCII MOVB #'>,(R0)+ 15$: MOV C.LNK(R3),R3 ; Get next control block if any BNE 10$ ; And mark that one ; ENDCLQ: ; Ref label .DSABL LSB ;+ ;Now mark asn control blocks (another easy one) ;- .ENABL LSB MOV $LOGHD,R3 ; Get 1st one BEQ ENDLOG ; If it exists, else skip out 10$: ; Time for a check BIT #1,R3 ; Is it odd ? BEQ 100$ ; If not, branch MSGOUT ; Put out error message BR ENDLOG ; End ASN control block scan 100$: CMP R3,@#$EXSIZ ; Is link above pool ? BLO 120$ ; If yes,branch MSGOUT ; Put out error message BR ENDLOG ; and end ASN check 120$: MOV R3,R0 ; Make a copy CALL GTMOFF ; Get offset into map BCS 15$ ; Ignore if outside pool MOVB #'<,(R0)+ ; Mark in form ' ; Put out error message JMP ENDPAR ; End pcb scan 100$: CMP R3,@#$EXSIZ ; Is link above pool ? BLO 120$ ; If yes, branch MSGOUT ; Put out error message JMP ENDPAR ; and end PCB scan 120$: MOV R3,R0 ; Make a copy to calculate map offset CALL GTMOFF ; Convert to byte offset in map BCS PARSYS ; Ignore if outside pool MOVB #'(,(R0)+ ; Mark it with a '(' CMP P.MAIN(R3),R3 ; Is this a 'main' partition? BNE NTMAIN MOVB #40,(R0)+ ; Yes, no special symbol inserted MOV P.NAM(R3),R1 ; Get partition name CALL $C5TA ; And convert to ASCII MOV P.NAM+2(R3),R1 ; Mark as '( parnam)' PARL: CALL $C5TA TRLPAR: MOVB #'),(R0)+ ;Look for task headers in pool MOV P.HDR(R3),R0 ; See if this partition has a header BEQ PARSYS ; No if zero MOV P.TCB(R3),R4 ; Maybe, have to check if still in memory BIT #TS.OUT,T.STAT(R4) ; Header is allocated until marked out BNE PARSYS ; If out, then no header in pool MOV H.HDLN(R0),R1 ; It's there, get its length CALL GTMOFF ; Get offset into map BCS PARSYS ; If C set, wasn't in pool area MOV R0,-(SP) ; Save start offset address CALL MRKMP2 ; Mark the whole header area .WORD '# ; W/ '#######' MOVB #'>,-(R0) ; Mark end w/ usual angle bracket MOV (SP)+,R0 ; Get back beginning of header MOV #HDRSTG,R1 ; Insert '
; Put out error message JMP ENDVCB ; End vcb scan 100$: CMP R3,@#$EXSIZ ; Is link above pool ? BLO 120$ ; If no, branch MSGOUT ; Put out error message JMP ENDVCB ; and end VCB check 120$: MOVB D.UNIT+1(R3),R5 ; Get total # units MOVB D.UNIT(R3),R4 ; Get the bottom unit number SUB R4,R5 ; Subtract bottom # INC R5 ; Adjust for end count MOV D.UCBL(R3),R4 ; Save length of a UCB MOV D.UCB(R3),R2 ; Get a UCB TSTUCB: BIT #DV.MNT,U.CW1(R2) ; Is this device mountable? BEQ 10$ ; If not, go try for another device BIT #DV.F11,U.CW1(R2) ; Is it FILES-11? BNE 20$ ; If yes branch 10$: JMP NXTDEV ; If no, try another device 20$: BITB #US.MNT,U.STS(R2) ; Okay, is it actually mounted BEQ 30$ ; If yes branch JMP NXTUNT ; If no, check the next unit 30$: MOV U.VCB(R2),R0 ; Aha!, got one. get address of VCB ASR R0 ; Check for odd address BCS FNDFCB ; End chain if so CALL GTMOFA ; Get offset in map BCS FNDFCB ; Ignore if outside pool MOV #VCBSTG,R1 ; Mark with '' MOVB #'>,(R0)+ .IFDF V$$D11 ; This is for Stamerjohn's vd: disk driver CMP D.NAM(R3),#"VD ; Is it a VD: ? BNE ENDVDS ; Br if no MOV U.VCB+2(R2),R0 ; Any extension block ? BEQ ENDVDS ; Br if no CALL GTMOFF ; Get offset in map BCS ENDVDS ; Ignore if not in pool MOV R1,-(SP) ; Save the unit # MOV #VDASTG,R1 ; Point to starting '' CALL MOVSTG ; Stuff it ENDVDS: .endc .DSABL LSB ;Now track down file-control-blocks in pool FNDFCB: MOV U.VCB(R2),R1 ; Get the VCB address again MOV V.FCB(R1),R1 ; Get 1st FCB CHKFCB: CMP R1,@#$EXSIZ ; In pool? BHI GETWB ; If not, give up (else have to map to acp) MOV R1,R0 ; Copy to convert to map ptr ASR R0 ; Check for odd address BCS GETWB ; If so, try something else CALL GTMOFA BCS NXTFCB ; Skip to next one if outside of pool MOV R1,-(SP) ; Save FCB for tracing chain MOV #FCBSTG,R1 ; Mark w/ ',R1 ; Adjust to size of whole window ASR R0 ; Check for odd address BCS NXTUNT ; Skip if so CALL GTMOFA ; Get start of window pointer in map BCS NXTUNT ; Skip this one if outside pool MOV R0,-(SP) ; Save pointer CALL MRKMP2 ; Mark off used window area .WORD '= ; With '=========' DEC R0 ; Back up one char MOVB #'>,(R0)+ ; Stick trailing delimiter on MOV (SP)+,R0 ; Get back start address MOVB #'<,(R0)+ ; Stick ' ; Put out error message JMP ENDOPK ; End opk scan 100$: CMP R3,@#$EXSIZ ; Is link above pool ? BLOS 120$ ; If no, branch MSGOUT ; Put out error message JMP ENDOPK ; And end opk scan 120$: CALL GTMOFF ; Convert to offset in map BCS ENDOPK MOV #PKTOPT,R1 ; Get string address to insert in map CALL MOVSTG ; Insert '' MOV (R3),R0 ; Get next packet address SOB R2,OPKLUP ; Any left to do? ENDOPK: ; Ref. label .DSABL LSB .ENDC ; Q$$OPT ;+ ;Now find any device driver data structures in pool ; or perhaps just interrupt control blocks ;- .ENABL LSB MOV $DEVHD,R0 ; Get start of DCB's TSTDCB: MOV R0,-(SP) ; Save DCB ptr; R0 will be used destructively MOVB D.UNIT(R0),R1 ; Calculate # units for this DCB MOVB D.UNIT+1(R0),R2 ; Get higher # SUB R1,R2 ; Sub lower # INC R2 ; & add for end count CLR R4 ; Init. to search for new SCB addrs. MOV D.UCB(R0),R3 ; Get 1st UCB TSTSCB: ;Time for a check BIT #1,R3 ; Is it odd ? BEQ 100$ ; If not, branch MSGOUT ; Put out error message BR 110$ ; End data structures scan 100$: CMP R3,@#$EXSIZ ; Is link above pool ? BLO 120$ ; If no, branch MSGOUT ; Put out error message 110$: TST (SP)+ ; Pop DCB off stack JMP ENDDCB ; And end data structure scan 120$: CMP U.SCB(R3),R4 ; Have we got a new SCB address? BEQ NXTUCB ; If not, try another UCB NEWSCB: MOV U.SCB(R3),R4 ; Get the SCB address MOVB S.VCT(R4),R5 ; Then get the intrp vector addr. ASL R5 ; Convert to actual addr ASL R5 ADD #BUFI0,R5 ; Add offset of buffer for crash dumps CMP (R5),#$POOL ; Do we have an intrp-control-block in pool? BLO NXTUCB ; If not, go to next UCB ;Now let's mark off an ICB (or possibly 2) MOV R1,-(SP) ; Save R1 for main-line code CALL MRKICB ; Do marking via subroutine CMP (R5)+,(R5)+ ; Then advance to next possible vector addr. CMP (R5),#$POOL ; If that's in pool, maybe device is full-duplx BLO CLEANS ; If not, go restore stack/registers CALL MRKICB ; This may not belong, but best i can do CLEANS: MOV (SP)+,R1 ; Restore R1 MOV (SP),R0 ; & get fresh copy of DCB from stack NXTUCB: ADD D.UCBL(R0),R3 ; Advance UCB pointer to next UCB SOB R2,TSTSCB ; & decr. count of remaining UCB's SUB D.UCBL(R0),R3 ; Restore UCB pointer to last good UCB addr. CMP R0,#$POOL ; Is this DCB inside pool area? BLO NXTDCB ; No if lower, so done w/ this device ;We now have all the associated data structures for this device. ;We will assume that they have been inserted in standard order, i.e. ; DCB, UCB, SCB... ADD #S.MPR,R4 ; Advance to end of SCB area BIT #FE.EXT,$FMASK ; Do we have to worry about UMR area? BEQ 10$ BITB #UC.NPR,U.CTL(R3) ; Yes, but is this an NPR device? BEQ 10$ ADD #12.,R4 ; Yes, so add in space for UMR allocation 10$: SUB R0,R4 ; Convert R4 to size of area MOV R4,R1 ; Set up for marking off area ASR R0 ; Check if address is odd BCS NXTDCB ; Quit if so CALL GTMOFA ; Convert to offset in pool map BCS NXTDCB ; Give up if bad MOV R0,-(SP) ; Save start of area CALL MRKMP2 .WORD '% ; Fill area w/ '%%%%%%%' DEC R0 ; Back up one char MOVB #'>,(R0)+ ; End area w/ usual '>' MOV (SP)+,R0 ; Recover beginning of area MOV #DCBSTG,R1 ; Insert ' ; Put out error message BR ENDMCR ; End MCR scan 100$: MOV R3,R0 ; Get copy for distructive use BEQ ENDMCR ; Quit if no new line CMP R3,@#$EXSIZ ; Is link above pool ? BLO 120$ ; If no, branch MSGOUT ; Put out error message BR ENDMCR ; And end MCR check 120$: CALL GTMOFF ; Get offset into pool map BCS 20$ ; Skip if somewhow not in pool MOV #MCRSTG,R1 ; Put ',(R0)+ ; Finish off with ending delimiter 20$: MOV (R3),R3 ; Get next MCR line address BR 10$ ; And go try out that one ENDMCR: ; Ref. label .DSABL LSB ;+ ;Now look for mount control blocks ;- .ENABL LSB MOV $MOULS,R3 ; Get listhead for mount control blocks 10$: ;Time for a check BIT #1,R3 ; Is it odd ? BEQ 100$ ; If not, branch MSGOUT ; Put out error message BR ENDMOU ; End mcb scan 100$: MOV R3,R0 ; Get copy for distructive use BEQ ENDMOU ; Quit if no new block CMP R3,@#$EXSIZ ; Is link above pool ? BLO 120$ ; If no, branch MSGOUT ; Put out error message BR ENDMOU ; And end mcb check 120$: CALL GTMOFF ; Get offset into pool map BCS 20$ ; Skip if somewhow not in pool MOVB #'<,(R0)+ ; Mark mount blocks with ; Put out error message BR ENDCKP ; End CKP scan 100$: MOV R3,R0 ; Get copy for distructive use BEQ ENDCKP ; Quit if no new block CMP R3,@#$EXSIZ ; Is link above pool ? BLO 120$ ; If no, branch MSGOUT ; Put out error message BR ENDCKP ; and end 120$: CALL GTMOFF ; Get offset into pool map BCS 20$ ; Skip if somewhow not in pool MOV #CKPSTG,R1 ; Put '' in map CALL MOVSTG 20$: MOV (R3),R3 ; Get next checkpoint PCB address BR 10$ ; and go try out that one ENDCKP: ; Ref. label .DSABL LSB ;+ ;Done with pool scan - now display all the information ;- MOV FRGMNT,R2 MOV #FRGMSG,R1 ; Set for message about fragments MOV PC,R3 ; Set for decimal conversion CALL PRMSNM ; Print # fragments MOV POOLWD,R2 ASR R2 ; Convert to # words MOV #POOLMS,R1 CALL PRMSNM ; Print pool size MOV #TEXTBF,R0 ; Output message about next printout MOV #SEGMSG,R1 ; It's list of free segment addrs. CALL MOVSTG CALL OUTIT MOV FRGMNT,R5 ; Set loop count for printing MOV #FRLIST,R4 ; Get address of segment list CLR R3 ; Accumulate segment lengths in R3 PRSEG: MOV (R4),R1 ; Get address of segment MOV #1,R2 ; No zero suppression MOV #TEXTBF,R0 ; Set start of output buffer CALL $CBOMG ; Convert to octal MOVB #'-,(R0)+ ; Insert a dash MOV (R4)+,R1 ; Get start addr. again ADD (R4),R1 ; Add length DEC R1 ; Adjust to last free byte address MOV #1,R2 ; No zero suppress for octal printout CALL $CBOMG ; 1st print value in octal MOVB #40,(R0)+ ; Separate values w/ a space MOV (R4)+,R1 ; Recover length to print in decimal ASR R1 ; Convert length to words ADD R1,R3 ; Accumulate segment lengths CLR R2 ; Suppress zeros this time CALL $CBDMG ; Convert to decimal for segment length MOVB #'.,(R0)+ ; Show it to be a decimal value CALL OUTIT SOB R5,PRSEG ; Keep going until all segments done MOV R3,R2 ; Print total of free segments MOV #NFRMSG,R1 MOV PC,R3 ; Print in decimal CALL PRMSNM ;+ ;Now print map in rows of 64 chars. ;- MOV #TEXTBF,R0 ; Output header for map: MOV #MAPMSG,R1 CALL MOVSTG CALL OUTIT MOV #$POOL,R0 ; Calc. even 100's map address to start BIC #377,R0 MOV R0,POOLAD ; Save as pool address MOV $EXSIZ,R5 ; Calc. map output size SUB R0,R5 ASR R5 ; in # bytes ASR R5 SUB #$POOL,R0 ASR R0 ; Convert to map address ASR R0 ADD MAP,R0 MOV R0,MAPAD ; Save map address PRTLUP: MOV POOLAD,R1 ; Set up to convert pool address to octal ADD #400,POOLAD ; Bump pool address to next line MOV #1,R2 ; Set for no zero suppression MOV #TEXTBF,R0 ; Get output buffer address CALL $CBOMG ; Convert to octal word MOVB #':,(R0)+ ; Separate from map w/ ': ' MOVB #40,(R0)+ MOV MAPAD,R1 ; Get our current map address MOV #64.,R4 ; Set R4 to default # bytes/record CMP R4,R5 ; Is there less remaining? BLE 10$ MOV R5,R4 ; Yes, use the smaller # 10$: ADD R4,MAPAD ; Advance map address for next record SUB R4,R5 ; Decrease # bytes left to print 11$: MOVB (R1)+,(R0)+ ; Copy map into buffer SOB R4,11$ ; until record filled CALL OUTIT ; Print it TST R5 ; Anything left to print? BNE PRTLUP ; If so, back for another record ; CLOSE$ #FDBOUT ; CLOSE OUTPUT FILE EXIT$S ; The end ;+ ;Subroutines ;- ;PRMSNM: Print message w/ trailing # ; entry w/ R1 = addr. of ASCIZ string to output ; R2 = value to append ; R3 = flag for type of conversion: zero=octal, non-zero=decimal PRMSNM: MOV #TEXTBF,R0 ; Set start of output buffer CALL MOVSTG ; Copy in the text MOVB #'=,(R0)+ ; Separate message from value MOV R2,R1 ; Get the value to convert CLR R2 ; Suppress leading zeros MOV R3,-(SP) ; Save R3 for user reuse BEQ CNVOCT ; and convert to octal if flag was zero CALL $CBDMG ; Convert to decimal magnitude MOVB #'.,(R0)+ ; Append decimal point BR RESR3 ; CNVOCT: CALL $CBOMG ; Convert to octal RESR3: MOV (SP)+,R3 ; Restore R3 for user reuse OUTIT: SUB #TEXTBF,R0 ; Calc. length of message MOV R0,LEN ; Save length for PUT$S PUT$S #FDBOUT,#TEXTBF,LEN ; Output to file system RETURN LEN: .BLKW 1 ; Storage for length ; MRKMAP: ; Main entry point ; Entry with: R0=absolute address of pool ; R1=size of segment in bytes ; @0(SP)=char. to put in map ; Entry at MRKMP1 w/ R0=rel. address in pool ; Entry at MRKMP1 w/ R0= byte address in map ; Exit w/ no-op & carry set if map offset negative, else carry clear SUB #$POOL,R0 ; Adjust to beginning of pool MRKMP1: ASR R0 ; Convert to segment number ASR R0 ADD MAP,R0 ; Get start address in map MRKMP2: ; Checking now done in mapout ADD #3,R1 ; Round size to next larger #segments ASR R1 ASR R1 STOCH: MOVB @0(SP),(R0)+ ; Stuff char. in map SOB R1,STOCH ; until all segments marked ADD #2,(SP) ; Move return past mark character CLC ; Show successful operation RETURN ; Now done ; ; GTMOFF: Entered w/ pool address in R0 ; Exit w/ map address in R0 ; Return w/ carry set & no-op if offset negative, else carry clear ; GTMOFA: alternate entry w/ address/2 in R0 GTMOFA: ASL R0 ; Convert back to full address GTMOFF: CMP R0,$EXSIZ ; Above top of pool? BHI 5$ ; If yes, skip conversion SUB #$POOL,R0 ; 1st get addr. rel to start of pool BHIS 10$ ; Legal if positive offset 5$: SEC ; No, show error code RETURN ; & exit w/o doing anything else ; 10$: ASR R0 ; Then get block # ASR R0 ADD MAP,R0 ; Finally calc. actual map addr. RETURN ; CNVASC: ; Ref label ; Entered w/ hex value in R1 ; Exit w/ ASCII value stored @(R0)+ ADD #'0,R1 ; Convert to ASCII CMP R1,#'9 ; Use hex if > 9. BLE 11$ ADD #<'@-'9>,R1 ; Bump to ASCII 'a' 11$: MOV R1,-(SP) ; Insert into map CALL MAPOUT ; Use safe write RETURN ; MOVBYT: MOVB (R1)+,(R0)+ ; Copy a byte to target area MOVSTG: ; Ref. label ; Entered w/ output address in R0 ; w/ input ASCIZ string address in R1 TSTB (R1) ; At end of string? BNE MOVBYT RETURN ; Not much of a routine, is it? ; GPTSKN: ; Ref. label ; Entered w/ PCB address in R3 at entry GPTSKN ; or w/ TCB address in R4 at entry GTTSKN ; Output is task-name in ASCII stored at address in R0 ; R0 is updated to next byte after name MOV P.TCB(R3),R4 ; Get TCB address to get task name GTTSKN: MOV T.NAM(R4),R1 ; Get task name for subpartition CALL $C5TA MOV T.NAM+2(R4),R1 CALL $C5TA ; Convert this 2nd half of name RETURN ; Done copying in task name ; MRKICB: ; Ref. label ; Entered with R5 containing a vector address which appears to have ; an intrp control block in pool MOV (R5),R1 ; Get address of ICB 10$: CMP (R1)+,#207 ; Look for standard end of ICB BNE 10$ SUB (R5),R1 ; Calculate size of ICB MOV (R5),R0 ; Get start addr. into R0 CALL VFYADR ; Check that address is valid BCS 20$ CALL MRKMAP ; Mark off area w/ blanks .WORD 40 ; (Don't expect it to be large) MOVB #'>,-(R0) ; Put closing mark at end MOV (R5),R0 ; Get beginning again CALL GTMOFF ; (in map coordinates) MOVB #'<,(R0)+ ; Mark as: '= end of wite area ? BHI 10$ ; If yes ignore the request MOVB 2(SP),(R0)+ ; Must be safe, write it out 10$: MOV (SP)+,(SP) ; Clean up the stack RETURN .NLIST .nlist meb .SBTTL GCMLIN - Command line handler and file opening .LIST ; .ENABL LSB GCMLIN: FINIT$ ; Re-entrant routines must init fsr PROMPT: CLOSE$ #FDB ; Ensure its not open CLOSE$ #FDBOUT ; Output too GCML$ #GCLBLK ; Prompt and get command line BCC 1$ ; Check for retrieval error or ctrl/z CMPB #GE.EOF,G.ERR(R0) ; Eof on input ? BNE 1$ ; If not then continue on EXIT$S ; Otherwise exit ; 1$: TST GCLBLK+G.CMLD ; Null command line? BEQ PROMPT ; If so, re-prompt PARSE: CSI$1 #CSIBLK,GCLBLK+G.CMLD+2,GCLBLK+G.CMLD ; Validate line BCS 2$ ; Syntax error ? CSI$2 #CSIBLK,INPUT,#SWTABL ; Parse command line BCC 3$ ; 2$: MSGOUT JMP PROMPT ; 3$: OPEN$R #FDB ; Open input file BCC 25$ ; Br if found MSGOUT JMP PROMPT ; Go prompt again ; 25$: CSI$2 #CSIBLK,OUTPUT,#SWTABL ; OK, now find output filespec. BCS 1$ OPEN$W #FDBOUT ; Open output file BCC 30$ ; Br if found MSGOUT JMP PROMPT ; Go prompt again 30$: TST CSIBLK+C.MKW1 ; /HE switch specified? BNE 7$ ; Branch if yes RETURN ; ; For /he 7$: MSGOUT ; RETURN .DSABL LSB .NLIST .SBTTL Data area .LIST ;+ ;Data area ;- ; ; First messages ; .NLIST BEX FRGMSG: .ASCIZ /# FREE POOL FRAGMENTS/ POOLMS: .ASCIZ /TOTAL WORDS OF POOL/ NFRMSG: .ASCIZ /TOTAL FREE WORDS/ SEGMSG: .ASCIZ /FREE SEGMENT LIST:/ MAPMSG: .ASCIZ <14>/POOL MAP:/ PKTOPT: .ASCIZ // HDRSTG: .ASCIZ /
/ VDASTG: .ASCIZ // ; MSG2: .ASCII /CPA -- File not found/ SIZ2=.-MSG2 MSG4:: .ASCII /CPA -- Transfer done/<7> SIZ4=.-MSG4 ; .EVEN .LIST BEX ; ; The following area contains all areas written to by this program ; MQIO: QIOW$ IO.WVB,TILUN,TIEVF,,,,<,,40,,> ; ; FDOF$L ; Define fdb offsets ; FSRSZ$ 2 ; 1 file will be open ; 1 gmcl file can be open ; FDB: FDBDF$ ; Allocate 140 byts for fdb FDRC$A FD.RWM ; Read$/write$ block i/o FDBK$A BUFI0,42000,,10. ; Init record access section of fdb FDOP$A INLUN,CSIBLK+C.DSDS,FILEIN ; Init file open section of FDB ; Lun 1, dataset descriptor supplied dynamically ; By CSI, default filename block FILEIN: NMBLK$ CLEAN,CDA,,SY,0 ; Default filetype FDBOUT: FDBDF$ ; Make an fdb FDAT$A R.VAR,FD.CR ; Initialize file attributes FDOP$A OUTLUN,CSIBLK+C.DSDS,FILEOU ; Initialize file open section ; FILEOU: NMBLK$ CPA,TXT,,SY,0 ; Default filetype RBUF: .BLKW 41. IOST: .BLKW 2 ; I/O status return BKVB: .BLKW 2 ; GCLBLK: GCMLB$ 1,CPA,RBUF,GCMLUN ; Initialize gcml control block CSI$ .EVEN CSIBLK: .BLKB C.SIZE ; Create control block ; SWTABL: CSI$SW HE,HEMSK ; Define /he switch CSI$ND ; End of switch definitions ; QIO: QIOW$ IO.WVB,TILUN,TIEVF,,,, POOLAD: .BLKW 1 ; Starting address for printout MAPAD: .BLKW 1 ; Starting map address for same POOLWD: .WORD 0 MAP: .WORD $CMFIN+64. ; Pointer to area to be overwritten w/ map MAPEND: .WORD $CMFIN+6*1024.+64. ; End of map area (allows 12. KW pool) FRGMNT: .WORD 0 FRLIST: .BLKW 2*MAXFRG NAMFLD: .WORD 0 ; Address of name-field (temp. use) MAPSIZ: .WORD 0 ; Actual map size in segments (4 bytes ea.) TEXTBF: .BLKW 40 ; Text buffer .END CPA