.TITLE WAIT ; ; THIS ROUTINE IS CALLABLE FROM A FORTRAN PROGRAM ; "CALL WAIT (I)" WHERE I IS AN INTEGER*2 VARIABLE ; IN TENTHS OF SECONDS ; ; FOR CONTROL Y TO WORK CORECTLY THE IMAGE ; MUST BE INSTALLED WITH LOG_IO PRIV. ; ; D. R. BLACK 1/19/81 ; $SSDEF $IODEF DELTA_TIM: .QUAD 0 CONST: .LONG -1000000 .LONG -1 LOG_NAME: .LONG INPUT_DESC TT_DESC: .ASCID /_TT/ INPUT_DESC: .ASCID /SYS$INPUT/ DEV_DESC: PHYS_NAME_LEN: .LONG 63 PHYS_NAME_ADR: .LONG PHYS_NAME PHYS_NAME: .BLKB 63 TT_CHAN: .BLKW 1 VECTOR: .LONG 2 .LONG SS$_NORMAL .LONG 0 FIRST: .LONG 0 ; .ENTRY WAIT,^M BLBC FIRST,2$ ;IS THIS THE FIRST TIME THROUGH BRW 8$ ;NO - GO TO WAIT SECTION 2$: ;YES MOVL #1,FIRST ;SET INDICATOR 30$: $TRNLOG_S LOGNAM=@LOG_NAME,- ;TRANSLATE LOGICAL NAME RSLLEN=PHYS_NAME_LEN,- RSLBUF=DEV_DESC CMPL R0,#SS$_NOTRAN ;WAS THERE A TRANSLATION? BNEQU 5$ ;YES - CONTINUE BRW 8$ ;NO - FORGET IT 5$: CMPB PHYS_NAME,#^X1B ;DOES NAME START WITH ESCAPE? BNEQU 40$ ;NO SUBL #4,PHYS_NAME_LEN ;YES, STRIP OFF 4 CHAR. ADDL #4,PHYS_NAME_ADR 40$: CMPC3 #1,@TT_DESC+4,@DEV_DESC+4 ;IS FIRST CHAR. A '_'? BEQLU 50$ ;YES MOVAL DEV_DESC,LOG_NAME ;NO - SETUP FOR ANOTHER ;TRANSLATION BRB 30$ ;GO DO IT 50$: CMPC3 #3,@TT_DESC+4,@DEV_DESC+4 ;IS THIS DEVICE A TERMINAL? BEQLU 51$ ;YES CONTINUE BRW 8$ ;NO - GO TO WAIT SECTION ; 51$: $ASSIGN_S DEVNAM=DEV_DESC,CHAN=TT_CHAN BLBS R0,6$ BRW ERROR 6$: MOVL PHYS_NAME_ADR,R0 ;PUT PHYS NAME IN R0 INCL R0 ;INCREMENT PAST '_' CMPW (R0),#^X5454 ;IS THIS DEVICE A TERMINAL BNEQ 8$ ;NO ; $QIOW_S CHAN=TT_CHAN,- ;QIO TO SET UP THE FUNC=#IO$_SETMODE!IO$M_CTRLYAST,- ;SET UP ^Y AST P1=CTRLAST- P3=#3 CMPL R0,#1 ; BEQL 8$ ;EQ, MUST BE OK SKIP ^C CMPL R0,#SS$_NOPRIV ; BEQL 7$ ;IF NO_PRIV, SET UP ^C BRW ERROR ;ELSE BLEW IT 7$: $QIOW_S CHAN=TT_CHAN,- FUNC=#IO$_SETMODE!IO$M_CTRLCAST,- ; ^C AST P1=CTRLAST- P3=#3 CMPL R0,#1 BEQL 8$ BRW ERROR 8$: MOVQ CONST,R2 MOVZWL @4(AP),R4 CLRQ R5 EMUL R2,R4,#0,R6 ;MULT. LOW HALF MULL3 R3,R4,R0 ;HIGH HALF=R3(HIGH)*R4(LOW) MULL3 R2,R5,R1 ;+R2(LOW)*R5(HIGH) ADDL R1,R0 ;COMBINE TSTL R2 ;IF R2(LOW)<0 BGEQ 10$ ;NO ADDL R4,R0 ;COMPENSATE FOR UNSIGNED BIAS OF 2**32 10$: TSTL R4 ;IF R4(LOW)<0 BGEQ 20$ ;NO ADDL R2,R0 ;COMPENSATE FOR UNSIGNED BIAS OF 2**32 20$: ADDL R0,R7 ;COMBINE WITH HIGH HALF OF R2(LOW)*R4(LOW) ; MOVQ R6,DELTA_TIM $SCHDWK_S DAYTIM=DELTA_TIM $HIBER_S RET ; ERROR: PUSHL R0 $CANWAK_S , CALLS #1,@#LIB$SIGNAL $CANCEL_S TT_CHAN $EXIT_S CTRLAST: $CANWAK_S ; $PUTMSG_S MSGVEC=VECTOR $CANCEL_S TT_CHAN $EXIT_S .END