.TITLE NETCLK Set system clock from Internet host .NLIST BEX .ENABL LC ; ; Set system clock from Internet host ; ; This program sets the local date and time of day from a specified Internet ; host. ; ; External symbols ; .GLOBL CTRL,NETMSG,RTNMSG ;network routines .GLOBL RNAME ;domain-name server ; ; Entry symbols ; .GLOBL PRBYT ;char i/o routines ; ; System definitions ; .ASECT .MCALL .COM,.CHR,.TRDEF,.GCLK,.WIND,.TRAP ;dcnlib macros .MCALL .TTYOU,.EXIT,.QSET ;rt-11 macroni .MCALL .SPND,.RSUM,.MRKT,.CMKT,.SCCA .MCALL $DFIH,$DFUH,$DFSIG ;moslib macroni .MCALL CALL,FORMAT ;netlib macros .COM ;define common data .CHR ;define ascii character codes $DFIH ;define internet header $DFUH ;define user datagram header $DFSIG ;define interprocess signals .TRDEF ;define trap codes ; ; Module definitions ; QUESIZ = 20. ;max elements on completion queue TCBSIZ = 256. ;size of tcb S.TIM = 37. ;time port number RTXTIM = 5*60. ;retry timeout (five seconds) RTXMAX = 4 ;max retries ; ; Procedure segment ; .PSECT $BOSI,RO,I ; ; NIC data-base query program ; START: BIS #40000,@#44 ;disable folding .QSET #QUEUE,#QUESIZ ;allocate space for completion queue MOV #512,R1 ;is argument in chain area TSTB @R1 BNE 1$ ;branch if yes MOV #TIMNAM,R1 ;no. use default 1$: CALL RNAME,R1,#CCBADR,#0 ;fetch Internet address TST R0 BEQ 2$ ;branch if found JSR PC,PRIDNT ;error. display message JSR PC,RTNMSG .EXIT ; 2$: MOV #S.TIM,CCBADR+4 ;insert port SWAB CCBADR+4 ;swab decks CLR SCCA ;disable control-c .SCCA #ARGBLK,#SCCA MOV #RTXMAX,RETRY CLR TCB ;(pass check in open) CALL CTRL,#CM.OPN,#CCB,#TCB ;open connection TST R0 BEQ 3$ ;branch if no error JSR PC,PRIDNT ;error. display message JSR PC,RTNMSG .EXIT ; 3$: .SPND ;lots happen in there .EXIT ; ; Net trap routine ; NCA: MOV SD.ADR(R0),R1 ;get signal particulars MOV SD.CHN(R0),R0 BIC #^C17,R0 ;decode signal MOV R0,R2 ASL R2 ADD R2,PC BR SIGOPN ;0 open BR SIGERR ;1 connection error BR SIGERR ;2 host not responding BR SIGCLS ;3 closed BR SIGDAT ;4 data available BR SIGERR ;5 connection reset BR SIGERR ;6 send complete BR SIGERR ;7 remote disconnect BR SIGERR ;10 remote interrupt BR SIGERR ;11 nsp (decnet) ; SIGERR: JSR PC,PRIDNT ;net error. display message JSR PC,NETMSG RTS PC ; SIGCLS: .RSUM ;close complete. unlock mainline RTS PC ; SIGOPN: TST SCCA ;is control-c pending BNE SIG77 ;branch if yes CALL CTRL,#CM.GET,#TEMP,#TCB ;no. allocate and init ip datagram TST R0 BEQ 1$ ;branch if no error JSR PC,PRIDNT ;display error message JSR PC,RTNMSG BR 6$ ; 1$: MOV TEMP,R1 ;get packet pointers MOV #UH.LEN,PH.LNG(R1) ;compute checksum MOV PH.TIM+2(R1),DELAY ;send udp datagram CALL CTRL,#CM.UDP,R1,#TCB TST R0 BEQ 6$ ;branch if no error JSR PC,PRIDNT ;display error message JSR PC,RTNMSG 6$: .MRKT #ARGBLK,#TIME1,#SMPSRV,#1 ;arm watchdog bark RTS PC ; SMPSRV: DEC RETRY ;has max retries been reached BNE SIGOPN ;branch if no FORMAT #COM20 ;timeout SIG77: BR SIGERY ; SIGDAT: CLR R0 ;map packet into user space .WIND CMP PH.LNG(R1),#UH.LEN+4 ;is format correct BHIS 1$ ;branch if yes FORMAT #COM21 ;invalid packet format CALL CTRL,#CM.FRE,R1,#TCB ;free ip packet RTS PC ; 1$: .CMKT #ARGBLK,#1,#0 ;kill timeout SUB PH.TIM+2(R1),DELAY ;compute delay NEG DELAY MOV R1,-(SP) ;shuffle packet pointers MOV R1,R2 ADD PH.OFS(R1),R2 ADD #UH.LEN,R2 ;convert to dcnet format MOV (R2)+,R0 SWAB R0 MOV (R2)+,R1 SWAB R1 JSR PC,PRCLK .GCLK ;compute time-of-day offset COM R0 COM R1 ADD #1,R1 ADC R0 ADD TEMP+2,R1 ADC R0 ADD TEMP,R0 MOV R1,OFFSET+2 MOV R0,OFFSET .TRAP #TR.CLK,#0*400+CK.UDP,#5000.,DATE,OFFSET,OFFSET+2 FORMAT #COM27 ;confirm clock set FORMAT #COM28,#CCB MOV (SP)+,R1 CALL CTRL,#CM.FRE,R1,#TCB ;free ip packet SIGERY: CALL CTRL,#CM.CLS,#0,#TCB ;udp close RTS PC ; ; Subroutine to write byte ; R0 = byte ; PRBYT: .TTYOU ;put byte RTS PC ; ; Subroutine to display program ident ; PRIDNT: MOV R0,-(SP) ;appear transparent MOV #COM00,R0 ;display program ident JSR PC,FORMAT MOV (SP)+,R0 RTS PC ; ; Prclk (clk) convert from julian clock ; R0-r1 = julian (ien-142) clock ; PRCLK: MOV R2,-(SP) ;save registers MOV R3,-(SP) MOV R4,-(SP) SUB #58752.,R1 ;(2,272,060,800) 0000 1 january 1972 SBC R0 SUB #34668.,R0 CLR R2 ;divide by 60*60*24 CLR R3 MOV #33.,R4 1$: ROL R3 ;shift partial remainder left ROL R2 ADD #-20864.,R3 ;(-86400) ADC R2 ADD #-2.,R2 BCS 2$ ;branch if no underflow SUB #-20864.,R3 ;(-86400) underflow. restore partial remainder SBC R2 SUB #-2.,R2 2$: ROL R1 ;rotate partial quotient left ROL R0 DEC R4 BNE 1$ MOV R1,DATE ;save day CLR R1 ;convert time-of-day to milliseconds MOV #33.,R4 3$: ASR R1 ;shift partial product right ROR R2 ROR R3 BCC 4$ ;branch if lsb = 0 ADD #1000.,R1 ;lsb ~= 0. add multiplier 4$: DEC R4 BNE 3$ MOV R2,TEMP ;store time-of-day MOV R3,TEMP+2 MOV (SP)+,R4 ;restore registers MOV (SP)+,R3 MOV (SP)+,R2 RTS PC ; ; Data segment ; .PSECT $BOSD,RO,D ;read-only data ; TIME1: .WORD 0,RTXTIM ;reply timeout TIMNAM: .ASCIZ 'DCN1.ARPA' ;default master-clock host name COM00: .ASCIZ '?NETCLK-^+' COM20: .ASCIZ '?NETCLK-F-Reply timeout' COM21: .ASCIZ '?NETCLK-W-Invalid packet format' COM27: .ASCIZ '?NETCLK-I-Clock set to ^LD ^LT^+' COM28: .ASCIZ ' from ^C' .EVEN ; .PSECT $DATA,RW,I ;initialized read/write data ; ; Connection control block ; CCB: .WORD TCBSIZ ;ccb length .WORD NCA ;completion routine .BYTE P.UDP,0 ;protocol, flags .WORD 0,0,0 ;local socket (default) CCBADR: .WORD 0,0,0 ;remote socket .WORD 0,0 ;max datagram size, options (default) ; .PSECT $ERAS,RW,I ;read/write data ; STOBGN = . ;format fence ARGBLK: .BLKW 5 ;rt-11 argument block SCCA: .BLKW 1 ;control-c switch RETRY: .BLKW 1 ;retry count DELAY: .BLKW 1 ;roundtrip time DATE: .BLKW 1 ;date returned from master clock TEMP: .BLKW 2 ;time returned from master clock OFFSET: .BLKW 2 ;computed local clock offset QUEUE: .BLKW QUESIZ.*7. ;space for completion queue TCB: .BLKW TCBSIZ ;transmission control block ; .END START