ASMB,R,L,C,F
      HED %RFAN 91704-16101 REV A * (C) HEWLETT-PACKARD CO. 1976
      NAM %RFAN,7 91704-16101 REV A 760105
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  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.       *
******************************************************************
      SPC 3 
****************************************************
* 
*%RFAN              SUBROUTINE TO DO REMOTE RFA 
* 
*SOURCE PART #      91704-18101 REV A 
* 
*REL PART #         91704-16001 REV A 
* 
*WRITTEN BY:        LARRY POMATTO 
* 
*DATE WRITTEN:      11-15-74
* 
*MODIFIED BY:       JEAN-PIERRE BAUDOUIN
* 
*DATE MODIFIED:     DEC 1975
* 
***************************************************** 
      SPC 1 
      SUP 
* 
* 
* THIS SET OF USER-CALLABLE SUBROUTINES INTERFACES
* A DS1B TERMINAL USER TO THE RTE FILE MANAGER AND RTE
* EXECUTIVE OF A DS/1B RTE CENTRAL COMPUTER. %RFAN
* REQUIRES THE DVR65 DRIVER TO BE COFIGURED INTO THE
* RTE-B TERMINAL. 
* 
* 
* CALLING SEQUENCE: 
* 
*   JSB RXXXX 
*   DEF RETURN ADDRESS
*   DEF PARAMETER 1 
*   . 
*   . 
*   . 
*   DEF PARAMETER N 
*   RETURN
* 
* 
* 
      ENT CCRET,CPURG,COPEN,CREAD,CWRIT 
      ENT CPOSN,CWIND,CCLOS,CNAME,CCONT 
      ENT MBUFS,MBUF2,CLOCF,CAPOS,CSTAT 
      ENT RLU,CLU,CONFG,LSTEN,CLINE,DIMCK 
      ENT CAXTM,CEXTM,CSCHD,CTIM,CMESG
      ENT DIMFG,M72,REPLY,PRMB,RPLY,FIXNM 
* 
* 
      EXT EXEC,.STOP,ERROR
      EXT .1,.2,.3,.4,.6,.10
      EXT .8,.32,.48,FCORE,PROGL
      EXT M1,M2,M4,M5,M7
      EXT B377,B100,B200
      EXT STCK
      EXT DBSY,%TAM,INDCK,SBYTE 
* 
* 
A     EQU 0 
B     EQU 1 
* 
********************************* 
* ENTRY POINTS FOR REMOTE CALLS ********************
********************************* 
* 
* CREATE A CENTRAL FILE.
* 
CCRET NOP 
      JSB CQUE      NO RETURN. CALL IS POINTER TO 
      DEC 150       ENTRY POINT AND FUNCTION CODE.
* 
* PURGE A CENTRAL FILE. 
* 
CPURG NOP 
      JSB CQUE
      DEC 151 
* 
* OPEN A CENTRAL FILE.
* 
COPEN NOP 
      JSB CQUE
      DEC 152 
* 
* WRITE ON CENTRAL FILE.
* 
CWRIT NOP 
      JSB CQUE
      DEC 153 
* 
* READ FROM CENTRAL FILE. 
* 
CREAD NOP 
      JSB CQUE      SIGN BIT OF FCN CODE SET FOR
      OCT 100232    READ (FCN = 154). 
* 
* POSITION CENTRAL FILE.
* 
CPOSN NOP 
      JSB CQUE
      DEC 155 
* 
* REWIND CENTRAL FILE.
* 
CWIND NOP 
      JSB CQUE
      DEC 156 
* 
* CLOSE CENTRAL FILE. 
* 
CCLOS NOP 
      JSB CQUE
      DEC 157 
* 
* RENAME CENTRAL FILE.
* 
CNAME NOP 
      JSB CQUE
D158  DEC 158 
* 
* CONTROL CENTRAL FILE. 
* 
CCONT NOP 
      JSB CQUE
      DEC 159 
* 
* LOCATE CENTRAL FILE RECORD. 
* 
CLOCF NOP 
      JSB CQUE
      DEC 160 
* 
* ABS POSITION CENTRAL FILE.
* 
CAPOS NOP 
      JSB CQUE
      DEC 161 
* 
* READ CENTRAL FILE DIRECTORY.
* 
CSTAT NOP 
      JSB CQUE
      OCT 100242    READ CALL. FCN = 162. 
