ASMB,R * * NAME: CLRQ * SOURCE: 92070-18094 * RELOC: 92070-1X094 * PGMR: C.H.W. * * **************************************************************** * * (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. * * **************************************************************** * * NAM CLRQ,6 92070-1X094 REV.1941 790321 * ENT CLRQ * EXT $LIBR,$LIST,$ERAB,$F.CL,$IDNO,$XEQ EXT $SUSP,$RQRT,$A,$PVCN,$STAT EXT $LUTA,$LUT#,$CLTA,$XQT EXT $ID#,$IDSZ,$IDA 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 CLA STA $A,I TENTATIVELY RTN A=0 STA $PVCN CLEAR $LIBR CNTR CCB ADB CLRQ STB $SUSP,I SAVE POSSIBLE POINT OF SUSPENSION LDA CLRQ,I STA $RQRT SAVE POINT OF 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 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 $RQRT BUMP RTN ADDR IF N.A. SET LDA $STAT,I RAL,RAL ERA,RAR MOVE NO ABORT TO "NA" STA $STAT,I UPDATE ID SEG DLD 1,I GET 2ND / (3RD) PRAM ADDRESSES STA CLASA SAVE ADDR OF CLASS PARAM ISZ OPTNA SKIP IF NO 3RD PARAM STB OPTNA SAVE OPT.PARAMETER ADDR LDA CLASA,I GET PASSED CLASS AND B377 ISOLATE CLASS TABLE INDEX LDB 0 ADA $CLTA POINT TO CLASS TABLE STA TEMP SAVE ADDR OF CLASS ENTRY CMB,CLE,INB,SZB,RSS B=NEG CLASS TABLE INDEX JMP CL.05 CLASS # NOT SPECIFIED ADB $CLTA,I CHK CLASS # : E=1 IF OK LDA 0,I GET CLASS HEAD SEZ,SZA NO CLASS OR OUT OF RANGE? CLB,RSS NO, OK JMP CLER1 YES, ERROR CL01 SSA,RSS FOUND CLASS ID? JMP *-5 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 LDA $LUT# CMA,INA A= NEG # OF LU'S ADA 1 CHECK AGAINST REQUESTED LU SSA TOO LARGE? SSB NO, TOO SMALL? JMP CLER2 YES, ILLEGAL PARAMETER ADB $LUTA POINT TO LUT ENTRY LDB 1,I GET IT'S DVT ADDRESS SZB,RSS IS DVT THERE? JMP CLER2 NO, ERROR - LU UNASSIGNED LDA CLASA,I GET PASSED CLASS # JSB $F.CL FLUSH PENDING REQUESTS OCT 3 * EXIT LDA $RQRT STA $SUSP,I SET RETURN ADDR JMP $XEQ & GO TO SYSTEM 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 LDB $IDA ADDR OF 1ST ID SEGMENT ADB .12 POINT TO PGM NAME * CL.12 CPA $ID# ALL ID SEGS CHECKED? JMP ESC05 YES, GIVE "SC05" INA STA CNTR BUMP ID SEG # STB PNTR STB TEMP1 LDB OPTNA LDA 1,I GET 1ST 2 CHARS CPA TEMP1,I MATCH? INB,RSS YES JMP CL.13 NO ISZ TEMP1 LDA 1,I GET 3RD & 4TH CPA TEMP1,I MATCH? INB,RSS YES JMP CL.13 NO ISZ TEMP1 LDA 1,I XOR TEMP1,I TEST 5TH CHAR CLB LSL 8 CL.13 LDA CNTR CURRENT ID SEG # SZB,RSS NAME MATCH? JMP CL.16 YES * LDB PNTR ADB $IDSZ POINT TO NEXT ID SEG JMP CL.12 GO CHECK IT * ESC05 LDB .5 ERROR "SC05" LDA ASCSC JMP $ERAB CALL ERROR ABORT ROUTINE * CL.15 LDB $XQT CALLER'S ID SEG ADDR JSB $IDNO COMPUTE PGM # CL.16 STA TEMP1 ALF,ALF ISOLATE BITS FOR SECURITY CODE AND B174C IN BITS 12-8 LDB TEMP ADDR OF CLASS TABLE STA TEMP LDA CLASA,I GET USER CLASS AND B377 CLE,SZA DOES HE WANT A NEW ONE? JMP CL.18 NO, SKIP CLASS # ALLOCATE ADB $CLTA,I POINT TO END OF CLASS TABLE CL.17 CPB $CLTA MORE ENTRIES? JMP CL.19 NO CLASSES AVAILABLE CPA 1,I IS THIS ENTRY ALLOCATED? JMP *+3 NO, WE'LL USE IT ADB N1 POINT TO NEXT ENTRY JMP CL.17 ITERATE * LDA $CLTA 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 STA 1,I SET NEW CLASS TABLE ENTRY * CL.18 ADB $CLTA,I ADDR OF 2ND WORD OF CLASS TABLE LDA 1,I GET CURRENT VALUE SSA FLUSHING? JMP CLER1 YES, ERROR LDA TEMP1 USER ID SEGMENT # STA 1,I STORE IN 2ND WD OF ENTRY JMP EXIT DONE * CL.19 CCA,SEZ,RSS IS THERE A CLASS TABLE? JMP CLER1 NO, ERROR "CL01" STA $A,I SET ERROR CODE IN A OF -1 LDB ICODE SSB WAS "NO WAIT" FLAG SET? JMP EXIT YES, RETURN NOW (A=-1) LDB $XQT NO LDA $CLTA JSB $LIST SUSPEND CALLER NOW OCT 52 JMP $XEQ SKP * * FLUSH CLASS * CL.20 LDA CLASA,I GET USER'S CLASS JSB $F.CL FLUSH COMPLETED REQUESTS OCT 1 LDB $LUTA ADDR OF LU'S STB PNTR LDA $LUT# SIZE OF LU TABLE CMA,INA STA CNTR COUNTER * CL.25 LDB PNTR,I GET NEXT LU TABLE ENTRY SZB,RSS POINT TO A DVT? JMP CL.26 NO, SKIP IT LDA CLASA,I GET FLUSHING CLASS # JSB $F.CL FLUSH PENDING REQUESTS .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 ASCCL JMP $ERAB ABORT SPC 2 * * DATA ICODE NOP CLASA NOP OPTNA NOP PNTR NOP CNTR NOP TEMP NOP TEMP1 NOP * .2 DEC 2 .5 DEC 5 .12 DEC 12 B377 OCT 377 B174C OCT 17400 N1 DEC -1 ASCCL ASC 1,CL ASCSC ASC 1,SC * END