      HED DACE MEMORY MANAGEMENT ROUTINE
* 
* REQUESTS MAY BE MADE TO ALLOCATE AND RELEASE BUFFERS
* FROM THE MEMORY AVAILABLE AFTER LOADING AND FROM
* MEMORY RETURNED BY PROGRAM EXECUTION. 
* 
*    1. ALLOCATE: CALLING SEQUENCE
* 
*       (P)    JSB .ALC.
*       (P+1)  (# OF WORDS NEEDED)
*       (P+2)  -RETURN- 
* 
*              (A) = FWA BUFFER 
*              (B) = # OF WORDS ALLOCATED (MAY BE > (P+1))
* 
*    2. RELEASE BUFFER TO AVAILABLE MEMORY
* 
*       (P)    JSB .RTN.
*       (P+1)  (FWA OF BUFFER)
*       (P+2)  (# OF WORDS RETURNED)
*       (P+3)  -RETURN- 
* 
*    3. CLEAR - RETURN ALL BUFFERS
* 
*              CL*
*              ST* .CLR.
* 
* IF A REQUEST FOR A BUFFER OF LENGTH X CANNOT BE FILLED
* DURING A GIVEN CALL, RETURN IS MADE WITH: 
* 
*     (A) = 0 
* 
* IF, WHEN BUFFER REQUESTED, - (AVMEM) -  SHOWS INSUFFICIENT CORE 
* AVAILABLE TO CONTAIN A BUFFER OF THE LENGTH REQUESTED,
* THEN RETURN IS MADE WITH: 
* 
*      (A) = -1 
*      (B) = MAXIMUM LENGTH BUFFER THAT THE PROGRAM MAY ALLOCATE. 
* 
* TO FIND OUT HOW LARGE A BUFFER MAY BE ALLOCATED, USE THE CALL 
* 
*              JSB .ALC.
*              DEC 32767
* 
* BLOCKS OF MEMORY AVAILABLE FOR OUTPUT BUFFERING ARE LINKED THROUGH
*  THE FIRST TWO WORDS OF EACH BLOCK -
* 
*     WORD1 -   LENGTH OF BLOCK 
*     WORD2 -   ADDRESS OF NEXT BLOC (OR 77777 IF THIS IS LAST BLOCK) 
* 
* THE ALLOCATOR 'TRANSFERS' THE UPPER END OF A BLOCK TO IOC AND 
*  SHORTENS THE LENGTH OF THE BLOCK BY THE AMOUNT 'TRANSFERRED' 
* 
* THE INTERRUPT SYSTEM IS NOT AFFECTED BY THIS PROGRAM. 
* 
* REGISTERS ARE NOT PRESERVED 
* 
* 
      NAM MEMRY 
* 
      ENT .ALC.,.RTN.,.CLR. 
* 
      EXT .MEM. 
* 
.ALC. NOP           ENTRY POINT TO ALLOCATE MEMORY
      LDA .CLR.     HAS MEMORY BEEN SET UP FOR
0     SZA,RSS       THE ALLOCATOR?
      JSB INIT      NO - INITIALIZE MEMORY
      LDB PNTR      PNTR = 77777 MEANS NO MEMORY
      CPB M7        IS NOW AVAILABLE. 
      JMP .A3       SEE IF REQUEST CAN EVER FIT.
      STB AAD       OTHERWISE, BEGIN SEARCH 
.A2   LDA .ALC.,I   (A) = LENGTH(X) 
      STA SAVB      SET BUFFER LENGTH 
      CMA,INA         -X
      ADA B,I       LENGTH(I) - LENGTH(X) 
      SSA,RSS        >= 0?
      JMP .A1       YES, ALLOCATE THIS BLOCK
      INB 
      LDA B,I       (A) = FWD(I)
      CPA M7        IF FWD(I)=77777 THEN DONE 
      JMP .A3       NO BLOCK WAS FOUND
      LDA AAD       MOVE THIS BLOCK POINTER 
      STA BAD       TO LAST BLOCK POINTER 
      LDB B,I       AND NEXT BLOCK TO 
      STB AAD       THIS BLOCK
      JMP .A2       REPEAT LOOP 
* 
.A3   LDA .ALC.,I 
      CMA,INA       (A) = -X
      LDB AVMEM     IS LARGEST BLOCK BIG
      ADA B         ENOUGH TO HOLD BUFFER?
      SSA 
      JMP ERETN     NO - HALT.
* 
REJ   CLA           SET ZEJECT CODE 
      JMP SETB      REJECT REQUEST FOR NOW
* 
.A1   ADA CM2       IS BLOCK AT LEAST 2 WORDS 
      SSA           LARGER THAN REQUEST?
      JMP .A4       NO - ALLOCATE WHOLE BLOCK 
      ADA C2        (A) = LENGTH(I) - L(X)
      STA AAD,I     SET NEW L(I)
      ADA AAD       (A) = BUFFER ADDRESS
      JMP SETB      RETURN
* 
.A4   LDA AAD,I     SET BUFFER LENGTH TO
      STA SAVB      LENGTH(I) TO PASS WHOLE BLOCK 
      STB SAVA      BUFFER ADDRESS - AAD
      CPB PNTR      IS THIS FIRST BLOCK?
      JMP .A5       YES, MOVE PNTR TO FWD(1)
      INB           NO
      LDA B,I       FWD(I) TO 
      LDB BAD 
      INB 
      STA B,I       FWD(I-1)
      JMP SETA
.A5   INB 
      LDB B,I       SET PNTR TO NEW FIRST BLOCK 
      STB PNTR
* 
SETA  LDA SAVA      SET REGISTERS 
SETB  LDB SAVB
      RSS 
ERETN CCA           FLAG FOR INSUFFICIENT MEMORY
      ISZ .ALC.     SET RETURN ADDRESS
      JMP .ALC.,I   AND EXIT. 
* 
* THIS ROUTINE LOCATES THE BLOCK BEING RETURNED (ADDRESS IN ADX)
*  BETWEEN APPROPRIATE EXISTING BLOCKS WITH ADDRESS OF THE
*  LOWER BLOCK IN - BAD - AND ADDRESS OF THE HIGHER BLOCK IN - AAD -
* 
* IF THE BLOCK BEING RETURNED OVERLAPS ABOVE AND/OR BELOW, THE
*  LINKAGES ARE ADJUSTED ACCORDINGLY. 
* 
.RTN> NOP           ENTRY POINT FOR BUFFER RETURN 
      LDA .RTN.,I   (A) = FWA RETURN BUFFER (ADX) 
      STA ADX 
      ISZ .RTN. 
      LDA .RTN.,I   # OF WORDS RETURNED (X) 
      ADA CM2 
      SSA           < 2?
      JMP RETNR     BUFFER TOO SMALL - IGNORE 
      LDA .CLR. 
      SZA,RSS 
      JSB INIT
      CLA 
      STA BAD 
      LDB PNTR
.R1   STB AAD       AAD _ PNTR
      CMB,INB 
      ADB ADX 
      SSB           RETURN BLOCK ABOVE A BLOCK? 
      JMP .R2 
      LDA AAD       YES 
      STA BAD       BAD _ AAD 
      INA 
      LDB A,I       AAD _ NEXTBUFAD 
      JMP .R1       LOOP
* 
.R2   ADB .RTN.,I   X + ADX >= AAD? 
      SSB 
      JMP .R3       NO
      LDA AAD       BLOCK X AND BLOCK A OVERLAP 
      LDB ADX 
      CMB,INB 
      ADB AAD 
      ADB AAD,I 
      STB ADX,I     L(X) = L(A) + AAD - ADX 
      INA 
      LDB A,I       (B) = FWD(A)
      LDA ADX 
      INA 
      STB A,I       FWD(X) _ FWD(A) 
      JMP .R4 
.R3   LDA .RTN.,I   X NOT CONTIGUOUS WITH A 
      STA ADX,I     L(X) -
      LDA ADX 
      INA 
      LDB AAD 
      STB A,I       FWD(X) = AAD
* 
.R4   LDB BAD 
      SZB,RSS       ANY LOWER BLOCKS
      JMP .R5       NO, DONE
      INB 
      LDA ADX 
      CPA BAD       SAME BLOCK? 
      RSS           YES, DO NOT SET FWD(B)
      STA B,I       FWD(B) _ ADX
      LDA BAD 
      ADA BAD,I 
      LDB ADX 
      CMB,INB 
      ADB A 
      SSB           BAD + L (B) >= ADX? 
      JMP .R6       NO, DONE
      LDA ADX       YES, B AND X OVERLAP
      INA 
      LDB A,I 
      LDA BAD 
      INA 
      STB A,I       FWDNB) - FWD (X)
      CMA,INA 
      INA 
      ADA ADX 
      ADA ADX,I 
      STA BAD,I     L(B) _ L(X) + ADX - BAD 
      RSS 
.R6   LDA ADX,I 
      LDB AVMEM 
      CMB,INB 
      ADB A 
      SSB,RSS 
      STA AVMEM 
* 
RETNR ISZ .RTN. 
      JMP .RTN.,I 
.R5   LDA ADX       X IS NOW FIRST BLOCK
      STA PNTR
      JMP .R6 
* 
INIT  NOP           INITIALIZE MEMORY FROM THE
      LDA .MEM.     LOADER MEMORY TABLE 
      LDA A,I 
      STA .CLR. 
      STA PNTR      PNTR _ FWABP
      LDB .MEM. 
      INB           (B) = DEN LWABP 
      CMA 
   0  ADA B,I       LWABP - FWABP - 1 >= 0? 
      SSA 
      JMP IN1       NO - TRY MEMORY 
      ADA C2
      STA AVMEM 
      STA PNTR,I    L(1) = LWABP - FWABP + 1
      INB 
      LDA B,I       FWAM TO 
      LDB PNTR
      INB 
      STA B,I       FWABP + 1 (FWD(1))
      CMA 
      LDB .MEM. 
      ADB C3
      ADA B,I       LWAM - FWAM - 1 >= 0? 
      SSA 
      JMP IN2       NO - SET FWD(1) = 77777 
In3   ADA C2
      STA PAWDS 
      ADB CM1 
      LDB B,I       L(M) TO AD(M) 
      STA B,I 
      INB 
      LDA M7
      STA B,I       FWD(M) = 77777
      LDA AVMEM 
      LDB PAWDS 
      CMA,INA 
      ADA B 
      SSA,RSS 
      STB AVMEM 
      JMP INIT,I
* 
IN1   INB           (B) = DEF FWAM
      LDA B,I 
      STA PNTR      PNTR _ FWAM 
      INB           (B) = DEF LWAM
      CMA 
      ADA B,I       LWAM - FWAM - 1 >= 0? 
      SSA,RSS 
      JMP IN3       YES - LINK MEMORY 
      LDA M7
      STA PNTR
      JMP INIT,I
* 
IN2   LDA PNTR
      INA 
      LDB M7
      STB A,I 
      JMP INIT,I
* 
* 
* 
.CLR. NOP 
* 
PNTR  OCT 77777     ADDRESS OF LOWEST BLOCK 
M7    OCT 77777 
PAWDS NOP 
AAD   NOP           ADDRESS OF BLOCK A (ABOVE)
BAD   NOP           ADDRESS OF BLOCK B (BELOW)
C2    OCT 2 
C3    OCT 3 
CM2   OCT -2
ADX   NOP           ADDRESS OF BLOCK X (BEING RETURNED) 
CM1   OCT -1
SAVA  NOP 
SAVB  NOP 
AVMEM NOP           LENGTH OF LONGEST AVAILABLE BLOCK 
* 
A     EQU 0 
B     EQU 1 
      END 
      HED PROGRAM CONTROLLED CLOCKS, STCLK & RDCLK
      NAM .CLOK 
      ENT .CLOK,STCLK,RDCLK 
      EXT .ENTR 
* 
*     .CLOK IS THE SYSTEM CLOCK - CONTROL IS TRANSFERRED
*         HERE AT EACH CLOCK INTERRUPT. THE SUBROUTINES 
*         STCLK AND RDCLK ARE SERVICED HERE.
* 
.CLOK NOP 
      LDA CLK1
      INA,SZA,RSS 
      JMP C.1 
      STA CLK1
      JMP .CLOK,I 
* 
C.1   LDA MCLK
      STA CLK1
      ISZ RCLK
      NOP 
      JMP .CLOK,I 
* 
CLK1  NOP 
MCLK  NOP 
RCLK  NOP 
* 
*     STCLK - SETS THE RATE AT WHICH THE PROGRAM CLOCK IS 
*             UPDATED TO N TIMES THE BASIC CLOCK INTERVAL 
*             WHERE N = THE PARAMETER IN THE CALL TO STCLK
* 
SARG  NOP 
* 
STCLK NOP 
      JSB .ENTR 
   0  DEF SARG
      LDA SARG,I
      CMA,INA       - CLOCK RATE TO COUNTER 
      STA MCLK
      CLF 0         DISABLE INTERRUPT 
      STA CLK1      INITIALIZE COUNTDOWN
      CLA 
      STA RCLK      0 TO PROGRAM CLOCK
      STF 0         TURN ON INTERRUPT 
      JMP STCLK,I 
* 
*     RDCLK - THE VALUE OF THE PROGRAM CLOCK IS RETURNED
*             IN THE ARGUMENT OF THE CALL 
* 
RARG  NOP 
* 
RDCLK NOP 
      JSB .ENTR 
      DEF RARG
      LDA RCLK
      STA RARG,I
      JMP RDCLK,I 
      END 
      HED      *** LAG ***
      NAM LAG 
      ENT LAG 
      EXT .ENTR,.SLIP 
* 
*     LAG IS A DACE FUNCTION CALL WHICH RETURNS 
*      THE VALUE IN SECONDS THAT THE SYSTEM LAGS
*      REAL TIME WITH THE ARGUMENT OF THE CALL
*      ADDED TO THE VALUE OF ACTUAL TIME LAG. 
* 
LAG1  NOP 
* 
LAG   NOP 
      JSB .ENTR 
      DEF LAG1
      LDA .SLIP 
      ADA LAG1,I
      JMP LAG,I 
      END 
      HED DACE SUBROUTINE LINK
* 
      NAM LINK
      ENT LINK
* 
LINK  NOP 
      LDA LINK
      ADA C10 
      JMP A,I 
* 
A     EQU 0 
C10   OCT 10
      END 
      HED DUMMY .RTN. FOR NON-BUFFERED IOC
      NAM .RTN. 
      ENT .RTN. 
*  DACE LOOKS AT .RTN. ENTRY WORD - IF IT IS THIS 
*      OCTAL 177777, THIS DUMMY HAS BEEN LOADED 
*        AND OPERATION IS WITH NON-BUFFERED IOC 
* 
.RTN. OCT 177777
      END 
      HED DACE SUBROUTINE DATIM 
* 
      NAM DATIM 
      ENT(DATIM 
      EXT .ENTR,.DTCL 
* 
HRS   DEF DRAIN 
MIN   DEF DRAIN 
SEC   DEF DRAIN 
* 
DATIM NOP 
      JSB .ENTR 
      DEF HRS 
      DLD .DTCL 
      DIV CHRS
      STA HRS,I 
      LDA 1 
      CLB 
      DIV CMIN
      STA MIN,I 
      STB SEC,I 
D.1   LDA CM24
      ADA HRS,I 
      SSA 
      JMP DATIM,I 
      STA HRS,I 
      JMP D.1 
CHRS  DEC 3600
CMIN  DEC 60
CM24  DEC -24 
DRAIN NOP 
      END 
                                                                                                                                                                                                                    