ASMB,R,L,B
        HED <<BASIC/IMAGE INTERFACE LIBRARY>> 
        NAM BAIMG,7 92069-16255 REV.2026 800201 
* 
* 
******************************************************************* 
* (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:    92069-18255
*     RELOC:     92069-16255
* 
*     PRGMR:     CEJ
*     ALTERED:   FEBUARY 1, 1980 FOR SORTED CHAINS FEATURE - CEJ
* 
* 
******************************************************************* 
* 
* 
* 
* 
        ENT DMOPN,DMINF,DMFND,DMGET,DMUPD,DMPUT,DMDEL,DMCLS 
        ENT DMLCK,DMUNL 
* 
        EXT $CVT3,.ENTR,.FIXD,.FLTD,.MVW,DBOPN,DBINF,DBFND
        EXT DBGET,DBUPD,DBPUT,DBDEL,DBCLS,DBLCK,DBUNL 
        EXT DCITA,FLOAT,IFIX,NAMR,RSFLG 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBOPN(BASEO,LEVLO,MODEO,STATO) 
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBOPN(RVA,RA,I,IVA),   OV=NN,  ENT=DMOPN,  FIL=%BAIMG 
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
BASEO   NOP 
LEVLO   NOP 
MODEO   NOP 
STATO   NOP 
* 
DMOPN   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
         DEF BASEO
* 
        JSB ASCI        CONVERT STRING TO ASCII 
         DEF BASEO      PASS ADDRESS OF STRING
* 
        LDA BASEO,I     MAKE SURE BASE STARTS WITH
        CPA BLNKS         TWO BLANKS
        RSS 
        JMP E310
* 
        JSB ASCI        CONVERT STRING TO ASCII 
         DEF LEVLO      PASS ADDRESS OF STRING
* 
        JSB PAD         PAD LEVEL NAME TO 6 CHARACTERS
         DEF *+3
         DEF LEVLO
         DEF NAME1
* 
        JSB DBOPN       CALL IMAGE OPEN ROUTINE 
         DEF *+5
         DEF BASEO,I
         DEF NAME1
         DEF MODEO,I
         DEF STATO,I
* 
EXTO1   JSB RSFLG       SET SAVE RESOURCES FLAG 
         DEF *+1
        JMP DMOPN,I     TERMINATE OPEN CALL 
* 
E310    LDA .310        ILLEGAL BASE PARAMETER ERROR. 
        STA STATO,I 
        JMP EXTO1 
        SKP 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBINF(BASEI,IDI,MODEI,STATI,BUFI)
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBINF(RA,RA,I,IVA,RVA),   OV=NN,  ENT=DMINF,   FIL=%BAIMG 
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
BASEI   NOP 
IDI     NOP 
MODEI   NOP 
STATI   NOP 
BUFI    NOP 
* 
DMINF   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
         DEF BASEI
        ISZ BASEI 
* 
        JSB ASCI        CONVERT STRING TO ASCII 
         DEF IDI
* 
        JSB PAD         PAD ID TO 6 CHARACTERS
         DEF *+3
         DEF IDI
         DEF NAME1
* 
        LDA MODEI,I 
        SSA             IS MODE < 0?
        JMP E324          YES - ILLEGAL DBINF REQUEST 
* 
        CLB               NO - DETERMINE AN INDEX INTO
        DIV .100          JUMP TABLE BASED ON MODE. 
* 
        SZA,RSS         A = QUOTIENT MODE/100 
        JMP E324        IS QUOTIENT > 0 
        CMA,INA 
        ADA .4            AND <=4?
        SSA 
        JMP E324          NO - ILLEGAL MODE.
* 
        SZB,RSS         B = REMAINDER MODE/100
        JMP E324        IS REMAINDER > 0
        CMB,INB 
        ADB .4            AND <=4?
        SSB 
        JMP E324          NO - ILLEGAL MODE.
* 
        ALS,ALS         A = (4-QUOTIENT)*2+(4-REMAINDER)
        IOR B 
        ADA JMPTB 
        JMP A,I 
* 
JMPTB   DEF *+1 
        JMP E324        MODE = 404
        JMP E324        MODE = 403
        JMP INF8        MODE = 402
        JMP INF8        MODE = 401
* 
        JMP E324        MODE = 304
        JMP E324        MODE = 303
        JMP INF7        MODE = 302
        JMP INF6        MODE = 301
* 
        JMP INF4        MODE = 204
        JMP INF4        MODE = 203
        JMP INF5        MODE = 202
        JMP INF1        MODE = 201
* 
        JMP INF3        MODE = 104
        JMP INF3        MODE = 103
        JMP INF2        MODE = 102
        JMP INF1        MODE = 101
* 
INF1    JSB INFO        CALL IMAGE ROUTINE MODES 101 & 201. 
* 
        LDA BUFFR       IF A NEGATIVE NUMBER RETURNED,
        LDB MINUS         THEN PUT A "- " IN BUFI 
        SSA,RSS           ELSE PUT A "+ " IN BUFI.
        LDB PLUS
        LDA .2          CHARACTER COUNT = 2.
        DST BUFI,I
        JMP EXITI 
* 
INF2    JSB INFO        CALL IMAGE ROUTINE MODE 102.
* 
        LDB BUFI        SET UP PBUF FOR PAK SUBROUTINE. 
        INB 
        STB PBUF
* 
        LDA BUFFR+8     GET ITEM TYPE AND 
        ALF,ALF 
        JSB PAK           PACK IT INTO BUFI 
* 
        LDA COMMA       FOLLOW IT BY A COMMA. 
        JSB PAK 
* 
        LDA BUFFR+9     GET ELEMENT LENGTH AND
        CCE               CONVERT IT INTO A DECIMAL 
        JSB $CVT3         ASCII STRING. 
        CCE,INA         A -> 3 SIGNIFICANT CHARACTERS.
        RAL,ERA         SET UP UPBUF FOR PACKN SUBROUTINE.
        STA UPBUF         (SET SIGN BIT OF A.)
        JSB PACKN       MOVE ELEMENT LENGTH INTO BUFI 
         DEF .3 
* 
        LDA COMMA       FOLLOW IT WITH A COMMA. 
        JSB PAK 
* 
        LDA BUFFR+10    GET ELEMENT COUNT,
        CCE               AND CONVERT IT. 
        JSB $CVT3 
        CCE,INA         PUT THE RESULTANT 3 
        RAL,ERA           SIGNIFICANT CHARACTERS
        STA UPBUF         INTO BUFI.
        JSB PACKN 
         DEF .3 
* 
        LDA .9          CHARACTER COUNT = 9.
        STA BUFI,I
        JMP EXITI 
* 
INF3    LDA .102        SET UP MODE FOR 
        STA MODE          ITEM CONVERSION.
        JMP INF34 
* 
INF4    LDA .202        SET UP MODE FOR 
        STA MODE          SET CONVERSION. 
* 
INF34   JSB INFO        CALL IMAGE ROUTINE MODES 103, 104 
*                                                203 & 204. 
        LDA BUFI        SET UP FOR PAK SUBROUTINE.
        INA 
        STA PBUF
* 
        LDA BUFFR       GET ITEM (OR SET) COUNT 
        LDB A           IF COUNT > 36 
        CMB,INB 
        ADB .36           THEN TOO GREAT FOR
        SSB               LENGTH OF BUFI
        LDA .36           RETURN ONLY 36 ITEM (OR SET) NAMES. 
        CMA 
        STA ITEMS       SET COUNT FOR PAKIT.
* 
        CMA,CCE         CONVERT POSITIVE COUNT
        JSB $CVT3         INTO A DECIMAL ASCII STRING 
        CCE,INA         A -> 3 SIGNIFICANT DIGITS 
        RAL,ERA           (SET SIGN BIT OF A.)
        STA UPBUF       SET UP FOR PACKN
        JSB PACKN         THEN ASK IT TO MOVE 
         DEF .3           COUNT INTO BUFI.
* 
        LDA .3          SET UP FOR PAKIT
        STA COUNT       COUNT = 3 CHARACTERS
        LDA OFSET       INDEX INTO BUFFR = 1. 
        STA INDX
        JSB PAKIT       GO PACK NAMES INTO BUFI.
* 
        LDA COUNT       SET CHARACTER COUNT IN BUFI 
        STA BUFI,I
        JMP EXITI 
* 
INF5    JSB INFO        CALL IMAGE ROUTINE MODE 202.
* 
        LDB BUFI        SET UP PBUF FOR PAK.
        INB 
        STB PBUF
* 
        LDA BUFFR+8     GET DATA SET TYPE AND 
        ALF,ALF 
        JSB PAK           BUF IT INTO BUFI
* 
        LDA COMMA       FOLLOW IT WITH A COMMA. 
        JSB PAK 
* 
        LDA BUFFR+9     CONVERT LENGTH OF ENTRY TO
        CCE               A DECIMAL ASCII STRING. 
        JSB $CVT3 
        INA             A -> 4 SIGNIFICANT CHARACTERS.
        STA UPBUF 
        JSB PACKN       MOVE THOSE 4 INTO BUFI
         DEF .4 
* 
        LDA COMMA       FOLLOW THEM WITH A COMMA
        JSB PAK 
* 
        JSB DCITA       CONVERT THE DOUBLEWORD ENTRY
         DEF *+3          COUNT TO A DECIMAL ASCII STRING.
         DEF BUFFR+13 
         DEF BUFF2
        LDA OFST2       MOVE THIS STRING INTO BUFI
        STA UPBUF 
        JSB PACKN 
         DEF .10
* 
        LDA COMMA       FOLLOW WITH A COMMA AGAIN.
        JSB PAK 
* 
        JSB DCITA       CONVERT DOUBLEWORD CAPACITY 
         DEF *+3          INTO A DECIMAL ASCII STRING.
         DEF BUFFR+15 
         DEF BUFF2
        LDA OFST2       MOVE STRING INTO BUFI 
        STA UPBUF 
        JSB PACKN 
         DEF .10
* 
        LDA .28         CHARACTER COUNT = 28
        STA BUFI,I
        JMP EXITI 
* 
INF6    JSB INFO        CALL IMAGE ROUTINE MODE 301.
* 
        LDB BUFI        SET UP PBUF FOR PAK.
        INB 
        STB PBUF
* 
        LDA BUFFR       GET PATH COUNT
        LDB A 
        CMB             NEGATE IT AND SET ITEMS 
        STB ITEMS         FOR PKIT2.
* 
        CCE             CONVERT PATH COUNT TO A 
        JSB $CVT3         DECIMAL ASCII STRING. 
        ADA .2          A -> 2 SIGNIFICANT CHARACTERS.
        STA UPBUF 
        JSB PACKN       PUT THOSE 2 CHARACTERS IN BUFI. 
         DEF .2 
* 
        LDA .2          SET UP FOR PKIT2
        STA COUNT       CHARACTER COUNT = 2.
        LDA OFSET       INDEX INTO BUFFR = 1. 
        STA INDX
        JSB PKIT2 
* 
        LDA COUNT       PUT CHARACTER COUNT INTO BUFI.
        STA BUFI,I
        JMP EXITI 
* 
INF7    JSB INFO        CALL IMAGE ROUTINE MODE 302.
* 
        LDB BUFI        SET UP PBUF FOR PAK.
        INB 
        STB PBUF
* 
        LDA BUFFR       IF ITEM # IS ZERO 
        SZA,RSS 
        JMP INF73         MOVE 6 BLANKS INTO BUFI 
        LDA .102
        STA MODE
        JSB DSNAM         ELSE CONVERT NUMBER 
         DEF BUFFR        INTO A NAME.
        LDB OFST2 
        JMP INF75 
* 
INF73   LDB BLNKS 
INF75   STB UPBUF 
        JSB PACKN       MOVE THE NAME OR BLANKS 
         DEF .6           INTO BUFI 
* 
        LDA .6          CHARACTER COUNT = 6.
        STA BUFI,I
        JMP EXITI 
* 
INF8    JSB INFO        CALL IMAGE ROUTINE MODES 401 & 402. 
* 
        LDB BUFI        MOVE THE RETURNED 
        LDA OFSTB         INFO INTO BUFI
        STB PBUF          NOTE THAT BUFI IS 
        STA UPBUF         THEN INACCESSIBLE BY
        JSB PACKN         ANY BASIC PROGRAM.
         DEF .14
* 
        LDA .7          SET RETURNED LENGTH TO 7 WORDS. 
        JMP EXTI2 
* 
EXITI   INA             SET RETURNED LENGTH TO CHARACTER
        ARS               COUNT + 1 DIVIDED BY 2. 
* 
EXTI2   LDB STATI       GET ADDRESS OF LENGTH WORD
        INB 
        STA B,I           AND PUT LENGTH INTO IT. 
        JMP EXTI3 
* 
ERRI    LDA ISTAT       GET CONDITION CODE
ERRI2   STA STATI,I       AND PUT IT INTO STATI.
* 
EXTI3   JSB RSFLG       SET SAVE RESOURCES FLAG 
         DEF *+1
        JMP DMINF,I       AND TERMINATE INFO CALL.
* 
* 
* 
E324    LDA .324        ILLEGAL DBINF REQUEST 
        JMP ERRI2 
        SKP 
* 
*  DBINF CALL INTERFACE ROUTINE 
* 
INFO    NOP             CALL IMAGE INFORMATION ROUTINE
        JSB DBINF 
         DEF *+6
         DEF BASEI,I
         DEF NAME1
         DEF MODEI,I
         DEF STATI,I
         DEF BUFFR
* 
        LDA STATI,I     TEST FOR ERROR IN INFO CALL.
        SZA 
        JMP ERRI2         YES - EXIT INTERFACE. 
* 
        JMP INFO,I        NO - RETURN TO CALLER 
* 
* 
*************************************************************** 
*       CONVERT DATA SET OR ITEM NUMBER TO A NAME             * 
*                                                             * 
*       CALLING SEQUENCE:     MODE = 202                      * 
*                             JSB DSNAM                       * 
*                              DEF SET                        * 
*                      OR                                     * 
*                             MODE = 102                      * 
*                             JSB DSNAM                       * 
*                              DEF ITEM                       * 
*                                                             * 
*                             NAME RETURNED IN WORDS 1,2,3    * 
*                               OF BUFF2                      * 
*************************************************************** 
* 
DSNAM   NOP 
        LDA DSNAM,I 
        STA TMP 
* 
        JSB DBINF       CALL IMAGE INFO SUBROUTINE
         DEF *+6          IN MODE 202 TO GET NAME.
         DEF BASEI,I
         DEF TMP,I
         DEF MODE 
         DEF ISTAT
         DEF BUFF2
* 
        LDA ISTAT       CHECK FOR ERROR.
        SZA 
        JMP ERRI2       YES - JUST CONVERT STATUS WORD
        ISZ DSNAM       NO - INCREMENT RETURN ADDRESS 
        JMP DSNAM,I       AND RETURN. 
* 
* 
*************************************************************** 
*       ROUTINES TO PACK A LIST OF ITEM OR SET NAMES          * 
*                                                             * 
*       CALLING SEQUENCE:     MODE = 102                      * 
*                             ITEMS   = NUMBER OF ITEMS       * 
*                             BUFFR   = BUFFER OF NAMES       * 
*                             INDX    = OFFSET INTO BUFFR     * 
*                             JSB PAKIT                       * 
*                       OR                                    * 
*                             MODE = 202                      * 
*                      SETS <-> ITEMS = NUMBER OF SETS        * 
*                             BUFFR   = BUFFER OF NAMES       * 
*                             INDX    = OFFSET INTO BUFFR     * 
*                             JSB PAKIT                       * 
*                                                             * 
*                             NAMES ARE PACKED INTO BUFI,     * 
*                              SEPARATED BY COMMAS            * 
*************************************************************** 
* 
PAKIT   NOP 
PAKI1   ISZ ITEMS       TEST ITEM COUNT 
        RSS 
        JMP PAKIT,I     ALL NAMES PACKED
        LDA COMMA       PACK A COMMA
        JSB PAK 
* 
        ISZ COUNT       INCREMENT STRING CHARACTER COUNT
        LDB INDX,I
        SSB             TEST FOR NEGATIVE ITEM NUMBER 
        CMB,INB         YES, MAKE POSITIVE
        STB INDX,I
* 
        JSB DSNAM       CONVERT DATA ITEM NUMBER TO NAME
         DEF INDX,I     ITEM NUMBER 
* 
        LDB OFST2 
        STB UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       TRANSFER ITEM NAME TO USER BUFFER 
         DEF .6 
* 
        LDA COUNT 
        ADA .6          ADD 6 TO STRING CHARACTER COUNT 
        STA COUNT 
        ISZ INDX        INCREMENT POINTER TO NEXT ITEM
        JMP PAKI1 
* 
* 
*************************************************************** 
*       ROUTINE TO PACK A LIST OF DATA SET-DATA ITEM NAMES    * 
*                                                             * 
*       CALLING SEQUENCE:     ITEMS  = NUMBER OF DATA SETS +  * 
*                                        DATA ITEMS           * 
*                             BUFFR  = BUFFER OF SETS, ITEMS  * 
*                             INDX   = POINTER TO NEXT SET &  * 
*                                        ITEM PAIR IN BUFFR   * 
*                             JSB PKIT2                       * 
*                             NAMES ARE PACKED IN IBUF,       * 
*                               SEPARATED BY COMMAS           * 
*************************************************************** 
* 
PKIT2   NOP 
LOOP2   ISZ ITEMS       TEST SET-ITEM COUNT 
        RSS 
        JMP PKIT2,I 
        LDA COMMA       PACK A COMMA
        JSB PAK 
        ISZ COUNT       INCREMENT STRING CHARACTER COUNT
* 
        LDA .202
        STA MODE
        JSB DSNAM       CONVERT DATA SET NUMBER TO NAME 
         DEF INDX,I     DATA SET NUMBER 
        LDB OFST2 
        STB UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       PACK DATA SET NAME INTO IBUF
         DEF .6 
        LDA COUNT 
        ADA .6          ADD 6 TO STRING CHARACTER COUNT 
        STA COUNT 
* 
        ISZ INDX        INCREMENT POINTER TO NEXT ITEM
        LDA COMMA       PACK A COMMA
        JSB PAK 
        ISZ COUNT       INCREMENT STRING CHARACTER COUNT
* 
        LDA .102
        STA MODE
        JSB DSNAM       CONVERT ITEM NUMBER TO ITEM NAME
         DEF INDX,I     DATA ITEM NUMBER
        LDB OFST2 
        STB UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN 
         DEF .6 
        LDA COUNT 
        ADA .6          ADD 6 TO STRING CHARACTER COUNT 
        STA COUNT 
* 
        ISZ INDX        INCREMENT POINTER TO SORT ITEM
        LDA COMMA 
        JSB PAK         PACK A COMMA
        ISZ COUNT       INCREMENT STRING CHAR. COUNT
* 
        LDA INDX,I      IF SORT ITEM IS ZERO, 
        SZA 
        JMP PKT2        FILL BUFFER WITH BLANKS 
        LDA BLNKS 
        LDB OFST2 
        STA B,I 
        INB 
        STA B,I 
        INB 
        STA B,I 
        JMP PKT3        THEN MOVE INTO PACKING BUFFER 
* 
PKT2    JSB DSNAM       CONVERT ITEM NUMBER TO ITEM NAME
         DEF INDX,I     SORT ITEM NUMBER
PKT3    LDB OFST2 
        STB UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN 
         DEF .6 
        LDA COUNT 
        ADA .6          ADD 6 TO STRING CHARACTER COUNT 
        STA COUNT 
* 
        ISZ INDX        INCREMENT POINTER TO NEXT SET 
        JMP LOOP2       & ITEM PAIR 
* 
* 
*************************************************************** 
*            STRING PACK ROUTINE                              * 
*                                                             * 
*  THE FOLLOWING ROUTINE PACKS A CHARACTER INTO A BUFFER      * 
*  ACCORDING TO THE POINTER PBUF WITHOUT OTHERWISE ALTERING   * 
*  THE BUFFER.  THE ROUTINE UPDATES PBUF SO THAT A PACKED     * 
*  ASCII BUFFER MAY BE WRITTEN BY SUCCESSIVE CALLS TO PAK.    * 
*  PBUF CONTAINS THE ADDRESS OF THE WORD TO PACK INTO; THE    * 
*  SIGN BIT, IF SET, INDICATES A PACK INTO THE LOW ORDER      * 
*  BITS OF THE WORD.                                          * 
*                                                             * 
*  CALLING SEQUENCE:     LDA VALUE FOR PBUF                   * 
*                        STA PBUF                             * 
*                        LDA CHARACTER                        * 
*                        JSB PAK                              * 
*                                                             * 
*************************************************************** 
* 
PAK     NOP             ENTRY 
        LDB PBUF        LOAD CURRENT ADDRESS POINTER
        CLE 
        ELB,RBR         GET SIGN BIT
        SEZ,RSS         TEST IF SIGN BIT SET
        ALF,ALF 
        STA CHAR
        LDA B,I         GET CONTENTS OF ASCII BUFFER
        SEZ 
        ALF,ALF 
        AND B177        MASK HIGH BITS
        SEZ 
        ALF,ALF 
        XOR CHAR        GET ACTUAL CHARACTER
        STA B,I         PACK IN CURRENT PACK ADDRESS
        SEZ,CME         TEST IF SIGN BIT SET
        INB,RSS         YES, INCREMENT PACK ADDR
        ELB,RBR 
        STB PBUF        SAVE NEW ADDRESS POINTER
        JMP PAK,I       RETURN
* 
* 
*************************************************************** 
*                    STRING UNPACK ROUTINE                    * 
*                                                             * 
*  THE FOLLOWING ROUTINE UNPACKS A CHARACTER FROM A PACKED    * 
*  ASCII BUFFER ACCORDING TO THE POINTER UPBUF.  THE ROUTINE  * 
*  UPDATES UPBUF SO THAT A PACKED BUFFER MAY BE SEARCHED BY   * 
*  SUCCESSIVE CALLS TO UNPAK.  UPBUF CONTAINS THE ADDRESS OF  * 
*  THE WORD TO UNPACK FROM; THE SIGN BIT, IF SET, INDICATES   * 
*  AN UNPACK FROM THE LOW ORDER BITS OF THE WORD.             * 
*                                                             * 
*  CALLING SEQUENCE:     LDA VALUE FOR UPBUF                  * 
*                        STA UPBUF                            * 
*                        JSB UNPAK                            * 
*                        CHARACTER RETURNED IN A-REGISTER     * 
*                                                             * 
*************************************************************** 
* 
UNPAK   NOP             ENTRY 
        LDB UPBUF       LOAD CURRENT ADDRESS POINTER
        CLE 
        ELB,RBR         GET SIGN BIT
        LDA B,I         GET CONTENTS OF PACKED BUFFER 
        SEZ,RSS         TEST IF SIGN BIT SET
        ALF,ALF 
        AND B177        MASK HIGH BITS
        SEZ,CME         TEST IF SIGN BIT SET
        INB,RSS         YES, INCREMENT UNPACK ADDR
        ELB,RBR 
        STB UPBUF       SAVE NEW ADDRESS POINTER
        JMP UNPAK,I     RETURN
* 
* 
*************************************************************** 
*               CHARACTER UNPAK-PAK ROUTINE                   * 
*                                                             * 
*     THE FOLLOWING ROUTINE PERFORMS A SERIES OF UNPACK AND   * 
*     PACK OPERATIONS BASED ON THE INPUT PARAMETER N.  EACH   * 
*     UNPAK-PAK OPERATION TRANSFERS THE NEXT CHARACTER IN THE * 
*     BUFFER POINTED TO BY UPBUF INTO THE NEXT CHARACTER      * 
*     POSITION POINTED TO BY PBUF.                            * 
*                                                             * 
*     CALLING SEQUENCE:     (UPBUF) = ADDRESS OF FROM-BUFFER, * 
*                                       USED BY UNPAK         * 
*                           (PBUF)  = ADDRESS OF TO-BUFFER,   * 
*                                       USED BY PAK           * 
*                           JSB PACKN                         * 
*                           DEF N, WHERE N IS THE NUMBER OF   * 
*                             CHARACTERS TO BE TRANSFERRED    * 
*************************************************************** 
* 
PACKN   NOP 
        LDA PACKN,I 
        LDA A,I 
        CMA             SAVE CHARACTER COUNT - 1
        STA N 
TESTN   ISZ N           ALL CHARACTERS TRANSFERRED? 
        RSS 
        JMP EXIT2       YES 
        JSB UNPAK       NO, UNPACK NEXT CHARACTER 
        JSB PAK         PACK THE CHARACTER INTO TO-BUFFER 
        JMP TESTN 
EXIT2   ISZ PACKN       INCREMENT RETURN ADDRESS
        JMP PACKN,I     RETURN
      SKP 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBFND(BASEF,IDF,MODEF,STATF,ITEMF,ARGF)
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBFND(RA,RA,I,RVA,RA,RA),   OV=NN,  ENT=DMFND,   FIL=%BAIMG 
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
BASEF   NOP 
IDF     NOP 
MODEF   NOP 
STATF   NOP 
ITEMF   NOP 
ARGF    NOP 
* 
DMFND   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
         DEF BASEF
        ISZ BASEF 
* 
        JSB ASCI        CONVERT STRINGS TO ASCII
         DEF IDF
* 
        JSB PAD         PAD SET NAME TO 6 CHARACTERS
         DEF *+3
         DEF IDF
         DEF NAME1
* 
        JSB ASCI
         DEF ITEMF
* 
        JSB PAD         PAD ITEM NAME TO 6 CHARACTERS 
         DEF *+3
         DEF ITEMF
         DEF NAME2
* 
        JSB DBINF       CALL IMAGE INFORMATION ROUTINE
         DEF *+6
         DEF BASEF,I
         DEF NAME2
         DEF .102 
         DEF ISTAT
         DEF BUFF2
* 
        LDB ISTAT 
        SZB,RSS         TEST FOR ERROR IN INFORMATION CALL
        JMP FIND1       NO
        JMP ERRF        YES - RETURN ERROR TO USER
* 
FIND1   LDA BUFF2+8     DATA ITEM TYPE (I, R, OR X) 
        ALF,ALF 
        AND B377
        CPA B111        TEST FOR INTEGER ITEM (I) 
        JMP INTG        YES 
        CPA B130        TEST FOR ASCII ITEM (U) 
        RSS             YES 
        JMP FIND        NO, REAL ITEM 
* 
        JSB ASCI        CONVERT STRING TO ASCII 
         DEF ARGF 
        JMP FIND
* 
INTG    DLD ARGF,I
        JSB IFIX        CONVERT REAL TO INTEGER 
        STA ARGF,I      SAVE CONVERTED KEY ITEM VALUE 
* 
FIND    JSB DBFND       CALL IMAGE FIND ROUTINE 
         DEF *+7
         DEF BASEF,I
         DEF NAME1
         DEF MODEF,I
         DEF ISTAT
         DEF NAME2
         DEF ARGF,I 
* 
        LDA ISTAT       CHECK FOR ANY ERRORS. 
        SZA 
        JMP ERRF        YES - SKIP ALL BUT ERROR CODE CONVERSION. 
* 
        LDB STATF       NO - SET UP TO CONVERT ALL
        ADB .2            ENTRIES IN STATUS ARRAY.
        STB TMP 
        LDB ISTAD 
        ADB .4
        STB TMP2
* 
        CLA             ZERO (REAL) TO 2ND
        CLB               ELEMENT IN STATF
        DST TMP,I 
        ISZ TMP 
        ISZ TMP 
* 
        DST TMP,I       DOUBLEWORD CURRENT RECORD 
        ISZ TMP           NUMBER SET TO ZERO (REAL) 
        ISZ TMP 
* 
        LDA M3
        STA COUNT 
* 
FIND2   DLD TMP2,I      DOUBLEWORD COUNT OF # 
        JSB .FLTD         OF ENTRIES IN CHAIN 
        DST TMP,I       DOUBLEWORD RECORD # 
        ISZ TMP2          OF CHAIN FOOT 
        ISZ TMP2        DOUBLEWORD RECORD # 
        ISZ TMP           OF CHAIN HEAD 
        ISZ TMP         FLOAT ALL ABOVE ENTRIES.
        ISZ COUNT 
        JMP FIND2 
* 
ERRF    LDA ISTAT       FINALLY, CONDITION CODE.
        JSB FLOAT 
        DST STATF,I 
* 
        JSB RSFLG       SET SAVE RESOURCES FLAG 
         DEF *+1
        JMP DMFND,I     TERMINATE FIND CALL 
        SKP 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBGET(BASEG,IDG,MODEG,STATG,ARGG,NAMEG,READ-LIST)
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBGET(RA,RA,I,RVA,RA,RA,RVA,RVA,RVA,RVA,RVA,RVA,RVA,RVA,RVA), 
*                                OV=NN,  ENT=DMGET,  FIL=%BAIMG 
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
BASEG   NOP 
IDG     NOP 
MODEG   NOP 
STATG   NOP 
ARGG    NOP 
NAMEG   NOP 
LISTG   BSS 10
* 
DMGET   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
         DEF BASEG
        ISZ BASEG 
* 
        JSB ASCI        CONVERT STRING TO ASCII 
         DEF IDG
* 
        JSB PAD         PAD SET NAME TO 6 CHARACTERS
         DEF *+3
         DEF IDG
         DEF NAME1
* 
        JSB ASCI        CONVERT NAME LIST TO ASCII
         DEF NAMEG
* 
        CCB 
        ADB CHARS       SAVE CHARACTER LENGTH OF
        STB BCNT          LIST - 1 FOR NAMR.
* 
        LDA MODEG,I     GET MODE FOR DATA BASE READ 
        CPA .4          TEST FOR MODE=4 
        JMP CONVT       YES, CONVERT RELATIVE RECORD TO DOUBLE INTG.
        CPA .7          TEST FOR MODE = 7 
        JMP GET2        YES, CONVERT IARG TO CORRECT TYPE 
        JMP GET         ELSE,JUST DO GET
* 
CONVT   CCA             TEST IF RELATIVE RECORD NUMBER IS NUMERIC 
        ADA ARGG        PARM. TYPE IN WORD -1 OF VARIABLE 
        LDB A,I           IS >= 0 IF SO.
        SSB 
        JMP E306        NO, ERROR 
        DLD ARGG,I      RELATIVE RECORD NUMBER (REAL) 
        JSB .FIXD       CONVERT REAL TO DOUBLE INTEGER
        DST ARGG,I
        JMP GET         CALL IMAGE READ ROUTINE 
* 
E306    LDA .306        INVALID RECD# IN DIRECTED READ
        JMP ERRG2       SET USER STATUS CODE TO 306.
* 
GET2    JSB DBINF       GET KEY ITEM OF DATA SET IN IDSET 
         DEF *+6
         DEF BASEG,I
         DEF NAME1
         DEF .302 
         DEF ISTAT
         DEF BUFFR
* 
        LDA ISTAT 
        SZA             TEST FOR ERROR IN INFORMATION CALL
        JMP ERRG2       SET USER STATUS CODE TO ERROR NUMBER
* 
        LDB BUFFR 
        SZB,RSS         CHECK FOR KEY ITEM INACCESSIBLE 
        JMP E118        YES - ERROR 
* 
        JSB DBINF       GET ITEM TYPE OF KEY ITEM 
         DEF *+6
         DEF BASEG,I
         DEF BUFFR
         DEF .102 
         DEF ISTAT
         DEF BUFF2
* 
        LDA ISTAT 
        SZA             TEST FOR ERROR IN INFORMATION CALL
        JMP ERRG2       SET USER STATUS CODE TO ERROR NUMBER
* 
        LDA BUFF2+8 
        ALF,ALF 
        AND B377        DATA ITEM TYPE (I, R, OR X) 
        CPA B130        TEST FOR ASCII ITEM (X) 
        JMP ASC2        YES 
        CPA B111        TEST FOR INTEGER ITEM (I) 
        RSS             YES, CONVERT ARGG TO INTEGER
        JMP GET         NO, REAL ITEM (R) 
* 
        DLD ARGG,I      CONVERT ARGG TO INTEGER 
        JSB IFIX        REAL TO INTEGER CONVERSION
        STA ARGG,I
        JMP GET 
ASC2    JSB ASCI        CONVERT STRING TO ASCII 
         DEF ARGG 
* 
GET     JSB DBGET       CALL IMAGE GET ROUTINE
         DEF *+8
         DEF BASEG,I
         DEF NAME1
         DEF MODEG,I
         DEF ISTAT
         DEF NAMEG,I
         DEF IBUF 
         DEF ARGG,I 
* 
        LDA ISTAT       TEST FOR SUCCESSFUL DATA BASE READ
        SZA 
        JMP ERRG2       NO, RETURN
* 
        LDB M10         SET UP FOR ITEM VALUE MOVE. 
        STB COUNT       NO MORE THAN 9 ITEMS. 
        LDA INDXG       SET VARIABLE INDEX TO 
        STA INDX3         VARIABLE NUMBER 1.
        LDB OFSTB       SET UP INDEX INTO IBUF. 
        STB INDXB 
        CLA             SET RETURNED LENGTH TO ZERO.
        STA TOTAL 
        INA             SET CHARACTER IN NAME LIST TO 1.
        STA BSTRT 
* 
GET3    JSB NAMR        GET NEXT ITEM'S NAME
         DEF *+5          FROM NAME LIST. 
         DEF BUFF2
         DEF NAMEG,I
         DEF BCNT 
         DEF BSTRT
* 
        SSA             IS THERE ANOTHER NAME?
        JMP EXITG         NO - DONE WITH MOVE.
        ISZ COUNT         YES - CHECK TO MAKE SURE
        RSS                 NO MORE THAN NINE NAMES.
        JMP E302
* 
        JSB DBINF       GET INFORMATION ON THE ITEM.
         DEF *+6
         DEF BASEG,I
         DEF BUFF2
         DEF .102 
         DEF ISTAT
         DEF BUFF2
* 
        LDA ISTAT       CHECK FOR ERROR.
        SZA 
        JMP ERRG2 
* 
        LDA BUFF2+10    NO ERROR, GET ELEMENT COUNT.
        CMA,INA 
        STA NCNT        NEGATE AS A LOOP COUNT. 
        LDA INDX3,I     GET NEXT VARIABLES ADDRESS. 
        STA VARS
        ISZ INDX3 
* 
        SZA,RSS         IS THERE A NEXT VARIABLE? 
        JMP E303          NO - MISSING VARIABLE.
        CCA               YES - GET WORD -1 OF CURRENT VAR. 
        ADA VARS                TO TEST TYPE OF PARAMETER.
        LDA A,I 
        CLE             E USED AS INDICATOR OF VAR. TYPE. 
        SSA             TEST IF NUMERIC OR STRING.
        CME               STRING - SET E. 
* 
        LDA BUFF2+8     GET DATA ITEM TYPE. 
        ALF,ALF 
        AND B377
        CPA B130        TEST FOR ASCII ITEM (X) 
        JMP GCHAR         YES 
        CPA B111        TEST FOR INTEGER ITEM (I) 
        JMP GITR          YES 
* 
        SEZ             REAL - TEST IF VARIABLE NUMERIC.
        JMP E304          NO, ERROR 
GREL    LDA INDX3,I     ADDRESS OF NEXT VAR. IN LIST. 
        SZA,RSS         TEST IF LAST PARAM
        JMP GREL1         YES, CONTINUE.
        LDA VARS          NO, TEST IF WRITING 
        ADA .5              IN NEXT VAR.
        CMA,INA 
        ADA INDX3,I 
        SSA 
        JMP E304              YES, ERROR. 
* 
GREL1   DLD INDXB,I         NO - GET VALUE AND
        DST VARS,I          PUT INTO VARIABLE.
        ISZ INDXB       UPDATE POSITION IN
        ISZ INDXB         ITEM VALUES 
        ISZ VARS          AND VARIABLE LIST.
        ISZ VARS
        LDA TOTAL       UPDATE RETURNED LENGTH. 
        ADA .2
        STA TOTAL 
* 
        ISZ NCNT        ANY MORE ELEMENTS 
        JMP GREL          IN THIS VARIABLE? 
        JMP GET3          NO - SEE IF ANOTHER VAR.
* 
GITR    SEZ             INTEGER - TEST IF RETURN VAR. NUMERIC.
        JMP E304          NO, ERROR 
GITR1   LDA INDX3,I     ADDRESS OF NEXT VAR. IN LIST
        SZA,RSS         TEST IF LAST VAR. 
        JMP GITR2         YES, CONTINUE 
        LDA VARS          NO, TEST IF WRITING IN
        ADA .5              NEXT VARIABLE.
        CMA,INA 
        ADA INDX3,I 
        SSA 
        JMP E304            YES,ERROR 
* 
GITR2   LDA INDXB,I         NO, GET VALUE.
        JSB FLOAT         FLOAT IT
        DST VARS,I        AND STORE IT IN VARIABLE. 
        ISZ INDXB       UPDATE POSITION IN IBUF 
        ISZ VARS          AND VARIABLE. 
        ISZ VARS
        LDA TOTAL       UPDATE RETURNED LENGTH. 
        ADA .2
        STA TOTAL 
* 
        ISZ NCNT        ARE THERE ANYMORE ELEMENTS? 
        JMP GITR1         YES 
        JMP GET3          NO
* 
GCHAR   SEZ,RSS         CHARACTER - TEST IF VARIABLE TYPE STRING. 
        JMP E304          NO, ERROR 
        LDA BUFF2+9     DETERMINE ITEM LENGTH 
        CLB               IN WORDS =
        MPY BUFF2+10      ELEMENT LENGTH IN BYTES 
        ARS               * ELEMENT COUNT / 2.
        STA LENTH 
* 
        LDB INDX3,I     TEST IF LAST PARAMETER
        SZB,RSS 
        JMP GCHR1         YES, CONTINUE 
        ADA VARS          NO, TEST IF WRITING 
        ADA .3            IN NEXT VARIABLE. 
        CMA,INA 
        ADA INDX3,I 
        SSA 
        JMP E304            YES, ERROR
* 
GCHR1   LDA LENTH           NO, IS LENGTH > 127?
        CMA,INA 
        ADA .127
        SSA 
        JMP E304              YES, LENGTH ERROR.
* 
        LDB VARS              NO, MOVE VALUE IN 
        INB 
        LDA INDXB 
        JSB .MVW
         DEF LENTH
         DEC 0
        STA INDXB       UPDATE POSITION IN BUFFER 
        LDA LENTH         AND SET CHARACTER COUNT 
        ALS               IN 1ST WORD OF VARIABLE.
        STA VARS,I
        ARS             UPDATE RETURNED LENGTH. 
        ADA TOTAL 
        STA TOTAL 
        JMP GET3        THEN, SEE IF ANY MORE VARIABLES.
* 
* 
EXITG   LDB STATG       SET UP TO CONVERT STATUS ARRAY. 
        ADB .2
        STB TMP 
        LDB ISTAD 
        ADB .2
        STB TMP2
* 
        LDA TOTAL       WORD LENGTH OF DATA TRASFERED.
        JSB FLOAT 
        DST TMP,I 
        ISZ TMP 
        ISZ TMP 
* 
        LDA M4          DOUBLEWRD RECORDS AND 
        STA COUNT         COUNTS IN CHAIN.
GET4    DLD TMP2,I      4 VALUES IN ALL.
        JSB .FLTD       FLOAT ALL 4.
        DST TMP,I 
        ISZ TMP2
        ISZ TMP2
        ISZ TMP 
        ISZ TMP 
        ISZ COUNT 
        JMP GET4
* 
ERRG    LDA ISTAT       FINALLY, CONDITION CODE.
ERRG2   JSB FLOAT 
        DST STATG,I 
* 
        JSB RSFLG       SET SAVE RESOURCES FLAG 
        DEF *+1 
        JMP DMGET,I     TERMINATE GET CALL
* 
E118    LDA .118
        RSS 
E303    LDA .303        BAD ITEM NAME 
        RSS 
E302    LDA .302        ILLEGAL ITEM LIST - TOO MANY ITEMS. 
        RSS 
E304    LDA .304        BAD VARIABLE TYPE OR LENGTH.
        JMP ERRG2 
INDXG DEF LISTG 
        SKP 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBUPD(BASEU,IDU,MODEU,STATU,NAMEU,LISTU) 
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBUPD(RA,RA,I,IVA,RA,RA,RA,RA,RA,RA,RA,RA,RA,RA,RA),
*                               OV=NN,  ENT=DMUPD,  FIL=%BAIMG
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
BASEU   NOP 
IDU     NOP 
MODEU   NOP 
STATU   NOP 
NAMEU   NOP 
LISTU   BSS 11
* 
DMUPD   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
         DEF BASEU
        ISZ BASEU 
* 
        JSB ASCI        CONVERT STRING TO ASCII 
         DEF IDU
* 
        JSB PAD         PAD SET NAME TO 6 CHARACTERS
         DEF *+3
         DEF IDU
         DEF NAME1
* 
        JSB ASCI        CONVERT NAME LIST TO ASCII. 
         DEF NAMEU
* 
        CCB 
        ADB CHARS       SAVE CHARACTER LENGTH OF
        STB BCNT          LIST -1 FOR NAMR. 
* 
        JSB IVAL        CONSTRUCT IVALU PACKED ARRAY
         DEF *+4
         DEF NAMEU
         DEF LISTU
         DEF BASEU
        SZB,RSS         TEST FOR ERROR IN CONSTRUCTION
        JMP UPDT3       NO
        STB STATU,I     YES, SET USER STATUS CODE TO ERROR
        JMP ERRU        RETURN. 
* 
UPDT3   JSB DBUPD       CALL IMAGE UPDATE ROUTINE 
         DEF *+7
         DEF BASEU,I
         DEF NAME1
         DEF MODEU,I
         DEF STATU,I
         DEF NAMEU,I
         DEF IBUF 
* 
ERRU    JSB RSFLG       SET SAVE RESOURCES FLAG 
         DEF *+1
        JMP DMUPD,I     TERMINATE UPDATE CALL 
        SKP 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBPUT(BASEP,IDP,MODEP,STATP,NAMEP,LISTP) 
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBPUT(RA,RA,I,RVA,RA,RA,RA,RA,RA,RA,RA,RA,RA,RA,RA),
*                               OV=NN,  ENT=DMPUT,  FIL=%BIAMG
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
BASEP   NOP 
IDP     NOP 
MODEP   NOP 
STATP   NOP 
NAMEP   NOP 
LISTP   BSS 11
* 
DMPUT   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
         DEF BASEP
        ISZ BASEP 
* 
        JSB ASCI        CONVERT STRING TO ASCII 
         DEF IDP
* 
        JSB PAD         PAD SET NAME TO 6 CHARACTERS
         DEF *+3
         DEF IDP
         DEF NAME1
* 
        JSB ASCI        CONVERT NAME LIST TO ASCII
         DEF NAMEP
* 
        CCB 
        ADB CHARS       SAVE CHARACTER LENGTH OF
        STB BCNT          LIST -1 FOR NAMR. 
* 
        JSB IVAL        BUILD IVALU PACKED ARRAY
         DEF *+4
         DEF NAMEP
         DEF LISTP
         DEF BASEP
        SZB,RSS         TEST FOR ERROR IN PARSE 
        JMP PUT         NO ERROR, COMPLETE PUT REQUEST
        STB ISTAT       SET USER STATUS CODE TO ERROR NUMBER
        JMP ERRP        RETURN
* 
PUT     JSB DBPUT       CALL IMAGE PUT ROUTINE
         DEF *+7
         DEF BASEP,I
         DEF NAME1
         DEF MODEP,I
         DEF ISTAT
         DEF NAMEP,I
         DEF IBUF 
* 
        LDA ISTAT       CHECK FOR ERROR 
        SZA 
        JMP ERRP          YES, JUST CONVERT STATUS CODE.
* 
        LDB ISTAD         NO, CONVERT ENTIRE ARRAY. 
        INB             SET UP FOR CONVERSIONS. 
        STB TMP 
        LDB STATP 
        ADB .2
        STB TMP2
* 
        LDA TMP,I       INTEGER WORD LENGTH OF IBUF 
        JSB FLOAT         TO REAL.
        DST TMP2,I
        ISZ TMP 
        ISZ TMP2
        ISZ TMP2
* 
        LDA M4          FOUR DOUBLEWORDS CONTAINING 
        STA COUNT         CONTS AND RECORD NUMBER.
EXITP   DLD TMP,I       FLOAT THEM ALL. 
        JSB .FLTD 
        DST TMP2,I
        ISZ TMP 
        ISZ TMP 
        ISZ TMP2
        ISZ TMP2
        ISZ COUNT 
        JMP EXITP 
* 
ERRP    LDA ISTAT       INTEGER ERROR CODE, 
        JSB FLOAT         CONVERT TO REAL 
        DST STATP,I 
* 
        JSB RSFLG       SET SAVE RESOURCES FLAG 
        DEF *+1 
        JMP DMPUT,I     TERMINATE PUT CALL
        SKP 
* 
* 
*      SUBROUTINE TO BUILD THE PACKED VALUE ARRAY FOR DBUPD & DBPUT.
* 
*      CALLING SEQUENCE:
*                           JSB IVAL
*                            DEF *+4
*                            DEF NAMES <<OF ITEMS>> 
*                            DEF LIST  <<LIST OF VARS. CONTAINING VALUES>>
*                            DEF BASE  <<DATA BASE PARAMETER>>
* 
*      THE VALUES ARE PACKED INTO IBUF. 
* 
IVAL    NOP             CONSTRUCT IVALU PACKED ARRAY
        LDB IVAL
        LDA B,I         SAVE RETURN ADDRESS 
        STA IVAL
        LDA OFSTB       INITIALIZE POINTER TO IBUF. 
        STA INDXB 
        INB 
        LDA B,I         FETCH PARAMETERS
        LDA A,I 
        STA TMP         SAVE POINTER TO NAME LIST 
        INB 
        LDA B,I           VARIABLE LIST 
        STA INDX3 
        INB 
        LDB B,I           AND DATA BASE 
        LDB B,I 
        STB BASE
* 
        LDA M11         SET NAME COUNT TO -11.
        STA COUNT 
        CLA,INA         SET STARTING CHARACTER FOR NAMR 
        STA BSTRT         TO ONE. 
* 
NITEM   LDB INDX3,I     GET NEXT PARAMETER FROM PRINT-LIST
        STB VARS        SAVE VARIABLE-LIST ADDRESS
* 
        JSB NAMR        GET NEXT ITEM'S NAME. 
         DEF *+5
         DEF BUFF2
         DEF TMP,I
         DEF BCNT 
         DEF BSTRT
* 
        SSA             END OF NAME LIST? 
        JMP EXIT7         YES 
        ISZ COUNT         NO, TOO MANY NAMES? 
        RSS 
        JMP E302A           YES 
* 
        JSB DBINF           NO, GET ITEM INFORMATION. 
         DEF *+6
         DEF BASE,I 
         DEF BUFF2
         DEF .102 
         DEF ISTAT
         DEF BUFF2
* 
        LDB ISTAT       TEST FOR ERROR IN INFO CALL 
        SZB 
        JMP IVAL,I        YES, RETURN ERROR 
* 
        LDA VARS        ADDRESS OF PRINT-LIST PARAMETER 
        SZA             TEST FOR NO PARAMETER 
        JMP NITM3       NO ERROR, CONTINUE
        LDB .305        VARIABLE MISSING IN VARIABLE LIST 
        JMP IVAL,I      RETURN
* 
NITM3   ISZ INDX3       INCREMENT INDEX TO PLIST
        LDA BUFF2+10    GET ELEMENT COUNT 
        CMA,INA           AND NEGATE FOR LOOP COUNTER.
        STA NCNT
        LDA BUFF2+8     DATA ITEM TYPE (I,R, OR X)
        ALF,ALF 
        AND B377
        CPA B130        TEST FOR ASCII ITEM (X) 
        JMP STRNG       YES 
        CPA B111        TEST FOR INTEGER ITEM (I) 
        JMP INTGR       YES 
* 
REAL    LDA INDX3,I     ADDRESS OF NEXT PARM IN VAR-LIST
        SZA,RSS         TEST IF LAST PARAMETER
        JMP NITM4       YES, CONTINUE 
        LDA VARS        NO, TEST IF READING FROM NEXT PARM
        ADA .5
        CMA,INA 
        ADA INDX3,I 
        SSA,RSS 
        JMP NITM4       NO, CONTINUE
E304A   LDB .304        ERROR 
        RSS 
E303A   LDB .303
        RSS 
E302A   LDB .302
        JMP IVAL,I      RETURN
* 
NITM4   DLD VARS,I      NO, REAL ITEM (R) 
        DST INDXB,I     PACK REAL ITEM INTO IVALU 
        ISZ INDXB       INCREMENT INDEX TO IVALU ARRAY
        ISZ INDXB 
        ISZ VARS          AND INTO VARIABLE 
        ISZ VARS
        ISZ NCNT        ANY MORE ELEMENTS?
        JMP REAL          YES 
        JMP NITEM         NO
* 
STRNG   LDB VARS,I      STRING CHARACTER COUNT
        SLB             TEST IF ODD COUNT 
        INB             YES 
        BRS             LENGTH IN WORDS 
        STB TMP2
        LDA BUFF2+9     COMPARE WITH LENGTH AS DEFINED
        CLB 
        MPY BUFF2+10
        ARS 
        CPA TMP2
        RSS             YES, CORRECT ITEM LENGTH
        JMP E304A       NO, INCORRECT ITEM LENGTH 
        JSB ASCI        CONVERT STRING TO ASCII 
         DEF VARS 
        LDA VARS        MOVE CHARACTER STRING INTO IBUF.
        LDB INDXB 
        JSB .MVW
         DEF LENTH
         DEC 0
        STB INDXB       SAVE PLACE IN IBUF. 
        JMP NITEM       GO SEE IF MORE NAMES. 
* 
INTGR   LDA INDX3,I     ADDRESS OF NEXT PARM IN VAR-LIST
        SZA,RSS         TEST IF LAST PARAMETER
        JMP INTG2       YES, CONTINUE 
        LDA VARS        NO, TEST IF READING FROM NEXT PARM
        ADA .5
        CMA,INA 
        ADA INDX3,I 
        SSA 
        JMP E304A       YES, SET ERROR CODE 
* 
INTG2   DLD VARS,I      GET NEXT VARIABLE IN PRINT-LIST 
        JSB IFIX        CONVERT TO INTEGER
        STA INDXB,I     PACK INTEGER INTO IVALU 
        ISZ INDXB       INCREMENT INDEX TO IVALU
        ISZ VARS          AND TO VARIABLE 
        ISZ VARS
        ISZ NCNT        ANY MORE ELEMENTS?
        JMP INTGR         YES 
        JMP NITEM         NO, GET NEXT ITEM FROM INBR ARRAY 
* 
EXIT7   CLB             SET INTERNAL ERROR CODE TO ZERO 
        JMP IVAL,I      RETURN
        SKP 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBDEL(BASED,IDD,MODED,STATD) 
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBDEL(RA,RA,I,IVA),   OV=NN,  ENT=DMDEL,   FIL=%BAIMG 
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
BASED   NOP 
IDD     NOP 
MODED   NOP 
STATD   NOP 
* 
DMDEL   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
         DEF BASED
        ISZ BASED 
* 
        JSB ASCI        CONVERT STRING TO ASCII 
         DEF IDD
* 
        JSB PAD         PAD SET NAME TO 6 CHARACTERS
         DEF *+3
         DEF IDD
         DEF NAME1
* 
        JSB DBDEL       CALL IMAGE DELETE ROUTINE 
         DEF *+5
         DEF BASED,I
         DEF NAME1
         DEF MODED,I
         DEF STATD,I
* 
        JSB RSFLG       SET SAVE RESOURCES FLAG 
         DEF *+1
        JMP DMDEL,I     TERMINATE DELETE CALL 
        SKP 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBCLS(BASEC,IDC,MODEC,STATC) 
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBCLS(RVA,RA,I,IVA),   OV=NN,  ENT=DMCLS,   FIL=%BAIMG
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
BASEC   NOP 
IDC     NOP 
MODEC   NOP 
STATC   NOP 
* 
DMCLS   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
         DEF BASEC
        ISZ BASEC 
* 
        JSB ASCI        CONVERT STRING TO ASCII 
         DEF IDC
* 
        JSB PAD         PAD SET NAME TO 6 CHARACTERS. 
         DEF *+3
         DEF IDC
         DEF NAME1
* 
        JSB DBCLS       CALL IMAGE CLOSE ROUTINE
         DEF *+5
         DEF BASEC,I
         DEF NAME1
         DEF MODEC,I
         DEF STATC,I
* 
        JSB RSFLG       SET SAVE RESOURCES FLAG 
         DEF *+1
        JMP DMCLS,I     TERMINATE CLOSE CALL
        SKP 
* 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBLCK(BASEL,IDL,MODEL,STATL) 
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBLCK(RA,RA,I,IVA),   OV=NN,  ENT=DMLCK,  FIL=%BAIMG
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
BASEL   NOP 
IDL     NOP 
MODEL   NOP 
STATL   NOP 
* 
DMLCK   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
         DEF BASEL
        ISZ BASEL 
* 
        JSB DBLCK       CALL IMAGE LOCK ROUTINE 
         DEF *+5
         DEF BASEL,I
         DEF IDL,I
         DEF MODEL,I
         DEF STATL,I
* 
        JSB RSFLG       SET SAVE RESOURCES FLAG 
         DEF *+1
        JMP DMLCK,I     TERMINATE LOCK CALL 
        SKP 
* 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBUNL(BASEN,IDN,MODEN,STATN) 
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBUNL(RA,RA,I,IVA),      OV=NN,   ENT=DMUNL,   FIL=%BAIMG 
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
BASEN   NOP 
IDN     NOP 
MODEN   NOP 
STATN   NOP 
* 
DMUNL   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETER 
         DEF BASEN
        ISZ BASEN 
* 
        JSB DBUNL       CALL IMAGE UNLOCK ROUTINE 
         DEF *+5
         DEF BASEN,I
         DEF IDN,I
         DEF MODEN,I
         DEF STATN,I
* 
        JSB RSFLG       SET SAVE RESOURCES FLAG 
         DEF *+1
        JMP DMUNL,I     TERMINATE UNLOCK CALL 
        SKP 
* 
* 
*      BASIC STRING TO ASCII STRING CONVERTER.
* 
*      CALLING SEQUENCE:
*                           JSB ASCI
*                            DEF STRING 
* 
*      RETURNS CHARACTER LENGTH OF STRING IN CHARS. 
* 
* 
ASCI    NOP             CONVERT STRING TO ASCII 
        LDB ASCI,I      FETCH PARAMETER (ADDR OF STRING)
        LDA B,I 
        LDA A,I 
        AND B377        EXTRACT LENGTH IN CHARACTERS
        STA CHARS       SAVE LENGTH IN CHARACTERS 
        SLA             SKIP IF EVEN NUMBER OF CHARS
        JMP ODDLN       ODD NUMBER OF CHARACTERS
        ARS             OBTAIN NUMBER OF WORDS REQUIRED 
        STA LENTH 
RMOV    ISZ B,I         CHARACTERS BEGIN AT WORD 2
        ISZ ASCI        INCREMENT RETURN ADDRESS
        JMP ASCI,I      RETURN
* 
ODDLN   INA             ADDITIONAL WORD SINCE LENGTH ODD
        ARS             OBTAIN NUMBER OF WORDS REQUIRED 
        STA LENTH 
        STB TEMP        SAVE POINTER TO STRING
        LDB B,I 
        ADB LENTH       ADDR OF LAST WORD OF STRING 
        LDA B,I 
        AND MSKLO       MASK LOWER BYTE (NO CHAR) 
        IOR B40         PAD WITH A BLANK
        STA B,I 
        LDB TEMP        RESTORE POINTER TO STRING 
        JMP RMOV
* 
TEMP  NOP 
* 
* 
*************************************************************** 
*            PAD AN ASCII STRING WITH BLANKS                  * 
*                                                             * 
*  THE FOLLOWING ROUTINE PADS A SIX-CHARACTER ASCII STRING    * 
*  WITH BLANKS, CHECKING THE VARIABLE "LENTH" TO DETERMINE    * 
*  THE AMOUNT OF PADDING NECESSARY.                           * 
*                                                             * 
*     CALLING SEQUENCE:     JSB PAD                           * 
*                           DEF *+3                           * 
*                           DEF SOURCE BUFFER ADDRESS         * 
*                           DEF RETURN BUFFER ADDRESS         * 
*                                                             * 
*************************************************************** 
* 
PAD     NOP 
        LDB PAD 
        LDA B,I         SAVE RETURN ADDRESS 
        STA PAD 
        INB 
        LDA B,I         ORIGINAL ASCII STRING 
        LDA A,I 
        STA TMP 
        INB 
        LDB B,I         RETURNED STRING ADDRESS 
        STB TMP2
* 
        LDA LENTH       STRING LENGTH IN WORDS
        CMA,INA 
        ADA .2
        SSA             TEST IF LENGTH GREATER THAN 2 
        JMP PAD2        YES 
        INB 
        SZA,RSS         TEST FOR NUMBER OF WORDS TO PAD 
        JMP PAD1
        LDA BLNKS       PAD LAST TWO WORDS
        STA B,I 
PAD1    LDA BLNKS       PAD LAST WORD 
        INB 
        STA B,I 
PAD2    LDA TMP         A-REG = SOURCE BUFFER ADDRESS 
        LDB TMP2        B-REG = DESTINATION BUFFER ADDRESS
        JSB .MVW        MOVE WORDS
        DEF LENTH       NUMBER OF WORDS TO BE MOVED 
        NOP 
        JMP PAD,I       RETURN
* 
* 
.2      DEC 2 
.3      DEC 3 
.4      DEC 4 
.5      DEC 5 
.6      DEC 6 
.7      DEC 7 
.9      DEC 9 
.10     DEC 10
.14     DEC 14
.28     DEC 28
.36     DEC 36
COMMA   DEC 44          COMMA 
.100    DEC 100 
.102    DEC 102 
.118    DEC 118 
.127    DEC 127 
.202    DEC 202 
.302    DEC 302         INVALID NAME-LIST 
.303    DEC 303         INVALID NAME IN NAME-LIST 
.304    DEC 304         INVALID PARAMETER IN VAR-LIST 
.305    DEC 305         VARIABLE MISSING IN VARIABLE-LIST 
.306    DEC 306         INVALID RECD# IN DIRECTED READ
.310    DEC 310 
.324    DEC 324         ILLEGAL DBINF REQUEST 
M3      DEC -3
M4      DEC -4
M10     DEC -10 
M11     DEC -11 
B40     OCT 40
B111    OCT 111         "I" 
B130    OCT 130         "X" 
B177    EQU .127
B377    OCT 377         MASK UPPER BYTE 
MSKLO   OCT 177400      MASK LOWER BYTE 
BLNKS   ASC 3,
MINUS   ASC 1,- 
PLUS    ASC 1,+ 
A       EQU 0 
B       EQU 1 
BSTRT   NOP 
BCNT    NOP 
BUFF2   BSS 17
COUNT   BSS 1 
BASE    NOP 
TOTAL   NOP 
INDX3   NOP 
INDXB   BSS 1 
LENTH   BSS 1 
N       EQU BASE
NAME1   BSS 3 
NCNT    BSS 1 
OFST2   DEF BUFF2 
TMP     BSS 1 
TMP2    BSS 1 
VARS    BSS 1 
ISTAT   BSS 10
ISTAD   DEF ISTAT 
IBUF    BSS 2045
BUFFR   EQU IBUF        (256 WORDS) 
NAME2   EQU IBUF+257    (3 WORDS) 
MODE    EQU IBUF+261    (1 WORD)
ITEMS   EQU IBUF+263    (1 WORD)
INDX    EQU IBUF+265    (1 WORD)
CHAR    EQU IBUF+267    (1 WORD)
PBUF    EQU IBUF+269    (1 WORD)
UPBUF   EQU IBUF+271    (1 WORD)
CHARS   EQU IBUF+273    (1 WORD)
OFSET   DEF BUFFR+1 
OFSTB   DEF BUFFR 
        END 
                                                                                                                                                                                                                                      