ASMB,Q,C
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
*  ***************************************************************
* 
*     SOURCE PART NUMBER : 92067-18422
* 
*     RELOCATABLE PART NUMBER : 92067-16361 
* 
*     PROGRAMER(S)   : J.M.N. 
* 
* 
      NAM IVBUF,7 92067-16361 REV.1940 781010 
      ENT IVBUF 
      EXT READF,WRITF,ACOM1 
* 
*     VIRTUAL MEMORY ROUTINE FOR +@CCT!::-31178 
*     IN NDCB BUFFER IN NBUF OF COMMON /ACOM1/
* 
*     CALLING SEQUENCE: 
*C     FETCH VALUE FROM FILE
*      IVAL=IVBUF(INDEX,IREC) 
* 
*C     STORE VALUE IN FILE
*      CALL IVBUF(INDEX,IREC,IVAL)
* 
*C     POST MEMORY TO DISC
*      CALL IVBUF 
* 
*        WHERE:  INDEX  IS INDEX INTO FILE STARTING 
*                       FROM RECORD "IREC"
*                IREC   IS STARTING RECORD FOR VIRTUAL
*                       BUFFER  (128 WORDS / RECORD)
* 
*                IVAL   IS VALUE BEING FETCHED OR STORED
* 
IVBUF NOP 
      CLA           CLEAR NEW RECORD NUMBER 
      STA IRECN 
      LDA IVBUF,I   GET RETURN ADDRESS
      STA RTRN
      ISZ IVBUF 
      CPA IVBUF     IF NO PARMAMETERS IT IS A POST
      JMP WRITE 
* 
      LDB IVBUF,I   FETCH INDEX ADDRESS 
      CCA           OFSET FOR FORTRAN 
      ADA B,I       THEN THE VALUE
      LDB A 
      AND B177      STRIP OFF OFFSET IN RECORD
      STA OFSET 
      XOR B         GET RECORD NUMBER 
      ALF,ALF 
      RAL           (9 TO LEFT =7 TO THE RIGHT) 
      ISZ IVBUF 
      LDB IVBUF,I 
      ADA B,I       ADD STARTING RECORD NUMBER
*             IS IT IN MEMORY 
      CPA IREC1 
      JMP REC1      YES IN FIRST BUFFER 
      CPA IREC2 
      JMP REC2      YES IN SECOND BUFFER
* 
      STA IRECN     NO THEN POST FIRST BUFFER 
WRITE LDA IREC1     IF PREVIOUSLY SET UP
      SZA,RSS 
      JMP READ
* 
      LDA WRFL1 
      SZA,RSS       HAS IT BEEN WRITTEN IN
      JMP READ      NO SKIP WRITF 
* 
      JSB WRITF     WRITE TO FILE 
      DEF *+6 
      DEF ACOM1+0 
      DEF IERR
BUF1  DEF ACOM1+272 
      DEF D128
      DEF IREC1 
* 
*     MOVE POINTERS OF BUFFER #2 TO BUFFER #1 
* 
READ  LDA BUF2
      LDB BUF1
      STA BUF1
      STB BUF2
      LDA IREC2 
      STA IREC1 
      LDA WRFL2      WRITE FLAG 
      STA WRFL1 
      CLA 
      STA WRFL2 
      LDA IRECN 
      STA IREC2 
      SZA,RSS       IF IRECN =0 THEN IT IS A POST 
      JMP WRIT2 
* 
      JSB READF     READ FROM FILE
      DEF *+7 
      DEF ACOM1+0 
      DEF IERR
BUF2  DEF ACOM1+272+128 
      DEF D128
      DEF LEN 
      DEF IREC2 
* 
REC2  LDB BUF2 COMPUTE MEMORY ADDRESS 
      LDA WRF2A 
      JMP REC 
REC1  LDB BUF1
      LDA WRF1A 
REC   STA WRFLA 
      ADB OFSET 
      ISZ IVBUF 
      LDA IVBUF     IS IT A STORE 
      CPA RTRN
      JMP ACLOA 
      LDA IVBUF,I   YES GET ADDRESS OF VALUE
      LDA A,I       AND THEN VALUE
      STA B,I PUT IN VIRTUAL BUFFER 
* 
      CCA 
      STA WRFLA,I   SET WRITTEN INTO FLAG 
      JMP RTRN,I
* 
ACLOA LDA B,I       FETCH VALUE FROM VIRTUAL BUFFER 
      JMP RTRN,I
* 
WRIT2 LDA IREC1 
      SZA           IF NOTHING IN BUFFER 1
      JMP WRITE+1 
      JMP RTRN,I    THEN NOTHING TO POST
* 
A     EQU 0 
B     EQU 1 
* 
WRF1A DEF WRFL1 
WRF2A DEF WRFL2 
WRFLA BSS 1 
WRFL1 BSS 1 
WRFL2 BSS 1 
IREC1 NOP 
IREC2 NOP 
IRECN NOP 
B177  OCT 177 
D128  DEC 128 
OFSET BSS 1 
IERR  BSS 1 
RTRN  BSS 1 
LEN   BSS 1 
      END 
* 
      LDA IVBUF 
      CPA RTRN
            