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