ASMB,R,L
      HED "CPUT" SAME AS IPUT BUT THRU SYSTEM MAP IF ONE 5-78 (DLB) 
      NAM CPUT,7 PRE-REL 780519 (DLB) RTE-IV
      ENT CPUT
      EXT $LIBR,$LIBX 
      SPC 1 
A     EQU 0 
B     EQU 1 
BPA3  EQU 1744B 
* PURPOSE:  TO ALLOW FTN PROGRAM TO PUT DATA TO SYSTEM AND
*           BASE PAGE.
* CALLED: 
*            CALL CPUT(IADDRS,IVALU)
* WHERE:
*          IADDRS = DESIRED ADDRESS OF WORD TO PUT THUR SYSTEM MAP. 
*          IVALU  = VALUE OF DESIRED WORD.
      SPC 1 
ADDR  NOP           ADDRESS OF IADRS PARAMETER
CPUT  NOP           ENTRY 
      JSB $LIBR     TURN OFF INTERRUPTS 
      NOP 
      LDA BPA3      CHECK IF MAPPING SYSTEM?
      CPA O2        CHECK IF MAPPED SYSTEM? 
      JMP CPUT1     YES, CONTINUE 
      LDA STABI     NO, MUST BE RTE-II OR DOS 
      STA IOPTN 
      CLA           NOW ZERO THE DEF
      STA IOPTN+1 
CPUT1 LDB CPUT,I    GET RETURN ADDRESS
      ISZ CPUT      BUMP TO PARAMETER ADDRESS 
      LDA CPUT,I    GET ADDRESS OF 1ST PARAMETER
      STA ADDR      SAVE PARAMETER ADDRESSES
      ISZ CPUT      BUMP TO NEXT PARAMETER
      LDA CPUT,I    GET THE VALUE'S ADDRESS 
      STB CPUT      SAVE THE RETURN ADDRESS 
      LDA A,I       AND GET THE VALUE 
      LDB ADDR,I    GET THE ADDRESS TO STORE TO 
IOPTN XSA B,I       OR STA B,I
      JSB $LIBX     AND EXIT WITH A-REG = ANSWER
      DEF CPUT
      SPC 1 
O2    OCT 2 
STABI STA B,I 
      END 
                                                                                            