ASMB,R,L,C HED <> 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