ASMB HED . ** T M S - I M A G E - M O D U L E ** NAM $ITMS,7 92080-1X111 REV.2026 800606 1200 SPC 3 ********************************************************************** * * * NAME: $ITMS TMS-IMAGE MODULE * * SOURCE: &$ITMS 92080-18111 * * BINARY: %$ITMS ----NONE--- PART OF $TMSLB 92080-12100 * * * * 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,JASC,PRTN,KLCLS EXT $PARS,DBCRC,OPLOG,WRLOG EXT DBOPN,DBCLS,DBUPD,DBDEL,DBUNL EXT DBPUT,DBFND,DBINF,DBGET,DBLCK EXT HASH,BLANC,INAMR,NXINI,NXPAR EXT .DDI,.DMP,.DSBR,.DIN * EXT DBUGR * EXT DMPTM 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 STX .LNAM SAVE LOG FILE NAME ADDR STY .DMDL SAVE LOCK FLAG, DBNAMR ADDR LDA .DMDL,I GET LOCK FLAG AND D1 ISOLATE BIT 1 STA DMDLK SAVE * ISY POINT TO DB NAME, LEV ACC, SEC CODE, CR NO, NODE NO CYA LDB .DBNM GET ADDR OF DB NAMR ARRAY MVW D9 SAVE DB NAME, LEV ACC, SEC CODE, CR NO, NODE NO * LDB LOCTB,I RECALL B REG VALUE JSB RMPAR AND RETREIVE PARAMETER DEF *+2 DEF P1 SPC 1 LDA P1 GET LU PARAMETER SZA,RSS SET TO 1 IF NOT SPECIFIED CLA,INA STA P1 STA LU * JSB EXEC SWAP THE WHOLE AREA DEF *+3 DEF D22 DEF D0 SWAP THE ENTIRE PARTITION SPC 2 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 * * 450 [DBOPN] TMSIM COPY MISSING, NOT LOADED (DONE * LOCALLY BY TMLIM) * 451 [DBOPN] LEVEL ACCESS WORD IS NOT THE GREATER ONE, OR USE * OF THIS PROGRAM TO ACCES AN OTHER DATA-BASE * 452 [DBOPN] THE PROGRAM HAS NOT BEEN INITAILIZED * (NO DBOPN REQUEST) * 453 [DBOPN] CANNOT ALLOCATE CLASS IO * * * 460 [INTERNAL] UPDATE A FILE NOT SAVED IN THE AUTOMATIC * SAVED RUN TABLE. * 461 [INTERNAL] CORRUPT TMS-IMAGE DATA STRUCTURES * 462 ITEM LENGTH IS .GT. 512 WORDS SPC 2 * NEW IMAGE LOCK STATUS MEANING * * 400 [IMG-STAT] ERROR RETURNED WHEN PROCESS SHOULD BE SUSPENDED * AND THE 'NO WAIT' OPTION HAS BEEN SPECIFIED * OR WHEN ATTEMPTING TO LOCK THE DATA BASE WHEN * IT IS LOCKED BY ANOTHER PROGRAM (LOCK ON * DEMAND ONLY) * 401 [IMG-STAT] DEADLOCK ERROR * 402 [IMG-STAT] LOCK TABLE OVERFLOW * 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 HAS LOCKED A RECORD SHARED HAS * TRIED TO LOCK THAT RECORD EXCLUSIVELY. * 414 [IMG-STAT] AN UPDATE OR DELETE ON A MASTER DATA SET HAS * BEEN ATTEMPTED, HOWEVER THE RUN TABLE * INDICATES THAT THE RECORD DOES NOT EXIST * AND HAS BEEN LOCKED FOR ADD. (DBGET CALL * THAT DID THE LOCK RETURNED A 107) * 410 [IMG-STAT] AN ADD HAS BEEN ATTEMPTED ON A MASTER DATA SET, * HOWEVER, THE RUNTABLE INDICATES THAT THE * RECORD EXISTS AND HAS BEEN LOCKED FOR * UPDATE/DELETE. (DBGET CALL THAT DID THE * LOCKED RETURNED A 0) 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 : 512 WORDS * MAXIMUM ITEM LENGTH : 128 WORDS * * * - TMS-IMAGE COMMUNICATION MAXIMUM BUFFER LENGTH: * * MAXIMUM BUFFER LENGTH RECEIVED BY THIS PROGRAM IS * FOR A DBGET CALL : 1+1+2+23+543 = 570 = RBULN * WHERE 1,1,2,23 ARE TMS INTERNAL BUFFER * AND 512 IS IVALUE (MAX ENTRY LENGTH) * * MAXIMUM BUFFER LENGTH SEND BY THIS PROGRAM IS * FOR A DBGET CALL : 2+23+515 = 540 = SBULN * WHERE 2,23 ARE TMS INTERNAL BUFFER * AND 512 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 JMP DEB05 SPC 3 ILSHR LDA P1 SET UP LU SZA,RSS ILSH3 CLA,INA LDB LU STA LU STB P1 ILSH5 LDA .ILIS SET PROGRAM NAME IN THE MESSAGE LDB .MES1 MVW D3 JSB WRTTY OUTPUT .MES DEF MES "ILLEGAL SHCEDULE REQUEST" DEF D18 LDA ACTIV GET ACTIVE FLAG SZA,RSS PROGRAM ACTIVE ? JSB ABORT NO, TERMINATE PROGRAM LDA P1 STA LU JMP EXIT4 YES, SAVE SUSPENSION POINT * MES ASC 5, /XXXXX : ASC 13,ILLEGAL SCHEDULE REQUEST ! .MES1 DEF MES+1 * ILIST DEC 1 BSS 3 * SBULN DEC 540 MAX BUF LEN TO SEND RBULN DEC 570 MAX BUF LEN TO RECEIVE * * STATUS BUFFER * ISTAT BSS 10 * * DBINF BUFFER * ISINF BSS 17 * CLASS NOP LGCLA NOP DMDLK NOP LOCK FLAG .DMDL 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 LDA DMDLK CHECK DEMAND LOCK FLAG SLA,RSS DEMAND LOCKING SPECIFIED? JMP EXI10 NO, TERMINATE LDA LKTOT YES, ARE THERE ANY LOCKED RECS? SZA JMP EXI10 YES, DONOT UNLOCK D.B. LDA LKFLG NO, IS THE D.B. ALREADY UNLOCKED? SZA,RSS JMP EXI10 YES, SKIP UNLOCK JSB DBUNL NO LOCKED RECS, UNLOCK D.B. DEF *+5 DEF IBASE DEF NCHRS DUMMY DEF D1 DEF BTEMP * CLA STA LKFLG SET LOCK FLAG TO INDICATE THAT D.B. IS UNLOCKED LDA LGCLA LOGGING? SZA,RSS JMP EXI10 NO, FINISH UP CCA YES, LOG UNLOCK STA SCODE SAVE UNLOCK CODE LDA D32 GET BUFFER LENGTH TO SEND TO DCLOG CLB DO NOT RETURN TO ANY PROG JSB DBLOG LOG DATA * EXI10 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 B1.47 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 NOP * JSB DMPTM * DEF *+7 * DEF D6 * DEF SCODE * DEF SMWDS * DEF MNMES * DEF D20 * DEF D1 * JSB DBUGR * DEF *+2 * DEF D21 LDA SCODE GET REQUEST CODE SSA NEGATIVE ? JMP ILSH3 YES, ERROR ADA DM10 .GE. 10 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,RSS NO, OPEN REQUEST ? JMP XDBOP YES, PROCESS CPA D9 NO, IS IT VERIFY REQUEST? JMP XDBVF YES, PROCESS JMP ER452 NO, REJECT THIS CALL SPC 1 DEB30 ADA C.TAB INDEX IN TABLE JMP A,I *NMES ASC 10,1$ITMS DATA 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 LDB LU STA LU SAVE LU STB P1 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 WRTTY PRINT "DATA-BASE=" 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 DOES NOT MATCH JMP ILSH5 REJECT THE SHEDULE REQUEST * SPCL6 JSB WRTTY PRINT "LEVEL =" 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 SEC. CODE NOP DO NOT COMPARE JMP ILSH5 REJECT THE SHEDULE REQUEST * SPCL7 JSB WRTTY PRINT "SEC.-CODE=" DEF MSSC BUFFER DEF D7 JSB SPCL0 READ AND PARSE ANSWER SZB,RSS NUL ? JMP SPCL7 YES, RE-ISSUE MESAGE LDB A,I CHECK IF CORRECT CPB DBNAM+6 RSS JMP ILSH5 REJECT THE SHEDULE REQUEST * SPC71 JSB WRTTY PRINT "CR-NO. =" DEF MSCR MESSAGE BUFFER DEF D6 JSB SPCL0 GET ANSWER SZB,RSS NUL ? JMP SPC71 YES, RE-ISSUE MESSAGE LDB A,I VERIFY CR. NO. CPB DBNAM+7 RSS JMP ILSH5 REJECT SCHEDULE REQUEST * CLA,INA SET SCODE FOR DBCLOSE STA SCODE CLA SET SPECIAL CLOSE FLAG STA SPCLF TO RETURN AFTER THE CLOSE LDA IBASE SET IMAGE INTERNAL DB# STA SCODE+2 JMP XDBC0 * SPCLS LDA .DBNM MOVE DATA-BASE NAME INTO THE MESSAGE LDB .MS9X MVW D3 LDA RTPAR RECALL DBCLOSE IMAGE STATUS SSA OK ? JMP SPCL8 YES, PRINT MESSAGE STA TEMP JSB JASC DEF *+5 DEF TEMP DEF MS9+17 DEF D1 DEF D6 LDA .MS8 LDB .MS9Y MVW D8 SPCL8 JSB WRTTY PRINT "DATA-BASE XXXXXX SUCCESSFULLY CLOSE" DEF MS9 DEF D20 JMP EXI10 SPC 1 SPCL9 JSB WRTTY PRINT "NO DATA-BASE CURRENTLY OPEN" DEF MS7 DEF D16 JSB ABORT TERMINATE PROGRAM JMP EXI10 SPC 1 MSDB ASC 6, DATA-BASE = OCT 20137 MSLE ASC 4, LEVEL = OCT 20137 MSSC ASC 6, SEC.-CODE = OCT 20137 MSCR ASC 5, CR.-NO. = OCT 20137 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 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 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 STA ISTAT LDB SCODE SZB,RSS OPEN REQUEST ? JMP XDBC0 YES, CLOSE DATA BASE AND CLEAN UP IF NECESSARY CPB D1 CLOSE REQUEST ? JMP RTPRG CPB D8 TBULK REQUEST ? JMP RTPRG DST ERCOD SET UP ERROR CODE & REQUEST CODE STA BTEMP+BTSTA SET UP IMAGE ERROR STATUS LDB LCKID PASS BACK THE LOCK-ID WORD STB BTEMP+BTLID (IT IS PROC. INDEX DIRECTORY: PID) LDB LCKID+1 PASS BACK THE IMAGE INTERNAL D.B. NO. STB BTEMP+BTIDB LDA D24 SET BUFFER LENGTH JMP EXIT6 AND GO SEND THE ANSWER TO THE CALLER SPC 1 ER452 JSB ABORT TERMINATE THE PROGRAM LDA D452 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 STA BTEMP+BTSTA JMP XDBF3 RETURN * * * 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: * * SCODE (4) RQ/CLASS#/PARM1/PARM2 * BUF[1:3] (3) DATA-BASE NAME * BUF[4:6] (3) LEVEL ACCESS WORD * BUF[7] (1) SECURITY CODE * BUF[8] (1) CARTRIDGE NO. * BUF[9] (1) DS NODE NO. (NOT USED) * BUF[10] (1) D.B. OPEN MODE * * OFFSETS INTO BUF * BFDBN EQU 0 DATA BASE NAME OFFSET BFLEV EQU 3 LEVEL ACCESS WORD OFFSET BFSEC EQU 6 SECURITY CODE OFFSET BFCRN EQU 7 CARTRIDGE NO. OFFSET BFNOD EQU 8 DS NODE OFFSET BFMD1 EQU 9 OPEN MODE OFFSET SPC 1 * RETURN VALUE USING 'PRTN' SUBROUTINE: * * RTPAR[1] (1) NEG IMAGE INTERNAL DB# / POS ERR CODE * DB# IF OK, ERROR CODE IF ERROR * RTPAR[2] (1) CLASS IO WD / TMS SUBROUTINE NO. * CLASS IO IF OK, SUB NO. IF ERROR * RTPAR[3] (1) DATA-BASE CRC * RTPAR[4] (1) MAXIMUM ITEM LENGTH * RTPAR[5] (1) MAXIMUM ENTRY LENGTH * * OFFSETS INTO RTPAR * RTERR EQU 0 IMAGE INTERNAL DB# / ERROR CODE RTCLA EQU 1 CLASS IO WORD / TMS SUBROUTINE NO. RTCRC EQU 2 DATA BASE CRC RTILN EQU 3 MAX ITEM LENGTH RTELN EQU 4 MAX ENTRY LENGTH SPC 1 XDBOP LDA CLAS# RELEASE MAIL BOX & CLASS JSB KLCLX * LDA .BUF GET ADDR OF DB NAMR SUPPLIED BY USER LDB .DBNM GET ADDR OF DB NAMR SUPPLIED BY TMPGN CMW D8 SAME ? JMP XDBOK YES, KEEP PROCESSING NOP NO, ERROR #451 LDA ACTIV IS DB ALREADY OPEN? SZA,RSS JSB ABORT NO, ABORT LDA D451 GET ERROR CODE 451 JMP XDBER PROCESS ERROR * XDBOK LDA ACTIV GET ACTIVE FLAG SZA IS IT THE FIRST ENTRY ? * JMP XDBO4 NO, CHECK THAT IT IS THE SAME DATA BASE JMP XDBO5 NO, CHECK MODE TO SEE THAT IT MATCHES SPC 1 LDA BUF+BFMD1 YES, FIRST OPEN CALL, SAVE MODE STA MODE * LDA MODE GET OPEN MODE SSA IS IT NEG? CMA,INA YES, GET ABS VALUE STA MOD1 SAVE * JSB BLANC CREATE DB NAMR FROM NAME, SEC CODE, CR NO. DEF *+3 DEF IBASE DEF D11 * * LDA BUF+BFNOD CHECK DS NODE NO. * SZA * STA IBASE * LDA .BUF LDB .IBA1 MVW D3 MOVE NAME INTO NAMR ARRAY * INB CBX SAVE SEC CODE ADDR LDB .ILEV GET LEVEL ACCESS WD ADDR MVW D3 CXB * MVW D2 MOVE SEC CODE AND CR NO. INTO NAMR ARRAY * LDA B27 GET PARSE CODE (ASCII, INTEGER, INTEGER) ADB DM3 POINT TO PARAMETER TYPE FIELD STA B,I SET PARAMETER TYPE * CLA STA NCHRS JSB INAMR CREATE NAMR DEF *+5 DEF IBAS1 DEF IBASE+1 DEF D20 DEF NCHRS * SPC 1 JSB DBOPN OPEN THE DATA BASE DEF *+5 DEF IBASE DATA BASE NAMR DEF BUF+BFLEV LEVEL ACCESS WORD DEF MOD1 MODE DEF ISTAT STATUS JSB ERR? OK? LDA ISTAT+1 RECALL LEVEL ACCESS CPA D15 IS IT THE HIGHEST LEVEL ? JMP XDBO0 YES, CHECK THE OPEN MODE LDA D451 NO, DBOPN ERR# 451: BAD LEVEL ACCESS WORD JMP EROR PASSES ERROR BACK TO CALLING PRG & TERMINATE SPC 1 XDBO0 LDA MOD1 GET MODE CPA D1 MODE 1 (SHARED READ/WRITE) ? JMP XDBO1 YES, LOCK DATA BASE, ENABLE RECORD LOCKING CLA NO, DISABLE DEMAND LOCKING STA DMDLK JMP XDBO2 * XDBO1 CLA ENABLE RECORD LOCKING STA LOCK1 STA LKTOT SET NO. OF RECS LOCKED TO 0 STA LKFLG SET LOCK FLAG TO INDICATE THAT D.B. IS UNLOCKED LDA DMDLK GET DEMAND LOCK FLAG SLA JMP XDBO2 DEMAND LOCKING, DO NOT LOCK D.B. NOW JSB DBLCK LOCK THE WHOLE DATA BASE DEF *+5 DEF IBASE DEF NCHRS USED AS DUMMY VARIABLE DEF D2 LOCK WITHOUT WAIT DEF ISTAT JSB ERR? ERROR? CLA,INA STA LKFLG SET LOCK FLAG TO INDICATE THAT D.B. IS LOCKED * XDBO2 JSB DBCRC CALCULATE THE DATA-BASE CRC DEF *+6 AND RETURN MAXIMUM VALUE DEF IBASE DATA BASE NAMR DEF RTPAR+RTCRC CRC DEF RTPAR+RTILN MAX ITEM LENGTH DEF RTPAR+RTELN MAX ENTRY LENGTH DEF ISTAT STATUS JSB ERR? OK ? * CHECK FOR MAX ENTRY LEN .LE. 512 * LDA RTPAR+RTELN CMA,INA ADA D512 SSA,RSS JMP XDBO3 LDA D512 STA RTPAR+RTELN * XDBO3 LDA MODE GET OPEN MODE CPA DM3 EXCLUSIVE OPEN WITH LOGGING BYPASS ? JMP XDBO7 YES, SKIP LOG FILE INITIALIZATION * LDA .LNAM,I LOGGING USED? SZA,RSS JMP XDBO7 NO, SKIP THE LOGGING OF THE DATABASE OPEN CLA YES, OPEN LOG FILE JSB OPLOG .LNAM NOP NAME OR DEV LU DEF P1 CONSOLE LU STB LGCLA SAVE CLASS IO WD JSB .ERR? CHECK FOR ERROR * LDA D32 GET WORD COUNT CLB GET RETURN CLASS JSB DBLOG LOG DATA * XDBO7 JSB GTCLW ALLOCATE CLASS IO WD STA CLASS SAVE * OKOPN ISZ ACTIV BUMP ACTIVE FLAG LDB CLASS RETURN SPECIAL CLASS# TO CALLER OKRTN LDA IBASE RETURN GOOD STATUS (NEG IMAGE INTERNAL DB#) CMA,INA 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 AC WD, SEC CODE, CR NO., * LDB .DBNM AND NODE NO. ARE THE SAME * CMW D9 * JMP XDBO5 OK, SAME DATA-BASE, CHECK OPEN MODE * NOP NOT THE SAME * LDA D451 DBOPN ERR# 451: OPEN AN OTHER DATA BASE * JMP XDBER * XDBO5 LDB BUF+BFMD1 GET USER OPEN MODE CPB MODE SAME AS D.B. OPEN MODE? JMP XDBO6 YES, CHECK THAT IT IS NOT MODE 3 LDA D152 NO, ERROR 152, INCOMPATIBLE OPEN MODE JMP XDBER * XDBO6 LDB MOD1 CPB D3 MODE 3? RSS YES, ERROR JMP OKOPN NO, OK LDA D150 ERROR 150, D.B. IS OPENED EXCLUSIVELY TO OTHER USER * XDBER LDB SCODE OPEN ERROR, RETURN BAD STATUS JMP RTPRG SPC 1 RTPAR BSS 5 .RSS RSS .DBNM DEF DBNAM DBNAM ASC 6,...... DB NAME AND LEVEL ACCESS WD OCT 0 SEC CODE OCT 0 CR NO. OCT 0 D.S. NODE (NOT USED) MODE OCT 0 OPEN MODE MOD1 BSS 1 NCHRS BSS 1 SCRATCH CHARACTER COUNT IBAS1 BSS 10 SCRATCH NAMR ARRAY .IBA1 DEF IBAS1 HED DBCLS PROCESSOR * * INPUT BUFFER FORMAT: * * SCODE (4) RQ/CLASS#/PARM1/PARM2 SPC 1 * RETURN VALUE USING 'PRTN' SUBROUTINE: * * RTPAR[1] (1) 0 / ERROR CODE * RTPAR[2] (1) CLASS IO WD / TMS SUB CODE * CLASS IO IF OK, SUB CODE IF ERR * * NOTE: THE DATA SET CLOSE FEATURE HAS NOT BEEN IMPLEMENTED. SPC 1 XDBCL LDA CLAS# RELEASE MAIL BOX & CLASS I/O JSB KLCLX * CCA DECREMENT ACTIVE FLAG ADA ACTIV STA ACTIV SZA LAST DBCLS REQUEST ? JMP OKRTN NO, FORGET THE REQUEST SPC 1 XDBC0 JSB ABORT SET UP TO TERMINATE PROGRAM * * JSB DMPTM * DEF *+7 * DEF D6 * DEF BUF * DEF D22 * DEF MSDB2 * DEF D10 * DEF D1 JSB DBCLS CLOSE THE DATA BASE DEF *+5 DEF IBASE IMAGE INTERNAL DB# DEF D1 DUMMY DEF D1 CLOSE ALL FILES DEF IBAS1 DUMMY STATUS (NO CHECK IS MADE) * JSB DMPTM * DEF *+7 * DEF D6 * DEF ISTAT * DEF D10 * DEF MSDB1 * DEF D10 * DEF D0 SPC 1 LDA CLASS RELEASE THE CLASS I/O JSB KLCLX CLA STA CLASS SPC 1 LDB PROTB RELEASE CLASS I/O USED TO SUSPEND XDBC3 CPB PROTE PROCESSES: END OF DIRECTORY ? JMP XDBC8 YES, TERMINATE THE PROGRAM * ADB DM1 LDA B,I GET CLASS I/O WORD ADB DM2 BUMP POINTER SZA,RSS CLASS HERE ? JMP XDBC3 NO, SKIP RELEASE STB TEMP SAVE POINTER JSB KLCLX YES, DEALLOCATE THE CLASS LDB TEMP AND CONTINUE JMP XDBC3 SPC 1 XDBC8 CLA THE RESTART QUEUE IS EMPTY ! STA RSTAR,I STA DMDLK DISABLE LOCK ON DEMAND * LDA LGCLA YES, CHECK FOR LOGGING SZA,RSS JMP XDBC9 NO LOGGING, RETURN IMMEDIATELY LDA D32 LOGGING USED, GET WORD COUNT OF BUFFER CLB SET RETURN CLASS TO 0 JSB DBLOG LOG THIS OPERATION * CLA,INA SET TERMINATE FLAG JSB OPLOG CLOSE LOG FILE DEF .LNAM,I DEF P1 CLA STA LGCLA CLEAR LOGGING CLASS * XDBC9 LDB SCODE GET OPERATION CPB D1 NORMAL CLOSE (SPECIFIC CLOSE REQUEST?) JMP OKRTN YES, RETURN LDA ISTAT NO, GET ERROR CODE JMP RTPRG RETURN ERROR STATUS HED TBULK PROCESSOR * * INPUT BUFFER FORMAT: * * SCODE (1) SUBROUTINE CODE * ECLAS (1) LOCKID WORD SPC 1 * RETURN VALUE USING 'PRTN' SUBROUTINE: * * RTPAR[1] (1) 0 / ERROR CODE * RTPAR[2] (1) TMS-SUBROUTINE CODE IF ERROR SPC 1 XTBUL LDA CLAS# RELEASE MAIL BOX & CLASS I/O JSB KLCLX * LDA D2 FORCE LOCKW TO UNLOCK REQUEST LDB ECLAS GET THE LOCKID WORD DST LOCKW AND STORE THEM WHERE THEY USE TO BE * JSB SPIDD ACCESS PROCESS ID DIRECTORY JMP UNLER ERROR 404, TRY TO UNLOCK WITH OUT HAVING LOCK ID SPC 1 LDA PIDPT,I RECALL # OF RECORDS LOCKED BY RAL,CLE,ERA THIS PROCESS STA PIDPT,I AND CLEAR BIT 15 (BIT X) SZA,RSS ANY RECORD OWNED ? JMP OKRTN NO, RETURN LDA LOCTB YES, SEARCH ALL THOSE ENTRY IN THE LOCK TABLE STA PT0 INIT STARTING OF LOCK TABLE ADDR. * XTBU3 STA PT SET POINTER FOR UNLCK ROUTINE CPA LOCTE END OF LOCK TABLE ? JMP UNLE1 YES, ERROR 461, CORRUPT DATA STRUCTURES LDA PT,I GET ENTRY FROM THE LOCK TABLE ALF,ALF AND B377 ISOLATE PIDX CPA PIDX ENTRY BELONG TO THIS PROCESS ? JSB UNLCK YES, RELEASE ENTRY LDA PIDPT,I RECALL # OF RECORD LOCKED SZA,RSS ALL RELEASED ? JMP OKRTN YES, RETURN LDA PT NO, CONTINUE ADA D3 BUMP POINTER JMP XTBU3 * UNLER LDA D404 ERROR 404, TRY TO UNLOCK WITHOUT LOCK ID JMP EROR UNLE1 LDA D461 CORRUPT DATA STRUCTURES JMP EROR HED DBGET PROCESSOR * * INPUT BUFFER FORMAT: * * SCODE (4) RQ/CLASS#/PARM1/PARM2 * BUF[1] (1) LOCK WORD * BUF[2] (1) TMS LOCK ID (TMS DB# / DS#) * BUF[3] (1) IMAGE INTERNAL DB# * BUF[4:6] (3) SCRATCH AREA * BUF[7:13] (7) IMAGE RUN TABLE * BUF[14] (1) DBGET MODE * BUF[15:22] (8) DATA SET NAME * BUF[23] (1) ILIST LENGTH * BUF[24:X] (N) ILIST * BUF[X+1:Y] (M) IARG * * OFFSETS INTO BUF * BFLKW EQU 0 TMS LOCK WORD BFLID EQU 1 TMS LOCK ID (TMS DB# / LOCK ID) BFIDB EQU 2 IMAGE INTERNAL DB# BFSCR EQU 3 SCRATCH WORDS (3) BFIRT EQU 6 IMAGE RUN TABLE BFMOD EQU 13 MODE BFDSN EQU 14 DATA SET NAME BFNLL EQU 22 NAME LIST (ILIST) LENGTH BFNLS EQU 23 NAME LIST (ILIST) * * OFFSETS INTO IMAGE RUNTABLE * RTCRR EQU 0 CURRENT RECORD IN CHAIN RTPRR EQU 2 PREVIOUS RECORD IN CHAIN RTNXR EQU 4 NEXT RECORD IN CHAIN RTCCP EQU 6 CURRENT CHAIN POINTER SPC 1 * OUTPUT BUFFER FORMAT: * * ERCOD (2) ERROR CODE/SUB # (TMS INTERNAL) * BTEMP[1:10] (10) IMAGE STATUS * BTEMP[11] (1) LOCK ID * BTEMP[12] (1) IMAGE INTERNAL DB# * BTEMP[13:15] (3) SCRATCH WORDS * BTEMP[16:22] (7) IMAGE RUN TABLE * BTEMP[23] (1) ENTRY LENGTH * BTEMP[24:X] (N) DATA RETREIVED (ENTRY VALUE) * * OFFSETS INTO BTEMP * BTLID EQU 10 LOCK ID OFFSET BTIDB EQU 11 IMAGE INTERNAL DB# BTSCR EQU 12 SCRATCH WORDS BTIRT EQU 15 IMAGE RUN TABLE BTSTA EQU 0 IMAGE STATUS BTELN EQU 22 ENTRY LENGTH BTDAT EQU 23 DATA RETREIVED * * LOGIC TO RELEASE PREV AND NEXT RECS ON CHAINED READS MAY BE * NECESSARY. SPC 1 XDBGE JSB LCKDB LOCK DATA BASE IF NECESSARY DEF BUF+BFLKW LOCK WORD LDA .BDSN GET DATA SET NAME JSB DSNUM ---> DATA SET NUMBER (INTO DS#) * LDA BUF+BFNLL GET ILIST LENGTH ADA .GET1 AND CALCULATE START ADDR OF IARG STA .GET2 * LDA BUF+BFMOD RECALL MODE STA LOCKM SAVE CPA D4 JMP XDBG2 DIRECTED READ CPA D7 JMP XDBG2 KEYED READ JSB RSTRT YES, RESTORE RUN TABLE FOR RE-READ, CHAINED READS, * AND SEQUENTIAL READS JMP XDBU7 ERROR RETURN SPC 1 XDBG2 JSB DBGET READ FROM DATA BASE DEF *+8 DEF BUF+BFIDB DEF DS# DATA SET NUMBER DEF BUF+BFMOD MODE DEF BTEMP+BTSTA STATUS RETURNED HERE .GET1 DEF BUF+BFNLS ILIST DEF BTEMP+BTDAT DATA BUFFER .GET2 BSS 1 IARG ADDR LDA BTEMP+BTSTA+1 STA NWDS LDA BTEMP+BTSTA !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB CHECK !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB SAVRT SAVE RUN TABLE SPC 1 *** JSB DBUGR *** DEF *+2 *** DEF D1 * LDA BUF+BFMOD RECALL DBGET MODE JSB LOCK LOCK/UNLCK ENTRY AS REQUESTED SPC 1 LDA NWDS RECALL NO. OF WDS TRANSFERRED STA BTEMP+BTELN STORE IN RETURN BUFFER INA XDBG9 ADA D22 CALCULATE NO. OF WDS TO RETURN SPC 1 LDB LCKID PASSES BACK THE LOCK-ID WORD STB BTEMP+BTLID (IT IS PROC. INDEX DIRECTORY: PID) LDB LCKID+1 PASSES BACK ALSO THE NEXT WORD STB BTEMP+BTIDB SPC 1 JMP EXIT5 AND RETURN SPC 1 NWDS BSS 1 HED DBFND PROCESSOR * * INPUT BUFFER FORMAT: * * SCODE (4) RQ/CLASS#/PARM1/PARM2 * BUF[1] (1) LOCK WORD * BUF[2] (1) TMS LOCK ID (TMS DB# / DS#) * BUF[3] (1) IMAGE INTERNAL DB# * BUF[4:6] (3) SCRATCH AREA * BUF[7:13] (7) IMAGE RUN TABLE * BUF[14] (1) DBGET MODE * BUF[15:22] (8) DATA SET NAME * BUF[23] (1) ITEM LENGTH * BUF[24:X] (N) ITEM LIST * BUF[X+1:Y] (M) IARG * * OFFSETS INTO BUF (DEFINED IN TBGET CALL) * SPC 1 * OUTPUT BUFFER FORMAT: * * ERCOD (2) ERROR CODE/SUB # (TMS INTERNAL) * BTEMP[1:10] (10) IMAGE STATUS TABLE * BTEMP[11] (1) LOCK ID * BTEMP[12] (1) IMAGE INTERNAL DB# * BTEMP[13:15] (3) SCRATCH WORDS * BTEMP[16:22] (7) IMAGE RUN TABLE * * OFFSETS INTO BTEMP (DEFINED IN TBGET CALL) * SPC 2 XDBFN JSB LCKDB LOCK DATA BASE IF NECESSARY DEF BUF+BFLKW LOCK WORD LDA .BDSN GET DATA SET NAME JSB DSNUM ---> DATA SET NUMBER * LDA BUF+BFNLL GET ILIST LENGTH ADA .FND1 TO CALCULATE ADDR OF IARG ARRAY STA .FND2 * JSB DBFND SET UP THE CHAIN DEF *+7 DEF BUF+BFIDB IMAGE INTERNAL DB# DEF DS# DATA SET NO. DEF D1 MODE DEF BTEMP+BTSTA STATUS .FND1 DEF BUF+BFNLS KEY ITEM NAMELIST (ILIST) .FND2 BSS 1 KEY ITEM VALUELIST (IARG) LDA BTEMP+BTSTA !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB CHECK !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! * JSB SAVRT SAVE RUN TABLE SPC 1 CLA SET MODE=0 FOR DBFND REQUEST STA LOCKM JSB LOCK LOCK/UNLOCK ENTRY AS REQUESTED SPC 1 XDBF3 CLA TO AJUST BUFFER LENGTH JMP XDBG9 HED DBPUT PROCESSOR * * INPUT BUFFER FORMAT: * * SCODE (4) RQ/CLASS#/PARM1/PARM2 * BUF[1] (1) LOCK WORD * BUF[2] (1) TMS LOCK ID (TMS DB# / DS#) * BUF[3] (1) IMAGE INTERNAL DB# * BUF[4:6] (3) SCRATCH AREA * BUF[7:13] (7) IMAGE RUN TABLE * BUF[14] (1) DBGET MODE * BUF[15:22] (8) DATA SET NAME * BUF[23] (1) NAME LIST LENGTH * BUF[24:X] (N) NAME LIST * BUF[X+1:Y] (M) VALUE LIST * * OFFSETS INTO BUF (DEFINED IN TBGET) * SPC 1 * OUTPUT BUFFER FORMAT: * * ERCOD (2) ERROR CODE/SUB # (TMS INTERNAL) * BTEMP[1:10] (10) IMAGE STATUS SPC 2 XDBPU LDA .BF02 GET DATA SET NAME JSB DSNUM ---> DATA SET NUMBER * LDA DSTYP CHECK DATA SET TYPE CPA M. IS IT MASTER? JMP XDBP1 YES, D.B. SHOULD BE LOCKED JSB LCKDB NO, DETAIL, LOCK D.B. DEF D1 FORCE LOCKING * XDBP1 LDA BUF+BFNLL RECALL # OF ITEM ADA .BF05 STA XDBP3 SET IVALU ADDR SPC 1 LDA D8 SET MODE=8 FOR DBPUT REQUEST STA LOCKM JSB LOCK UNLOCK REQUEST AS REQUESTED SPC 1 JSB DBPUT STORE DATA INTO THE DATA BASE DEF *+7 DEF BUF+BFIDB IMAGE INTERNAL DB# DEF DS# DATA SET NUMBER DEF D1 DUMMY MODE ARG DEF BTEMP+BTSTA STATUS .BF05 DEF BUF+BFNLS NAME LIST XDBP3 NOP VALUE LIST LDA BTEMP+BTSTA !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB CHECK !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! * * JSB DMPTM * DEF *+7 * DEF D6 * DEF BUF+BFNLS * DEF BUF+BFNLL * DEF ITMES * DEF D10 * DEF D1 * JSB DMPTM * DEF *+7 * DEF D6 * DEF XDBP3,I * DEF D201 * DEF ITMES * DEF D10 * DEF D1 * XDBP5 LDA LGCLA CHECK FOR LOGGING SZA JMP XDBP7 LOGGING IS USED, LOG THIS OPERATION * XDBP6 LDA D10 NO LOGGING, RETURN DIRECTLY JMP EXIT5 RETURN * XDBP7 LDA .ERCD GET ADDR OF STATUS BUFFER LDB .ERCL GET ADDR OF STATUS BUFFER TO SEND TO DCLOG MVW D12 MOVE TO DCLOG BUFFER CLB STB ERCOL SET OK STATUS IN DCLOG BUFFER LDB SCODE STB ERCOL+1 MOVE SUBROUTINE CODE TO DCLOG BUFFER * LDA SMWDS CALCULATE LENGTH OF BUFFER TO SEND TO DCLOG ADA D31 LDB ECLAS GET RUETURN CLASS JSB DBLOG LOG THIS OPERATION JMP EXIT3 CHECK FOR NEW OPERATION, DCLOG WILL HANDLE RETURN SPC 1 .BF02 DEF BUF+BFDSN HED DBUPD PROCESSOR * * INPUT BUFFER FORMAT: * * SCODE (4) RQ/CLASS#/PARM1/PARM2 * BUF[1] (1) LOCK WORD * BUF[2] (1) TMS LOCK ID (TMS DB# / DS#) * BUF[3] (1) IMAGE INTERNAL DB# * BUF[4:6] (3) SCRATCH AREA * BUF[7:13] (7) IMAGE RUN TABLE * BUF[14] (1) DBGET MODE * BUF[15:22] (8) DATA SET NAME * BUF[23] (1) NAME LIST LENGTH * BUF[24:X] (N) NAME LIST * BUF[X+1:Y] (M) VALUE LIST * * OFFSETS INTO BUF (DEFINED IN TBGET AND TBPUT CALLS) * SPC 1 * OUTPUT BUFFER FORMAT: * * ERCOD (2) ERROR CODE/SUB # (TMS INTERNAL) * BTEMP[1:10] (10) IMAGE STATUS SPC 2 XDBUP LDA .BF02 GET DATA SET NAME JSB DSNUM ---> DATA SET NUMBER * LDA D9 SET LOCK MODE TO 9 FOR DBUPD/DEDEL STA LOCKM JSB RSTRT RESTORE RUN TABLE JMP XDBU7 WRONG DATA SET ---> ERROR # 460 SPC 1 * LDA D9 SET MODE=9 FOR DBUPD JSB LOCK UNLOCK ENTRY AS REQUESTED SPC 1 LDA BUF+BFNLL RECALL # OF ITEM ADA .BF12 STA XDBU3 SET IVALU ADDR * JSB DBUPD UPDATE ITEM VALUE IN AN ENTRY DEF *+7 DEF BUF+BFIDB IMAGE INTERNAL DB# DEF DS# DATA SET NAME DEF D1 DUMMY MODE DEF BTEMP+BTSTA STATUS .BF12 DEF BUF+BFNLS NAME LIST XDBU3 NOP VALUE LIST LDA BTEMP+BTSTA !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB CHECK !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! * JMP XDBP5 TERMINATE LIKE DBPUT SPC 3 XDBU7 LDA D460 BAD RUN TABLE SAVED JMP EROR ERROR # 460 HED DBDEL PROCESSOR * * INPUT BUFFER FORMAT: * * SCODE (4) RQ/CLASS#/PARM1/PARM2 * BUF[1] (1) LOCK WORD * BUF[2] (1) TMS LOCK ID (TMS DB# / DS#) * BUF[3] (1) IMAGE INTERNAL DB# * BUF[4:6] (3) SCRATCH AREA * BUF[7:13] (7) IMAGE RUN TABLE * BUF[14] (1) DBGET MODE * BUF[15:22] (8) DATA SET NAME * * OFFSETS INTO BUF (DEFINED IN TBGET CALL) * SPC 1 * OUTPUT BUFFER FORMAT: * * ERCOD (2) ERROR CODE/SUB # (TMS INTERNAL) * BTEMP[1:10] (10) IMAGE STATUS SPC 2 XDBDE LDA .BF02 GET DATA SET NAME JSB DSNUM ---> DATA SET NUMBER * LDA D9 SET LOCK MODE TO 9 FOR DBDEL/DBUPD STA LOCKM JSB RSTRT RESTORE RUN TABLE JMP XDBU7 WRONG DATA SET ---> ERROR#460 SPC 1 * LDA D9 SET MODE=9 FOR DBDEL JSB LOCK UNLOCK ENTRY AS REQUESTED SPC 1 JSB DBDEL DELETE ENTRY IN A DATA SET DEF *+5 DEF BUF+BFIDB IMAGE INTERNAL DB# DEF DS# DATA SET NUMBER DEF D1 DUMMY MODE DEF BTEMP+BTSTA STATUS LDA BTEMP+BTSTA !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! JSB CHECK !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! * JMP XDBP5 RETURN TO USER PROGRAM HED DBINF PROCESSOR * * INPUT BUFFER FORMAT: * * SCODE (4) RQ/CLASS#/PARM1/PARM2 * BUF[1:13] (13) NOT USED * BUF[14] (1) DBINF MODE * BUF[15:22] (8) DATA SET NAME * * * OUTPUT BUFFER FORMAT: * * ERCOD (2) ERROR CODE/SUB # (TMS INTERNAL) * BTEMP[1:10] (10) STATUS * BTEMP[11:X] (N) DBINF INFORMATION * * OFFSET INTO BTEMP: * BTINF EQU 10 DBINF INFORMATION * * XDBIN JSB DBINF EXECUTE CALL DEF *+6 DEF BUF+BFIDB IMAGE INTERNAL D.B. NO. .BDSN DEF BUF+BFDSN DATA SET NO. DEF BUF+BFMOD MODE DEF BTEMP+BTSTA STATUS RETURN DEF BTEMP+BTINF INFORMATION RETURN LDA BTEMP+BTSTA GET STATUS JSB CHECK CHECK FOR ERROR * LDA BTEMP+BTSTA+1 GET NO .OF WDS TRANSFERRED ADA D10 CALCULATE NO. OF WDS TO RETURN JMP EXIT5 RETURN HED RETURN DATA BASE INFORMATION * * THIS IS A SPECIAL ENTRY POINT THAT IS CALLED BY TMPGN TO VERIFY * CERTAIN DATA-BASE INFORMATION * * INPUT BUFFER FORMAT: * * SCODE (4) RQ/0/0/0 * BUF[1:3] (3) DATA-BASE NAME * BUF[4:6] (3) LEVEL ACCESS * BUF[7] (1) SEC. CODE * BUF[8] (1) CR. NO. * * OUTPUT BUFFER FORMAT: * * PARM[1] (1) STATUS (0 OR 3) * PARM[2] (1) ACTIVE FLAG (NO. OF PROCESSES * ACCESSING D.B.) * BUF[1] (3) D.B. NAME (RETURNED IF ACTIVE) * BUF[4] (3) LEVEL ACCESS (RETURNED IF * ACTIVE) * BUF[7] (1) SEC. CODE. (RETURNED IF ACTIVE) * BUF[8] (1) CR. NO. (RETURNED IF ACTIVE) * BUF[9] (1) LOCK ON TMP COPY/LOCK ON DEMAND * FLAG * BUF[10-12] (3) LOG FILE NAME * BUF[13] (1) SEC. CODE * BUF[14] (1) CR. NO. * * XDBVF LDA .DMDL,I GET TMP COPY/DEMAND LOCK FLAG STA BUF+8 SAVE IN RETURN BUFFER * LDA .LNAM GET ADDR OF LOG FILE NAME LDB .BF09 GET ADDR OF RETURN BUFFER MVW D5 MOVE LOG FILE NAME TO RETURN BUFFER * LDA ACTIV GET ACTIVE FLAG STA PARM+1 SAVE IN RETURN BUFFER * SZA,RSS IS THIS PROGRAM ACTIVE (IS D.B. BEING ACCESSED) JMP XDBV2 NO, SKIB D.B. NAME VERIFICATION * LDA .BUF GET ADDR OF DB NAME SUPPLIED BY USER LDB .DBNM GET ADDR OF DB NAME USED BY PROGRAM CMW D8 DO NAMES MATCH? JMP XDBV2 YES, RETURN 0 ERROR CODE NOP LDA D3 NO, RETURN ERROR CODE OF 3 RSS XDBV2 CLA STA PARM SET ERROR CODE * LDA .DBNM RETURN D.B. NAME LDB .BUF MVW D8 * JSB EXEC SEND INFORMATION TO CALLER DEF *+5 DEF D14 DEF D2 DEF PARM DEF D16 * LDA ACTIV IS THIS PROG ACTIVE? SZA,RSS JSB ABORT NO, ABORT JMP EXI10 TERMINATE * .BF09 DEF BUF+9 HED !!!! SPC 2 CHECK NOP !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SZA,RSS JMP CHECK,I LDB SCODE CPB D2 GET CALL? JMP CHEC1 YES, CHECK IF ERROR 107 CPB D3 FIND CALL? JMP CHEC1 YES, CHECK IF ERROR 107 JMP SIMST NO, RETURN WITH ERROR CHEC1 CPA D107 JMP CHECK,I JMP SIMST RETURN WITH ERROR * HED UTILITY SUBROUTINE DSNUM NOP FIND DATA SET NUMBER STA DSNU3 JSB DBINF DATA SET NAME ---> DATA SET # DEF *+6 DEF BUF+BFIDB DSNU3 NOP DATA SET NAME DEF D201 MODE DEF ISTAT STATUS DEF ISINF DATA RETURN JSB CHECK OK ? DSNU7 LDA ISINF SSA CMA,INA MAKE SURE DS# IS POS STA DS# SET DATA SET NUMBER JSB DBINF DS# ---> TYPE/CAPACITY/ENTRY LENGTH DEF *+6 DEF BUF+BFIDB IMAGE INTERNAL DB# DEF DS# DATA SET NUMBER DEF D202 MODE DEF ISTAT STATUS DEF ISINF DATA RETURN JSB CHECK OK ? LDA .IST8 MOVE INFO LDB .DSTP MVW D2 ADA D3 MVW D4 * LDA ENTLN CHECK FOR ENTRY .GT. 512 WDS ADA DM513 SSA .LE. 512 ? JMP DSNUM,I YES, RETURN LDA D462 NO, ERROR JMP SIMST * .IST8 DEF ISINF+8 .DSTP DEF DSTYP DS# NOP DATA SET NUMBER DSTYP NOP DATA SET TYPE (ASCII) ENTLN NOP ENTRY LENGTH NOENT BSS 2 NO. OF ENTERIES CAPAC BSS 2 DATA SET CAPACITY ITEM# NOP KEY ITEM NUMBER ITMLN NOP ITEM LENGTH SPC 1 KYITM NOP RETREIVE KEY ITEM CHARACTERITICS JSB DBINF DS# ---> KEY ITEM # DEF *+6 DEF BUF+BFIDB DEF DS# DEF D302 MODE 302 DEF ISTAT STATUS DEF ISINF RUNTABLE JSB ERR? OK LDA ISINF GET KEY ITEM # STA KYSAV SAVE FOR FUTURE USE JSB GITLN GET ITEM LEN STA LNSAV SAVE LENGTH FOR FUTURE USE * * CALCULATE KEY ITEM VALUE OFFSET IN IMAGE BUFFER * CLA STA KYOFF SET OFFSET TO 0 * LDA LOCKM GET LOCK MODE CPA D7 KEYED READ? JMP KYIT3 YES, RETURN * JSB DBINF GET LIST OF ALL ITEMS IN THE DATA SET DEF *+6 DEF BUF+BFIDB DEF DS# DEF D104 DEF ISTAT DEF ITLST LIST RETURNED HERE JSB ERR? ERROR? * LDA BUF+BFNLS GET FIRST WORD IN NAME LIST CPA @BLNK @ CONSTRUCT? JMP NOLST YES, NO LIST SPECIFIED, CHECK ALL ITEMS ADA DM128 NO, IS IT A NUMBER LIST OR NAME LIST? STA LSTYP (NEG.-NUMBER LIST, POS.-NAME LIST) SSA JMP NULST NUMBER LIST, GO TO NUMBER LIST SECTION * * NAME LIST, PERFORM INITIALIZATION FOR OFFSET COMPUTATION * LDA BUF+BFNLL GET WORD LENGTH OF NAME LIST ALS CONVERT TO BYTE LENGTH STA BYTLN * JSB NXINI INITIALIZE NAME LIST PARSEING ROUTINE DEF *+4 DEF BUF+BFNLS DEF D1 DEF BYTLN JMP SELST * * NUMBER LIST, INITIALIZE OFFSET COMPUTATION * NULST LDA .NULS GET ADDR OF FIRST ITEM NUMBER IN NUMBER LIST STA SOURC (NUMBER LIST IS SPECIFIED BY USER) JMP SELST * * NO LIST, INITIALIZE OFFSET COMPUTAION * NOLST LDA .ITL1 GET ADDR OF FIRST ITEM (FROM LIST OF ALL ITEMS IN STA SOURC DATA SET -- ALL ITEMS MUST BE CHECKED) CCA SET LIST TYPE FLAG TO INDICATE NUMBER LIST STA LSTYP * * SEARCH ITEM LIST UNTIL KEY ITEM IS FOUND, CALCULATE OFFSET AS * SEARCH IS PERFORMED * SELST LDA LSTYP GET LIST TYPE SSA NUMBER LIST? JMP SELS1 YES, GET NUMERIC ITEM * JSB BLANC BLANC NAME DESTINATION FIRST DEF *+3 DEF ITEMN DEF D8 JSB NXPAR NAME LIST, GET ITEM NAME DEF *+4 DEF ITEMN ITEM NAME DEF DUMMY ITEM LENGTH DEF BLNCM LIST TERMINATOR - " ," JMP SELS2 * SELS1 LDA SOURC,I GET ITEM NO. STA ITEMN ISZ SOURC * SELS2 LDA .ITEN GET ADDR OF ITEM NAME/NUMBER JSB GIT#L GET ITEM NUMBER, ITEM LENGTH LDA ITEM# CPA KYSAV IS IT THE KEY ITEM? JMP KYIT3 YES, RETURN * LDA ITMLN NO, ADD ITEM LENGTH TO OFFSET ADA KYOFF STA KYOFF JMP SELST * KYIT3 LDA LNSAV GET KEY ITEM LENGTH STA ITMLN JMP KYITM,I * KYOFF BSS 1 KEY ITEM OFFSET BYTLN BSS 1 BYTE LENGTH OF NAME/NUMBER LIST LSTYP BSS 1 LIST TYPE (NEG - NUMBER, POS - NAME) KYSAV BSS 1 TEMPORARY STORAGE FOR KEY ITEM LNSAV BSS 1 TEMPORARY STORAGE FOR KEY ITEM LENGTH SOURC BSS 1 DUMMY BSS 1 BLNCM ASC 1, , " ," @BLNK ASC 1,@ "@ " .NULS DEF BUF+BFNLS+1 NUMBER LIST ADDR .ITL1 DEF ITLST+1 ADDR OF LIST OF ALL ITEMS IN DATA SET .ITEN DEF ITEMN SPC 1 GIT#L NOP GET ITEM # & LEN FROM ITEM NAME STA GTM#3 SET ITEM NAME ADDR LDA A,I GET FIRST CHAR. OR NUM. STA ISINF ADA DM256 IS IT ALREADY SSA A NUMBER ? JMP GTM#7 YES, SKIP THE DBINF JSB DBINF ITEM NAME ---> ITEM # DEF *+6 DEF BUF+BFIDB IMAGE INTERNAL DB# GTM#3 NOP ITEM NAME DEF D101 MODE DEF ISTAT STATUS DEF ISINF DATA RETURN JSB ERR? OK ? GTM#7 LDA ISINF GET ITEM # SSA CMA,INA MAKE SURE IT IS POS JSB GITLN RETREIVE ITEM LENGTH JMP GIT#L,I * SPC 1 GITLN NOP GET ITEM LENGTH STA ITEM# SAVE ITEM # JSB DBINF ITEM # ---> ITEM LENGTH DEF *+6 DEF BUF+BFIDB IMAGE INTERNAL DB# DEF ITEM# ITEM NUMBER DEF D102 MODE 102 DEF ISTAT STATUS DEF ISINF INFORMATION BUFFER JSB ERR? OK ? LDA ISINF+9 GET ITEM LENGTH MPY ISINF+10 MPY BY NO OF SUB ITEMS * LDB ISINF+8 CHECK FOR BYTE COUNT OR WORD COUNT CLE CPB X. (ASC 1,X) ERA BYTE COUNT, DIVIDE BY 2 SEZ REMAINDER? INA YES, ALLOCATE ONE MORE WORD STA ITMLN JMP GITLN,I SPC 2 SAVRT NOP SAVE RUN TABLE INFORMATION LDA DSTYP CHECK IF DETAIL OR MASTER DS CPA D. JMP SAVR2 DETAIL, USE DBINF CALL TO SAVE RUNTABLE * DLD BTEMP+BTSTA+2 MASTER DATA SET, SAVE RUN TABLE INFO DST BTEMP+BTSCR+1 RETURNED IN ISTAT DST BTEMP+BTIRT+RTCRR CLA CLB DST BTEMP+BTIRT+RTPRR DST BTEMP+BTIRT+RTNXR STA BTEMP+BTIRT+RTCCP JMP SAVR4 * SAVR2 JSB DBINF SAVE RUN TABLE DEF *+6 DEF BUF+BFIDB IMAGE INTERNAL DB# DEF DS# DATA SET # DEF D401 MODE 401 DEF ISTAT STATUS DEF BTEMP+BTIRT RUN TABLE ADDR JSB ERR? OK ? CLA STA BTEMP+BTSCR+1 STA BTEMP+BTSCR+2 * SAVR4 LDA DS# SAVE DATA-SET # STA BTEMP+BTSCR JMP SAVRT,I * SPC 1 RSTRT NOP RESTORE RUN TABLE LDA BUF+BFSCR RECALL DATA SET # SAVED CPA DS# SAME DATA SET ? RSS YES, CHECK DATA SET TYPE JMP RSTR0 NO, CHECK TYPE OF CALL * LDA DSTYP CHECK IF MASTER OR DETAIL DATA SET CPA M. JMP RSTR1 MASTER DATA SET, USE DIRECTED READ TO RESTORE POSITION LDA LOCKM DETAIL DATA SET, CHECK TYPE OF CALL CPA D2 FORWARD SERIAL READ? JMP RSTR1 YES, USE DIRECTED READ TO RESTORE POSITION CPA D3 BACKWARD SERIAL READ? JMP RSTR1 YES, USE DIRECTED READ TO RESTORE POSITION JMP RSTR2 NOT SERIAL READ, USE DBINF CALL TO RESTORE POSITION * RSTR0 LDA LOCKM RECALL LOCK MODE CPA D2 FORWARD SERIAL READ? RSS YES CPA D3 NO, BACKWARD SERIAL READ RSS YES JMP RSTRT,I NO, ERROR * CLA MUST BE FIRST SERIAL READ ON THIS DATA SET STA BUF+BFIRT+RTCRR SET CURRENT RECORD NO. TO 0 NOP AND RESTORE POSTITION * RSTR1 JSB DBGET MASTER DATA SET, USE DIRECTED READ TO RESTORE POS DEF *+8 DEF BUF+BFIDB IMAGE INTERNAL DB# DEF DS# DEF D4 DEF ISTAT DEF D0 DO NOT RETURN ANY DATA DEF BTEMP+BTDAT DEF BUF+BFIRT+RTCRR JMP RSTR4 * RSTR2 JSB DBINF RESTORE THE POSITION DEF *+6 DEF BUF+BFIDB IMAGE INTERNAL DB# DEF DS# DATA SET NO. DEF D402 MODE 402 DEF ISTAT STATUS RETURN DEF BUF+BFIRT RUNTABLE * RSTR4 JSB ERR? OK ? LDA DS# RESTORE INITIAL MAIL BOX BUFFER STA BUF+BFSCR FOR LOCK ALGORITM ! ISZ RSTRT RETURN OK (P+2) JMP RSTRT,I SPC 1 D. ASC 1,D M. ASC 1,M X. ASC 1,X SPC 2 PSAM NOP PUT MAIL BOX INTO SAM DST PARM1 SET PARAMETERS LDA PSAM,I GET BUFFER ADDR STA PSAM2 ISZ PSAM JSB EXEC CALL I/O WRITE/READ DEF *+8 DEF NAB20 WRITE/READ REQUEST DEF D0 DUMMY LU PSAM2 NOP BUFFER ADDR DEF PSAM,I BUFFER LENGTH DEF PARM1 DEF PARM2 DEF CLAS# CALL I/O WORD JMP PSER ERROR SZA JMP PSER * JSB DMPTM * DEF *+7 * DEF D6 * DEF PSAM2,I * DEF PSAM,I * DEF MES2 * DEF D10 * DEF D1 ISZ PSAM SET RETURN ADDR JMP PSAM,I * PSER DST PSME1 JSB OUTMS OUTPUT ERROR MESSAGE DEF PSMES DEF D32 JMP XDBC0 CLOSE D.B., TERMINATE PROGRAM * NAB20 OCT 100024 * PSMES BSS 5 ASC 8, CLASS IO ERROR PSME1 BSS 2 ASC 17,, TERMINATING TO PROTECT DATA BASE SPC 2 GSAM NOP IOR BIT15 SET NO-WAIT BIT STA TEMP JSB EXEC CLASS I/O GET DEF *+7 DEF NAB21 GET NO-ABORT DEF TEMP CLASS I/O WORD DEF SCODE BUFFER ADDR DEF RBULN BUFFER LENGTH DEF PARM1 DEF PARM2 CCA ABORT RETURN, NOTHING HAS BEEN GET STA SAVA STB SMWDS * JSB DMPTM * DEF *+7 * DEF D6 * DEF SCODE * DEF RBULN * DEF MES1 * DEF D10 * DEF D1 LDA SAVA JMP GSAM,I RETURN OK * NAB19 OCT 100023 NAB21 OCT 100025 SMWDS BSS 1 NO. OF WORDS RECEIVED BY CLASS IO GET SAVA BSS 1 SPC 2 GTCLW NOP ALLOCATED A CLASS I/O CLA WHEN OWNER CLASS I/O WILL BE RELEASE STA GTCLX THIS SUBROUTINE WILL BE REPLACED JSB EXEC BY THE SYSTEM ROUTINE. DEF *+5 THE CLASS MUST BE OWNED BY THE CALLING PROGRAM DEF NAB19 SO THE ABORT PROCEDURE WILL BE EASIER DEF D0 I.E.: THE PROGRAM WILL BE ABORTED DEF * AND HOPFULLY THE CLASS I/O RELEASED. DEF GTCLX JMP PSER LDA GTCLX IOR B20K SET BIT13 'DO NOT DEALLOACATE' STA GTCLX JSB EXEC DEF *+5 DEF NAB21 DEF GTCLX DEF * DEF D0 JMP PSER LDA GTCLX JMP GTCLW,I * GTCLX NOP SPC 1 KLCLX NOP STA KLCL3 SAVE CLASS I/O WORD JSB KLCLS RELEASE THE CLASS DEF *+2 DEF KLCL3 JMP KLCLX,I * KLCL3 NOP SPC 3 DBLOG NOP LOG DATABASE OPERATIONS STA LGCNT SAVE WORD COUNT STB RTNCL SAVE RETURN CLASS JSB WRLOG LOG DATA DEF SCODL BUFFER DEF LGCNT DEF LGCLA DCLOG CLASS DEF RTNCL RETURN CLASS DEF PARM SPECIAL PARAMETER #1 DEF PARM+1 SPECIAL PARAMETER #2 JSB .ERR? CHECK FOR ERROR JMP DBLOG,I NO ERROR, RETURN * LGCNT NOP WORD COUNT RTNCL NOP RETURN CLASS SPC 2 LCKDB NOP LOCK D.B. IF DEMAND LOCKING LDA DMDLK GET DEMAND LOCK FLAG LDB LCKDB,I GET LOCK WORD LDB B,I ISZ LCKDB INCREMENT RETURN ADDR SLA,RSS JMP LCKDB,I NO DEMAND LOCKING RETURN SLB,RSS JMP LCKDB,I NO LOCKING REQUESTED, RETURN LDA LKFLG IS DATA BASE ALREADY LOCKED? SZA NO, LOCK D.B. JMP LCKDB,I YES, RETURN * JSB DBLCK NO, LOCK D.B. DEF *+5 DEF BUF+BFIDB DEF NCHRS DUMMY DEF D2 NO WAIT DEF ISTAT LDA ISTAT CHECK STATUS SZA JMP LCKD2 ERROR!!! CLA,INA STA LKFLG SET LOCK FLAG TO INDICATE THAT THE D.B. IS LOCKED JMP LCKDB,I OK, RETURN * LCKD2 LDA D400 LOCK ERROR, #400 JMP SIMST RETURN * LKTOT OCT 0 TOTAL NO. OF RECS LOCKED LKFLG OCT 0 D.B. LOCK INDICATOR SPC 2 OUTMS NOP OUTPUT ERROR MESSAGE LDB OUTMS,I GET MESSAGE ADDR ISZ OUTMS INCREMENT RETURN ADDR LDA OUTMS,I GET WORD COUNT ADDR STA OUTM2 STB OUTM1 LDA SPCSL GET " /" STA B,I INB LDA .ILIS GET ADDR OF PROGRAM NAME MVW D3 MOVE TO MESSAGE BUFFER LDA COLSP GET ": " STA B,I JSB WRTTY OUTPUT MESSAGE OUTM1 NOP MESSAGE BUFFER OUTM2 NOP WORD COUNT ISZ OUTMS INCREMENT RETURN ADDR JMP OUTMS,I RETURN * SPCSL ASC 1, / COLSP ASC 1,: SPC 2 WRTTY NOP WRITE TO TTY LDA WRTTY,I GET MESSAGE BUFFER ADDR ISZ WRTTY INCREMENT RETURN ADDR LDB WRTTY,I GET WORD COUNT ISZ WRTTY INCREMENT RETURN ADDR DST WRTT1 SAVE MESSAGE BUFFER AND WORD COUNT JSB EXEC OUTPUT MESSAGE DEF *+5 DEF D2 DEF LU WRTT1 BSS 2 JMP WRTTY,I RETURN * LU BSS 1 HED *** LOCKING MECHANISM *** * THE FORMAT OF THE BUFFER USED IS AS FOLLOWS: * SPC 2 * * 15 8 7 6 5 0 * ADDRESS ******************************** * L * PIDX * * DS # *<--- LOCTB (PT) * ! O * RECORD # (DOUBLE INT) * * ! C * * * ! K ******************************** * ! --->* PIDX *W * DS # * [W] BIT IS THE * ! ! * RECORD # (DOUBLE INT) * 'SOMEONE WAITING' * ! ! * * * ! T ! ******************************** * ! A ! * .... .... * FREE ENTRY * ! B ! * 0 * * ! L ! * 0 * * ! + E ! ******************************** [N] BIT IS THE * ! ! * .... * N* .... * 'NON-EXCLUSIVE * ! ! * .... .... * LOCK FLAG' * ! ! * .... .... * * ! ! ******************************** * ! ! * *<--- LOCTE * ! ! * * * ! ! . . * \ ! / ! . . * \!/ ! * . ! * ! * ! . . * P ! * *<--- PROTE * R ! ******************************** * O ! *1* LINK IN RESTART QUEUE * PROCESS IN * C ! * CLASS I/O WORD * RESTART QUEUE * E ! *X* # OF RECORDS LOCKED * * S ! ******************************** * S ----+ POINTER TO LOCK TABLE * PROCESS WAITING * * CLASS I/O WORD * ON A RECORD * D *X* # OF RECORDS LOCKED * * I ******************************** * R * 0 * * E * 0 * * C *X* # OF RECORDS LOCKED *<--- PROTB (PIDPT) * T ******************************** * O * R [X] FLAG SET WHEN PID IS ALLOCATED * Y AND CLEAR WHEN PID IS DEALLOACTED * * SPC 2 * PIDX IS THE PROCESS ID INDEX IN PROCESS DIRECTORY * * PIDPT IS THE PROCESS ID POINTER INTO THE PROCESS DIRECTORY SKP * LOCK PERFORM ALL LOCKING/UNLOCKING FUNCTION * * CALLING SEQUENCE: * LDA MODE (IDENTIFY IMAGE FUNCTION PERFORMED) * JSB LOCK * RETURN ONLY IF FUNCTION IS CORRECTLY PERFORMED. * * IF AN ERROR IS FOUND OR IF THE PROCESS NEED TO BE SUSPENDED * EXIT IS DONE DIRECTLY. (NO RETURN TO CALLING PRG) SPC 1 LOCK NOP LOCK1 JMP LOCK,I THIS LINE IS NOP'ED FOR OPEN MODE =1 * STA LOCKM SAVE MODE * LDA LOCKW GET FUNCTION TO BE PERFORMED AND D3 MASK BIT 0 & 1 - LOCK & UNLCK BIT SZA,RSS ANY FUNCTION REQUESTED ? JMP LOCK,I NO, RETURN TO CALLER * LDA LOCKW RECALL LOCK WORD TO AND D4 SET THE LOCK EXCLUSIVE FLAG ALF FROM BIT2 TO BIT6 STA LCKXF SET LOCK EXCLUSIVE FLAG SPC 1 JSB SPIDD ACCESS PROCESS ID DIRECTORY RSS PID WAS NOT DEFINED, AND UNLOCK IS REQUESTED ! JMP LCK03 PID IS OK, CONTINUE THE LOCKING/UNLOCKING PROCESS SPC 1 LDA LOCKM LOCKID WAS NOT DEFINED, CHECK THE RQ ADA DM8 SSA DBFND, DBGET? (MODE 0-7) JMP LOCK,I YES, RETURN, NO ERROR SZA DBPUT? (MODE 8) JMP LCKE5 NO, IMAGE ERROR # 405 LDA DSTYP YES, PUT, RECALL THE DATA-SET TYPE CPA D. PUT IN A DETAIL DATA-SET ? JMP LOCK,I YES, IT IS OK, FORGET THE UNLOCK JMP LCKE5 NO, PUT IN A MASTER, THE ENTRY MUST HAVE BEEN LOCKED SPC 1 LCK03 CLA INIT ITEM LENGTH TO ZERO STA ITMLN USED ONLY IN CASE OF SUSPEND * LDB BTEMP+BTSTA RECALL USER'S CALL IMAGE STATUS LDA LOCKM RECALL MODE CPA D7 KEYED READ ? JMP LCK40 YES, PERFORM KEYED CALL LOCK CPA D8 NO, DBPUT REQUEST ? JMP LCK50 YES, CPA D9 NO, DBUPD/DBDEL REQUEST ? JMP LCK50 YES SZB IMAGE ERROR ? JMP LOCK,I YES, FORGET THE LOCK SZA,RSS DBFND CALL ? JMP LCK13 YES, LOCK NEXT RECORD ONLY DLD BTEMP+BTIRT+RTCRR NO, LOCK CURRENT RECORD DST REC# JSB LKX00 ACCESS LOCK TABLE NOP NOP LDA LOCKM RECALL MODE CPA D5 FORWARD CHAINED READ REQUEST JMP LCK15 YES, CHECK FOR "LOCK AHEAD" CPA D6 BACKWARD CHAINED READ REQUEST JMP LCK15 YES, CHECK FOR "LOCK AHEAD" JMP LOCK,I NO, EXIT * LCK13 LDA .BF12 RECALL ITEM NAME ADDR TO RETREIVE JSB GIT#L ITEM LENGTH (USED IN CASE OF SUSP.) * LCK15 LDA LOCKW GET LOCK WORD AND D8 ISOLATE "LOCK NEXT" BIT (3) SZA,RSS LOCK NEXT RECORD? JMP LCK17 NO, CHECK FOR "LOCK PREV" DLD BTEMP+BTIRT+RTNXR GET NEXT REC NO. DST REC# IOR B DOUBLE WD CHECK FOR 0 SZA,RSS NEXT REC EXIST? JMP LCK17 NO, SKIP LOCK JSB LKX00 YES, LOCK IT NOP NOP * LCK17 LDA LOCKW GET LOCK WORD AND D16 ISOLATE "LOCK PREV" BIT (4) SZA,RSS LOCK PREV RECORD? JMP LOCK,I NO, RETURN DLD BTEMP+BTIRT+RTPRR GET PREV REC NO. DST REC# IOR B DOUBLE WD CHECK FOR 0 SZA,RSS PREV REC EXIST? JMP LOCK,I NO, SKIP LOCK, RETURN JSB LKX00 YES, LOCK IT NOP NOP JMP LOCK,I YES, RETURN SPC 1 LCK40 LDA .GET2 GET KEY VALUE ADDR LDX BTEMP+BTSCR+1 GET REC# OF ITEM LDY BTEMP+BTSCR+2 SZB,RSS USER'S IMAGE STATUS OK? JMP LCK57 YES, PROCESS LOCK CPB D107 NO, IS IT ENTRY NOT THERE ? JMP LCK51 YES, PROCESS LOCK IN ADVANCE JMP LOCK,I NO, FORGET THE LOCK SPC 1 LCK50 LDB DSTYP GET THE DATA-SET TYPE CPB D. DETAIL DATA-SET ? JMP LCK60 YES, CHECK IMAGE CALL LDX BUF+BFSCR+1 NO, MASTER DATA SET, RECALL PRIMARY REC # LDY BUF+BFSCR+2 CPA D9 DBUPD, DBDEL REQUEST ? JMP LCK54 YES, REC# WAS IN THE SAVED RUN TBL LDA XDBP3 NO, COMPUTE THE REC# FROM THE KEY VALUE * LCK51 STA LCK53 SET KEY VALU ADDR FOR HASHING ROUTINE JSB KYITM RETREIVE KEY ITEM CHARACTERISTIC LDA KYOFF GET KEY ITEM OFFSET ADA LCK53 CALCULATE KEY ITEM ADDR STA LCK53 JSB HASH RETREIVE RECORD NUMBER OF DEF *+3 PRIMARY ENTRY FOR THAT KEY VALUE DEF ITMLN KEY ITEM LENGTH LCK53 NOP KEY ITEM VALUE * DST DBLWD RECORD NO. CALCULATION, MAY NOT BE CORRECT JSB .DDI DEF CAPAC JSB .DMP DEF CAPAC JSB .DSBR DEF DBLWD JSB .DIN DST BTEMP+BTSCR+1 SAVE REC# DST BTEMP+BTIRT+RTCRR CAX CBY CCA SET FLAG TO INDICATE THAT RECORD IS NON-EXISTENT STA BTEMP+BTIRT+RTCCP JMP LCK57 * LCK54 LDB BUF+BFIRT+RTCCP GET NON-EXISTENT RECORD INDICATOR SSB DBUPD, DBDEL, DOES RECORD EXIST? JMP LCE14 NO, ERROR 414 * LCK57 STX REC# RECORD NUMBER OF PRIMARY ENTRY STY REC#+1 JSB LKX00 ACCESS LOCK TABLE JMP LCK58 RECORD NOT LOCKED BY CALLING PROCESS JMP LCK58 RECORD IS LOCKED IN SHARED MODE JMP LOCK,I AND RETURN * LCK58 LDA LOCKM GET LOCK MODE CPA D8 DBPUT? JMP LCKE5 YES, ERROR 405, REC SHARED OR NOT LOCKED CPA D9 DBUPD, DBDEL? JMP LCKE5 YES, ERROR 405, REC SHARED OR NOT LOCKED JMP LOCK,I SPC 1 LCK60 LDX BUF+BFIRT DETAIL DATA SET, RECALL REC # FROM SAVED RUN TBL LDY BUF+BFIRT+1 CPA D9 DBUPD,DBDEL REQUEST ? JMP LCK57 YES, PERFORM THE LOCK JMP LOCK,I DBPUT, EXIT * DBLWD BSS 2 TEMPORARY DOUBLE INTEGER STORAGE SPC 2 * ACCESS OF THE LOCK TABLE, AND UPDATE OF THE * LOCK TABLE TO REFLECT THE LOCK/UNLOCK FUNCTION. * * PRIOR CALLING THIS FUNCTION, SET UP THE FOLLOWING: * PIDPT, REC#, DS#, PIDX * * RETURN POINTS: * * P+1 - RECORD NOT LOCKED, LOCK NOT * REQUESTED * P+2 - SHARED LOCK * P+3 - NORMAL RETURN, FUNCTION * EXECUTED SPC 1 LKX00 NOP * JSB SLTBL SEARCH IN LOCK TABLE JMP LKX50 RECORD IS NOT LOCKED JMP LKX70 RECORD IS LOCKED LDA LOCKW RECORD IS LOCKED BY THE CALLING PROCESS ISZ LKX00 ISZ LKX00 * SLA,RSS LOCK REQUEST ? JMP LKX30 NO, MUST BE UNLOCK THEN * LDA PT,I YES, IT DOES NOT MATTER IF A UNLCK AND BIT6 IS ALSO SPECIFIED, VERIFY THAT LDB LCKXF A NON-EXCULSIVE LOCK IS NOT TRANSFORMED XOR B INTO A EXCLUSIF LOCK SZA SAME KIND ? SZB NO, NEW LOCK NON-EXCLUSIVE ? JMP LKX00,I YES, RETURN BUT DO NOT CHANGE THE KIND JMP LCKE6 NO, ERROR: TRY TO NON-EXCLUS. --> EXCLUSI. * LKX30 LDA PT,I GET TYPE OF LOCK AND BIT6 CHECK IF NON-EXCLUSIVE SZA,RSS JMP LKX31 EXCLUSIVE, PERFORM UNLOCK LDA LOCKM NON-EX, CHECK TYPE OF CALL CPA D8 DBPUT? JMP LCKE5 YES, ERROR, CANNOT PUT WITH NON-EX LOCK CPA D9 DBUPD/DBDEL? JMP LCKE5 YES, ERROR, CANNOT UPD/DEL WITH NON-EX LOCK LKX31 LDA PT UNLOCK THE RECORD ADA D3 INITIALIZE THE BEGINING STA PT0 OF THE LOCK TABLE JSB UNLCK AND PERFORM THE UNLOCK FUNCTION JMP LKX00,I AND EXIT SPC 1 * ADD AN ENTRY IN THE LOCK TABLE. * LKX50 LDA LOCKW RECALL LOCK WORD SLA,RSS LOCK REQUESTED ? JMP LKX00,I NO, RETURN TO CALLER LKX52 JSB PACK YES, PACK LOCK TABLE IF NECESSARY LDA PIDX ADD AN ENTRY IN THE LOCK TABLE ALF,ALF IOR DS# MERGE PID INDEX WITH DATA SET # IOR LCKXF MERGE EXCLUSIVE/NON-EXCLUSIVE FLAG LDB PTHOL GET ADDR OF LAST EMPTY ENTRY STA B,I TO STORE IT INTO THE TABLE INB LDA .REC# SAVE ALSO RECORD NUMBER MVW D2 INTO THE TABLE LDA PTHOL WAS IT AT THE CPA LOCTE END OF THE LOCK TABLE ? STB LOCTE YES, UPDATE END OF LOCK TABLE ISZ PIDPT,I INCREMENT # OF RECORD LOCKED ISZ LKTOT INCREMENT TOTAL NO. OF RECS LOCKED JMP LKX00,I AND RETURN TO CALLER SPC 2 * SUSPEND CALLING PROCESS IF IT IS A LOCK REQUEST * WITH WAIT OPTION AND NO DEADLOCK OCCURS. * LKX70 ISZ LKX00 LDB LOCKW RECALL LOCK WORD RBR,SLB UNLOCK REQUESTED ? JMP LCKE3 YES, ERROR # 403 * LDA LCKXF IS EXCLUSIVE LOCK SZA,RSS REQUESTED ? JMP LKX71 YES, SUSPEND THE PROCESS LDA PT,I NO, HOW IS THE RECORD LOCKED AND BIT6 SZA,RSS RECORD LOCKED EXCLUSIVELY ? JMP LKX71 YES, SO SUSPEND THE PROCESS JMP LKX52 NON-EXCLUSIVE LOCK, GO LOCK RECORD * *LKX75 LDA PT NO, MAKE SURE THAT RECORD IS NOT * ADA D3 ALREADY OWNED BY THE CARRENT PROCESS * JSB SLTB0 SCAN THE END OF THE LOCK TABLE * JMP LKX52 END OF TABLE, THIS REC. CAN BE LOCKED (NON-EXCLUS.) * LDA PT,I AN OTHER ENTRY WHICH LOCK THE SAME * AND BIT6 RECORD HAS BEEN FOUND, VERIFY THAT * SZA,RSS IT IS LOCKED WITH NON-EXCLUSIVE OPTION * HLT 13B EXCLUSIVE LOCK !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! * LDA PT,I RECALL FIRST WORD IN THE LOCK TBALE * ALF,ALF TO RETEIVE THE OWNER OF THAT ENTRY * AND B377 GET PID * CPA PIDX IS THE OWNER THE CURRENT PROCESS ? * JMP LKX00,I YES, ALREADY OWNED, FORGET THE REQUEST * JMP LKX75 NO, CONTINUE SCANNING UP TO THE END OF TABLE * LKX71 LDA D400 NO WAIT ERROR = 400 LDB LOCKW RECAL LOCK WORD SSB NO WAIT REQUEST ? JMP SIMST YES, RETURN ERROR# 400 TO USER IN IMAGE ST * LDA PT,I RETREIVE IF THERE IS A DEADLOCK CONDITION LKX72 ALF,ALF ISOLATE OWNER OF THE RECORD AND B377 CPA PIDX IS OWNER IS THE CALLING PROCESS ? (ALWAYS FAIL 1ST TIME) JMP LCKE1 YES, DEADLOCK CONDITION, ERROR # 401 CMA,INA NO, CHECK IF THE OWNER IS SUSPENDED INA MPY D3 RETREIVE POINTER ON A RECORD FROM ADA PROTB THE PROCESS ID DIRECTORY ADA DM2 TO ACCESS POINTER LDB A,I GET POINTER TO RECORD LOCK TABLE LDA B,I GET RECORD OWNER-DS# FROM LOCK TABLE SZB,RSS PROCESS SUSPENDED ? JMP LKX74 NO, PROCEED WITH THE SUSPEND SSB,RSS CHECK IF IN RESTART QUEUE, IF YES SKIP JMP LKX72 NOT RST. QUEUE, IT IS SUSP., TRACK DOWN ONE MORE * LKX74 LDA SMWDS RECALL ITEM LENGTH TO SAVE STA LKX77 SET BUFFER LEN JSB PSAM SEND BUFFER INTO SAM DEF SCODE BUFFER ADDR LKX77 NOP BUFFER LENGTH * LDA CLAS# OK, SUSPEND THE CALLING PROCESS LDB PIDPT SAVE CLASS I/O INTO THE PID DIRECTORY ADB DM1 STA B,I ADB DM1 UPDATE POINTER LDA PT AND SAVE POINTER TO RECORD LOCK TABLE STA B,I INTO THE DIRECTORY LDA PT,I RECALL THE RECORD LOCK ENTRY IOR BIT7 TO SET 'SOMEONE IS WAITING' BIT STA PT,I JMP EXIT3 EXIT WITHOUT DOING THE IMAGE CALL SPC 2 LCKE3 LDA D403 ERROR # 403, UNLCK REC. LOCKED BY AN OTHER JMP SIMST GO SET IMAGE STATUS * LCKE5 LDA D405 ERROR # 405, PUT IN A MASTER WITHOUT LOCK ID JMP SIMST * LCKE6 LDA D406 ERROR # 406, GO FROM NON-EXCLUSIVE TO JMP SIMST EXCLUSIVE LOCK IN THE SAME PROCESS * LCKE1 LDA D401 DEADLOCK ERROR = 401 JMP SIMST GO SET IMAGE STATUS * LCE14 LDA D414 RECORD DOEST NOT EXIST, ERROR 414 JMP SIMST * LCE10 LDA D410 RECORD EXISTS, ERROR 410 JMP SIMST SPC 1 REC# BSS 2 .REC# DEF REC# LCKXF NOP EXCLUSIVE LOCK FLAG IN BIT 6 SKP * UNLOCK: CLEAR AN ENTRY IN THE LOCK TABLE * OR RESTART A WAITING PROCESS AND GIVE THAT * ENTRY TO THIS WAITING PROCESS. * * THE ADDRESS OF THE ENTRY CLEARED OR PASSED IS IN PT * * NOTE: WHEN A NON-ECLUSIVE LOCK IS RESTARTED AFTER BEING SUSPSENDED * IT BECOMES A EXCLUSIVE LOCK REQUEST, ALSO ONLY ONE PROCESS IS * RESTARTED AT A TIME EVEN IF MORE THAN ONE NON-ECLUSIVE LOCK * REQUEST IS SUSPENDED (WHEN A PROCESS IS RESTARTED NO CHECK IS * MADE FOR EXCLUSIVE/NON-EXCLUSIVE LOCK). * THOSE ARE NOT ACTUALLY BUGS BUT CAN BE IMPROVE IN THE FUTURE! * UNLCK NOP LDA PT,I RECALL THE ENTRY FROM THE LOCK TABLE ALF,ALF ROTATE TO GET 'SOMEONE IS WAITING' BIT SSA,RSS SOMEONE WAITING ? JMP UNLC8 NO, CLEAR ENTRY * RAL CHECK 'NON-EXCLUSIVE LOCK' BIT SSA JMP ULC72 NO-EXCL., VERIFY THAT NO OTHER ENTRY EXIST * ULC40 CLA EXCLUSIVE LOCK, SEARCH WHICH PROCESS WAIT STA TEMP INIT # OF WAITERS COUNTER LDA PROTE SEARCH WAITERS ULC42 JSB SRCWT IN THE PROCESS ID DIRECTORY JMP ULC45 END OF DIRECTORY RETURN STA TEMP1 SAVE DIRECTORY ADDR OF THE WAITER ISZ TEMP COUNT THE # OF WAITER JMP ULC42 AND LOOP UNTIL END ULC45 LDA TEMP GET # OF WAITERS SZA,RSS MUST BE AT LEAST ONE JMP UNLE1 ERROR, DATA STRUCTURES CORRUPT!!!!!!!!!!!!!!!!!! SPC 1 * PASSES THIS ENTRY TO ONE OF THE WAITERS AND * RESTART IT. * LDB RSTAR YES, RESTART WAITERS, GET RESTART ULC52 LDA B,I QUEUE HEAD, GET NEXT ELEMENT OF THE QUEUE SZA,RSS END OF QUEUE ? JMP ULC54 YES, ADD THE NEW ONE RAL,CLE,ERA NO, CLEAR BIT 15 AND LDB A GO GET NEXT ONE JMP ULC52 * ULC54 STA TEMP1,I SET NEW END OF QUEUE LDA TEMP1 SET BIT15 IN THE ADDR TO INDICATE IOR BIT15 LINK INTO THE RESTART QUEUE INSTEAD OF STA B,I POINTER TO LOCK TABLE. LDB TEMP1 RECALL ADDR INTO THE PROCESS DIRECTORY ADB D2 TO ACCESS THE # OF RECORD LOCKED ISZ B,I INCREMENT # OF RECORDS LOCKED JSB SPIDX COMPUTE THE PIDX OF THE WAITER ALF,ALF ROTATE IT INTO UPPER BYTE STA TEMP1 AND SAVE IT LDA PT,I GIVE THIS RECORD TO THE WAITER AND MASK1 CLEAR OLD PIDX AND 'NON-EXCLUS. LOCK' FLAG IOR TEMP1 AND PUT THE NEW ONE LDB TEMP RECALL # OF WAITERS CPB D1 ONLY ONE WAITERS ? AND NBIT7 YES, CLEAR BIT [W] STA PT,I AND STORE IT BACK JMP UNLC9 SPC 1 * NO-EXCLUSIVE LOCKED RECORD IS RELEASED, * DO NOT RESTART THE WAITER, BUT SET WAIT BIT * IN ONE OF THOSE IDENTICAL ENTRY IN THE LOCK TABLE * AND MAKE ALL WAITERS WAIT ON THAT ENTRY * ULC72 LDB PT RE-INIT RC# & DS# ( FOR THE TBULK COMMAND LDA B,I AND B77 STA DS# INB DLD B,I DST REC# * LDA PT SAVE CURRENT POINTER IN THE LOCK TABLE STA TEMP INA AND CLEAR TEMPORARILY THIS ENTRY CLB STB A,I TO MAKE SURE AN OTHER ONE IS FOUND INA STB A,I * LDA PT0 RECALL THE STARTING OF THE LOCK TABLE JSB SLTB0 AND SCAN THE END OF THE LOCK TABLE JMP ULC75 NO OTHER ENTRY LIKE THIS, RESTART WAITER LDB PT AN OTHER ENTRY IS FOUND, RESTORE PT LDA TEMP AND SAVE THE NEW ENTRY POINTER STA PT INTO TEMP STB TEMP LDA B,I IOR BIT7 SET THE "WAIT BIT" INTO THAT ENTRY STA B,I * LDA PROTE MAKE ALL THE WAITERS ULC73 JSB SRCWT WAIT ON THIS NEW ENTRY JMP UNLC8 NO MORE WAITERS, CLEAR THE ENTRY IN LOCK TABLE LDB TEMP RECALL LOCK TABLE ENTRY ADDR STB A,I AND STORE IT INTO THE DIRECTORY JMP ULC73 LOOP UNTIL END OF DIRECTORY * ULC75 LDB TEMP SINCE NO IDENTICAL ENTRY EXIST IN THE STB PT LOCK TABLE, RESTORE THE ENTRY AND INB RESTART THE WAITING PROCESS LDA .REC# MVW D2 JMP ULC40 RESTART THE WAITER SPC 1 * DELETE AN ENTRY IN THE LOCK TABLE. * UNLC8 CLA LDB PT CLEAR THE ENTRY IN THE LOCK TABLE STA B,I INB STA B,I INB STA B,I * UNLC9 LDA PIDPT,I ADA DM1 DECREMENT # OF RECORD OWNED BY THE STA PIDPT,I CURRENT PROCESS LDA LKTOT DECREMENT TOTAL # OF RECS LOCKED SZA,RSS IS NO. OF RECS LOCKED ZERO? JMP UNLCK,I YES, RETURN ADA DM1 NO, DECREMENT STA LKTOT JMP UNLCK,I AND EXIT SPC 2 SRCWT NOP SEARCH THE WAITERS INTO THE PROCESS CPA PROTE ID DIRECTORY, FIRST CALL ? RSS YES, DO NOT BUMP POINTER SRCW3 ADA D2 NO, BUMP POINTER CPA PROTB END OF DIRECTORY ? JMP SRCWT,I YES, RETURN P+1 INA NO, CHECK THIS ENTRY LDB A,I GET POINTER TO LOCK TABLE ENTRY CPB PT WAITING ON THIS ENTRY ? RSS YES, RETURN P+2 JMP SRCW3 NO, CONTINUE ISZ SRCWT JMP SRCWT,I SPC 5 * SEARCH IN THE PROCESS ID DIRECTORY * * CALLING SEQUENCE: * JSB SPIDD * RETURN P+1 - UNLOCK REQUEST AND NO LOCK ID IS DEFINED !! * RETURN P+2 - OLD OR NEW PID * * ON RETURN P+2, PIDPT & PIDX ARE SET UP SPC 1 SPIDD NOP SEARCH IN PROCESS ID DIRECTORY LDA LCKID RECALL LOCKID WORD (DB#-PID) FROM AND PIDMS USER BUFFER AND ISOLATE PID STA PIDX SET PID SZA IS PID DEFINED ? JMP SPID4 YES, SETUP PIDPT LDA LOCKW NO, RECALL LOCK WORD RAR,SLA UNLOCK REQUEST ? JMP SPIDD,I YES, ERROR * * PID IS NOT DEFINED, ADD NEW ENTRY * JSB PACK PACK LOCK TABLE IF NECESSARY LDB PROTB GET START OF PROCESS ID DIRECTORY SPID2 CPB PROTE END OF DIRECTORY ? JMP SPID3 YES, SETUP NEW PID LDA B,I GET # OF RECORD LOCKED SZA,RSS PID FREE HERE ? JMP SPID3 YES ADB DM3 NO, GO TO NEXT ENTRY JMP SPID2 CONTINUE * SPID3 STB PIDPT INIT PIDPT JSB SPIDX COMPUTE PIDX STA PIDX SET PID (FIRST IS ONE) IOR LCKID MERGE WITH DB# TO BUILD LOCKIDWORD STA LCKID SET IT THERE IN CASE OF SUSPEND LDB PIDPT RESTORE B TO LDA BIT15 INIT THE PROCESS ID DIRECTORY STA B,I SET # OF REC. LCK ADB DM1 CLA STA B,I SET CLASS I/O WORD ADB DM1 STA B,I SET POINTER TO LCK TABLE LDA PIDPT WAS IT A NEW PID CPA PROTE ADDED AT THE END ? RSS YES, UPDATE END OF DIRECTORY JMP SPID5 NO, RETURN OK ADB DM1 YES, UPDATE B AND STB PROTE SET NEW END OF PROCESS ID DIREC. JMP SPID5 AND RETURN OK * SPID4 CMA,INA CALCULATE THE PID POINTER INA MPY D3 ADA PROTB STA PIDPT SET PID POINTER SPID5 ISZ SPIDD JMP SPIDD,I AND RETURN OK * PIDMS OCT 17777 PID # MASK SPC 3 SPIDX NOP CMB,INB ADB PROTB COMPUTE CLA DIRECTORY INDEX=[(PROTB-PIDPT) 3]+1 SWP DIV D3 INA (PID# MUST BE < 17777 OCTAL) !!! JMP SPIDX,I EXIT WITH A=PIDX SPC 2 * SEARCH IN RECORD LOCK TABLE * * CALLING SEQUENCE: * PRIOR CALLING THIS FUNCTION, SET UP THE FOLLOWING: * REC#, DS#, PIDX * JSB SLTBL * RETURN P+1 - RECORD NOT LOCKED * RETURN P+2 - RECORD IS LOCKED BY AN OTHER PROCESS * RETURN P+3 - RECORD IS LOCKED BY THE CALLING PROCESS * * ON RETURN P+2 & P+3, THE ADDRESS OF THE ENTRY ACCESSED * IS SAVED INTO PT, AND THE ADDRESS OF * THE LAST EMPTY ENTRY IN THE LOCK TABLE * IS SAVED INTO PTHOL SPC 2 SLTBL NOP SEARCH IN LOCK TABLE CLA SET "OTHER PROCESS FLAG" TO 0 STA SLTFL STA PT1 SET FIRST "OTHER RECORD" TO 0 DLD REC# CHECK THAT REC# IS NEVER NUL (0) IOR B DOUBLE INTEGER CHECK FOR 0 SZA,RSS JMP UNLE1 ERROR, DATA STRUCTURES CORRUPT!!!!!!!!!!!!!!!!!!!! LDA LOCTE INIT LAST EMPTY ENTRY IN LOCK TABLE STA PTHOL WITH THE END OF TABLE LDA LOCTB GET FIRST ADDR OF LOCK TABLE * SLT01 JSB SLTB0 LOOK IN THE LOCK TABLE JMP SLT03 END OF TABLE, RETURN LDA PT,I RECALL FIRST WORD OF THE ENTRY IN THE ALF,ALF LOCK TABLE AND ISOLATE THE PID AND B377 CPA PIDX RECORD OWNED BY THE CALLING PROCESS ? JMP SLT02 YES, EXIT P+3 (RECORD BELONG TO CALLING PROCESS) ISZ SLTFL NO, RECORD LOCKED BY OTHER PROCESS, INC FLAG LDA PT GET ENTRY ADDR LDB PT1 GET FIRST "OTHER PROCESS" SZB,RSS FIRST "OTHER PROCESS" ? (.EQ.0) STA PT1 YES, SAVE ENTRY ADDR ADA D3 POINT TO NEXT ENTRY JMP SLT01 KEEP SEARCHING UNTIL PROCESS FOUND OR EOT * SLT02 ISZ SLTBL INCREMENT RETURN ADDR ISZ SLTBL BY 2 JMP SLTBL,I RETURN * SLT03 LDA SLTFL ANY "OTHER PROCESSES" FOUND? SZA,RSS JMP SLTBL,I NO, RETURN P+1 LDA PT1 YES, GET FIRST "OTHER PROCESS" STA PT SET UP PT ISZ SLTBL INC RETURN ADDR JMP SLTBL,I RETURN P+2 * SLTFL OCT 0 "OTHER PROCESS" FLAG PT1 OCT 0 FIRST "OTHER PROCESS" SPC 2 SLTB0 NOP SLTL2 STA PT CPA LOCTE END OF LOCK TABLE ? JMP SLTB0,I YES, EXIT P+1 (RECORD NOT FOUND) INA LDB .REC# CMW D2 JMP SLTL3 NOP JMP SLTL4 SLTL3 LDA PT,I AND B77 MASK OUT DATA SET # CPA DS# IS IT THE SAME DATA-SET ? JMP SLTL6 YES, RETURN P+2 SLTL4 LDA PT GO TO NEXT ENTRY LDB A,I SZB,RSS IS THAT ENTRY EMPTY ? STA PTHOL YES, UPDATE LAST EMPTY ENTRY IN THE LOCK TABLE ADA D3 JMP SLTL2 CONTINUE * SLTL6 ISZ SLTB0 RETURN P+2 ( RECORD FIND IN THE JMP SLTB0,I LOCK TABLE) SPC 2 PIDPT NOP PID DIRECTORY POINTER PIDX NOP PID DIRECTORY INDEX PT NOP PT0 NOP PTHOL NOP LAST EMPTY ENTRY IN THE LOCK TABLE * LOCTB NOP FWA OF LOCK TABLE LOCTE NOP LWA OF LOCK TABLE PROTB NOP FWA OF DIRECTORY (DIRECTORY IS BACKWARD) PROTE NOP LWA OF DIRECTORY LOCKM NOP * BIT6 OCT 100 BIT7 OCT 200 NBIT7 OCT 177577 B77 OCT 77 MASK1 OCT 277 CLEAR UPPER BYTE & BIT 6 SPC 3 * THIS PROGRAM PACKS THE LOCK TABLE SPC 1 PACK NOP LDB LOCTE CHECK IF PACK IS NEEDED ADB D5 CMB,INB ADB PROTE SSB,RSS NEEDED ? JMP PACK,I NO, RETURN IMMEDIATELY * LDA LOCTB YES, GET START ADDR OF LOCK TABLE STA PACKA INIT FROM POINTER STA PACKB INIT TO POINTER * PACK2 LDA PACKA CHECK FOR END OF TABLE CPA LOCTE END OF TABLE ? JMP PACK8 YES LDA PACKA,I GET AN ENTRY SZA,RSS ENTRY HERE ? JMP PACK4 NO, ENTRY EMPTY PACK3 LDA PACKA YES, STORE IT BACK LDB PACKB MVW D3 LDA PACKA,I AND BIT7 MASK OUT SOMEONE IS WAITING BIT SZA,RSS IS SOMEONE WAITING ? JMP PACK7 NO, FORGET DIRECTORY BUSINESS * LDA PROTB YES, UPDATE DIRECTORY CONTENT PACK6 CPA PROTE TO REFLECT THE CHANGE JMP PACK7 IT IS THE END OF DIRECTORY ADA DM2 TO GET LOCK TABLE POINTER LDB A,I GET POINTER ADA DM1 CPB PACKA DIRECTORY REFERS TO THE MODIFIED ONE ? INA,RSS YES, MODIFY DIRECTORY JMP PACK6 NO, CONTINUE LDB PACKB SET NEW POINTER VALUE STB A,I INTO THE DIRECTORY ADA DM1 JMP PACK6 CONTINUE * PACK7 ISZ PACKA BUMP POINTERS TO LOCK TABLE ISZ PACKA ISZ PACKA ISZ PACKB ISZ PACKB ISZ PACKB JMP PACK2 AND LOOP UNTIL END OF LOCK TABLE * PACK4 ISZ PACKA SKIP THE EMPTY SPACE ISZ PACKA ISZ PACKA LDA PACKA CHECK FOR END OF TABLE CPA LOCTE END OF LOCK TABLE ? JMP PACK8 YES DLD PACKA,I NO, GET ENTRY LDA PACKA SZA,RSS ENTRY EMPTY ? JMP PACK4 YES, LOOP ON EMPTY ENTRY JMP PACK3 NO, STORE ENTRY AND UPDATE DIRECTORY SPC 1 PACK8 LDA PACKB SET UP NEW END OF LOCK TABLE CPA LOCTE ONE HOLE FOUND ? JMP PACK9 NO, FATAL ERROR STA LOCTE YES, SET NEW END OF LOCK TABLE STA PTHOL SET NEW LAST EMPTY ENTRY JMP PACK,I * PACK9 LDA D402 ERROR LOCK TABLE OVERFLOW JMP SIMST GO SET IMAGE STATUS SPC 1 PACKA NOP PACKB NOP HED CONSTANTS & VARAIBLES DM513 DEC -513 DM256 DEC -256 DM128 DEC -128 DM10 DEC -10 DM8 DEC -8 DM7 DEC -7 DM3 DEC -3 DM2 DEC -2 DM1 DEC -1 D0 DEC 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D8 DEC 8 D9 DEC 9 D10 DEC 10 D11 DEC 11 D12 DEC 12 D14 DEC 14 D15 DEC 15 D16 DEC 16 D18 DEC 18 D20 DEC 20 D22 DEC 22 D24 DEC 24 D31 DEC 31 D32 DEC 32 D101 DEC 101 D102 DEC 102 D104 DEC 104 D107 DEC 107 D150 DEC 150 D152 DEC 152 D201 DEC 201 D202 DEC 202 D302 DEC 302 D400 DEC 400 D401 DEC 401 D402 DEC 402 D403 DEC 403 D404 DEC 404 D405 DEC 405 D406 DEC 406 D414 DEC 414 D410 DEC 410 D451 DEC 451 D452 DEC 452 D460 DEC 460 D461 DEC 461 D462 DEC 462 D512 DEC 512 B27 OCT 27 B377 OCT 377 B400 OCT 400 B1.47 OCT 17777 B20K OCT 20000 * BIT15 OCT 100000 SPC 1 TEMP NOP TEMP1 NOP PARM1 NOP PARM2 NOP SPC 1 C.TAB DEF *+1,I DEF XDBOP 0 - DBOPN DEF XDBCL 1 - DBCLS DEF XDBGE 2 - DBGET DEF XDBFN 3 - DBFND DEF XDBPU 4 - DBPUT DEF XDBUP 5 - DBUPD DEF XDBDE 6 - DBDEL DEF XDBIN 7 - DBINF DEF XTBUL 8 - TBULK DEF XDBVF 9 - SPECIAL VERIFY * * * ITLST BSS 128 USED TO HOLD LIST OF ALL ITEMS IN A DATA SET ITEMN BSS 8 USED TO HOLD ITEM NAME ASC 1, HED BUFFERS USE TO COMMUNICATE WITH THE USER PROGRAM * DO NOT DISTURB NEXT LOCATIONS * .ERCD DEF ERCOD .ERCL DEF ERCOL .ILEV DEF ILEVL SCODL DEC 2 BUFFER USED TO SEND DATA TO DCLOG BSS 3 ERCOL BSS 12 IMAGE ERROR CODE AND RUN TABLE DEC 0 IBASE BSS 11 DATA BASE NAMR ARRAY (IBASE) ILEVL BSS 3 LEVEL ACCESS WD SCODE NOP BUFFER USED TO GET THE REQUEST ECLAS NOP PARM BSS 2 BUF BSS 566 (1+1+2+23+543=570) SPC 3 ERCOD BSS 2 BUFFER USED TO SEND THE ANSWER BTEMP BSS 538 (2+23+515=540) SPC 2 LOCKW EQU BUF+BFLKW LCKID EQU BUF+BFLID SPC 3 UNS * ORG * DEFINE LAST LOCATION END