home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / rt11pascal.zip / rttime.pas < prev    next >
Pascal/Delphi Source File  |  1984-05-22  |  2KB  |  132 lines
  1. {$E+}
  2.  
  3. { External Procedures -- Timer Support }
  4.  
  5. PROCEDURE Sleep({ Using    } t:integer); (* pause for t seconds *)
  6.    BEGIN
  7.      TimeLeft := t * 60; { in ticks }
  8.      REPEAT
  9.      { nothing }
  10.      UNTIL (TimeLeft<=0);
  11.    END;
  12.  
  13.  
  14. PROCEDURE ITime;  { Initialize Timer }
  15. BEGIN
  16. {$C
  17.     DVEC = ^O100
  18.     MOV    @LTCVEC,SAV            ;SAVE OLD VECTOR
  19.     MOV    @LTCVEC,SAV2            ;SAVE OLD VECTOR FOR RTI
  20.       CLR    RNTICK                ;CLEAR TICKS
  21.     MOV    #LTCINT,@LTCVEC            ;OUR INTERRUPT
  22. }
  23.  
  24. END;
  25.  
  26. PROCEDURE RTime;  { Reset Timer    }
  27. BEGIN
  28.  
  29. {$C
  30.     TST    SAV                ;TEST 
  31.     BEQ    9$
  32.     MOV    SAV,@LTCVEC            ;RESTORE VECTOR
  33.     CLR    SAV                ;SET OFF
  34. 9$:    NOP    
  35. }
  36. END;
  37.  
  38. {$C
  39.     .EVEN
  40.     .GLOBL    LTCVEC
  41. LTCVEC:    .WORD    DVEC                ;LTC VECTOR
  42. RNTICK:    .WORD    0                ;TICKS FOR RUNTIME
  43. SAV:    .WORD    0                ;SAVED INTERUPT
  44. SAV2:    .WORD    0
  45. ;
  46. LTCINT:    MOV    R5,-(SP)            ;SAVE R5
  47.     MOV    $RESR5,R5            ;GET  BASE
  48.     INC    RNTICK                ;TIMER INTERRUPT
  49.     DEC    TimeLeft(R5)            ;DECREASE TIME LEFT
  50.     CMP    RNTICK,#^O74            ;COMPARE TO 60
  51.     BLT    9$
  52.     INC    RunTime(R5)            ;INCREASE RUNTIME        
  53.     CLR    RNTICK                ;ZERO TICKS
  54. 9$:    MOV    (SP)+,R5
  55.     JMP    @SAV2                ;JUMP TO SYSTEM    INTERRUPT 
  56. ;                        ;AND LET IT DO THE RTI
  57.  
  58. }
  59.  
  60. { External Procedures -- For Console }
  61.  
  62. {$C
  63.  
  64. ;    MACRO ROUTINES FOR RT-11 STIP
  65. ;    TO HANDLE CONVERSION OF    LOWER CASE
  66. ;
  67.     .GLOBL    CONLOW
  68.     .GLOBL    CONUP
  69. ;********************************************
  70. JSW=^O44            ;JSW
  71. MASK=^O40000            ;FOR BIT 14
  72. ;********************************************
  73. CONLOW:    BIS    #MASK,@#JSW    ;DO NOT    CONVERT
  74.     RTS    PC
  75. ;********************************************
  76. CONUP:    BIC    #MASK,@#JSW    ;CONVERT
  77.     RTS    PC
  78. }
  79.  
  80. PROCEDURE ICON; { set    console    - enable interupts }
  81.   BEGIN
  82. {$C
  83.     .MCALL .SCCA
  84.     .GLOBL    TTSPEC
  85.     .SCCA    #AREA,#CHECKC            ;INHIBIT CONTROL C
  86.     JSR    PC,TTSPEC            ;SET SPECIAL MODE
  87. }
  88.    END;
  89.  
  90.   PROCEDURE RCON; { reset console }
  91.    BEGIN
  92.  
  93. {$C
  94.     .GLOBL    TTNORM
  95.     .SCCA    #AREA,#0            ;RESTORE CONTROL C
  96.     JSR    PC,TTNORM            ;RESET
  97. }
  98.  
  99.    END;
  100.  
  101. {$C
  102.     .EVEN
  103. AREA:    .BLKW    2                ;for .SCCA EMT
  104. CHECKC:    .WORD    0                
  105.  
  106. }
  107.     
  108. FUNCTION CheckTheConsole : boolean;
  109. VAR 
  110.   c : integer;
  111. BEGIN
  112. {$C
  113.     .MCALL    .TTINR    
  114.     CLR     R0
  115.     .TTINR
  116.     BCS    9$
  117.     BIC    #^O177600,R0
  118.     MOV    R0,c(SP)
  119. 9$:    NOP    
  120. }
  121.     IF c = ord('A') THEN
  122.         FromConsole := AbortNow
  123.     ELSE IF c = ord('a') THEN
  124.         FromConsole := AbortNow
  125.     ELSE IF c = CR THEN 
  126.         FromConsole := CRin
  127.     ELSE 
  128.         FromConsole := Nothing; 
  129.  
  130.     CheckTheConsole := (FromConsole = AbortNow) OR (FromConsole = CRin);
  131. END;
  132.