ASMB,R,Q,C HED "IDRP" FTN/SPL SUBR TO DO A FMGR ":RP,PROG" FROM ANY CART. * SOURCE: 92067-18561 * RELOC: 92067-16185 * PGMR: D.L.B., D.C.L. * * *************************************************************** * * (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 IDRP,7 92067-16185 REV.2026 800305 * * MODIFICATION RECORD: * DATE REASON BY WHOM * 1) 2-2-76 TO ADD PRIVILEDGE READ CODE TO EXEC CALL TO * THE DISC CALL TO THE FILE. (DLB) * 2) 8-16-77 TO ZERO THE 5 TEMP WORDS IN THE RESTORED * ID SEGMENT * 3) 10-14-77 TO SUPPORT EXTENDED ID SEGMENT * 4) 1-6-78 TO NOT USE DYNAMIC BASE PAGE WORDS IN CALCULATION * OF SYSTEM CHECKSUM (RTE-IV ONLY). (GLM) * 5) 4-3-78 CROSS-MAP ACCESS TO ID SEGMENTS FOR RTE-IV * TYPE 4 PROGRAMS USING THIS ROUTINE * 6) 5-31-78 TO PRESERVE WORD 32 OF NEW ID SEGMENT (BL) * 7) 9-20-78 TO SET "I'M A COPY" FLAG (GLM) * 8) 1-22-79 TO RETURN NEW IDSEG ADDR., TO PRESERVE DON'T COPY * FLAG, AND TO SKIP ERR 23 IF DISC ADDRESSES MATCH * 9) 2-22-79 TO REMOVE ID SEGMENT IF EMA PGM AND NO ID EXTENSIONS * ARE AVAILABLE * 10) 7-26-79 TO RESTORE TIME LIST WORD (WD 18) SST #4429 * 11) 10-16-79 TO TEST IF PROTECTED TYPE 6 PGM BEFORE RESTORING * 12) 12-19-79 TO :RP FROM ANY CARTRIDGE. IF TYPE 6 NOT ON LU * 2 OR 3 THEN COPY INTO POOL TRACKS (FAKE A TEMPORARY * PROGRAM LOAD). THIS SUBROUTINE WAS MADE BY * MODIFYING THE 2001 REV. OF . (DCL) * 13) 12-27-79 FIXED ORIGINAL BUG IN . DIDN'T SETUP * "DON'T COPY" BIT IN IDSEG CORRECTLY. (DCL) * 14) 3-5-80 CLEANED UP FOR RELEASE (DCL) * * SUP PRESS EXTRANEOUS LISTINGS * ENT IDRP 791219 EXT EXEC,.ENTR,$LIBR,$LIBX,IDSGA,NAM..,$OPSY,$IDEX EXT .OWNR,$SMCA,$SMGP,$SMID,ISMVE,SESSN A EQU 0 B EQU 1 KEYWD EQU 1657B RTDRA EQU 1750B 780106 GLM BGDRA EQU 1754B 780106 GLM TATLG EQU 1755B 780106 GLM TAT EQU 1656B TAT BASE ADDR 791219 TATSD EQU 1756B # TRACKS ON LU2 791219 SECT2 EQU 1757B # SECTORS/TRACK ON LU2 791219 SECT3 EQU 1760B # SECTORS/TRACK ON LU3 791219 BPA1 EQU 1742B XEQT EQU 1717B EQTA EQU 1650B SKP * * PURPOSE: * * TO ACCOMPLISH THE EQUIVALENT OF A FMGR ":RP,PROG" IN A SUBROUTINE. * AND TO ALLOW THE TYPE 6 FILE TO RESIDE ON ANY CARTRIDGE. * IF THE TYPE 6 FILE IS ON LU2 OR LU3 THEN AN ID SEGMENT IS * CONSTRUCTED WHICH POINTS DIRECTLY TO THE TYPE 6 FILE. * IF THE TYPE 6 FILE IS NOT ON LU2 OR LU3, THE PROGRAM IMAGE PART * OF THE FILE IS COPIED INTO SYSTEM POOL TRACKS AND AN ID SEGMENT * IS CONSTRUCTED WHICH POINTS TO THESE TRACKS. (THIS SIMULATES * A TEMPORARY PROGRAM LOAD.) * * CALLED: * * CALL IDRP (IDCB,IERR,NAME,IBUF,IBUFL,NID) * -OR- * IF (IDRP (IDCB,IERR,NAME,IBUF,IBUFL,NID).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 * NAME = 5 CHARACTER BUFFER OF THE PROGRAM NAME PUT IN ID SEGMENT * IBUF = BUFFER FOR DISK TRANSFER IF FILE IS NOT ON LU2 OR LU3 * IBUFL= LENGTH OF "IBUF" (MUST BE AT LEAST 64 WORDS, * BUT SHOULD BE LARGE FOR EFFICIENT TRANSFERS) * NID = (OPTIONAL) RETURN ADDRESS OF NEW ID SEGMENT * * SKELETON ID: (1ST 37 WORDS IN FILE) * * ID(1) = NOT USED, NOR CHANGED IN SYSTEM * ID(2) - ID(6) = XTEMP(1) - XTEMP(5) IN DEFAULT CASE. (I.E. '*RU,PROG') * ID(7) = PRIORITY OF PROGRAM IF PROGRAM TYPE IS 2 OR 3, ELSE NOT USED * ID(8) = ENTRY ADDRESS OF PROGRAM * ID(9) - ID(12) = NOT USED (ID(11) 'XB' IS SET TO XTEMP(1)) * ID(13) - ID(14) = NOT USED * ID(15) = PROG TYPE BITS 0-3, BITS 4-15 NOT USED * ID(16) - ID(21) = NOT USED (ID(19),ID(20) = 25000B,177574B) * ID(18) = TIME PARAMETERS * ID(22) = 0 IF RTE-II, ??? IF RTE-III. (SEE RTE-III MANUAL) * ID(23) = LOW MAIN MEMORY LOAD ADDRESS * ID(24) = HI MAIN MEMORY LOAD ADDRESS + 1 * ID(25) = LOW BASE PAGE LOAD ADDRESS * ID(26) = HI BASE PAGE LOAD ADDRESS + 1 * ID(27) = DISC ADDR - LU(15),TRK(14-7),SECTOR(6-0) * ID(28) = NOT USED * ID(29) = EMA SIZE (BITS 0-9), ID EXT# (BITS 10-15) * ID(30) = HI-ADDR + 1 OF LARGEST SEGMENT * ID(31) = * ID(32) = * ID(33) = * ID(34) = ARITHMETIC SUM OF ID(1) THRU ID(33) * ID(35) = SYSTEM SET UP CODE (SUM 1650-1657 + 1742-1764) * ID(36) = ID EXTENSION WORD 0 * ID(37) = ID EXTENSION WORD 1 * ID(39) = USER ID REQUIRED TO RUN OR RP IF SIGN BIT SET * ID(40) = GROUP ID REQUIRED TO RUN OR RP IF SIGN BIT SET * ID(41) = CAPABILITY LEVEL REQUIRED TO RUN OR RP * * RETURN: * * IERR = 0 > SUCCESSFUL INSTALLATION OF ID SEGMENT INTO SYSTEM * E-REG = 1 IF ERROR, ELSE E-REG = 0 (FOR SPL FRETURN) * IERR = -1 > DISC ERROR * IERR = -11 > IDCB NOT OPEN * IERR = 14 > NO BLANK ID SEGMENTS OR EXTENSIONS AVAILABLE * IERR = -15 > ILLEGAL NAME * IERR = 16 > FILE NOT ON DISC LU = 2 OR LU = 3 * AND INSUFFICIENT SYSTEM POOL TRACKS * AVAILABLE FOR COPY * IERR = 19 > ID(34),ID(35) WORDS DID NOT CHECKSUM CORRECTLY. * IERR = 23 > DUPLICATE PROGRAM NAME. * IERR = 75 > TYPE 6 PGM IS PROTECTED ON USER ID * IERR = 76 > TYPE 6 PGM IS PROTECTED ON GROUP ID * IERR = 77 > TYPE 6 PGM IS PROTECTED ON CAPABILITY LEVEL * IERR = 78 > IBUFL < 64 WORDS OR INTERNAL CONSISTENCY * CHECKS HAVE FAILED. CAN'T RP PROGRAM. * * NOTES: * * (1) A-REG = IERR ON RETURN, THEREFORE MAY BE USED AS FUNCTION * (2) IDRP DOES NOT CLOSE THE FILE. * (3) RECOMMEND FILE BE NON-EXCLUSIVELY 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. * * TEST PROGRAM: *FTN,L * PROGRAM TYRP(2,99) * DIMENSION NAME(3),LU(5),NUNAM(3),IDCB(144),IBUF(6144) * DATA IBUFL/6144/ * CALL RMPAR(LU) * IF (LU.EQ.0) LU = 1 * 1 WRITE (LU,11) * 11 FORMAT ("INPUT PROGRAM FILE NAME? _") * READ (LU,12) NAME * IF (NAME.EQ.2H/E) GO TO 9999 * WRITE (LU,13) * 13 FORMAT ("INPUT NEW NAME FOR PROG? _") * READ (LU,12) NUNAM * IF (NUNAM.EQ.2H/E) GO TO 9999 * 12 FORMAT (3A2) * IF(OPEN(IDCB,IERR,NAME,1).LT.0) GO TO 33 * IF(IDRP(IDCB,IERR,NUNAM,IBUF,IBUFL).EQ.0) GO TO 9999 * 33 WRITE (LU,46) IERR * 46 FORMAT ("FMGR ERROR "I3) * GO TO 1 * 9999 END * END$ SKP IDCB NOP OPEN DCB ADDRESS IERR NOP RETURNED ERROR CODE NAME NOP FIVE CHAR ASCII NAME TO GIVE PROGRAM IBUF NOP DISK TRANSFER BUFFER 791219 IBUFL NOP DISK TRANSFER BUFFER LENGTH 791219 NID NOP ADDRESS OF NEW ID SEGMENT * IDRP NOP ENTRY JSB .ENTR DEF IDCB * CCA SET FLAG TO INDICATE 791219 STA ITRAK NO POOL TRACKS ALLOCATED YET 791219 * LDA IDCB,I GET TRACK-LU WORD FROM DCB LDB IDCB CALCULATE FILE TRACK/SECTOR WORD ADB O3 ADDRESSES STB DCB3 INB STB DCB4 AND SET INTO EXEC CALL ADB O4 BUMP TO SECT/TRACK WORD STB DCB8 AND SAVE IDCB(9) ADDRESS 791219 CCE,INB PREPARE E-REG IN CASE OF ERROR LDB B,I GET OPEN FLAG CPB XEQT DCB OPEN? RSS YES, CHECK DISC LU JMP ERR11 NO, ERROR -11 AND O77 MASK TO JUST LU OF DISC STA DLU SAVE DISK LU # 791219 IOR PRC MERGE IN PRIVILEDGED CODE STA FDLU SAVE FOR EXEC CALL 791219 AND O77 TAKE IT OUT CLE,ERA SAVE LU=2 OR LU=3 FLAG IN E-REG CPA O1 CHECK IF EQUAL TO 2 OR 3? ERA,SLA YES, PUT FLAG IN BIT 15 & SKIP CLA NO, FILE NOT ON LU 2 OR 3 791219 STA TEMP1 SAVE DISC LU FOR LATER USE JSB EXEC READ 1ST 41 WORDS OF FILE DEF *+7 DEF O1 READ DEF FDLU DISC LU 791219 DEFID DEF IDBUF DESTINATION BUFFER ADDRESS DEF D41 BUFFER LENGTH DCB3 DEF * DISC TRACK DCB4 DEF * DISK SECTOR CLA,CCE JSB SUM CALCULATE CHECKSUM DEF IDBUF OF THE 1ST 33 WORDS OF FILE DEC -33 CPA ID+34 EQUAL TO WORD 34? CLA,RSS YES JMP ERR19 NO JSB SUM 1650B TO 1657B DEF EQTA DEC -8 JSB SUM 1742B TO 1747B 780106 GLM DEF BPA1 780106 GLM OCT -6 780106 GLM JSB SUM 1755B TO 1764B 780106 GLM DEF TATLG 780106 GLM DEC -8 780106 GLM * * IF NOT RTE-IV, WE MUST INCLUDE LOCATIONS 1750B TO 1754B. 780106 GLM * LDB $OPSY FETCH SYSTEM 780106 GLM CPB M9 IF RTE-IV 780106 GLM JMP IDOK? THEN JUST CHECK IT. 780106 GLM * JSB SUM 780106 GLM DEF RTDRA INCLUDE 1750B TO 1754B (RTE-II&III ONLY)780106 GLM OCT -5 780106 GLM * IDOK? CPA ID+35 COMPARE? JMP DORP YES, CONTINUE ERR19 LDA D19 NO, FMGR ERROR 19 JMP EREXT ERR01 CCA DISK ERROR 800305 JMP EREXT 800305 ERR75 LDA D75 TYPE 6 PGM IS PROTECTED ON USER ID JMP EREXT ERR76 LDA D76 TYPE 6 PGM IS PROTECTED ON GROUP ID JMP EREXT ERR77 LDA D77 TYPE 6 PGM IS PROTECTED ON CAPABILITY LEVEL JMP EREXT ERR78 LDA D78 INTERNAL CONSISTENCY CHECK FAILED 800305 JMP EREXT 800305 ERR11 LDA D11 CMA,INA,RSS MAKE NEGATIVE ERR16 LDA O20 GET DEC 16 EREXT CCE ERROR EXIT E-REG = 1 EXIT STA IERR,I TELL CALLER RETURN CODE * STA TEMP1 SAVE A-REG 791219 ELA 791219 STA TEMP2 SAVE E-REG 791219 * * RELEASE ANY TRACKS THIS SUBROUTINE HAS ALLOCATED * WHICH IS STILL OWNS. * LDA ITRAK LOAD TRACK ALLOCATE FLAG 791219 SSA TRACKS ALLOCATED? 791219 JMP .L2 -NO 791219 * JSB EXEC RELEASE TRACKS 791219 DEF *+1+4 791219 DEF O5 791219 DEF NTRAK 791219 DEF ITRAK 791219 DEF IDISC 791219 * .L2 LDA TEMP2 791219 ERA RESTORE E-REG 791219 LDA TEMP1 RESTORE A-REG 791219 * CLB STB NID CLEAR OPTIONAL PARAMETER JMP IDRP,I RETURN IERR = A-REG SPC 1 DORP LDA $OPSY OP SYSTEM IDENTIFIER *780403* ERA MOVE MAPPED BIT FOR SLA *780403* STA STYPE SAVE FOR LOADA,STORA ROUTINES *780403* LDA DCB3,I GET START TRACK NUMBER *780403* LSL 7 PUT IN BITS 7-14 OF A-REG LDB DCB4,I GET STARTING SECTOR NUMBER ADB O2 BUMP TO SECOND BLOCK OF FILE CPB DCB8,I CHECK IF TRACK CROSSING?(IDCB(9)) 791219 LDB O200 YES, BUMP TRACK>SET SECTOR=0 ADA B MERGE SECTOR OR BUMP TRACK IOR TEMP1 MERGE IN DISC LU STA ID+27 PUT IN THE SKELETON IDSEG SPC 1 LDA ID+18 GET TIME LIST WORD STA DEFTM+3 SAVE IT LDA ID+15 GET PROGRAM TYPE AND O7 MASK DOWN TO 2,3 OR 5 STA ID+1 SPC 1 LDB D99 SET PRIORITY TO 99 IF CPA O5 PROGRAM IS TYPE 5 STB ID+7 SPC 1 * CHECK THAT NAME IS AS LEGAL AS A FILE NAME SPC 1 JSB NAM.. USE FMP NAME CHECKING ROUTINE DEF *+2 DEF NAME,I SZA NAME OK? JMP EREXT NO, FMGR ERROR -15 SPC 1 * THE FOLLOWING CODE TESTS WHETHER THE TYPE 6 PROGRAM IS PROTECTED * BY A USER ID, A GROUP ID, OR BY A MINIMUM CAPABILITY LEVEL SPC 1 JSB SESSN CHECK IF IN SESSION DEF *+2 DEF XEQT ID SEGMENT ADDRESS SEZ IN SESSION (E=0)? JMP PRIV NO, SO SKIP TESTS SPC 1 STB SESWD SAVE ID SEGMENT SESSION WORD JSB ISMVE GET USER ID FROM SESSION CONTROL BLOCK DEF *+5 DEF SESWD ID SEGMENT SESSION WORD DEF $SMID SCB OFFSET TO USER ID DEF TEMP RETURN CALLER'S USER ID DEF O1 ONE WORD LDA TEMP CHECK CALLER'S USER ID CPA O7777 SYSTEM MANAGER? JMP PRIV YES, SO ALLOW RP SPC 1 LDA ID+39 GET USER ID FROM TYPE 6 FILE, WORD 39 ELA ISOLATE SIGN BIT (SET MEANS USER ID MUST MATCH) SEZ,RSS SIGN BIT SET? JMP GTGID NO, NOT PROTECTED ON USER ID SPC 1 CLE,ERA CLEAR SIGN BIT FROM USER ID WORD CPA TEMP DOES USER ID REQUIRED MATCH CALLER'S USER ID? JMP GTCAP YES, NOW CHECK IF MINIMUM CAPABILITY REQUIRED JMP ERR75 NO, ERROR - TYPE 6 PGM PROTECTED BY USER ID SPC 1 GTGID LDA ID+40 GET GROUP ID FROM TYPE 6 FILE, WORD 40 ELA ISOLATE SIGN BIT (SET MEANS GROUP ID MUST MATCH) SEZ,RSS SIGN BIT SET? JMP GTCAP NO, NOT PROTECTED ON GROUP ID SPC 1 JSB ISMVE GET GROUP ID FROM SESSION CONTROL BLOCK DEF *+5 DEF SESWD ID SEGMENT SESSION WORD DEF $SMGP SCB OFFSET TO GROUP ID DEF TEMP RETURN CALLER'S GROUP ID DEF O1 ONE WORD LDA ID+40 GET GROUP ID FROM TYPE 6 FILE ELA,CLE,ERA CLEAR SIGN BIT CPA TEMP DOES GROUP ID REQUIRED MATCH CALLER'S GROUP ID? RSS YES, NOW CHECK IF MINIMUM CAPABILITY REQUIRED JMP ERR76 NO, ERROR - TYPE 6 PGM PROTECTED BY GROUP ID SPC 1 GTCAP JSB ISMVE GET CAPABILITY FROM SESSION CONTROL BLOCK DEF *+5 DEF SESWD ID SEGMENT SESSION WORD DEF $SMCA SCB OFFSET TO CAPABILITY DEF TEMP RETURN CALLER'S CAPABILITY DEF O1 ONE WORD LDA TEMP USER'S CAPABILITY LEVEL CMA ADA ID+41 SSA,RSS CALLER'S CAPABILITY GREATER OR EQUAL? JMP ERR77 NO, ERROR - INSUFFICIENT CAPABILITY SPC 1 * GO PRIVILEDGED TO PREVENT CONFLICTS WITH OTHER PROGRAMS OF DIFFERENT * PRIORITY USING THIS SUBROUTINE. SPC 1 * IF TYPE 6 FILE IS ON LU2 OR LU3 THEN SKIP SPECIAL PROCESSING * PRIV LDA DLU A = DISK LU OF TYPE 6 FILE 791219 CPA O2 IF DISK LU = 2 791219 RSS OR 791219 CPA O3 IF DISK LU = 3 791219 JMP PRIV2 THEN SKIP SPECIAL PROCESSING 791219 * JSB $LIBR GO PRIVILEDGED TO PREVENT NOP CONFLICTS WITH OTHER ROUTINE USING SAME SUB SPC 1 JSB FIDSG CHECK ID SEG AVAILABILITY 791219 RSS -MAYBE ALREADY RP'D 791219 JMP COPYF -ID SEG IS AVAILABLE 791219 * * AT THIS POINT EITHER: * * 1) (A=23, E=1) THERE EXISTS AN ID SEGMENT WITH THE SAME * NAME, BUT WHOSE DISK ADDRESS WORD DOES NOT POINT TO OUR * TYPE 6 FILE. * => RETURN FMGR ERROR 23: DUPLICATE PROGRAM NAME * * 2) (A=E=0) THERE EXISTS AN ID SEGMENT WITH THE SAME NAME * AND WHOSE DISK ADDRESS WORD SEEMS TO POINT TO OUR TYPE 6 * FILE. * IF TYPE 6 FILE IS ON LU2 OR LU3 THEN THIS FILE IS * ALREADY RP'D. * => RETURN SUCCESS * ELSE DISK ADDRESS WORD CAN'T POINT TO OUR TYPE 6 FILE. * => RETURN FMGR ERROR 23: DUPLICATE PROGRAM NAME * LDB DLU B = DISK LU OF FILE 791219 SZA,RSS IF A = NON-ZERO ERROR THEN DO ERROR RETURN 791219 CPB O2 FILE ON LU2 ? 791219 RSS OR 791219 CPB O3 IS FILE ON LU3 ? 791219 JMP PEXIT -YES, RETURN A & E = STATUS 791219 * * TYPE 6 FILE NOT ON LU2 OR LU3, => DUPLICATE PROGRAM NAME * LDA D23 A = ERROR = 23 791219 CCE E = ERROR = 1 791219 JMP PEXIT RETURN 791219 * * * WE'RE GOING TO COPY THE PROGRAM IMAGE PART OF THE TYPE 6 FILE * INTO SYSTEM POOL TRACKS TO MAKE IT LOOK LIKE A TEMPORARY LOAD. * * * COMPUTE MINIMUM NUMBER OF SECTORS PER TRACK ON TRACK POOL DISKS * BECAUSE WE DON'T KNOW WHICH DISK OUR POOL TRACKS WILL COME FROM. * COPYF JSB $LIBX GO UNPRIVILEDGED 791219 DEF *+1 791219 DEF *+1 791219 * LDA SECT2 A = # SECTORS/TRACK ON LU2 791219 STA SECTR SAVE AS DEFAULT MINIMUM 791219 * CMA,INA CALCULATE DIFFERENCE BETWEEN 791219 ADA SECT3 LU2 & LU3 SECTORS/TRACK 791219 LDB SECT3 791219 SZB,RSS IS THERE AN LU3? 791219 JMP .L1 -NO 791219 SSA FEWER SECTORS/TRACK ON LU3 ? 791219 STB SECTR -YES, SET NEW MINIMUM 791219 * .L1 EQU * 791219 * * USE MINIMUM NUMBER OF SECTORS/TRACK TO CALCULATE HOW MANY * TRACKS TO ASK FOR, = (FILE SIZE) - (2 SECTORS OF DCB INFO) * * ***** ASSUME FILE IS NOT AN "EXTENDED FILE" ***** * ***** WHOSE FILE SIZE IS IN "CHUNKS". ***** * LDA IDCB 791219 ADA O5 CALCULATE ADDR OF IDCB(6) 791219 * LDA A,I A = FILE SIZE (SECTORS) 791219 ADA M2 IGNORE DCB INFO SECTORS 791219 STA PSIZE SAVE PROGRAM SIZE (SECTORS) 791219 * CLB (B = 0 FOR DIVISION) 791219 DIV SECTR CALCULATE MAX # TRACKS REQUIRED 791219 SZB PARTIAL TRACK? 791219 INA -YES, ROUND UP 791219 IOR O1S SET NO WAIT BIT 791219 STA NTRAK SAVE FOR ALLOCATION CALL 791219 * * ALLOCATE POOL TRACKS * (ALLOCATE LOCALLY FOR NOW IN CASE WE'RE ABORTED) * JSB EXEC REQUEST TRACKS 791219 DEF *+1+5 791219 DEF O4 791219 DEF NTRAK (# TRACKS REQUESTED) 791219 DEF ITRAK (RETURNED STARTING TRACK ADDR) 791219 DEF IDISC (RETURNED DISK LU #) 791219 DEF ISETR (RETURNED # SECTORS/TRACK) 791219 * LDA ITRAK 791219 SSA DID I GET TRACKS? 791219 JMP ERR16 -NO, ERROR RETURN 791219 * LDA NTRAK LOAD # TRACKS REQUESTED 791219 AND MASK CLEAR SIGN (NO ABORT) BIT 791219 STA NTRAK SAVE # TRACKS RECEIVED 791219 * * RETURN ANY UNNEEDED DISK SPACE * LDA PSIZE A = PROGRAM SIZE (SECTORS) 791219 CLB (B = 0 FOR DIVISION) 791219 DIV ISETR CALCULATE # TRACKS ACTUALLY REQUIRED 791219 SZB PARTIAL TRACK? 791219 INA -YES, ROUND UP 791219 STA TEMP1 SAVE FOR LATER 791219 * CMA,INA NEGATE 791219 ADA NTRAK A = # EXTRA TRACKS RECEIVED 791219 SZA,RSS EXTRA TRACKS? 791219 JMP NRLSE -NO, SO DON'T RETURN ANY 791219 * SSA IF # EXTRA TRACKS < 0 800305 JMP ERR78 THEN NOT ENOUGH TRACKS ?!?! 800305 * STA NTRAK SAVE # EXTRA TRACKS 791219 * LDA TEMP1 A = # TRACKS ACTUALLY NEEDED 791219 ADA ITRAK CALCULATE STARTING TRACK TO RETURN 791219 STA TEMP2 SAVE FOR SYSTEM CALL 791219 * JSB EXEC RETURN THE EXTRA TRACKS 791219 DEF *+1+4 791219 DEF O5 791219 DEF NTRAK 791219 DEF TEMP2 791219 DEF IDISC 791219 * LDA TEMP1 LOAD ACTUAL # OF TRACKS TO USE 791219 STA NTRAK SAVE 791219 * NRLSE EQU * * * * * UPDATE SKELETON ID SEGMENT DISK ADDRESS WORD * TO POINT TO POOL TRACKS. * * * CONSTRUCT DISK LU PART OF ADDRESS WORD (SIGN BIT) * CCA A = -1 (FOR PARANOID CHECK) 791219 LDB IDISC B = POOL TRACK DISK LU 791219 * CPB O2 LU2 ? 791219 CLA -YES, CLEAR SIGN BIT 791219 * CPB O3 LU3 ? 791219 LDA O1S -YES, SET SIGN BIT 791219 * SLA PARANOID CHECK: LU2 OR LU3 ? 791219 JMP ERR78 -NO, BARF 800305 * * INCLUDE TRACK ADDR IN BITS 14-7 * (SECTOR ADDR = 0 IN BITS 6-0) * LSR 7 POSITION 791219 IOR ITRAK INCLUDE TRACK ADDR 791219 LSL 7 POSITION BACK 791219 STA ID+27 SET INTO SKELETON ID SEGMENT 791219 * * * * COPY THE PROGRAM IMAGE FROM THE TYPE 6 FILE INTO * THE SYSTEM POOL TRACKS. * * (IGNORE THE FIRST TWO SECTORS OF THE FILE WHICH * CONTAIN ID SEGMENT INFORMATION.) * * * * SETUP SOURCE PARAMETER ARRAY FOR SUBROUTINE * LDB DCB3,I LOAD FILE TRACK ADDR 791219 STB .TRKI SAVE 800305 * LDA DCB4,I LOAD FILE SECTOR ADDR 791219 ADA O2 SKIP ID SEG INFO 791219 STA .SECI SAVE 800305 * CPA DCB8,I TRACK CROSSING? 791219 RSS -YES 791219 JMP NOCRS -NO 791219 * ISZ .TRKI INCREMENT TRACK ADDRESS 800305 CLA ZERO THE 791219 STA .SECI SECTOR ADDRESS 800305 * NOCRS EQU * 800305 * * SETUP DESTINATION PARAMETER ARRAY FOR SUBROUTINE * LDA ITRAK 791219 STA .TRKO TRACK ADDRESS 800305 * CLA 791219 STA .SECO SECTOR ADDRESS 800305 * * SET UP OTHER INFO FOR SUBROUTINE * LDA PSIZE GET PROGRAM SIZE (SECTORS) 791219 STA .NSCI SAVE AS COPY SIZES 800305 STA .NSCO 800305 * * CALL SUBROUTINE TO DO THE TRANSFER * FILOP JSB ZXFER READ FROM FILE 800305 DEF *+1+8 800305 DEF O1 (1:READ 2:WRITE) 800305 DEF FDLU (DISK LU) 791219 DEF IBUF,I (BUFFER) 791219 DEF IBUFL,I (BUFFER LENGTH) 791219 DEF .TRKI (TRACK ADDRESS) 800305 DEF .SECI (SECTOR ADDRESS) 800305 DEF .NSCI (# SECTORS TO COPY) 800305 DEF DCB8,I (# SECTORS PER TRACK) 791219 * JSB ZXFER WRITE TO POOL TRACKS 800305 DEF *+1+8 800305 DEF O2 800305 DEF IDISC 791219 DEF IBUF,I 791219 DEF IBUFL,I 791219 DEF .TRKO 800305 DEF .SECO 800305 DEF .NSCO 800305 DEF ISETR 791219 * * IF NOT DONE WITH COPY THEN LOOP * LDA .NSCO LOAD # SECTORS LEFT TO COPY 800305 SZA DONE ? 800305 JMP FILOP -NO, LOOP 800305 * * * * GET ID SEGMENT AND SETUP TO POINT TO FILE OR POOL TRACKS * PRIV2 JSB $LIBR GO PRIVILEDGED TO PREVENT 791219 NOP CONFLICTS WITH OTHER ROUTINES 791219 * JSB FIDSG CHECK ID SEG AVAILABILITY: 791219 JMP PEXIT -ALREADY RP'D 791219 * LDB ID+29 GET ID SEG EMA WORD 800305 LDA $OPSY GET OP SYSTEM IDENTIFIER 800305 * CPA M9 IF RTE-IV 800305 SZB,RSS AND PROGRAM USES EMA 800305 RSS THEN 800305 JSB FIDEX GET AN ID SEG EXTENSION 800305 * * WE GOT AN ID SEGMENT, LET'S GO... * * FIRST, IF WE COPIED THE FILE INTO SYSTEM POOL TRACKS, * WE MUST ASSIGN OWNERSHIP OF THE TRACKS TO THE SYSTEM * SO THAT THIS WHOLE THING LOOKS JUST LIKE A TEMPORARY * PROGRAM LOAD. TO DO THIS WE MODIFY THE TAT (TRACK * ASSIGNMENT TABLE) WHILE IN PRIVILEDGED MODE. * LDA B1000 INITIALIZE THE 791219 STA CPY "I'M A COPY" BIT FLAG 791219 * LDA ITRAK LOAD POOL TRACK ADDRESS 791219 SSA WERE POOL TRACKS ALLOCATED? 791219 JMP TRDON -NO, SKIP SPECIAL PROCESSING 791219 * * CALCULATE INDEX INTO TAT * CLB OFFSET = 0 791219 LDA IDISC A = POOL TRACK DISK LU 791219 CPA O3 LU3 ? 791219 LDB TATSD -YES, OFFSET = # TRACKS ON LU2 791219 ADB TAT ADD TAT BASE ADDR 791219 ADB ITRAK ADD STARTING TRACK NUMBER 791219 * * CHANGE OWNERSHIP OF TRACKS IN TAT * LDA NTRAK LOAD # TRACKS 791219 CMA,INA NEGATE 791219 STA TEMP2 SAVE FOR LOOP COUNTER 791219 * LDA O1S A = SYSTEM OWNERSHIP FLAG 791219 * TROWN JSB STORA CHANGE TAT OWNERSHIP FOR A TRACK 791219 INB INCREMENT TAT ADDR 791219 ISZ TEMP2 DONE WITH TRACKS? 791219 JMP TROWN -NO, LOOP 791219 * CCA SET FLAG TO INDICATE WE NO 791219 STA ITRAK LONGER HAVE TRACKS ALLOCATED 791219 * CLA CLEAR THE "I'M A COPY" FLAG SO THAT 791219 STA CPY TRACKS WILL BE RELEASED ON PROG :OF 791219 * TRDON EQU * * * SPC 1 * FOUND BLANK IDSEG, SET IT UP SPC 1 LDA DID32,I GET IDSEG WORD32 *791227 AND B2000 EXTRACT DON'T COPY BIT *791227 STA NOCPY SAVE IT *791227 * JSB .OWNR FETCH THE OWNER ID *780920* IOR CPY AND SET "I'M A COPY" FLAG *780920*791219 STA OWID SAVE FOR ID BUILD *780920* LDB ID+17 GET IDSEG(1) ADDRESS *780403* JSB LOADA *780403* STA B *780403* STA NID,I SAVE ADDRESS OF NEW ID SEGMENT LDA TEMP RESTORE TRACK INDICATOR *780403* CLE,SZA NOW MOVE INTO SYSTEM JMP SHOR1 SHORT ID, SKIP SOME OF MOVE CCE,INB BUMP TO XTEMP STB ID+11 SET UP XB WORD LDA DEFZ ZERO THE 5 XTEMP WORDS JSB MOVE MOVE TO THE BLANK ID SEG. OCT 5 LDA DEFID GET BUFFER ADA D6 OFFSET TO 7TH WORD LDA A,I GET CONTENTS AND JSB STORA RESTORE TO BLANK ID SEG. *780403* INB BUMP DESTINATION ADDRESS ISZ ID+18 SPC 1 * E-REG = 0 FOR LONG ID, E-REG=1 FOR SHORT ID SPC 1 RSS SHOR1 ADB D11 CORRECT FOR SHORT ID LDA ID+8 GET PROGRAM ENTRY POINT ADDRESS JSB STORA AND PUT *780403* SEZ,INB,RSS BUMP TO ID(9) IF LONG JMP SHOR2 YES, SHORT ID LDA DID9 GET DEF TO ID(9) JSB MOVE MOVE ID(9) TO ID(12) O4 OCT 4 SHOR2 STB ADNAM SAVE ADDRESS OF IDSEG WORD 13 (NAME) LDA NAME GET NAME(1) JSB MOVE MOVE NAME(1),NAME(2) O2 OCT 2 LDA ID+18,I GET NAME(3) AND OM400 MASK OFF 6TH CHAR XOR ID+15 MERGE IN PROGRAM TYPE AND OM20 MASK OFF BITS 4-15 XOR ID+15 IOR O200 PUT IN TEMP BIT SEZ,RSS CHECK IF SHORT ID BIT IOR O20 PUT IN SHORT ID IF SHORT JSB STORA STORE ID(15) *780403* SEZ,INB,RSS ZERO OUT ID(16),ID(17) JMP SHOR3 SKIP IF SHORT ID LDA DEFTM MOVE SIX WORDS JSB MOVE INTO IDSEG(16) - IDSEG(21) D6 DEC 6 LDA ID+22 GET THE RTE-III THING JSB STORA IDSG(22)! CALLER BETTER KNOW P'S,Q'S *"* INB POINT ID(23) SHOR3 LDA DID23 GET ADDRESS OF LOW MAIN ADDRESS JSB MOVE A-REG = SOURCE ADDRESS, B-REG=DEST O5 OCT 5 NUMBER OF WORDS TO MOVE CLA,SEZ,CCE,RSS IF SHORT ID (E=0), JMP ERR14 THEN DONE JSB STORA ZERO ID(28) FOR LONG ID *780403* * * CHECK PROGRAM TYPE (SAVED IN ID+1). IF PROGRAM SEGMENT * (TYPE = 5), SKIP THE ID EXTENSION WORK. *780407* * LDA ID+1 FETCH PROG TYPE *780407* CPA O5 IF SEGMENT, *780407* JMP CNT.5 SKIP ID EXT WORK *780407* * SPC 1 LDA $OPSY OP SYSTEM IDENTIFIER CPA M9 RTE-IV? JMP CONT1 YES, SAVE RTE-IV WORDS CNT.5 CLA RESET A (E=1 !!!) JMP ERR14 EXIT CONT1 INB POINT TO ID(29) STB NEWID SAVE DESTINATION ADDRESS * LDA ID+29 GET ID SEG EMA WORD 800305 SZA,RSS PROGRAM USES EMA ? 800305 JMP NOEMA -NO, EMA WORD IS ZERO * * PROGRAM USES EMA. SETUP THE ID SEG EXTENSION * LDA INDX GET FOUND ID SEG EXT # 800305 CLB *780403* RRR 6 RESTORE ID EXT# TO HIGH 6 BITS *780403* * *780403* LDA DID29,I GET ID SEGMENT EMA WORD AND O1777 MASK OFF HIGH 6 BITS IOR B MERGE TO CREATE NEW EMA WORD LDB NEWID *780403* JSB STORA RESTORE TO NEW ID SEGMENT (29) *780403* ISZ NEWID BUMP DESTINATION ADDRESS LDA DID36 RESTORE ID EXTENSION WORDS LDA A,I GET SAVED ID EXT WORD 0 *780403* LDB IDEXT *780403* JSB STORA SAVE IN NEW ID EXT WORD 0 *780403* INB BUMP TO NEXT WORD OF NEW ID EXT *780403* LDA DID36 *780403* INA POINT TO ID(37) LDA A,I GET SAVED ID EXT WORD 1 *780403* JSB STORA SAVE IN NEW ID EXT WORD 1 *780403* INB BUMP TO WORD 2 OF NEW ID EXT *780403* CLA *780403* JSB STORA ZERO NEW ID EXT WORD 2 *780403* LDB NEWID SET UP ID30 ADDRESS *780508* JMP SETUP CONTINUE SPC 1 NOEMA LDB NEWID *780403* JSB STORA ZERO EMA WORD IN NEW ID SEG *780403* INB BUMP POINTER TO NEW ID SEGMENT *780403* SETUP LDA DID29 POINTER TO ID(29) INA BUMP TO ID(30) LDA A,I GET SAVED HI-ADDR+1 OF SEGMENT *780403* JSB STORA RESTORE TO NEW ID SEGMENT *780403* INB BUMP POINTER TO NEW ID SEG *780403* CLA JSB STORA ZERO ID(31) *780403* INB *780403* JSB LOADA FETCH ID 32 *780920* AND B170K SAVE SEQUENCE COUNTER *780920* IOR OWID MERGE IN COPY FLAG *780920* IOR NOCPY MERGE IN DONT' COPY BIT JSB STORA RESTORE ID 32 *780920* INB *780403* CLA JSB STORA ZERO ID(33) *780403* ERR14 SEZ,CME,RSS CHANGE SO E=1, IF ERROR, ELSE = 0 LDA D14 RETURN IDSEGMENT NOT FOUND PEXIT JSB $LIBX DONE A=0,E=0 FOR GOOD EXIT DEF *+1 DEF EXIT SKP * * * SUBROUTINE TO FIND AN AVAILABLE, SUITABLE ID SEGMENT * * * CALLING ROUTINE MUST BE PRIVILEDGED: * * JSB $LIBR * NOP * JSB FIDSG * * * * OTHER POSSIBLE SUBROUTINE EXITS: * * JMP ERR14 (IF NO BLANK ID SEGMENTS) * * * RETURNED PARAMETERS: * * : * ADDRESS OF KEYWD BLOCK ENTRY FOR FOUND ID SEGMENT * RETURNED IN ID+17 * TEMP CONTAINS THE TRACKS & LONG/SHORT ID SEG INDICATOR * * : EITHER * (A=23,E=1) THERE EXISTS AN ID SEGMENT WITH THE SAME NAME, * BUT WHOSE DISK ADDRESS WORD DOES NOT MATCH ID+27. * (A DIFFERENT PROGRAM WITH THE SAME NAME.) * (A=E=0) THERE EXISTS AN ID SEGMENT WITH THE SAME NAME, * AND WHOSE DISK ADDRESS WORD MATCHES ID+27. * (THIS PROGRAM IS ALREADY RP'D.) * * FIDSG NOP JSB IDSGA SEARCH FOR NAME ALREADY EXISTS DEF *+2 DEF NAME,I SEZ,CME IF NOT FOUND, CLEAR E-REG & A-REG JMP SERCH AND GO FIND A BLANK IDSEGMENT STA NID,I RETURN ADDR OF NEW ID SEGMENT ADA D26 OFFSET TO DISC ADDRESS WORD (ID27) STA B SAVE IN B JSB LOADA GET DISC ADDRESS TO A CPA ID+27 COMPARE WITH ADDRESS OF TYPE 6 FILE JMP LABL1 MATCH, SO RETURN AS IF WE DID IT LDA D23 NO MATCH, ERROR 23 CCE,RSS RETURN WITH E=1 LABL1 CLA,CLE GOOD RETURN, A=E=0 JMP FIDSG,I SPC 1 * BLANK ID'S ARE SEARCHED IN FOLLOWING PRECEDENCE * * TYPE 2 OR 3 PROG TYPE 5 PROG (SEGMENT) * 1)LONG BLANK WITHOUT TRACKS 1)SHORT BLANK WITHOUT TRACKS * 2)LONG BLANK & DON'T CARE 2)LONG BLANK WITHOUT TRACKS * 3)SHORT BLANK & DON'T CARE IF HAS TRACKS * 4)LONG BLANK & DON'T CARE IF HAS TRACKS * SPC 1 LOOP1 LDA ID+16 GET LONG/SHORT ID FLAG (0/20B) SEZ,SZA,RSS IF DOWN TO LONG BLANK & DONT CARE JMP ERR14 THEN GET OUT FMGR ERROR 14 SPC 1 SERCH SZA,RSS TOGGLE E-REG WHEN A= 0 CME LDB ID+1 GET PROGRAM TYPE CPB O5 CAN IT HAVE A SHORT ID? XOR O20 YES, THEN CHANGE SEARCH TO OTHER KIND STA ID+16 AND PUT BACK IN TEMP LDA KEYWD RESET FOR KEYWORD SEARCH STA ID+17 RSS SKIP 1ST ISZ SPC 1 * ID+16=0 > SEARCH LONG ID ID+16=20B > SEARCH SHORT ID * E-REG=1 > SEARCH ID WITHOUT TRACKS E-REG=0 > DON'T CARE ABOUT TRACKS SPC 1 LOOP2 ISZ ID+17 BUMP AND CHECK IF DONE WITH LDB ID+17 KEYWORD SEARCH *780403* JSB LOADA *780403* SZA,RSS DONE? *780403* JMP LOOP1 YES, TRY NEXT TYPE OF BLANK ID STA B *780403* ADB D14 BUMP TO WORD 15 IN IDSEG (NAME/TYPE) JSB LOADA GET VALUE *780403* AND OM360 MASK TO CHAR 5 & SHORT/LONG BIT(177420B) CPA ID+16 NULL AND SHORT/LONG? RSS FOUND ONE BLANK, CHECK JMP LOOP2 NO, TRY NEXT IDSEG ADB O5 IF HAS TRACKS SZA,RSS CHECK IF SHORT OR LONG? ADB O7 LONG, BUMP TO WORD 27 STA TEMP SAVE TRACKS INDICATOR *780403* JSB LOADA EQUAL TO 0 IF NO TRACKS *780403* SEZ,SZA CHECK IF HAS TRACKS & CARE FLAG *780403* JMP LOOP2 WELL THIS DUDE HAS TRACKS, SKIP * ISZ FIDSG POINT TO NORMAL RETURN 791219 JMP FIDSG,I EXIT SUBROUTINE 791219 SKP * * * SUBROUTINE TO FIND AN AVAILABLE ID SEGMENT EXTENSION * * * CALLING ROUTINE MUST BE PRIVILEDGED: * * JSB $LIBR * NOP * JSB FIDEX * * * OTHER POSSIBLE SUBROUTINE EXITS: * * JMP ERR14 (IF NO FREE ID SEGMENT EXTENSIONS) * * * RETURNED PARAMETERS: * * IDEXT CONTAINS THE ADDRESS OF THE FOUND ID * SEGMENT EXTENSION * * INDX CONTAINS THE INDEX INTO THE ID EXTENSION * LIST OF THE FOUND ID SEGMENT EXTENSION * * FIDEX NOP CLA INITIALIZE INDEX INTO STA INDX THE ID EXTENSION LIST * XLB $IDEX LOAD ID EXTENSION LIST HEAD STB IDEXT SAVE * GTEX1 LDB IDEXT XLA B,I GET NEXT ENTRY IN ID EXT LIST * SZA,RSS END OF ID EXTENSION BLOCK ? JMP GTEX2 -YES, NO AVAILABLE ID EXTENSIONS * STA B XLA B,I GET WORD ZERO OF ID EXTENSION * SZA,RSS AVAILABLE ? JMP GTEX3 -YES, FOUND ONE * ISZ INDX BUMP INDEX INTO ID EXT LIST ISZ IDEXT BUMP ID EXTENSION ADDRESS * JMP GTEX1 TRY THE NEXT ID EXTENSION * * CAN'T FIND AN ID SEGMENT EXTENSION * GTEX2 CLE SET FOR ERROR EXIT JMP ERR14 TAKE ERROR EXIT * * FOUND AN ID SEGMENT EXTENSION * GTEX3 STB IDEXT SAVE RESULT JMP FIDEX,I EXIT * * IDEXT BSS 1 ID EXTENSION ADDRESS INDX BSS 1 ID EXTENSION LIST INDEX SKP * * TRANSFER DATA BETWEEN DISK AND A BUFFER * * CALLING SEQUENCE: * * CALL ZXFER (ZDIR,ZLU,ZBUF,ZBUFL,ZTRK,ZSEC,ZNSEC,ZNSPT) * * ZDIR = 1 (READ FROM DISK) OR 2 (WRITE TO DISK) * ZLU = DISK LU * ZBUF = BUFFER * ZBUFL = BUFFER LENGTH (WORDS). MUST BE AT LEAST 64 WORDS LONG. * ZTRK = STARTING TRACK ADDRESS * ZSEC = STARTING SECTOR ADDRESS * ZNSEC = TOTAL NUMBER OF SECTORS ON DISK TO TRANSFER * ZNSPT = NUMBER OF SECTORS PER TRACK ON DISK * * ERROR EXITS: IF ZBUFL < 64 WORDS: JMP ERR78 * IF DISK I/O ERROR: JMP ERR01 * * NOTE: ZTRK AND ZSEC ARE MODIFIED BY THIS ROUTINE TO ALWAYS POINT * TO THE NEXT POSITION ON DISK TO TRANSFER TO/FROM. * ZNSEC IS MODIFIED BY THIS ROUTINE TO ALWAYS INDICATE THE * NUMBER OF SECTORS REMAINING TO BE TRANSFERED. * * ZXFER SHOULD BE CALLED ITERATIVELY UNTIL ZNSEC DROPS TO ZERO. * * ZDIR NOP TRANSFER DIRECTION ZLU NOP DISK LU ZBUF NOP BUFFER ADDRESS ZBUFL NOP BUFFER LENGTH ZTRK NOP TRACK ADDRESS ZSEC NOP SECTOR ADDRESS ZNSEC NOP NUMBER OF SECTORS ON DISK TO COPY ZNSPT NOP NUMBER OF SECTORS PER TRACK * ZXFER NOP JSB .ENTR PICKUP PARAMETERS DEF ZDIR * * PICKUP PARAMETERS * LDA ZDIR,I A = READ (1) OR WRITE (2) AND O3 CLEAR UNUSED BITS IOR O1S SET "NO ABORT" BIT STA ZDIR SAVE FOR EXEC CALL * LDA ZBUFL,I LOAD BUFFER LENGTH AND FLOOR FORCE TO BE A MULTIPLE OF SECTOR SIZE STA ZBUFL SAVE AS "REMAINING BUFFER LENGTH" * SZA IF BUFFER LENGTH IS ZERO SSA OR NEGATIVE JMP ERR78 THEN TAKE ERROR EXIT * (NOTE: LEAVE A-REG UNALTERED FOR USAGE BELOW.) * * REMAINING BUFFER LENGTH = * MINIMUM (SUPPLIED BUFFER LENGTH, REMAINING FILE LENGTH) * LDB ZNSEC,I B=REMAINING FILE LENGTH (SECTORS) BLF MULTIPLY BY 64 WORDS/SECTOR BLS,BLS B=REMAINING FILE LENGTH (WORDS) * CMA,INA A=NEGATIVE REMAINING BUF LENGTH (WORDS) ADA B A=(FILE LENGTH) - (BUFFER LENGTH) * SSA FILE LENGTH < BUFFER LENGTH ? STB ZBUFL -YES, RESET REMAINING BUFFER LENGTH * * TRANSFER LENGTH = * MINIMUM (REMAINING BUFFER LENGTH, REMAINING TRACK LENGTH) * ZLOOP LDA ZSEC,I A=CURRENT SECTOR ADDR CMA,INA NEGATE ADA ZNSPT,I A=REMAINING TRACK LENGTH (SECTORS) * ALF MULTIPLY BY 64 WORDS/SECTOR ALS,ALS A=REMAINING TRACK LENGTH (WORDS) * LDB ZBUFL B=REMAINING BUFFER LENGTH (WORDS) STB ZXLEN SAVE AS DEFAULT TRANSFER LENGTH CMB,INB NEGATE ADB A B=(TRACK LENGTH) - (BUFFER LENGTH) * SSB TRACK LENGTH < BUFFER LENGTH ? STA ZXLEN -YES, RESET TRANSFER LENGTH * * DO THE DISK TRANSFER * JSB EXEC DEF *+1+6 DEF ZDIR (TRANSFER DIRECTION) DEF ZLU,I (DISK LU) DEF ZBUF,I (BUFFER) DEF ZXLEN (TRANSFER LENGTH) DEF ZTRK,I (TRACK ADDRESS) DEF ZSEC,I (SECTOR ADDRESS) JMP ERR01 (NO-ABORT ERROR RETURN) * * UPDATE SECTOR AND TRACK ADDRESSES * LDA ZXLEN A=TRANSFER LENGTH (WORDS) ARS,ARS DIVIDE BY 64 WORDS/SECTOR ARS,ARS ARS,ARS A=TRANSFER LENGTH (SECTORS) LDB A (SAVE IN B-REG) * ADA ZSEC,I CALCULATE NEW SECTOR ADDRESS STA ZSEC,I UPDATE CURRENT SECTOR ADDRESS * CPA ZNSPT,I END OF TRACK ? RSS -YES JMP ZSKIP -NO * ISZ ZTRK,I INCREMENT TRACK ADDRESS CLA STA ZSEC,I RESET SECTOR ADDRESS * ZSKIP EQU * * * UPDATE REMAINING FILE LENGTH * CMB,INB B=NEGATIVE TRANSFER LENGTH (SECTORS) ADB ZNSEC,I CALCULATE NEW REMAINING FILE LENGTH STB ZNSEC,I SAVE * * UPDATE BUFFER ADDRESS * LDA ZBUF A = OLD BUFFER ADDRESS ADA ZXLEN ADD TRANSFER LENGTH STA ZBUF UPDATE CURRENT BUFFER ADDRESS * * UPDATE REMAINING BUFFER LENGTH * LDA ZXLEN A=TRANSFER LENGTH (WORDS) CMA,INA NEGATE ADA ZBUFL CALCULATE NEW BUFFER LENGTH STA ZBUFL SAVE * * LOOP UNTIL BUFFER IS EMPTY * SZA BUFFER EMPTY ? JMP ZLOOP -NO, LOOP JMP ZXFER,I -YES, EXIT * * ZXLEN BSS 1 STORAGE FOR TRANSFER LENGTH (WORDS) FLOOR OCT 177700 MASK TO INSURE MULTIPLE OF 64 SKP * * MISC. UTILITY SUBROUTINES * * * MOVE NOP ENTRY A=SOURCE,B=DEST ADDRESS STA ID+18 SAVE SOURCE ADDRESS LDA MOVE,I GET COUNTER CMA,INA STA ID+19 ISZ MOVE SET RETURN TO P+2 MORE LDA ID+18,I GET NEXT WORD JSB STORA PUT *780403* INB ISZ ID+18 ISZ ID+19 JMP MORE E-REG UNMODIFIED!!!!!!!!!!!! JMP MOVE,I RETURN DONE B=NEXT ADDRESS SPC 1 SUM NOP P+1=ADDRESS,P+2=# OF WORDS LDB SUM,I ISZ SUM STB MOVE SAVE START SUMMING ADDRESS LDB SUM,I GET NUMBER OF WORDS ISZ SUM BUMP TO P+3 ADA MOVE,I ACCUMULATE THE SUM ISZ MOVE BUMP TO NEXT WORD INB,SZB DONE? JMP *-3 JMP SUM,I RETURN P+3, E-REG = 1!!!!!! SPC 1 STYPE NOP *780403* LOADA NOP DOES XLA B,I IF MAPPED SYS *780403* LDA STYPE OP SYS IDENTIFIER (AFTER ERA) *780403* SLA MAPPED SYSTEM? *780403* JMP MAPSY YES *780403* LDA B,I NO, DO DIRECT LOAD *780403* JMP LOADA,I RETURN *780403* MAPSY XLA B,I DO CROSS-LOAD (2-WD INSTRUCT.) *780403* JMP LOADA,I RETURN *780403* SPC 1 STORA NOP DOES XSA B,I IF MAPPED SYS *780403* STA STSAV SAVE TEMPORARILY *780403*791219 LDA STYPE OP SYS IDENTIFIER (AFTER ERA) *780403* SLA MAPPED SYSTEM? *780403* JMP MAP YES *780403* LDA STSAV RESTORE TEMP WORD *780403*791219 STA B,I NON-MAPPED, DO DIRECT LOAD *780403* JMP STORA,I RETURN *780403* MAP LDA STSAV RESTORE TEMP WORD *780403*791219 XSA B,I DO CROSS-STORE(2-WD INSTRUCT.) *780403* JMP STORA,I RETURN *780403* * STSAV BSS 1 TEMPORARY STORAGE 791219 * SPC 1 DEFZ DEF *+1 DEC 0 DEC 0 DEC 0 DEC 0 DEC 0 DEFTM DEF *+1 DEC 0 DEC 0 DEC 0 OCT 25000 TIME = ONE DAY OCT 177574 DEC 0 SPC 1 * PRC OCT 74000 FMP PRIV CODE FOR WRITE ON FMP TRACKS * O1S OCT 100000 791219 O1 OCT 1 O3 OCT 3 O7 OCT 7 M2 DEC -2 791219 M9 DEC -9 D11 DEC 11 D14 DEC 14 D19 DEC 19 D23 DEC 23 D26 DEC 26 D41 DEC 41 D75 DEC 75 D76 DEC 76 D77 DEC 77 D78 DEC 78 D99 DEC 99 O20 OCT 20 O77 OCT 77 O200 OCT 200 O1777 OCT 1777 MASK OCT 77777 B170K OCT 170000 B1000 OCT 1000 B2000 OCT 2000 O7777 OCT 7777 OM20 OCT -20 OM360 OCT -360 OM400 OCT -400 DID9 DEF ID+9 DID23 DEF ID+23 DID29 DEF ID+29 DID32 DEF ID+32 DID36 DEF ID+36 * IDBUF BSS 41 ID EQU IDBUF-1 TEMP NOP *780403* TEMP1 NOP OWID NOP ADNAM NOP NEWID NOP NOCPY NOP CPY BSS 1 "I'M A COPY" FLAG 791219 SESWD NOP * TEMP2 BSS 1 791219 IDISC BSS 1 POOL DISK LU # 791219 ITRAK BSS 1 STARTING POOL TRACK # 791219 ISETR BSS 1 # SECTORS/TRACK ON "IDISC" 791219 NTRAK BSS 1 NUMBER OF POOL TRACKS DESIRED/RECEIVED 791219 * DCB8 DEF *-* ADDR OF IDCB(9) 791219 DLU BSS 1 FILE DISK LU # 791219 FDLU BSS 1 FILE DISK LU # WITH FMP PRIV. CODE 791219 SECTR BSS 1 MIN # SECTORS/TRACK ON POOL DISKS 791219 PSIZE BSS 1 PROGRAM SIZE (IN SECTORS) 791219 * * PARAMETER STORAGE FOR CALLS TO SUBROUTINE * .TRKI BSS 1 INPUT TRACK ADDR 800305 .SECI BSS 1 INPUT SECTOR ADDR 800305 .NSCI BSS 1 INPUT # SECTORS TO READ 800305 .TRKO BSS 1 OUTPUT TRACK ADDR 800305 .SECO BSS 1 OUTPUT SECTOR ADDR 800305 .NSCO BSS 1 OUTPUT # SECTORS TO WRITE 800305 * * END