ASMB,R,L,C,Z HED (FMP) IDRPL: SUBROUTINE TO DO A FMGR ":RP,PROG" * NAME: IDRPL * SOURCE: 92071-18062 * RELOC: 92071-16062 * PGMR: M.L.K. * MOD: E.D.B. * * *************************************************************** * * (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 IDRPL,7 92071-1X062 REV.2041 800421 * ENT IDRPL * EXT GTOPN, NAM.. EXT IDSGA, LOGLU, .MWI, .XLA, .CAX EXT EXEC, .ENTR, $LIBR, $LIBX, $SETP, $IDSZ IFZ *** L/20 CODE *** EXT $CKSM, $SCCK XIF IFN *** L/10 CODE *** EXT $FWBG, $BGBP, $CKSM XIF * EXT F.DCB, F.LU, F.TR2, F.SC2, F.S/T, F.FLG SUP SKP * * DESCRIPTION * * IDRPL CREATES AN ID SEGMENT FOR A PROGRAM * * CALLING SEQUENCE: * * CALL IDRPL (IDCB,IERR,NAME,IPERM) * IERR = IDRPL (IDCB,IERR,NAME,IPERM) * * WHERE: * * IERR WILL BE ERROR RETURN CODE (SAME AS ERROR CODES IN FMGR) * * IDCB IS AN OPEN DATA CONTROL BLOCK (144-WORD ARRAY) * FOR THE TYPE 6 FILE TO BE RESTORED. * * NAME IS 5 CHARACTER PROGRA NAME (3-WORD ARRAY) TO PUT INTO * ID SEGMENT. * * IPERM IS 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 NUMBER (L/10 ONLY) * 26 LO BASE PAGE BLOCK NUMBER (L/10 ONLY) * HI MAIN BLOCK NUMBER * 27 MAIN TRACK NUMBER * 28 LO MAIN DISC LU * 29 LO CONSOLE LU (FROM LOGLU) * HI SEQUENCE NUMBER (FROM OLD ID SEGMENT) * * SHORT ID SEGMENT * 3 MAIN TRACK OFFSET (L/10 ONLY) * 6 BASE PAGE TRACK OFFSET (L/10 ONLY) * 7 BASE PAGE BLOCK NUMBER (L/10 ONLY) * 8 SYSTEM CHECKSUM (L/10 ONLY) * * POSSIBLE ERRORS: * * 0 SUCCESSFUL INSTALLATION OF ID SEGMENT INTO SYSTEM * -11 IDCB NOT OPEN * 14 NO BLANK ID SEGMENTS OR EXTENSIONS AVAILABLE * -15 ILLEGAL NAME * 19 A CHECKSUM (ID(34), ID(35), ID(36)) DID NOT MATCH. * 23 DUPLICATE PROGRAM NAME * 39 DISC ADDRESS OUT OF RANGE * 40 MEMORY BOUNDS CONFLICT * ?? PROGRAM ALREADY RP'ED * * NOTES: * (1) IDRPL DOES NOT CLOSE THE FILE. * (2) RECOMMEND FILE BE NON-EXCLUSIVELY OPENED. * (3) E-REG = 1 IF ERROR; E=0 IF NO ERROR (FOR SPL). * (4) ONLY THE DCB HEADER IS USED BY THIS SUBROUTINE. * * SPECIAL ASSEMBLY INSTRUCTIONS: * THIS FILE CONTAINS SOURCE CODE FOR BOTH THE RTE-L AND RTE-L/20 * IDRPL SUBROUTINE. ASSEMBLY THE CODE WITH THE N OPTION FOR * THE RTE-L VERSION, AND WITH THE Z OPTION FOR THE RTE-L/20 * VERSION SKP * * ENTRY * IDRPL NOP DUMMY ENTRY POINT LDA DZERO STA PERM LDA IDRPL STA DRPL JMP DRPL+1 * 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 MAKE LOCAL COPY OF DCB POINTERS LDB F.DCB JSB $SETP DEF .16 NOP * JSB GTOPN GET PROGRAM'S OPEN FLAG DEF *+1 CPA F.FLG,I IS IT THE SAME AS IN DCB? RSS JMP ER11 NO, TAKE ERROR EXIT * JSB NAM.. CHECK FOR LEGAL NAME DEF *+2 DEF NAME,I * SZA NAME OK? JMP EREX NO, FMGR ERROR -15 SKP * * PROCESS REQUEST * LDA F.LU,I GET WORD CONTAINING LU AND B77 ISOLATE LU IOR B7700 ADD PROTECT BITS STA PDSLU SAVE FOR EXEC * IFN *** L/10 CODE *** LDA F.S/T,I GET SECTORS / TRACK ARS CONVERT TO BLOCKS STA BK/TR XIF * JSB EXEC READ SKELETON ID SEGMENT FROM FILE DEF *+7 DEF .1 DEF PDSLU PROTECTED DISC LU DEFID DEF IDBUF DESTINATION BUFFER ADDRESS DEF IDSIZ BUFFER LENGTH DEF F.TR2,I DISC TRACK DEF F.SC2,I DISK SECTOR * JSB .XLA GET SYSTEM CHECKSUM DEF $CKSM+0 CPA CKSM IF SAME AS ID SEGMENT, RSS THEN CONTINUE JMP ER19 * IFZ *** L/20 CODE *** LDA ID+16 GET ID SEGMENT STATUS WORD AND B4K ISOLATE SYSTEM-COMMON FLAG SZA,RSS IF PROGRAM DOESN'T USE SYSTEM COMMON JMP NOCHK THEN DON'T TEST CHECKSUM * JSB .XLA GET SYSTEM COMMON CHECKSUM DEF $SCCK+0 CPA SCCK IF SAME AS ID SEGMENT, RSS THEN CONTINUE JMP ER19 XIF * NOCHK LDA DEFID GET THE LONG ID SEGMENT'S ADDRESS STA #MOVE SAVE CHECKSUM START ADDRESS LDB NCKSM GET NUMBER OF WORDS (NEGATIVE) CLA CLEAR CHECKSUM FOR TOTALING * SUM1 ADA #MOVE,I ACCUMULATE THE SUM ISZ #MOVE BUMP TO NEXT WORD INB,SZB IF NOT DONE, JMP SUM1 THEN ADD THE NEXT * CPA CKSM1 IF EQUAL TO INTERNAL CHECKSUM, RSS THEN CONTINUE JMP ER19 ELSE TAKE ERROR EXIT SKP * * SET UP LONG ID SEGMENT * LDA F.SC2,I GET STARTING SECTOR NUMBER ADA .2 BUMP TO BEGINNING OF MAIN (RECORD 2) CLB CLEAR B FOR DIVIDE DIV F.S/T,I DIVIDE BY SECTORS / TRACK ADA F.TR2,I ADD STARTING TRACK NUMBER BRS CONVERT SECTORS TO BLOCKS * IFN *** L/10 CODE *** DST ID+26 SAVE MAIN TRACK AND BLOCK ADDRESS DST TRACK SAVE TRACK AND BLOCK FOR BUMP LDA ID+22 FETCH MAIN HIGH ADDRESS LDB ID+21 FETCH MAIN LOW ADDRESS JSB BUMP CALCULATE DISC ADDRESS ALF,ALF ALIGN BASE PAGE BLOCK ADDRESS IOR ID+26 MERGE WITH MAIN BLOCK ADDRESS STA ID+26 AND SAVE AGAIN * LDA ID+27 GET MAIN TRACK ADDRESS CMA,INA NEGATE STA NEGMN AND SAVE FOR LATER ADB A ADD BASE PAGE TRACK ADDRESS LDA N64 TEST IF OFFSET NEEDS MORE THAN 6 BITS ADA B SSA,RSS IF OUT OF RANGE, JMP ER39 THEN TAKE ERROR EXIT * CLA CLEAR FOR SHIFT ASR 6 MOVE OFFSET (B-REG) TO HI BITS OF A-REG IOR ID+25 MERGE WITH OLD WORD 25 STA ID+25 AND SAVE AGAIN XIF IFZ *** L/20 CODE *** SWP ALF,ALF SHIFT MAIN BLOCK ADDRESS TO HIGH BYTE AND NB400 ISOLATE IT IOR ID+26 MERGE WITH CURRENT WORD 26 DST ID+26 SAVE MAIN TRACK AND BLOCK ADDRESS XIF * LDA F.LU,I GET DISC LU AND B77 ISOLATE LU IOR ID+28 MERGE WITH CURRENT WORD 28 STA ID+28 SAVE IN WORD 28 * JSB LOGLU GET CONSOLE LU DEF *+2 DEF PDSLU DUMMY PARAMETER STA ID+29 SAVE IN WORD 29 * LDA NAME,I GET FIRST TWO CHARACTERS STA ID+13 SAVE 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 SAVE THE SECOND WORD LDA B MOVE LAST CHARACTER TO A AND NB400 CLEAR LOWER BYTE STA ID+15 AND SAVE 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 SAVE 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 * IFN *** L/10 CODE *** DLD F.TR2,I GET DISC ADDRESS DST TRAK AND SAVE FOR SETPT * 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 * JSB .XLA GET BG BOUNDRY IN CASE REAL TIME DEF $FWBG+0 STA HISEG SAVE IN PLACE OF HI SEGMENT JSB .XLA GET BG BP BOUNDRY IN CASE REAL TIME DEF $BGBP+0 STA HIBP SAVE IN PLACE OF HI SEGMENT BP * LDA ID+24 GET BASE PAGE LOW ADDRESS AND B1777 ISOLATE, STA B AND PUT INTO B LDA ID+25 GET BASE PAGE HIGH ADDRESS + 1 AND B1777 ISOLATE, STA HMNBP AND SAVE FOR LOOP JSB BUMP POSITION TRACK AND SECTOR TO SEGMENT 0 * LOOP JSB SETPT SET UP POINTERS TO SHORT ID SEGMENT DLD TRACK GET CURRENT TRACK AND BLOCK OF SEGMENT MAIN STA TR SAVE TRACK FOR LATER STB SID7,I SAVE BLOCK IN THE SHORT ID WORD 7 ADA NEGMN SUBTRACT THE MAIN TRACK TO GET OFFSET LDB N256 TEST WHETHER OFFSET IS GREATER THAN 255 ADB A AND WON'T FIT IN A BYTE SSB,RSS IF OUT OF RANGE JMP ER39 THEN TAKE ERROR EXIT * STA B MOVE OFFSET INTO B-REG LDA SID3,I GET LAST LETTER OF NAME AND AND NB400 ISOLATE IT IOR B MERGE WITH OFFSET STA SID3,I AND SAVE AGAIN SKP * * SET UP FOR SEGMENT'S BASE PAGE * LDA SID5,I GET THE SEGMENT'S MAIN HIGH ADDRESS + 1 LDB ID+22 USE THE MAIN 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 SAVE 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 N64 TEST IF GREATER THAN 64 ADA B SSA,RSS IF OUT OF RANGE, JMP ER39 THEN TAKE ERROR EXIT * BLF,BLF POSITION TRACK OFFSET TO UPPER RBL,RBL SIX BITS LDA SID6,I GET BASE PAGE HIGH ADDRESS + 1 IN A AND B1777 ISOLATE BASE PAGE HIGH ADDRESS + 1 ADB A MERGE WITH BASE PAGE TRACK OFFSET STB SID6,I AND SAVE AGAIN LDB HMNBP LOAD MAIN BASE PAGE HIGH ADDRESS JSB BUMP NOW UPDATE DISC ADDRESSES * * CALCULATE THE SHORT ID SEGMENT CHECKSUM * LDA SID1 GET THE SHORT ID SEGMENT'S ADDRESS STA #MOVE SAVE CHECKSUM START ADDRESS LDB N7 GET NUMBER OF WORDS (NEGATIVE) CLA CLEAR CHECKSUM FOR TOTALING * SUM2 ADA #MOVE,I ACCUMULATE THE SUM ISZ #MOVE BUMP TO NEXT WORD INB,SZB IF NOT DONE, JMP SUM2 THEN ADD THE NEXT * STA SID8,I SAVE CHECKSUM 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 N8 AND SUBTRACT 8 AND SAVE IN SID1. THIS WILL STA SID1 FORCE A WRITE OF THE CURRENT SECTOR. JSB SETPT NOW CALL TO DO WRITE XIF SKP * * WRITE THE ID SEGMENT INTO SYSTEM MEMORY * WRTID JSB $LIBR GO PRIVILEGED TO PREVENT NOP CONFLICTS WITH OTHER ROUTINES * JSB IDSGA SEARCH FOR DUPLICATE PROGRAM NAME DEF *+2 DEF NAME,I * SEZ IF NOT FOUND, JMP FREID * * WAS IT ALREADY RP'ED * * JMP PER?? INDICATE ALREADY RP'ED JMP PER23 INDICATE DUPLICATE PROGRAM NAME * * SEARCH FOR FREE ID SEGMENT * FREID JSB IDSGA LOOK FOR BLANK NAME (EMPTY ID SEGMENT) DEF *+2 DEF ZERO ARRAY OF THREE ZEROS * SEZ IF NOT FOUND JMP PER14 THEN INDICATE NO ID SEGMENTS AVAILABLE * * MOVE ID SEGMENT INTO SYSTEM * STA B SAVE COPY OF ID ADDRESS FOR MOVE ADA .28 BUMP TO WORD 29 JSB .XLA GET WORD WITH SEQUENCE NUMBER DEF A,I AND B170K ISOLATE SEQUENCE NUMBER IOR ID+29 MERGE WITH USER'S CONSOLE LU STA ID+29 AND SAVE IN WORD 29 * JSB .XLA SET TO MOVE ID SEGMENT DEF $IDSZ+0 JSB .CAX (MOVE TO X-REG FOR .MWI) LDA DEFID SET A TO SOURCE (B TO DESTINATION) * JSB .MWI MOVE THE ID SEGMENT * CLA,CLE NO ERROR INTENDED JMP PEREX * PER?? LDA .?? PROGRAM ALREADY RP'ED JMP PEREX * PER23 LDA .23 DUPLICATE PROGRAM NAME JMP PEREX * PER14 LDA .14 REQUIRED ID-SEGMENT NOT FOUND * PEREX JSB $LIBX DONE! DEF *+1 DEF EXIT1 SKP * * EXIT * ER19 LDA .19 CHECKSUM ERROR JMP EREX * ER39 LDA .39 CANNOT RP PROGRAM JMP EREX * ER01 CCA DISC ERROR JMP EREX * ER11 LDA N11 FILE NOT OPEN TO PROGRAM * EREX CCE ERROR EXIT E-REG = 1 * EXIT1 STA IERR,I SAVE ERROR RETURN CODE JMP DRPL,I AND RETURN 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 * BK/TR NUMBER OF BLOCKS/TRACK * IFN *** L/10 CODE *** 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, SAVE 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 F.S/T,I OVERFLOW THIS TRACK? CLA,RSS YES, SET SECTOR TO 0 RSS NO, SKIP TRACK INCREMENT ISZ TRAK INCREMENT TRACK ADDRESS STA SEKTR SAVE 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 XIF 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 = BLOCK AND BLOCK = CURRENT BLOCK * B = TRACK AND TRACK = CURRENT TRACK * BK/TR = BLOCKS/TRACK * IFN *** L/10 CODE *** 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 GIVING NUMBER OF BLOCKS SZB IF REMAINDER IS NOT ZERO INA THEN ADD ONE TO BLOCK COUNT FOR A PARTIAL BLOCK ADA BLOCK ADD IN CURRENT BLOCK CLB CLEAR B FOR DIVIDE DIV BK/TR DIVIDE BY BLOCKS/TRACK STB BLOCK SAVE REMAINDER AS CURRENT BLOCK ADA TRACK ADD QUOTIENT TO TRACK ADDRESS STA TRACK SAVE AS CURRENT TRACK ADDRESS SWP PUT BLOCK IN A, TRACK IN B JMP BUMP,I RETURN XIF SKP * * STORAGE AREA * ZERO NOP THIS ARRAY IS USED TO FIND NOP A BLANK NOP ID SEGMENT * N7 DEC -7 N8 DEC -8 N11 DEC -11 N64 DEC -64 N256 DEC -256 * .1 DEC 1 .2 DEC 2 .8 DEC 8 .14 DEC 14 .16 DEC 16 .19 DEC 19 .23 DEC 23 .28 DEC 28 .39 DEC 39 .99 DEC 99 .128 DEC 128 .?? DEC 23 * B77 OCT 77 B1777 OCT 1777 B4K OCT 4000 B7700 OCT 7700 B170K OCT 170000 * NB400 OCT -400 * IDBIT OCT 2000 * * DZERO DEF ZERO * IFN *** L/10 CODE *** TRACK NOP (BUMP) TRACK ADDRESS BLOCK NOP (BUMP) BLOCK ADDRESS * TRAK NOP (SETPT) TRACK ADDRESS SEKTR NOP (SETPT) SECTOR ADDRESS * BK/TR NOP (BUMP) BLOCKS/TRACK FOR DISC 'LU' NEGMN NOP NEGATIVE VALUE OF MAIN TRACK HMNBP NOP BASE PAGE HIGH 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 * INIT NOP (SETPT) INITIALIZATION FLAG XIF * #MOVE NOP USED BY SUM * IDSIZ ABS IDEND-IDBUF SKELETON IDBUFSEGMENT SIZE NCKSM ABS IDBUF-CKSM1 NEGATIVE WORDS TO CHECKSUM * PDSLU NOP PROTECTED DISC LU * IFN *** L/10 CODE *** IDBUF BSS 30 - ID SEGMENT BUFFER CKSM NOP ! CKSM1 NOP ! HISEG NOP ! HIBP NOP - XIF IFZ *** L/20 CODE *** IDBUF BSS 30 - HISEG NOP ! HIBP NOP ! NOP ! CKSM NOP ! SCCK NOP ! CKSM1 NOP - XIF * ID EQU IDBUF-1 IDEND EQU * * A EQU 0 B EQU 1 * END EQU * * END