ASMB HED . ** T M S - I M A G E - M O D U L E ** NAM $ITMS,7 92903-16100 REV.1913 781219 SPC 3 ********************************************************************** * * * NAME: $ITMS TMS-IMAGE MODULE * * SOURCE: &$ITMS 92903-18111 * * BINARY: %$ITMS ----NONE--- PART OF %TMSLB 92903-16100 * * * * PGMR: FRANCOIS GAULLIER * * * ********************************************************************** SPC 2 * ************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ************************************************************** SPC 3 ENT $ITMS SPC 1 EXT RMPAR,PNAME,EXEC,CNUMD,PRTN,KLCLS EXT $PARS,DBCRC EXT DBINT,DBOPN,DBCLS,DBUPD,DBDEL EXT DBPUT,DBFND,DBINF,DBGET,DBLCK EXT HASH SPC 1 A EQU 0 B EQU 1 SUP SPC 4 $ITMS STA LOCTB SAVE LOCK TABLE ADDR STA LOCTE AND INIT LOCK TABLE POINTERS STB PROTB STB PROTE LDB A,I RECALL B REG VALUE JSB RMPAR AND RETREIVE PARAMETER DEF *+2 DEF P1 SPC 1 JSB EXEC SWAP THE WHOLE AREA DEF *+3 DEF D22 DEF D3 SWAP THE ENTIRE PARTITION SPC 2 IFZ JSB .DBUG CALL DBUG: INTERNAL USE ONLY !!!!!!!!!!!!!!!!!!!!! EXT .DBUG CALL DBUG: INTERNAL USE ONLY !!!!!!!!!!!!!!!!!!!!! XIF SPC 2 JSB PNAME GET PROGRAM NAME DEF *+2 .ILIS DEF ILIST+1 SKP * SHEDULE REQUEST ACCEPTED BY THIS PROGRAM: * =========================================== * * * - IF NO STRING IS PASSES: * * * THE 4TH PARAMETER IS CHECKED, IF = -1 THEN THE PROGRAM TRY TO * GET A REQUEST BUFFER ON SPECIAL CLASS ALLOCATED BY THIS PROGRAM * AND RETURNED TO USER ON THE DBOPN CALL. IF THE GET FAIL THE * PROGRAM TERMINATES FOR EVER IF IT WAS DORMANT, OR WITH 'SAVE * SUSPENSION POINT' OPTION IF IT WAS IN THAT STATE. * * IF THE 4TH PARAMATER IS NOT -1, THEN IT IS ASSUMED TO BE A * CLASS I/O WORD AND A CLASS I/O GET IS EXECUTED ON THAT CLASS. * * IF THE GET FAIL, A ERROR MESSAGE IS PRINTED ON THE SYSTEM * CONSOLE AND THE PROGRAM TERMINATES WITH THE CURRENT OPTION. * * IF THE GET SUCCEED, THE FIRST WORD OF THE BUFFER IS ASSUMED * TO BE THE REQUEST CODE. IF IT IS LEGAL (0 =< RQ =<8), THE * REQUEST IS PERFORMED, ELSE THE ERROR MESSAGE IS PRINTED ON * THE SYSTEM CONSOLE AND THE PROGRAM TERMINATES WITH THE * CURRENT OPTION. * * * - IF A STRING IS PASSES: * * * THE FIRST WORD OF THE STRING IS ASSUMED TO BE THE REQUEST CODE * IF IT IS LEGAL (BETWEEN 0 & 8) THE REQUEST IS PERFORMED. * IF THE REQUEST CODE IS NOT LEGAL, THE STRING IS CHECKED AGAINST * ",,1" OPTAIN FROM THE FOLLOWING RTE/FMGR COMMAND "RU,TMSIM,,,1" * * IF THE STRING DOES NOT MATCHE, A MESSAGE IS PRINTED ON THE * TERMINAL USED TO SHEDULE THE PROGRAM, AND THE PROGRAM * TERMINATES WITH THE CURRENT OPTION. * * IF THE STRING MATCHES, AND THE DATA-BASE IS CLOSE, THE * FOLLOWING MESSAGE IS PRINTED: * NO DATA-BASE CURRENTLY OPEN. * * IF THE STRING MATCHES, AND A DATA-BASE IS STILL OPEN, THE * USER IS PROMPTED WITH THE FOLLOWING: * DATA-BASE= * LEVEL WORD= * SEC-CODE= * IF THE USER ANSWER CORRECTLY, THE DATA-BASE IS CLOSED IMMEDIATLY * REGARDLESS OF ANY LOCKING CONSIDERATION, AND THE PROGRAM * TERMINATES FOR EVER. (NO SAVE SUSP. OPTION) * * THIS PROCEDURE SHOULD BE USE ONLY IN CASE OF EMMERGENCY !! * * * THE ERROR MESSAGE PRINTED ON THE TERMINAL IS THE FOLLOWING: * * /XXXXX : ILLEGAL SCHEDULE REQUEST ! SKP * FATAL ERROR # MEANING * * 1 [DBOPN] TMSIM COPY MISSING, NOT LOADED (DONE * LOCALLY BY TMLIM) * 2 [DBOPN] LEVEL ACCESS WORD IS NOT THE GREATER ONE * 3 [DBOPN] USE OF THIS PROGRAM TO ACCES AN OTHER DATA-BASE * 500 THE PROGRAM HAS NOT BEEN INITAILIZED * (NO DBOPN REQUEST) * 501 UPDATE A FILE NOT SAVED IN THE AUTOMATIC * SAVED RUN TABLE. SPC 2 * NEW IMAGE STATUS MEANING * * 397 [IMG-STAT] LOCK TABLE OVERFLOW. * 399 [IMG-STAT] IMAGE TBXXX CALL WITH DATA-BASE NAME THAT HAS NOT * BEEN OPENED TO THIS PROCESS. * 400 [IMG-STAT] ERROR RETURNED WHEN PROCESS SHOULD BE SUSPENDED * AND THE 'NO WAIT' OPTION HAS BEEN SPECIFIED * 401 [IMG-STAT] DEADLOCK ERROR ! * 403 [IMG-STAT] UNLOCK RECORD LOCKED BY AN OTHER PROCESS * 404 [IMG-STAT] UNLOCK RECORD WITHOUT HAVING A LOCKID (NEVER * REQUEST ANY LOCK) * 405 [IMG-STAT] DBPUT IN A MASTER WITHOUT HAVING LOCK THE ENTRY * IN ADVANCE * 406 [IMG-STAT] A PROCESS THAT OWN NON-EXCLUSIVELY A RECORD, TRY * TO LOCK THAT RECORD EXCLUSIVELY. SKP * MAXIMUM VALUE CONSIDERATION * =========================== * * - IMAGE MAXIMUM VALUE: * * MAXIMUM NUMBER OF DATA-SET PER DATA-BASE : 50 * MAXIMUM NUMBER OF ITEM PER DATA-BASE : 255 * MAXIMUM NUMBER OF ITEM PER DATA-SET ENTRY : 127 * * MAXIMUM ENTRY LENGTH (MEDIA+DATA) : 256 WORDS * MAXIMUM ITEM LENGTH : 63 WORDS * * * - TMS-IMAGE COMMUNICATION MAXIMUM BUFFER LENGTH: * * MAXIMUM BUFFER LENGTH RECEIVED BY THIS PROGRAM IS * FOR A DBPUT CALL : 4+1+1+3+128+256 = 393 = RBULN * WHERE 4,1,1,3 ARE TMS INTERNAL BUFFER * 128 IS INBR (MAX # OF ITEM/DATA-SET + 1) * AND 256 IS IVALUE (MAX ENTRY LENGTH) * * MAXIMUM BUFFER LENGTH SEND BY THIS PROGRAM IS * FOR A DBGET CALL : 2+8+4+1+256 = 271 = SBULN * WHERE 2,8,4,1 ARE TMS INTERNAL BUFFER * AND 256 IS THE ENTRY VALUE (MAX ENTRY LENGTH) * * ANY BUFFER RETURNED BY DBINF SHOULD BE SMALLER THAN THAT. SKP LDA LOCTB GET FWA OF BUFFER LDB PROTB GET LWA OF BUFFER CMB,INB ADB LOCTB COMPUTE LENGTH STA PT SAVE FWA CLA STA PT,I ISZ PT CLEAR THE BUFFER INB,SZB JMP *-3 SPC 1 * ALLOCATE A CLASS I/O WORD, PASSES IT BACK TO THE * CALLER, SO WHEN THE CALLER NEED TO REQUEST THAT PROGRAM * IT CAN USE A SCHEDULE REQUEST OR IF THE PROGRAM IS NOT * DORMANT IT CAN SEND A MAIL BOX USING THIS CLASS I/O * IN ORDER TO NOT SUSPEND ITSELF. * JSB GTCLW ALLOCATE A CLASS I/O STA CLASS SAVE THE CALSS I/O WORD * JMP DEB05 SPC 3 ILSHR LDA P1 SET UP LU SZA,RSS ILSH3 CLA,INA STA P1 LDA .ILIS SET PROGRAM NAME IN THE MESSAGE LDB .MES1 MVW D3 JSB EXEC OUTPUT DEF *+5 "ILLEGAL SHEDULE REQUEST ! " DEF D2 DEF P1 DEF MES DEF D18 LDA ACTIV GET ACTIVE FLAG SZA,RSS PROGRAM ACTIVE ? JSB ABORT NO, TERMINATE PROGRAM JMP EXIT4 YES, SAVE SUSPENSION POINT * MES ASC 5, /XXXXX : ASC 13,ILLEGAL SCHEDULE REQUEST ! D18 DEC 18 D14 DEC 14 D8 DEC 8 .MES1 DEF MES+1 D22 DEC 22 D7 DEC 7 * ILIST DEC 1 BSS 3 * SBULN DEC 271 MAX BUF LEN TO SEND RBULN DEF 393 MAX BUF LEN TO RECEIVE * ISTAT BSS 10 * CLASS NOP * SPC 1 P1 BSS 3 PARAMETERS GET BY RMPAR CLAS# OCT 0 P4 MAY BE THE CLASS I/O WORD NOP HED T-M LIBRARY <---> TMS-IMAGE MODULE COMMUNICATION EXIT5 ADA D2 ADJUST MAIL BOX LENGTH CLB STB ERCOD NO FATAL ERROR REPORTED LDB SCODE RETURN THE TMS-IMSGE-RQ-CODE STB ERCOD+1 TO THE CALLER SPC 1 EXIT6 STA LTEM SET MAIL BOX LENGTH * LDA CLAS# RELEASE CLASS I/O IF NOT ALREADY DONE JSB KLCLX LDA ECLAS RECALL CLASS I/O THAT SHOULD BE USED STA CLAS# TO SEND THE RESULT LDA PARM SET UP OPTIONAL CLASS I/0 PARAMETERS LDB PARM+1 WITH THOSE SUPPLIED BY THE USER JSB PSAM SEND ANSWER TO THE USER USING HIS CLASS I/O DEF ERCOD BUFFER ADDR LTEM NOP BUFFER LENGTH SPC 1 EXIT3 LDA RSTAR,I GET RESTART QUEUE HEAD SZA,RSS SOMETHING TO RESTART ? JMP EXIT4 NO, EXIT RAL,CLE,ERA YES, CLEAR BIT 15 LDB A,I REMOVE THAT PROCESS FROM THE STB RSTAR,I RESTART QUEUE CLB STB A,I CLEAR LINK WORD IN THE PROCESS DIRECTORY INA LDB A,I RECALL CLASS I/O STB CLAS# SET CLASS I/O WORD CLB STB A,I CLEAR CALL I/O IN THE PROCESS DIRECTORY LDA CLAS# SET CLASS I/O WORD IN A REG. JMP DEB15 AND RESTART PROGRAM SPC 1 EXIT4 LDA CLASS TRY TO GET A REQUEST ON THE SPECIAL CLASS JSB GSAM GET NO-WAIT & NO-ABORT SSA,RSS SOMETHING GET ? JMP DEB20 YES, GO PROCESS REQUEST * RTNFL OCT 0 RETURN FLAG (NOP/RSS) TO RTN PARAM TO CALLER JMP EXIT9 IF NOP; EXIT WITHOUT 'PRTN' * SPCLF RSS CLEARED ONLY WHEN SPECIAL CLOSE JMP SPCLS REQUEST IS REQUESTED, RETURN TO SPECIAL PROCESS * JSB PRTN SEND RETURN PARAMETERS TO CALLER DEF *+2 DEF RTPAR RETURN PARAMETRS BUFFER * EXIT9 JSB EXEC COMPLETE THIS PROGRAM DEF *+4 SAVING SUSPENSION POINT. DEF D6 .D0 DEF D0 DEF D1 SPC 1 **************************************************************** SPC 1 JSB RMPAR RETREIVE SCHEDULE PARAMETERS DEF *+2 DEF P1 SAVE PARAMETER * DEB05 CLA SET RETURN FLAG TO NOT USE 'PRTN' STA RTNFL SPC 1 JSB EXEC GET STRING REQUEST DEF *+5 DEF D14 DEF D1 .SCOD DEF SCODE BUFFER ADDR DEF RBULN BUFFER LENGTH DST PARM1 SAVE STATUS & LENGTH SZA,RSS STRING GET SUCCED ? JMP DEB18 YES, GO PROCESS REQUEST * LDA CLAS# NO STRING, CHECK FOR A MAIL BOX CPA DM1 WANTS TO GET FROM THE SPECIAL CLASS ? JMP EXIT4 YES, GO DO THE GET SZA,RSS CLASS I/O DEFINED ? JMP ILSH3 NO, PRINT 'ILLEGAL SCHEDULE REQUEST' DEB15 AND =B17777 YES, RELEASE BUFFER ON THE NEXT GET IOR B20K BUT DO NOT DEALLOCATE THE CLASS I/O JSB GSAM GET NO-WAIT & NO-ABORT SSA SOMETHING GET ? JMP ILSH3 NO, PRINT MESSAGE AND EXIT JMP DEB25 YES, PROCESS THE REQUEST SPC 2 DEB18 BLS SET TLOG IN CHARACTERS LDA .SCOD BUFFER ADDR JSB $PARS PARSE THE BUFFER DEF BTEMP AND STORE RESULTE INTO BTEMP * LDA BTEMP+1 RECALL FIRST PARAM VALUE CPA ARU IS IT A "RU, .... " COMMAND ? JMP SPCL3 YES, CHECK FOR EMERGENCY PROCEDURE SPC 1 DEB20 CLA NO CLASS I/O IS DEFINE IN THAT WORD STA CLAS# SPC 2 DEB25 LDA SCODE GET REQUEST CODE SSA NEGATIVE ? JMP ILSH3 YES, ERROR ADA =D-9 GREATER THAN 9 SSA,RSS JMP ILSH3 YES, ERROR LDA SCODE NO, RECALL SUBROUTINE CODE LDB ACTIV RECALL ACTIVE FLAG SZB DATA BASE OPEN ? JMP DEB30 YES, CONTINUE SZA NO, OPEN REQUEST ? JMP ER500 NO, REJECT THIS CALL SPC 1 DEB30 ADA C.TAB INDEX IN TABLE JMP A,I HED EMERGENCY CLOSE PROCEDURE SPCL3 LDA BTEMP+8 VERIFY THAT THE 1ST PARAM SZA IS NOT DEFINED JMP ILSH3 ERROR ! LDA BTEMP+12 VERIFY THAT THE 2ND PARAM SZA IS NOT DEFINED JMP ILSHR ERROR ! LDA BTEMP+16 VERIFY THAT THE 3RD PARAM ADA BTEMP+17 IS "1" CPA D2 COMPARE TYPE+VALUE RSS OK, DO SPECIAL CLOSE REQUEST JMP ILSHR SPC 1 LDA P1 RECALL LU SZA,RSS CLA,INA STA P1 SAVE LU IOR =B400 STA P1+1 SAVE LU FOR INPUT SPC 1 LDA ACTIV DATA-BASE OPEN SZA,RSS OPEN ? JMP SPCL9 NO, REPORT ERROR SPC 1 SPCL5 JSB EXEC PRINT "DATA-BASE=" DEF *+5 DEF D2 DEF P1 LU DEF MSDB BUFFER DEF D7 JSB SPCL0 READ AND PARSE ANSWER CPB D2 ASCII ? RSS YES, OK JMP SPCL5 NO, TRY AGAIN LDB .DBNM CHECK IF CORRECT CMW D3 JMP SPCL6 OK, ASK LEVEL WORD NOP DO NOT COMPARE JMP ILSHR REJECT THE SHEDULE REQUEST * SPCL6 JSB EXEC PRINT "LEVEL =" DEF *+5 DEF D2 DEF P1 DEF MSLE DEF D5 JSB SPCL0 READ AND PARSE ANSWER SZB,RSS NUL ? LDA .SP YES, TAKE DEFAULT ASCII VALUE SZB CPB D2 ASCII ? RSS YES, OK JMP SPCL6 NO, TRY AGAIN LDB .DBN3 CHECK IF CORRECT CMW D3 JMP SPCL7 OK, ASK LEVEL WORD NOP DO NOT COMPARE JMP ILSHR REJECT THE SHEDULE REQUEST * SPCL7 JSB EXEC PRINT "SEC.-CODE=" DEF *+5 DEF D2 DEF P1 LU DEF MSSC BUFFER DEF D7 JSB SPCL0 READ AND PARSE ANSWER SZB NUL ? CPB D1 NUMERIC ? RSS YES, OK JMP SPCL7 NO, TRY AGAIN LDB A,I CHECK IF CORRECT CPB DBNAM+6 RSS JMP ILSHR REJECT THE SHEDULE REQUEST * CLA,INA SET SCODE FOR DBCLOSE STA SCODE CLA SET SPECIAL CLOSE FLAG STA SPCLF TO RETURN AFTER THE CLOSE JMP XDBC0 * SPCLS LDA .DBNM MOVE DATA-BASE NAME INTO THE MESSAGE LDB .MS9X MVW D3 LDA RTPAR RECALL DBCLOSE IMAGE STATUS SZA,RSS OK ? JMP SPCL8 YES, PRINT MESSAGE SSA NO, PRINT ERROR MESSAGE CMA,INA STA TEMP JSB CNUMD DEF *+3 DEF TEMP DEF MS9+16 LDA .MS8 LDB .MS9Y MVW D8 SPCL8 JSB EXEC PRINT "DATA-BASE XXXXXX SUCCESSFULLY CLOSE" DEF *+5 DEF D2 DEF P1 DEF MS9 DEF D20 JMP EXIT9 SPC 1 SPCL9 JSB EXEC PRINT "NO DATA-BASE CURRENTLY OPEN" DEF *+5 DEF D2 DEF P1 DEF MS7 DEF D16 JSB ABORT TERMINATE PROGRAM JMP EXIT9 SPC 1 MSDB ASC 7, DATA-BASE = _ MSLE ASC 5, LEVEL = _ MSSC ASC 7, SEC.-CODE = _ MS9 ASC 20, DATA-BASE: XXXXXX SUCCESSFULLY CLOSED. MS7 ASC 16, NO DATA-BASE CURRENTLY OPEN ! .MS8 DEF *+1 ASC 8,; CLOSE ERROR : .SP DEF *+1 ASC 3, .MS9Y DEF MS9+9 .MS9X DEF MS9+6 ARU ASC 1,RU .DBN3 DEF DBNAM+3 D16 DEC 16 SPC 1 SPCL0 NOP JSB EXEC READ ANSWER DEF *+5 DEF D1 DEF P1+1 .BUF DEF BUF DEF DM7 LDA .BUF RECALL BUFFER ADDR JSB $PARS PARSE BUFFER DEF BTEMP OUTPUT BUFFER LDA .BTE1 ADDR. OF DATA LDB BTEMP TYPE OF DATA JMP SPCL0,I * .BTE1 DEF BTEMP+1 DM7 DEC -7 HED IMAGE / INTERNAL ERROR PROCESSING ERR? NOP FOR INTERNAL IMAGE RQ, CHECK STATUS LDA ISTAT RECALL IMAGE STATUS JSB .ERR? JMP ERR?,I SPC 2 * FATAL ERROR PROCESSING ---> ABORT CALLER * .ERR? NOP SZA,RSS OK ? JMP .ERR?,I YES, CONTINUE EROR JSB CHECK !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LDB SCODE SZB,RSS OPEN REQUEST ? JMP RTPRG YES, USE SPECIAL RETURN WITH 'PRTN' CPB D1 CLOSE REQUEST ? JMP RTPRG CPB D8 TBULK REQUEST ? JMP RTPRG DST ERCOD SET UP ERROR CODE & REQUEST CODE LDA D2 SET BUFFER LENGTH JMP EXIT6 AND GO SEND THE ANSWER TO THE CALLER SPC 1 ER500 JSB ABORT TERMINATE THE PROGRAM LDA =D500 DATA-BASE HAS NOT BEEN OPENED JMP EROR SPC 2 * IMAGE ERROR PROCESSING ---> THE ERROR NUMBER * IS RETURNED TO THE USER, IN PLACE OF * THE IMAGE STATUS. * SIMST LDB SCODE SET IMAGE STATUS ADB S.TAB A REG = ERROR CODE JMP B,I JUMP TO RIGHT CODE SPC 1 SIMS1 STA BTEMP+8 SET IMAGE STATUS JSB CHECK !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JMP XDBF3 AND RETURN * SIMS2 STA BTEMP SET IMAGE STATUS JSB CHECK !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JMP XDBP5 AND RETURN SPC 1 S.TAB DEF *+1,I DEF ILRQ DBOPN DEF ILRQ DBCLS DEF SIMS1 DBGET DEF SIMS1 DBFND DEF SIMS2 DBPUT DEF SIMS2 DBUPD DEF SIMS2 DBDEL DEF ILRQ DBINF DEF ILRQ TBULK SPC 2 * TERMINATE THIS PROGRAM WITHOUT ANY OPTION * TO MAKE IT ACTUALLY DORMANT. SPC 1 ABORT NOP LDA .D0 STA .D0+1 SUPPRESS TERMINATE OPTION JMP ABORT,I AND TERMINATE PROGRAM. SPC 1 RSTAR DEF *+1 RESTART PROCESS QUEUE OCT 0 SPC 1 ACTIV OCT 0 # OF OPEN/CLOSE REQUEST HED DBOPN PROCESSOR * * INPUT BUFFER FORMAT: * * HEADR (4) RQ/CLASS#/PARM1/PARM2 * BUF[1:3] (3) DATA-BASE NAME * BUF[4:6] (3) LEVEL ACCESS WORD * BUF[7] (1) SECURITY CODE SPC 1 * RETURN VALUE USING 'PRTN' SUBROUTINE: * * RTPAR[1] (1) 0 / ERROR CODE * RTPAR[2] (1) TMS-SUBROUTINE CODE IF ERROR * RTPAR[3] (1) DATA-BASE CRC * RTPAR[4] (1) MAXIMUM ITEM LENGTH * RTPAR[5] (1) MAXIMUM ENTRY LENGTH SPC 1 XDBOP LDA CLAS# RELEASE MAIL BOX & CLASS JSB KLCLX * LDA ACTIV GET ACTIVE FLAG SZA IS IT THE FIRST ENTRY ? JMP XDBO4 NO, CHECK THAT IT IS THE SAME DATA BASE SPC 1 LDA .BUF SAVE DATA-BASE NAME & LEVEL WORD LDB .DBNM & SECURITY CODE MVW D7 SPC 1 JSB DBINT INITIALIZE RUN TABLE AREA DEF *+5 DEF BUF DATA BASE NAME DEF BUF+6 SECURITY CODE DEF ILIST LIST OF PROGRAM DEF ISTAT JSB ERR? OK ? SPC 1 JSB DBOPN OPEN THE DATA BASE DEF *+6 DEF BUF DATA BASE NAME DEF BUF+3 LEVEL ACCESS WORD DEF BUF+6 SECURITY CODE DEF D2 MODE DEF ISTAT STATUS JSB ERR? OK ? LDA ISTAT+1 RECALL LEVEL ACCESS CPA =D15 IS IT THE HIGHEST LEVEL ? JMP XDBO2 YES, GO LOCK THE DATA BASE LDA D2 NO, DBOPN ERR#2: BAD LEVEL ACCESS WORD JMP EROR PASSES ERROR BACK TO CALLING PRG & TERMINATE SPC 1 XDBO2 JSB DBLCK LOCK THE WHOLE DATA BASE DEF *+3 DEF D2 LOCK WITHOUT WAIT DEF ISTAT JSB ERR? SUCCESFUL LOCK ? * JSB DBCRC CALCULATE THE DATA-BASE CRC DEF *+6 AND RETURN MAXIMUM VALUE DEF BUF DATA BASE NAME DEF RTPAR+2 CRC DEF RTPAR+3 MAX ITEM LENGTH DEF RTPAR+4 MAX ENTRY LENGTH DEF ISTAT STATUS JSB ERR? OK ? * OKOPN ISZ ACTIV BUMP ACTIVE FLAG LDB CLASS RETURN SPECIAL CLASS# TO CALLER OKRTN CLA RETURN GOOD SATUS SPC 1 RTPRG DST RTPAR SAVE RETURN PARAMETERS LDA .RSS AND SET THE RETURN FLAG TO STA RTNFL USE 'PRTN' SUBROUTINE JMP EXIT3 RETURN SPC 2 XDBO4 LDA .BUF CHECK THAT NAME, LEVEL WORD AND SC LDB .DBNM ARE THE SAME CMW D7 JMP OKOPN OK, SAME DATA-BASE