* 
* REMOTE EXEC CALLS 
* 
CAXTM BSS 0         TIME ABSOLUTE..SAME AS INITAL OFFSET
CEXTM NOP 
      JSB CQUE      GO PROCESS REQUEST
      OCT 243       REQUEST FUNCTION CODE OF 163. 
      DEC 12        EXEC CODE...12 TIME SCHEDULE
      SPC 2 
*     STANDARD SCHEDULE 
CSCHD NOP 
      JSB CQUE      SET PRAMS FOR SCHEDULE CALL 
      OCT 243 
      DEC 10        EXEC CODE FOR SCHEDULE
      SPC 2 
*     TIME REQUEST
CTIM  NOP 
      JSB CQUE      GO SET UP PRAMS FOR TIME REQUEST
      OCT 243 
      DEC 11        TIME REQUEST
      SPC 2 
*     SEND MESSAGE
CMESG NOP 
      JSB CQUE      SET UP PRAMS
      OCT 243 
      DEC 2         SET UP AS A WRITE REQUEST TO LU 1 
      SKP 
**********************************
* BUILD THE PARAM BUFFER (PARMB) *******************
**********************************
* 
* 
* WHEN CQUE IS CALLED, THE ADDRESS OF THE USER
* CALL AND THE FUNCTION CODE CAN BE DETERMINED
* VIA THE ENTRY POINT CONTENTS. 
* 
CQUE  NOP 
      LDA CQUE,I    FETCH FUNCTION CODE.
      CLB,INB       CHECK SIGN BIT. 
      SSA,RSS 
      INB 
      STB RDATA     SET "READ DATA" FLAG. 
      ELA,CLE,ERA   CLEAR SIGN BIT. 
      STA FCN 
      ADA MD163 
      STA .FCN      SET FUNCTION CODE FLAG..ZERO=EXEC 
      CLA 
      STA ISTAT     CLEAR ERROR FLAG
      LDA CQUE      FETCH USER CALL ADDRESS.
      ADA M2
      LDA A,I 
      STA CALL
* 
      CLA           CLEAR DATA BUFR ADDR. 
      STA DADR
* 
* INITIALIZE PARMB: STREAM, SUB-STREAM, FUNCTION CODE.
* 
      LDA PRMBA     POINT TO PARMB AREA.
      STA PARMB 
* 
      LDA .FCN      GET FUNCTION CODE FLAG
      LDB B5        SET FOR EXEC
      SZA           REMOTE EXEC CALL
      INB           NOT EXEC...RFA
      STB PARMB,I   STORE STREAM TYPE.
      ISZ PARMB 
* 
      CLA 
      STA PARMB,I   SUB-STREAM (NULL).
      ISZ PARMB 
* 
      LDA FCN 
      STA PARMB,I   FUNCTION CODE.
      ISZ PARMB 
* 
* STORE SPARE WORD, DATA FLAG = 0.
* 
      LDA B202L 
      STA PARMB,I   202*000 
      ISZ PARMB 
      ALF,ALF 
      STA PARMB,I   000*202 
      ISZ PARMB 
      CLA 
      STA PARMB,I   000*000 
* 
* INITIALIZE DYNAMIC POINTERS.
* 
      LDA CALL    ADDR OF USER CALL RETURN ADDR.
      INA           MOVE OVER RETURN ADDRESS
      STA P.PTR     POINTER TO USER CALL PARAMETERS.
* 
      LDA .2
      STA B.PTR     PARMB BYTE POINTER. 
* 
      LDA UPARM     ADDR OF SAVED PARAMS. 
      STA U.PTR 
* 
* PERFORM COMMON PARMB ENTRY STORAGE ACCORDING TO 
* CLASS OF CALL (CEXEC OR RFA)
* 
      LDA .FCN      GET FUNCTION CODE INDICATOR 
      SZA 
      JMP .RFA
* 
.EXEC JSB STERM     SET A B202 TERMINATOR 
      LDA CQUE      FIND OUT EXEC CODE
      INA 
      LDA A,I       WE HAVE FUNCTION CODE 
      JSB STWRD     SAVE FUNCTION EXEC CODE 
      STA .RCD      SAVE IT.
* 
      CPA .2
      JMP RC1       WRITE.
      CPA .10 
      JMP RC10      SCHEDULE. 
      CPA D11 
      JMP RC11      TIME. 
      CPA D12 
      JMP RC12      EXECUTION TIME. 
* 
      LDA M70       ILLEGAL REQUEST CODE. 
      JMP SSTAT 
* 
.RFA  LDA FCN       GET FUNCTION CODE 
      ADA MD153     CHECK IF IT IS A CREATE OPEN PURGE
      SSA,RSS       OR RENAME 
      CPA B5        IF IT IS MOVE NAME TO DCB 
      JSB MNAM
      JSB STRNG     MOVE NAME TO PARMB
      ISZ P.PTR     SKP OVER ERROR STATUS 
