ASMB,R,L,C
        HED <<BASIC/IMAGE INTERFACE LIBRARY>> 
        NAM IMAG,7 92101-16019 REV.1901 781103
* 
* 
* 
************************************************************
* (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.                                                 *
************************************************************
* 
* 
* 
************************************************************
*               BASIC-IMAGE INTERFACE LIBRARY              *
************************************************************
* 
        ENT DMOPN,DMINF,DMFND,DMGET,DMUPD,DMPUT,DMDEL,DMCLS 
        ENT DMLCK,DMUNL 
* 
        EXT .ENTR,DBOPN,DBINF,DBFND,DBGET,DBUPD,DBPUT 
        EXT DBDEL,DBCLS,DBLCK,DBUNL,RSFLG,RFLAG,FWPWA 
        EXT CLOSE,AIRUN,AIDCB,ISIZE,OPEN,LOCF,FWAFS,LWAFS 
        EXT CITA,CATI,IFIX,FLOAT,.MVW 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBOPN(ISTAT,IBASE,ILEVL,ISCOD,IMODE) 
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBOPN(IVA,RA,RA,I,I),  OV=NN,  ENT=DMOPN,  FIL=IMAGR
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
ISTAT   NOP 
IBASE   NOP 
ILEVL   NOP 
ISCOD   NOP 
IMODE   NOP 
DMOPN   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
        DEF ISTAT 
        JSB ASCI        CONVERT STRING TO ASCII 
        DEF IBASE       PASS ADDRESS OF STRING
        JSB PAD         PAD DATA BASE NAME TO 6 CHARACTERS
        DEF *+3 
        DEF IBASE 
        DEF NAME1 
* 
        CLA             INITIALIZATION
        STA ISTAT,I 
        LDA ISCOD,I 
        CMA,INA 
        STA SC          MAKE SECURITY CODE NEGATIVE 
        JSB OPEN        OPEN DATA BASE ROOT FILE
        DEF *+6           TO DETERMINE SIZE 
        DEF DCB 
        DEF IERR
        DEF NAME1 
        DEF .1
        DEF SC
* 
        LDA IERR
        CPA M7          ILLEGAL SECURITY CODE?
        JMP E117        YES 
        CPA M8
        JMP E129        LOCKED OR OPEN ERROR
        SSA             ERROR?
        JMP EFMR        YES 
* 
        JSB LOCF        GET FILE LENGTH 
        DEF *+7 
        DEF DCB 
        DEF IERR
        DEF TMP 
        DEF TMP 
        DEF TMP 
        DEF LENTH 
* 
        JSB CLOSE       CLOSE 
        DEF *+2 
        DEF DCB 
* 
        LDA LENTH 
        MPY .64         COMPUTE LENGTH
        STA LENTH         IN WORDS
        LDA FWAFS       SET UP RUN TABLE ADDRESS
        STA AIRUN 
        CMA,INA 
        ADA LWAFS       COMPUTE SPACE 
        STA LENF
        CMA,INA 
        ADA LENTH 
        SSA,RSS         ENOUGH SPACE FOR RUN TABLE? 
        JMP E128        NO
        LDA FWAFS       COMPUTE ADDRESS FOR DCB'S 
        ADA LENTH 
        STA AIDCB 
        CMA,INA 
        ADA LWAFS 
        STA LENF
        CMA,INA         ENOUGH SPACE FOR 1X272? 
        ADA .272
        SSA 
        JMP A272        YES 
        LDA LENF        NO
        ADA M144        ENOUGH SPACE FOR 1X144? 
        SSA 
        JMP E128        NO
* 
        LDA M144        YES, USE 1X144
        RSS 
A272    LDA M272        USE 1X272 
        STA ISIZE 
        CMA,INA 
        ADA AIDCB       COMPUTE 1ST WORD AFTER DCB SPACE
        STA FWPWA       SAVE IT 
        LDA .1          SET FLAG TO USE FWPWA AS 1ST WORD 
        STA RFLAG         OF FREE SPACE WHILE DATA BASE OPEN
* 
        JSB ASCI        CONVERT STRING TO ASCII 
        DEF ILEVL       PASS ADDRESS OF STRING
        JSB PAD         PAD LEVEL NAME TO 6 CHARACTERS
        DEF *+3 
        DEF ILEVL 
        DEF NAME2 
* 
        JSB DBOPN       CALL IMAGE OPEN ROUTINE 
        DEF *+6 
        DEF NAME1 
        DEF NAME2 
        DEF ISCOD,I 
        DEF IMODE,I 
        DEF ISTAT,I 
* 
        JSB RSFLG       SET SAVE RESOURCES FLAG 
        DEF *+1 
        JMP DMOPN,I     TERMINATE OPEN CALL 
* 
E117    LDA .117        ILLEGAL SECURITY CODE 
        RSS 
E128    LDA .128        INSUFFICIENT BUFFER SPACE 
        RSS 
E129    LDA .129        ROOT FILE OPENED OR LOCKED
ERROR   STA ISTAT,I 
        JMP DMOPN,I 
EFMR    CMA,INA         FMGR EXIT 
        JMP ERROR 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBINF(IMODE,ID,IBUF) 
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBINF(I,RA,RVA),   OV=NN,  ENT=DMINF,   FIL=IMAGR 
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
IMOD1   NOP 
ID      NOP 
IBUF    NOP 
DMINF   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
        DEF IMOD1 
        JSB ASCI        CONVERT STRING TO ASCII 
        DEF ID
        JSB PAD         PAD ID TO 6 CHARACTERS
        DEF *+3 
        DEF ID
        DEF NAME1 
        LDA IMOD1,I 
        SSA             TEST IF MODE NEGATIVE 
        JMP E324        YES, ILLEGAL DBINF REQUEST
        ADA M8
        SSA,RSS         TEST IF MODE > 7
        JMP E324        YES, ILLEGAL DBINF REQUEST
        ADA TABAD       INDEX TO CORRECT CONVERSION ROUTINE 
        JMP A,I 
TABAD   DEF TABA+8
TABA    JMP E324        MODE 0 - ILLEGAL DBINF REQUEST
        JMP I13         MODE 1 - CONVERT TO "I",1 
        JMP I2          MODE 2 - CONVERT TO "I",2 
        JMP I13         MODE 3 - CONVERT TO "I",3 
        JMP S4          MODE 4 - CONVERT TO "S",4 
        JMP S2          MODE 5 - CONVERT TO "S",2 
        JMP S6          MODE 6 - CONVERT TO "S",6 
        JMP R6          MODE 7 - CONVERT TO "R",6 
* 
I2      LDA AI
        STA ITYP
        JSB DINUM       CONVERT DATA SET NAME TO NUMBER 
        DEF *+3 
        DEF NAME1 
        DEF ID,I
        CPB .103        DATA BASE NOT OPEN? 
        JMP ERR1
        SZB             TEST FOR ERROR
        JMP E325        YES, INVALID DATA SET NAME
        JSB INFO        CALL IMAGE INFORMATION ROUTINE
        LDB BUFFR 
        SZB             TEST FOR ERROR IN INFO CALL 
        JMP ERR1        YES 
        JSB PAKCC       PACK CONDITION CODE INTO IBUF 
        DEF BUFFR 
        LDA .44         PACK A COMMA
        JSB PAK 
        LDA BUFFR+4 
        AND MSKLO       GET SEARCH TYPE (HIGH BYTE) 
        ALF,ALF 
        CPA .1          TEST FOR KEY ITEM 
        JMP INF2        YES 
        LDA .78         NON-KEY ITEM (N)
        RSS 
INF2    LDA .75         KEY ITEM (K)
        JSB PAK         PACK SEARCH TYPE
        LDA .44         PACK A COMMA
        JSB PAK 
        LDA BUFFR+4 
        AND B377        GET ITEM TYPE (LOW BYTE)
        JSB PAK         PACK ITEM TYPE
        LDA .44 
        JSB PAK         PACK A COMMA
        CLA 
        STA TMP2        INITIALIZE READ/WRITE LEVEL FLAG
        LDA BUFFR+5 
        AND MSKLO       GET READ LEVEL (HIGH BYTE)
        ALF,ALF 
LOOP4   STA TMP 
        JSB CITA        CONVERT READ OR WRITE LEVEL TO ASCII
        DEF *+3 
        DEF TMP         LEVEL (INTEGER) 
        DEF BUFF2       ASCII BUFFER
        LDA OFST2 
        ADA .2
        STA UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       PACK LEVEL INTO IBUF
        DEF .2
        LDA .44         PACK A COMMA
        JSB PAK 
        LDA TMP2        TEST WHETHER BOTH READ AND WRITE
        CPA .1            LEVELS HAVE BEEN PACKED 
        JMP INF3        YES 
        LDA BUFFR+5     NO
        AND B377        GET WRITE LEVEL (LOW BYTE)
        ISZ TMP2        SET READ/WRITE LEVEL FLAG 
        JMP LOOP4       PACK WRITE LEVEL
* 
INF3    JSB CITA        CONVERT ITEM LENGTH TO ASCII
        DEF *+3 
        DEF BUFFR+6     ITEM LENGTH (INTEGER) 
        DEF BUFF2       ASCII BUFFER
        LDA OFST2 
        INA 
        IOR SIGN
        STA UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       PACK ITEM LENGTH INTO IBUF
        DEF .3
        LDA .44         PACK A COMMA
        JSB PAK 
        LDA AS
        STA ITYP
        JSB DSNAM       CONVERT DATA SET NUMBER TO NAME 
        DEF BUFFR+8     DATA SET NUMBER 
        LDA OFST2 
        INA 
        STA UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       TRANSFER DATA SET NAME TO IBUF
        DEF .6
        LDA .24         STRING CHARACTER COUNT
        STA IBUF,I      STORE IN FIRST WORD OF STRING 
        JMP EXIT1 
* 
I13     LDA AS
        STA ITYP
        JSB DINUM       CONVERT DATA SET NAME TO NUMBER 
        DEF *+3 
        DEF NAME1 
        DEF ID,I
        CPB .103        DATA BASE NOT OPEN? 
        JMP ERR1
        SZB             TEST FOR ERROR
        JMP E325        YES, INVALID DATA SET NAME
        LDA AI
        STA ITYP
        JSB INFO        CALL IMAGE INFORMATION ROUTINE
        LDB BUFFR 
        SZB             TEST FOR ERROR
        JMP ERR1        YES 
        LDA OFSET 
        STA INDX        INITIALIZE POINTER TO FIRST ITEM
        LDA BUFFR+1     SAVE ITEM COUNT - 1 
        STA B 
        CMB,INB         TEST IF COUNT > 35
        ADB .35 
        SSB 
        LDA .35         YES, RETURN MAX. OF 35 ITEM NAMES 
        CMA 
        STA ITEMS 
        JSB PAKCC       PACK CONDITION CODE INTO IBUF 
        DEF BUFFR 
        LDA .44         PACK A COMMA
        JSB PAK 
        ISZ COUNT       INCREMENT STRING CHARACTER COUNT
        JSB CITA        CONVERT ITEM COUNT TO ASCII (3) 
        DEF *+3 
        DEF BUFFR+1     ITEM COUNT (INTEGER)
        DEF BUFF2       ASCII BUFFER
        LDA OFST2 
        INA 
        IOR SIGN
        STA UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       TRANSFER ITEM COUNT (ASCII) 
        DEF .3            TO USER BUFFER
        LDA COUNT 
        ADA .3          ADD 3 TO STRING CHARACTER COUNT 
        STA COUNT 
        JSB PAKIT       PACK LIST OF ITEM NAMES 
        LDA COUNT       STRING CHARACTER COUNT
        STA IBUF,I
        JMP EXIT1 
S2      LDA AS
        STA ITYP
        JSB DINUM       CONVERT DATA SET NAME TO NUMBER 
        DEF *+3 
        DEF NAME1 
        DEF ID,I
        CPB .103        DATA BASE NOT OPEN? 
        JMP ERR1
        SZB             TEST FOR ERROR
        JMP E325        YES, INVALID DATA SET NAME
        LDA .2
        STA IMOD1,I 
        JSB INFO        CALL IMAGE INFORMATION ROUTINE
        LDB BUFFR 
        SZB             TEST FOR ERROR
        JMP ERR1        YES 
        JSB PAKCC       PACK CONDITION CODE INTO USER BUFFER
        DEF BUFFR 
        LDA .44         PACK A COMMA
        JSB PAK 
        LDA BUFFR+4     PACK DATA SET TYPE
        AND B377
        STA BUFF4       SAVE DATA SET TYPE
        JSB PAK 
        LDA .44         PACK A COMMA
        JSB PAK 
* 
        JSB CITA        CONVERT CAPACITY TO ASCII (5) 
        DEF *+3 
        DEF BUFFR+5     CAPACITY (INTEGER)
        DEF BUFF2       ASCII BUFFER
        LDA OFST2 
        IOR SIGN
        STA UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       TRANSFER CAPACITY (ASCII) TO
        DEF .5            USER BUFFER 
* 
        LDA .44         PACK A COMMA
        JSB PAK 
        LDA BUFFR+6 
        STA TMP         SAVE ENTRY LENGTH 
        LDA AI
        STA ITYP        INFO CALL TYPE=I
        LDA .3
        STA IMOD1,I     INFO CALL MODE=3
        JSB INFO        GET KEY ITEM NUMBERS
        LDB BUFFR 
        SZB             TEST FOR ERROR
        JMP E324        YES 
        LDA BUFF4       GET DATA SET TYPE 
        CPA B104        TEST IF DATA SET IS DETAIL
        JMP DETAI       YES 
        LDA AS          NO, DATA SET IS A MASTER
        STA ITYP
        LDA .4
        STA IMOD1,I     INFO CALL MODE=4
        LDA BUFFR+2     ITEM NUMBER OF KEY ITEM IN MASTER 
        STA ID,I
        JSB INFO        GET LINKED DATA SETS
        LDB BUFFR 
        SZB             TEST FOR ERROR
        JMP E324        YES 
        LDA BUFFR+1     COUNT OF LINKED DATA SETS 
        MPY .3          CALCULATE MEDIA RECORD LENGTH 
        ADA .3            (3+(3*PATH COUNT))
        CMA,INA 
        LDB TMP         ENTRY LENGTH (MEDIA + RECORD) 
        ADB A           SUBTRACT MEDIA TO GET RECORD LENGTH 
        STB TMP 
        JMP ENTLN       CONVERT ACTUAL ENTRY LENGTH TO ASCII
* 
DETAI   LDA BUFFR+1     COUNT OF KEY DATA ITEMS 
        ALS             CALCULATE MEDIA RECORD LENGTH 
        INA               (1+(2*PATH COUNT))
        CMA,INA 
        LDB TMP         ENTRY LENGTH (MEDIA + RECORD) 
        ADB A           SUBTRACT MEDIA TO GET RECORD LENGTH 
        STB TMP 
* 
ENTLN   JSB CITA        CONVERT ENTRY LENGTH TO ASCII (3) 
        DEF *+3 
        DEF TMP         ENTRY LENGTH (INTEGER)
        DEF BUFF2       ASCII BUFFER
        LDA OFST2 
        INA 
        IOR SIGN
        STA UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       TRANSFER ENTRY LENGTH (ASCII) 
        DEF .3            TO USER BUFFER
        LDA .15         STRING CHARACTER COUNT
        STA IBUF,I      SAVE IN FIRST WORD OF USER BUFFER 
        JMP EXIT1 
S4      LDA AI
        STA ITYP
        JSB DINUM       CONVERT DATA ITEM NAME TO NUMBER
        DEF *+3 
        DEF NAME1 
        DEF ID,I
        CPB .103        DATA BASE NOT OPEN? 
        JMP ERR1
        SZB             TEST FOR ERROR
        JMP E325        YES, INVALID DATA ITEM NAME 
        LDA AS
        STA ITYP
        JSB INFO        CALL IMAGE INFORMATION ROUTINE
        LDB BUFFR 
        SZB             TEST FOR ERROR
        JMP ERR1        YES 
* 
        LDA OFSET 
        STA INDX        POINTER TO FIRST NAME IN BUFFER 
        LDA BUFFR+1     DATA SET-DATA ITEM COUNT
        ALS             DOUBLE COUNT TO = SETS+ITEMS
        CMA             SAVE COUNT - 1
        STA ITEMS 
        JSB PAKCC       PACK CONDITION CODE INTO IBUF 
        DEF BUFFR 
        LDA .44         PACK A COMMA
        JSB PAK 
        ISZ COUNT       INCREMENT STRING CHARACTER COUNT
        JSB CITA        CONVERT PAIR COUNT TO ASCII (3) 
        DEF *+3 
        DEF BUFFR+1     PAIR COUNT (INTEGER)
        DEF BUFF2       ASCII BUFFER
        LDA OFST2 
        INA 
        IOR SIGN
        STA UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       PACK PAIR COUNT INTO IBUF 
        DEF .3
        LDA COUNT 
        ADA .3          ADD 3 TO STRING CHARACTER COUNT 
        STA COUNT       SAVE COUNT
        JSB PKIT2       PACK DATA SET AND ITEM NAMES
        LDA COUNT       STRING CHARACTER COUNT
        STA IBUF,I
        JMP EXIT1 
S6      LDB AS          ITYP = "S"
        STB ITYP
        JSB DINUM       CONVERT DATA SET NAME TO NUMBER 
        DEF *+3 
        DEF NAME1 
        DEF ID,I
        CPB .103        DATA BASE NOT OPEN? 
        JMP ERR1
        SZB             TEST FOR ERROR
        JMP E325        YES 
BLD     JSB INFO        CALL IMAGE INFORMATION ROUTINE
        LDB BUFFR 
        SZB             TEST FOR ERROR
        JMP ERR1        YES 
        JSB PAKCC       PACK CONDITION CODE INTO IBUF 
        DEF BUFFR 
        LDA .44         PACK A COMMA
        JSB PAK 
        JSB CITA        CONVERT LAST RECD ACCESSED TO ASCII 
        DEF *+3 
        DEF BUFFR+1     LAST RECORD ACCESSED (INTEGER)
        DEF BUFF2       BUFFER FOR RETURNED ASCII EQUIVALENT
        LDA OFST2 
        IOR SIGN
        STA UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       TRANSFER RECORD NUMBER (ASCII)
        DEF .5            TO USER BUFFER
* 
        LDA .44         PACK A COMMA
        JSB PAK 
        JSB CITA        CONVERT PATH LENGTH TO ASCII (5)
        DEF *+3 
        DEF BUFFR+2     PATH LENGTH OF CHAIN (INTEGER)
        DEF BUFF2       BUFFER FOR RETURNED ASCII EQUIVALENT
        LDA OFST2 
        IOR SIGN
        STA UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       TRANSFER PATH LENGTH (ASCII)
        DEF .5            TO USER BUFFER
* 
        LDA .44         PACK A COMMA
        JSB PAK 
        JSB CITA        CONVERT RECD # OF FOOT TO ASCII (5) 
        DEF *+3 
        DEF BUFFR+3     RECORD NUMBER OF CHAIN FOOT 
        DEF BUFF2       BUFFER FOR RETURNED ASCII EQUIVALENT
        LDA OFST2 
        IOR SIGN
        STA UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       TRANSFER NEXT RECORD (ASCII)
        DEF .5            TO USER BUFFER
* 
        LDA .44         PACK A COMMA
        JSB PAK 
        JSB CITA        CONVERT NEXT RECORD # TO ASCII (5)
        DEF *+3 
        DEF BUFFR+4     NEXT RECORD IN CHAIN (INTEGER)
        DEF BUFF2       BUFFER FOR RETURNED ASCII EQUIVALENT
        LDA OFST2 
        IOR SIGN
        STA UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       TRANSFER RECORD NUMBER (ASCII)
        DEF .5            TO USER BUFFER
* 
        LDA .44         PACK A COMMA
        JSB PAK 
        JSB CITA        CONVERT PATH NUMBER TO ASCII (5)
        DEF *+3 
        DEF BUFFR+5     PATH NUMBER OF CURRENT CHAIN
        DEF BUFF2       BUFFER FOR RETURNED ASCII EQUIVALENT
        LDA OFST2 
        IOR SIGN
        STA UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       TRANSFER PATH NUMBER (ASCII)
        DEF .5            TO USER BUFFER
        LDA .33         STRING CHARACTER COUNT
        STA IBUF,I      SAVE IN FIRST WORD OF USER BUFFER 
        JMP EXIT1 
* 
R6      LDA .6          IMODE = 6 
        STA IMOD1,I 
*                                       PARSE IBUF, CONVERTING ASCII TO 
*                                         INTEGER AND REMOVING COMMAS 
        LDA OFSTB 
        STA TMP2        SAVE ADDR OF BUFFER TO PACK INTO
        LDA IBUF
        INA 
        STA BUFF4       SAVE ADDR OF BUFFER TO UNPACK FROM
        CLA 
        STA COUNT       INITIALIZE COUNT OF ASCII FIELDS
        LDA .3
AGAIN   STA TMP         SAVE LENGTH OF ASCII FIELD
        JSB CATI        CONVERT ASCII TO INTEGER
        DEF *+6 
        DEF BUFF4,I     FIELD OF ASCII CHARACTERS 
        DEF .1          HIGH BYTE 
        DEF TMP         LENGTH OF ASCII FIELD TO CONVERT
        DEF N           CONVERTED INTEGER 
        DEF STAT        STATUS WORD 
        LDB STAT
        SZB             TEST FOR ERROR IN CONVERSION
        JMP E324        YES 
        LDA N 
        STA TMP2,I      STORE INTEGER IN PACK-BUFFER
        ISZ TMP2        INCREMENT POINTER TO PACK-BUFFER
        LDA BUFF4 
        LDB TMP         INCREMENT POINTER TO UNPACK-BUFFER
        INB 
        BRS 
        ADA B 
        STA BUFF4 
        LDA COUNT       COUNT OF ASCII FIELDS CONVERTED 
        INA 
        CPA .6          TEST IF ALL FIELDS CONVERTED
        JMP R6A         YES 
        STA COUNT       NO
        LDA .5          FIELD LENGTH OF REMAINING FIELDS
        JMP AGAIN       CONVERT NEXT ASCII FIELD
R6A     LDA AS
        STA ITYP
        JSB DINUM       CONVERT DATA SET NAME TO NUMBER 
        DEF *+3 
        DEF NAME1 
        DEF ID,I
        CPB .103        DATA BASE NOT OPEN? 
        JMP ERR1
        SZB             TEST FOR ERROR
        JMP E325        YES, INVALID DATA SET NAME
        LDA AR
        STA ITYP
        JMP BLD         BUILD INFORMATION STRING
* 
E324    LDB .324        ILLEGAL DBINF REQUEST 
        RSS 
E325    LDB .325        INVALID DATA SET OR ITEM NAME 
ERR1    STB TMP 
        JSB CITA        CONVERT CONDITION CODE TO ASCII 
        DEF *+3 
        DEF TMP         CONDITION CODE (INTEGER)
        DEF BUFF2       ASCII BUFFER
        LDB IBUF
        LDA .3          SET STRING CHARACTER COUNT
        STA B,I 
        INB 
        STB PBUF        SAVE ADDR OF BUFFER TO PACK INTO
        LDA OFST2 
        INA 
        IOR SIGN
        STA UPBUF       ADDR OF BUFFER TO UNPACK FROM 
        JSB PACKN       TRANSFER CONDITION CODE (ASCII) 
        DEF .3            TO USER BUFFER
        JMP EXIT1       RETURN
* 
INFO    NOP             CALL IMAGE INFORMATION ROUTINE
        JSB DBINF 
        DEF *+5 
        DEF ITYP
        DEF IMOD1,I 
        DEF ID,I
        DEF BUFFR 
        JMP INFO,I
* 
* 
*************************************************************** 
*       CONVERT DATA SET OR ITEM NAME TO A NUMBER             * 
*                                                             * 
*       CALLING SEQUENCE:     ITYP = I OR S, FOR ITEM OR SET  * 
*                             JSB DINUM                       * 
*                             DEF *+3                         * 
*                             DEF DATA ITEM NAME              * 
*                             DEF BUFFER FOR DATA ITEM NUMBER * 
*                             RETURNS WITH CONDITION CODE IN  * 
*                               B-REGISTER                    * 
*************************************************************** 
* 
DINUM   NOP 
        LDA DINUM,I 
        STA RETRN       SAVE RETURN ADDRESS 
        ISZ DINUM 
        LDA DINUM,I     ITEM NAME 
        STA TMP 
        JSB DBINF       CALL IMAGE INFORMATION ROUTINE
        DEF *+5 
        DEF ITYP        ITYPE = I OR S
        DEF .5          IMODE = 5 
        DEF TMP,I       DATA ITEM NAME
        DEF TMP2        TEMPORARY BUFFER TO HOLD ITEM NUMBER
* 
        LDB TMP2
        SZB             TEST CONDITION CODE 
        JMP RETRN,I     ERROR, RETURN 
        ISZ DINUM 
        LDB DINUM,I 
        LDA TMP2+1      DATA ITEM NUMBER
        STA B,I         BUFFER FOR RETURNED ITEM NUMBER 
        CLB 
        JMP RETRN,I     RETURN
* 
* 
*************************************************************** 
*       CONVERT DATA SET OR ITEM NUMBER TO A NAME             * 
*                                                             * 
*       CALLING SEQUENCE:     JSB DSNAM                       * 
*                             DEF SET OR ITEM NUMBER          * 
*                             NAME RETURNED IN WORDS 2,3,4    * 
*                               OF BUFF2                      * 
*************************************************************** 
* 
DSNAM   NOP 
        LDA DSNAM,I 
        STA TMP 
        JSB DBINF       CALL IMAGE INFORMATION ROUTINE
        DEF *+5 
        DEF ITYP        ITYPE=I OR S
        DEF .2          IMODE=2 
        DEF TMP,I       DATA SET NUMBER 
        DEF BUFF2       BUFFER FOR RETURNED INFORMATION 
        LDA BUFF2       TEST CONDITION CODE 
        SZA,RSS 
        JMP DSNM1 
        JSB PAKCC       ERROR IN INFORMATION CALL 
        DEF BUFF2       CONDITION CODE
        LDA COUNT 
        STA IBUF,I      STRING CHARACTER COUNT
        JMP DMINF,I 
DSNM1   ISZ DSNAM       INCREMENT RETURN ADDRESS
        JMP DSNAM,I     RETURN
* 
* 
*************************************************************** 
*            ROUTINE TO PACK ASCII CONDITION CODE             * 
*                                                             * 
*       CALLING SEQUENCE:     JSB PAKCC                       * 
*                             DEF CONDITION CODE              * 
*                             ASCII CONDITION CODE IS PACKED  * 
*                             INTO IBUF                       * 
*************************************************************** 
* 
PAKCC   NOP 
        LDA PAKCC,I 
        STA TMP 
        JSB CITA        CONVERT CONDITION CODE TO ASCII (3) 
        DEF *+3 
        DEF TMP,I       CONDITION CODE (INTEGER)
        DEF BUFF2       ASCII BUFFER
        LDB IBUF
        INB 
        STB PBUF        SAVE ADDRESS OF BUFFER TO PACK INTO 
        CLA 
        STA COUNT       INITIALIZE STRING CHARACTER COUNT 
        LDA OFST2 
        INA 
        IOR SIGN
        STA UPBUF       SAVE ADDR OF BUFFER TO UNPACK FROM
        JSB PACKN       TRANSFER CONDITION CODE (ASCII) 
        DEF .3            TO USER BUFFER
        LDA COUNT 
        ADA .3          ADD 3 TO STRING CHARACTER COUNT 
        STA COUNT 
        ISZ PAKCC       INCREMENT RETURN ADDRESS
        JMP PAKCC,I     RETURN
* 
* 
*************************************************************** 
*       ROUTINE TO PACK A LIST OF ITEM NAMES                  * 
*                                                             * 
*       CALLING SEQUENCE:     ITEMS   = NUMBER OF ITEMS       * 
*                             BUFFR   = BUFFER OF NAMES       * 
*                             INDX    = OFFSET INTO BUFFR     * 
*                             JSB PAKIT                       * 
*                             NAMES ARE PACKED INTO IBUF,     * 
*                              SEPARATED BY COMMAS            * 
*************************************************************** 
* 
PAKIT   NOP 
        LDA AI          ITYPE = I 
        STA ITYP
LOOP1   ISZ ITEMS       TEST ITEM COUNT 
        RSS 
        JMP PAKIT,I     ALL NAMES PACKED
        LDA .44         PACK A COMMA
        JSB PAK 
        ISZ COUNT       INCREMENT STRING CHARACTER COUNT
        LDA INDX
        LDB A,I 
        SSB             TEST FOR NEGATIVE ITEM NUMBER 
        CMB,INB         YES, MAKE POSITIVE
        STB A,I 
        JSB DSNAM       CONVERT DATA ITEM NUMBER TO NAME
        DEF INDX,I      ITEM NUMBER 
        LDB OFST2 
        INB 
        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 LOOP1 
* 
* 
*************************************************************** 
*       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 OR * 
*                                        ITEM 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 .44         PACK A COMMA
        JSB PAK 
        ISZ COUNT       INCREMENT STRING CHARACTER COUNT
        LDA AS
        STA ITYP
        JSB DSNAM       CONVERT DATA SET NUMBER TO NAME 
        DEF INDX,I      DATA SET NUMBER 
        LDB OFST2 
        INB 
        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
        ISZ ITEMS       TEST SET-ITEM COUNT 
        RSS 
        JMP PKIT2,I 
        LDA .44         PACK A COMMA
        JSB PAK 
        ISZ COUNT       INCREMENT STRING CHARACTER COUNT
        LDA AI
        STA ITYP
        JSB DSNAM       CONVERT ITEM NUMBER TO ITEM NAME
        DEF INDX,I      DATA ITEM NUMBER
        LDB OFST2 
        INB 
        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 
* 
* 
EXIT1   JSB RSFLG       SET SAVE RESOURCES FLAG 
        DEF *+1 
        JMP DMINF,I     TERMINATE INFORMATION CALL
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBFND(ISTAT,IDSET,IPATH,IARG)
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBFND(IVA,RA,RA,RA),   OV=NN,  ENT=DMFND,   FIL=IMAGR 
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
ISTA7   NOP 
ISET4   NOP 
IPATH   NOP 
IARG1   NOP 
DMFND   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
        DEF ISTA7 
        JSB ASCI        CONVERT STRINGS TO ASCII
        DEF ISET4 
        JSB PAD         PAD SET NAME TO 6 CHARACTERS
        DEF *+3 
        DEF ISET4 
        DEF NAME1 
        JSB ASCI
        DEF IPATH 
        JSB PAD         PAD PATH NAME TO 6 CHARACTERS 
        DEF *+3 
        DEF IPATH 
        DEF NAME2 
* 
        LDA AI
        STA ITYP
        JSB DINUM       CONVERT DATA ITEM NAME TO NUMBER
        DEF *+3 
        DEF NAME2       DETAIL KEY ITEM NAME
        DEF BUFF4       BUFFER FOR RETURNED ITEM NUMBER 
        CPB .103        DATA BASE NOT OPEN? 
        JMP E103
        SZB             TEST INTERNAL ERROR CODE
        JMP E301        SET USER STATUS CODE TO ERROR NUMBER
* 
        JSB DBINF       CALL IMAGE INFORMATION ROUTINE
        DEF *+5 
        DEF AI          ITYPE = I 
        DEF .2          IMODE = 2 
        DEF BUFF4       DATA ITEM NUMBER
        DEF BUFF2       BUFFER FOR RETURNED INFORMATION 
* 
        LDB BUFF2 
        SZB,RSS         TEST FOR ERROR IN INFORMATION CALL
        JMP FIND1       NO
E301    LDB .301        INVALID DATA ITEM NAME
E103    STB ISTA7,I     SET USER STATUS CODE TO ERROR NUMBER
        JMP EXIT5       RETURN
* 
FIND1   LDA BUFF2+4     DATA ITEM TYPE (I, R, OR U) 
        AND B377
        CPA B111        TEST FOR INTEGER ITEM (I) 
        JMP INTG        YES 
        CPA B125        TEST FOR ASCII ITEM (U) 
        RSS             YES 
        JMP FIND        NO, REAL ITEM 
* 
        JSB ASCI        CONVERT STRING TO ASCII 
        DEF IARG1 
        JMP FIND
* 
INTG    DLD IARG1,I 
        JSB IFIX        CONVERT REAL TO INTEGER 
        STA IARG1,I     SAVE CONVERTED KEY ITEM VALUE 
* 
FIND    JSB DBFND       CALL IMAGE FIND ROUTINE 
        DEF *+5 
        DEF ISTA7,I 
        DEF NAME1 
        DEF NAME2 
        DEF IARG1,I 
* 
EXIT5   JSB RSFLG       SET SAVE RESOURCES FLAG 
        DEF *+1 
        JMP DMFND,I     TERMINATE FIND CALL 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBGET(ISTAT,IDSET,IMODE,IARG,INAME,READ-LIST)
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBGET(IVA,RA,I,RA,RA,RVA,RVA,RVA,RVA,RVA,RVA,RVA,RVA,RVA,RVA),
*                                OV=NN,  ENT=DMGET,  FIL=IMAGR
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
ISTA4   NOP 
IDSET   NOP 
IMOD3   NOP 
IARG    NOP 
INAM2   NOP 
RLIST   BSS 11
DMGET   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
        DEF ISTA4 
        JSB ASCI        CONVERT STRING TO ASCII 
        DEF IDSET 
        JSB PAD         PAD SET NAME TO 6 CHARACTERS
        DEF *+3 
        DEF IDSET 
        DEF NAME1 
* 
        LDA AS
        STA ITYP
        JSB DINUM       CONVERT DATA SET NAME TO NUMBER 
        DEF *+3 
        DEF NAME1       DATA SET NAME 
        DEF DSNBR       BUFFER FOR RETURNED DATA SET NUMBER 
        SZB,RSS         TEST FOR ERROR IN CONVERSION
        JMP GET1        NO ERROR
        CPB .103        DATA BASE NOT OPEN? 
        RSS 
E300    LDB .300        INVALID DATA SET NAME 
        STB ISTA4,I     SET USER STATUS CODE TO ERROR NUMBER
        JMP EXIT6       RETURN
* 
GET1    LDA IMOD3,I     GET MODE FOR DATA BASE READ 
        CPA .1          TEST FOR MODE=1 
        RSS             YES 
        CPA .2          TEST FOR MODE=2 
        JMP GET         YES, CALL DBGET 
        CPA .3          TEST FOR MODE=3 
        JMP CONVT       YES, CONVERT RELATIVE RECORD TO INTG
        CPA .4          TEST FOR MODE=4 
        JMP GET2        YES, CONVERT IARG TO CORRECT TYPE 
        LDB .315        INVALID MODE SPECIFIED BY USER
        STB ISTA4,I     SET USER STATUS CODE TO 315 
        JMP EXIT6       RETURN
* 
CONVT   LDA IARG,I      GET RELATIVE RECORD NUMBER
        AND MSKLO       TEST IF NUMERIC 
        SZA,RSS 
        JMP E306        NO, ERROR 
        DLD IARG,I      RELATIVE RECORD NUMBER (REAL) 
        JSB IFIX        CONVERT REAL TO INTEGER 
        STA IARG,I
        JMP GET         CALL IMAGE READ ROUTINE 
E306    LDB .306        INVALID RECD# IN DIRECTED READ
        STB ISTA4,I     SET USER STATUS CODE TO 306 
        JMP EXIT6       RETURN
* 
GET2    JSB DBINF       GET KEY ITEM OF DATA SET IN IDSET 
        DEF *+5 
        DEF AI          ITYPE=I 
        DEF .3          IMODE=3 
        DEF DSNBR       DATA SET NUMBER 
        DEF BUFF2       BUFFER FOR RETURNED INFORMATION 
        LDB BUFF2 
        SZB             TEST FOR ERROR IN INFORMATION CALL
        JMP E300        SET USER STATUS CODE TO ERROR NUMBER
* 
        JSB DBINF       GET ITEM TYPE OF KEY ITEM 
        DEF *+5 
        DEF AI          ITYPE=I 
        DEF .2          IMODE=2 
        DEF BUFF2+2     KEY ITEM NUMBER 
        DEF BUFF5       BUFFER FOR RETURNED INFORMATION 
        LDB BUFF5 
        SZB             TEST FOR ERROR IN INFORMATION CALL
        JMP E300        SET USER STATUS CODE TO ERROR NUMBER
* 
        LDA BUFF5+4 
        AND B377        DATA ITEM TYPE (I, R, OR U) 
        CPA B125        TEST FOR ASCII ITEM (U) 
        JMP ASC2        YES 
        CPA B111        TEST FOR INTEGER ITEM (I) 
        RSS             YES, CONVERT IARG TO INTEGER
        JMP GET         NO, REAL ITEM (R) 
* 
        DLD IARG,I      CONVERT IARG TO INTEGER 
        JSB IFIX        REAL TO INTEGER CONVERSION
        STA IARG,I
        JMP GET 
ASC2    JSB ASCI        CONVERT STRING TO ASCII 
        DEF IARG
* 
GET     JSB DBGET       CALL IMAGE GET ROUTINE
        DEF *+6 
        DEF NAME1 
        DEF IMOD3,I 
        DEF ISTA4,I 
        DEF IBUF1 
        DEF IARG,I
* 
        LDB ISTA4,I     TEST FOR SUCCESSFUL DATA BASE READ
        SZB 
        JMP EXIT6       NO, RETURN
* 
        JSB PARSE       PARSE NAME-LIST AND BUILD INBR ARRAY
        DEF *+2 
        DEF INAM2 
        SZB,RSS         TEST FOR ERROR IN PARSE 
        JMP GET3        NO, CONTINUE
        STB ISTA4,I     SET USER STATUS CODE TO ERROR NUMBER
        JMP EXIT6       RETURN
GET3    LDA INDXR 
        STA R 
        LDA INBR        GET ITEM NAME COUNT 
        CMA             SAVE COUNT-1
        STA COUNT 
MORE    LDA R,I 
        STA VARS        SAVE ADDRESS OF READ-LIST PARAMETER 
        ISZ COUNT       TEST FOR END OF IBUF1 UNPACK
        RSS             NO
        JMP EXIT6       YES, RETURN 
        ISZ INDXB       INCREMENT INDEX TO INBR ARRAY 
        JSB DBINF       CALL IMAGE INFORMATION ROUTINE
        DEF *+5 
        DEF AI          ITYPE=I 
        DEF .2          IMODE=2 
        DEF INDXB,I     DATA ITEM NUMBER
        DEF BUFF2       BUFFER FOR RETURNED INFORMATION 
* 
        LDB BUFF2 
        SZB,RSS         TEST FOR ERROR IN INFORMATION CALL
        JMP GET4        NO, CONTINUE
        LDB .303        INVALID NAME IN NAME-LIST 
        STB ISTA4,I     SET USER STATUS CODE TO ERROR NUMBER
        JMP EXIT6       RETURN
* 
GET4    LDB BUFF2+8     DATA SET NUMBER OF ITEM 
        CPB DSNBR       COMPARE WITH DATA SET PARAMETER 
        JMP GET5        MATCH, CONTINUE 
        LDB .303        DIFFER, INVALID NAME IN NAME-LIST 
        STB ISTA4,I     SET USER STATUS CODE
        JMP EXIT6       RETURN
* 
GET5    LDA VARS        ADDR OF PARAMETER IN VARIABLE LIST
        SZA             TEST FOR NO PARAMETER 
        JMP GET6        NO ERROR, CONTINUE
        LDB .305        VARIABLE MISSING IN VARIABLE-LIST 
        STB ISTA4,I     SET USER STATUS CODE
        JMP EXIT6       RETURN
* 
GET6    ISZ R           INCREMENT INDEX TO RLIST
        LDB BUFF2+7     DATA ITEM OFFSET
        ADB IBUFF       LOCATION OF ITEM IN DBGET BUFFER
        LDA VARS,I      GET WORD 1 OF CURRENT PARM
        AND MSKLO       MASK LOW BYTE TO TEST TYPE
        CLE             E USED AS INDICATOR OF PARM TYPE
        SZA,RSS         TEST IF NUMERIC OR STRING 
        CME             STRING - SET E
        LDA BUFF2+4     DATA ITEM TYPE (I, R, OR U) 
        AND B377
        CPA B125        TEST FOR ASCII ITEM (U) 
        JMP APEND       YES 
        CPA B111        TEST FOR INTEGER ITEM (I) 
        JMP ITR         YES 
* 
        SEZ             TEST IF RETURN VARIABLE NUMERIC 
        JMP E304        NO, ERROR 
        LDA R,I         ADDR OF NEXT PARM IN VARIABLE LIST
        SZA,RSS         TEST IF LAST PARAMETER
        JMP GET7        YES, CONTINUE 
        LDA VARS        NO, TEST IF WRITING IN NEXT PARM
        ADA .2
        CPA R,I 
        JMP GET7        NO, CONTINUE
E304    LDB .304        ERROR 
        STB ISTA4,I     SET USER STATUS CODE
        JMP EXIT6       RETURN
* 
GET7    DLD B,I         NO, REAL ITEM (R) 
        DST VARS,I      STORE REAL INTO READ-LIST 
        JMP MORE        UNPACK NEXT ITEM
APEND   SEZ,RSS         TEST IF RETURN VARIABLE TYPE STRING 
        JMP E304        NO, ERROR 
        LDA BUFF2+6     DATA ITEM LENGTH (IN WORDS) 
        STA TMP         SAVE LENGTH 
        LDA R,I         ADDR OF NEXT PARM IN VARIABLE LIST
        SZA,RSS         TEST IF LAST PARAMETER
        JMP GET8        YES, CONTINUE 
        CMA,INA 
        ADA VARS        NO, TEST IF WRITING IN NEXT PARM
        ADA TMP 
        SSA,RSS           (NEXT PARM = VARS+TMP+1)
        JMP E304        ERROR, SET USER STATUS CODE 
GET8    LDA TMP         RESTORE ITEM LENGTH 
        ALS             ITEM LENGTH IN CHARACTERS 
NEXT    STA VARS,I      STORE IN NEXT WORD OF STRING
        ISZ VARS        INCREMENT POINTER TO READ-LIST
        LDA TMP 
        SZA,RSS         TEST FOR END OF ASCII ITEM
        JMP MORE        YES, UNPACK NEXT ITEM 
        ADA M1          DECREMENT ITEM LENGTH COUNT 
        STA TMP 
        LDA B,I         GET NEXT WORD FROM DBGET BUFFER 
        INB             INCREMENT POINTER TO DBGET BUFFER 
        JMP NEXT        UNPACK NEXT WORD
* 
ITR     SEZ             TEST IF RETURN VARIABLE NUMERIC 
        JMP E304        NO, ERROR 
        LDA R,I         ADDR OF NEXT PARM IN VARIABLE LIST
        SZA,RSS         TEST IF LAST PARAMETER
        JMP GET9        YES, CONTINUE 
        LDA VARS        NO, TEST IF WRITING IN NEXT PARM
        ADA .2
        CPA R,I 
        RSS             NO, CONTINUE
        JMP E304        ERROR, SET USER STATUS CODE 
* 
GET9    LDA B,I         GET NEXT WORD FROM DBGET BUFFER 
        JSB FLOAT       CONVERT INTEGER TO REAL 
        DST VARS,I      STORE REAL INTO READ-LIST 
        JMP MORE        UNPACK NEXT ITEM
* 
EXIT6   JSB RSFLG       SET SAVE RESOURCES FLAG 
        DEF *+1 
        JMP DMGET,I     TERMINATE GET CALL
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBUPD(ISTAT,IDSET,INAME,PRINT-LIST)
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBUPD(IV,RA,RA),        OV=NN,  ENT=DMUPD,  FIL=IMAGR 
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
ISTA5   NOP 
ISET2   NOP 
INAME   NOP 
PLIST   BSS 13
DMUPD   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
        DEF ISTA5 
        JSB ASCI        CONVERT STRING TO ASCII 
        DEF ISET2 
        JSB PAD         PAD SET NAME TO 6 CHARACTERS
        DEF *+3 
        DEF ISET2 
        DEF NAME1 
* 
        LDA AS
        STA ITYP
        JSB DINUM       CONVERT DATA SET NAME TO NUMBER 
        DEF *+3 
        DEF NAME1       DATA SET NAME 
        DEF DSNBR       BUFFER FOR RETURNED DATA SET NUMBER 
        SZB,RSS         TEST FOR ERROR IN CONVERSION
        JMP UPD1        NO ERROR
        CPB .103        DATA BASE NOT OPEN? 
        RSS 
        LDB .300        INVALID DATA SET NAME 
        STB ISTA5,I     SET USER STATUS CODE
        JMP EXIT3       RETURN
* 
UPD1    JSB PARSE       PARSE NAME-LIST AND PRINT-LIST, AND 
        DEF *+2           BUILD INBR ARRAY
        DEF INAME 
* 
        SZB,RSS         TEST FOR ERROR IN PARSE 
        JMP UPD2        NO ERROR, COMPLETE UPDATE REQUEST 
        STB ISTA5,I     SET USER STATUS CODE TO ERROR NUMBER
        JMP EXIT3       RETURN
UPD2    JSB IVAL        CONSTRUCT IVALU PACKED ARRAY
        DEF *+2 
        DEF PLIST 
        SZB,RSS         TEST FOR ERROR IN CONSTRUCTION
        JMP UPDTE       NO
        STB ISTA5,I     SET USER STATUS CODE TO ERROR 
        JMP EXIT3       RETURN
* 
UPDTE   JSB DBUPD       CALL IMAGE UPDATE ROUTINE 
        DEF *+6 
        DEF NAME1 
        DEF ISTA5,I 
        DEF INBR
        DEF IVALU 
        DEF IBUF2 
* 
EXIT3   JSB RSFLG       SET SAVE RESOURCES FLAG 
        DEF *+1 
        JMP DMUPD,I     TERMINATE UPDATE CALL 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBPUT(ISTAT,IDSET,INAME,PRINT-LIST)
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBPUT(IV,RA,RA),        OV=NN,  ENT=DMPUT,  FIL=IMAGR 
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
ISTA6   NOP 
ISET3   NOP 
INAM1   NOP 
PLST1   BSS 13
DMPUT   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
        DEF ISTA6 
        JSB ASCI        CONVERT STRING TO ASCII 
        DEF ISET3 
        JSB PAD         PAD SET NAME TO 6 CHARACTERS
        DEF *+3 
        DEF ISET3 
        DEF NAME1 
* 
        LDA AS
        STA ITYP
        JSB DINUM       CONVERT DATA SET NAME TO NUMBER 
        DEF *+3 
        DEF NAME1       DATA SET NAME 
        DEF DSNBR       BUFFER FOR RETURNED DATA SET NUMBER 
        SZB,RSS         TEST FOR ERROR IN CONVERSION
        JMP PUT1        NO ERROR
        CPB .103        DATA BASE NOT OPEN? 
        RSS 
        LDB .300        INVALID DATA SET NAME 
        STB ISTA6,I     SET USER STATUS CODE
        JMP EXIT4       RETURN
* 
PUT1    JSB PARSE       PARSE NAME-LIST AND PRINT LIST, AND 
        DEF *+2           BUILD INBR PACKED ARRAY 
        DEF INAM1 
        SZB,RSS         TEST FOR ERROR IN PARSE 
        JMP PUT2        NO ERROR, COMPLETE PUT REQUEST
        STB ISTA6,I     SET USER STATUS CODE TO ERROR NUMBER
        JMP EXIT4       RETURN
PUT2    JSB IVAL        CONSTRUCT IVALU PACKED ARRAY
        DEF *+2 
        DEF PLST1 
        SZB,RSS         TEST FOR ERROR IN CONSTRUCTION
        JMP PUT         NO ERROR
        STB ISTA6,I     SET USER STATUS CODE TO ERROR NUMBER
        JMP EXIT4 
* 
PUT     JSB DBPUT       CALL IMAGE PUT ROUTINE
        DEF *+6 
        DEF NAME1 
        DEF ISTA6,I 
        DEF INBR
        DEF IVALU 
        DEF IBUF2 
* 
EXIT4   JSB RSFLG       SET SAVE RESOURCES FLAG 
        DEF *+1 
        JMP DMPUT,I     TERMINATE PUT CALL
* 
* 
PARSE   NOP             PARSE NAME-LIST AND BUILD INBR
        LDB PARSE 
        LDA B,I         SAVE RETURN ADDRESS 
        STA PARSE 
        INB 
        LDB B,I         FETCH PARAMETERS
        LDB B,I 
        STB NAMES       SAVE NAME-LIST ADDRESS
        LDA PTR1        INITIALIZE POINTERS TO INBR 
        STA INDXB 
        LDA PTR2
        STA OFSTN 
* 
        JSB ASCI        CONVERT NAME-LIST TO ASCII
        DEF NAMES 
        CLA 
        STA INBR        INITIALIZE ITEM-NAME COUNT
        LDB NAMES 
        STB UPBUF       ADDRESS OF BUFFER TO UNPACK FROM
NEXTI   LDA CHARS       NAME-LIST STRING CHARACTER COUNT
        SZA             TEST FOR EMPTY NAME-LIST
        JMP PARS1 
        LDB .302        INVALID NAME-LIST 
        JMP PARSE,I     RETURN
PARS1   ADA M1          DECREMENT NAME-LIST CHARACTER COUNT 
        STA CHARS       SAVE NAME-LIST CHARACTER COUNT
        JSB UNPAK       GET CHARACTER FROM NAME-LIST
        STA CHAR        SAVE CHARACTER
        CMA,INA 
        ADA .64 
        SSA             TEST FOR NON-ALPHABETIC CHARACTER 
        JMP PARS2 
E303    LDB .303        YES, INVALID NAME IN NAME-LIST
        JMP PARSE,I     RETURN
PARS2   LDA CHAR
        CMA,INA 
        ADA B132
        SSA             TEST FOR NON-ALPHABETIC CHARACTER 
        JMP E303        YES, INVALID NAME IN NAME-LIST
* 
        CLA,INA 
        STA NCNT        INITIALIZE ITEM-NAME CHARACTER COUNT
        LDA INDX3       TEMPORARY BUFFER TO HOLD ITEM-NAME
        STA PBUF        ADDRESS OF BUFFER TO PACK INTO
NEXTC   LDA CHAR
        JSB PAK         PACK CHARACTER INTO TEMPORARY BUFFER
        LDB CHARS       NAME-LIST CHARACTER COUNT 
        SZB,RSS         TEST FOR END OF NAME-LIST 
        JMP BLD2        END OF NAME-LIST
        ADB M1          DECREMENT NAME-LIST CHARACTER COUNT 
        STB CHARS 
        JSB UNPAK       GET NEXT CHARACTER FROM NAME-LIST 
        STA CHAR
        CPA .44         TEST FOR COMMA
        JMP BLD1        YES, END OF ITEM-NAME 
        LDA NCNT        NO
        INA             INCREMENT ITEM-NAME CHARACTER COUNT 
        STA NCNT
        CMA,INA 
        ADA .6
        SSA,RSS         TEST FOR NAME LONGER THAN 6 CHARS 
        JMP NEXTC       NO
        JMP E303        YES, INVALID NAME IN NAME-LIST
* 
BLD1    JSB BUILD       BUILD NEXT ELEMENT OF INBR
        SZB             TEST INTERNAL ERROR CODE
        JMP PARSE,I     ERROR, RETURN 
        JMP NEXTI       GET NEXT ITEM NAME FROM NAME-LIST 
* 
BLD2    JSB BUILD       BUILD LAST ELEMENT OF INBR
        JMP PARSE,I     RETURN
* 
IVAL    NOP             CONSTRUCT IVALU PACKED ARRAY
        LDB IVAL
        LDA B,I         SAVE RETURN ADDRESS 
        STA IVAL
        LDA PTR3        INITIALIZE POINTER TO IVALU 
        STA OFSTV 
        INB 
        LDB B,I         FETCH PARAMETER 
        STB P           SAVE POINTER TO PRINT-LIST
        LDA INBR        GET ITEM NAME COUNT 
        CMA             SAVE COUNT-1
        STA COUNT 
NITEM   LDB P,I         GET NEXT PARAMETER FROM PRINT-LIST
        STB VARS        SAVE VARIABLE-LIST ADDRESS
        ISZ COUNT       TEST FOR END OF IVALU CONSTRUCTION
        RSS             NO
        JMP EXIT7       YES, RETURN 
        ISZ INDXB       INDEX TO INBR ARRAY 
        JSB DBINF       CALL IMAGE INFORMATION ROUTINE
        DEF *+5 
        DEF AI          ITYPE=I 
        DEF .2          IMODE=2 
        DEF INDXB,I     DATA ITEM NUMBER
        DEF BUFF2       BUFFER FOR RETURNED INFORMATION 
* 
        LDB BUFF2 
        SZB,RSS         TEST FOR ERROR IN INFORMATION CALL
        JMP NITM1       NO, CONTINUE
        LDB .303
        JMP IVAL,I      ERROR, RETURN 
* 
NITM1   LDB BUFF2+8     DATA SET NUMBER AS DEFINED
        CPB DSNBR       COMPARE WITH DATA SET PARAMETER 
        JMP NITM2       MATCH, CONTINUE 
        LDB .303        DIFFER, INVALID NAME IN NAME-LIST 
        JMP IVAL,I      RETURN
* 
NITM2   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 P           INCREMENT INDEX TO PLIST
        LDA BUFF2+4     DATA ITEM TYPE (I,R, OR U)
        AND B377
        CPA B125        TEST FOR ASCII ITEM (U) 
        JMP STRNG       YES 
        CPA B111        TEST FOR INTEGER ITEM (I) 
        JMP INTGR       YES 
* 
        LDA P,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 .2
        CPA P,I 
        JMP NITM4       NO, CONTINUE
E304A   LDB .304        ERROR 
        JMP IVAL,I      RETURN
* 
NITM4   DLD VARS,I      NO, REAL ITEM (R) 
        DST OFSTV,I     PACK REAL ITEM INTO IVALU 
        ISZ OFSTV       INCREMENT INDEX TO IVALU ARRAY
        ISZ OFSTV 
        JMP NITEM 
* 
STRNG   LDB VARS,I      STRING CHARACTER COUNT
        SLB             TEST IF ODD COUNT 
        INB             YES 
        BRS             LENGTH IN WORDS 
        CPB BUFF2+6     COMPARE WITH LENGTH AS DEFINED
        RSS             YES, CORRECT ITEM LENGTH
        JMP E304A       NO, INCORRECT ITEM LENGTH 
        JSB ASCI        CONVERT STRING TO ASCII 
        DEF VARS
        LDA LENTH       LENGTH OF STRING IN WORDS 
NEXTW   SZA,RSS         TEST FOR COMPLETION OF PACK 
        JMP NITEM       YES 
        LDB VARS,I      INDEX TO PRINT-LIST 
        STB OFSTV,I     PACK 2 CHARACTERS INTO IVALU
        ISZ OFSTV       INCREMENT INDEX TO IVALU
        ISZ VARS        INCREMENT INDEX TO PRINT-LIST 
        ADA M1          DECREMENT STRING LENGTH WORD COUNT
        JMP NEXTW 
* 
INTGR   LDA P,I         ADDRESS OF NEXT PARM IN VAR-LIST
        SZA,RSS         TEST IF LAST PARAMETER
        JMP INTG1       YES, CONTINUE 
        LDA VARS        NO, TEST IF READING FROM NEXT PARM
        ADA .2
        CPA P,I 
        RSS             NO, CONTINUE
        JMP E304A       YES, SET ERROR CODE 
* 
INTG1   DLD VARS,I      GET NEXT VARIABLE IN PRINT-LIST 
        JSB IFIX        CONVERT TO INTEGER
        STA OFSTV,I     PACK INTEGER INTO IVALU 
        ISZ OFSTV       INCREMENT INDEX TO IVALU
        JMP NITEM       GET NEXT ITEM FROM INBR ARRAY 
* 
EXIT7   CLB             SET INTERNAL ERROR CODE TO ZERO 
        JMP IVAL,I      RETURN
* 
BUILD   NOP             BUILD INBR ARRAY
        LDA AI
        STA ITYP
        LDA NCNT        GET CHARACTER COUNT 
        SLA             TEST IF ODD NUMBER OF CHARACTERS
        JMP ODD         YES 
        ARS             GET COUNT IN WORDS
        STA LENTH       SAVE COUNT
CALPD   JSB PAD         PAD ITEM NAME TO 6 CHARACTERS 
        DEF *+3 
        DEF INDX3 
        DEF NAME2 
        JSB DINUM       CONVERT DATA ITEM NAME TO NUMBER
        DEF *+3 
        DEF NAME2       DATA ITEM NAME
        DEF BUFF4       BUFFER FOR RETURNED DATA ITEM NUMBER
        SZB,RSS         TEST FOR ERROR
        JMP CALP2       NO
        LDB .303
        JMP BUILD,I     ERROR, RETURN 
* 
CALP2   LDA BUFF4 
        STA OFSTN,I     PACK ITEM NUMBER INTO INBR ARRAY
        ISZ OFSTN       INCREMENT INDEX TO INBR ARRAY 
        ISZ INBR        INCREMENT COUNT OF DATA ITEMS 
        JMP BUILD,I     RETURN
ODD     ARS             LENGTH IN WORDS, LESS ONE 
        STA LENTH       SAVE LENGTH 
        LDB INDX3       POINTER TO FIRST WORD OF NAME 
        ADB A           B NOW POINTS TO LAST WORD OF NAME 
        LDA B,I         GET CONTENTS OF LAST WORD 
        AND MSKLO       MASK LOWER BYTE (NO CHAR) 
        IOR B40         PAD WITH A BLANK
        STA B,I         REPLACE LAST WORD 
        ISZ LENTH       INCREMENT TO TRUE LENGTH IN WORDS 
        JMP CALPD       CONTINUE
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBDEL(ISTAT,IDSET) 
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBDEL(IV,RA),   OV=NN,  ENT=DMDEL,   FIL=IMAGR
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
ISTA8   NOP 
ISET5   NOP 
DMDEL   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
        DEF ISTA8 
        JSB ASCI        CONVERT STRING TO ASCII 
        DEF ISET5 
        JSB PAD         PAD SET NAME TO 6 CHARACTERS
        DEF *+3 
        DEF ISET5 
        DEF NAME1 
* 
        JSB DBDEL       CALL IMAGE DELETE ROUTINE 
        DEF *+3 
        DEF NAME1 
        DEF ISTA8,I 
* 
        JSB RSFLG       SET SAVE RESOURCES FLAG 
        DEF *+1 
        JMP DMDEL,I     TERMINATE DELETE CALL 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBCLS(ISTAT,IMODE) 
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBCLS(IV,I),   OV=NN,  ENT=DMCLS,   FIL=IMAGR 
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
ISTA3   NOP 
IMOD2   NOP 
DMCLS   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
        DEF ISTA3 
* 
        JSB DBCLS       CALL IMAGE CLOSE ROUTINE
        DEF *+3 
        DEF IMOD2,I 
        DEF ISTA3,I 
* 
        LDA IMOD2,I 
        SZA,RSS         IF MODE=0, RESET INITIALIZE FLAG
        STA RFLAG 
* 
        JSB RSFLG       SET SAVE RESOURCES FLAG 
        DEF *+1 
        JMP DMCLS,I     TERMINATE CLOSE CALL
* 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBLCK(ISTAT,IMODE) 
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBLCK(IV,I),   OV=NN,  ENT=DMLCK,  FIL=IMAGR
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
ISTA9   NOP 
IMOD4   NOP 
DMLCK   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETERS
        DEF ISTA9 
* 
        JSB DBLCK       CALL IMAGE LOCK ROUTINE 
        DEF *+3 
        DEF IMOD4,I 
        DEF ISTA9,I 
* 
        JSB RSFLG       SET SAVE RESOURCES FLAG 
        DEF *+1 
        JMP DMLCK,I     TERMINATE LOCK CALL 
* 
* 
* 
* 
*       CALLING SEQUENCE: 
*       CALL DBUNL(ISTAT) 
* 
* 
*       ENTRY IN BASIC SUBROUTINE TABLE:
*       DBUNL(IV),      OV=NN,   ENT=DMUNL,   FIL=IMAGR 
* 
*            WHERE NN IS THE OVERLAY NUMBER 
* 
* 
ISTA1   NOP 
DMUNL   NOP             ENTRY 
        JSB .ENTR       FETCH PARAMETER 
        DEF ISTA1 
* 
        JSB DBUNL       CALL IMAGE UNLOCK ROUTINE 
        DEF *+2 
        DEF ISTA1,I 
* 
        JSB RSFLG       SET SAVE RESOURCES FLAG 
        DEF *+1 
        JMP DMUNL,I     TERMINATE UNLOCK CALL 
* 
* 
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
* 
* 
*************************************************************** 
*            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 
        ADA M1          NO
        SSA             TEST FOR NUMBER OF WORDS TO PAD 
        JMP PAD1
        LDA BLANK       PAD LAST TWO WORDS
        STA B,I 
PAD1    LDA BLANK       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
* 
* 
*************************************************************** 
*            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                              * 
*                                                             * 
*************************************************************** 
* 
CHAR    BSS 1 
PBUF    BSS 1 
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     * 
*                                                             * 
*************************************************************** 
* 
UPBUF   BSS 1 
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
* 
* 
.1      DEC 1 
.2      DEC 2 
.3      DEC 3 
.4      DEC 4 
.5      DEC 5 
.6      DEC 6 
.15     DEC 15
.24     DEC 24
.33     DEC 33
.35     DEC 35
.44     DEC 44          COMMA 
.64     DEC 64
.75     DEC 75          "K" 
.78     DEC 78          "N" 
.103    DEC 103         DATA BASE NOT PROPERLY OPENED 
.117    DEC 117         ILLEGAL SECURITY CODE 
.128    DEC 128         INSUFFICIENT BUFFER SPACE 
.129    DEC 129         ROOT FILE OPENED OR LOCKED
.272    DEC 272 
.300    DEC 300         INVALID DATA SET NAME 
.301    DEC 301         INVALID DATA ITEM NAME
.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
.315    DEC 315         INVALID MODE SPECIFIED BY USER
.324    DEC 324         ILLEGAL DBINF REQUEST 
.325    DEC 325         INVALID SET OR ITEM NAME IN DBINF 
M1      DEC -1
M7      DEC -7
M8      DEC -8
M144    DEC -144
M272    DEC -272
B40     OCT 40
B104    OCT 104         "D" 
B111    OCT 111         "I" 
B125    OCT 125         "U" 
B132    OCT 132 
B377    OCT 377         MASK UPPER BYTE 
SIGN    OCT 100000      SET SIGN BIT
MSKLO   OCT 177400      MASK LOWER BYTE 
AI      ASC 1,I 
AR      ASC 1,R 
AS      ASC 1,S 
BLANK   ASC 1,
A       EQU 0 
B       EQU 1 
BUFFR   BSS 256 
BUFF2   BSS 9 
BUFF3   BSS 3 
BUFF4   BSS 1 
BUFF5   BSS 9 
CHARS   BSS 1 
COUNT   BSS 1 
DCB     BSS 144 
DSNBR   BSS 1 
IBUF1   BSS 256 
IBUF2   EQU IBUF1 
IBUFF   DEF IBUF1-1 
INBR    BSS 128 
INDX    BSS 1 
INDX3   DEF BUFF3 
INDXB   BSS 1 
INDXR   DEF RLIST 
ITEMS   BSS 1 
ITYP    BSS 1 
IVALU   EQU BUFFR 
LENF    BSS 1 
IERR    EQU LENF
LENTH   BSS 1 
N       BSS 1 
NAME1   BSS 3 
NAME2   BSS 3 
NAMES   BSS 1 
NCNT    BSS 1 
OFSET   DEF BUFFR+2 
OFST2   DEF BUFF2 
OFSTB   DEF BUFFR 
OFSTN   BSS 1 
OFSTV   BSS 1 
P       BSS 1 
PTR1    DEF INBR
PTR2    DEF INBR+1
PTR3    DEF IVALU 
R       BSS 1 
RETRN   BSS 1 
SC      BSS 1 
STAT    BSS 1 
TEMP    BSS 1 
TMP     BSS 1 
TMP2    BSS 2 
VARS    BSS 1 
        END 
                                                                                                                                                                                                