ASMB,R,L,C HED "IDRPL" FTN/SPL SUBROUTINE TO DO A FMGR ":RP,PROG" * SOURCE: 92070-18062 * RELOC: 92070-16062 * PGMR: M.L.K. * * *************************************************************** * * (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 IDRPL,7 92070-1X062 REV.1941 790709 * SKP * ENT IDRPL EXT EXEC,.ENTR,$LIBR,$LIBX,IDSGA,NAM.. EXT GTOPN,LOGLU,$CKSM,IDMEM,.MVW EXT $FWBG,$BGBP SUP * * * PURPOSE: * TO ACCOMPLISH THE EQUIVALENT OF A FMGR ":RP,PROG" IN A SUBROUTINE. * CALLED: * CALL IDRPL (IDCB,IERR,NAME,IPERM) * -OR- * IF (IDRPL (IDCB,IERR,NAME,IPERM).NE.0) GO TO IERROR * WHERE: * IERR = RETURN ERROR CODE (SAME AS ERROR CODES IN FMGR) * IDCB = AN OPEN DCB OF THE TYPE 6 FILE ON LU=2 OR LU=3 * NAME = 5 CHARACTER BUFFER OF THE PROGRAM NAME PUT IN ID SEGMENT * IPERM= 0 IF PROGRAM TO BE TEMPORARY, #0 IF TO BE PERMANENT * * WORDS SET BY IDRPL: * * LONG ID SEGMENT * 13-15 PROGRAM NAME FROM THIRD INPUT PARAMETER * 16 ID BIT SET ACCORDING TO IPERM PARAMETER * 25 BASE PAGE TRACK OFFSET FROM MAIN TRACK * 26 BASE PAGE SECTOR/MAIN SECTOR (IN 128 WORD SECTORS) * 27 MAIN TRACK * 28 DISC LU * 29 SEQUENCE NUMBER SET FROM THE CURRENT CONTENTS OF THE ID * SEGMENT TO BE USED. CONSOLE LU FROM LOGLU. * * * SHORT ID SEGMENT * 3 SEGMENT'S MAIN TRACK OFFSET FROM WORD 27 IN LONG ID * 6 SEGMENT'S BASE PAGE TRACK OFFSET FROM WORD 3 IN SHORT ID * 7 SEGMENT'S BASE PAGE/MAIN SECTOR ADDRESS (PHYSICAL SECTORS) * 8 SHORT ID SEGMENT'S CHECKSUM FOR OP SYSTEM. * * RETURN: * * IERR = 0 > SUCCESSFUL INSTALLATION OF IDSEGMENT INTO SYSTEM * E-REG = 1 IF ERROR, ELSE E-REG = 0 (FOR FRETURN SPL) * IERR = -1 > DISC ERROR * IERR = -11 > IDCB NOT OPEN * IERR = 14 > NO BLANK ID SEGMENTS OR EXTENSIONS AVAILABLE * IERR = -15 > ILLEGAL NAME * IERR = 19 > ID(34),ID(35) WORDS DID NOT CHECKSUM CORRECTLY. * IERR = 23 > DUPLICATE PROGRAM NAME. * IERR = 39 > CANNOT RP PROGRAM. DISC ADDRESS OUT OF RANGE * IERR = 40 > REAL TIME PROGRAM ALREADY IN CORRESPONDING AREA. * * NOTES: * * (1) A-REG = IERR ON RETURN, THEREFORE MAY BE USED AS FUNCTION * (2) IDRPL DOES NOT CLOSE THE FILE. * (3) RECOMMEND FILE BE NON EXECUTIVELY OPENED * (4) E-REG = 1, IF ERROR, E=0, IF NO ERROR(FOR SPL) * (5) ONLY THE 1ST 10 WORDS OF THE DCB ARE USED BY THIS SUBROUTINE. * (6) B REGISTER HAS THE ADDRESS OF THE PROGRAM NAME IN CONFLICT * IF ERROR 40 IS RETURNED. SKP IDRPL NOP DUMMY ENTRY POINT LDA DZERO STA PERM LDA IDRPL STA DRPL JMP DRPL+1 SPC 2 IDCB NOP OPEN DCB ADDRESS IERR NOP RETURNED ERROR CODE NAME NOP FIVE CHAR ASCII NAME TO GIVE PROGRAM PERM NOP PERMANENT OR TEMPORARY INDICATOR * DRPL NOP ENTRY JSB .ENTR DEF IDCB LDA IDCB,I GET TRACK-LU WORD FROM DCB AND B77 ISOLATE LU OF THE DISC STA LU AND SAVE FOR EXEC AND ID ADA B7700 ADD DISC PROTECT STA PDSLU TO ITS LU LDB IDCB CALCULATE FILE TRACK/SECTOR WORD ADB .3 ADDRESSES STB DCB3 POINTER TO TRACK OF FILE INB BUMP TO SECTOR OF FILE STB DCB4 AND SET INTO EXEC CALL ADB .4 BUMP TO SECT/TRACK WORD LDA B,I GET # OF 64 SECTORS PER TRACK STA #SC/T SAVE # OF 64 WORD SECTORS PER TRACK RAR SHIFT FOR # OF 128 WORD SECTORS STA SEC/T AND SAVE CCE,INB PREPARE E-REG IN CASE OF ERROR, B TO OPEN FLAG JSB GTOPN GET CURRENT OPEN FLAG DEF *+1 CPA B,I SAME AS IN DCB? RSS YES, SKIP JMP ERR11 NO, FILE NOT OPEN * JSB LOGLU GET CONSOLE LU DEF *+2 DEF CONLU DUMMY PARAMETER STA CONLU SAVE FOR FUTURE USE * JSB EXEC READ 1ST 34 WORDS OF FILE DEF *+7 DEF .1 READ DEF PDSLU PROTECTED DISC LU DEFID DEF IDBUF DESTINATION BUFFER ADDRESS DEF .34 BUFFER LENGTH DCB3 DEF * DISC TRACK DCB4 DEF * DISK SECTOR * CLA,CCE CLEAR SUM TOTAL JSB SUM CALCULATE CHECKSUM DEF IDBUF OF THE 1ST 31 WORDS OF FILE DEC -31 CPA ID+32 EQUAL TO WORD 32? CLA,RSS YES JMP ERR19 NO LDA $CKSM GET SYSTEM CHECKSUM CPA ID+31 COMPARE? JMP DORP YES, CONTINUE ERR19 LDA .19 NO, FMGR ERROR 19 JMP EREXT ERR39 LDA .39 JMP EREXT ER01 CCA SET DISC ERROR JMP EREXT ERR11 LDA .11 CMA,INA MAKE NEGATIVE EREXT CCE ERROR EXIT E-REG = 1 EXIT STA IERR,I TELL CALLER RETURN CODE JMP DRPL,I RETURN IERR = A-REG SKP * * SET UP MAIN ID SEGMENT * DORP LDA DCB3,I GET STARTING TRACK NUMBER STA TRACK INITIALIZE TRACK VALUE FOR BUMP STA TRAK INITIALIZE TRACK VALUE FOR SETPT LDA DCB4,I GET STARTING SECTOR NUMBER STA SEKTR INITIALIZE SECTOR VALUE FOR SETPT RAR SHIFT FOR PHYSICAL SECTORS STA SECTR INITIALIZE SECTOR VALUE FOR BUMP * * MAIN DISC ADDRESS * CLA,INA SET A TO 1 FOR HIGH ADDRESS CLB SET B TO 0 FOR LOW ADDRESS JSB BUMP NOW BUMP DISC ADDRESS BY ONE SECTOR PAST ID STB ID+27 STORE MAIN TRACK IN WORD 27 STA ID+26 STORE MAIN SECTOR IN LOW BYTE WORD 26 * * BASE PAGE DISC ADDRESS * LDA ID+22 GET THE HIGH MAIN ADDRESS LDB ID+21 GET THE LOW MAIN ADDRESS JSB BUMP CALCULATE THE DISC ADDRESS OF THE MAIN BASE PAGE ALF,ALF SHIFT BASE PAGE SECTOR TO HIGH BYTE IOR ID+26 ADD IN THE MAIN SECTOR STA ID+26 AND STORE AGAIN IN WORD 26 * LDA ID+27 GET MAIN TRACK CMA,INA AND SET IT NEGATIVE STA NEGMN SAVE THIS FOR LATER ADB A ADD THE CURRENT TRACK TO GET OFFSET LDA M64 TEST IF OFFSET IS GREATER THAN 63 ADA B SSA,RSS POSITIVE? JMP ERR39 YES, ERROR IN SETUP BLF,BLF NO, IT'S OK. SO SHIFT THE OFFSET RBL,RBL TO THE TOP SIX BITS LDA ID+25 GET ID WORD 25 IOR B AND ADD IN BP OFFSET STA ID+25 AND STORE AGAIN IN WORD 25 * * DISC LU * LDA LU GET LU STA ID+28 AND STORE IN WORD 28 * * SET UP ID NAME * JSB NAM.. CHECK FOR LEGAL NAME DEF *+2 DEF NAME,I SZA NAME OK? JMP EREXT NO, FMGR ERROR -15 * LDA NAME,I GET FIRST TWO CHARACTERS STA ID+13 STORE IN WORD 13 LDA NAME GET THE ADDRESS OF THE NAME INA POINT TO THE SECOND WORD DLD A,I AND GET THE REST STA ID+14 STORE THE SECOND WORD LDA B MOVE LAST CHARACTER TO A AND UBYTE CLEAR LOWER BYTE STA ID+15 AND STORE IN ID WORD 15 * * SET ID BIT IF NECESSARY * LDA IDBIT PRESET THE ID BIT LDB PERM,I NOW GET THE PERMANENT PARAMETER SZB PREMANENT OR TEMPORARY? CLA PERMANENT, DON'T SET ID BIT IOR ID+16 TEMPORARY, SET ID BIT STA ID+16 STORE BACK IN WORD 16 * * CHECK PRIORITY, SET TO 99 IF 0 * LDA ID+7 GET PRIORITY SZA,RSS IF IT IS ZERO LDA .99 THEN SET IT TO 99 STA ID+7 AND SET IN WORD 7 SKP * * SET UP SHORT ID SEGMENTS * * SET UP LOOP LDA ID+24 GET ID WORD 24 ALF,ALF SWAP BYTES RAR,RAR POSITION # OF SEGMENTS INTO LOWER BITS AND B77 AND ISOLATE SZA,RSS ANY SEGMENTS? JMP WRTID NO, GO WRITE ID SEG INTO MEMORY CMA,INA SET # SEG NEGATIVE STA LPCNT SAVE AS LOOP COUNTER CCA SET INIT TO -1 TO CAUSE STA INIT SETPT TO INITIALIZE THE SECTOR BUFFER * LDA $FWBG GET BG BOUNDRY IN CASE REAL TIME STA ID+33 STORE IN PLACE OF HI SEGMENT LDA $BGBP GET BG BP BOUNDRY IN CASE REAL TIME STA ID+34 STORE IN PLACE OF HI SEGMENT BP * LDA ID+24 GET MAIN LOW BASE PAGE ADDRESS AND B1777 ISOLATE LOW BASE PAGE STA B AND PUT INTO B LDA ID+25 GET MAIN HIGH BASE PAGE + 1 ADDRESS AND B1777 AND ISOLATE IT STA HMNBP STORE FOR LOOP IN HI MAIN BASE PAGE JSB BUMP POSITION TRACK AND SECTOR TO SEGMENT 0 * LOOP JSB SETPT SET UP POINTERS TO SHORT ID SEGMENT LDA SECTR GET CURRENT SECTOR OF THE SEGMENT'S MAIN STA SID7,I STORE IT IN THE SHORT ID WORD 7 LDB TRACK GET CURRENT TRACK OF THE SEGMENT'S MAIN STB TR SAVE A COPY TO CALCULATE BP OFFSET ADB NEGMN SUBTRACT THE MAIN'S TRACK TO GET OFFSET LDA M256 TEST WHETHER OFFSET IS GREATER THAN 255 ADA B AND WON'T FIT IN A BYTE SSA,RSS OK? JMP ERR39 NO, EXIT, CAN'T SET IT UP LDA SID3,I GET LAST LETTER OF NAME AND AND UBYTE ISOLATE IT IOR B PUT TRACK OFFSET IN WORD 3 STA SID3,I AND STORE IT BACK * * SET UP FOR SEGMENT'S BASE PAGE * LDA SID5,I GET THE SEGMENT'S MAIN HIGH ADDRESS + 1 LDB ID+22 USE THE MAIN'S HIGH ADDRESS AS LOW JSB BUMP UPDATE THE DISC POINTERS ALF,ALF POSITION THE BP SECTOR IN THE UPPER BYTE IOR SID7,I PUT IN THE SEGMENT'S MAIN SECTOR STA SID7,I AND STORE BACK IN WORD 7 LDB TR GET SEGMENT'S MAIN TRACK CMB,INB AND SET IT NEGATIVE ADB TRACK ADD THE SEGMENT'S BP TRACK LDA M64 TEST IF GREATER THAN 64 ADA B SSA,RSS TOO BIG? JMP ERR39 YES, EXIT. CAN'T SET IT UP BLF,BLF POSITION TRACK OFFSET TO UPPER RBL,RBL SIX BITS LDA SID6,I GET HIGH BP ADDRESS + 1 IN A AND B1777 ISOLATE HIGH BP ADDRESS + 1 ADB A PUT BP TRACK OFFSET IN STB SID6,I AND REPLACE IN WORD 6 * * NOW BUMP DISC ADDRESS TO NEXT SEGMENT * LDB HMNBP LOAD MAIN'S BP ADDRESS (A REG ALREADY SET) JSB BUMP NOW UPDATE DISC ADDRESSES * * CALCULATE THE SHORT ID'S CHECKSUM * LDA SID1 PUT THE SHORT ID SEGMENT'S ADDRESS STA SIDAD INTO CALL FOR CHECKSUM CLA CLEAR PENDING SUM JSB SUM CALCULATE SUM OF SHORT SIDAD NOP BEGINNING ADDRESS OF SHORT ID SEGMENT DEC -7 TO WORD 7 STA SID8,I STORE IN WORD 8 * * CHECK COUNT * ISZ LPCNT DONE YET? JMP LOOP NO, DO NEXT SEGMENT * * WRITE OUT LAST SECTOR * LDA ENDSB GET ADDRESS OF THE END OF THE SECTOR BUFFER ADA M8 AND SUBTRACT 8 AND STORE IN SID1. THIS WILL STA SID1 FORCE A WRITE OF THE CURRENT SECTOR. JSB SETPT NOW CALL TO DO WRITE SKP * * GO PRIVILEGED TO WRITE THE ID SEGMENT * * WRTID JSB $LIBR GO PRIVILEGED TO PREVENT NOP CONFLICTS WITH OTHER ROUTINES * JSB IDSGA SEARCH FOR DUPLICATE PROGRAM NAMES DEF *+2 DEF NAME,I SEZ,CME IF NOT FOUND, CLEAR E-REG AND A-REG JMP RTPRG AND GO FIND A BLANK ID SEGMENT LDA .23 IF FOUND, RETURN FMGR 23 ERROR JMP PEXIT WITH E-REG = 1 * * TEST FOR REAL-TIME PROGRAM MEMORY CONFLICT * RTPRG JSB IDMEM TEST FOR REAL-TIME MEMORY BOUNDS DEF *+2 CONFLICTS DEF IDBUF PASS IT THE BUILT UP ID SEGMENT CCE,SZA,RSS IF NO CONFLICT FOUND (OR NOT REAL-TIME) JMP SERCH THEN SEARCH FOR FREE ID SEGMENT LDB A PUT NAME ADDRESS IN B LDA .40 OTHERWISE EXIT WITH FMGR 40 ERROR JMP PEXIT WITH E-REG = 1 * * SEARCH FOR FREE ID SEGMENT * SERCH JSB IDSGA CALL FOR MATCH OF BLANK NAME DEF *+2 DEF ZERO ARRAY OF THREE ZEROS SEZ,RSS IF FOUND, GO MOVE ID DOWN JMP MOVE LDA .14 OTHERWISE, EXIT. FMGR 14 JMP PEXIT E-REG = 1 * * MOVE ID SEGMENT INTO SYSTEM * MOVE STA B SAVE COPY OF ID ADDRESS ADA .28 POINT TO WORD 29 LDA A,I GET THE WORD WITH SEQUENCE NUMBER AND B170K ISOLATE SEQUENCE NUMBER IOR CONLU SET IN USER'S CONSOLE STA ID+29 AND SET BACK INTO ID 29 * LDA DEFID SET A TO SOURCE (B TO DESTINATION) JSB .MVW MOVE THE ID SEGMENT DEF .30 NOP (FOR COMPATIBILITY) CLA,CLE SET UP FOR GOOD RETURN * PEXIT JSB $LIBX DONE! DEF *+1 DEF EXIT SKP * * SETPT (SET UP POINTERS TO SHORT ID SEGMENT) - SETS UP POINTERS * SID1,SID3,SID5,SID6,SID7,SID8 TO THE CORRESPONDING WORDS IN THE * CURRENT ID SEGMENT. WILL WRITE OUT AND READ NEXT SECTOR IF * NECESSARY. * * ON ENTRY IF INIT = -1, INITIALIZES SUBROUTINE AND CLEARS INIT. * USES VARIBLES SECBF(128) SECTOR BUFFER * SEKTR DISC ADDRESS TO READ * TRAK WRITE TO * SEC/T NUMBER OF SECTORS/TRACK * SETPT NOP ISZ INIT IS THIS THE INITIALIZE CALL? RSS NO, GO SET UP ID POINTERS JMP REED YES, GO READ SECTOR WITH SHORT ID SEGMENTS * LDA SID1 GET CURRENT SHORT ID POINTER ADA .8 AND POINT TO THE NEXT ID CPA ENDSB AT THE END OF THE SECTOR? JMP RITE THEN WRITE IT OUT AND READ THE NEXT BLOCK SET STA SID1 ELSE, STORE FOR WORD 1 ADA .2 ADD 2 FOR STA SID3 WORD 3 ADA .2 ADD 2 FOR STA SID5 WORD 5 INA INCREMENT STA SID6 FOR WORD 6 INA INCREMENT STA SID7 FOR WORD 7 INA INCREMENT STA SID8 FOR WORD 8 JMP SETPT,I EXIT * * RITE JSB EXEC WRITE OUT SECTOR CONTAINING UPDATED DEF *+7 SHORT ID SEGMENTS DEF .2 WRITE DEF PDSLU PROTECTED DISC LU DEF SECBF SECTOR BUFFER DEF .128 WHOLE SECTOR DEF TRAK DISC TRACK DEF SEKTR DISC SECTOR CPB .128 CHECK FOR COMPLETE TRANSMISSION RSS OK, GO READ JMP ER01 DISC ERROR, EXIT * REED LDA SEKTR GET CURRENT SECTOR ADDRESS ADA .2 INCREMENT TO THE NEXT SECTOR (64 WORD) CPA #SC/T OVERFLOW THIS TRACK? CLA,RSS YES, SET SECTOR TO 0 RSS NO, SKIP TRACK INCREMENT ISZ TRAK INCREMENT TRACK ADDRESS STA SEKTR STORE SECTOR ADDRESS JSB EXEC READ NEXT SECTOR FROM THE DISC DEF *+7 WHICH CONTAINS THE SHORT ID SEGMENTS DEF .1 READ DEF PDSLU PROTECTED DISC LU DSCBF DEF SECBF SECTOR BUFFER DEF .128 WHOLE SECTOR DEF TRAK DISC TRACK DEF SEKTR DISC SECTOR CPB .128 CHECK FOR COMPLETE TRANSMISSION RSS OK JMP ER01 DISC ERROR, EXIT * LDA DSCBF GET ADDRESS OF SECTOR BUFFER JMP SET AND SET UP NEW POINTERS SKP * * BUMP - BUMP DISC POINTERS TO POINT AT THE VARIOUS MAINS, BASE PAGES, * AND SEGMENTS CONTAINED WITHIN A TYPE 6 FILE. * * * CALLING SEQUENCE: * A = HIGH ADDRESS + 1 * B = LOW ADDRESS * JSB BUMP * A = SECTOR AND SECTR = SECTOR * B = TRACK AND TRACK = TRACK * SEC/T = SECTORS/TRACK * * BUMP NOP CMB,INB SET THE LOW ADDRESS NEGATIVE ADA B AND ADD TO HIGH ADDRESS. A = PROGRAM SIZE CLB CLEAR B FOR DIVIDE DIV .128 DIVIDE BY 128 FOR NUMBER OF SECTORS SZB IF REMAINDER IS ZERO, SKIP INA OTHERWISE ADD ONE TO SECTOR COUNT FOR A PARTIAL SECTOR ADA SECTR ADD IN CURRENT SECTOR CLB CLEAR B FOR DIVIDE DIV SEC/T DIVIDE BY SECTORS/TRACK STB SECTR STORE REMAINDER AS SECTOR ADA TRACK AND ADD QUOTIENT TO TRACK ADDRESS STA TRACK AND SAVE AS CURRENT TRACK ADDRESS SWP PUT SECTORS IN A AND TRACK IN B JMP BUMP,I RETURN SKP * * SUM - USED TO SUM THE WORDS IN ID SEGMENTS FOR CHECKSUM TESTS * * SUM NOP P+1 = ADDRESS, P+2 = NEGATIVE NUMBER OF WORDS LDB SUM,I ISZ SUM STB #MOVE SAVE START SUMMING ADDRESS LDB SUM,I GET NUMBER OF WORDS ISZ SUM POINT TO RETURN ADDRESS ADA #MOVE,I ACCUMULATE THE SUM ISZ #MOVE BUMP TO NEXT WORD INB,SZB DONE? JMP *-3 NO, ADD THE NEXT JMP SUM,I YES, RETURN SKP * * CONSTANTS * DZERO DEF ZERO ZERO NOP THIS ARRAY IS USED TO FIND NOP A BLANK NOP ID SEGMENT B77 OCT 77 .3 DEC 3 .4 DEC 4 .1 DEC 1 .34 DEC 34 .19 DEC 19 .11 DEC 11 M64 DEC -64 UBYTE OCT 177400 IDBIT OCT 2000 .39 DEC 39 .40 DEC 40 .99 DEC 99 B1777 OCT 1777 B7700 OCT 7700 M256 DEC -256 M8 DEC -8 .23 DEC 23 .14 DEC 14 .28 DEC 28 B170K OCT 170000 .30 DEC 30 .8 DEC 8 .2 DEC 2 .128 DEC 128 * * VARIBLES * LU NOP DISC LU PDSLU NOP PROTECTED DISC LU IDBUF BSS 34 ID SEGMENT BUFFER ID EQU IDBUF-1 TRACK NOP TRACK WORD FOR BUMP SECTR NOP SECTOR WORD FOR BUMP TRAK NOP TRACK WORD FOR SETPT SEKTR NOP SECTOR WORD FOR SETPT SEC/T NOP SECTORS/TRACK FOR DISC 'LU' #SC/T NOP LOGICAL SECTORS PER TRACK NEGMN NOP NEGATIVE VALUE OF MAIN TRACK HMNBP NOP HIGH MAIN BASE PAGE ADDRESS SECBF BSS 128 SECTOR BUFFER ENDSB DEF * END OF SECTOR BUFFER ADDRESS LPCNT NOP LOOP COUNTER TR NOP TEMPORARY TRACK WORD SID1 NOP SHORT ID POINTER TO WORD 1 SID3 NOP SHORT ID POINTER TO WORD 3 SID5 NOP SHORT ID POINTER TO WORD 5 SID6 NOP SHORT ID POINTER TO WORD 6 SID7 NOP SHORT ID POINTER TO WORD 7 SID8 NOP SHORT ID POINTER TO WORD 8 CONLU NOP CONSOLE LU #MOVE NOP USED BY SUM INIT NOP INITIALIZATION FLAG USED BY SETPT * * A EQU 0 B EQU 1 END EQU * END