ASMB,R,L,C * NAME: LOAD2 * SOURCE: 92070-18110 * RELOC: 92070-16110 * PGMR: D.J.W.,B.W. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. 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 LOAD2,5,99 92070-1X110 REV.1941 800325 * * * THIS SEGMENT SERVES TO PROVIDE ROUTINES FOR FILE RELOCATION, * SEARCH, SYSTEM LIBRARY SCAN, PRINTING UNDEFINED EXTERNALS, * RELOCATION INITIALIZATION, AND COMPLETION OF RELOCATION. * * * CHANGE 3/8/80 * LOAD2 WAS CHANGED AT E.RRR PROCESSING TO JUMP DIRECTLY TO * AB.RT IN THE MAIN INSTEAD OF RETURNING TO THE CALLER OF * PRCSS WITH AN ERROR. THIS HANDLES THE CASE WHERE ALLOC * WAS CALLED DURING THE SEARCH OF SYSTEM ENTRIES AND A BASE * PAGE OVERFLOW RESULTED. BEFORE E.RRR ATTEMPTED TO RETURN * TO THE CALLER OF PRCSS WHEN PRCSS HAD NOT BEEN CALLED. * * * * CHANGE 2/25/80 * CHANGED END PROCESSING IN PRCSS ROUTINE SO AS TO CLEAR THE * VALID NAME READ FLAG, NM2.L, IF THE LATEST MODULE WAS LOADED * OR NOT. * * * ENT BHIGH,E.RRR, END,LOAD2,PRENT, PUDF ENT RE.LC,OFFBP,SE.MS,SHIGH,SYSCN,TABLE ENT PRCSS ENT &MNAM,&MLEN,&MODE,&NMOD * EXT QUERY EXT .DFER, .MVW,#LIBS,#SENT,#SGMT,#SLIB EXT AB.RT,ABOUT,ALLOC,APOSN,BNAMR,BPFWA EXT CBP.L, CFWA, CKSM,CNUMO,COMAD,COMLN EXT COMTP,CUREC, DB1, DB1X,DBFLG,DEBUG EXT DRKEY,FDONE,FMPER,FOPEN,FORCD,FWAVB EXT FWAFS,FWSYB,I.ERR,ID.CB,IFBRK,IGN.L EXT INAMR,L.BUF,L.CLS,L.IFX,L.INT,L.LDF EXT L.LUN,L.MAT,L.REL,L.SG0,L.SGN,L.SYE EXT LBS.L,LDRER,LNAMR, LOCF,LWAFS,MSEGF,NAMF EXT NM1.L,NM2.L,NM4.L,NOFBP,NOFSB,NOR.L EXT ODCB,ONAMR, OPEN,OTDFT,OUTAB,OUTBP EXT OUTBF,P.ROR,PGFWA EXT PGLWA,PGT.L,PL.ST,POSNT,PRI.L,PRMAP EXT PROGN,READF,RTNS2,RWNDF, SCAN, SDCB EXT SEG.L,SGB.L,SNAMR,SPACE, SYBP,SYOUT EXT SUMAP,TH1.L,TH2.L,TSY.L,WRITF EXT ALC.B * A EQU 0 B EQU 1 * SGNAM BSS 60 SEGMENT NAM BUFFER .BUF EQU * HED INITIALIZATION FOR LOADER LIBRARY ********************************************************************** * * NOTE: THIS CODE IS OVERLAYED WITH THE BUFFER 'SGNAM'. * ********************************************************************** * * ORG SGNAM LOAD2 LDA CBP.L SET THIS ASIDE IN CASE OF INITIAL BUMP STA TEMP1 JSB L.INT INITIALIZE RELOCATION SUBROUTINES DEF *+9 DEF FWAFS STARTING ADDRESS OF FREE AREA DEF LWAFS ENDING ADDRESS FREE AREA DEF BPFWA ACTUAL FWA BASE PAGE DEF COMAD SYSTEM COMMON ADDRESS, OR ZERO DEF COMLN LENGTH OF COMMON DEF TH2.L PROGRAM RELOCATION BASE DEF PGLWA LWA PROGRAM AREA DEF TABLE TABLE OF LIB SUBROUTINES * LDA DBFLG HAS USER SPECIFIED DEBUG ? SZA,RSS JMP NODBG NO JSB L.SYE YES, ENTER ".DBUG" INTO SYMBOL TABLE DEF *+6 DEF .DBUG SYMBOL NAME DEF P2 SET AS UNDEFINED DEF P0 VALUE = ZERO DEF P2 DO NOT OVERRIDE DEF RESLT RESULT RETURNED * NODBG LDA BPFWA SET UP SOME BASE PAGE POINTERS AND CMA,INA OFFSETS IN DUMMY BASE PAGE ADA FWAVB STA OFFBP OFFSET INTO DUMMY BASE PAGE CMA,INA STA NOFBP -VE OFFSET LDA FWSYB CMA,INA ADA SYBP STA NOFSB OFFSET INTO SYSTEM BASE PAGE * LDA TEMP1 GO OUTPUT ANY INITIAL BASE PAGE BUMP SZA IF THERE IS ONE THAT IS JSB ALC.B AND USE ALC.B TO ALLOCATE AND ZERO * LDA CKSM STUFF SYSTEM CHECKSUM WORD STA SYCKM INTO LONG ID SEGMENT LDA COMAD SYSTEM COMMON REFERENCED ? CLB SZA WELL ?? LDB B11 YES, SET STATUS WORD IN ID SEGMENT STB STATS TO 'SYSTEM COMMON' * LDA PGFWA SAVE PROGRAM FIRST WORD STA LOMAN AS LOW MAIN IN THE LONG ID LDA BPFWA SAVE LOW BASE PAGE ADDRESS STA LOBSE AS LOW BASE IN LONG ID JMP RTNS2 RETURN TO THE MAIN * TEMP1 BSS 1 TEMP FOR CBP.L B11 OCT 4000 .DBUG ASC 3,.DBUG USER DBUGR SYMBOL ENTRY NAME * * TABLE OF SUBROUTINES CALLABLE BY THE LOADER LIBRARY * TABLE DEF ALLOC+0 ALLOCATE A BASE PAGE LINK DEF SCAN+0 SCAN FOR A MATCHING BASE PAGE LINK DEF OUTAB+0 OUTPUT AN ABSOLUTE WORD TO THE DISC BSS .BUF-* *CHECK EQU *-.BUF CHECK FOR PROPER OVERLAY ********************************************************************** * * END OF OVERLAY AREA * ********************************************************************** HED RELOCATION FLOW OF CONTROL * * * THIS SUBROUTINE CONTROLS THE RELOCATION PROCESSING OF A FILE. * IT IS ASSUMED THE FILE IS OPENED AND POSITIONED TO THE FIRST * MODULE TO BE RELOCATED. * * CALLING SEQUENCE: JSB RE.LC * * ON RETURN: P+1: ABORT, A-REG < 0 = FMP ERROR CODE * P+2: GOOD LOAD * * RE.LC NOP CLE SET 'NEW LOAD' FLAG CLA SET 'NO RESCAN' FLAG STA RFLAG * CONTU CLB SET 'NOT A LIBRARY SCAN' STB LBS.L INB STB SCSEG SET 'RETURN ON SEGMENT NAM' JSB PRCSS GO PROCESS THE FILE JMP ERFM? ERROR RETURN SSA,RSS SEGMENT NAM READ ? JMP SEGMT YES, GO RESCAN AND SEARCH SYSTEM LIBS ISZ NOR.L NO SEGMENT, WAS A SUBROUTINE LOADED ? JSB RESCN YES, RESCAN THE FILE FIRST ISZ RE.LC NO SUBROUTINE LOADED, END OF FILE READ JMP RE.LC,I RETURN TO CALLER * * SEGMENT NAM FOUND IN THE FILE * SEGMT LDA #SGMT HAVE WE READ TOO MANY SEGMENTS ? CMA,INA ADA SEG# COMPARE TO THE MAXIMUM ALLOWED. SSA,RSS JMP ER.RR YES, GO OUTPUT ERROR MESSAGE * ISZ FDONE SET FLAG FOR 'MAIN LOADED' JSB RESCN RESCAN THE FILE FIRST ISZ RFLAG NEXT TIME WE RESCAN CLA SCAN USER AND SYSTEM LIBRARIES JSB SYSCN CHECK FOR UNDEFS IN CURRENT MAIN OR SEGMENT JMP RE.LC,I ERROR RETURN, MESSAGE HAS BEEN PRINTED STA TEMP JSB SUMAP PRINT UPPER BOUNDS ON MAIN OR SEG LDA TEMP LDB SEG.L GET THE STATUS WORD CPB P2 CURRENT MODULE MAIN OR SEGMENT ? SZA,RSS SEGMENT, DOES IT HAVE UNDEFS ? JMP CONT ITS A MAIN OR SEGMENT WITH NO UNDEFS LDA FORCD IS THIS A FORCE LOAD ? SSA JMP CONTX YES, FORCE LOAD CLA,INA PRINT THE UNDEFS JSB PUDF LDA P7 AND LOADER ERROR 'UN EXT' OUTMS JSB LDRER JMP RE.LC,I AND FLUSH THE LOAD * ER.RR LDA P6 OUTPUT LOADER ERROR 'NO SEG' JMP OUTMS * * CONTINUE WITH THE LOAD * CONTX CLA PRINT THE CURRENT UNDEFS JSB PUDF JSB L.IFX FIX-UP ALL UNDEFINED EXTERNALS DEF *+1 CONT JSB END FINISH PROCESSING CURRENT MAIN OR SEGMENT JMP RE.LC,I ERROR RETURN * ISZ SEG# JSB FOPEN DEF *+5 DEF INAMR NAMR ADDRESS DEF ID.CB DCB ADDRESS DEF IOPTN DEF P272 JMP RE.LC,I ERROR RETURN ON OPEN * LDA INAMR+3 WAS THIS AN LU ? ERA,SLA CCE,RSS JMP CONTU YES, SO NO REPOSITION * JSB APOSN REPOSITION TO SAVED LOCATION DEF *+6 DEF ID.CB DCB ADDRESS DEF I.ERR ERROR PARM DEF IREC RECORD NUMBER DEF IRB BLOCK NUMBER DEF IOFF OFFSET * CCE,SSA FMP ERROR ? JMP ERFMP YES, OUTPUT MESSAGE AND ABORT JMP CONTU CONTINUE WITH THE SEGMENT LOAD * * NOSEG DEC 6 RFLAG BSS 1 'RESCAN' FLAG P7 DEC 7 P272 DEC 272 * ERFM? SSA,RSS IS THERE AND FMP ERROR ? JMP RE.LC,I NO, JUST ABORT ERFMP JSB FMPER YES, OUTPUT ERROR MESSAGE DEF INAMR+0 ON RELOCATABLE NAMR JMP RE.LC,I AND ABORT * * RESCAN CURRENT FILE IN AN ATTEMPT TO SATISFY UNDEFS * RESCN NOP LDA INAMR+3 IS THIS A FILE OR LU ? ERA,SLA ITS GOT TO BE ONE OF THE TWO RSS FILE JMP RESCN,I LU, SORRY, NO RESCAN !! * * JSB LOCF DETERMINE CURRENT FILE LOCATION DEF *+6 DEF ID.CB+0 FILE DCB ADDRESS DEF I.ERR+0 ERROR PARM DEF IREC NEXT RECORD NUMBER DEF IRB RELATIVE BLOCK OF NEXT READ DEF IOFF BLOCK OFFSET OF NEXT RECORD * SSA FMP ERROR RETURNED ? JMP ERFMP YES * LDA SEG# IS THIS THE FIRST SEGMENT ? SZA,RSS JMP R.SCN YES, THEN RESCAN THE FILE * LDA RFLAG DO WE REALLY WANT TO RESCAN ? SZA,RSS JMP RESCN,I NO, RETURN TO CALLER * R.SCN JSB RWNDF REWIND FILE DEF *+3 DEF ID.CB+0 FILE DCB ADDRESS DEF I.ERR+0 ERROR PARM * SSA ERROR RETURNED ? JMP ERFMP YES * JSB SE.MS SCAN FILE FOR UNDEFS JMP RE.LC,I ERROR RETURN JMP RESCN,I RETURN TO CALLER * * * IREC NOP IRB NOP IOFF NOP TEMP BSS 1 P5 OCT 5 HED PRINT UNDEFINED EXTERNALS * * * PUDF OUTPUTS A LIST OF UNDEFINED EXTERNALS TO THE LIST DEVICE * OR COMMAND DEVICE USING SUBROUTINE 'SYOUT'. * * CALLING SEQUENCE: JSB PUDF * A-REG = 0/1, SEGMENT / MAIN AND SEGMENT * * ON RETURN: REGISTERS DESTROYED * * PUDF NOP STA MNSEG SAVE MAIN-SEGMENT FLAG CLA SET PNTR FLAG TO START OF EXTS STA PONTR CMA INITIALIZE 'FIRST TIME THROUGH' FLAG STA FIRST JSB SPACE AND SPACE UP A BLANK LINE * NXUDF JSB L.LUN RETRIEVE UNDEFINED EXTERNAL DEF *+4 DEF ADRS ADDRESS OF SYMBOL NAME ARRAY DEF PONTR ADDRESS POINTER TO BE CARRIED DEF MNSEG MAIN-SEGMENT FLAG * ISZ FIRST FIRST TIME THROUGH LOOP ? JMP UNDFS NO, PRINT UNDEF SZB,RSS YES, DO UNDEFS EXIST ? JMP NODEF NO, PRINT "NO UNDEFS" LDA P14 YES, UNDEFS EXIST LDB MESS3 PRINT HEADER MESSAGE FOR UNDEFS LIST JSB SYOUT LET SYOUT DECIDE WHERE MESSAGE GOES LDB ADRS RESTORE THE ENTRY ADDRESS * * UNDEFINED EXTERNALS EXIST * UNDFS SZB,RSS UNDEFS REMAIN ? JMP PUDF,I NO, RETURN TO CALLER LDA P5 YES, GET LENGTH OF MESSAGE IN CHARS JSB SYOUT OUTPUT TO LIST DEVICE JMP NXUDF GET NEXT UNDEF * * NO UNDEFS THIS TIME * NODEF LDA P12 NO UNDEFS, GET MESSAGE LENGTH LDB NMESS AND ADDRESS JSB SYOUT OUTPUT TO LIST DEVICE JMP PUDF,I RETURN TO CALLER * FIRST BSS 1 'FIRST TIME THROUGH' FLAG MNSEG BSS 1 0/1, SEGMENT/ MAIN AND SEGMENT PONTR BSS 1 POINTER FOR L.LUN ADRS BSS 1 ADDRESS OF SYMBOL TABLE ENTRY P12 DEC 12 P14 DEC 14 NMESS DEF *+1 ASC 6, NO UNDEFS MESS3 DEF *+1 ASC 7,UNDEFINED EXTS HED RELOCATION PROCESS CONTROL * * PRCSS CONTROLS CALLS TO THE LOADER LIBRARY RELOCATION * ROUTINES L.REL AND L.CLS. THE FLAGS ARE SET, * THE RECORD READ, CLASSIFIED, AND RELOCATED. ALSO SOME * PRE-PROCESSING AND POST-PROCESSING IS DONE ON THE * NAM AND END RECORDS RESPECTIVELY. * * CALLING SEQUENCE: JSB PRCSS * E-REG = 0/1, NEW LOAD/ CONTINUE SEGMENT LOAD * * ON RETURN: P+1: ERROR CONDITION, ABORT LOAD * P+2: GOOD LOAD, * A-REG = 0/-1, SEGMENT READ, EOF * * IL DEC 60 LENGTH OF L.BUF LEN NOP LENGTH READ ON READF CALL SUBTP EQU LEN SUBTYPE PARM (EQU LEN FOR SPACE ONLY) RIC NOP RECORD INDICATOR WORD &MODE DEC 1 DEFAULT TO SYMBOL SEARCH MODE (ALL MODULES) &MNAM BSS 3 3 WORD MODULE NAM BUFFER TEMPORAREY &MLEN BSS 1 LENGTH OF MODULE NAME IN WORDS &NMOD DEC 0 0/1, N/1 MODULES TO SEARCH AND RELOCATE IGNN BSS 1 0/<>0, PRC/IGNORE RECORDS UNTIL NAM HIT * PRCSS NOP CLA STA IGNN LOOK AT ALL RECORDS INITIALLY CCB SET FLAGS FOR LOADER LIBRARY STB NOR.L NO SUBROUTINES LOADED IN THE SCAN STB NM1.L NAM RECORD MUST BE FIRST SEZ NEW LOAD, CONTINUE SEG LOAD ? JMP CONTL CONTINUE SEGMENT LOAD * LDA FDONE HAS THE NAM BEEN READ ? SZA,RSS JMP PRC02 YES, CLASSIFY THE RECORD PRC00 JSB READF READ RELOCATABLE RECORD DEF *+6 DEF ID.CB+0 DCB ADDRESS DEF I.ERR+0 ERROR PARM DEF L.BUF+0 DESTINATION BUFFER DEF IL BUFFER LENGTH DEF LEN LENGTH READ SSA FMP ERROR ? JMP PRCSS,I RETURN TO CALLER LDA LEN ZERO LENGTH RECORD READ ? SZA,RSS JMP PRC00 YES, ISSUE READ AGAIN SSA EOF ? JMP EOF YES, RETURN TO CALLER * PRC02 JSB L.CLS NO, CLASSIFY RECORD TYPE DEF *+3 DEF RIC RECORD TYPE WORD DEF SUBTP SUBTYPE PARMETER SSA ERROR RETURN ? JMP E.RRR YES, OUTPUT MESSAGE AND ABORT CPA P7 IF INDEX RECORD SET IGNORE RECORDS UNTIL RSS NAM RECORD READ JMP NTIDX LDB SUBTP CPB P9 STA IGNN IS INDEX SET IGNN <>0 NTIDX LDB IGNN TEST FOR IGNORE IF NOT NAM SZB,RSS JMP OKPRC PROCESSING ALL RECORDS CPA P1 IGNORE IF NOT NAM RSS JMP PRC00 IGNORE THIS NON NAM RECORD CLB CLEAR FLAG TO RESUME SCANNING STB IGNN ALL RECORD TYPES * * NOTE THIS NAM CODE MUST BE CHANGED FOR XNAM RECORDS * OKPRC CPA P1 NAM RECORD ? JSB PRCNM CPA P6 EMA RECORD ? JMP EMA EMA ACCESS IS ILLEGAL FOR RTE-L JSB L.REL RELOCATE THE RECORD DEF *+2 DEF I.ERR+0 ERROR PARM SZA ERROR RETURN ? JMP E.RRR YES, REPORT AND ABORT LDB RIC NO, CHECK RECORD TYPE CPB P5 END RECORD ? JSB PRCED YES, POST END PROCESSING JMP PRC00 NO, CONTINUE RELOCATION * EOF CLB EOF READ STB SCSEG SET RETURN ON SEGMENT NAM FLAG RTN ISZ PRCSS TAKE GOOD RETURN, P+2 JMP PRCSS,I HED FATAL ERROR PROCESSING E.RRR STA TEMP LOADER ERROR, SAVE ERROR NUMBER CPA P1 BASE PAGE OVERFLOW ? JMP MODNM YES SSA,RSS ERROR +VE ? JMP REPRT YES, JUST REPORT THE ERROR CPA N4 IS THIS OV FIX ?? JMP REPRT YES, GO REPORT THE ERROR ADA P9 ERRORS -1 TO -9 GET MODULE NAME ALSO SSA LESS THAN -9 ? JMP REPRT YES, JUST GO REPORT * MODNM LDB NM2.L ADDRESS OF MODULE NAME LDA B,I CHECK THAT A VALID NAME PRESENT SZA,RSS JMP REPRT NO, SKIP MODULE NAME OUTPUT INB YES, VALID NAME LDA P5 GET LENGTH IN CHARS JSB SYOUT AND OUTPUT LDA TEMP CHECK FOR DUPLICATE ENTRY ERROR CPA N7 IS THIS IT ? JMP ENTNM YES, PRINT ENTRY POINT NAME ALSO * REPRT LDA TEMP REPORT THE ERROR TO THE LIST DEVICE PRINT JSB LDRER OUTPUT ERROR MESSAGE JMP AB.RT GO ABORT !!!!!!!!!!! * N4 DEC -4 N7 DEC -7 P9 DEC 9 N2 DEC -2 * ENTNM LDB TSY.L OUTPUT THE CURRENT SYMBOL TABLE ENTRY ADB N5 BACK UP TO PROPER SYMBOL ENTRY LDA B,I GET THE FIRST WORD OF THE SYMBOL ENTRY RAL,CLE,ERA SHIFT OUT ANY SIGN BIT STA B,I AND REPLACE (CAUSE WE'RE GOING TO ABORT) LDA P5 GET LENGTH JSB SYOUT AND OUTPUT JMP REPRT NOW GO REPORT THE ORIGIONAL ERROR * EMA LDA N11 GOT AN EMA RECORD JMP PRINT NO EMA ALLOWED AT ALL !!! * N5 DEC -5 N11 DEC -11 HED RELOCATION PROCESS CONTROL * P1 DEC 1 * * POST PROCESSING ON END RECORD * PRCED NOP JSB CKBRK CHECK FOR BREAK FLAG SET LDB IGN.L WAS THIS MODULE LOADED ? SZB JMP EN.CK NO, SO GET OUT OF HERE * LDA PRI.L PRIMARY ENTRY POINT ? SZA,RSS JMP NOPRE NO * * PROCESS ID SEGMENT VALUES * JSB BLDID JMP NOPRE THIS WAS A SUBROUTINE JMP PRE THIS WAS A SEGMENT, GO SET SOME FLAGS JSB RENAM THIS WAS THE MAIN, SAVE THE NAME AND RENAME JMP NOPRE EVERYTHING OK, SKIP SETTING SEGMENT FLAGS JMP PRCSS,I GOT AN ERROR ON THE RENAME GO ABORT * PRE CLB,INB SET 'RETURN ON SEGMENT NAM' FLAG STB SCSEG CLA,INA AND 'LIBRARY SCAN IN PROGRESS' FLAG STA LBS.L NOPRE JSB PRMAP PRINT MEMORY MAP JSB DEBUG CHECK FOR DBUGR ACCESS * *BW CODE ADDED TO ALLOW 1 MODULE TO BE LOADED ONLY * EN.CK CLA CLEAR THE VALID NAME FLAG IN THE LOADER LIB STA NM2.L,I THAT IS SET THE WORD COUNT TO ZERO LDA &NMOD SEE IF MORE MODULES REQUIRED SZA,RSS JMP PRCED,I YES, RETURN TO CALLER CLA STA &NMOD RESET FLAG TO ALLOW DEFAULTING CMA NO, SET A -1 FOR EOF RETURN FAKE JMP RTN * ASGNM DEF SGNAM+0 * * CONTL LDA ASGNM CONTINUE THE LOAD LDB ALBUF MOVE SEGMENT NAM BUFFER BACK INTO L.BUF JSB .MVW DEF P60 NOP CLA CLEAR 'RETURN ON SEGMENT NAM' FLAG STA SCSEG JMP PRC02 GO PROCESS * PRCNM NOP PRE-PROCESSING ON NAM RECORDS LDB SCSEG ARE WE SCANNING TILL SEGMENT ? SZB,RSS JMP PRCNM,I NO, NO PROCESSING NECESSARY THEN LDB L.BUF+9 YES, WELL HAVE WE GOT A SEGMENT ?? CPB P5 THE CLUE IS PROGRAM TYPE = 5 RSS WE GOT ONE !! JMP PRCNM,I NOPE LDA ALBUF SAVE THE SEGMENT NAM RECORD LDB ASGNM IN A SPECIAL BUFFER JSB .MVW DEF P60 NOP CLA TELL CALLER WE GOT A SEGMENT JMP RTN TAKE GOOD RETURN * * ALBUF DEF L.BUF+0 ENT SCSEG QUERY SETS THIS FLAG SAME AS EOF IN PRCSS SCSEG NOP 0/1, ARE NOT/ ARE CURRENTLY SCANNING TILL * NEXT SEGMENT FOUND P60 DEC 60 HED SEARCH RELOCATABLE FILE * * * SE.MS CONTROLS THE SINGLE OR MULTIPLE SCAN OF A RELOCATABLE * FILE. SE.MS ASSUMES THE FILE IS POSITIONED TO THE FIRST * MODULE TO BE SCANNED. * * * CALLING SEQUENCE: JSB SE.MS * A-REG >= 0, MULTIPLE SCAN DESIRED, * < 0, SINGLE SCAN ONLY. * * ON RETURN: P+1: FMP ERROR, A-REG = ERROR NUMBER * P+2: NO ERROR * * SE.MS NOP STA MULT SAVE MULTIPLE SCAN FLAG CCA SET 'CURRENTLY SCANNING LIBRARY' FLAG STA LBS.L FOR THE LOADER LIBRARY CLA,INA STA FDONE SET MAIN NOT LOADED FLAG SER00 CLA,CLE STA SCSEG SET 'DON'T RETURN ON SEGMENT NAM' FLAG JSB QUERY GO PROCESS THE FILE(MAY BE INDEXED) JMP SE.MS,I ERROR RETURNED FROM PRCSS * LDA MULT NO ERROR, SO WE'VE HIT EOF SSA YES, SCAN MULTIPLE TIMES ? JMP SERC0 SINGLE SCAN ONLY ISZ NOR.L MULTIPLE SCAN, ANYTHING LOADED ? JMP RWND YES, GO REWIND AND RESCAN * SERC0 ISZ SE.MS TAKE GOOD RETURN JMP SE.MS,I * RWND JSB RWNDF BEGIN RESCAN WITH FILE REWIND DEF *+3 DEF ID.CB DEF I.ERR+0 * CPA N3 IS THIS A REWINDABLE DEVICE ? JMP SERC0 YES, NO RESCAN SSA,RSS FMP ERROR RETURNED ? JMP SER00 NO, PROCESS THE FILE * JMP SE.MS,I PRINT MESSAGE AND ABORT * MULT NOP >= 0 , RESCAN MULTIPLE TIMES * < 0 , SCAN ONCE N3 DEC -3 HED SYSTEM LIBRARY SCAN * * * THIS ROUTINE PERFORMS A SCAN OF THE SNAPSHOT FILE AND ALL * NAMED SYSTEM LIBRARY FILES IN AN ATTEMPT TO SATISFY UNDEFS. * FIRST THE USER LIBRARY FILES ARE SCANNED, THESE ARE THE FILES * NAMED DURING THE LOAD PROCESS AS LIBRARIES. NEXT, IF THIS IS * THE FIRST SYSTEM LIBRARY SCAN THE MEMORY RESIDENT LIBRARY, * ABSOLUTE, AND RPL ENTRIES ARE READ FROM THE SNAP AND PUT INTO * THE SYMBOL TABLE. THEN THE SYSTEM LIBRARIES ARE SCANNED. * FINALLY THE SNAPSHOT IS READ TO SATISFY ANY REFERENCES FROM * LOADED SYSTEM LIBRARY SUBROUTINES. IF UNDEFINED EXTERNALS * STILL REMAIN AND SOME MODULE WAS LOADED FROM THE SYSTEM * LIBRARIES, THEN THESE LIBRARIES AND SCANNED AGAIN, AND THE * SNAPSHOT SCANNED. * * CALLING SEQUENCE: JSB SYSCN * A-REG = MAIN/SEGMENT FLAG * * ON RETURN: A-REG >= 0, NO UNDEFS REMAINING * < 0, UNDEFS STILL REMAIN * * SYSCN NOP STA MNSG? SAVE MAIN-SEG FLAG LDA PRENT,I CAN'T BE SCANNING SYSTEM LIBS IF NO SZA,RSS PRIMARY ENTRY POINT DEFINED JMP LOERR YES, 'TR ADD' ERROR * JSB UNDF? ARE THERE ANY UNDEFS ? JMP RNDEX NO, SO GET OUT OF HERE ! * CCA SET FLAGS FOR STA LBS.L LIBRARY SCAN IN PROGRESS CLA DON'T RETURN ON A SEGMENT NAM STA SCSEG * LDA PL.ST ARE WE LISTING ? SZA JSB SPACE YES, SPACE UP CAUSE WE GOT UNDEFS * * JSB URLIB SCAN USER LIBRARIES FIRST JSB SETUP CHECK FOR FIRST SYSLIB SCAN RSCN JSB LBLOK SEARCH SYSTEM LIBRARIES JSB SYLOK NOW SCAN THROUGH SYSTEM ENTRIES * * * JSB UNDF? FINALLY, UNDEFS EXIST ? JMP RNDEX NO UNDEFS, RETURN TO CALLER LDA SLOAD UNDEFS STILL EXIST SZA,RSS ANYTHING LOADED FROM SYSTEM LIBRARIES ? JMP RSCN YES, SO RESCAN THE SYSTEM LIBS AND SNAP RSS RNDEX CLA ISZ SYSCN NO ERROR ON SCAN JMP SYSCN,I RETURN TO CALLER * LOERR LDA P2 ILLEGAL SNAPSHOT ERROR ERROR JSB LDRER SIGNAL USER JMP SYSCN,I AND ABORT * P2 DEC 2 SKP * * UNDF? NOP CLA INITIALIZE SEARCH TO START OF SYMBOL TABLE STA PNTR? JSB L.LUN UNDEFS EXIST IN SYMBOL TABLE ? DEF *+4 DEF ADDR? ADDRESS OF SYMBOL DEF PNTR? DEF MNSG? SCAN CURRENT MODULE * SZB UNDEFS ? ISZ UNDF? YES JMP UNDF?,I NO * ADDR? NOP PNTR? NOP MNSG? NOP SKP * * SET UP FOR THE FIRST SYSTEM LIBRARY SCAN. PUT ALL * RESIDENT LIBRARY ENTRIES INTO THE USER SYMBOL TABLE. * IF SYSTEM COMMON HAS BEEN REFERENCED, THEN PUT ALL * LABELLED COMMON ENTRIES IN ALSO. * SETUP NOP ISZ FRSCN IS THIS THE FIRST SYSLIB SCAN ? JMP SETUP,I NO, RETURN TO CALLER * LDA #SLIB GET NUMBER RESIDENT LIB ENTRIES ALF,ALF ISOLATE IT AND RHALF CMA,INA NEGATE AND STA COUNT SAVE AS A COUNT LDA #SENT GET TOTAL COUNT ALSO CMA,INA STA #SYMB SAVE AS -VE CLA STA NM2.L,I CLEAR VALID NAME FLAG JSB POSNT POSITION TO FIRST ENTRY DEF *+5 DEF SDCB SNAP DCB DEF I.ERR ERROR PARM DEF P2 RECORD 2 DEF P2 TREAT ABOVE AS A RECORD NUMBER SSA FMP ERROR ? JMP SNFMP YES, GO REPORT * NXENT JSB READ READ AN ENTRY OFF THE SNAP LDA SNAME+1 SET SIGN BIT AS ALREADY LISTED IOR B15 STA SNAME+1 LDA SNAME+4 GET SYMBOL TYPE WORD LDB COUNT GET THE CURRENT COUNT SSB,RSS ARE WE PAST THE MEM RES SYMBOLS ? CPA COMTP IS THIS A LABELLED COMMON ENTRY ? JSB ENTER MEMORY RESIDENT OR LABELLED COMMON ISZ COUNT UP THE COUNT NOP DON'T CARE ABOUT THE SKIP ISZ #SYMB UP THE TOTAL COUNT JMP NXENT NOT DONE YET, GET NEXT ONE JMP SETUP,I DONE, RETURN TO CALLER * ENTER NOP ALF,ALF SET TYPE INTO UPPER BYTE STA SNAME+4 FOR THE LOADER SYMBOL TABLE JSB L.SYE PUT THE SYMBOL IN THE SYMBOL TABLE DEF *+6 DEF SNAME+1 SYMBOL NAME DEF SNAME+4 SYMBOL TYPE DEF SNAME+5 SYMBOL VALUE DEF P2 NO NOT OVERRRIDE ANY CURRENT DEFINITION DEF RESLT ERROR FLAG RETURNED SSA ERROR ? JMP ERROR YES, GO REPORT JMP ENTER,I NO, RETURN * RESLT BSS 1 ERROR FLAG FRSCN DEC -1 FIRST TIME FLAG #SYMB BSS 1 -VE TOTAL COUNT FOR SYMBOLS IN SNAPSHOT B15 OCT 100000 SKP * * SCAN THE SYSTEM ENTRIES FROM THE SNAPSHOT * SYLOK NOP JSB POSNT POSITION TO START OF RESIDENT LIB ENTS DEF *+5 DEF SDCB SNAP DCB DEF I.ERR ERROR PARM DEF P2 POSITION TO SYSTEM ENTRIES DEF P2 TREAT ABOVE AS A RECORD NUMBER SSA ERROR ? JMP SNFMP YES LDA #SENT NUMBER SYSTEM ENTRIES CMA,INA STA COUNT SAVE AS COUNT CLA STA NM2.L,I CLEAR VALID NAME READ FLAG * READS JSB READ READ SNAP ENTRY LDA SNAME+4 CHECK FOR COMMON ACCESS CPA P2 IS THIS AN COMMON SYMBOL ENTRY ? JMP SKIP YES, IF SHE ASKED FOR IT, SHES ALREADY GOT IT JSB L.MAT FIXUP PREVIOUS REFERENCES DEF *+5 DEF SNAME+1 SNAP ENTRY DEF SNAME+4 DEF SNAME+5 DEF RESLT RESULT * SKIP ISZ COUNT HAVE WE READ ALL ? JMP READS NO, READ NEXT ENTRY JMP SYLOK,I YES, RETURN TO CALLER * * READ NOP JSB READF READ ENTRY OFF SNAPSHOT FILE DEF *+5 DEF SDCB DEF I.ERR DEF SNAME DEF P10 RECORD LENGTH SSA,RSS ERROR RETURNED ? JMP READ,I NO, RETURN * SNFMP JSB FMPER DEF SNAMR+0 JMP SYSCN,I * RHALF OCT 377 SNAME BSS 10 COUNT EQU FIRST NCNT BSS 1 P10 DEC 10 SKP * * SCAN USER NAMED LIBRARY FILES * URLIB NOP LDA #LIBS -VE NUMBER USER LIBRARIES SZA,RSS HAS USER SPECIFIED A LIBRY ? JMP URLIB,I NO, SCAN SYSTEM LIBRARIES STA COUNT YES, SAVE COUNT VARIABLE LDA ABNAM NXTNM STA NAM JSB FOPEN OPEN THE USER LIBRARY FILE DEF *+5 NAM BSS 1 DEF ID.CB+0 DEF IOPTN DEF P272 JMP SYSCN,I ERROR RETURN * CLA SET SEARCH MULTIPLE FLAG JSB SE.MS SEARCH THE FILE JMP FMER? ERROR RETURN * LDA NAM INCREMENT TO NEXT NAMR ADDRESS ADA P6 EACH ARE SIX WORDS LONG ISZ COUNT HAVE WE SEARCHED ALL ? JMP NXTNM NO, OPEN NEXT FILE JMP URLIB,I * FMER? SSA,RSS JMP SYSCN,I ERROR EXIT, NOT FMP JSB FMPER DEF NAM,I JMP SYSCN,I SKP * * SEARCH THE SYSTEM LIBRARIES FROM THE SNAPSHOT * LBLOK NOP CCB INITIALIZE THE SYSTEM LIB LOADED FLAG STB SLOAD SET TO 'NONE LOADED' LDA #SLIB NUMBER OF LIBRARIES IN SNAP AND RHALF SZA,RSS HAVE WE GOT ANY ? JMP LBLOK,I NO, RETURN TO CALLER CMA,INA YES, NEGATE NUMBER TO BE SEARCHED STA COUNT AND SAVE AS A COUNT LDA #SENT DETERMINE RECORD NUMBER ALSO ADA P2 STA RECRD * JSB POSNT POSITION TO SYSTEM LIBRARY NAMRS DEF *+5 DEF SDCB DEF I.ERR+0 DEF RECRD DEF P2 * SSA FMP ERROR ? JMP SNFMP YES, GO REPORT AND ABORT * NEXT JSB READF READ NAMR FROM SNAPSHOT DEF *+5 DEF SDCB SNAP DCB DEF I.ERR+0 ERROR PARAMETER DEF SNAME LIBRARY NAMR BUFFER DEF P10 BUFFER LENGTH OF 10 WORDS * SSA ERROR ON READ ? JMP SNFMP YES, REPORT ERROR CLA,INA * JSB FOPEN AND OPEN THE FILE DEF *+5 DEF SNAME DEF ID.CB+0 DEF IOPTN DEF P272 JMP SYSCN,I ERROR RETURN * CCA CLEAR SEARCH MULTIPLE FLAG JSB SE.MS SEARCH THE FILE JMP ERFP? ERROR RETURN ISZ NOR.L WAS ANYTHING LOADED ? CLA,RSS YES, SET SLOAD FLAG JMP NLOAD NO, SO DON'T ALTER SLOAD FLAG STA SLOAD YES, SET SOMETHING LOADED FLAG NLOAD ISZ COUNT HAVE WE SEARCHED ALL THE FILES ? JMP NEXT NO, OPEN THE NEXT ONE JMP LBLOK,I YES, RETURN TO CALLER * SLOAD BSS 1 0/-1, YES/NO A SYSTEM LIB MODULE WAS LOADED ERFP? SSA,RSS JMP SYSCN,I JSB FMPER DEF SNAME JMP SYSCN,I * ABNAM DEF BNAMR+0 P6 DEC 6 IOPTN OCT 111 RECRD BSS 1 HED TERMINATE MODULE LOAD * * * PROCEDURE 'END' IS CALLED TO COMPLETE THE CURRENT MAIN OR * SEGMENT LOAD, THAT IS, PRINT ENTRIES, FINISH THE ID SEGMENT, * AND SET UP FOR THE NEXT SEGMENT. * * * CALLING SEQUENCE: JSB END * * ON RETURN: P+1: ERORR RETURN * P+2: GOOD RETURN * * END NOP LDA PL.ST GET LISTING WORD ARS ARE WE LISTING THE ENTRIES ? SLA,RSS JMP NOLST NO, SKIP LIST * * LIST ENTRIES IN CURRENT MAIN OR SEGMENT * JSB SPACE YES, SPACE UP ONE LINE LDA MESS8 OUTPUT HEADER MESSAGE LDB P12 (NOTE: THERE MUST BE AT LEAST ONE JSB DRKEY ENTRY POINT IN THE MODULE!) JSB SPACE SPACE UP ONE BLANK LINE CLA INITIALIZE PNTR FOR L.LDF STA PNTR * ELIST JSB L.LDF GET THE NEXT ENTRY POINT DEF *+4 DEF SYMBL DEF PNTR DEF N1 MARK ENTRIES AS LISTED SZB,RSS GOT ANY ? JMP NOLST NOPE, END OF LIST ADB P4 STB ADRX JSB .DFER DEF NAMEE DEF SYMBL,I JSB CNUMO DEF *+3 ADRX BSS 1 DEF VALUE * LDA EMES OUTPUT MESSAGE LDB P16 TO USER JSB DRKEY VIA DRKEY SSA,RSS JMP ELIST PRINT NEXT DEFINED ENTRY JSB FMPER DEF LNAMR+0 JMP AB.RT * P4 DEC 4 P16 DEC 16 PNTR NOP EMES DEF *+1 ASC 1, * NAMEE ASC 4, VALUE BSS 3 SYMBL BSS 1 MESS8 DEF *+1 ASC 6,ENTRY POINTS OFFBP BSS 1 OFFSET INTO DUMMY BASE PAGE * * ANY BASE PAGE TO BE OUTPUT ? * NOLST LDA SGB.L GET CURRENT BASE ADDRESS CMA,INA ADA CBP.L CURRENT AVAILABLE - CURRENT BASE LDB OFFBP ADB SGB.L GET THE DUMMY ADDRESS JSB OUTBP AND OUTPUT TO FILE VIA OUTBP * JSB FINID FINISH OFF THE ID SEGMENT JMP NXSEG PREPARE FOR NEXT SEGMENT JMP NTRMO REALLY DONE ! JSB L.SG0 YES, SET CONDITIONS FOR FIRST SEGMENT DEF *+2 DEF TEMP LDA TH2.L STA CFWA ISZ SEG.L BUMP SEG-MAIN FLAG TO 2 JMP MSGP2 AND CONTINUE * * NXSEG JSB L.SGN NO, SET CONDITIONS FOR NEXT SEGMENT DEF *+2 DEF TEMP * MSGP2 LDA DBFLG NO, IS DEBUG SPECIFIED SZA,RSS JMP MSGP4 NO JSB L.SYE YES, ENTER UNDEFINED SYMBOL INTO LST DEF *+6 DEF .DBSG SYMBOL NAME ARRAY DEF P2 SET AS UNDEFINED DEF P0 VALUE = ZERO DEF P2 DO NOT OVERRIDE DEF RESLT RESULT RETURNED * JSB .DFER DEF DB1X+0 DEF .DBSG JSB .DFER DEF DB1+0 DEF .STDB MSGP4 LDA PL.ST ARE WE LISTING ? SZA,RSS JMP NLIST NO JSB SPACE YES, OUTPUT THREE BLANK LINES JSB SPACE JSB SPACE * NLIST ISZ END NO LIST JMP END,I COMPLETED END PROCESSING * P0 DEC 0 .STDB ASC 3,.STDB * NTRMO JSB WRITF NORMAL TERMINATION PROCESSING DEF *+6 POST CURRENT RECORD BUFFER TO THE FILE DEF ODCB OUTPUT DCB DEF I.ERR+0 ERROR PARM DEF OUTBF+0 BUFFER DEF P128 LENGTH DEF CUREC CURRENT RECORD NUMBER * * ISZ END TAKE GOOD RETURN JMP END,I .DBSG ASC 3,.DBSG P128 DEC 128 HED BUILD PROGRAM ID SEGMENTS * * BLDID AND FINID ARE THE TWO ROUTINES WHICH BUILD THE ID * SEGMENTS, LONG AND SHORT. ALNID POINTS TO THE DUMMY LONG ID * IN MEMORY, ASHID POINTS TO THE DUMMY SHORT. THESE ARE LOCATED * BETWEEN THE TWO ROUTINES. * * CALLING SEQUENCE: JSB BLDID * * ON RETURN P+1: THIS IS A SEGMENT OF SUBROUTINE THAT * WE JUST PROCESSED * P+2: THIS IS THE MAIN * * * BLDID NOP LDB PRENT,I HAS THE PROGRAM PRIMARY ENTRY SZB BEEN DEFINED ? JMP BLDID,I NO, SO WE CAN'T DO MUCH HERE * ISZ BLDID GO ON TO NEXT CASE STA PRENT,I SET PRIMARY ENTRY POINT ADDRESS LDA NM2.L MOVE NAME INTO ID SEGMENT INA LDB NAME JSB .MVW DEF P3 NOP * LDB NAME CLEAR OUT THE SIXTH CHARACTER ADB P2 IN THE SEGMENT NAME LDA B,I AND LCHAR STA B,I * LDA PGT.L IS CURRENT MODULE A SEGMENT ? CPA P5 JMP BLDID,I YES, RETURN * LDA NM4.L,I NO, THIS IS THE MAIN, GUYS STA PRIOR SAVE PRIORITY ISZ BLDID ONE MORE ISZ FOR THE ROAD JMP BLDID,I AND RETURN * * LCHAR OCT 77400 PRENT DEF PENT ADDRESS OF MAIN/SEG PRIMARY ENT HIMAN DEF HIMN MAIN/SEG HIGH MAIN + 1 HIBSE DEF HIBS MAIN/SEG HIGH BASE PAGE + 1 NAME DEF PNAME ADDRESS OF MAIN'S NAME HED DUMMY ID SEGMENTS ALNID DEF *+1 ADDRESS OF LONG ID SEGMENT DEC -1 LIST LINKAGE WORD BSS 5 PRIOR BSS 1 PROGRAM PRIORITY PENT BSS 1 PRIMARY ENTRY POINT BSS 4 PNAME BSS 3 PROGRAM NAME STATS BSS 1 STATUS WORD BSS 4 LOMAN BSS 1 LOW MAIN ADDRESS HIMN BSS 1 HIGH MAIN ADDRESS + 1 HIMN1 BSS 1 ALSO SET TO HIGH MAIN + 1 LOBSE BSS 1 # ID SEGMENTS /LOW BASE PAGE HIBS BSS 1 HIGH BASE PAGE + 1 BSS 5 SYCKM BSS 1 SYSTEM CHECKSUM WORD BSS 1 ID SEGMENT CHECKSUM VALUE SHIGH BSS 1 HIGHEST SEGMENT ADDRESS + 1 BHIGH BSS 1 HIGHEST BASE PAGE ADDRESS + 1 * * ASHID DEF *+1 ADDRESS OF SHORT ID SEGMENT BSS 3 PROGRAM NAME BSS 1 PRIMARY ENTRY POINT ADDRESS BSS 1 HIGH SEGMENT + 1 BSS 1 HIGH BASE PAGE ADDRESS + 1 BSS 1 BSS 1 CHECKSUM VALUE FOR ID SEGMENT HED FINISH OFF THE ID SEGMENTS * * FINID NOP FINISH ID SEGMENT PROCESSING LDA CBP.L CURRENT WORD AVAILABLE BASE PAGE STA HIBSE,I SET AS HIGH BASE ADDRESS + 1 LDB BHIGH CHECK FOR NEW ALL TIME HIGH CMB,INB ADB A SSB,RSS IS THIS HIGH THE LARGEST SO FAR ? STA BHIGH LDA TH2.L HIGH ADDRESS + 1 STA HIMAN,I SAVED AS HIGH MAIN + 1 LDB SHIGH CMB,INB ADB A SSB,RSS STA SHIGH LDB SEG.L CPB P2 ARE WE A SEGMENT ? RSS YES, FINISH OFF THE ID JMP FINI0 NO, MAIN * LDA ASHID ADRESS OF SHORT ID LDB P8 AND LENGTH JSB CCKSM CALCULATE CHECKSUM LDA SEG# GET CURRENT SEGMENT NUMBER ADA N1 STARTING AT 0 MPY P8 DIV P128 DETERMINE RECORD, WORD ADA P2 ADD IN STARTING RECORD NUMBER JSB ABOUT GET RECORD IN MEMORY ADB AOUTB GET OUTBF ADDRESS LDA ASHID SOURCE ADDRESS JSB .MVW DEF P8 NOP CLA STA PRENT,I * LDB MSEGF IS THIS THE FINAL SEGMENT ? SZB,RSS JMP FINID,I NO JMP FIN02 AND FINISH OFF THE MAIN * N1 DEC -1 P8 DEC 8 AOUTB DEF OUTBF+0 SEG# DEC 0 * * * FINI0 STA HIMN1 FINISH OFF THE MAIN ID LDA MSEGF IS THIS THE FINAL SEGMENT ? SZB ARE WE SEGMENTED ? SZA JMP FIN02 UNSEGMENTED OR NO SEGMENTS RELOCATED LDA ASHID SET UP FOR SHORT ID PROCESSING STA NAME ADA P3 STA PRENT INA STA HIMAN INA STA HIBSE ISZ FINID ISZ FINID JMP FINID,I * * P3 DEC 3 FIN02 LDA SEG# ALF,ALF RAL,RAL IOR LOBSE STA LOBSE LDA P.ROR WAS A PRIORITY SPECIFIED FOR THIS PROGRAM ? SZA STA PRIOR YES, SET OVERRIDING PRIORITY LDA ALNID CALCULATE THE CHECKSUM ON THE ID LDB P32 JSB CCKSM CLA,INA LONG ID GOES IN RECORD ONE JSB ABOUT GET THIS RECORD IN MEMORY LDA ALNID AND MOVE IN THE ID LDB AOUTB JSB .MVW DEF P34 NOP ISZ FINID JMP FINID,I DONE ! * P32 DEC 32 P34 DEC 34 SKP * CCKSM NOP CMB,INB INB STB LENID CLB LOOP ADB A,I INA ISZ LENID JMP LOOP STB A,I JMP CCKSM,I * LENID NOP HED CHECK BREAK FLAG * * * CKBRK CHECKS THE BREAK FLAG AND IF SET -VE JUMPS TO 'ABORT' * IN THE MAIN. * * * CALLING SEQUENCE: JSB CKBRK * * ON RETURN: NO RETURN IF BREAK, ELSE P+1 * * CKBRK NOP JSB IFBRK DO IF BREAK THING DEF *+1 SSA BREAK ? JMP AB.RT YUP, GO TO IT JMP CKBRK,I NO, RETURN TO CALLER HED RENAME OUTPUT FILE * * * RENAM IS CALLED TO DETERMINE IF A SCRATCH FILE WAS USED * FOR THE OUTPUT FILE AND IF SO, TO RENAME THE FILE TO THE * PROGRAM NAME. IF AN FMP ERROR RESULTS FROM THE RENAME, * RENAM RENAMES THE FILE TO THE PROGRAM NAME WITH THE FIRST * TWO CHARACTERS REPLACED WITH '..'. IF THIS RESULTS IN AN * FMP ERROR ALSO, RENAM TAKES THE ERROR EXIT. * * * CALLING SEQUENCE: JSB RENAM * * ON RETURN: P+1: GOOD RETURN, PROGRAM RENAMED IF NECESSARY * P+2: ERROR ON RENAME, ABORT THE LOAD * * * RENAM NOP RENAME OUTPUT FILE ? JSB .DFER DEF PROGN FIRST SAVE THE NAME IN THE MAIN DEF PNAME FROM THE ID SEGMENT VALUE * LDA PROGN+2 ALSO NEED TO BLANK THE 6TH CHARACTER AND O7400 IOR BLNK2 STA PROGN+2 * LDA OTDFT NOW, DO WE NEED TO RENAME ? SZA,RSS DEFAULT NAME USED (IE SCRATCH FILE) ? JMP RENAM,I NO, NO RENAME OF THE OUTPUT FILE * CCB NEED TO FIRST POST THE CURRENT RECORD JSB OUTAB TO THE PROGRAM FILE DEF *+1 RENM1 JSB NAMF RENAME TO PROGRAM NAME DEF *+7 DEF ODCB+0 OUTPUT DCB DEF I.ERR+0 ERROR PARM DEF ONAMR+0 OLD NAME DEF PROGN+0 NEW NAME DEF ONAMR+3 SECURITY CODE DEF ONAMR+4 CR NUMBER * CPA N2 DUPLICATE NAME ? JMP DUNAM DUPLICATE NAME, CHECK FOR .. SSA,RSS ANY OTHER FMP ERROR ON RENAME ? JMP RENM2 NO, FINISH UP THE RENAME * JSB FMPER YES, OUTPUT FMP ERROR MESSAGE DEF PROGN+0 ON THE PROGRAM NAME ISZ RENAM DO ABORT PROCESSING JMP RENAM,I * DUNAM LDB PROGN DUPLICATE NAME OUT THERE CPB .. HAVE WE ALREADY TRIED ..XXX ? JMP ERFM YES, WELL THEN WE GOT AN ERROR * LDA .. NO, SO GIVE ..XXX A TRY STA PROGN SET NEW PROGRAM NAME JMP RENM1 GO TRY RENAME ONCE MORE * ERFM LDA P8 GOT AN ERROR, OUTPUT 'DU PGM' JSB LDRER * JSB REOPN NOW MUST REOPEN, EVEN FOR ERROR PROCESSING ISZ RENAM GO DO ABORT PROCESSING JMP RENAM,I * RENM2 JSB .DFER MUST ALSO UPDATE ONAMR DEF ONAMR+0 DESTINATION DEF PROGN+0 SOURCE JSB REOPN MUST REOPEN THE FILE, NAMF CLOSES IT JMP RENAM,I NO ERROR, RETURN TO THE CALLER * .. ASC 1,.. O7400 OCT 77400 BLNK2 OCT 40 * * REOPN NOP REOPEN THE OUTPUT FILE AFTER A RENAME JSB OPEN DEF *+7 DEF ODCB OUTPUT FILE DCB DEF I.ERR ERROR PARM DEF ONAMR OLD NAMR DEF IOPT OPEN OPTION DEF ONAMR+4 SECURITY CODE DEF ONAMR+5 CARTRIDGE NUMBER JMP REOPN,I RETURN TO CALLER * IOPT OCT 4 END LOAD2