;BLKPRT.LIT
;
;
;4/25/84 STEVEN G. MCNAUGHTON & RICH EAKIN
; QUAKER STATE OIL CORP. RESEARCH CENTER
;
; THIS PROGRAM IS DESIGNED FOR THE AMOS/L SYSTEM.
;
; ***********************************************************************
; * *
; * Format for use is BLKPRT <DEVn:> BLOCK1 BLOCK2 *
; * *
; * BLOCK1 is a single block to be printed or the starting block number *
; * of a group of blocks ending with BLOCK2.
; * *
; * If no device is specified the job's login is defaulted. *
; * *
; * Output file is written to job's login default device with a filespec*
; * of DEVn:BLOCK1.BLK. This filespec is the same whether one block or a*
; * group of blocks is being printed. *
; * *
; ***********************************************************************
;
; ***********************************************************************
; * *
; * EDIT AND DEVELOPMENT HISTORY *
; * *
; ***********************************************************************
; 100. - BASIC PRINT TO SCREEN [SGM]
; 101. - ADDED OUTPUT SWITCH CAPABILITY [SGM]
; 102. - REMOVED SWITCH TO PRINT - DEFAULTS TO PRINT - NO OPTION [SGM]
; 103. - ADDED RIGHT HAND ASCII BYTE DISPLAY [SGM]
; 104. - CORRECTED BLOCK NUMBER RANGE CHECK FOR DEVICES HAVING MORE
; THAN 32K BYTES PER DISK [SGM] 5/18/84
SEARCH SYS
SEARCH SYSSYM
SEARCH TRM.UNV
.OFINI
.OFDEF IDDB,D.DDB ;DUMMY FILE DDB
.OFDEF ODDB,D.DDB ;OUTPUT FILE DDB
.OFSIZ IMPSIZ
; ***********************************************************************
; * *
; * SYMBOL EQUATE AREA *
; * *
; ***********************************************************************
VMAJOR=1. ;VERSION NUMBER
VMINOR=1.
VSUB=1.
VEDIT=104.
HEADER:
PHDR -1,PV$RSM!PV$WSM,PH$REE!PH$REU
TOP:
GETIMP IMPSIZ,A5,EXIT ;GET SOME IMPURE SPACE
JOBIDX A3
MOVW 2(A3),D1
ANDW #20,D1 ;IS J.HEX SET?
BEQ RESPRG ;NOPE IN OCTAL
MOVW #1,D5 ;QUICK STORAGE FOR J.HEX SET
RESPRG: MOV A2,D2
LEA A3,ASCBUF ;A3 POINTS TO ASCII BUFFER SPACE
BYP ;BYPASS ANY BLANKS ON COMMAND LINE
LIN ;END OF LINE?
JEQ CERROR
NUMCHK:
NUM ;IS THE FIRST CHAR NUMERIC?
JEQ INPBLK ;YES ! GET THE BLOCK NUMBER
INLINE: ;NO ! GET THE DEVICE AND DRIVE INFO NOW
MOVB (A2)+,(A3)+ ;FIRST BYTE ON COMMAND LINE TO ASCII BUFFER
MOVB (A2)+,(A3)+ ;SECOND BYTE ON COMMAND LINE
MOVB (A2)+,(A3) ;THIRD BYTE ON COMMAND LINE
LEA A3,INDRV ;LOAD THE DRIVE STORAGE AREA
MOVB (A2)+,(A3)+ ;FOURTH BYTE ON COMMAND LINE TO DRIVE
BYP ;BYPASS ANY BLANKS
LIN ;END OF LINE?
JEQ CERROR ;*ERROR* WHERE'S THE COLON?
MOVB (A2),D1 ;CHECK THE COMMAND LINE FOR A COLON
CMPB D1,#': ;IS IT A COLON (END OF DEV AND DRV)
JEQ PCKIT ;YES ! GO PACK THE DEVICE NAME
MOVB (A2)+,(A3) ;GET FINAL CHARACTER OF DRIVE #
MOVB (A2),D1 ;TEST THE NEXT BYTE ON THE COMMAND LINE
CMPB D1,#': ;IS IT A COLON?
JEQ PCKIT ;YES - GO PACK THE DEV AND DRV
;*ERROR* DEV AND DRV MUST END IN COLON
SUB #2,A2
JMP CERROR
PCKIT:
ADD #1,A2 ;MOVE TO NEXT BYTE ON COMMAND LINE
BYP ;BYPASS ANY BLANKS
LIN ;END OF LINE?
JEQ CERROR
NUM2:
NUM ;IS THIS CHARACTER NUMERIC?
JNE CERROR ;*ERROR* - THIS MUST BE A NUMBER!
CLR D1 ;CLEAR OUT ANY JUNK
GTOCT ;GET AN OCTAL NUMBER FROM THE COMMAND LINE
LEA A3,BLOCK ;STORE THAT OCTAL NUMBER IN THE BLOCK
MOVW D1,(A3) ; TO BE SEARCHED AREA
BYP ;BYPASS ANY BLANKS
LIN ;END OF LINE?
JEQ GOPCK
NUM
JNE CERROR
LEA A3,UPBLK ;STORE THE UPPER PRINT RANGE PRINT BLOCK
CLR D1
GTOCT
MOVW D1,(A3) ;STORE IT
BYP
LIN
JNE CERROR
GOPCK:
CLR D1 ;CLEAR OUT ANY JUNK
LEA A2,ASCBUF ;A2 MUST POINT TO ASCII CHARACTERS
LEA A1,INDEV ;PACK AND STORE THE DEVICE NAME
PACK ;
LEA A2,INDRV ;GET THE INPUTED DRIVE NUMBER
GTDEC ;MAKE SURE ITS DECIMAL
LEA A2,INDRV ;PUT IT BACK INTO DRIVE # STORAGE
MOVW D1,(A2)
JMP INITDB ;
INPBLK:
CLR D1 ;GET THE BLOCK - DSK MUST HAVE BEEN
GTOCT ;DEFAULTED TO GET HERE!
LEA A3,BLOCK ;STORE THE BLOCK NUMBER
MOVW D1,(A3)
BYP ;BYPASS ANY BLANKS
LIN ;END OF LINE?
JEQ DEFAUL
NUM
JNE CERROR
LEA A3,UPBLK
CLR D1
GTOCT
MOVW D1,(A3)
BYP
LIN
JNE CERROR
DEFAUL:
LEA A3,INDEV ;DEVICE DEFAULT AREA
MOVW #0,(A3) ;MOVE A ZERO FOR DEVICE NAME (FOR IDDB)
LEA A3,INDRV ;MOVE A -1 FOR DRIVE NUMBER (FOR IDDB)
MOVW #-1,(A3)
INITDB: ;SET UP AND INIT A DUMMY IDDB
CLR D1
LEA A2,SCRAT ;LOAD A DUMMY FILESPEC IN
MOV A2,D0
MOVW #377,(A2)+
MOVW #377,(A2)+
MOVW #377,(A2)
MOV D0,A2
FSPEC IDDB(A5) ;PROCESS THE FILESPEC (POINTED BY A2)
LEA A3,IDDB+D.DEV(A5) ;PUT THE PROPER DEVICE NAME IN
LEA A2,INDEV
MOVW (A2),(A3)
LEA A3,IDDB+D.DRV(A5) ;PUT THE PROPER DRIVE NUMBER IN
LEA A2,INDRV
MOVW (A2),(A3)
INIT IDDB(A5) ;INITIALIZE THE IDDB
CTRLC EXIT
CLR D1
TYPESP <Block print on device:>
LEA A3,IDDB+D.DEV(A5) ;GET THE IDDB'S DEVICE NAME
MOVW (A3),D1 ;MOVE THE PACKED WORD TO D1
TST D1 ;IS IT A ZERO?
BNE UNPCK ;NOPE - GO UNPACK THE WORD
JOBIDX A3 ;DEFAULT DEVICE - DETERMINE LOG IN
LEA A2,JBDEV ; STATUS AND TYPE IT OUT
CLR D1
MOVW JOBDEV(A3),D1 ;GET THE PACKED DEVICE NAME
LEA A1,SCRAT ; AND UNPACK IT
MOVW D1,(A1)
LEA A2,ASCBUF
UNPACK
LEA A2,ASCBUF
TTYL (A2) ;PRINT THE DEFAULT DEVICE NAME
CLR D1
MOVW JOBDRV(A3),D1 ;GET THE DEFAULT DRIVE NUMBER
DCVT 0,OT$TRM ;CONVERT AND TYPE IT
CRLF
CLR D1
JMP PUTBLK
UNPCK:
LEA A1,INDEV ;GET AND UNPACK THE DEVICE NAME
LEA A2,ASCBUF
UNPACK
LEA A2,ASCBUF
MOVB (A2)+,D1 ;PRINT THE DEVICE NAME
TTY
MOVB (A2)+,D1
TTY
MOVB (A2)+,D1
TTY
LEA A2,INDRV ;GET THE DRIVE NUMBER
CLR D1
MOVB (A2),D1
DCVT 0,OT$TRM ;CONVERT AND TYPE IT
CRLF
CLR D1
PUTBLK:
TYPESP <Block number to be printed:>
CLR D1
LEA A1,BLOCK ;GET THE BLOCK NUMBER
MOVW (A1),D1
OCVT 0,OT$TRM ;CONVERT TO OCTAL AND TYPE IT
CRLF
CTRLC EXIT
ODBCHK:
LEA A3,OPDEV ;OUTPUT DEVICE
MOVW #0,(A3) ;DEFAULT DEVICE
LEA A3,OPDRV ;OUTPUT DRIVE
MOVW #-1,(A3)
ODBINI:
LEA A2,BLKBUF
CLR D1
LEA A3,BLOCK
MOVW (A3),D1
OCVT 0,OT$MEM
LEA A2,BLKBUF
FSPEC ODDB(A5),BLK ;PROCESS THE FILESPEC (POINTED BY A2)
LEA A3,ODDB+D.DEV(A5) ;PUT THE PROPER DEVICE NAME IN
LEA A2,OPDEV
MOVW (A2),(A3)
LEA A3,ODDB+D.DRV(A5) ;PUT THE PROPER DRIVE NUMBER IN
LEA A2,OPDRV
MOVW (A2),(A3)
INIT ODDB(A5) ;INITIALIZE THE IDDB
CTRLC EXIT
CLR D1
TYPESP <Block print has been initiated on:>
JOBIDX A3 ;DEFAULT DEVICE - DETERMINE LOG IN
LEA A2,JBDEV ; STATUS AND TYPE IT OUT
CLR D1
MOVW JOBDEV(A3),D1 ;GET THE PACKED DEVICE NAME
LEA A1,SCRAT ; AND UNPACK IT
MOVW D1,(A1)
LEA A2,ASCBUF
UNPACK
LEA A2,ASCBUF
TTYL (A2) ;PRINT THE DEFAULT DEVICE NAME
CLR D1
MOVW JOBDRV(A3),D1 ;GET THE DEFAULT DRIVE NUMBER
DCVT 0,OT$TRM ;CONVERT AND TYPE IT
CLR D1
TYPE <:>
PFILE ODDB(A5)
CRLF
LOOKUP ODDB(A5) ;DOES IT ALREADY EXIST?
BNE OPNOP ;NOPE - GO OPEN IT FOR OUTPUT
DSKDEL ODDB(A5) ;YES DELETE THE OLD
OPNOP:
OPENO ODDB(A5) ;OPEN IT FOR OUTPUT
TESTLP:
LEA A3,UPBLK
MOVW (A3),D1
TSTW D1
BEQ READBL
BLKCHK: CLR D1
MOV IDDB+D.DVR(A5),A3 ;GET THE DISK DRIVER ADDRESS
MOV 24(A3),D2 ;GET THE TOTAL NUMBER OF BLOCKS/DISK
SUB #1,D2 ;SUB 1 - BLOCK ZERO IS FIRST BLOCK
LEA A3,UPBLK ;GET THE INPUTED BLOCK NUMBER
MOVW (A3),D1
CMP D1,D2 ;IS THE INPUTED BLOCK LESS THAN BLOCK
BLOS UPBOK ; PER DISK?
BR BIGERR
UPBOK:
CLR D2
LEA A3,BLOCK
LEA A1,UPBLK
MOVW (A1),D4
MOVW (A3),D1
SUBW D1,D4
TST D4
JLOS BLKERR
READBL:
CLR D1
MOV IDDB+D.DVR(A5),A3 ;GET THE DISK DRIVER ADDRESS
MOV 24(A3),D2 ;GET THE TOTAL NUMBER OF BLOCKS/DISK
SUB #1,D2 ;SUB 1 - BLOCK ZERO IS FIRST BLOCK
LEA A3,BLOCK ;GET THE INPUTED BLOCK NUMBER
MOVW (A3),D1
CMP D1,D2 ;IS THE INPUTED BLOCK LESS THAN BLOCK [104]
JLE GOMFD ; PER DISK?
BIGERR: TYPECR <?Block number specified is too large for this device>
JMP EXIT
BLKERR: TYPECR <?End block number is less than start block>
JMP EXIT
GOMFD:
JOBIDX A3
MOV JOBTRM(A3),A0
ORW #1,(A0) ;SET FORCED IMAGE MODE
LEA A1,IDDB+D.REC(A5) ;LOAD BLOCK AREA IN DDB
MOV D1,(A1)
READ IDDB(A5) ;READ THE BLOCK
CTRLC EXIT
PRTBLK:
TYPE <Printing output file>
CRLF
CLR D1
MOVB #15,D1
FILOTB ODDB(A5)
MOVB #12,D1
FILOTB ODDB(A5)
CLRB D1
LEA A2,ODDB(A5)
OUTSP OT$DDB,<Dump of block:>
LEA A3,BLOCK
MOVW (A3),D1
OCVT 6,OT$DDB
CLR D1
MOVB #15,D1
FILOTB ODDB(A5)
MOVB #12,D1
FILOTB ODDB(A5)
FILOTB ODDB(A5) ;PRINT 2 LINE FEEDS
CTRLC EXIT
MOV IDDB+D.BUF(A5),A1 ;ADDRESS THE READ BUFFER AREA
LEA A2,ODDB(A5)
CLR D1
MOV #0,D0
MOV #0,D2
MOV D0,D1
PRTLP: CTRLC EXIT
MOV A1,A3
OCVT 3,OT$DDB
CLR D1
MOVB #':,D1
FILOTB ODDB(A5)
PRTLP1: CLR D1
MOVW (A1)+,D1
TSTW D5
BEQ OCTPRT
HEXPRT:
OCVT 4,OT$DDB
BR CONPRT
OCTPRT: OCVT 6,OT$DDB
CONPRT: CLR D1
MOVB #40,D1
FILOTB ODDB(A5)
CLR D1
ADD #2,D2
CMP D2,#16.
CTRLC EXIT
BNE PRTLP1
BYTR: LEA A4,BYTTRN
CLR D1
MOVW #16.,D2
PTRNLP:
CTRLC EXIT
CLRW D1
MOVB (A3)+,D1
CMPB D1,#41
BLT PUTDOT
CMPB D1,#176
BGT PUTDOT
BR PBYTTR
PUTDOT:
MOVB #'.,D1
PBYTTR:
MOVB D1,(A4)+
SUBW #1,D2
TST D2
BNE PTRNLP
POUTL:
MOVB #0,(A4) ;TAIL END NULL
CTRLC EXIT
CLRW D1
LEA A4,BYTTRN
OUTL (A4),OT$DDB
PRTCR:
CMP D0,#760
BEQ DUNPRT
CLR D1
MOVB #15,D1
FILOTB ODDB(A5)
MOVB #12,D1
FILOTB ODDB(A5)
ADD #20,D0
MOV D0,D1
CLR D2
JMP PRTLP
DUNPRT:
CLR D1
MOVB #15,D1
FILOTB ODDB(A5)
MOVB #12,D1
FILOTB ODDB(A5)
TSTW D4
BEQ FILDUN
LEA A3,BLOCK
ADDW #1,(A3)
SUBW #1,D4
MOVB #14,D1
FILOTB ODDB(A5)
JMP READBL
FILDUN: CLR D1
CRLF
TYPE <Output file completed.>
PBLK:
JMP EXIT
BLOCK: BLKB 2 ;STORAGE FOR THE INPUT BLOCK NUMBER
SCRAT: BLKB 6 ;SCRATCH AREA
JBDEV: BLKB 2 ;JOB DEVICE STORAGE
JBDRV: BLKB 2 ;JOB DRIVE STORAGE
ASCBUF: BLKB 4 ;ASCII BUFFER
INDEV: BLKB 6
INDRV: BLKB 2
BLKBUF: BLKB 6 ;ASCII REP OF BLOCK NUMBER
OPDEV: BLKB 2
OPDRV: BLKB 2
UPBLK: BLKB 2 ;UPPER BLOCK RANGE
BYTTRN: BLKB 20. ;BYTE TRANSLATION AREA
CERROR:
CLR D1
MOV A2,D1
SUB D2,D1
MOV D1,D2
ADD #10,D2
CLR D1
ELOOP:
TST D2
BEQ PERROR
MOVB #40,D1
TTY
SUB #1,D2
BR ELOOP
PERROR:
CLR D1
MOVB #'^,D1
TTY
TYPECR <Specification error>
CRLF
BR FINI
EXIT:
CRLF
CLR D1
MOVB #15,D1
FILOTB ODDB(A5)
MOVB #12,D1
FILOTB ODDB(A5)
CLOSE ODDB(A5)
FINI: EXIT
END