.MCALL .MODULE .MODULE NL,VERSION=12,COMMENT=,AUDIT=YES ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the ; inclusion of the above copyright notice. This software, or ; any other copies thereof, may not be provided or otherwise ; made available to any other person except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. .SBTTL CONDITIONAL ASSEMBLY SUMMARY ;+ ;COND ; ; MMG$T std conditional ; If MMG$T=1, SET NL [NO]SYSGEN exists ; ; TIM$T std conditional (no code effects) ; ERL$G std conditional (no code effects) ;- .MCALL .DRDEF .ASSUME .ADDR .Wait .ReadC .MCALL .Br .SDTTM .LIBRARY "SRC:SYSTEM" .MCALL .SYCDF .FIXDF .HANDF ..READ .CF1DF .SYCDF .FIXDF .CF1DF .HANDF ..READ .DRDEF NL,25,0,0,0,0,DMA=NO .DRPTR .DREST CLASS=DVC.NL .Sbttl ************************************* .SbTtl * Install Code * .Sbttl ************************************* .Sbttl .DRINS - Install Entry .Enabl LSB Ins.CSR =: 176 ; install CSR value Ins.DK =: 200 ; install EP for non-system device Ins.SY =: 202 ; install EP for system device BotChn =: 0 ; Boot-time channel number SysChn =: 17 ; Overlay channel number Block0 =: 0 Blk =: 1000 ; block size for disks V.Inst =: 010 ; vector for invalid instruction trap MFPT.J =: 5 ; value returned by MFPT for J11s AddSR = 177526 ; KDJ-11E Additional Status Register (11/93-94 only) TOYCom = 400 ; R/W bit for Time-Of-Year clock communication CMR =: 177750 ; CPU Maintenance Register (J11s) CMR.ID =: 000360 ; Area containing module ID J11E =: 05*20 ; Value for KDJ11-E .Assume . LE Ins.CSR .DrIns NL Ins$DK: Br 20$ ; non-system device .Assume . EQ Ins.SY Ins$SY: Br InsNo ; system device, invalid 20$: .TOY: Nop ;NOTOY sets this to RETURN ; get second block of install code .Wait #SysChn ; is this boot time? Bcc 30$ ; no, then channel 17 is used ;;; RETURN ;*DEBUG* no overlay on BOOT .Assume BotChn EQ 0 .Wait #0 ; is the boot channel open? Bcs InsNo ; no, then give up .Assume BotChn EQ 0 ClrB ReaChn ; use boot time channel Mov @R3,BlkAdd ; get increment value for block number 30$: Mov #OvrIns/2,R3 ; point to overlay install code .Br GetOvr ; go get it .Dsabl LSB .SbTtl GetOvr -- overlay handler for INSTALL code ;+ ; GETOVR ; ; Get INSTALL overlay and jump to code in it ; ; R3 contains Addr/2 of the place to get control. ; ; R3 is destroyed ; ; Cond codes destroyed ;- .Enabl LSB GetOvr: ; read "Install overlay" SwaB R3 ; get block number to low byte MovB R3,ReaBlk ; set block number to read Add #.-.,ReaBlk ; add in offset (boot time install) BlkAdd =: .-4 Bic #377,R3 ; clear out old block number Bis #NLStrt/Blk,R3 ; use Queue code block for address Jsr R0,20$ ; save R0, point to arg blk **PIC** ReaChn: .Byte SysChn+.-. ; channel ReaCod: .Byte .Read+.-. ; request code ReaBlk: .BlkW 1 ; block number to read ReaBuf: .BlkW 1 ; buffer address to read into .Word Blk/2 ; words to read .Word ..WtIO ; .ReadW 20$: .Addr #NLStrt,R5,PUSH ; == Push R5/ ADDR NLStrt**PIC** Mov R5,ReaBuf ; set address of read buffer Mov (SP)+,R5 ; restore work register .ReadC Code=NOSET ; do the read ; This is really a .READW Mov (SP)+,R0 ;*C* restore saved register Bcs SYWLEr ; overlay read/write failed SwaB R3 ; get address back Asl R3 ; make into byte offset .Addr #Block0,R3,ADD ; make into real address **PIC** Jmp @R3 ; go to it. .SbTtl SY: I/O error SYWLEr: BitB #1,ReaCod ; a read or a write? Beq SetEr2 ; read SYWLOv: ; entry from overlay write Mov @SP,R0 ; get return address Inc R0 ; point to returned opcode CmpB #BR/400,(R0)+ ; is it a BR ... ? Bne SetEr2 ; then no second return point Mov R0,@SP ; else take WRITELOCKED exit SetEr2: InsNo: Sec Return .Assume . LE 400 .Dsabl LSB .DrSet TOY,RETURN,O.Toy, .If ne MMG$T ALLSYS =: ^b11111111 ;all the bits in the sysgen byte .DrSet SYSGEN,ALLSYS,O.Sys, .EndC ;ne MMG$T O.Toy: Mov #NOP,R3 ;perform TOY operation N.Toy: .Assume O.Toy+4 eq N.Toy Mov R3,.TOY ;patch in instruction to Install code Return ;done .If ne MMG$T O.Sys: Clr R3 ;normal entry Nop N.Sys: .Assume O.Sys+4 eq N.Sys Mov @#$SyPtr,R0 ;-> RMON MovB $Sysge(R0),R1 ;get SYSGEN byte Tst R3 ;Which kind of entry? ; Clc ;carry cleared by Tst instruction Beq 10$ ;*C*normal entry, match SYSGEN Xor R3,R1 ;*C*flip the bits 10$: MovB R1,H.Gen ;*C*set the SYSGEN byte in the handler Return ;done .EndC; ne MMG$T .Assume . LE 1000 ; START OF HANDLER .DRBEG NL .ADDR #NLCQE,R4 ;-> CQE MOV @R4,R5 ;-> Q element 3rd word. TST Q$WCNT(R5) ;Test if read or write BMI NLEXIT ;Write - done go to complete BIS #EOF$,@-(R5) ;Read - EOF then go to complete NLEXIT:: ;;; .DRFIN NL ;EXIT ; ;R4 set from above MOV @#$SYPTR,R5 JMP @$QCOMP(R5) ;Go to I/O complete RETURN: RETURN ;Abort entry NLINT:: .Assume .-2 EQ RETURN,MESSAGE=<;INT entry must be just after a RETURN>; .IF ne MMG$T .DREND NL,FORCE=ALLSYS ;Gen max comm vector .IfF; ne MMG$T .DREND NL .EndC; ne MMG$T .SbTtl OvrIns - install overlay to use 11/9x clocks .PSect Pad000 .PSect SetOvr,I OvrIns:: ;;; bpt ;*debug* Mov #V.Inst,R1 ;point to invalid instruction vector Mov @R1,-(SP) ;save old address .Addr #InvIns,-(SP) ;get address of our routine Mov (SP)+,@R1 ;use it MFPT ;get processor type (or trap) Mov (SP)+,@R1 ;restore old address Cmp #MFPT.J,R0 ;is it a J-11? Bne 10$ ;no, done Mov @#CMR,R0 ;get the module type number Bic #^cCMR.ID,R0 ;clear junk out Cmp #J11E,R0 ;is it an 11/9x processor? Bne 10$ ;no Call DoClk 10$: Return InvIns:: Clr R0 ;Return non J-11 code Rti DoClk: call GetTOY ;Get Time-Of-Year clock contents .sbttl . Convert clock date to RT-11 format. ; Convert the BCD date read from the clock to the standard RT-11 format: ; ; RT-11 extended date word (RT-11 V5.5ff) ; ; 15 14 13 12 11 10 9 8 | 7 6 5 4 3 2 1 0 ; +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ ; |yr xtn | month | day | year-1972 | ; +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ ; 2 bits 4 bits 5 bits 5 bits ; ; ; To support the year extension, clock years of 72..99 can be considered to ; be in the 1900s (since the RT-11 base year of 1972) and years of 00..71 can ; be considered to be in the 2000s. movb T.mon,r0 ;Get month number, convert it from call BCD2bn ; BCD to binary and put it into mov r0,r1 ; into the date assembly register movb T.day,r0 ;Get day number, convert it from call BCD2bn ; BCD to binary, shift month by ash #5,r1 ; 5 bits and merge day and month bis r0,r1 ; into date assembly register movb T.year,r0 ;Get year number, convert it from call BCD2bn ; BCD to binary, bias it from Clr R2 ;assume no Age bits sub #72.,r0 ; RT-11 year zero, shift the Bpl 11$ ;1972-1999 Add #100.,R0 ;2000-2071 Mov R0,R2 ;copy age bits Bic #^c37,R0 ;leave only year bits Bic #37,R2 ;leave only age bits Ash #9.,R2 ;move to age area 11$: ash #5,r1 ; month & day by another 5 bits bis r0,r1 ; and merge year with the rest bis R2,R1 ; and merge age bits too mov r1,NewDat ;Set up new date argument .sbttl . Convert clock time to RT-11 format. ; Convert the BCD time read from the clock to the standard RT-11 format: ; ; 15 14 13 12 11 10 9 8 | 7 6 5 4 3 2 1 0 ; +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ ; 0 | high order time (ticks past midnight) | ; +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ ; 2 | low order time (ticks past midnight) | ; +---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+ ; MovB T.hrs,r0 ;Get hour of the day, convert it from Call BCD2bn ; BCD to binary and multiply it by Mov @#$SyPtr,R2 ;point to RMON .Addr #Hz60,R3 ;assume 60Hz Bit #Clk50$,$Cnfg1(R2) ;is it 50Hz? Beq 12$ ;no .Addr #Hz50,R3 ;yes, use alternative constants 12$: mul (R3)+,r0 ; use 6750. or 5625. then shift ashc #5,r0 ; it left by 5 bits and store the mov r0,NewTim ; time area mov r1,NewTim+2 movb T.min,r0 ;Get minute in hour, convert it from call BCD2bn ; BCD to binary, multiply it by mul (R3)+,r0 ; 3600./3000. & add the 32-bit result add r1,NewTim+2 ; into the accumulating double- adc NewTim ; precision ticks add r0,NewTim movb T.sec,r0 ;Get second in minute, convert it from call BCD2bn ; BCD to binary, multiply it by mul (R3)+,r0 ; 60. / 50. and add the 32-bit result add r1,NewTim+2 ; into the accumulating double- adc NewTim ; precision ticks add r0,NewTim ; The last 2 digits are the tenths and hundreths (fractional) of seconds. The ; clock resolution is 100/second but the system clock resolution is 60/second ; (assumed to be US LTC). After converting the digits from BCD to binary, ; they are fractional seconds * 100 (an integer value). Multiply by 6 and ; divide by 10 to get clock ticks. (Modified for 50 Hz also) movb T.fsec,r0 ;Get fractional seconds, convert from call BCD2bn ; BCD to binary, multiply it by mul (R3)+,r0 ; 5|6 to get fract_sec*500|600., then div #10.,r0 ; divide by 10. to get ticks and add r0,NewTim+2 ; add into the accumulating double- adc NewTim ; precision ticks. .Addr #SDTarg,R0 .Addr #NewDat,R1 .sdttm R0,R1 ;Set new system date and time return ;done .sbttl Subroutine to get the Time-Of-Year clock contents ; Read 64 bits (8 bytes) from the clock chip and store them in memory. After ; calling SetTOY to set up the DS1215, the words are read starting with the ; lowest bit of the tenths/hundredths of seconds byte and continuing through ; the tens/ones of year byte. The 64 bits read are stored into 4 words by ; shifting 16 bits into each word; the 16 bits are shifted left-to-right into ; a word, exactly filling the word in the correct order. ; ; The subroutine uses R1, R3, R4 and R5. SetTOY loads R0 with the address of ; the high byte of AddSR and loads R2 with the shifted contents of the high ; byte of AddSR (required for writing). GetTOY:: call SetTOY ;Set up Time-Of-Year clock for reading .Addr #TOYdat,r1 ;Point to save area for data mov #4.,r3 ;Load count of words to read/store 40$: mov #16.,r4 ;Load count of bits per word 50$: movb (r0),r5 ;Get high byte value, asr r5 ; shift low bit into Carry ror (r1) ; and shift Carry into save area sob r4,50$ ;Loop to fill 16-bit word with data tst (r1)+ ;Point to next data word sob r3,40$ ;Loop to fill 4 words (8 bytes) return .sbttl Subroutine to set up the Time-Of-Year clock for read or write ; The DS1215 is accessed serially through the TOYCom bit (the low bit of the ; high byte) in the "Additional Status Register" (AddSR). Before data can be ; read from or written to the chip, it must be sent a 64-bit enable pattern; ; this subroutine sends the enable pattern to the chip. ; ; Reading from the chip is not a problem since the other bits in the AddSR ; can be ignored, but writes should not disturb any of the other bits since ; some of them control the KDJ11-E board configuration. This problem is re- ; solved by first reading and saving the register bits and then reloading all ; of the other bits each time a bit is sent to the chip. ; ; Since sending the enable pattern to the chip must be preceeded with a read ; from the chip, the read is also used to get the other bits that must be re- ; loaded into the AddSR with each write. Then the 4 16-bit pattern words are ; send to the chip with 64 writes. ; ; On subroutine exit: the chip is ready to have its 8 bytes of time and date ; information either read or written, R0 contains the address of the high byte ; of AddSR and R2 contains the shifted contents of the high byte of AddSR (for ; writing data to the chip). R2, R3, R4 and R5 have all been modified. SetTOY:: mov .CSR,r0 ;Get address of Add'l Status Reg, inc r0 ; increment to high byte and .Addr #TOYpat,r1 ; point to the match pattern. movb (r0),r2 ;Get (READ) contents of high byte, asr r2 ; shift it right to vacate bit 0 10$: mov (r1)+,r3 ;Get next match pattern word beq 30$ ; Zero = end of table mov #16.,r4 ;Load count of bits 20$: mov r2,r5 ;Copy shifted old value to work reg, asr r3 ; shift low match bit into Carry, rol r5 ; shift it back into data byte and movb r5,(r0) ; WRITE match bit to Status Reg. sob r4,20$ ;Loop until all bits done in this word br 10$ ;Word done, go try next one 30$: return .sbttl Subroutine to convert a BCD byte (2 digits) to binary ; Called with the BCD digit pair in the low byte of R0; returns with the ; binary equivalent in R0. All other registers are preserved. ; ; On entry, R0 contains 2 decimal digits, D1 (the tens digit) and D0 (the ones ; digit), in the form D1*16.+D0. We want R0 to contain D1*10.+D0. Subtract- ; ing D1*6 from R0 will produce the correct value. This method is called ; "radix deflation"; I first saw it in the mid-1970s in a DECUScope article ; by Carl Lowenstein of UCSD which contained a short and fast deflation rout- ; ine for 3 BCD digits in a 12-bit PDP-8 word. BCD2bn: mov r1,-(sp) ;Save register for work bic #^c377,r0 ;Clear any sign extension in hi byte mov r0,r1 ;Copy the BCD digits to work register bic #^c<17*16.>,r1 ; Mask off D0, leaving D1*16. asr r1 ; Shift to D1*8. asr r1 ; Shift to D1*4. sub r1,r0 ; D1*16.+D0 - D1*4 = D1*12.+D0 asr r1 ; Shift to D1*2. sub r1,r0 ; D1*12.+D0 - D1*2 = D1*10.+D0 mov (sp)+,r1 ;Restore saved register return TOYpat: .word 35305,56243,35305,56243 ; 64-bit "match" pattern .word 0 ;End of table marker Hz60: .word 6750.,3600.,60.,6. ;hrs*32.,minutes,seconds,hundredths Hz50: .word 5625.,3000.,50.,5. ;hrs*32.,minutes,seconds,hundredths .even ;MUST start on WORD boundary TOYdat: ;Space for 8 bytes of data (2 BCD digits @): T.fsec: .byte ; Fractional Seconds (tenths & hundreths) T.sec: .byte ; Seconds (tens & ones) T.min: .byte ; Minutes (tens & ones) T.hrs: .byte ; Hours (12/24, Am/Pm, ten, ones) T.dow: .byte ; Day of week (control bits, ones) T.day: .byte ; Day (tens & ones) T.mon: .byte ; Month (ten & ones) T.year: .byte ; Year (tens & ones) SDTarg: .byte 0,40 ;Argument block for .SDTTM .BlkW 1 ;Address of 3-word parameter block NewDat: .word -1 ;RT-11 format date word NewTim: .word -1 ;High order time word .word 0 ;Low order time word .CSR:: .word AddSR ; Additional Status Register address .END