;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;
; CRT611.M68 - modified VCR tape certification ;
; ;
; Usage: CRT611 /F(ile)/P(rogress)/I(nterval):nnnn/N(odetail) ;
; ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; (c) Bob Fowler, 1989/04/10, runs on AMOSL 1.2A(106)
; Permission is given to copy and use this program, but not for profit.
; Explanation of switch options:
; /F - puts results into file VCRSTS.LST
; /P - displays progress reports on terminal (effects results)
; /I:n - time interval between checks (in ticks of .0001 seconds each)
; /N - omit details in histogram table (use with large I:n values)
; Defaults to /I:1000 (.1 second intervals)
; Use of registers:
; A0 = work area
; A1 = [free]
; A2 = string processing (filespecs, input line, output)
; A3 = address of VCR input buffer, temp during report
; A4 = VCR command/status port address (hex FFFFD4)
; A5 = base of impure memory (user work area)
; D0 = work area
; D1 = work area
; D2 = work area (RPTHIS)
; D3 = work area (RPTHIS)
; D4 = [free]
; D5 = tape status = 0 (READING) , 1 (COMPLETE) , 2 (ABORTED)
TABSIZ = 200. ; histogram sizes
SEARCH SYS
SEARCH SYSSYM
VMAJOR = 1
VMINOR = 0
VSUB = 0
VEDIT = 100.
VWHO = 0
PHDR -1,0,PH$REE ! PH$REU
GETIMP MEMLTH,A5 ; allocate work area
LEA A6,@A5 ; base of work area
MOV #MEMLTH/2,D7 ; start word countdown
CLRWRK: CLRW (A6)+ ; clear another word
DEC D7 ; is countdown zero?
BNE CLRWRK ; no - clear another
;------------------;
; PROCESS SWITCHES ;
;------------------;
; Initialize default switch values
MOV #1000.,TIMDIF(A5) ; time interval defaults to .1 second
CLRW PRGFLG(A5) ; default to no progress displays
CLRW RPTFLG(A5) ; default to no disk file report
SETW DETFLG(A5) ; default to no disk file report
SWLOOP: BYP ; bypass blanks
LIN ; anything there?
JEQ SWEND ; no - user input complete
CMPB (A2)+,#'/ ; slash?
JNE USAGE ; no - invalid input
CMPB @A2,#'P ; /P ?
BNE NOSWP ; no - try another
SETW PRGFLG(A5) ; set display flag for Y
TYPECR <Progress displays include (blocks,copies,CRC,hard)>
SWBYP: ADD #1,A2 ; pass over /P
BR SWLOOP ; look for another switch
NOSWP:
CMPB @A2,#'F ; /F ?
BNE NOSWF ; no - try another
SETW RPTFLG(A5) ; yes - make report file
BR SWBYP ; look for another switch
NOSWF:
CMPB @A2,#'N ; /N ?
BNE NOSWN ; no - try another
CLRW DETFLG(A5) ; yes - omit details in report
BR SWBYP ; look for another switch
NOSWN:
; /I:n - display progress reports
CMPB @A2,#'I ; /I ?
BNE NOSWI ; no - try another
ADD #1,A2 ; skip past "I"
CMPB (A2)+,#': ; ":" ?
JNE USAGE ; no - invalid format
GTDEC ; reads between displays
MOV D1,TIMDIF(A5) ; save it
JMP SWLOOP ; look for another switch
NOSWI:
; invalid switch
JMP USAGE ; none of the above ...
USAGE: LEA A2,USEMSG ; help line
TTYL @A2 ; display it
EXIT ; leave
SWEND:
LEA A2,SPEC2 ; "VCR0:" filespec
MOV #-1,D6 ; process only device
FSPEC VCRDDB(A5) ; set up DDB for VCR0:
INIT VCRDDB(A5) ; get a buffer for DDB
OPENI VCRDDB(A5) ; open VCR0:
CLR D5 ; clear tape status
MOV VCRDDB+D.BUF(A5),BUFADR(A5) ; save buffer address
LEA A0,VCRLBL(A5) ; label buffer address
MOV A0,VCRDDB+D.BUF(A5) ; use label buffer until label found
;-----------------;
; FIND TAPE LABEL ;
;-----------------;
CRLF ; look pretty
PUSHW RPTFLG(A5) ; save report flag
CLRW RPTFLG(A5) ; force a display
CALL RPTTCK ; display ticks and copies
POPW RPTFLG(A5) ; restore report flag
TYPECR <Search for tape label> ; tell 'em what we are doing
MOVB #150,D0 ; set up output (for what?)
CALL WRCTL2 ; write bytes (208,000) to VCR control port
MOV #2,D0 ; prepare countdown of attempts
MOVW #^H0AA55,VCRDDB+D.WRK(A5) ; ? (argument for VCR READ)
LEADER: ORB #D$ERC ! D$BYP,VCRDDB+D.FLG(A5) ; ignore tape leader errors
READ VCRDDB(A5) ; read block from VCR
BNE NOLBL ; if error in leader, give up header
; Found something - check if it is a Tape Header
CTRLC CRTCLS ; allow control-C
MOV VCRDDB+D.BUF(A5),A6 ; address of VCR buffer
CMP @A6,#^H0AAAA5555 ; Is a tape header code there?
BEQ ENDLBL ; yes - we found the Tape Header
DEC D0 ; countdown
BNE LEADER ; if not zero, try again (2 times)
; Either a VCR.DVR READ error, or two failed attempts to read Tape Header
NOLBL: CLR VCRLBL(A5) ; no label found
ENDLBL: MOV BUFADR(A5),VCRDDB+D.BUF(A5) ; restore buffer address
TYPECR <Begin certify>
GTIMEI TIMBEG(A5) ; get starting time of CRT611
ANDB #^C<D$ERC!D$BYP>,VCRDDB+D.FLG(A5) ; report errors now
MOVB #150,D0 ; setup output (for what?)
CALL WRCTL2 ; write bytes (208,000) to VCR control port
;-------------------------;
; MAIN CERTIFICATION LOOP ;
;-------------------------;
CRTLOP: CALL CHKVCR ; check auto-READ VCR status
MOV VCRDDB+D.BUF(A5),A3 ; DDB of VCR0:
CALL PROGRS ; output certification progress
CALL UPDHIS ; update histograms
CMP D5,#1 ; COMPLETE ?
JEQ REPORT ; yes - finish up
CMP D5,#2 ; ABORTED ?
JEQ ABORT ; yes - leave before histograms
SLEEP TIMDIF(A5) ; sleep
BR CRTLOP ; then do it again
ABORT:
JOBIDX
ANDW #^C<J.CCC>,@A6 ; clear control-C flag
;--------------;
; REPORT LABEL ;
;--------------;
REPORT: TSTW RPTFLG(A5) ; report file?
BEQ RPTOPN ; no - don't open it
LEA A2,SPEC1 ; "VCRSTS.LST" filespec
MOV #[LST],D6 ; LST default extension
FSPEC RPTDDB(A5) ; set up DDB for VCR0:
INIT RPTDDB(A5) ; get a buffer for DDB
LOOKUP RPTDDB(A5) ; already there?
BNE 10$ ; no - no problem
DSKDEL RPTDDB(A5) ; yes - erase it
10$: OPENO RPTDDB(A5) ; open for sequential output
RPTOPN:
; Report tape label (uses A0,A3)
LEA A3,VCRLBL(A5) ; VCR tape label
TST @A3 ; does label exist?
JEQ NOLBL2 ; no - say so
LEA A2,LBL1 ; "Tape labeled as"
CALL OUTLIN ; output with cr + lf
LEA A2,LBL2 ; "Volume Name"
CALL OUTSTR ; output
CLRB VTHNAM+39.(A3) ; in case no null at end
LEA A2,VTHNAM(A3) ; label field #1 - volume name
CALL OUTLIN ; output with cr + lf
LEA A2,LBL3 ; "Volume ID"
CALL OUTSTR ; output
CLRB VTHVID+9.(A3) ; in case no null at end
LEA A2,VTHVID(A3) ; label field #2 - volume ID
CALL OUTLIN ; output with cr + lf
LEA A2,LBL4 ; "Installation"
CALL OUTSTR ; output
CLRB VTHINS+29.(A3) ; in case no null at end
LEA A2,VTHINS(A3) ; label field #4 - installation
CALL OUTLIN ; output with cr + lf
LEA A2,LBL5 ; "System"
CALL OUTSTR ; output
CLRB VTHSYS+29.(A3) ; in case no null at end
LEA A2,VTHSYS(A3) ; label field #5 - system
CALL OUTLIN ; output with cr + lf
LEA A2,LBL6 ; "Creator"
CALL OUTSTR ; output
CLRB VTHCRE+29.(A3) ; in case no null at end
LEA A2,VTHCRE(A3) ; label field #6 - creator
CALL OUTLIN ; output field with cr + lf
LEA A2,LBL7 ; "Tape Date"
CALL OUTSTR ; output
LEA A2,RPTWRK(A5) ; base of work area
MOVB #'1,(A2)+ ; century 19xx
MOVB #'9,(A2)+ ; century 19xx
CLR D1 ; clear upper bytes
MOVB VTHDAT+2(A3),D1 ; label field #3 - year
DCVT 2,OT$MEM ; 19yy
MOVB #'/,(A2)+ ; 19yy/
MOVB VTHDAT(A3),D1 ; label field #3 - month
DCVT 2,OT$MEM ; 19yy/mm
MOVB #'/,(A2)+ ; 19yy/mm/
MOVB VTHDAT+1(A3),D1 ; label field #3 - day
DCVT 2,OT$MEM ; 19yy/mm/dd
CLRB (A2)+ ; end output string with null
LEA A2,RPTWRK(A5) ; base of work area
CALL OUTLIN ; output with cr + lf
LEA A2,LBL8 ; "Extra copies"
CALL OUTSTR ; output
CLR D1 ; clear upper bytes
MOVB VTHCOP(A3),D1 ; extra copies
LEA A2,RPTWRK(A5) ; base of work area
DCVT 0,OT$MEM ; output to work area
CLRB (A2)+ ; end output string with null
LEA A2,RPTWRK(A5) ; base of work area
CALL OUTLIN ; output with cr + lf
LEA A2,LBL9 ; "Bootable"
CALL OUTSTR ; output
MOVB #'N,D1 ; no
TSTW VTHBOT(A3) ; blocks in boot file
BEQ NOBOOT ; empty - say nothing
MOVB #'Y,D1 ; yes
NOBOOT: CALL OUTCH ; output
CALL OUTEOL ; output blank line
BR RPTHIS
NOLBL2: LEA A2,LBL10 ; "No tape label"
CALL OUTLIN ; output with cr + lf
;-------------------;
; REPORT HISTOGRAMS ;
;-------------------;
; Uses A0, D0,D1,D2,D3
RPTHIS: CALL OUTEOL ; output blank line
LEA A2,HIS1 ; histogram title 1
CALL OUTLIN ; output with cr + lf
LEA A2,HIS2 ; histogram title 2
CALL OUTLIN ; output with cr + lf
TSTW DETFLG(A5) ; include detail?
JEQ HISTOT ; no - skip to totals
CLR D2 ; start with count 0
LINLOP: CTRLC HISTOT ; allow abort
SET D3 ; last row indicator
LEA A2,RPTWRK(A5) ; base of work area
; Column 1
COL1: MOV D2,D1 ; count size
DCVT 3,OT$MEM ! OT$ZER ; display it
CMP D2,#TABSIZ ; last entry in array?
BEQ 10$ ; yes - indicate so
MOVB #' ,(A2)+ ; no - no indicator
BR 20$
10$: MOVB #'+,(A2)+ ; special indicator
20$: MOVB #' ,(A2)+
MOV INTEND(A5),D0 ; end of intervals histogram
LEA A0,INTHST(A5) ; base of intervals histogram
CALL DOCOL ; display column 2
MOV INTEND(A5),D0 ; end of sample index histogram
LEA A0,INTIDX(A5) ; base of sample index histogram
CALL DOCOL ; display column 2
MOV CRCEND(A5),D0 ; end of CRC counts histogram
LEA A0,CRCHST(A5) ; base of CRC counts histogram
CALL DOCOL ; display column 3
MOV TWOEND(A5),D0 ; end of CRC-pairs histogram
LEA A0,TWOHST(A5) ; base of CRC-pairs histogram
CALL DOCOL ; display column 4
; End of line
CLRB (A2)+ ; end output string with null
LEA A2,RPTWRK(A5) ; base of work area
CALL OUTLIN ; output with cr + lf
INC D2 ; go to next count
TST D3 ; last row?
JEQ LINLOP ; no - do next line
BR HISTOT
DOCOL: CMP D2,D0 ; end of this histogram?
BHI 20$ ; past end - display blanks
BEQ 10$ ; at end - don't change flag
CLR D3 ; before end - clear flag
10$: MOV D2,D0 ; offset
LSL D0,#2 ; longword offset
MOV 0(A0)[D0],D1 ; next interval count
DCVT 8.,OT$MEM ! OT$ZER ; display it
BR 30$ ; skip other display
20$: CALL SPACE8 ; fill with 8 spaces
30$: RTN
; Move 8 spaces to @A2
SPACE8: MOV #8.,D0 ; set countdown
10$: MOVB #' ,(A2)+ ; move 8 blanks
DEC D0 ; countdown
BHI 10$ ; do until zero
RTN
;------------------;
; HISTOGRAM TOTALS ;
;------------------;
HISTOT: LEA A2,HIS3 ; "all"
CALL OUTSTR ; output
LEA A2,RPTWRK(A5) ; base of work area
MOV INTSMP(A5),D1
DCVT 8.,OT$MEM ! OT$ZER ; display it
CALL SPACE8 ; fill with 8 spaces
MOV CRCSMP(A5),D1
DCVT 8.,OT$MEM ! OT$ZER ; display it
MOV TWOSMP(A5),D1
DCVT 8.,OT$MEM ! OT$ZER ; display it
CLRB (A2)+ ; end output string with null
LEA A2,RPTWRK(A5) ; base of work area
CALL OUTLIN ; output with cr + lf
LEA A2,HIS4 ; "Total"
CALL OUTSTR ; output
LEA A2,RPTWRK(A5) ; base of work area
MOV INTTOT(A5),D1
DCVT 8.,OT$MEM ! OT$ZER ; display it
CALL SPACE8 ; fill with 8 spaces
MOV CRCTOT(A5),D1
DCVT 8.,OT$MEM ! OT$ZER ; display it
MOV TWOTOT(A5),D1
DCVT 8.,OT$MEM ! OT$ZER ; display it
CLRB (A2)+ ; end output string with null
LEA A2,RPTWRK(A5) ; base of work area
CALL OUTLIN ; output with cr + lf
CALL OUTEOL ; output blank line
LEA A2,HIS5 ; "Seconds elapsed ="
CALL OUTSTR ; output
GTIMEI D1 ; get time in seconds since midnight
SUB TIMBEG(A5),D1 ; subtract from starting time
BGT 10$ ; if positive, no problem
ADD #86400.,D1 ; add 1 day (86400 seconds)
10$: LEA A2,RPTWRK(A5) ; base of work area
DCVT 0,OT$MEM ; output to work area
CLRB (A2)+ ; end output string with null
LEA A2,RPTWRK(A5) ; base of work area
CALL OUTLIN ; output
CALL RPTTCK ; report ticks and copies
RPTEND: LEA A2,HIS7 ; "Certification"
CALL OUTSTR ; output
CMP D5,#1 ; complete?
BEQ 10$ ; yes - say so
LEA A2,HIS8 ; "aborted"
BR 20$
10$: LEA A2,HIS9 ; "completed"
20$: CALL OUTLIN ; output with cr + lf
TSTW RPTFLG(A5) ; report file?
BEQ 30$ ; no - skip close
CLOSE RPTDDB(A5) ; yes - close report file
30$:
MOVB #7.,D1 ; ASCII bell (ding)
TTY ; get user's attention
;-------------;
; REPORT DONE ;
;-------------;
CRTCLS: CLOSE VCRDDB(A5) ; let others use tape
TYPECR <Certification over> ; exit clearly
EXIT ; bye bye
;**********;
; ROUTINES ;
;**********;
; Display Progress
PROGRS: TSTW PRGFLG(A5) ; is display flag set?
BEQ PRGEND ; no - skip display
MOV VPLBLK(A3),D1 ; total different blocks read
SWAP D1 ; swap words
DCVT 0,OT$TRM ! OT$LSP ; output in decimal
MOV VPLCOP(A3),D1 ; total tape blocks read
SWAP D1 ; swap words
DCVT 0,OT$TRM ! OT$LSP ; output in decimal
MOV VPLCRC(A3),D1 ; bad tape blocks
SWAP D1 ; swap words
DCVT 0,OT$TRM ! OT$LSP ; output in decimal
MOV VPLHRD(A3),D1 ; total hard errors
SWAP D1 ; swap words
DCVT 0,OT$TRM ! OT$LSP ; output in decimal
MOV VPLCOP(A3),D1 ; total tape blocks read
SWAP D1 ; swap words
SUB INTLST(A5),D1 ; change since previous value
CMP D1,INTLOW(A5) ; is it abnormally low?
BHIS 10$ ; no - skip display
TYPE < (> ; yes - draw attention
DCVT 0,OT$TRM ; output in decimal
TYPE <)>
10$:
CRLF
PRGEND: RTN
UPDHIS:
; Update histogram of copy interval sizes
UPDINT: MOV VPLCOP(A3),D1 ; total tape blocks read
SWAP D1 ; swap words
PUSH D1 ; save for below
SUB INTLST(A5),D1 ; change since previous value
POP INTLST(A5) ; remember for next time
ADD D1,INTTOT(A5) ; add to totals
INC INTSMP(A5) ; increment total samples
CMP D1,#TABSIZ ; too big for table?
BLT 10$ ; no - fine
MOV #TABSIZ,D1 ; yes - use last element
10$: PUSH D1 ; save for below
LSL D1,#2 ; create longword offset
LEA A2,INTHST(A5) ; base of histogram table
ADD D1,A2 ; offset to tally
ADD #1,@A2 ; add 1 to tally
LEA A2,INTIDX(A5) ; base of histogram table
ADD D1,A2 ; offset to index
MOV VPLBLK(A3),D1 ; total blocks read
SWAP D1 ; swap words
MOV D1,@A2 ; move block number to index
POP D1 ; recall interval value
CMP D1,INTEND(A5) ; new high value?
BLO 20$ ; no - skip following
MOV D1,INTEND(A5) ; yes - new max count
20$:
; Update histogram of CRC counts
UPDCRC: MOV VPLCRC(A3),D1 ; bad tape blocks
SWAP D1 ; swap words
PUSH D1 ; save for below
SUB CRCLST(A5),D1 ; change since previous value
POP CRCLST(A5) ; remember for next time
MOV D1,DIFNEW(A5) ; save for pairs histogram
ADD D1,CRCTOT(A5) ; add to totals
INC CRCSMP(A5) ; increment total samples
CMP D1,#TABSIZ ; too big for table?
BLT 10$ ; no - fine
MOV #TABSIZ,D1 ; yes - use last element
10$: PUSH D1 ; save for below
LEA A2,CRCHST(A5) ; base of histogram table
LSL D1,#2 ; create longword offset
ADD D1,A2 ; offset to tally
ADD #1,@A2 ; add 1 to tally
POP D1
CMP D1,CRCEND(A5) ; new high value?
BLO 20$ ; no - skip following
MOV D1,CRCEND(A5) ; yes - new max count
20$:
; Update histogram of CRC pair-counts
UPDTWO: MOV DIFNEW(A5),D1 ; fetch current difference
PUSH D1 ; save for below
ADD DIFOLD(A5),D1 ; add to previous difference
POP DIFOLD(A5) ; remember for next time
ADD D1,TWOTOT(A5) ; add to totals
INC TWOSMP(A5) ; increment total samples
CMP D1,#TABSIZ ; too big for table?
BLT 10$ ; no - fine
MOV #TABSIZ,D1 ; yes - use TABSIZ
10$: PUSH D1 ; save for below
LEA A2,TWOHST(A5) ; base of histogram table
LSL D1,#2 ; create longword offset
ADD D1,A2 ; offset to tally
ADD #1,@A2 ; add 1 to tally
POP D1
CMP D1,TWOEND(A5) ; new high value?
BLO 20$ ; no - skip following
MOV D1,TWOEND(A5) ; yes - new max count
20$:
RTN ; progress report done
RPTTCK: LEA A2,HIS6 ; "Sample interval = "
CALL OUTSTR ; output
MOV TIMDIF(A5),D1 ; delay in ticks
LEA A2,RPTWRK(A5) ; base of work area
DCVT 0,OT$MEM ; interval parameter
CLRB (A2)+ ; end output string with null
LEA A2,RPTWRK(A5) ; base of work area
CALL OUTSTR ; output
LEA A2,HIS6A ; " AMO
S ticks = ";
CALL OUTSTR ; output
CALL CALCOP ; copies = ticks / 10000 x 120
CALL OUTSTR ; output
LEA A2,HIS6B ; " tape copies (average)"
CALL OUTLIN ; output with cr + lf
RTN
; Calculate copies per read = ticks / 10000 x 120 (uses D0,D1,D2,D3)
CALCOP: LEA A2,RPTWRK(A5) ; base of work area
; First, do cheap double-precision multiply by 12
MOV TIMDIF(A5),D0 ; D0 = delay (in .0001 second ticks)
LSL D0,#2 ; D0 = delay x 4
MOV D0,D1 ; D1 = delay x 4
LSL D1,#1 ; D1 = delay x 8
ADD D1,D0 ; D0 = delay x 12
; Then, do non-cheap double-precision divide by 1000
MOV #1000.,D1 ; divisor
CALL DIVIDE ; D0 / D1 ===> D2 rem D0
MOV D2,D1 ; integer part
SUB #2,D2 ; this is abnormally low interval
MOV D2,INTLOW(A5) ; use for warning displays
DCVT 0,OT$MEM ; "nnnn"
MOVB #'.,(A2)+ ; "."
MOV D0,D1 ; fractional part
DCVT 3,OT$MEM ; "nnn"
CLRB (A2)+ ; end with null
LEA A2,RPTWRK(A5) ; base of work area
RTN
;-------------------------;
; Extended Divide Routine ;
;-------------------------;
; The 68000 can only divide 32 bits / 16 bits ===> 16-bit quot , 16-bit rem
; The routine below divides 32 bits / 32 bits ===> 32-bit quot , 32-bit rem
; This can be done in one instruction on the 68020
; Reg Input Output
; --- ----------- ---------
; D0 Dividend Remainder
; D1 Divisor Divisor
; D2 [garbage] Quotient
; D3 [garbage] [zero]
DIVIDE:
; Following is the 68000 routine
CLR D2 ; D2 = quotient (clear first)
MOV #1,D3 ; D3 = current quotient bit
SHIFT1: CMP D0,D1 ; can we subtract?
BLO TEST ; no - divisor is shifted enough
ASL D1 ; shift again
BCS BACK ; we went too far!
ASL D3 ; quotient bit similiarly shifted
BR SHIFT1 ; keep going
BACK: ROXR D1 ; undo last shift
TEST: CMP D0,D1 ; can we subtract?
BLO SHIFT2 ; no - go shift
SUB D1,D0 ; subtract divisor multiple
ADD D3,D2 ; add bit to quotient
SHIFT2: LSR D3 ; quotient bit halved
BEQ ENDDIV ; if zero, we are done
LSR D1 ; divisor multiple is halved
BR TEST ; test next quotient subtract
ENDDIV: RTN
; Following is the equivalent 68020 routine
; DIVUL D2:D0,D1
; EXG D0,D2
; RTN
; Output string @A2 to terminal/report and append cr + lf
OUTLIN: CALL OUTSTR ; output string (clears D1)
OUTEOL: MOVB #15,D1 ; return
CALL OUTCH ; output it
MOVB #12,D1 ; line feed
CALL OUTCH ; output it
RTN
; Output string @A2 to terminal/report
OUTSTR: CLR D1 ; clear upper bytes
10$: MOVB (A2)+,D1 ; next byte to output
BEQ 20$ ; if null, done
CALL OUTCH ; output character
BR 10$ ; do another
20$: RTN
; Output character in D1 to terminal/report
OUTCH: TSTW RPTFLG(A5) ; report file?
BEQ 10$ ; no - display
FILOTB RPTDDB(A5) ; output to report file
BR 20$ ; done
10$: TTY ; display
20$: RTN ; done
; Get AM-610 auto-READ status
; uses D0
CHKVCR: JLOCK ; lock out other jobs
MOVB #377,D0 ; set up output
CALL WRCTL1 ; write byte 377 to VCR control port
10$: MOVB @A4,D0 ; read from VCR control port
BMI 10$ ; repeat until 200 bit clear
CLRB @A4 ; write byte 000 to VCR control port
GTPARM VCRDDB(A5) ; get VCR parameters
CTRLC TAPABT ; allow control-C
ANDB #40,D0 ; test 40 bit of last VCR port status
BNE TAPDON ; set - tape finished reading
MOVB #33,D0 ; setup output (27 = check auto-read)
20$: CALL WRCTL1 ; write 027/015 to VCR control port
MOVB @A4,D6 ; read VCR control port
BPL 20$ ; repeat until 200 bit set
CLRB @A4 ; write byte 000 to VCR control port
TAPRED: JUNLOK ; let in other jobs
RTN ; done
TAPDON: MOV #1,D5 ; indicate tape is COMPLETE
BR TAPRED ; unlock and return
TAPABT: MOV #2,D5 ; tape ABORTED
BR TAPRED ; unlock and return
; Write byte to VCR control port
; D0 = the output byte
WRCTL1: SUPVR ; go into SUPERVISOR mode
MOV #^H00FFFFD4,A4 ; AM-610 control port
10$: LSTS #23400 ; set SUPERVISOR & interrupt mask 7
MOVB @A4,D6 ; read VCR control port
ANDB #10,D6 ; test 10 bit
BEQ 20$ ; bit clear - VCR is ready
LSTS #20000 ; set SUPERVISOR & no interrupts
BR 10$ ; try again
20$: MOVB D0,@A4 ; write byte to VCR control port
LSTS #20000 ; set SUPERVISOR mode
; Following instruction is not allowed by M68.LIT
; ANDW #^C20000,SR ; exit SUPERVISOR mode
WORD 1174,157777 ; this assembles to same bits
RTN
; Write (D0,000) bytes to VCR control port
; D0 = the output byte
WRCTL2: CALL WRCTL1 ; write D0 to VCR control port
MOVB @A4,D6 ; read from VCR control port
BPL WRCTL2 ; repeat until 200 bit set
CLRB @A4 ; write zero to VCR control port
10$: MOVB @A4,D6 ; read from VCR control port
BMI 10$ ; repeat until 200 bit clear
RTN ; done
SPEC1: ASCII /VCRSTS.LST/
BYTE 15
SPEC2: ASCII /VCR0:/
BYTE 15
EVEN
USEMSG: ASCII "Usage: CRT611 /F/P/N/I:n (n in .0001 second ticks)"
BYTE 15,0
LBL1: ASCII /Tape labeled as:/
BYTE 0
LBL2: ASCII / Volume Name : /
BYTE 0
LBL3: ASCII / Volume ID : /
BYTE 0
LBL4: ASCII / Installation: /
BYTE 0
LBL5: ASCII / System : /
BYTE 0
LBL6: ASCII / Creator : /
BYTE 0
LBL7: ASCII / Tape date : /
BYTE 0
LBL8: ASCII / Extra copies: /
BYTE 0
LBL9: ASCII / Bootable : /
BYTE 0
LBL10: ASCII /%No tape label/
BYTE 0
HIS1: ASCII /SIZE CPYFREQ BLOCK# CRCFREQ CRCPAIR/
BYTE 0
HIS2: ASCII /---- ------- ------- ------- -------/
BYTE 0
HIS3: ASCII /ALL /
BYTE 0
HIS4: ASCII /TOTAL/
BYTE 0
HIS5: ASCII /Seconds elapsed = /
BYTE 0
HIS6: ASCII /Sample interval = /
BYTE 0
HIS6A: ASCII / AMOS ticks = /
BYTE 0
HIS6B: ASCII / tape copies (average)/
BYTE 0
HIS7: ASCII /Certification /
BYTE 0
HIS8: ASCII /aborted/
BYTE 0
HIS9: ASCII /completed/
BYTE 0
EVEN
ASECT
.=0
VCRDDB: BLKB D.DDB ; Certification DDB
BUFADR: BLKL 1 ; address of DDB buffer (temporarily saved)
VCRLBL: BLKB 1000 ; VCR tape label (null if not found)
RPTDDB: BLKB D.DDB ; report file DDB
RPTWRK: BLKB 80. ; report work area
INTLST: BLKL 1 ; last total copies from AM-610
INTHST: BLKL TABSIZ+1 ; number of intervals of each size
INTIDX: BLKL TABSIZ+1 ; index of last sample with this size
INTEND: BLKL 1
INTTOT: BLKL 1 ; sum of INTHST array
INTSMP: BLKL 1 ; number of interval samples
INTLOW: BLKL 1 ; abnormally low copies interval
CRCLST: BLKL 1 ; last total CRC from AM-610
CRCHST: BLKL TABSIZ+1 ; number of CRC counts of each size
CRCEND: BLKL 1
CRCTOT: BLKL 1 ; sum of CRCHST array
CRCSMP: BLKL 1 ; number of CRC samples
DIFOLD: BLKL 1 ; last CRC difference
DIFNEW: BLKL 1 ; current CRC difference
TWOHST: BLKL TABSIZ+1 ; number of CRC pair-counts of each size
TWOEND: BLKL 1
TWOTOT: BLKL 1 ; sum of TWOHST array
TWOSMP: BLKL 1 ; number of CRC pair samples
PRGFLG: BLKW 1 ; non-zero for progress display
RPTFLG: BLKW 1 ; non-zero for final results report
DETFLG: BLKW 1 ; non-zero to include details in report
TIMBEG: BLKL 1 ; time when certify began
TIMDIF: BLKL 1 ; delay between samples in ticks (.0001 sec)
MEMLTH: ; memory used
ASECT
.=0
; Format of VCR Tape Header Block
VTHCOD: BLKL 1 ; 000 - VCR Tape Header code (hex AAAA5555)
VTHNAM: BLKB 40. ; 004 - Volume Name
VTHVID: BLKB 10. ; 054 - Volume ID
VTHCRE: BLKB 30. ; 066 - Creator
VTHINS: BLKB 30. ; 124 - Installation
VTHSYS: BLKB 30. ; 162 - System
VTHDAT: BLKL 1 ; 220 - Date (AMOS separated format)
BLKB 32. ; 224 - ?
VTHBOT: BLKW 1 ; 264 - Blocks in Warm Boot File
VTHVER: BLKW 1 ; 266 - VCR Tape Format Version (=2)
VTHTIM: BLKL 1 ; 270 - Time (in AM-100 ticks, words swapped)
VTHFLG: BLKB 1 ; 274 - Flags (=1)
VTHCOP: BLKB 1 ; 275 - Extra copies (/C:nnn)
ASECT
.=0
; Format of VCR Parameter List in GTPARM,STPARM monitor calls (undocumented)
VPLRPT: BLKB 1 ; copies to write
BLKB 3 ; ?
VPLBLK: BLKL 1 ; Block read/written (swap words in Dn)
VPLCOP: BLKL 1 ; Copies read (swap words in Dn)
VPLCRC: BLKL 1 ; CRC errors (swap words in Dn)
VPLHRD: BLKL 1 ; Hard errors (swap words in Dn)
END