* 
      LDA FCN 
      ADA MD150 
      ADA RTBL
      LDA A,I 
      JMP A,I 
* 
RTBL  DEF *+1       GO TO UNIQUE PROCESSING FOR 
      DEF .CRET     THE PARTICULAR RFA CALLS. 
      DEF .PURG 
      DEF .OPEN 
      DEF .WRIT 
      DEF .READ 
      DEF .POSN 
      DEF .WIND 
      DEF .CLOS 
      DEF .NAME 
      DEF .CONT 
      DEF .LOCF 
      DEF .APOS 
      DEF .STAT 
* 
* UNIQUE PROCESSING FOR INDIVIDUAL REMOTE EXEC CALLS. 
* 
*     HERE FOR MESSAGE PROCESSING 
*     WHEN INITILIZATION ROUTINE CALLED REMOTE
*     LU WAS OBTAINED AND SET AS AN ASC VALUE 
* 
RC1   JSB STERM     SET IN CONTROL BYTE 
      JSB GET.P     GET DISPLAY LU (THEY DON'T KNOW THAT THEY CAN") 
      SZA,RSS       IS IT ZERO (NORMALLY SHOULD BE!)
      INA           ZERO...SET LU 1 
      JSB STWRD     SAVE LU 
      JSB STERM     SET CONTROL BYTE FOR LENGTH 
      JSB GET.A     GET ADDRESS OF MESSAGE
      STA TEMP1     SAVE ADDRESS MOVE 
      LDA A,I       GET LENGTH
      AND B377      MASK OFF BIT 8
      STA B         SAVE IN B REG 
      ADA MBUFS     CHECK IF IT IS IN RANGE 
      SZB           ZERO LENGTH...ERROR 
      SSA,RSS       NEGATIVE...IN RANGE 
      JMP WRONG     OUT OF RANGE...TREATE AS MISSING PRAM 
      INB           INCASE ODD # OF CHARACTERS
      STB TEMP3     SAVE # OF CHARACTERS
      CLE,ERB       CONVERT TO # OF WORDS 
      CMB,INB       NEGATE COUNT
      LDA MBFA2     GET ADDRESS OF MESSAGE BUFFER 
      STA TEMP2     SAVE CURRENT ADDRESS
RC101 ISZ TEMP1     GET TO CURRENT DATA WORD
      LDA TEMP1,I   GET MESSAGE 
      STA TEMP2,I   AND MOVE IT TO BUFFER 
      ISZ TEMP2     GET NEXT OUTPUT WORD ADDRESS
      INB,SZB       DONE? 
      JMP RC101     NO...CONTINUE 
      LDA MBUFA     GET MESSAGE BUFFER ADDRESS
      JSB RPARM     SAVE ADDRESS
      LDA TEMP3     GET LENGTH
      CLE,ERA       CONVERT TO WORD LENGTH
      SEZ           ODD # OF CHARACTERS?
      JMP RC100     NO
      STA TEMP3     SAVE # OF WORDS 
      CCB           GET A -1
      ADB TEMP2     GET ADDRESS OF LAST VALUE STORED
      LDA B,I       GET VALUE 
      AND M377L     MASK OFF ALL BUT UPPER 8 BITS 
      IOR .32       MASK IN SPACE 
      STA B,I       SAVE LAST WORD
      LDA TEMP3     GET COUNT AGAIN 
RC100 ADA .3        ADD IN PREAMBLE 
      JSB RPARM     SAVE LENGTH 
      STA PARMB,I   SET IN PARMB DATA FLAG
      JSB STWRD     SAVE VALUE IN DATA STREAM 
      JMP READY     SEND MESSAGE
* 
RC10  JSB STRNG     STORE PROGRAM NAME. 
      ISZ P.PTR     GET PAST RETURN STATUS
      JSB OPTN      STORE OPTIONAL PARAMS.
      JSB OPTN
      JMP OPT3
* 
RC11  JMP READY 
* 
RC12  JSB STRNG     STORE PROG NAME.
      JSB INTGR     IRESL 
      JSB INTGR     MTPLE 
      JSB INTGR     IOFST: CHECK SIGN.
      SSA 
      JMP READY     INITIAL OFFSET VERSION. 
      JSB INTGR     MINS
      JSB INTGR     ISECS 
      JSB STERM     SET IN TERMINATOR 
      CLA           SET MSECS TO 0
      JSB STWRD 
      JMP READY     ABSOLUTE START TIME VERSION.
* 
* UNIQUE PROCESSING FOR INDIVIDUAL RFA CALLS. 
* 
.CRET ISZ P.PTR     SKIP OVER NAME
      LDA B204      STORE 2-WORD SIZE ARRAY.
      JSB STBYT 
      JSB GET.A 
      STA TEMP3 
      DLD TEMP3,I   GET FLOATING POINT LENGTH 
      FIX           CONVERT IT INTO AN INTEGER
      JSB STWRD 
      ISZ TEMP3 
      ISZ TEMP3     GET TO RECORD LENGTH
      DLD TEMP3,I   GET LENGTH
      FIX           CONVERT IT TO FIXED.
      JSB STWRD 
      JSB INTGR     STORE FILE TYPE.
      JMP OPT2
* 
.PURG ISZ P.PTR     SKP OVER NAME PRAM
      JMP OPT2
* 
.OPEN ISZ P.PTR     SKP OVER NAME 
OPT3  JSB OPTN
OPT2  JSB OPTN      STORE OPTIONAL PARAMS.
OPT1  JSB OPTN
      JMP READY     PARMB COMPLETE. 
* 
.CLOS EQU OPT1
* 
.READ JSB GET.A 
      JSB RPARM     SAVE DATA BUFR ADDRESS. 
      JSB STLEN     STORE LENGTH. 
      JMP OPT2
* 
.WRIT EQU .READ 
* 
.POSN JSB INTGR     STORE RECORD NUMBER.
      JMP OPT1
* 
.WIND JMP READY 
* 
.NAME ISZ P.PTR     SKP OVER OLD NAME 
      JSB STRNG     STORE NEW NAME. 
      JMP OPT2
* 
.CONT JSB INTGR     STORE CONTROL WORD. 
      JMP OPT1
* 
.LOCF JMP READY 
* 
.APOS JSB INTGR     STORE RECORD NUMBER.
      JMP OPT2
* 
.STAT LDA .2        RESET BYTE POINTER. 
      STA B.PTR 
      LDA P.PTR     BACK UP PARAM POINTER.
      ADA M1       (NO IERR PARAM)
      STA P.PTR 
      JSB GET.A 
      JSB RPARM     SAVE DATA BUFR ADDRESS. 
      LDA D124      STORE LENGTH
      STA PARMB,I     IN DATA-FLAG AND
      JSB RPARM       GIVE IT TO CALLER.
      JMP READY 
* 
MSSNG LDA M10       MISSING PARAMETER.
      JMP SSTAT 
* 
READY CLA           STORE TERMINATION BYTE. 
      JSB STBYT 
* 
      LDA UPARM     POINT TO PLEN STORAGE.
      ADA .2
      STA U.PTR 
* 
      JSB RPARM     PUSH PARAMETER POINTER
      SKP 
******************************************
* TRANSMIT PARMB TO CENTRAL & READ REPLY ***********
******************************************
* 
      LDA DADR      GET DATA FLAG 
      SZA           IS THERE DATA ON THIS REQUEST?
      JMP REQAD     YES...REQUEST AND DATA
      CCE           SET FOR WRITE REQ 
      JSB %TAM      MAKE CALL 
      DEF REPLY     ADDRESS OF REPLY BUFFER 
      DEF PRMBA     ADDRESS OF PRMB AND LENGTH
      JMP COMPL     WHEN WE GET HERE...RECIEVED RESPONSE
      SPC 2 
* 
*     ONE DATA READ OR WRITE CHECK FOR LEGAL BOUNDS 
* 
REQAD LDB DLEN      GET LENGTH
      LDA M72       SET INCASE ZERO LENGTH RECORD 
      SZB           CHECK FOR ZERO LENGTH OR
      SSB           NEGATIVE
      JMP SSTAT     YES...TERMINATE CALL
      LDA RDATA     GET DATA FLAG 
      CPA .2        IS IT A WRITE?
      JMP REQDA     YES...DONT CHECK BOUNDS 
      LDA DADR      GET STARTING ADDRESS
      JSB INDCK     CHASE DOWN INDIRECTS
      ADB A         GET LAST WORD+2 
      ADB M2        BACK IT UP TO WITHIN BOUNDS 
      JSB DIMCK     CHECK DIMENSIONS
REQDA LDA DADR      SET FOR SEND DATA AND REQ 
      LDB RDATA     READ OR WRITE COMAND
      RBR,ERB       SET E REG IF WRITE DATA 
      JSB %TAM      GO MAKE REQ AND DATA CALL 
      DEF REPLY     REPLY ADDRESS 
      DEF DADR      PRAM ADDRSS..DATA ADD,DATA LEN,REQ ADD,REQ LEN
      SKP 
******************************* 
* PASS RETURN PARAMS TO USER. **********************
******************************* 
* 
COMPL CPA .1        ALL OK? 
      JMP CMPL1     YES 
      LDB M51       GET GENERAL DRIVER ERROR
      CPA B100      PARITY ERROR? 
      LDB M52       YES...PARITY ERROR
      LDA B         GET ERROR CODE FOR STATUS 
      JMP SSTAT     AND SET IN ERROR CODE 
CMPL1 LDA REPLY+2   RFAM ERROR CODE?
      CPA M1
      RSS 
      JMP CMPL2     NO. 
* 
      LDA M11       YES. MAP THE CODE.
      LDB REPLY+3 
      CPB .4
      JMP SSTAT     FILE NOT OPEN.
      LDA M62 
      CPB B5
      JMP SSTAT     REQ. OVERFLOW AT CENTRAL. 
      LDA M71 
      CPB .8
      JMP SSTAT     UNDEF. PROG SCHEDULE. 
      CPB D12 
      JMP SSTAT     ILLEGAL LU. 
      LDA M4
      CPB D11       ILLEGAL RECORD SIZE?
      JMP SSTAT 
      LDA M103      SET FOR SOFTWARE BUG
* 
SSTAT STA ISTAT     COMMUNICATION STATUS. 
* 
CMPL2 LDA ISTAT     GET STATUS FLAG 
      SZA,RSS       IS IT ZERO? 
      JMP CMPL5     YES...NO ERROR NORMAL TERMINATION 
      STA REPLY+3   SET ERROR CODE IN B REG 
      STA REPLY+4   SET FOR IERR IN FMP CALL
      CCA           GET A -1
      STA REPLY+2   SET A REQ=-1...ERROR
CMPL5 LDA REPLY+2   SEE IF ERROR OCCURED
      LDB M60       SET FOR ILLEGAL CALL
      CPA ASCIL     IS IT "IL" ILLEGAL CALL 
      STB ISTAT     YES...SAVE ERROR CODE 
CMPL7 LDA CALL
      INA 
      STA P.PTR     PTR TO USER CALL PARAMS.
* 
      LDA RPLY
      ADA .4
      STA I.PTR     PTR TO REPLY BUFR PARAMS. 
* 
      LDA .FCN      TEST FOR RFA OR CEXEC.
      SZA,RSS 
      JMP RREXC     CEXEC.
* 
      LDB FCN       RFA. CSTAT? 
      CPB D162
      JMP EXIT      YES. ALL DONE.
* 
      LDA I.PTR,I   NO. RETURN IERR.
      ISZ P.PTR     PASS OVER DCB 
      JSB RWORD 
      ISZ I.PTR     GET TO FIRST RETURN PRAM
      LDA ISTAT     GET STATUS
      SZA           ANY ERRORS? 
      JMP EXIT      YES...DON'T STORE ANYTHING
* 
      LDB FCN 
      CPB D154      CREAD?
      RSS 
      JMP CMPL3     NO. 
      LDA P.PTR     MOVE PARAM POINTER. 
      ADA .2
      STA P.PTR 
      LDA I.PTR,I   YES. RETURN XMSN LOG. 
      JSB RWORD 
      JMP EXIT
* 
CMPL3 CPB D160      CLOCF?
      RSS 
      JMP EXIT      NO. 
      LDB M7        YES. RETURN N PARAMS. 
      JSB PINTG 
      JMP EXIT
* 
RREXC LDA ISTAT     GET STATUS WORD 
      SZA           ANY STATUS ERRORS?
      JMP CMPL4     YES...REPORT THEM 
      LDA .RCD      GET REQUEST CODE
      CPA .10       IS IT A SCHEDULE? 
      JMP CMPL6     YES...PASS BACK STATUS
      CPA D12       SEE IF TIME SCHEDULE
      JMP CMPL8     YES...CHECK FOR ILLEGAL TIME INTERVAL REQ 
      CPA D11       IS IT A TIME CALL?
      RSS           YES 
      JMP EXIT      NO...DONE 
      LDB M5        RETURN TIME ARRAY 
      STB TEMP2     SAVE COUNT
TLOOP LDA I.PTR,I 
      JSB RWORD     SAVE VALUE
      ISZ I.PTR 
      ISZ TEMP2     DONE? 
      JMP TLOOP     NO...CONINUE
      JMP EXIT
* 
CMPL4 LDA ISTAT 
      SSA           IF POSITIVE, DON'T CONVERT
      CMA,INA 
      STA ISTAT 
      JSB ERROR     ERROR...STATUS ERROR
      DEF *+3 
      DEF ISTAT     STATUS CODE 
      DEF ERMSG     "DS"
      JMP EXIT      TERMINATE CALL
* 
CMPL6 ISZ P.PTR     SKIP OVER NAME...STATUS RETURN
      LDA REPLY+2   A REG TO SCHEDULE CALL
      JSB RWORD     PASS BACK STATUS
      JMP EXIT      AND TERMINATE 
* 
*     HERE ON TIME INTERVAL REQ 
* 
CMPL8 LDB M72       SET FOR ILLEGAL SCHEDULE CALL 
      LDA REPLY+2   SEE IF REPLY IS ASC..."SC". 
      CPA SCCOD     IF SO, TELL WORLD 
      RSS 
      JMP EXIT      NO ERROR
      STB ISTAT     SAVE STATUS 
      JMP CMPL4     AND GO COMPLAIN 
      SPC 1 
SCCOD ASC 1,SC
      SPC 1 
* 
* RETURN TO USER PROGRAM. 
* 
EXIT  CLA           CLEAR OUT DIMENSION CHECK FLAG
      STA DIMFG 
      LDA CALL,I    GET RETURN ADDRESS. 
      STA TEMP1 
      LDA REPLY+2   SET A, B REGISTERS. 
      LDB REPLY+3 
      JMP TEMP1,I   RETURN. 
      SKP 
**********************
* SUBROUTINE SECTION *******************************
**********************
* 
* STORE INTEGER PARAM FROM USER CALL INTO PARMB.
* 
INTGR NOP 
      JSB PCHEK     IS THE PARAM SPECIFIED? 
      JMP MSSNG     NO. 
      JSB STERM     SAVE CONTROL BYTE 
      JSB GET.P     FETCH PARAM VALUE.
      JSB STWRD     STORE IN PARMB. 
      JMP INTGR,I   (A) HAS THE VALUE.
* 
* STORE OPTIONAL INTEGER PARAM (IF SPECIFIED) FROM
* USER CALL INTO PARMB. 
* 
OPTN  NOP 
      JSB PCHEK     IS PARAM SPECIFIED? 
      JMP OPTN,I    NO (LEAVE P.PTR ALONE). 
      JSB INTGR     YES, STORE IT.
      JMP OPTN,I    (A) HAS THE VALUE.
* 
* STORE AN ASCII STRING FROM USER FISRT WORD
* CONTAINS THE COUNT OF STRING TO BE STORED 
* INTO PARMB. 
* 
STRNG NOP 
      JSB PCHEK     IS PARAM SPECIFIED? 
      JMP MSSNG     NO. 
* 
      LDA .6        STORE CONTROL BYTE. 
      JSB STBYT 
      JSB GET.A     GET ADDRESS 
      JSB FIXNM     CHECK IF NUMBER INSTEAD OF NAME 
      JMP MSSNG     TREAT AS MISSING PRAM IF ERROR
      STB TEMP3     SAVE ADDRESS OF NAME
      LDA TEMP3,I   GET LENGTH WORD 
      AND B377      MASK OFF ALL BUT COUNT
      CMA,INA       NEGATE COUNT
      STA TEMP2     SAVE COUNT
      ADA .6        GET NUMBER OF SPACES NEEDED 
      CMA           NEGATE IT -1
      STA TEMP4     SAVE # OF SPACES
      SSA,RSS       MAKE SURE NOT OVER 6 CHAR LONG
      JMP MSSNG     TREAT AS AN ERROR 
STR   ISZ TEMP3     GET ADDRESS OF NEXT WORD
      LDA TEMP3,I   GET CHARACTER 
      ALF,ALF       GET UPPER CHAR FIRST
      JSB STBYT     SAVE CHARACTER
      ISZ TEMP2     DONE? 
      RSS           NO...CONTINUE 
      JMP STR1      YES 
      LDA TEMP3,I   GET RIGHT CHARACTER 
      JSB STBYT 
      ISZ TEMP2     DONE? 
      JMP STR       NO
STR1  LDA .32       YES...NEED SPACES?
      ISZ TEMP4     COUNT WILL BE -1 OR LESS
      RSS           NEED SPACE
      JMP STRNG,I   MOVED ALL THE SPACES WE NEEDED
      JSB STBYT     SAVE SPACE
      JMP STR1      AND CONTINUE
* 
*     SUBROUTINE TO MOVE NAME FROM NAME TO DCB
* 
MNAM  NOP 
      LDA P.PTR     GET CURRENT PRAM ADDRESS
      STA TEMP4 
      JSB GET.A     GET DCB NAME ADDRESS
      STA MNAM1     SAVE ADDRESS FOR MOVE 
      ISZ P.PTR     WE ARE OK...GET INPUT ADDRESS 
      JSB GET.A     GET ADDRESS 
      STA TEMP3     SAVE AS TEMP
      LDA MNAM1     GET LOWER BOUND 
      LDB MNAM1     GET UPPER BOUND 
      ADB .2
      JSB DIMCK     SEE IF DIM ARRAY
MNAM2 LDB M4        GET DOWN COUNTER
      LDA TEMP3,I   GET SOURCE
      STA MNAM1,I   SAVE VALUE
      ISZ TEMP3 
      ISZ MNAM1 
      INB,SZB       DONE? 
      JMP *-5       NO
      LDA TEMP4     GET CURRENT PRAM ADDRESS
      STA P.PTR     RESET POINTER 
      JMP MNAM,I    RETURN
      SPC 1 
MNAM1 NOP 
      SPC 2 
* 
*     SUBROUTINE TO DO DIMENSION CHECKING 
*     CALLING SEQUENCE
*     JSB DIMCK 
*     A REG= START OF ARRAY 
*     B REG= END OF ARRAY 
*     WILL ABORT IF ERROR 
* 
DIMCK NOP 
      CMA 
      CMB           NEGATE BOUNDS 
      ADA PROGL     START OF STACK AREA 
      ADB FCORE     END OF STACK AREA 
      SSA           MUST BE NEGATIVE
      SSB           MUST BE POSITIVE
      RSS           ERROR...HE BLEW IT...KICK HIM OFF 
      JMP DIMCK,I   RETURN...ALL OK 
      LDA DIMFG     SEE IF SPECIAL
      SZA           ZERO, NOT SPECIAL 
      JMP DIMCK,I   YES SPECIAL 
      JSB ERROR     ERROR...DST ERROR 
      DEF *+3 
      DEF .1
      DEF DST       DST ERROR MESSAGE 
      JMP .STOP     DOOM...GET OUT
DST   DEC 3 
      ASC 2,DST 
DIMFG NOP 
      SPC 1 
* 
* STORE A-REGISTER CONTENTS INTO NEXT WORD
* OF SAVED VALUES.
* 
RPARM NOP 
      LDB U.PTR,I 
      STA B,I 
      ISZ U.PTR 
      JMP RPARM,I 
* 
* STORE USER BUFFER LENGTH IN PARMB, DATA-FLAG, 
* AND SAVE IT.
* 
STLEN NOP 
      JSB INTGR     STORE IN PARMB. 
* 
      SZA,RSS 
      JMP WRONG     SPECIFIED, BUT ZERO.
      SSA,RSS       NEGATIVE? 
      JMP STL       NO. 
* 
      CMA,INA       YES, MAKE POSITIVE. 
      INA           ROUND UP. 
      CLE,ERA       CONVERT TO WORD COUNT.
* 
STL   STA PARMB,I   STORE IN DATA-FLAG. 
      JSB RPARM     PASS BACK TO CALLER.
      JMP STLEN,I   EXIT. 
* 
WRONG LDA M71 
      JMP SSTAT 
* 
* TEST WHETHER THE USER HAS SPECIFIED 
* A PARAMETER.
*        JSB PCHEK
*         ERROR RETURN (PARAM NOT GIVEN)
*         NORMAL RETURN 
* 
PCHEK NOP 
      LDA P.PTR     PARAM ADDR
      CMA,INA 
      ADA CALL,I    RETURN ADDRESS. 
      ADA M1
      SSA,RSS 
      ISZ PCHEK 
      JMP PCHEK,I 
* 
* GET VALUE OF NEXT PARAM IN USER CALL
* 
GET.P NOP 
      JSB GET.A     FETCH PARAM ADDR. 
      LDA A,I       GET PARAM VALUE.
      JMP GET.P,I 
* 
* GET ADDRESS OF NEXT PARAM IN USER CALL
*   AND BUMP PARAM POINTER. 
* 
GET.A NOP 
      LDA P.PTR,I   GET PARAMETER ADDRESS.
      RSS           RESOLVE 
      LDA A,I         INDIRECT
      RAL,CLE,SLA,ERA   ADDRESSES.
      JMP *-2 
      ISZ P.PTR     BUMP PARAM POINTER. 
      JMP GET.A,I 
* 
* STORE WORD (IN A-REG) IN PARMB. 
* 
STWRD NOP 
      STA TEMP2     SAVE WORD.
      ALF,ALF 
      JSB STBYT     STORE LEFT BYTE.
      LDA TEMP2 
      JSB STBYT     STORE RIGHT BYTE. 
      LDA TEMP2     RESTORE WORD. 
      JMP STWRD,I   RETURN. 
* 
* STORE BYTE IN NEXT BYTE OF PARMB. 
* 
STBYT NOP           (A) = BYTE RIGHT JUSTIFIED. 
      AND B377      ISOLATE NEW BYTE. 
      STA TEMP1     SAVE. 
      LDB B.PTR     FORM WORD ADDR OF PARMB.
      CLE,ERB       (E) = LEFT/RIGHT FLAG.
      ADB PARMB 
* 
      LDA B,I       INSERT NEW BYTE INTO PARMB. 
      SEZ,RSS 
      ALF,ALF 
      AND M377L 
      IOR TEMP1 
      SEZ,RSS 
      ALF,ALF 
      STA B,I 
* 
      ISZ B.PTR     BUMP RELATIVE BYTE POINTER. 
      JMP STBYT,I   RETURN. 
* 
* 
* PASS A-REG CONTENTS TO USER PARAM.
* 
RWORD NOP 
      STA TEMP1 
      JSB PCHEK     IS PARAM SPECIFIED? 
      JMP RWORD,I   NO. 
      LDA TEMP1     YES.
      LDB P.PTR,I 
      STA B,I 
      ISZ P.PTR 
      JMP RWORD,I 
* 
* PASS N PARAMS TO USER PROGRAM. (B)= -N. 
* 
PINTG NOP 
      STB TEMP2 
PLOOP LDA I.PTR,I 
      JSB RWORD 
      ISZ I.PTR 
      ISZ TEMP2 
      JMP PLOOP 
      JMP PINTG,I 
* 
*     SET CONTROL BYTE
* 
STERM NOP 
      LDA B202
      JSB STBYT 
      JMP STERM,I   RETURN
      SKP 
* 
*     SUBROUTINE TO ACCEPT EITHER A FLOATING POINT #
*     OR AN ASC II STRING 
*     CALLING SEQUENCE
*     JSB FIXNM 
*     ERROR RETURN
*     NORMAL RETURN 
*     A REG=ADDRESS OF FIELD
*     B REG=NOT CHANGED IF ERROR, OR BUFFER ADDRESS ON RETURN 
* 
FIXNM NOP 
      JSB INDCK     TRACE DOWN THOSE LITTLE BITS
      STA FXNMA     SAVE ADDRESS OF BUFFER
      LDA A,I       GET COUNT WORD
      SZA,RSS       ERROR...ZERO
      JMP FIXNM,I   ERROR RETURN
      RAL,SLA       NEGATIVE NUMBERS...ILLEGAL
      JMP FIXNM,I   ERROR 
      LDB FXNMA     GET ADDRESS OF BUFFER AGAIN 
      ISZ FIXNM     GET NORMAL RETURN 
      SSA,RSS       BIT 14 SET...NUMERIC
      JMP FIXNM,I   NO...ASC STRING 
* 
*     IF NUMERIC CONVERT TO ASC AND ADD THE PREFEX "N"
* 
      LDB FNBFA     GET ADDRESS OF INTERNAL BUFFER
      INB           GET TO FIRST DATA WORD
      RBL           CONVERT TO BYTE ADDRESS 
      LDA ASCN      GET THE PREFEX "N"
      JSB SBYTE     SAVE PREFEX 
      INB           GET TO NEXT DATA BYTE ADDRESS 
      STB FXNMB     SAVE IN TEMP LOCATION 
      DLD FXNMA,I   GET FLOATING POINT WORD 
      FIX           CONVERT IT TO INTEGER 
      JSB BNDEC     CONVERT TO ASC
FXNMB NOP           BYTE ADDRESS GOES HERE
      INA           INCREMENT CHARACTER COUNT TO INCLUDE "N"
      STA FNBF      SAVE LENGTH OF NAME 
      LDB FNBFA     GET ADDRESS OF NAME BUFFER
      JMP FIXNM,I   AND RETURN
      SPC 2 
ASCN  OCT 116       ASC "N" 
FXNMA NOP 
FNBFA DEF FNBF
FNBF  BSS 4 
                                                                                                                                                                                                          