ASMB,R,L,C HED "IDDUP" FTN/SPL SUBROUTINE TO DUPLICATE ID SEGMENTS NAM IDDUP,6 92067-16185 REV.1903 790122 * SOURCE: 92067-18234 * RELOC: 92067-16185 * PGMR: D.L.B. * * *************************************************************** * * (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. * * *************************************************************** * * MODIFICATION RECORD: * OLD DATE NEW DATE REASON BY WHOM * 1) 12-3-75 1-30-76 TO FIX BUG IF PROGRAM IS ON DISC LU=3 (DLB) * 2) 1-30-76 10-5-76 TO REMOVE DUPLICATION OF PERMANENT PROGRAMS (DLB) * 3) 10-5-76 9-2-77 TO SUPPORT EXTENDED ID SEGMENT * 4) 9-2-77 4-3-78 CROSS-MAP ACCESS TO ID SEGMENTS FOR RTE-IV * TYPE 4 PROGRAMS USING THIS ROUTINE * 5) 4-3-78 9-20-78 TO ALLOW DUPLICATION OF PERMANENT PGMS (GLM) * 6) 9-20-78 1-22-79 TO SKIP ERR 23 IF DISC ADDRESSES MATCH * TO RETURN EXISTING AND NEW IDSEG ADDRESSES * ENT IDDUP EXT $LIBR,$LIBX,IDSGA,.ENTP,NAM..,$OPSY,$IDEX EXT .OWNR TAT EQU 1656B KEYWD EQU 1657B TATSD EQU 1756B *10-5SECT2 EQU 1757B *10-5SECT3 EQU SECT2+1 *10-5DSCUT EQU 1763B A EQU 0 B EQU 1 * * PURPOSE: * * TO DUPLICATE AN ID SEGMENT ALREADY IN AN RTE-II/III/IV * SYSTEM GIVING IT ANOTHER NAME AT THE SAME TIME. * * CALLED: * * CALL IDDUP (IDNAM,NWNAM,IERR,OID,NID) * -OR- * IF ( IDDUP (IDNAM,NWNAM,IERR,OID,NID) .NE.0) GO TO IERROR * * WHERE: * * IDNAM = AN EXISTING PROGRAM NAME IN THE SYSTEM. (MUST HAVE BEEN * ':RP,IDNAM' OR BE A PERMANENT PROGRAM IN THE SYSTEM. * NWNAM = THE NAME OF THE NEWLY CREATED ID SEGMENT * IERR = (OPTIONAL) RETURN ERROR CODE (SAME AS ERROR CODES IN FMGR) * OID = (OPTIONAL) RETURN ADDRESS OF EXISTING ID SEGMENT * NID = (OPTIONAL) RETURN ADDRESS OF NEW ID SEGMENT * * * RETURN: * * IERR = 0 > SUCCESSFUL INSTALLATION OF ID SEGMENT INTO SYSTEM * IERR = 14 > IDNAM TYPE NOT EQUAL TO DISC RESIDENT PROGRAM. * IERR = 17 > NWNAM IS AN ILLEGAL PROGRAM TYPE (1,4 OR 5) * TYPE 4 IS ALLOWED IF SYSTEM IS RTE-IV * IERR = 23 > NWNAM IS ALREADY IN THE SYSTEM WITH DIFFERENT DISC * ADDRESS * IERR = -15 > ILLEGAL NAME (NWNAM) * NOTES: * * (1) A-REG = IERR ON RETURN, THEREFORE MAY BE USED AS FUNCTION * E-REG = 1, IF ERROR, ELSE E-REG = 0 ON RETURN(FRETURN SPL) * (2) IDNAM MUST BE PROGRAM TYPE 2,3 OR 12B,13B (REVERSE COMMON?) * TYPE 4 IS ALLOWED IF THE SYSTEM IS RTE-IV * (3) IDNAM MUST BE A PROGRAM THAT WAS ':RP,IDNAM' OR BE A PERMANENT * PROGRAM * (4) THE TRACK THAT THE ID SEGMENT POINTS TO, WILL ALWAYS BE * AS A 'FMP' TRACK IN THE TAT WHEN EXIT FROM THIS SUBROUTINE. * THIS IS DONE SO THAT ON '*OF,PROG,8' DIRECTIVE DOES NOT * RELEASE THE TRACKS, BUT DOES RELEASE THE ID SEGMENT. * (DO YOU KNOW WHAT THE 'LOADR' DOES WITH A PERMANENT * PROGRAM (TM=0) WHEN THE 1ST TRACK IT IS ON IS MARKED * AS A 'FMP' TRACK? (77776B)) (DLB) * (5) NWNAM MUST BE A 3 WORD BUFFER CONTAINING A NAME THAT * COULD BE USED AS A FILE NAME. (ALL SIX CHARACTERS ARE TESTED * FOR LEGALITY. THE "FMP" NAM.. ROUTINE IS USED TO CHECK FOR * NAME CORRECTNESS.) * * TEST PROGRAM: *FTN,L * PROGRAM TYDUP(2,99) * DIMENSION NAME(3),LU(5),NUNAM(3) * CALL RMPAR(LU) * IF (LU.EQ.0) LU = 1 * 1 WRITE (LU,11) * 11 FORMAT ("INPUT SYS PROGRAM 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(IDDUP(NAME,NUNAM,IERR).EQ.0) GO TO 9999 * WRITE (LU,46) IERR * 46 FORMAT ("FMGR ERROR "I3) * GO TO 1 * 9999 END * END$ SPC 1 IDNAM NOP NWNAM NOP IERR NOP IERR ADDRESS OID NOP ADDRESS OF EXISTING ID SEGMENT NID NOP ADDRESS OF NEW ID SEGMENT IDDUP NOP ENTRY JSB $LIBR TURN OF INTERRUPTS MCNT NOP JSB .ENTP PICK UP PARAMETER ADDRESSES DEF IDNAM SPC 1 LDA $OPSY OP SYSTEM IDENTIFIER *780403* ERA MOVE MAPPED BIT FOR SLA *780403* STA STYPE FOR LOADA,STORA,LOAD2 ROUTINES *780403* JSB IDSGA CHECK IF IDNAM EXISTS DEF *+2 DEF IDNAM,I CCE,SZA,RSS CHECK IF FOUND? JMP ERR14 NO, TELL CALLER STA B SAVE IN B-REG STA OID,I RETURN ADDR OF EXISTING ID SEGMENT ADA O6 BUMP TO ID(7) PRIORITY WORD STA ID7 SAVE FOR LATER USE ADB D14 BUMP TO ID(15) JSB LOADA GET THE PROGRAM TYPE WORD *780403* STA NAM5Y SAVE PROGRAM TYPE WORD AND O3 CHECK IF TYPE IS 2 OR 3 ARS LEAVE E-REG SET!! CPA O1 BIT 1 MUST BE SET JMP OK OK LDA $OPSY OP SYSTEM IDENTIFIER CPA M9 RTE-IV? RSS YES JMP ERR17 NON-RTEIV AND TYPE=1,4 OR 5 LDA NAM5Y PROGRAM TYPE AND O7 TYPE=4? CPA O4 RSS YES, TYPE 4 ALLOWED FOR RTE-IV JMP ERR17 NO, MUST BE 1 OR 5 OK ADB O7 BUMP TO ID(22) STB ID22 AND SAVE FOR LATER USE ADB O5 BUMP TO ID(27) STB ID27 SAVE FOR LATER USE ADB O2 BUMP TO ID(29) STB ID29 AND SAVE ADB O3 ADVANCE TO 2ND SESSION WORD *780920* JSB LOADA FETCH CONTENTS *780920* ALF,RAL IF "DON'T COPY" BIT IS SET, *780920* SSA REJECT REQUEST *780920* JMP ERR17 *780920* * * COPY EVERYTHING EXCEPT TEMPORARY LOADS BY THE LOADER. * IF TL BIT IS SET, CHECK THE "I'M A COPY" BIT. IF THIS * BIT IS SET, WE CAN DO THE COPY, OTHERWISE REPORT ERROR. * NOTE: THE "I'M A COPY" BIT IS SET WHEN A PROGRAM IS RP'ED. * RAL,ELA MOVE "I'M A COPY" BIT TO E *780920* LDA NAM5Y MOVE THE TEMPORARY LOAD BIT *780920* ALF,ALF *780920* SSA IF TEMP LOAD BIT CLEAR(PERM.PGM) *0920* SEZ,CCE OR THE "I'M A COPY" BIT IS SET *780920* JMP TYPOK THEN THIS ID MAY BE COPIED *780920* * ERR17 LDA D17 ERR 17 >> ID SEGMENT NOT SET UP BY RP JMP EXIT E-REG=1 OR NOT A PERMANENT SYSGEN PROGRAM ERR23 CCE LDA D23 ERR 23 >> DUPLICATE PROGRAM NAME JMP EXIT ERR14 LDA D14 ERR 14 >> REQUIRED ID SEGMENT NOT FOUND JMP EXIT SPC 1 TYPOK JSB IDSGA SEARCH IF NEW NAME ALREADY EXISTS DEF *+2 DEF NWNAM,I CCE,SZA,RSS NOT FOUND IS OK JMP CKNAM SPC 1 STA NID,I RETURN AS NEW ID SEG ADDRESS ADA D26 OFFSET TO DISC ADDRESS WORD STA B SAVE IN B JSB LOADA GET DISC ADDRESS TO A STA TEMP SAVE TEMPORARILY LDB ID27 DISC ADDRESS IN "OLD" ID JSB LOADA CPA TEMP COMPARE THE TWO DISC ADDRESSES CLA,CLE,RSS MATCH - RETURN AS IF WE DID IT JMP ERR23 NO MATCH - ERROR JMP EXIT RETURN SPC 1 * NOW CHECK NEW NAME FOR CONTAINING PRINTABLE CHARACTERS SPC 1 CKNAM JSB NAM.. USE FMP NAME CHECKING ROUTINE DEF *+2 DEF NWNAM,I CCE,SZA CHECK IF -15 ERROR JMP EXIT YES, GET OUT -15 ERROR JMP SERCH E-REG MUST = 1 AT THIS POINT!!!!! SPC 1 * BLANK ID'S ARE SEARCHED IN FOLLOWING PRECEDENCE * * TYPE 2 OR 3 PROG * 1)LONG BLANK WITHOUT TRACKS * 2)LONG BLANK & DON'T CARE * SPC 1 LOOP1 SEZ,CME,RSS IF DOWN TO LONG BLANK & DONT CARE JMP ERR14 THEN GET OUT FMGR ERROR 14 SPC 1 SERCH LDA KEYWD RESET FOR KEYWORD SEARCH STA TEMP1 RSS SKIP 1ST ISZ SPC 1 * E-REG=1>>SEARCH ID WITHOUT TRACKS E-REG=0>>DON'T CARE ABOUT TRACKS SPC 1 LOOP2 ISZ TEMP1 BUMP AND CHECK IF DONE WITH LDB TEMP1 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) SZA FOUND ONE BLANK & LONG JMP LOOP2 NO, TRY NEXT IDSEG ADB D12 BUMP TO WORD 27 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 LDB TEMP1 GET BLANK IDSEG(1) ADDRESS *780403* JSB LOADA *780403* STA B *780403* STA NID,I RETURN ADDRESS OF NEW ID SEGMENT STB MOVE1 SAVE FOR MOVE ROUTINE INB SET UP FOR XB SET STB TEMXB SPC 1 * NOW CREATE THE NEW ID SEGMENT SPC 1 JSB .OWNR FETCH OWNER FLAG *780920* IOR B1000 MERGE IN COPY FLAG *780920* STA OWID SAVE FOR ID BUILD *780920* CLA *780403* JSB MOVE CLEAR 1ST 6 WORDS OF PROGRAMS ID O6 DEC 6 LDA ID7 GET IDNAM'S ID(7) ADDRESS JSB XMOV GET PRIORITY & ENTRY PT ADDR. *780403* OCT 2 CLA CLEAR WORDS 9-10 JSB MOVE FIX UP WORD 11 LATER (XB) OCT 2 LDA DEFXB SET XB TO POINT TO XTEMP JSB MOVE AND ZERO ID(12) OCT 2 LDA NWNAM MOVE NEW NAME CHARS 1-4 JSB MOVE INTO NEW ID SEGMENT DEC 2 LDA A,I GET 3RD WORD OF NAME AND OM400 MASK OFF 6TH CHAR XOR NAM5Y MERGE IN 6TH CHAR OF OLD ID AND OM20 OM20 = 177760B XOR NAM5Y RESTORE BITS 8-15 OF NWNAM 0-3 OF NAM5Y IOR O200 MERGE IN THE "TM" BIT STA NAM5Y SAVE IN "TIME" BUFFER LDA TIMEB GET TIME BUFFER ADDRESS JSB MOVE COPY INTO ID O7 OCT 7 LDA ID22 COPY MEMORY/DISC ADDRESS JSB XMOV *780403* OCT 6 SPC 1 *10-5* NOW CALCULATE NUMBER OF TRACKS USED BY PROGRAM *10-5* THE ASSUMPTION IS MADE THAT A PROGRAM OWNS A TRACK IF IT OWNS *10-5* THE FIRST SECTOR OF THAT TRACK. (IT IS POSSIBLE THAT A SHORT *10-5* PROGRAM OWNS NOTHING) THIS IS TO BE COMPATABLE WITH THE *10-5* SYSTEM '*OF,PROG,8' PROCESSOR. *10-5* NOW AN EXCEPTION IS MADE TO THE PREVIOUS STATEMENT: *10-5* THIS SUBROUTINE SETS THE FIRST TRACK THIS PROGRAM IS ON TO *10-5* BELONG TO 'FMP' BECAUSE THE ':RP,,PROG' FMGR DIRECTIVE WON'T *10-5* WORK IF THIS NOT SO. ('*OF,PROG,8' IS CONSIDERED TOO NOISY *10-5* A DIRECTIVE TO THE SYSTEM CONSOLE AT PRESENT) IF THE 'OF,PROG,8' *10-5* DIRECTIVE IS FIXED, THERE IS 2 LINES OF CODE MARKED '*' THAT CAN *10-5* BE INSERTED LATER. (DLB) *10-5 SPC 1 *10-5 ISZ ID22 BUMP TO ID(23) HI-MAIN ADDRESS *10-5 JSB SUM CALCULATE # SECT USED FOR MAIN MEM. *10-5 STA TEMP1 *10-5 JSB SUM CALCULATE # SECT OF BASE PAGE *10-5 ADA TEMP1 CALCULATE TOTAL - 1 *10-5 ADA OM1 *10-5 STA TEMP1 AND SAVE FOR LATER ADDITION *10-5 LDA ID22,I GET LU/TRACK/SECTOR ADDRESS OF START *10-5 AND O177 GET SECTOR NUMBER *10-5 STA SUM SAVE TEMP *10-5 XOR ID22,I GET TRACK # *10-5 LDB ASCT2 GET DEF TO SECT2 ON BASE PAGE *10-5 STB SECPT SAVE FOR CALCULATIONS *10-5 CLE,ELA SAVE LU IN E-REG *10-5 SEZ IF LU=3 BUMP TO SECT3 WORD *10-5 ISZ SECPT ON BASE PAGE *10-5 ALF,ALF POSITION TRACK BITS 0-7 *10-5 MPY SECPT CALCULATE # SECTORS *10-5SECPT EQU *-1 SAVE SOME CORE *10-5 ADA SUM ADD IN STARTING SECTOR *10-5 ADA TEMP1 LAST USED SECTOR BY PROG *10-5 DIV SECPT,I NOW CALCULATE LAST TRACK *10-5 SEZ CHECK IF LU=2 OR LU=3 *10-5 ADA TATSD LU=3, MOVE UP TO THAT PART OF TAT *10-5 ADA TAT ADD IN BASE ADDRESS OF TAT *10-5* *10-5* SZB CHECK IF OWNS 1ST SECTOR OF TRACK *10-5* JMP *+3 NO, DON'T BUY 1ST TRACK IT IS ON. *10-5* *10-5NEXTK LDB FMPTK GET FMP TRACK OWNERSHIP WORD *10-5 STB TATAD,I AND BUY *10-5 CPA TATAD CHECK IF LAST TRACK PROG IN ON? *10-5 JMP DONE YES, CONTINUE *10-5 ISZ TATAD NO, BUMP TO NEXT TRACK AND BUY *10-5 JMP NEXTK *10-5 SPC 1 DONE CLA STA INDX JSB MOVE NOW ZERO WORD 28 O1 OCT 1 SPC 1 LDB $OPSY OP SYSTEM IDENTIFIER CPB M9 RTE-IV? RSS YES, SAVE RTE-IV WORDS JMP EXIT NO LDB ID29 GET EMA WORD *780403* JSB LOADA *780403* SZA,RSS EMA? JMP NOEMA NO, ZERO THE EMA WORD JSB GTEXT FIND FREE ID EXTENSION SZB,RSS AVAILABLE? *780403* JMP ERR14 NO, RETURN NO AVAILABLE ID EXT STB IDEXT YES, SET UP DESTINATION ADDR. *780403* LDB ID29 GET EMA WORD *780403* JSB LOADA *780403* CLB GET READY FOR SHIFT *780503* ASL 6 GET CURRENT ID EXT # TO B XLA $IDEX GET ID EXT LIST HEAD *780503* ADB A OFFSET TO ID EXT ADDR *780503* JSB LOADA AND FETCH IT *780403* STA B *780403* STA TEMP1 *780403* JSB LOADA GET ID EXT WORD 0 *780403* AND MSKMS MASK OFF MSEG# LDB IDEXT SAVE IN ID EXTENSION WORD 0 *780403* JSB STORA *780403* ISZ IDEXT BUMP DESTINATION ADDRESS LDB TEMP1 *780403* INB BUMP TO NEXT ID EXT WORD JSB LOADA CONTENTS OF NEXT ID EXT WORD *780403* AND MSKH6 MASK OFF EMA START PAGE LDB IDEXT SAVE IN ID EXTENSION WORD 1 *780403* JSB STORA *780403* INB BUMP DESTINATION ADDRESS *780403* CLA ZERO ID EXTENSION WORD 2 JSB STORA SAVE IN ID EXTENSION WORD 2 *780403* SPC 1 LDB INDX GET NEW ID EXTENSION # ASR 6 MOVE TO HIGH 6 BITS STA TEMP1 TEMPORARY SAVE *780403* LDB ID29 GET ID SEGMENT EMA WORD *780403* JSB LOADA *780403* AND O1777 MASK OFF HIGH 6 BITS IOR TEMP1 MERGE TO CREATE NEW EMA WORD *780403* NOEMA LDB MOVE1 COPY TO NEW ID SEGMENT *780403* JSB STORA *780403* ISZ MOVE1 BUMP DESTINATION ADDRESS SPC 1 LDB ID29 *780403* INB *780403* JSB LOADA GET HI-ADDR+1 OF LARGEST SEG. *780403* LDB MOVE1 DESTINATION ADDRESS *780403* JSB STORA COPY TO NEW ID SEGMENT *780403* INB BUMP DESTINATION ADDRESS *780403* CLA JSB STORA ZERO ID(30) *780403* INB *780403* JSB LOADA FETCH ID(31) *780920* AND B170K ISOLATE SEQUENCE COUNTER *780920* IOR OWID MERGE IN OWNER & COPY FLAGS *780920* JSB STORA RESTORE ID(31) *780920* CLA INB *780403* JSB STORA ZERO ID(32) *780403* SPC 1 EXIT STA IERR,I TELL CALLER CLB CLEAR IERR FOR POSSIBLE NEXT USER STB IERR STB OID CLEAR OPTIONAL PARM STB NID CLEAR OPTIONAL PARM JSB $LIBX AND RETURN DEF IDDUP SPC 1 *10-5SUM NOP ROUTINE TO CALCULATE # SECTORS USED *10-5 LDA ID22,I GET LO-ADDRESS *10-5 CMA,INA MAKE NEG *10-5 IOR O177 ROUND UP TO NEAREST MOD OF 128 WORDS *10-5 ISZ ID22 BUMP TO HI-ADDRESS *10-5 ADA ID22,I SUM FOR TOTAL WORDS *10-5 ISZ ID22 *10-5 CLB NOW CALCULATE # SECTORS *10-5 LSR 7 DIVID BY 128 *10-5 RAL MPY BY 2 *10-5 JMP SUM,I RETURN A=# OF SECTORS NEEDED *10-5 SPC 1 *10-5ASCT2 DEF SECT2 *10-5 SPC 1 MOVE NOP ENTRY A=SOURCE ADDRESS, NEWID=DEST LDB MOVE,I GET COUNTER CMB,INB STB MCNT LDB MOVE1 *780403* MORE STA TEMP1 *780403* LDA A,I GET NEXT WORD OR ZERO *780403* JSB STORA AND PUT IN SYSTEM *780403* LDA TEMP1 RESTORE TEMPORARY SAVE *780403* CLE,SZA BUMP SOURCE ADDRESS ONLY IF NON 0 INA RETURN E-REG = 0!!!!!! INB *780403* ISZ MOVE1 ISZ MCNT JMP MORE ISZ MOVE P+2 RETURN JMP MOVE,I RETURN DONE B=NEXT ADDRESS SPC 1 MOVE1 NOP SPC 1 XMOV NOP ENTRY A=SOURCE ADDR (CROSS-MAP)*780403* LDB XMOV,I GET COUNTER OF WORDS TO MOVE *780403* CMB,INB *780403* STB MCNT *780403* LDB MOVE1 DESTINATION ADDRESS *780403* MORE2 STA TEMP1 TEMPORARY SAVE *780403* JSB LOAD2 GET NEXT WORD OR ZERO *780403* JSB STORA AND PUT IN SYSTEM *780403* LDA TEMP1 RESTORE TEMPORARY WORD *780403* CLE,SZA BUMP SOURCE ADDR ONLY IF NON-0 *780403* INA RETURN E-REG=0! *780403* INB BUMP DESTINATION ADDRESS *780403* ISZ MOVE1 *780403* ISZ MCNT *780403* JMP MORE2 *780403* ISZ XMOV P+2 RETURN *780403* JMP XMOV,I RETURN WITH B=NEXT ADDRESS *780403* SPC 1 GTEXT NOP RETURN B=ID EXTENSION ADDRESS XLB $IDEX RETURN B=0, E=1 IF NO ID EXT AVAIL. STB IDX GET & SAVE ID EXTENSION LIST HEAD RSS *780403* GTEX1 LDB IDX GET NEXT ENTRY IN ID EXT LIST *780403* XLA B,I *780403* STA B *780403* SZB,RSS END OF ID EXTENSION BLOCK? *780403* JMP GTEXT,I YES, RETURN B=0, NO AVAIL EXT. *780403* XLA B,I NO, GET WORD 0 OF ID EXTENSION *780403* SZA,RSS AVAILABLE? *780403* JMP GTEXT,I RETURN B=ID EXTENSION ADDRESS *780403* ISZ INDX NO, BUMP ID EXTENSION NUMBER ISZ IDX BUMP ID EXTENSION ADDRESS JMP GTEX1 TRY THE NEXT ID EXTENSION 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 TEMP SAVE TEMPORARILY *780403* LDA STYPE OP SYS IDENTIFIER (AFTER ERA) *780403* SLA MAPPED SYSTEM? *780403* JMP MAP YES *780403* LDA TEMP RESTORE TEMP WORD *780403* STA B,I NON-MAPPED, DO DIRECT LOAD *780403* JMP STORA,I RETURN *780403* MAP LDA TEMP RESTORE TEMP WORD *780403* XSA B,I DO CROSS-STORE (2 WD INSTRUCT) *780403* JMP STORA,I RETURN *780403* SPC 1 LOAD2 NOP DOES XLA A,I IF MAPPED SYS *780403* STA TEMP SAVE A-REG *780403* LDA STYPE OP SYS IDENTIFIER (AFTER ERA) *780403* SLA MAPPED SYSTEM? *780403* JMP XLOAD YES *780403* LDA TEMP,I NO, DO DIRECT LOAD *780403* JMP LOAD2,I RETURN *780403* XLOAD XLA TEMP,I DO CROSS-LOAD (2 WD INSTRUCT.) *780403* JMP LOAD2,I RETURN *780403* SPC 1 TIMEB DEF *+1 NAM5Y NOP 5TH CHAR & PROGRAM TYPE DEC 0 ID(16) DEC 0 ID(17) DEC 0 ID(18) OCT 25000 ID(19) TIME = ONE DAY OCT 177574 ID(20) DEC 0 ID(21) SPC 1 DEFXB DEF *+1 DON'T CHANG ORDER OF NEXT 3 WORDS TEMXB NOP DEC 0 SPC 1 ID7 NOP HOLDS ADDRESS IF ID(7) ID22 NOP ID27 NOP *10-5TATAD NOP ID29 NOP IDEXT NOP IDX NOP INDX NOP OWID NOP *780920* TEMP NOP *780403* TEMP1 NOP FMPTK OCT 77776 MSKH6 OCT 176000 MSKMS OCT 100037 *10-5OM1 OCT -1 O2 OCT 2 O3 OCT 3 O4 OCT 4 O5 OCT 5 M9 DEC -9 D12 DEC 12 D14 DEC 14 D17 DEC 17 D23 DEC 23 D26 DEC 26 *10-5O177 OCT 177 O200 OCT 200 O1777 OCT 1777 B1000 OCT 1000 B170K OCT 170000 OM2 OCT -2 OM20 OCT -20 OM400 OCT -400 OM360 OCT -360 END