ASMB,R,L,C * * NAME: CLRQ * SOURCE: 92071-18094 * RELOC: 92071-1X094 * PGMR: C.H.W.,DJN * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. 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. * * **************************************************************** * * NAM CLRQ,6 92071-1X094 REV.2041 800808 * ENT CLRQ * EXT $LIBR,$LIST,$ERAB,$F.CL,$IDNO EXT $RQRT,$PVCN,$STAT,$SUSP,$NAMX EXT $LUTA,$LUT#,$CLTA,$XQT,$EXEX EXT .XST,.XLD,$SJS1,$SJS0,$SJP SKP * * THIS LIBRARY SUBROUTINE PERFORMS CLASS MANAGEMENT FUNCTIONS. IT WILL * ALLOW THE ASSIGNMENT OF OWNERSHIP TO CLASSES SO THAT IN THE EVENT * OF A PROGRAM TERMINATING OR ABORTING WITHOUT CLEANING UP THE CLASSES * AND CLASS BUFFERS ASSIGNED TO IT, THE SYSTEM WILL BE ABLE TO * DEALLOCATE THESE RESOURCES. THIS ROUTINE ALSO ALLOWS PROGRAMMATIC * FLUSHING OF PENDING CLASS BUFFERS ON AN LU OR FLUSHING OF ALL CLASS * BUFFERS (PENDING OR COMPLETED) WITH DEALLOCATION OF THE CLASS ITSELF. * THE CALLING SEQUENCE IS AS FOLLOWS: * EXT CLRQ * . * . * JSB CLRQ TRANSFER CONTROL TO SUBROUTINE * DEF RTN RETURN ADDRESS * DEF ICODE CONTROL INFORMATION (BIT14=NO ABORT)(15=NO WAIT) * DEF CLASS CLASS NUMBER * DEF IPRAM CALL DEPENDENT PARAMETER (PGM NAME OR LU) * RTN RETURN POINT CONTINUE EXECUTION * . * . * ICODE OCT 1 ASSIGN CLASS OWNERSHIP. IPRAM CONTAINS THE NAME * OF THE PROGRAM ASSIGNED OWNERSHIP OF THE CLASS. * IF IPRAM IS ZERO, NO OWNERSHIP IS ASSIGNED. IF * IPRAM IS DEFAULTED, THE CALLING PROGRAM IS ASSIGNED * OWNERSHIP. IF CLASS IS ZERO, A NEW CLASS NUMBER IS * ALLOCATED BY THE CALL. IN THIS CASE, A ZERO IS * RETURNED IN THE A REG IF ALLOCATION WAS SUCCESSFUL * IF NO CLASSES ARE AVAILABLE, THE USER IS SUSPENDED * UNLESS THE NO-WAIT FLAG WAS SET IN WHICH CASE A * -1 IS RETURNED IN THE A REGISTER. * * " " OCT 2 FLUSH CLASS REQUESTS & DEALLOCATE CLASS. ALL NON- * ACTIVE PENDING REQUESTS WILL BE DEALLOCATED. ABORT * REQUESTS WILL BE ISSUED BY THE SYSTEM FOR ALL ACTIVE * I/O REQUESTS, IN WHICH CASE THE BUFFER WILL BE * DEALLOCATED AT LOGICAL DONE. ALL PREVIOUSLY * COMPLETED REQUESTS WILL BE IMMEDIATELY DEALLOCATED. * THE CLASS TABLE ENTRY WILL BE FLAGGED SO THAT NO * NEW REQUESTS WILL BE ISSUED ON THE CLASS (IO00 * ERROR RETURNED) AND SO THAT UPON THE PENDING * COUNT REACHING ZERO, THE SYSTEM CAN DEALLOCATE THE * CLASS. * * " " OCT 3 FLUSH CLASS REQUESTS ON LU DESIGNATED BY IPRAM. * NON-ACTIVE REQUESTS FOR THE DESIGNATED CLASS * PENDING ON THE LU ARE DEALLOCATED AND IF A * REQUEST IS ACTIVE, AN ABORT REQUEST IS ISSUED BY * THE SYSTEM. THE BUFFER WILL BE DEALLOCATED AT * LOGICAL DONE. THE CLASS IS NOT DEALLOCATED BY * THIS CALL. * ERRORS: CL01 - ILLEGAL CLASS # OR NULL CLASS TABLE * CL02 - PARAMETER OR CALL SEQUENCE ERROR * SC05 - PROGRAM NOT FOUND (ONLY WHEN ICODE=1) * SKP * CLRQ NOP JSB $LIBR GO PRIVILEGED NOP JSB .XLD GET ADDRESS AT $CLTA DEF $CLTA STA CLTA SAVE COPY LOCALLY JSB .XLD GET NUMBER OF CLASSES CLTA NOP WILL STORE CLASS TABLE ADDRESS STA NUMCL CLA CLEAR FOR RETURN STA ARTN TENTATIVELY RETURN A=0 JSB .XST CLEAR $LIBR CNTR DEF $PVCN CCB ADB CLRQ STB RETRY SAVE CALLING ADDRESS FOR RETRY AFTER SUSPEND JSB .XLD SET UP $SUSP FOR $ERAB DEF $SUSP STA 1 LDA RETRY JSB .XST DEF 1,I LDA CLRQ,I STA RTNAD SAVE POINT OF RETURN FOR NO WAIT RETURN CMA,INA ADA CLRQ ADA .2 A= -# OF PRAMS +1 SSA,RSS AT LEAST 2 PARAMS? JMP CLER2 NO, THAT'S A CL02 STA OPTNA = -1 IF 2 PARAMS LDB RETRY GET ADDRESS OF JSB CLRQ ADB .2 POINT TO 1ST PARAMETER ADDR LDA 1,I GET ADDRESS LDA 0,I GET "ICODE" STA ICODE SAVE CONTROL WORD RAL,ELA MOVE NO ABORT BIT TO E SEZ,INB ISZ RTNAD BUMP RTN ADDR IF N.A. SET STB TEMP1 SAVE PASSED PARAM POINTER JSB .XLD UPDATE THE ID STATUS WORD DEF $STAT FIRST BY GETTING CONTENTS OF $STAT STA TEMP SAVE $STAT VALUE FOR XST JSB .XLD GET THE OLD STATUS WORD DEF 0,I RAL,RAL ERA,RAR MOVE NO ABORT TO "NA" JSB .XST UPDATE ID SEG TEMP NOP WILL CONTAIN $STAT CONTENTS DLD TEMP1,I GET 2ND / (3RD) PRAM ADDRESSES STA CLASA SAVE ADDR OF CLASS PARAM ISZ OPTNA SKIP IF NO 3RD PARAM RSS IS A 3RD PARAM JMP NO3RD IS NO THIRD PARAM * * RESOLVE ANY IDIRECTS IN NAME FIELD * RESLV SSB,RSS SKIP IF INDIRECT JMP NOIND SIGN BIT CLEAR, NOT INDIRECT ELB,CLE,ERB CLEAR INDIRECT BIT LDB 1,I GET NEXT LEVEL ADDRESS JMP RESLV SEE IF STILL NEEDS RESOLVING NOIND STB OPTNA SAVE OPT.PARAMETER ADDR NO3RD LDA CLASA,I GET PASSED CLASS AND B377 ISOLATE CLASS TABLE INDEX LDB 0 COPY INDEX TO B ADA CLTA POINT TO CLASS TABLE STA CLEA SAVE ADDR OF CLASS ENTRY CMB,CLE,INB,SZB,RSS B=NEG CLASS TABLE INDEX JMP CL.05 CLASS # NOT SPECIFIED ADB NUMCL CHK CLASS # : E=1 IF OK GETHD JSB .XLD GET CLASS HEAD DEF 0,I SEZ,SZA NO CLASS OR OUT OF RANGE? CLB,RSS NO, OK JMP CLER1 YES, ERROR CL01 SSA,RSS FOUND CLASS ID? JMP GETHD NO, TRACK IT DOWN XOR CLASA,I TEST CLASS AND B174C TO SEE IF SECURITY CODE OK CLE,SZA YES, SEC CODE MATCH? JMP CLER1 NO, ERROR * CL.05 LDA ICODE FUNCTION CODE AND .3 CMA,INA,SZA,RSS =3? JMP CLER2 YES, ERROR INA,SZA,RSS ASSIGN OWNERSHIP? JMP CL.10 YES CCB,SEZ WAS EXISTING CLASS GIVEN? JMP CLER1 NO, ERROR INA,SZA,RSS FLUSH CLASS? JMP CL.20 YES * * FLUSH ONLY PENDING REQUESTS ON DESIGNATED LU * CLA ADB OPTNA,I GET OPT. PARAM -1 STB TEMP JSB .XLD DEF $LUT# CMA,INA A= NEG # OF LU'S LDB TEMP ADA 1 CHECK AGAINST REQUESTED LU SSA TOO LARGE? SSB NO, TOO SMALL? JMP CLER2 YES, ILLEGAL PARAMETER * JSB .XLD POINT TO LUT ENTRY DEF $LUTA ADA TEMP ADD # OF LU'S -1 JSB .XLD GET DVT ADDRESS DEF 0,I STA 1 PUT DVT ADR IN B FOR $F.CL SZB,RSS IS DVT THERE? JMP CLER2 NO, ERROR - LU UNASSIGNED LDA CLASA,I GET PASSED CLASS # JSB $SJS1 FLUSH PENDING REQUESTS DEF $F.CL OCT 3 * EXIT LDA RTNAD SET UP RETURN ADDRESS JSB .XST DEF $RQRT LDA ARTN GET A REG RETURN JSB $SJP & GO TO SYSTEM DEF $EXEX * SKP * * ASSIGN CLASS OWNERSHIP * CL.10 CPB OPTNA PGM NAME DEFAULTED? JMP CL.15 YES, USE CALLER'S NAME CPB OPTNA,I WAS ZERO SPECIFIED? JMP CL.16 YES, NO OWNER * * NOW VERIFY NAME, AND COMPUTE ITS ID SEGMENT NUMBER * LDA OPTNA GET ADDRESS OF NAME STA OPNA JSB $SJS1 DEF $NAMX OPNA NOP CHANGED ABOVE SZB NOT FOUND JMP GETID CONVERT ADDRESS TO ID NUMBER * LDA RTNAD SET $RQRT FOR IN CASE JSB .XST OF NO ABORT RETURN DEF $RQRT LDB .5 ERROR "SC05" LDA ASCSC JMP ERABX CALL ERROR ABORT ROUTINE * CL.15 JSB .XLD CALLER'S ID SEG ADDR DEF $XQT STA 1 PUT IN B FOR $IDNO GETID JSB $SJS0 COMPUTE PGM # DEF $IDNO CL.16 STA TEMP1 SAVE IDNO ALF,ALF ISOLATE BITS FOR SECURITY CODE AND B174C IN BITS 12-8 LDB CLEA ADDR OF CLASS TABLE ENTRY STA TEMP LDA CLASA,I GET USER CLASS AND B377 STA CLASS SAVE FOR COMPARING CLE,SZA DOES HE WANT A NEW ONE? JMP CL.18 NO, SKIP CLASS # ALLOCATE ADB NUMCL POINT TO END OF CLASS TABLE CL.17 CPB CLTA MORE ENTRIES? JMP CL.19 NO CLASSES AVAILABLE STB PNTR SAVE CLASS TABLE POINTER JSB .XLD IS THIS ENTRY ALLOCATED? DEF 1,I LDB PNTR RESTOR BE FOR CONDITIONAL JUMP CPA CLASS COMPARE WITH PASSED CLASS JMP GOTIT NOT USED, SO USE IT ADB N1 POINT TO NEXT ENTRY JMP CL.17 ITERATE * GOTIT LDA CLTA GET CLASS TABLE ADDRESS CMA,INA ADA 1 COMPUTE CLASS # IOR TEMP INCLUDE SECURITY CODE STA CLASA,I GIVE USER HIS NEW CLASS # LDA TEMP RAL,ERA SET TO STATE 3 JSB .XST SET NEW CLASS TABLE ENTRY DEF 1,I * CL.18 ADB NUMCL ADDR OF 2ND WORD OF CLASS TABLE STB TEMP JSB .XLD GET CURRENT VALUE DEF 1,I SSA FLUSHING? JMP CLER1 YES, ERROR LDA TEMP1 USER ID SEGMENT # LDB TEMP RESTORE CLASS TABLE ENTRY ADDRESS JSB .XST STORE IN 2ND WD OF ENTRY DEF 1,I JMP EXIT DONE * CL.19 CCA,SEZ,RSS IS THERE A CLASS TABLE? JMP CLER1 NO, ERROR "CL01" STA ARTN SET ERROR CODE IN A OF -1 LDB ICODE SSB WAS "NO WAIT" FLAG SET? JMP EXIT YES, RETURN NOW (A=-1) JSB .XLD NO, GET ID ADDRESS DEF $XQT STA 1 PUT IN B FOR $LIST LDA CLTA GET ADDR OF CLASS TABLE FOR $LIST JSB $SJS1 SUSPEND CALLER NOW DEF $LIST OCT 52 LDA RETRY SET UP $RQRT SO THE CALL IS RETRIED JSB .XST DEF $RQRT JSB $SJP GO TO DISPATCHER AND RETRY DEF $EXEX SKP * * FLUSH CLASS * CL.20 LDA CLASA,I GET USER'S CLASS JSB $SJS1 FLUSH COMPLETED REQUESTS DEF $F.CL OCT 1 JSB .XLD ADDR OF LU'S DEF $LUTA STA PNTR JSB .XLD SIZE OF LU TABLE DEF $LUT# CMA,INA STA CNTR COUNTER * CL.25 LDA PNTR GET NEXT LU TABLE ENTRY JSB .XLD DEF 0,I SZA,RSS POINT TO A DVT? JMP CL.26 NO, SKIP IT STA 1 PUT ADDR IN B FOR F.CL LDA CLASA,I GET FLUSHING CLASS # JSB $SJS1 FLUSH PENDING REQUESTS DEF $F.CL .3 OCT 3 CL.26 ISZ PNTR POINT TO NEXT LU ISZ CNTR MORE? JMP CL.25 YES JMP EXIT NO, DONE SPC 3 * CLER1 CLB,INB,RSS * CLER2 LDB .2 LDA RTNAD SET UP RETURN FOR NO ABORT CASE JSB .XST DEF $RQRT LDA ASCCL ERABX JSB $SJP ABORT DEF $ERAB SPC 2 * * DATA ARTN NOP RTNAD NOP RETRY NOP NUMCL NOP ICODE NOP CLASA NOP OPTNA NOP PNTR NOP CNTR NOP CLEA NOP ADDRESS OF CLASS ENTRY TEMP1 NOP CLASS NOP * .2 DEC 2 .5 DEC 5 B377 OCT 377 B174C OCT 17400 N1 DEC -1 ASCCL ASC 1,CL ASCSC ASC 1,SC * END