ASMB,Q,C * * *************************************************************** * * (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. * * *************************************************************** * HED RELOCATING LOADR FOR RTE-IV <1730> NAM LOADR,4,90 92067-16471 REV.2040 800730 * * ENT LOADR * * *******************DEBUGGING STUFF * EXT STLK,DUEN,REEN,PLCT * EXT EUSED,DCPA,NGEND,CPL2 *******************END DEBUGGING STUFF EXT $MATA,NAMR EXT $MNP,$MBGP,$MRTP,$MCHN,$SDA,$COML EXT $PLP,$DLP,$IDEX,$CMAD,$SMCA,ISMVE EXT REIO,OPEN,CLOSE,READF,$CVT3,LURQ,LOGLU EXT LOCF,APOSN,WRITF,CREAT,POST,POSNT EXT IFBRK,EXEC,$LIBR,$LIBX,PRTN EXT .OWNR,PTERR,FTIME,$SSCT,$STRK EXT BPR.L,CAD.L,CBP.L,CPL.L,COM.L,EBP.L,EMA.L EXT EMS.L,FXN.L,FXS.L,IGN.L,LBS.L,LSY.L EXT MSG.L,NM1.L,NM2.L,NM3.L,NM4.L,NOR.L EXT PGT.L,PRI.L,RBT.L,SEG.L,SGB.L,SSG.L EXT SGM.L,SYM.L,TH1.L,TH2.L,TSY.L EXT L.INT,L.ADD,L.SYE,L.MAT,L.LDF,L.LUN,L.IFX EXT L.CLS,L.BUF,L.REL,L.SG0,L.SGN,PGL.L * * NAME: RTE LOADER * SOURCE: 92067-18471 * RELOC: 92067-16471 * PGMR: C.M.M., EFH * SUP PRESS EXTRANIOUS LISTING * SKP *1 LOADR ERROR CODES *0 ALL LOADR ERRORS ARE REPORTED TO THE LIST DEVICE. THE LIST * DEVICE MAY BE SPECIFIED AT LOAD TIME OR DEFAULTED. THE DEFAULT * LIST DEVICE IS SPECIFIED UNDER 'LIST = ' AT THE BEGINING OF THIS * DOCUMENT. * THE LOADR ERROR CODES ARE LISTED BELOW. NOTE THAT ERROR CODES * 19, 20, 21, 22, REFER TO RTE 4 ONLY. * LIST OF LOADR ERROR DIAGNOSTICS * * * = MODULE NAME PRINTED BEFORE DIAGNOSTIC * **= ENTRY POINT NAME PRINTED AFTER MODULE NAME * *CK SUM* - CHECKSUM ERROR (WAS IT A RELOCATABLE FILE ?) *IL REC* - ILLEGAL RECORD *OV MEM* - MEMORY OVERFLOW (YOUR PROGRAM IS TOO LARGE) * (YOUR PROGRAM + MSEG SIZE IS TOO LARGE) *OV BSE* - BP LINKAGE OVERFLOW (TRY REARRANGING THE SUBROUTINES) *OV SYM* - SYMBOL TABLE OVERFLOW (GIVE THIS LOADR MORE ROOM) *CM BLK* - COMMON BLOCK ERROR (WAS THE 1ST COM DECL THE LARGEST ?) *DU ENT* ** - DUPLICATE ENTRY POINTS (YOU PUT THE SUBROUTINE IN TWICE) *TR ADD- NO TRANSFER ADDR (ONLY SUBROUTINES WERE LOADED WHERE'S THE MAIN?) *RE SEQ* - RECORD OUT OF SEQUENCE (DID YOU POSITION THE TAPE CORRECTLY ?) *IL PRM- ILLEGAL PARAMETER IN RU STATEMENT OR IN STATEMENT PRIOR TO * A RELOCATE STATEMENT. *CO RES- ATTEMPT TO REPLACE A CORE RESIDENT PROG (A MEM RES PROG W/SAME NAME) *OV FIX* - FIXUP TABLE OVERFLOW (GIVE THIS LOADER MORE ROOM) *LM LIB- THE LIMIT ON THE NUMBER OF LIBRARIES SPECIFIED BY THE "LI" * COMMAND HAS BEEN EXCEEDED. (10 IS THE LIMIT) POSSIBLY YOU CAN * DO AN "SE" OF THE FILE INSTEAD OF TRYING TO MAKE IT A LIBRARY. *IL REL* - ASMB PRODUCED ILLEGAL RELOCATABLE . A DBL REC * WAS PRODUCED REFERING TO AN EXTERNAL WHICH WAS NOT DEFINED. * IE, I SHOULD HAVE FOUND IT IN MY SYMBOL TABLE BUT I DIDN'T *IL PTN- ILLEGAL PARTITION NUMBER OR CORRUPT MAP TABLE. *RQ PGS- NUMBER OF PAGES REQUIRED EXCEEDS AMOUNT IN PTTN. *OV PTN- REQUESTED # OF PAGES EXCEEDS LARGEST POSSIBLE * ADDRESS SPACE FOR THAT PROGRAM. *ML EMA- EMA DECLARED TWICE OR DECLARED IN A PROGRAM SEGMENT * OR A REFERENCE TO THE EMA LABEL BEFORE THAT LABEL WAS * DECLARED EMA OR AN ATTEMPT TO DECLARE THE SAME LABEL AS * AN ENT RECORD (IE DUPLICATE ENT). EMA MUST BE DECLARED * IN THE MAIN. ANY INDIVIDUAL RELOCATABLE MODULES THAT * PRECEED THE MAIN MAY NOT HAVE EMA REFERENCES. EMA * REFERENCES MAY APPEAR ANYWHERE IN THE MAIN. EMA REFERENCES * IN SEGMENTS OR SUBROUTINES MAY APPEAR ANYWHERE WITHIN THE * MODULE BUT THAT MODULE MUST NOT BE RELOCATED BEFORE THE MAIN *ID EXT- NO ID EXTENSIONS AVAILABLE FOR YOUR EMA PROGRAM *SZ EMA- PROGRAMS EMA SIZE IS TOO LARGE FOR CURRENT SYSTEMS * PARTITIONS. *IL SCB- RETURN ILLEGAL SCB VALUE(NEGATIVE). *IN CAP- USER'S CAPABILITY LEVEL IS LOWER THAN 60 AND TRY TO PU,PE,RP. *SS ENT- ATTEMPT TO ACCESS AN SSGA ENTRY POINT BUT SSGA ACCESS * WAS NOT DECLARED AT THE BEGINING OF THE LOAD. *IL CMD- ATTEMPT TO PURGE A PROGRAM UNDER BATCH OR ATTEMPT TO * USE THE LI OR PU COMMANDS WITHIN A TRANSFER FILE. * LI & PU MAY BE USED IN THE INTERACTIVE MODE BUT * WILL NOT BE HONORED WHEN ENCOUNTERED WITHIN A FILE. *ID SEG- NOT ENOUGH LONG AND SHORT ID SEGMENTS TO FINISH LOAD. * THIS ERROR CODE IS EXTREMELY RARE. IT CAN OCCUR WHEN * LOADING A SEGMENTED PROGRAM WHERE THERE WERE ENOUGH * LONG + SHORT ID SEGMENTS TO SUCCESSFULLY LOAD THE LAST * SEGMENT IN THE PROGRAM WHILE THE LAST SEGMENT LOAD WAS * GOING ON. HOWEVER, WHEN THE LOADR WENT TO CREATE THE * ID SEGMENTS NOT ENOUGH LONG + SHORT SEGMENTS WERE FOUND. * IN THIS CASE SOME ID SEGMENTS WERE CREATED BUT OTHERS * WERE NOT. IF THE PROGRAM IS RUN AN SC05 ERROR WOULD * RESULT. THE CORRECT ACTION IS TO OFF OR PURGE ALL ID'S * CREATED, FREE UP ADDITIONAL ID SEGMENTS, AND PERFORM THE * LOAD OVER AGAIN. *RF EMA- ATTEMPT TO ACCESS AN EMA EXTERNAL (ARRAY) WITH OFFSET * OR INDIRECT. TO ACCESS EMA ARRAYS USE THE H-P SUPPLIED * SUBROUTINES .EMAP & .EMIO . * IF LOADING A PROGRAM WRITTEN IN A HIGH LEVEL LANGUAGE * PROBABLY FORGOT $EMA STMT IN SORCE CODE OF A SUBROUTINE *UN EXT- UNDEFINED EXTERNALS EXIST. THIS IS PROBABLY THE MOST * COMMON ERROR FOR THE LOADR. BASICLY A SUBROUTINE * EXISTS THAT IS NEEDED TO FINISH THE LOAD BUT THE LOADR * CAN'T FIND IT. *EX CPY- ATTEMPT TO REPLACE OR PURGE A PROGRAM WHERE COPIES OF * THAT PROGRAM EXIST. THE PROGRAM CAN'T BE PURGED BECAUSE * THE DISC SPACE CAN'T BE RELEASED OR THE OTHER PROGRAMS * WILL BE OUT TO LUNCH. THE PROPER COURSE HERE IS TO GET * RID OF ALL THE COPIED PROGRAMS (VIA OF,XXXXX COMMAND) AND * TRY THE LOAD AGAIN. *RP CPY- ATTEMPT TO REPLACE A COPIED PROGRAM. THE 'OP,RP' COMMAND * MAY NOT BE USED WITH A COPY OF A PROGRAM. YOU MUST REPLACE * THE ORGINAL. *PE LDR- L O A D R AND ONLY THE PROGRAM NAMED L O A D R MAY DO PERMINANT * LOADS OR PURGES. *DU PGM- DUPLICATE PROGRAM NAME. YOU HAVE ALREADY LOADED THE * SAME PROGRAM TWICE WITHOUT OFFING THE ORIGINAL. WE * WERE NICE THE SECOND TIME AND RENAMED YOUR PROGRAM * CALLED XXXXX TO ..XXX THE THIRD TIME WE DON'T RENAME. *NO IDS- NOT ENOUGH ID SEGMENTS TO FINISH THE LOAD. CALL THE * SYSTEM MANAGER TO FREE UP SOME ID SEGS. *RP PGM- ATTEMPT TO REPLACE A PROGRAM THAT WAS EITHOR NOT * DORMANT OR STILL IN A PARTITION. DO AN ' OF ' ON * THE PROGRAM & TRY AGAIN. * LIST OF WARNINGS (THE RELOCATION IS NOT ABORTED) * *RQ PGS- NUMBER OF PAGES REQUIRED EXCEEDS AMOUNT IN PTTN. *IL CMD- ATTEMPT TO RELOCATE A MODULE OR TRANSFER TO A COMMAND * FILE WHILE DOING SPECIAL PROCESSING WHEN UNDEFINED * EXTERNALS EXIST. *UN EXT* ** - UNDEFINED EXTERNALS EXIST. BASICALLY A SUBROUTINE * EXISTS THAT IS NEEDED TO FINISH THE LOAD BUT THE LOADR * CAN'T FIND IT. *DU PGM- DUPLICATE PROGRAM NAME. YOU TRIED TO LOAD A * PROGRAM XXXXX BUT A PROGRAM CALLED XXXXX WAS ALREADY * IN THE SYSTEM, SO WE RENAMED YOUR PROGRAM TO * ..XXX AND CONTINUED THE LOAD. SKP * * LOADING OF PROGRAMS WITH THE RELOCATABLE LOADER CONSISTS OF * (1) LOADING PROGRAMS FROM THE INPUT UNIT * (2) LOADING PROGRAMS FROM THE PROG LIB * THE FIRST PROGRAM WITH A PRIMARY ENTRY POINT IS CONSIDERED * TO BE THE MAIN PROGRAM. AT LEAST ONE MAIN PROG MUST BE LOADED * BEFORE THE LIBRARY IS LOADED. LINKAGES FROM THE MAIN PROG * TO ALL USER AND LIB SUBROUTINES IS DETERMINED BY ENTRIES * IN THE LOADER SYMBOL TABLE (LST). * * EACH LST ENTRY CONSISTS OF 5 WORDS: * **************************************************** * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * **************************************************** * L * CHAR 1 * CHAR 2 * *..................................................* * U * CHAR 3 * CHAR 4 * *..................................................* * CHAR 5 * ORDINAL * *..................................................* * TYPE * V* * S * *..................................................* * V = 0/1 ABS ADDRESS / BP LINK ADDRESS * **************************************************** * 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 * **************************************************** * * * * EACH WORD IN THE LST ENTRY CONSISTS OF THE FOLLOWING: * * WORD 1: SYMBOL NAME - ASCII CHARACTERS 1,2 * BIT 15 = 1 MEANS THE ENTRY IS FROM SYS LIBRARY * BIT 15 = 0 MEANS THE ENTRY FROM MODULE * WORD 2: SYMBOL NAME - ASCII CHARACTERS 3,4 * BIT 15 = 1 SYMBOL REFERENCED BY CURRENT MODULE * BIT 15 = 0 SYMBOL NOT REFERENCED BY CURRENT MODULE * WORD 3: (8-15) SYMBOL NAME - ASCII CHARACTER 5 * (0-7) EXT ORDINAL NUMBER * WORD 4: ORGANIZED INTO FOLLOWING THREE FIELDS - * STATUS FIELD (BITS 0 TO 6) - INDICATES STATUS * OF THE SYMBOL AS FOLLOWS: * 0 - ENT SYMBOL READ DURING LIB SCAN (COULD BE * FROM RES LIB, RELOC LIB ON DISC OR USER * GIVEN LIB). * 1 - ENT SYMBOL READ DURING LOADING OF USER * PROGRAM. * 2 - EXT ENTRY (UNDEFINED SYMBOL). * 3 - EMA ENTRY THE SYMBOL IS CONSIDERED DEFINED. * NOTE THAT STATUS OF A SYMBOL CHANGES FROM 2 TO * 0 OR 1 AS IT BECOMES DEFINED. * 'V' BIT (BIT 7) - WHEN SET THEN WORD 5 HAS THE * THE ADDRESS OF THE BASE PAGE LINK, ELSE WORD 5 * HAS SYMBOL VALUE (VALUE OF ENT AFTER RELOCATION ). * V WILL ONLY BE SET IF THE REFERENCE IS TO EMA. * TYPE : * ENT TYPE (BITS 8 TO 15) - IS 0 FOR EXT ENTRY AND * 0 TO 4 (RELOCATION INDICATOR) FOR ENT SYMBOL. * TYPE = 0 PROG RELOCATABLE * 1 BP RELOCATABLE * 2 COMMON RELOCATABLE * 3 ABSOLUTE * 4 INSTRUCTION REPLACEMENT * * WORD 5: BASE PAGE LINKAGE ADDR IF 'V' BIT IS SET * ELSE SYMBOL VALUE . * * IIILU DEC 1 DEBUG LU IPBUF BSS 10 OUTPUT PARSED BUFFER STRNG BSS 40 INPUT STRING BUFFER SLONG NOP STRING LENGTH IN CHARS DONE? NOP =1 WHEN INPUT PRAMS CHECKED OUT RSDON NOP =1 WHEN ALL OF RUN STRING HAS BEEN PARSED * F3 DEF FILE3 FILE3 OCT 206 NOP NOP TYPE3 NOP F3SC NOP F3DSC NOP * PLIST DEC 2 BATCH NOP BATCH FLAG 0=NO /-1 = YES SKP.1 NOP SKIP FLAG (SKIP IF WE REREAD LAST COMMAND) N80 DEC -80 P16 DEC 16 P23 DEC 23 * * MOVE OR REARRANGE THE BUFFERS BELOW AT YOUR UNDYING & EVERLASTING * PERIL !!!!!!! * IDCB3 BSS 144 LIST FILE DCB NOP TEMP. LEAVE IN FRONT OF MBUF MBUF BSS 66 NAM RECORD BUFFER MBUF1 EQU MBUF+1 IDCB1 BSS 16 DCB HEADER FOR RELO FILE XBUF BSS 128 DCB & READ BUFFER FOR LU & SYS LIB READS SBUF BSS 128 DCB & DIRECTORY BLOCK READ BUFFER LBUF BSS 64 RELO RECORD PROCESS BUFFER DBUF BSS 128 ABSOLUTE OUTPUT BUFFER IDCB2 BSS 144 COMMAND FILE DCB SGNAM BSS 60 SEGMENT NAM RECORD BUFFER MVBUF BSS 18 ID INFO TO BE MOVED INTO SYS ID AREA * .BUF EQU * END OF BUFFERS IN OVERLAYED CODE SKP * * ORG IDCB3 * LOAD ASC 3,LOADR * *THIS SECTION OF THE LOADR RETRIEVES THE RUN STRING AND PARSES THE *INPUT. ONLY MIMIMAL ERROR CHECKING IS DONE. THIS MEANS THAT *FINAL ERROR CHECKING OF ALL ERROR CONDITIONS IS DONE ONLY AFTER *THE INPUT FROM THE COMMAND FILE IS READ. THIS ALLOWS GROSS ERRORS *TO BE MADE ON THE RUN STATEMENT BUT CORRECTED IN THE COMMAND FILE. *IN ADDITION IT MEANS COMMAND FILES WILL HAVE THE LAST WORD ON *HOW A PROGRAM IS LOADED. THUS A COMMAND FILE COULD BE SET UP TO *KEEP INEXPERIENCED USERS FROM HURTING THEMSELVES, THE SYSTEM, OR *OTHER USERS. I HATE TO USE THE WORD BUT IT IS VERY (UGH) FRIENDLY. * * * CALCULATE THE BLOCK NUMBER WHERE THE LIB DIRECTORY STARTS * AND THE POSSIBLE OFFSET IN NUMBER OF ENTRYS TO ACCOUNT FOR * AN ODD STARTING SECTOR. * WE DO THIS HERE BECAUSE IT IS OVERLAYABLE SPC 1 LOADR JSB LOGLU GET THE DEFAULT LU DEF *+2 DEF MYLU# STA MYLU# * JSB .OWNR GET THE OWNER WORD FOR THE ID STA OWNER * * SPC 1 * THIS CODE IS PLACED HERE BECAUSE IT NEED ONLY EXECUTE * ONCE AND THEN I CAN USE THE AREA FOR OVERLAY PURPOSES SPC 1 * LDA SECT2 GET THE # SECTRS PER TRACK ON LU 2 MPY P64 A = # WORDS PER TRACK STA D6144 SAVE FOR LATER LDB XEQT (B)=ADDR OF LOADR'S ID SEG ADB P20 (B)=ID SEG'S WORD 21 ADDR XLA B,I GET WORD 21 TO CHECK BIT 15 CCB GET A FLAG READY STB EBP.L FORCE EXT TO USE BP LINK SSA IF LOADR RUNNING UNDER BATCH STB BATCH LDB XEQT (B)=ADDR OF LOADR'S ID SEG ADB P23 (B)=ADDR OF LOADR'S HIGH MAIN XLA B,I SET UP LOADR SYMBOL TABLE TO STA SYM.L START FROM LOADR'S HIGH ADB N9 (B)=ADDR OF LOADR ID'S WORD 15 XLA B,I GET LOADR'S PROG TYPE LDB BKLWA GET ADDR OF LOADR'S LAST WORD AND P7 SPC 1 CPA P2 SKIP IF LOADR IS BG LDB RTLWA ELSE GET LWA OF BG. STB BKLWR SET AS LWA AVAILABLE TO LOADR * LDB XEQT GET MY ID ADDRESS ADB P12 & CHECK IF I'M 'THE' L O A D R XLA B,I CPA LOAD CHECK 1ST TWO CHARACTERS INB,RSS OK ! ISZ TLOAD SET TEMP LOAD ONLY FLAG XLA B,I CPA LOAD+1 3RD & 4TH CHARS OK ? INB,RSS YES. ISZ TLOAD NO XLA B,I GET LAST CHAR AND M7400 IOR P32 APPEND A BLANK CPA LOAD+2 RSS PERM LOADS OK ! ISZ TLOAD * LDA DSCLB GET DISC ADDR OF LIB DIRECT. AND M177 GET SECTOR NUMBER STA BLOK# AND SAVE TEMP XOR DSCLB GET TRACK NUMBER ALF,ALF AND POSITION RAL RIGHT JUSTIFIED MPY SECT2 MULYPLY BY SECTORS/TRACK ADA BLOK# AND ADD INTO SECTOR NUMBER CLE,ERA PRODUCE BLOCK NUMBER STA BLOK# AND SAVE FOR "GTENT" CLA,SEZ NOW SET ENTRY OFFSET NUMBER ADA P16 EQUAL TO 0 OR 16 STA OEFL1 AND SET FOR "GTENT" LDA SYSLN GET # OF,SYSTEM ENTRY POINTS ADA DSCLN ADD # OF USER ENTRY POINTS STA #ENTS TO GET TOTAL # OF ENTS LDB XEQT ID SEG ADDR ADB P32 GO TO WORD 33 XLA B,I GET SESSION WORD STA IADR SAVE SCB ADDR * * SKP JSB EXEC GET THE RUN STRING DEF *+5 DEF P14 DEF P1 THIS IS A GET NOT A PUT DEF STRNG ADDRESS OF 40 WORD STRING BUFFER DEF N80 LENGTH OF STRING (NEG CHAR LENGTH) * STB SLONG SLONG = STRING LENGTH IN + CHARACTERS * JSB NAMRR PARSE TWICE TO GET RID OF THE RU AND JSB NAMRR THE LOADR. WE NOW HAVE PARAMETERS. * * JSB GTCMD GET THE COMMAND FILE * * JSB NAMRR NOW GET THE INPUT FILE NAME SSA END OF STRING ? JMP SEFIL YES LDA N6 NEG COUNT TO A REG FOR MOVE WORDS JSB MOVE DEF IPBUF ADDRESS OF SOURCE DEF FILE1 ADDRESS OF DESTINATION LDA TYPE1 GET TYPE OF INPUT THAT WAS PARSED AND P3 SAVE THE LEAST TWO BITS STA TYPE1 FOR A LU VERSES FILE TEST * * * LDA IPBUF+6 * SZA,RSS * JMP *+5 * STA IIILU * JSB DBUGR * DEF *+2 * DEF IIILU * EXT DBUGR * * * * GTLST JSB NAMRR NOW GO GET THE LIST LU SSA JMP SEFIL JMP GETOP * TRKYX EQU MBUF-* ORG MBUF LEAVE ROOM FOR IDCB3 * GETOP JSB DOLST SEE IF IT'S A FILE OR LU * OPFMT JSB NAMRR NOW GO GET THE OPCODE INFO SSA JMP SEFIL LDB IPBUF GET THE 1ST OPCODE JSB TEST CHECK IT OUT LDB IPBUF+1 NOW THE NEXT ONE JSB TEST LDB IPBUF+2 AND THE LAST ONE JSB TEST * ISZ FMT DID WE DO THE FMT PARAMS YET? JMP OPFMT NO, GO DO THEM * JSB NAMRR YES,GET THE PART'N NUMBER IF SUPPLIED. SSA JMP SEFIL LDA IPBUF GET THE # STA #PTTN SAVE * JSB NAMRR NO, GET THE SIZE OF THE PROGRAM SSA JMP SEFIL LDA IPBUF STA #PGS AND SAVE * ******************CHECK OUT COMMAND FILE********************* * * SEFIL ISZ RSDON SET FLAG - RUN STRING DONE LDA TYPE2 GET THE TYPE WORD FOR THE COMMAND FILE SZA WAS A COMMAND FILE ENTERED ? JMP SEFIX YES * LDB TYPE1 NO CMND FILE. WAS A RELO FILE ENTERED ? SZB WELL . JMP CNFLT YES, NO CMND BUT DO HAVE A RELO FILE * LDA B1777 NO CMND & NO RELO !!!! STA ISTRC FAKE OUT NAMR JSB GTCMD & FORCE A COMMAND ENTRY LU LDA OPCOD GET THE LAST OP CODE CPA P4 IF IT WAS A PURGE JMP CNFLT THEN GO DO CONFLICT CHECKING LDA TYPE2 GET THE TYPE * SEFIX ERA,SLA IS IT A FILE OR A LU ? JMP FOPEN A FILE ! JMP *+1,I GO DO THE READ DEF LREAD (SAVE A BP LINK TOO ) * * FMT DEC -2 M200 OCT 200 TLOAD NOP 0 = PERM LOADS OK. SPC 1 * CHECK FOR ANY CONFLICT IN PARAMETERS AND THEN CHECK THE * PARAMETERS THEMSELVES. SPC 1 CNFLT ISZ DONE? MAKE SURE WE NEVER COME HERE AGAIN  * LDA LISTU GET THE LIST LU LDB DOLST AND THE LU LOCK SUB ENTRY POINT SZB,RSS NOW IF DOLST NEVER CALLED SZA AND LIST LU NEVER RESET, THEN JMP CNFL1 SET UP USER CONSOLE AS DEFAULT * CLA,INA SET LU NOT FILE FLAG STA IPBUF+3 * LDA MYLU# CCB SET B TO -1 CPB BATCH BATCH MODE? LDA P6 YES, DEFAULT TO LU 6 STA IPBUF JSB DOLST NOW GO SET THE LU & LOCK IT * CNFL1 LDA EDFLG GET THE EDITING FLAG LDB TLOAD AND THE PERM LOAD OK FLAG. SZA THIS A PERM LOAD ? SZB,RSS THEN THIS BETTER BE THE L O A D R JMP CHEKR OK! * NOPUG LDA ERR31 YOU LOSE JMP ABOR * * CHEKR LDA PLIST GET THE LISTING PARAMETER SSA JMP LDI5 THEN INPUT ERROR ADA N4 SSA,RSS IF GREATER THAN 3 JMP LDI5 THEN INPUT ERROR. LDA FILE1 CHECK PRAM 1. CPA P1 IF INPUT IS SYS TTY, JMP LDI5 TREAT AS ERROR CPA P2 IS THIS TO THE DISK JMP LDI5 JUST WHO DO YOU THINK YOUR KIDDING?????? * * LDA #PGS DID HE SUPPLY A NEGATIVE SIZE ? SSA WELL ? JMP ER.17 SEND THE TURKEY A LOVE MESSAGE. LDA #PTTN GET THE PART'N SPECIFIED IF ANY SZA,RSS WAS PTTN# SPECIFIED? JMP NOPTN NO, DO SIZE CHECK LATER SSA BUT IF NEG JMP ER.16 FLUSH HIM. SPC 2 * PARTITION WAS SPECIFIED FOR THIS PROG * XLA $MNP YES, DO SIZE CHECK NOW. GET MAX # PART'NS * CMA ADA #PTTN SSA,RSS ERR16 IF PTTN# > #PTTNS JMP ER.16 * CCA ADA #PTTN 7 * (PTTN# - 1) + $MATA MPY P7 IS ADDR OF ENTRY XLB $MATA ADA B XLB A,I (A) IS ADDR MAP ENTRY SSB IF ENTRY NOT DEFINED, JMP ER.16 GIVE ERR16 * ADA P4 BUMP TO WORD 5 XLA A,I AND B1777 REMOVE RESERVED FLAG STA #PGPT SAVE #PAGES IN PTTN CMA ADA #PGS ENOUGH PAGES IN SSA SPECIFIED PTTN? JMP PGSOK YES SZA OK IF EQUAL LDA #PGS NO, BUT WAS SPECIFIC SZA SIZE REQUESTED? JMP ER.17 YES, CAN'T FIT! * PGSOK CCA ADA #PGS SUBT 1 FROM #PGS REQUESTED SSA ANY REQUESTED? LDA #PGPT NO, USE SIZE OF PTTN STA #MXBG SET AS MAX SIZE STA #MXRT OF QUALIFIED AREAS JMP CMMST NOW SET UP COMMON STUFF * * * NO PARTITION WAS SPECIFIED FOR THIS PROG * NOPTN XLA $MBGP GET MAX BG PARTN STA #MXBG XLA $MRTP GET MAX RT PARTN STA #MXRT * * *E * CMMST LDB PTYPE GET THE PROG TYPE XLA $PLP ASSUME ITS A TYPE 2 OR TYPE 3 RBR,RBR IS IT ? SLB,RSS WELL ?! JMP SETLP YES * XLA $DLP NO, ITS A LARGE BG PROG TYPE = 4 LDB COMTP GET THE COMMON TYPE ADB #MPFT ADD IN SSGA SZB,RSS ANY COMMON ? JMP SETLP NO. * XLA $SDA THE FIND PG # OF START OF SYSDVR AREA ALF,ALF CONVERT TO PG # RAL,RAL SETLP STA URFWA SET THE LOAD POINT OF PROG. * RAL,RAL PUT PAGE # IN LOWER BITS ALF ADA #PGS ADD IN REQUESTED PAGE SIZE ADA N34 SUBTRACT MAX PROG SIZE SSA,RSS REQUESTED SIZE TOO LARGE ? JMP ER.18 YES, SO FLUSH THE TURKEY * LDA URFWA GET THE LOAD POINT AGAIN CCB SET PROPER LWA USER ADB #PGS #PAGES REQ'D LESS BASEPAGE SSB WAS ANY REQUESTED? JMP LEDT4 NO, DEFAULTS 77777 BLF,BLF SHIFT TO FORM PAGE ADDR RBL,RBL ADA N1 SUBT 1 AND ADD TO U.FWA ADA B FOR ADDR OF U.LWA SSA,RSS IF PAST 32K USE 77777 STA URLWA NO, SET URLWA,UBLWA * * LEDT4 LDA COMTP GET THE COMMON TYPE SZA,RSS ANY COMMON JMP LCLCM NO JUST LOCAL COMMON LDB PTYPE GET THE PROG TYPE CPA P1 SYS COMMON OR REVERSE COMMON ? JMP STRAT SYS COMMON. * CPB P2 IS IT A RT PROGRAM ? JMP ITSBG YES, SO USE BG COMMON JMP ITSRT NO, A BG PROG SO USE RT COMMON * STRAT CPB P2 IS IT A RT PROG JMP ITSRT ITSBG LDA P3 SET MPFT FENCE STA #MPFT LDA BKORG GET START OF BG COMMON LDB BKCOM AND THE LENGTH JMP STUF ITSRT LDA P2 STA #MPFT NOW DO RT LIKE BG ABOVE LDA RTORG LDB RTCOM STUF STA CAD.L STB COM.L JMP CMEXI GO LOOK FOR SSGA. * LCLCM CCA SET THE LOCAL COMMON FLAG STA COMIN LDA P5 NOW ASSUME PROG BG OR RT LDB PTYPE GET THE PROG TYPE CPB P4 IS IT A LBG PROG ? CLA YES STA #MPFT * CMEXI LDA P4 WELL, DOES HE WANT SSGA ? LDB SSGA SZB 0/1 NO/YES STA #MPFT * * * LDA UBFWA SET FWA USER BG DISC RES STA AFWA ORIGIN AS ABS FWA + LDA UBLWA SET UPPER STA LWA BOUND. LDA BPA3 GET FWA OF BKG BASE PAGE AREA STA BPR.L SET BASE PAGE RELOCATION BASE STA BPFWA SAVE IT CMA,INA AND SUBTRACT FROM LWA OF ADA BKGBL LINK AREA. * CMA,INA CACULATE AREA SIZE IN UPPER MEMORY STA B SAVE COUNT FOR ZEROING ADA BKLWR SUBTRACT FROM END OF MEM STA FWABP SET BOUNDRY STA FXS.L ADDRESS OF BASE ID SEG (NONE EXIST YET) STA MBUF1 POINTER TO ZAP THE AREA WITH LDA BKLWR SET LWA STA LWABP OF AREA * LDA SYM.L GET LWA+1 OF THIS PROG CMA,INA MAKE IT NEG ADA FWABP ADD START OF DUMMY BASE PAGE SSA ANY OVERLAP? JMP LOVER YES, SYMBOL TABLE OVERFLOW * CLA CLEAR LDI7 STA MBUF1,I DUMMY ISZ MBUF1 BASE INB,SZB PAGE JMP LDI7 AREA * STA NM2.L,I CLEAR VALID MODULE PRESENT FLAG LDA AFWA SET UP THE BASE LOAD ADDRESSES STA FWA FIRST WORD FOR LOAD ADA MAPOF ALLOCATE ROOM FOR X,Y REGS & MAP REGS STA SGM.L SEGMENT BASE * * * INITIALIZE THE LOADER LIBARY * * JSB L.INT INITIALIZE DEF *+9 DEF SYM.L FWA FREE SPACE DEF FXS.L LWA FREE SPACE DEF BPR.L FWA BASE PAGE DEF CAD.L SYS COMMON ADDR OR ZERO DEF COM.L LENGTH OF COMMON DEF SGM.L FWA PROGRAM DEF LWA LWA PROGRAM DEF SUBTB TABLE OF SUBROUTINE ADDRESSES LDB OPCOD GET THE LAST OPCODE CPB P4 WAS IT A 4 JMP PURGE YES SO GO PURGE THE PROGRAM * LDB EDFLG IF REPLACEMENT, CPB P2 DON'T REQUIRE A CLA,INA,RSS BLANK ID SEGMENT. CLA BLANK ID REQUIRED CLB INDICATE LONG ID JSB SETID BLANK ID SEGMENT * JSB ITRAK MAKE ALLOCATION. * CCB STB NOR.L SET NO. PROGS LOADED = -1 STB NM1.L SET LOADING FLAG = LOADING LDA DBFLG GET DEBUG FLAG SZA,RSS SKIP - DEBUG OPTION SELECTED JMP NODBG OMIT ENTERING DEBUG INTO LST SKP * * ENTER '.BBUG' INTO LST * JSB L.SYE DEF *+6 DEF CHRDE ENTER .DBUG DEF P2 UNDEFINED DEF N1 DUMMY PARAM DEF P1 DO NOT OVERRRIDE DEF RSLT * NODBG CLA STA DSECT SET CURRENT SECTOR = 0. LDA TRAKB SET CURRENT TRACK = STA DTRAK TRACK BASE. * * * LDA TYPE1 GET THE TYPE OF INPUT SZA,RSS ANY MAIN SPECIFIED ? JMP CDTST NO, GO SEE IF ANY CMND FILE LDB TYPE2 YES SZB,RSS IS THERE A CMND FILE ALSO ? JMP DMANE NO, SO JUST GO LOAD MAIN * CCB YES, SO SET A FLAG SO THAT WE KNOW STB SKP.1 TO REREAD THE LAST COMMAND JMP DMANE * N34 DEC -34 * ER.17 LDA ERR17 JMP ABOR * CDTST LDB TYPE2 GET CMND FILE TYPE SZB,RSS IS THERE A CMND FILE ? JMP LDI5 NO CMND FILE AND NO MAIN ???????? JMP *+1,I GO GET THE LAST COMMAND DEF SECK1 (SAVE A BP LINK TOO !) * SKP SKP 2 *********************************************************************** * OVERLAYABLE SUBROUTINES *********************************************************************** SPC 2 * * THE TEST SUBROUTINE IS USED TO CHECK OUT AND PROCESS * ALL OPCODE AND FMT PARAMETERS. * FMT AND OPCODE MNEMONICS MAY BE INTERMIXED AND INTER- * MINGLED. ANY UNDEFINED MNEUMONIC WILL GENERATE AN * IL PRM ERROR. TEST NOP SZB IF NOTHING ENTERED CPB ABLNK JMP TEST,I STB OPP SET THE ERROR RETURN CODE = INPUT CODE LDA LDOPC GET START OF OPCODE TABLE STA XTEMP AND SAVE FOR SEARCH LDA LDJMP GET JUMP ADDRESS TABLE STA YTEMP AND SAVE FOR JUMP TO APPROPRIATE PROCESSOR LOOPR CPB XTEMP,I IS THIS THE CODE JMP YTEMP,I YES, SO JUMP TO THE APPROPRIATE PROCESSOR ISZ XTEMP NO, SO BUMP THE ISZ YTEMP TWO POINTERS AND JMP LOOPR TRY AGAIN. * LDOPC DEF *+1 ADDRESS OF START OF TABLE ASC 20,LIPULBRTSCRCNCSSDBPETERPRSBGLENLDCMPCPBP OPP NOP ERROR CODE LDJMP DEF *+1,I HEAD OF JUMP TABLE DEF DO3 LIST OPERATION DEF DO4 PURGE OPERATION DEF LB BG PROGRAM (LARGE) DEF RT RT PROGRAM DEF SC USES SYSTEM COMMON DEF RC USES REVERSE COMMON DEF NC NO COMMON (OR LOCAL COMMON- DEFAULT) DEF SS USES SSGA DEF DB APPEND THE DEBUG ROUTINE DEF PE PERMANENT PROGRAM (ADDITION) DEF TE TEMPORARY PROGRAM (DEFAULT) DEF RP REPLACEMENT OPERATION DEF RS RESCAN FILE FOR APPENDED SUBROUTINES DEF BG PRIVLEDGED PROGRAM DEF LE LIST ENTRY POINTS DEF NL NO LISTING DESIRED DEF DC THIS PROGRAM NOT TO BE COPIED ! DEF MP USE CURR PG LINKS (EXCLUDING EXTERNALS) DEF CP USE CURR PG LINKS (INCLUDING EXTERNALS) DEF BP USE BASE PG LINKS DEF PRERR INPUT ERROR PROCESSING * * ABLNK ASC 1, * * ********************************************************************** *THIS SECTION SETS A FEW FLAGS FOR LATER USE IN LOADING THE PROGRAM *AS THE INFORMATION COMES IN THE FLAGS ARE SET. THE FLAGS ARE NOT *CHECKED UNTIL ALL INFORMATION ABOUT THE PROGRAM FROM THE RUN STRING *OR THE COMMAND FILE HAS BEEN PROCESSED. * * BACKROUND PROGRAMS SET PTYPE = 3 * REAL TIME PROGRAMS SET PTYPE = 2 * TEMPORARY PROGRAMS SET EDFLG = 0 * PERMANENT PROGRAMS SET EDFLG = 1 IE PERMANENT ADDITION * REPLACED PROGRAMS SET EDFLG = 2 IE PERMANENT REPLACEMENT * #PAGES = # OF PAGES IN PROGRAM (INCLUDES BP) * #PTTN = PARTITION # (COUNTING FROM 1 ) * SSGA = 0/1 DON'T USE / USE SSGA * COMTP = 0 ... NO COMMON ( OR LOCAL COMMON) * COMTP = 1 ... SYSTEM COMMON * COMTP = 3 ... REVERSE COMMON * OPCOD = 1 IF DBUG APPENDED * OPCOD = 3 IF PROGRAM LISTING DESIRED * OPCOD = 4 IF PROGRAM PURGE DESIRED * CPL.L = 0/1 DON'T USE/USE CURR PG LINKS * EXCEPT EXTERNALS * EBP.L = -1/0 NO/YES USE CURR PG LINKS * INCLUDING EXTERNALS * (IF YES,FORCES CPL.L TO BE SET TO 1) * DO3 LDA RSDON WAS LI IN RUN STRING? SZA,RSS WELL? JMP LLIST YES, GO DO THE LISTING LDA TYPE2 NO, GET THE COMMAND TYPE ERA,SLA IS IT A FILE ? JMP LDI25 THEN ITS AN ERROR JMP LLIST DO THE LISTING * DO4 LDB P4 GET THE PURGE CODE STB OPCOD AND SAVE FOR LATER LDB TYPE2 GET THE COMMAND TYPE LDA RSDON WAS PU CODE IN RUNSTRING? SZA,RSS WELL? JMP THELD YES, SO SEE IF THIS IS 'THE' LOADR ERB,SLB NO, IF CMND IS A FILE FLUSH HIM JMP LDI25 AND TELL HIM THE COMMAND TOO THELD LDA TLOAD IS THIS ' THE ' LOADR SZA YES JMP NOPUG NO, FORGET IT. SZB WAS A COMMAND FILE ENTERED? JMP CHEKR YES, SO ALL'S WELL JMP SEFIL NO, SO GO DO IT. * LB LDA P4 BACKROUND PROGRAM (LARGE) BG2 STA PTYPE STB MES12+11 SET UP OPTION MESSAGE FOR END OF LOAD JMP TEST,I RT LDA P2 JMP BG2 BG LDA P3 JMP BG2 * NC CLA,RSS SC CLA,INA SC2 STA COMTP STB MES12+22 SET UP OPTION MESSAGE-COMMON JMP TEST,I RC LDA P3 JMP SC2 * SS CLA,INA STA #MPFT STA SSGA SSGA FLAG STB MES12+23 SET UP OPTION MESSAGE-SSGA JMP TEST,I * DB CLA,INA STA DBFLG STA OPCOD STB MES12+26 SET UP OPTION MESSAGE-DEBUG JMP TEST,I * TE CLA,RSS PE CLA,INA PM2 STA EDFLG STB MES12+16 SET UP OPTION MESSAGE-LOAD CLB SZA STB OWNER CLEAR OWNER FLAG FOR PERM LOADS LDA IADR GET SESSION WORD SZA,RSS IF IT IS 0, JMP TEST,I THEN ITS NON- SESSION SSA,RSS JSB CAPCK IN SESSION, CHECK CAP LEVEL JMP TEST,I NOT IN SESSION, GO BACK RP LDA P2 JMP PM2 * RS JMP TEST,I THE 'RS' OPTION WAS A MISTAKE. CMM * LE CLA,RSS NL LDA P3 STA PLIST JMP TEST,I * DC LDA M2000 GET THE DON'T COPY FLAG STA COPY? AND SET UP FOR LATER JMP TEST,I GET THE NEXT COMMAND * CP CLA EXT'S NOT FORCED TO USE BP LINKS RSS MP CCA USE CURRENT PAGE LINKING STA EBP.L CLA,INA STA CPL.L STB MES12+4 SET UP OPTION MESSAGE-LINKS JMP TEST,I BP CLA USE BASE PAGE LINKS STA CPL.L CCA STA EBP.L STB MES12+4 SET UP OPTION MESSAGE-LINKS JMP TEST,I * * SKP * * THIS ROUTINE SETS UP THE LIST DEVICE AS AN LU OR FILE * DOLST NOP LDB IPBUF+3 GET THE TYPE WORD SZB ANY LU SUPPLIED OR IS IT NULL ? JMP DOALU YES, SO FIX THE LU * INB NULL SUPPLIED, SO SET DEFAULT STB IPBUF+3 * LDA MYLU# STA IPBUF * * JSB CLOS3 CLOSE ANY OLD FILE * DOALU LDA N6 GET THE NEG COUNT FOR THE MOVE JSB MOVE MOVE THE BUFFER TO FILE NAME AREA DEF IPBUF THE LIST DEVICE MAY BE A FILE DEF FILE3 LDA TYPE3 GET THE INPUT TYPE AND P3 AND KEEP ONLY STA TYPE3 THE LOWER BITS ERA,SLA IS IT A FILE OR AN LU ?? JMP OPNFL A FILE, SO OPEN IT. * LDA IPBUF GET THE LIST LU SZA,RSS IS THERE ONE ? JMP ZIPLU NO . JSB INTER IS IT INTERACTIVE ? RSS NO! JMP ZIPLU YES, DON'T LOCK IT * JSB LURQ UNLOCK ANY PREVIOUS LOCK DEF *+2 DEF MSIGN * JSB LURQ NOW LOCK THE NON INTERACTIVE LU DEF *+4 DEF P1 SPECIFY LOCK DEF IPBUF SPECIFY THE LU DEF P1 AND THE # OF LU'S * LDA IPBUF GET THE LU IOR M200 SET V BIT TO USE COLUMN 1 ZIPLU STA LISTU AND SET IT UP * JMP DOLST,I GET THE NEXT PARAMETER * OPNFL LDA FILE3 GET THE 1ST 2 CHARS OF FILE NAME AND M7400 KEEP ONLY UPPER BYTE CPA ACENT IS IT A ' JMP OPEN3 YES SO GO OPEN THE FILE * CRAT3 JSB CREAT NO, SO CREAT THE FILE DEF *+8 DEF IDCB3 DEF IERR3 DEF FILE3 DEF P12 SIZE = 12 BLOCKS DEF P4 DEF F3SC DEF F3DSC * F3ERR SSA,RSS ANY ERRORS ? JMP DOLST,I NO, FILE NOW OPEN. SO RETURN * JSB CLOS3 YES, SO CLOSE THE LIST FILE LDB F3 GET THE FILE NAME ADDRESS TO B LDA IERR3 ERROR CODE TO A JSB FLERR DO FILE ERROR THING * * OPEN3 JSB OPEN OPEN THE LIST FILE DEF *+7 DEF IDCB3 DEF IERR3 DEF FILE3 DEF IPTN3 DEF F3SC DEF F3DSC * CPA N6 DID WE FIND THE FILE ? JMP CRAT3 NO SO GO CREAT IT JMP F3ERR SEE IF ANY ERRORS * * ACENT OCT 23400 THIS IS A ' * * * * OVLY1 CPB AS ASSIGN PARTITION ? JMP DOAS CPB SZ SPECIFY PROGRAM SIZE JMP DOSZ CPB LL NEW LIST DEVICE ? JMP DOLL CPB OP NEW OPCODE PARAMETERS ? JMP DOOP CPB FM NEW FORMAT PARAMETERS JMP DOOP JMP LSTCH LAST CHANCE IS AN OP OR FM * AS ASC 1,AS SZ ASC 1,SZ LL ASC 1,LL OP ASC 1,OP FM ASC 1,FM * * * DOAS JSB NAMRR GO PARSE THE INPUT LDA IPBUF GET THE PARTITION # STA #PTTN AND SAVE FOR LATER CHECK JMP NXTOP DOSZ JSB NAMRR GO PARSE LDA IPBUF GET THE # OF PAGES SSA,RSS IF NEG SZA,RSS OR ZERO JMP PRERR IT'S AN ERROR. STA #PGS SAVE FOR LATER ERROR CHECKING JMP NXTOP DOLL JSB NAMRR PARSE TO GET THE LIST DEVICE JSB DOLST NOW CHECK IT OUT JMP NXTOP DOOP JSB NAMRR PARSE THE INPUT PARAMETER STRING LDB IPBUF GET THE 1ST PARAMETER LSTCH JSB TEST AND CHECK IT OUT LDB IPBUF+1 JSB TEST NOW TEST THE SECOND PARAMETER LDB IPBUF+2 JSB TEST AND THE LAST PARAMETER JMP NXTOP GET THE NEXT OP CODE * * * ********************************************************************** * TRKYY EQU IDCB2-* OVERLAY CHECK !! * * SKP * * SYSTEM PROGRAM LISTING OPTION * * THE SELECTION OF THIS OPTION GIVES A LISTING * (ON THE LIST UNIT) OF THE PRIMARY CONTENTS OF * EACH ID SEGMENT IN THE SYSTEM. * THE LISTING IS PRECEDED BY THE HEADING: * NAME TY PRIOR LMAIN HMAIN LO BP HI BP SZ EMA MSEG PTN TM COM S-ID * * EACH LINE OF OUTPUT FOR A DEFINED ID SEGMENT IS: * AS SHOWN ABOVE. * * A BLANK ID SEGMENT (AVAILABLE FOR USE) IS * NOTED BY THE LINE OUTPUT: * "" OR "" * * * LLIST JSB SPACE LDB LLM1 PRINT LDA P72 SPC 1 JSB DRKEY JSB SPACE JSB SPACE * LDA KEYWD SAVE STARTING STA ABT1 KEYWORD ADDR. * ZAP36 LDB ABLNK GET AN ASCII BLANK READY LDA N36 # OF WORDS TO BLANK STA YTEMP SAVE TEMPORARIALLY LDA LLM1 GET THE BUFFER ADDRESS ZAPIT STB A,I BLANK IT OUT FOR REUSE INA BUMP POINTER ISZ YTEMP ARE WE DONE ? JMP ZAPIT NO * * JSB BREAK SEE IF BREAK BIT SET XLB ABT1,I GET ID SEGMENT ADDR. SZB,RSS IF END-OF-LIST, GO TO SINGLE JMP GTNBR TERMINATION * ADB P12 SET TO NAME AREA. XLA B,I GET NAME 1,2, STA LLM1+1 SET IN MESSAGE. SZA,RSS IF NAME WORD = 0, THEN JMP LL3 BLANK ID SEGMENT. INB XLA B,I SET NAME 3,4 STA LLM1+2 IN MESSAGE. INB XLA B,I GET NAME 5, AND M7400 ISOLATE, IOR BLNK ADD BLANK STA LLM1+3 AND STORE. * JSB LIST? GO SEE IF WE SHOULD PRINT IT * * XLA B,I GET TYPE AND M7 CODE. STA ZTEMP SAVE PROG TYPE IOR M60 MAKE ASCII, IOR UBLNK ADD UPPER BLANK, STA LLM1+4 AND STORE. * XLA B,I GET THE WORD AGAIN AND M20 GET THE SS BIT STA YTEMP SAVE IT * XLA B,I ONE MORE TIME AND M200 GET TEMPORARY LOAD BIT STA WTEMP AND SAVE * CLB STB OPCOD INSURE AN OCTAL CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P23 INDEX TO HIGH MAIN XLA A,I GET IT LDB LLM11 GET THE DESTINATION ADDRESS JSB CONVD DO THE CONVERSION. * JSB ADJST GET THE ID ADDRESS AGAIN ADA D22 INDEX TO THE LOW MAIN WORD XLA A,I LDB LLM8 GET THE DESTINATION JSB CONVD DO THE CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P24 GET LOW BP XLA A,I GET THE WORD LDB LLM14 GET THE DESTINATION JSB CONVD DO THE CONVERSION * JSB ADJST GET THE ID ADDRESS AGAIN ADA P25 GET THE HI BP XLA A,I LDB LLM17 JSB CONVD * * LDB ZTEMP GET THE PROGRAM TYPE BACK AGAIN CPB P5 IS IT A SEGMENT ? JMP LL45 YES * PROR XLB ABT1,I GET THE ID ADDRESS AGAIN ADB P6 INDEX TO THE PRIORITY XLA B,I GET THE PRIORITY LDB P3 MAKE SURE THE CONVERSION IS DECIMAL STB OPCOD LDB LLM5 GE THE DESTINATION ADDRESS JSB CONVD DO THE CONVERSION * * * XLB ABT1,I GET THE ID ADDRESS AGAIN (TEDIOUS ISN'T IT ?) ADB D21 INDEX TO SIZE WORD XLA B,I GET THE SIZE STA XTEMP SAVE IT AND M1600 GET MEMORY PROTECT FENCE ARS LDB NCMPF DEFAULT WILL BE NO COMMON CPA M200 REAL COMMON? LDB RTMPF CPA M300 BACKGROUND COMMON? LDB BGMPF CPA M400 SSGA? LDB SSMPF STB LLM1+33 PUT IT IN THE MESSAGE * LDA ZTEMP GET THE PROG TYPE AGAIN CPA P1 MEM RES ? JMP LL4 YES, SO WE'RE DONE * LDA XTEMP SIZE WORD AGAIN AND M0760 NOW GET THE SIZE INFO ALF,ALF PLAY A FEW GAMES WITH IT RAR,RAR INA ACCOUNT FOR BASE PAGE JSB CNV99 CONVERT TO ASCII STA LLM1+21 SOCK IT AWAY * LDA XTEMP GET THE SIZE WORD AGAIN SSA,RSS IS THIS PROG ASSIGNED TO A PARTITION ? JMP LL4. NO, SO GO DO OUTPUT * AND M77 SO GET THE PARTITION # INA MAKE IT COUBT FROM 1 (NOT 0 ) JSB CNV99 DO THE CONVERSION STA LLM1+29 SAVE IT * LL4. XLB ABT1,I GET THE ID SEG AGAIN ADB D28 GET TO EMA WORD XLA B,I PULL IT IN SZA,RSS ANY EMA DECLARED ? JMP LL43 NO, SO WE'RE DONE WITH THIS LINE * STA LLIST SAVE WORD AND B1777 KEEP EMA SIZE LDB LLM22 GET THE ADDRESS JSB CONVD AND CONVERT * LDA LLIST NOW GET THE MSEG SIZE FROM THE ALF ID EXTENSION RAL,RAL AND M77 XLB $IDEX ADA B XLA A,I NOW HAVE THE MSEG ADDRESS XLA A,I NOW HAVE THE MSEG WORD AND M37 JSB CNV99 STA LLM1+26 * * LL43 XLB ABT1,I ID ADDR AGAIN! ADB P31 INDEX TO NEXT TO LAST WORD XLA B,I GET IT AND M377 OWNER IS IN LOW 8 BITS LDB LLM34 DESTINATION JSB CONVD CONVERT IT * * LL45 LDA PELD PERMANENT LDB WTEMP TEMPORARY? SZB WELL? LDA TELD YES, CHANGE A REG TO TEMPORARY STA LLM1+31 PUT IT IN THE MESS * * LL4 LDA P72 PRINT NAME LDB LLM1 LINE JSB DRKEY * LL2 ISZ ABT1 GET NEXT KEYWORD ADDR. JMP ZAP36 -REPEAT SCAN. * * OUTPUT BLANK ID MESSAGE * LL3 LDA TYPE1 GET THE PROG NAME TYPE WORD SZA ANY PROG SPECIFIED JMP LL2 YES SO DONT PRINT THE BLANK ID MSG. ADB P2 (B)=ADDR OF NAM5 WORD XLA B,I GET NAM5 WORD AND M20 MASK IN 'SS' BIT LDB LLM3 (B)=ADDR OF LONG ID MESSAGE SZA 'SS' BIT SET ? LDB LLM4 YES-(B)=ADDR OF SHORT ID MESSAGE LDA P18 (A)=MESSAGE LENGTH JSB DRKEY JMP LL2 * * GTNBR LDA P3 INSURE DECIMAL CONVERSION STA OPCOD JSB BLKID LDA BID5 GET # OF LONG LDB L#1 GET ADDRESS JSB CONVD CONVERT * LDA BID6 GET # OF SHORT IDS LDB L#2 JSB CONVD * LDA BID11 GET # OF ID EXTS LDB L#3 JSB CONVD * JSB SPACE LDA P64 PRINT THE INFO LDB L#IDS JSB DRKEY AND AS PORKY PIG WOULD SAY : * JMP EXIT THA-THA-THA-THA-THATS ALL FOLKS !!!!! * * * PURGE LDA IADR GET SCB ADDR SZA,RSS IF ITS 0, JMP *+3 THEN IT IS NON-SESSION SSA,RSS CHECK IF IN SESSION JSB CAPCK YES, IN SESSION. GO TO CHECK CAP LEVEL CLA,INA NOT IN SESSION, GO GET CLB JSB SETID ID ADDRS FOR LONG ID LDB BATCH GET THE BATCH FLAG SSB UNDER BATCH ? JMP LDI25 YES , ITS AN ERROR * LDA PAM1 GET INPUT PARAMETER P1 * SZA INPUT SPECIFIED ? * JMP USEIM YES - GO USE IT. * LDB BATCH GET BATCH FLAG * INA SET FOR LU1 * SZB RUNNING UNDER BATCH ? * LDA P5 YES-THEN DEFAULT INPUT TO LU 5 * SZB,RSS RUNNING UNDER BATCH? *SEIM STA LIST1 NO, SET PROMPT LU * * * LDA TYPE1 WAS A NAME ENTERED? SZA FROM RUN STRING? JMP GOTNM YES,SO OK * * * LDA TYPE2 GET COMMAND TYPE ERA,SLA FILE OR LU? JMP TRLOG FILE, SO PROMPT LOG LU * LDA FILE2 GET THE CMND FILE LU # AND M77 KEEP ONLY LOWER BITS JSB INTER SEE IF IT'S INTERACTIVE JMP TRLST NOPE GOTIT IOR M400 SET ECHO BIT STA LISTU AND SET THE LU JMP TRYAG GO PRINT THE MESSAGE * TRLST LDA LISTU GET THE LIST LU AND M77 KEEP ONLY LU JSB INTER GO SEE IF ITS INTERACTIVE JMP LDI5 THAT'S NOT EITHOR, SO FLUSH HIM ! JMP GOTIT * TRLOG LDA MYLU# GET LOG LU AND M77 KEEP ONLY LU JSB INTER SEE IF INTERACTIVE JMP LDI5 NO,SORRY JMP GOTIT YES,GO FOR IT * * TRYAG LDA P10 SEND THE MESSAGE LDB LLM2 LOADR: PNAME ? JSB SYOUT TO THE OUTPUT DEVICE * LDA LLM2+1 GET AN ASCII BLANK STA NAM12,I AND INITIALIZE BUFFER STA NAM34,I STA NAM5,I * JSB EXEC READ THE REPLY DEF *+5 TO THE DEF P1 DEF LISTU DEF NAM12,I NAME AREA IN THE ID SEGMENT DEF P3 THREE WORDS LDA NAM12,I CHECK FOR /A (ABORT OPERATION) CPA /A JMP ABORT YES GO ABORT DEFCK JSB MIDN GO SEE IF THE NAME IS DEFINED JMP LDI5 NO GO SEND MESSAGE JMP *+1,I GO PURGE THE PROG DEF ED0 (SAVE A BP LINK TOO !) * GOTNM LDA FILE1 NAME IS IN FILE1 STA NAM12,I MOVE TO NAM12 LDA FILE1+1 STA NAM34,I NAM34 LDA FILE1+2 STA NAM5,I NAM5 JMP DEFCK CONTINUE AS BEFORE SPC 1 * BLNK OCT 40 D21 DEC 21 D22 DEC 22 * * L#IDS DEF *+1 ASC 22,XXXXXX FREE LONG IDS, XXXXXX FREE SHORT IDS, ASC 10,XXXXXX FREE ID EXTS * L#1 DEF L#IDS+1 L#2 DEF L#IDS+12 L#3 DEF L#IDS+23 LLM1 DEF *+1 ASC 20,NAME TY PRIOR LMAIN HMAIN LO BP HI BP ASC 16,SZ EMA MSEG PTN TM COM S-ID SPC 1 /A ASC 1,/A * LLM4 DEF *+1 ASC 9, LLM3 DEF *+1 ASC 9, * LLM8 DEF LLM1+8 LLM11 DEF LLM1+11 LLM14 DEF LLM1+14 LLM17 DEF LLM1+17 LLM5 DEF LLM1+5 LLM22 DEF LLM1+22 LLM34 DEF LLM1+34 P24 DEC 24 P25 DEC 25 N36 DEC -36 D28 DEC 28 LLM2 DEF *+1 ASC 5, PNAME ?_ * * * * CHECK THE CAPABILITY LEVEL WHEN IN SESSION. * THIS SUBROUTINE WILL NEVER BE CALLED IF USER NOT IN SESSION. * CAPCK NOP JSB CAPGT GET THE CAP. LEVEL LDA P60 CMA,INA IF LEVEL > OR = 60 ADA LCAP SSA IT IS O.K. JMP CAPER IF LEVEL < 60 , RETURN AN ERROR AND ABORT IT. JMP CAPCK,I * * * GET THE USER'S CAPABILITY LEVEL * CAPGT NOP JSB ISMVE DEF *+5 DEF IADR SCB ADDR DEF $SMCA OFSET BACK TO THE CAPABILITY DEF LCAP RETURN SESSION CAPABILITY LEVEL DEF P1 GET 1 WORD * LDA LCAP SSA JMP SCBER CONTENTS OF SCB ADDR IS INVALID, ABORT IT. JMP CAPGT,I IT IS VALID VALUE, GO BACK * * ERROR RETURN IF SCB CONTENT IS INVALID * SCBER LDA ERR22 JMP ABOR * * ERROR RETURN IF CAPABILITY LEVEL IS LOWER THAN 60 AND TRY TO * PU,PE,RP A PROGRAM. * CAPER LDA ERR23 JMP ABOR * * * ADJST NOP XLA ABT1,I GET THE ID ADDRESS AGAIN LDB YTEMP GET THE SHORT SEG FLAG CPB M20 IS THIS A SHORT SEG ? ADA N7 THEN ADJUST A REG JMP ADJST,I AND RETURN * * LIST? NOP LDA TYPE1 SZA,RSS ANY THING INPUT FOR PROG NAME ? JMP LIST?,I NO, SO CONTINUE LDA FILE1 GET 1ST CHAR CPA LLM1+1 IS IT THIS ONE ? RSS YES JMP LL2 NO LDA FILE1+1 GET 2ND CHAR CPA LLM1+2 RSS JMP LL2 LDA FILE1+2 GET THE LAST CHAR CPA LLM1+3 JMP LIST?,I SUCCESS !!! JMP LL2 SPC 1 NOVLY EQU * BEGIN NON-OVERLAYABE CODE .LBUF EQU *-LBUF-128 OVERLAY CHECK .DBUF EQU *-DBUF-128 OVERLAY CHECK .XBUF EQU *-XBUF-128 OVERLAY CHECK * BSS .BUF-* TURKY EQU *-.BUF OVERLAY CHECK NOP * * UBLNK OCT 20000 COMTP NOP TYPE OF COMMON 0/1/3 LOCAL/SYS/REVERSE M60 OCT 60 LDI25 LDA ERR25 JMP ABOR DBFLG NOP 0/1 NORMAL LOAD /APPEND DEBUG TELD ASC 1,TE PELD ASC 1,PE NCMPF ASC 1,NC RTMPF ASC 1,RT BGMPF ASC 1,BG SSMPF ASC 1,SS WTEMP NOP XTEMP NOP YTEMP NOP ZTEMP NOP BKLWR NOP LAST WORD OF AVAIL MEMORY INDLU NOP TEMP LU WORD #PGPT NOP # OF PAGES IN PART'N * MYLU# DEC 1 DEFAULT LU B1777 OCT 1777 M400 OCT 400 * SKP *********************************************************************** * NON OVERLAY AREA *********************************************************************** * * * * * GTCMD NOP JSB CLOS2 CLOSE CURRENT LIB * JSB NAMRR NOW GET THE COMMAND FILE NAME SSA,RSS END OF STRING ? JMP NOSTG NO * LDA MYLU# YES, NO STRING. GET THE DEFAULT LU CCB SET B-REG TO -1 CPB BATCH RUNNING UNDER BATCH? LDA P5 YES,DEFAULT TO LU 5 STA IPBUF PUT INTO PARSE BUFFER CLA,INA SET TYPE WORD TO LU (NOT A FILE) STA IPBUF+3 * NOSTG LDA N6 GET THE NEG COUNT AGAIN JSB MOVE AND MOVE THE NAME TO THE CMND NAME BUFFER DEF IPBUF SOURCE OF MOVE DEF FILE2 COMMAND FILE NAME ADDRESS * CLA CLEAR INTERACTIVE FLAG STA DFLAG * LDA TYPE2 GET THE PARSE TYPE WORD AND P3 KEEP ONLY THE LEAST TWO BITS STA TYPE2 AND SAVE FOR LATER * ERA,SLA IS IT A FILE OR AN LU ? JMP GTCMD,I FILE, SO JUST RETURN LDA FILE2 AN LU. JSB INTER SEE IF IT IS INTERACTIVE JMP GTCMD,I SO JUST RETURN * ISZ DFLAG IT IS SO SET THE INTERACTIVE BIT * LDB DOLST WAS DOLST EVER CALLED? SZB WELL? JMP STECH YES, LIST DEVICE SET UP ALREADY * ISZ DOLST NO, MARK IT SO WE KNOW WE DONE IT STA FILE3 IT IS, SO MAKE IT THE LIST LU IOR M200 USE COLUMN 1 STA LISTU STECH IOR M400 SET THE ECHO BIT STA FILE2 ON THE LU FOR THE PROMPT JMP GTCMD,I RETURN * * * * FOPEN JSB OPEN OPEN THE COMMAND FILE DEF *+7 DEF IDCB2 DATA CONTROL BLOCK DEF IERR2 ERROR FLAG DEF FILE2 FILE NAMR DEF IPTN2 OPEN OPTION DEF F2SC SECURITY CODE DEF F2DSC CARTRIDGE REF # * SSA,RSS ANY ERRORS ? JMP FREAD NO LDB F2 GET THE FILE NAME ADDRESS JSB FLERR YES * * * COMMAND FILE PROCESSOR * * LREAD LDA DFLAG (ALL LU READS RETURN HERE) GET THE FLAG SZA ARE WE INTERACTIVE ?? JSB PRMTR YES, SO OUTPUT LOADR PROMPT JSB REIO NOW READ THE INPUT DEF *+5 DO IT IN A REENTRANT FASHION SO THAT DEF P1 WE ARE SWAPABLE DEF FILE2 DEF STRNG DEF N80 SZB,RSS WAS THE READ OF ZERO LENGTH ? JMP RETRY YES, END OF INPUT, GO SEE IF RETRY ALLOWED CMND STB SLONG SAVE READ LENGTH FOR PARSING ROUTINE CLA,INA SET UP PARSING OFFSET TO START PARSING STA TRYCT RESET RETRY COUNT STA ISTRC AT THE FIRST CHARACTER JSB NAMRR PARSE THE OPCODE LDB IPBUF+1 GET 3RD & 4TH CHAR STB OP1? LDB IPBUF AND SAVE THE OPCODE STB OP? TEMPORARIALLY * * THESE COMMANDS MAY BE ENTERED ANY TIME * * CPB EN END OF COMMAND FILE ? JMP SECHK CPB /E END OF COMMAND FILE ? JMP SECHK CPB EX END OF COMMAND FILE ? JMP SECHK CPB LO MODIFY CURRENT LOAD POINT ? JMP SECHK CPB SE A SEARCH COMMAND ? JMP SECHK CPB MS A MULTIPLE SEARCH COMMAND? JMP SECHK CPB FO A FORCE COMMAND ? JMP FORCE CPB RE A RELOCATE COMMAND ? JMP SECHK CPB DS DISPLAY UNDEFS ? JMP DSPLY CPB EC ECHO COMMANDS ? JMP SUPRS CPB LI LIBRARY FILE ? JMP GTLIB CPB .A ABORT ? JMP ABORT CPB AB ABORT ? JMP ABORT CPB TR TRANSFER ? JMP XEQTR CPB SL LIBRARY SEARCH ? JMP SECHK LDA B AND M7400 CPA AS2RK JMP NXTOP * LDA DONE? GET THE MAIN LOADED FLAG SZA,RSS HAS THE MAIN BEEN LOADED ? JMP OVLY1 NO, GO TO OVERLAY AREA FOR REST OF COMNDS * PRERR LDA DFLAG GET THE INTERACTIVE FLAG ? SZA,RSS ARE WE IN THE INTERACTIVE MODE ? JMP DOERR GO DO THE INPUT ERROR THING JSB PRMTR YES, JSB EXEC SO GIVE HIM ANOTHER CHANCE DEF *+5 DEF P2 DEF FILE2 DEF PROMT+6 DEF P1 * CLA CLEAR FLAG IN CASE STA LIBLM IT WAS SET * JMP NXTOP GO GET THE NEXT INPUT * RETRY LDA DFLAG WE INTERACTIVE? SZA,RSS WELL? JMP END?? NO, END OF INPUT, GO DO ERROR CHECKING LDA TRYCT YES, GET TRY COUNT CPA P5 WE ALREADY TRY 5 TIMES? JMP END?? YES, SO DO ERROR CHECKING ISZ TRYCT NO, INCREMENT COUNT JMP LREAD AND TRY AGAIN * DOERR LDA CLEN GET THE READ LENGTH SZA IF NON ZERO ECHO IT JSB IECHO LDA LIBLM GET THE LIB LIM EXCEEDED FLG SZA,RSS WAS IT? JMP LDI5 NO,SO JUST ABORT THYSELF LDA ERR13 YES, SEND LM LIB JMP ABOR ERROR MESSAGE * LIBER ISZ LIBLM INC LIB LIM FLAG JMP PRERR GO PROCESS THE ERROR * OP? NOP LAST OPCODE LIBLM NOP LIBRARY LIMIT EXCEEDED FLAG ISTRC DEC 1 POINTER TO CURRENT CHAR TO BE PARSED TRYCT NOP REPROMPT COUNT FOR INTERACTIVE LU * * PROCESS THE COMMAND. * DSPLY LDA DFLAG GET THE CMND INTERACTIVE FLAG SZA,RSS IS IT INTERACTIVE ?? JMP DSPL1 NO LDB LISTU YES SO GET THE LIST LU STB QTEMP AND SAVE LDB FILE2 GET THE CMND LU STB LISTU AND USE IT AS THE LIST DEVICE LDB TYPE3 GET TYPE STB PTEMP AND SAVE CLB,INB STB TYPE3 JSB PUDF REPORT UNDEFS LDB QTEMP GET THE LIST LU BACK AGAIN STB LISTU AND RESTORE IT LDB PTEMP GET TYPE STB TYPE3 AND SAVE IT TOO JMP NXTOP GET NEXT COMMAND DSPL1 JSB PUDF REPORT UNDEFS JMP NXTOP GET THE NEXT COMMAND SUPRS CCA STA ECHO? NXTOP LDA TYPE2 GET THE TYPE OF INPUT ERA,SLA WHERE ARE WE READING FROM ? JMP FREAD A FILE JMP LREAD AN LU FORCE CCA SET THE FORCE STA FORCD FLAG. STB MES12+28 SET UP OPTION MESSAGE-FORCE JMP NXTOP RELOC CCA GET A -1 CPA UNFLG IS UNDEF PROCESSING FLAG SET? JMP W25 YES, RE NOT ALLOWED CLA,RSS NOW SET A FEW FLAGS SERCH CCA NOW SET A FEW FLAGS STA LBS.L IS A LIBRARY SEARCH * DOPRS CLA SET A FEW FLAGS STA SCSEG CLEAR SCAN TILL SEG ENCOUNTERED FLAG STA SLIBF NOT A SYS LIB SCAN STA LGOU NOT AN LG READ CMA STA NOR.L NO ROUTINES LOADED STA NM1.L NAM MUST BE FIRST JSB NAMRR PARSE TH INPUT SSA WAS THERE ANYTHING TO PARSE ? JMP SE?? NO SEE IF LAST ONE WAS A SE,< > LDA IPBUF GET THE 1ST PARSED WORD SZA IF = 0 OR CPA PROMT+4 = ASCII BLANK THEN JMP SE?? BETTER BE A SE,0, OR SE,, COMMAND * LDA N6 GET THE WORD COUNT JSB MOVE MOVE THE NAMR TO THE DCB AREA DEF IPBUF SOURCE DEF FILE1 DESTINATION LDA TYPE1 GET THE TYPE WORD AND P3 KEEP ONLY THE LEAST 2 BITS STA TYPE1 JMP DMANE NOW GO DO THE READ * W25 LDA P8 SEND A NASTY NOTE LDB WNG25 AND GIVE HIM JSB SYOUT ANOTHER JMP LREAD TRY * WNG25 DEF *+1 ASC 4,W-IL CMD * DLOAD JSB NAMRR GO PARSE THE INPUT TO GET NEW LOAD ADDRESS LDA IPBUF+3 GET THE TYPE OF PARAMETER SLA RAR,SLA ONLY NUMERIC ALLOWED. NO ASCII. JMP PRERR SHAME ON YOU ! LDA TH1.L GET THE CURRENT LOAD ADDRESS CMA,INA AND MAKE SURE THAT THE NEW LOAD ADA IPBUF ADDRESS IS ABOVE THE OLD ONE SSA IS IT ? JMP PRERR NO, SEND AN ERROR LDB IPBUF GET THE ADDRESS AGAIN SSB IF NEGATIVE JMP PRERR ITS AN ERROR ALSO CLA OK, SO CLEAR THE UNUSED AREA ADB N1 UP TO BUT NOT INCLUDING NEW LD ADDR JSB OUTAB OUTAB WILL CHECK TO SEE IF HE SET THE DEF *+3 DUMMY DEFS DEF *+2 TO FAKE OUT DEF *+1 OUTAB * JMP NXTOP LD PT RST IN L.REL,L.SG0. NOW GET NEXT CMND. * SE?? LDA OP? GET THE LAST OPCODE ENTERED CPA SE WAS IT AN ' SE ' ? JMP SEOK YES CPA MS WAS IT AN 'MS'? RSS YES JMP PRERR NO, WAS AN RE, < > = AN ERROR * SEOK JMP *+1,I NOW GO SCAN DEF LOADN (SAVE A BP LINK TOO !) * END?? LDA EN FLIB NOP 0/-1 NOT/IS A LIBRARY FILE SCAN SVTP1 NOP OLD INPUT FILE TYPE WORD STA OP? SECHK LDB DONE? GET THE ERROR CHECKS DONE FLAG SZB,RSS HAVE WE DONE THE PARAMETER CONFLICT CHECK ? JMP CNFLT NO, SO DO IT (JMPS BACK TO OVERLAY AREA ) SECK1 LDA OP? GET THE OPCODE AGAIN * CPA FO WAS IT A FORCE ? JMP FORCE YES, SO DO THE FORCE LOAD CPA SE WAS IT A SEARCH ? JMP SERCH YES, SO SEARCH THE FILE CPA MS WAS IT A MSEARCH? JMP SERCH YES, SO SEARCH IN THIS CASE, TOO CPA RE WAS IT A RELOCATE ? JMP RELOC YES, SO RELOCATE THE FILE CPA LO WAS IT A CHANGE LOAD ADDRESS CMND ? JMP DLOAD YES, SO GO SET UP NEW LOAD ADDRESS CPA SL WAS IT A SEARCH LIBRARY COMMAND ? JMP SELIB THEN DO IT JSB CLOS2 MUST HAVE BEEN AN END. SO CLOSE JSB CLOS1 COMMAND AND INPUT FILES. AND JMP CLFL1 FINISH THE LOAD. * GTLIB JSB NAMRR PARSE FOR NEXT INPUT SSA ANY ERRORS ? JMP PRERR YES, NOTHING TO PARSE * LDA IPBUF+3 GET THE TYPE WORD AND P3 KEEP ONLY TYPE CPA P3 WAS THE INPUT ASCII ? RSS YES. SO ITS OK FOR NOW. JMP PRERR NO, LU'S ARE NOT LIBRARY FILES. * LDB LPNTR GET THE POINTER TO THE LAST LIB FILE CPB END TOO MANY LIB FILES ? JMP LIBER THATS AN ERROR TOO. STB NXTAD OK. SO MOVE NAME & SC & CART # TO BUFFER AREA * LDA N3 MOVE COUNT JSB MOVE DEF IPBUF SOURCE NXTAD NOP DESTINATION SET ABOVE * LDB LPNTR GET THE SOURCE ADDR ADB P3 ADD MOVE COUNT LDA IPBUF+4 GET THE SECURITY CODE STA B,I & STUFF IT INB BUMP POINTER LDA IPBUF+5 GET THE CART REF # STA B,I AND STUFF THAT TOO. INB STB LPNTR RESET THE POINTER ADDRESS FO NEXT LIB. JMP NXTOP GET THE NEXT COMMAND. * XEQTR CCA GET A -1 CPA UNFLG ARE WE DOING SPECIAL UNDEF EXT STUFF? JMP XEQT1 YES, TR ALLOWED, TR,XXXXX NOT ALLOWED JSB GTCMD CLOSE OUT OLD FILE & OPEN NEW. JSB BREAK CHECK IF ABORT DESIRED LDA TYPE2 GET THE TYPE WORD ERA,SLA FILE OR LU JMP FOPEN FILE JMP LREAD LU * XEQT1 JSB NAMRR GET COMMAND FILE NAME SSA,RSS ANY? JMP W25 YES, NOT ALLOWED * CLA NO, RESTORE WHAT WE STARTED WITH STA UNFLG CLEAR UNDEF PROCESSING FLAG STA TRY2 CLEAR 2ND TRY NOT ALLOWED FLAG * LDB SVOP RESTORE STB OP? THE LAST OP CODE * LDA SF2TY GET SAVED COMMAND FILE TYPE SZA ANY? JMP XEQT3 YES, GO RESTORE IT * CPB EN NO, WAS COMMAND AN EN? JMP XEQT2 YES, GO CLEAR CMMD FILE CPB /E WAS COMMAND A /E? JMP XEQT2 YES, GO CLEAR CMMD FILE CPB EX WAS COMMAND AN EX? JMP XEQT2 YES, GO CLEAR CMMD FILE JMP XEQT4 NO,LEAVE CMMD AS IS, SEE ABOUT RELOC * XEQT2 STA TYPE2 CLEAR FILE TYPE WORD STA DFLAG AND INTERACTIVE LU WORD JMP XEQT4 GO CHECK OUT RELOCATABLE * XEQT3 LDA N6 JSB MOVE MOVE CMMD FILE DEF SFIL2 INFO BACK DEF FILE2 LDA SF2IN RESET INTERACTIVE FLAG STA DFLAG CLA CLEAR OUT STA SF2TY SAVED CMND FILE TYPE LDA TYPE2 IS COMMAND AN LU OR FILE? ERA,SLA JSB OPPOS A FILE, SO OPEN AND POSITION IT * XEQT4 LDA SF1TY GET RELOC TYPE SZA,RSS ANY? JMP LOADX NO, GO PRETEND LIKE NOTHING HAPPENED * LDA N6 YES JSB MOVE RESTORE RELOC DEF SFIL1 FILE DEF FILE1 CLA CLEAR OUT STA SF1TY SAVED RELOC FILE TYPE LDA TYPE1 IS RELOC A FILE OR LU? ERA,SLA RSS * JMP LOADX AN LU SO GO PROCESS OLD OP * JSB OPEN A FILE, SO OPEN AND POSITION IT DEF *+8 DEF IDCB1 DEF IERR1 DEF FILE1 DEF IPTN1 DEF F1SC DEF F1DSC DEF IDCBS * SSA,RSS ANY ERRORS? JMP POS1 NO, SO GO POSITION IT LDB F1 YES, GET FILE NAME ADDRESS JSB FLERR AND SEND ERROR MESSAGE * POS1 JSB APOSN GET TO THE RIGHT RECORD DEF *+6 DEF IDCB1 DEF IERR1 DEF SF1RC DEF SF1RB DEF SF1OF * SSA,RSS ANY ERROR? JMP LOADX NO, PRETEND LIKE NOTHING HAPPENED LDB F1 YES, GET FILE NAME ADDRESS JSB FLERR AND SEND ERROR MESSAGE * OPPOS NOP ROUTINE TO OPEN & POSITION CMMD FILE * JSB OPEN OPEN THE COMMAND FILE DEF *+7 DEF IDCB2 DEF IERR2 DEF FILE2 DEF IPTN2 DEF F2SC DEF F2DSC * SSA,RSS ERROR? JMP POS2 NO LDB F2 YES, GET FILE NAME ADDRESS JSB FLERR AND RETURN THE ERROR * POS2 JSB APOSN POSITION THE COMMAND FILE DEF *+6 DEF IDCB2 DEF IERR2 DEF SF2RC DEF SF2RB DEF SF2OF * SSA,RSS ANY ERROR? JMP OPPOS,I NO, RETURN LDB F2 YES, GET FILE NAME ADDRESS JSB FLERR RETURN ERROR JMP OPPOS,I RETURN * SELIB JSB LIBSC SCAN THE LIBRARIES JMP NXTOP GO GET NEXT COMMAND * * * THE FOLLOWING ARE THE LEGAL COMMAND FILE COMMANDS * DS ASC 1,DI TR ASC 1,TR SL ASC 1,SL LI ASC 1,LI EC ASC 1,EC RE ASC 1,RE SE ASC 1,SE MS ASC 1,MS FO ASC 1,FO EN ASC 1,EN .A ASC 1,/A AB ASC 1,AB /E ASC 1,/E EX ASC 1,EX LO ASC 1,LO AS2RK OCT 25000 AN * ECHO? NOP LPNTR DEF LIBRY POINTER TO LIBRARY NAME BUFFERS SPC 1 * * * IERR2 NOP ERROR FLAG FOR COMMAND FILE IPTN2 NOP OPEN OPTION * IERR3 NOP ERROR FLAG FOR LIST DEVICE IPTN3 DEC 1 OPEN OPTION (NON EXCLUSIVE !!!!!) * * IERR1 NOP READ ERROR FLAG IPTN1 DEC 1 OPEN OPTION (NON EXCLUSIVE) IDCBS DEC 256 * * SPC 1 * OPEN, READ, AND ECHO THE COMMAND. SPC 1 * FREAD JSB READF READ THE COMMAND FILE DEF *+6 DEF IDCB2 DEF IERR2 DEF STRNG DEF P40 DEF CLEN * LDA ECHO? ARE WE ECHOING COMMANDS ? SZA JSB IECHO YES, SO DO IT. * * * LDA IERR2 SSA,RSS ANY ERRORS ? JMP FLCHK NO LDB F2 JSB FLERR YES FLCHK LDB CLEN GET LENGTH OF COMMAND JUST READ SZB,RSS WAS IT ZERO ? JMP FREAD YES, SO DO IT AGAIN SSB WAS IT NEGATIVE (IE END OF FILE) JMP END?? YES, SO FINISH PROCESSING CLE,ELB CONVERT TO CHAR COUNT (MULT BY 2) JMP CMND GO DO COMMAND FILE PROCESSING * CLEN NOP RECORD READ LENGTH * * * P40 DEC 40 * ************************************************************************* * NON-OVERLAYABLE SUBROUTINES ************************************************************************* * THE NAMRR SUBROUTINE USES THE RELOCATABLE LIBRARY * PARSING ROUTINE NAMR. THE INPUT TO NAMR IS A STRING * OF ASCII CHARACTERS. * THE OUTPUT IS A 10 WORD BUFFER PARSED AS : * PRAM1,PRAM2,PRAM3,TYPE,S1,S2,S3,S4,S5,S6 * PARAMETERS BETWEEN COMMAS ARE PARSED. SUBPARAMETERS ARE * DELINEATED BY COLONS. THE TYPE WORD DESCRIBES ALL * PARAMETERS AS ASCII, NUMERIC, OR NULL. * THE TYPE WORD IS BROKEN UP INTO 2 BIT FIELDS TO DESCRIBE * THE INPUT. *15,14 13,12 11,10 9,8 7,6 5,4 3,2 1,0 *----------------------------------------------- * S6 ! S5 ! S4 ! S3 ! S2 ! S1 ! PRAM ! *----------------------------------------------- * * PRAM = 0 ...NULL PRAM1 = PRAM2 = PRAM3 = 0 * PRAM = 1....NUMERIC (ONLY PRAM1 USED) PRAM1 = # * PRAM = 2 ...NOT USED * PRAM = 3 ... ASCII (USES PRAM1,PRAM2,PRAM3 ) * * S1 - S6 ARE DEFINED THE SAME EXCEPT THEY ARE ONE WORD ONLY * NAMRR NOP JSB NAMR THIS IS THE RELO LIBR PARSING ROUTINE DEF *+5 RETURN ADDR DEF IPBUF ADDRESS OF 10 WORD PARSED BUFFER DEF STRNG ADDRESS OF BUFFER TO BE PARSED DEF SLONG CHARACTER LENGTH DEF ISTRC CHAR OFFSET IN STRNG FOR NEXT PRAM JMP NAMRR,I RETURN TO CALLER * * * THIS SUBROUTINE IS USED IF THE COMMAND FILE FOR * INPUT IS AN INTERACTIVE LU. IT OUTPUTS A LOADR * PROMPT WHICH IS /LOADR: * PRMTR NOP JSB EXEC DEF *+5 DEF P2 DEF FILE2 DEF PROMT DEF P6 JMP PRMTR,I PROMT ASC 6, /LOADR: _ ASC 1,?? * * * THE IECHO ROUTINE ECHOS COMMAND FILE COMMANDS AND ECHOS * ANY BAD COMMANDS ENCOUNTERED IN THE COMMAND FILE * IT ASSUMES THE WORD COUNT IN ' CLEN ' AND THE BUFFER * TO BE OUTPUT IN ' DSTRG '. * IECHO NOP LDA CLEN RAL WORD COUNT IS NOW CHAR COUNT LDB DSTRG GET THE BUFFER ADDRESS JSB DRKEY OUTPUT IT JMP IECHO,I RETURN TO CALLER * * * *THE FLERR ROUTINE HANDLES ALL FILE ERRORS. CALLING SEQUENCE: * * LDA WITH ERROR CODE (NEGATIVE) * LDB WITH ADDRESS OF FILE * JSB FLERR * * *THIS ROUTINE WILL CLOSE ALL FILES FLERR NOP STB EFILE SAVE NAME OF FILE CMA,INA MAKE ERROR POSITIVE JSB CNV99 CONVERT TO ASCII STA B IF 1ST CHAR IS AND M774K ASCII BLANK CPA B20K THEN ADB B10K CHANGE TO A ZERO STB EFBUF+4 PUT INTO ERROR MESSAGE LDA EFILE,I GET THE FILE NAME STA EFBUF+10 AND ISZ EFILE PUT LDA EFILE,I IT STA EFBUF+11 INTO ISZ EFILE THE LDA EFILE,I ERROR STA EFBUF+12 MESSAGE . * JSB PTERR POST THE ERROR DEF *+2 DEF EFBUF+1 * LDA DFLAG GET INTEACTIVE FLAG SZA,RSS WE INTERACTIVE ? JMP PRNIT NO,JUST GO PRINT IT * LDA LISTU SAVE THE LIST LU STA QTEMP LDA FILE2 REPLACE WITH INTERACTIVE LU STA LISTU LDA TYPE3 SAVE TYPE STA PTEMP CLA,INA SET TYPE = LU STA TYPE3 * PRNIT LDA P26 GET THE CHAR COUNT LDB DEBUF AND THE ADDRESS JSB DRKEY NOW PRINT THE ERROR MESSAGE * LDA DFLAG GET THE INTERACTIVE CMND FILE WORD SZA,RSS ARE WE INTERACTIVE ? JMP FLER1 NO, LOG FILE ERROR TO LOG DEVICE * LDA QTEMP RESTORE LIST DEVICE STA LISTU LDA PTEMP STA TYPE3 AND TYPE OF LIST DEVICE WORD * JMP NXTOP GO GET NEXT COMMAND * FLER1 LDA TYPE3 IS LIST DEVICE ERA,SLA FILE OR LU? JMP FLER2 FILE, SO CAN'T BE LOG DEVICE LDA LISTU IS LIST DEVICE AND M77 CPA MYLU# LOG DEVICE? JMP LDI5 YES, DO REST OF ERROR THING * FLER2 LDA LISTU SAVE LIST DEVICE STA QTEMP LDA MYLU# REPLACE WITH LOD DEVICE STA LISTU LDA TYPE3 SAVE TYPE STA PTEMP CLA,INA SET TYPE = LU STA TYPE3 * LDA P26 GET CHAR COUNT LDB DEBUF AND THE ADDRESS JSB DRKEY SO LOG FILE ERROR * LDA QTEMP RESTORE LIST DEVICE STA LISTU LDA PTEMP RESTORE TYPE OF LIST DEVICE STA TYPE3 * JMP LDI5 DO REST OF ERROR THING * * * EFILE NOP DSTRG DEF STRNG POINTER TO STRING BUFFER P26 DEC 26 M774K OCT 77400 B20K OCT 20000 B10K OCT 10000 * * *THE FCLOSE ROUTINE CLOSES ALL FILES OPEN TO THE *LOADR AND IGN.LES ANY ERROR RETURNS. AFTER ALL WHAT ELSE *CAN YOU DO ?? * FCLOS NOP JSB CLOS1 JSB CLOS3 JSB CLOS2 JMP FCLOS,I * CLOS1 NOP LDA TYPE1 GET THE TYPE WORD FOR THE FILE CLB,CLE STB TYPE1 CLOSE OUT THE FILE TYPE WORD ERA,SLA IS IT A FILE ? RSS YES JMP CLOS1,I NO, LOOK AT THE NEXT ONE JSB CLOSE CLOSE THE FILE DEF *+2 DEF IDCB1 JMP CLOS1,I * CLOS2 NOP LDA TYPE2 CLB STB TYPE2 CLOSE OUT FILE TYPE WORD STB DFLAG AND INTERACTIVE LU WORD ERA,SLA IS IT A FILE RSS YES JMP CLOS2,I NO JSB CLOSE YES DEF *+2 DEF IDCB2 JMP CLOS2,I * CLOS3 NOP LDA TYPE3 ERA,SLA RSS JMP CLOS3,I JSB CLOSE DEF *+2 DEF IDCB3 * CLA,INA SET UP THE STA TYPE3 NUMERIC FIELD IN THE TYPE WORD LDB TYPE2 GET THE CMND TYPE SZB,RSS IF NO COMMAND MODE JMP USEL1 USE LU 1 ERB,SLB IS IT A FILE OR AN LU ? JMP USEL1 A FILE * LDA FILE2 AN LU AND M77 KEEP ONLY LU BITS JSB INTER SEE IF IT IS INTERACTIVE RSS NOT INTERACTIVE JMP USEL2 IS INTERACTIVE USEL1 LDA MYLU# ITS NOT, SO USE START UP LU USEL2 STA LISTU AS THE LIST LU JMP CLOS3,I RETURN * * JMP CLOS3,I RETURN * DEBUF DEF EFBUF EFBUF ASC 13, FMGR-0XX ON FILE * *THE INTER SUBROUTINE DETERMINES IF THE INPUT LU# IS AN *INTERACTIVE LU OR NOT. IN ADDITION, THE LU IS CHECKED TO SEE IF *IT IS IN RANGE. IF NOT IT IS ASSUMED TO BE AN INPUT ERROR AND THE *LOAD IS ABORTED. * * * CALLING SEQUENCE : LDA LU# * JSB INTER * * RETURN P+1 IF NOT INTERACTIVE * P+2 IF INTERACTIVE * INTER NOP SZA,RSS IF BIT BUCKET JMP INTER,I ITS NOT INTERACTIVE STA ANLU# SAVE THE LU # FOR RETURN SSA IF NEG, FLUSH HIM JMP LDI5 CMA MAKE NEG ADA P64 ADD IN CORRECT RANGE SSA JMP LDI5 JSB EXEC GET THE EQT INFO ON THE LU# DEF *+6 DEF P13 DEF ANLU# DEF QTEMP EQT WORD 5 PLACED HERE DEF PTEMP EQT WORD 4 PLACED HERE DEF RTEMP SUBCHANNEL IN LOWER 5 BITS HERE * LDA QTEMP GET EQT WORD 5 AND MEQT GET THE EQT TYPE SZA,RSS IF DVR00 THEN JMP BUMPR BUMP RETURN ADDRESS * CPA M2400 IF DVR05 THEN CHECK THE SUBCHANNEL RSS CPA M3400 IF DVR07 SUBCHANNEL = 0 RSS JMP NBUMP NOT INTER ACTIVE, SO RETURN LDA RTEMP GET THE SUBCHANNEL AND M37 KEEP ONLY SUBCHANNEL BITS SZA,RSS IF = 0, THEN ITS INTERACTIVE BUMPR ISZ INTER NBUMP LDA ANLU# JMP INTER,I * MEQT OCT 37400 ANLU# NOP M2400 OCT 2400 M3400 OCT 3400 * * * * THE BREAK ROUTINE CATCHES ANY PROGRAM BREAKS AND DOES * A CLEAN TERMINATION. * BREAK NOP JSB IFBRK DEF *+1 SSA ANY BREAK INPUT ? JMP ABORT YES , SO ABORT THYSELF JMP BREAK,I NO SO JUST RETURN * PTEMP NOP QTEMP NOP RTEMP NOP SKP * * HERE WE DECIDE WHERE THE INPUT IS TO BE READ FROM. THE NEW * INPUT COULD BE FROM LG, LU, OR A FILE. SPC 2 * DMANE LDA FILE1 GET THE READ LU OR FILE # LDB TYPE1 NO SO GET THE TYPE ERB,SLB IS IT A FILE OR AN LU ? JMP F1OPN A FILE. SO LETS OPEN IT. * JSB INTER AN LU SO CHECK IT OUT. IF P1=0, RSS JMP LDI5 IOR M300 SET THE BINARY AND V BITS STA PGMIN SET NEW INPUT LU IOR B400 SET EOT CONTROL WORD STA SEOT * JSB EXEC SET EOT ON INPUT UNIT DEF *+3 DEF P3 DEF SEOT * CLA SET FLAG FOR 'LG NOT BEING USED' STA LGOU * LDRIN LDA LGOU GET 'LG USE' FLAG SZA LG BEING USED FOR INPUT ? JMP LDRN2 YES, READ FROM LG AREA. LDA TYPE1 NO, SO GET THE READ TYPE WORD ERA,SLA IS THE READ FROM AN LU OR FILE JMP RREAD A FILE SO GO READ THE NEXT RECORD. * SKP * * LOAD FROM INPUT LU * JSB EXEC DEF *+5 DEF P1 1 = READ REQUEST DEF PGMIN PROG INPUT UNIT NO. DEF L.BUF+0 L.BUF = INPUT BUFFER DEF P64 BUFFER LENGTH = 64 WORDS * AND M240 EOF OR EOT? SZA NO JMP RECLS SZB JMP TESTR JMP RECLS * * PGMIN OCT 305 SEOT OCT 705 B400 OCT 400 * * M240 OCT 240 * SPC 1 * OPENN NOP JSB OPEN OPEN THE FILE ! DEF *+8 DEF IDCB1 DCB DEF IERR1 ERROR FLAG DEFF1 DEF FILE1 ASCII FILE NAME DEF IPTN1 READ OPTION DEF F1SC SECURITY CODE DEF F1DSC CART REF # DEF IDCBS # OF BUFFER WORDS * SSA,RSS ANY ERROR IN THE READ ? JMP OPENN,I NO LDB F1 YES , GET THE FILE NAME JSB FLERR AND REPORT * * * * F1OPN JSB OPENN OPEN THE FILE FNXT1 CLA STA NAM#1 SET TO FIRST NAM IN FILE STA RSRSC DO NOT RESET AND RESCAN (AT BEGINNING) STA SXREC RESCAN POINT NOT SET YET STA #SEGS CLEAR # OF SEGMENTS ENCOUNTERED FLAG STA #NAMS CLEAR # OF NAMS FOUND WHILE SCAN TILL SEG FLAG STA YREC CLEAR THE SEGMENTED PROGRAM RESCAN POINTER STA ZREC CLEAR THE SEGMENTED PROGRAM RESCAN POINTER INA STA XREC SET RESCAN POINTER TO 1ST RECORD IN THE FILE. * SPC 1 RREAD JSB READF READ THE NEXR RECORD DEF *+6 DEF IDCB1 DEF IERR1 DEF L.BUF+0 RELOCATABLE RECORD BUFFER ! DEF P64 DEF LEN ACTUAL RECORD LENGTH READ * SPC 1 SSA,RSS ANY ERRORS ? JMP FNXT2 NO LDB F1 YES, GET THE FILE NAME JSB FLERR AND REPORT SPC 1 FNXT2 LDA LEN GET THE RECORD LENGTH READ SZA,RSS ZERO RECORD LENGTH ? JMP RREAD YES, SO TRY AGAIN SSA,RSS NO, WAS IT A NEG LENGTH ( -1 ) JMP TESTR NO, SO GO PROCESS RECORD ! * LDA FLIB THIS A FILE LIB SCAN (LI,XXXXX COMMAND) SZA,RSS WELL ? JMP NOLIB NO. * ISZ NOR.L YES, ANYTHING LOADED ? JMP RWNDL YES, SO DO IT AGAIN JMP LBRTN NO, SO GO CHECK OUT THE NEXT FILE. * SPC 1 NOLIB LDA RSCNX YES ! SZA WERE WE RESCANNING THE FILE ?? JMP NSCAN YES NOW GO RESET THE FILE BACK * LDA LBS.L IS THIS A LIBRARY SCAN ? ADA SCSEG AND NOT A SCAN TILL SEGMENT FOUND SZA,RSS WELL? JMP CK#SG NO, SEE IF ANY SEGMENTS IN THIS FILE LDA OP? CPA MS WAS THE COMMAND AN MS? JMP MSSE YES , CONTINUE CHECKING LDA OP1? DID HE SAY SE, OR SEXXXX, ? CPA ASNUL WELL JMP RECLS SE, SO DON'T LOOK FOR BACKWARD REFS MSSE ISZ NOR.L YES, WAS ANYTHING LOADED ? JMP DUMMY YES, SO DO IT AGAIN (BACKWARD REF FIX) JMP RECLS NO, SO GO CLOSE THE FILE * CK#SG LDA #SEGS GET THE # OF SEGMENTS IN THIS FILE SZA,RSS ANY ? JMP RECLS NO. * LDA #NAMS WERE THERE ANY NAMS AFTER THE SEGMENT ? CMA,INA,SZA JMP SCANW YES,SET A REG NEG * * RECLS JSB CLOS1 NO , EOF REACHED. CLOSE FILE * ISZ SKP.1 SKIP IF 1ST CMND NOT YET DONE RSS JMP SECK1 GO DO LAST COMMAND * LDA TYPE2 GET THE CMND FILE TYPE WORD. SZA IS THERE A CMND FILE ? JMP NXTOP YES, SO GO GET NEXT COMMAND * CLFL1 LDA P3 NO CNMD FILE & NO RELOC FILE. MUST BE LDB SEG.L FINISHED WITH USER INPUT. SO IF SZB THE PROG IS SEGMENTED. SET LAST SEG STA MSEGF FLAG. JMP LOADX NOW GO FINISH THE LOAD. * * F1 DEF FILE1 POINTER TO RELOC FILE BUFFER LEN NOP LENGTH OF READ OF RELO FILE ASNUL ASC 1, A BLANK OP1? NOP 2ND WORD OF SEARCH COMMAND (SEXXCH) * * * ALL FORCE LOADS COME HERE TO CLEAN UP FIX UP TABLE * * FIXCL LDA SEG.L GET THE SEGMENTED PROG FLAG SZA,RSS IS PROG SEGMENTED ? JMP NODEX NO, DON'T NEED TO CLEAN UP FIXUP TABLE. * JSB L.IFX CLEAN UP FIXUP TABLE DEF *+1 JMP NODEX GO FINISH * P13 DEC 13 LDI5 LDA ERR10 JMP ABOR * * * * * SYMBOL TABLE OVERFLOW * LOVER EQU * JSB CPRNM PRINT MODULE NAME(IF PRSENT) LDA ERR05 SET CODE EQUAL LST OVERFLOW ABOR JSB ERROR * JSB PTERR POST THE ERROR TO THE SCB DEF *+3 DEF MERR DEF ERROR (DUMMY PARAMETER) * ABORT CLA CLEAR STA PRAM+4 P5 LDA MERR PUT L- STA PRAM+3 IN P4 LDA MERR+1 AND THE STA PRAM ERROR LDA MERR+2 MESSAGE STA PRAM+1 IN P1-P3 LDA MERR+3 FOR PRTN ROUTINE STA PRAM+2 FOR RETURN MESS FOR FATHER LDA P13 LDB MES10 MES10 = ADDR "LOADR ABORTED" JMP *+1,I TERMINATE LOADER(AND THIS PROGMER) DEF LTERM (SAVE A BP LINK TOO ) * MES10 DEF *+1 ASC 7,LOADR ABORTED SKP * * INPUT FROM DISC LOAD-AND-GO AREA (SYSTEM LIBRARY SCAN ) * LDRN2 LDB XCUR IF CURRENT ADDR. OF XBUF = CPB XBUFA FWA OF XBUF, RSS READ NEXT SECTOR JMP LDRN4 DON'T BOTHER ITS IN CORE * LDRN3 LDB LGSEC CHECK CURRENT SECTOR #. CPB SECT2 IF CURRENT = LAST SECTOR, CLB,RSS SKIP JMP LDRN6 GO TO INPUT SECTOR. STB LGSEC RESET SECTOR # TO ZERO ISZ LGTRK ADD 1 TO TRACK # * READ NEXT SECTOR FROM LG AREA OR SYS LIB * LDRN6 JSB EXEC DEF *+7 DEF P1 DEF P2 DEF XBUF DEF P128 READ 2 LOGICAL SECTORS (1 PHYSICAL 7900) DEF LGTRK DEF LGSEC * ISZ LGSEC -ADD 2 FOR NEXT SECTOR. ISZ LGSEC LDA XBUFA SET STARTING BUFFER STA XCUR ADDR LDA N128 AND STA LGT1 COUNTER = -128. LDB LBOEF IS THE LIB ODD/EVEN SSB,RSS FLAG SET??? JMP LDRN4 -NO- CLA CLEAR THE STA LBOEF FLAG LDA N64 RESET COUNT FOR HALF SECTOR ONLY STA LGT1 CLA STA XCNT SET REC COUNT TO ZERO LDA XBHLF SET THE BUF ADDR STA XCUR TO THE ODD SECTOR * LDRN4 CLA IF CURRENT CPA XCNT REC COUNT = 0, RSS THEN SET FOR NEW REC. JMP LDRN5 CONTINUE WITH CURRENT REC. LDA XCUR,I GET NEXT ALF,ALF REC LENGTH (UPPER CHAR.), AND M77 SET NEGATIVE CMA,INA,SZA,RSS JMP LDRNE YES, READ NEXT SECTOR STA XCNT NO, SAVE COUNT FOR MOVE LDA ALBUF RESET ADDR OF STA LGT2 L.BUF FOR MOVE. * LDRN5 LDA XCUR,I MOVE WORD FORM XBUF STA LGT2,I TO L.BUF ISZ XCUR UPDATE BUFFER ISZ LGT2 ADDRES. ISZ XCNT INDEX NOP ISZ LGT1 COUNTERS. NOP CLA LDB XBUFA RESET ADDR OF CPA LGT1 'XBUF' IF STB XCUR END OF XBUF. CPA XCNT IF END OF REC, JMP TESTR GO TO PROCESS IT. CPA LGT1 IF END OF XBUF, JMP LDRN3 GO TO READ NEXT SECTOR. JMP LDRN5 CONTINUE WITH CURRENT REC. * N64 DEC -64 N128 DEC -128 P128 DEC 128 LDRNE LDA XBUFA WAS ZERO LENGTH REC AT CPA XCUR START OF A SECTOR? RSS JMP LDRN3 NO, READ NEW SECTOR. CCB YES, SUBTRACT 1 FROM CURR SECTOR ADB LGSEC IN CASE END OF LG ON ODD SECTOR JMP LDRN6 CHECK FOR END OF LG * SKP * * SUBROUTINES TO SAVE AND RESTORE DISC READ PARAMETERS. * * * * LGTRK NOP TRACK LGSEC NOP SECTOR LGS# NOP # SECS / TRK LGT1 NOP DOWN COUNTER IN XBUF LGT2 NOP CURRENT L.BUF ADDR XCNT NOP REC LENGTH RIC NOP REC INDICATOR SUBFD NOP SUBFIELD INDICATOR XBHLF DEF XBUF+64 ADDR OF END OF XBUF XBUFA DEF XBUF DEFINE ADDR OF XBUF XCUR DEF XBUF * * SKP * * THE SCANX ROUTINE SAVES OUR LOCATION IN THE FILE AND * THEN REWINDS THE FILE TO THE BEGINING SO THAT THE FILE * MAY BE SCANNED FOR UNDEFS. THIS ALLOWS A SUBROUTINE TO * PLACED IN THE FILE ONLY ONCE, BUT TO HAVE IT APPENDED TO * ANY SEGMENT OR MAIN THAT CALLS IT. SCANX IS CALLED WHENEVER * A SEGMENT NAM IS ENCOUNTERED IN THE FILE. WHEN THE END OF * FILE IS ENCOUNTERED THE FILE MUST ALSO BE SCANNED (IE MAY BE * THE LAST SEGMENT IN THE PROGRAM) IN THIS CASE EOF IS REACHED * INSTEAD OF THE NEXT SEGMENT. THIS IS DETECTED BY THE FILE * READ ROUTINE. IF MORE THAN ONE NAM IS ENCOUNTERED AFTER AHEN * SEGMENT BUT BEFORE THE NEXT SEGMENT OR EOF THEN THE * CONTROL IS TRANSFERED TO SCANW (A REG IS NEG). THEN #SEGS IS * MADE NEG AS A FLAG SO THAT THE NSCAN ROUTINE WILL CLOSE THE * FILE INSTEAD OF GOING OF TO DO A SYSTEM LIBRARY SEARCH. * * SCANW STA #SEGS SET FLAG FOR EOF REACHED & RESCANNING FILE CLA STA SCSEG CLEAR SCAN TILL SEG FOUND FLAG. SCANX CCA SET THE RESCAN FLAG HERE.(NOT BELOW) STA RSCNX * LDB SEG.L GET THE SEGMENTED PROG FLAG CPB P1 WE WORKING ON THE MAIN ? JMP SCFLG YES, SO FORGET ABOUT REWIND (WE GOT IT ALREADY) * LDA RSRSC OK TO RESCAN FILE SZA,RSS IF NEW FILE AND SEGMENT LOADED JMP NOSCN ELSE DON'T RESCAN * DUMMY JSB POSTX POST FILE (KLUGE FIX FOR A FMGR BUG !!!!!!) * * LDA XREC GET THE RESCAN POINTER SSA IF NEG, NO USEFUL SUBROUTINES IN THIS FILE JMP NOSCN NEG, SO DON'T BOTHER WITH RESCAN * JSB APOSN NO SO REWIND FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF XREC REC # DEF YREC REL BLOCK OFFSET WITHIN FILE DEF ZREC REL OFFSET WITHIN THE BLOCK * SSA,RSS ANY ERRORS ? JMP SCFLG NO, SO GO SET THE FLAGS DORWN LDB F1 YES JSB FLERR SO REPORT THE ERROR * SCFLG CLA NOW SET A FEW FLAGS STA SLIBF NOT SYS LIB STA LGOU NOT LG AREA CMA STA LBS.L IS A SCAN OF LIBRARY STA NOR.L NO ROUTINES LOADED STA NM1.L NAM MUST BE FIRST * LDB SEG.L GET SEG FLAG CPB P1 WORKING ON MAIN ? JMP TESTR YES, GO PROCESS THE RECORD AGAIN JMP RREAD READ THE RECORD * * * THE NSCAN ROUTINE SETS THE FILE BACK TO THE ORGINAL * LOCATION BEFORE THE SCANX ROUTINE REWOUND IT. * * NSCAN ISZ NOR.L ANYTHING LOADED LAST SCAN ?? JMP SMART SO DO IT AGAIN * LDA SXREC SET RESCAN POINT YET? SZA NO JMP APSNX YES * CCB LDA XREC GET THE POINTER TO 1ST SUBROUTINE AFTER CPA P1 FIRST SEGMENT. DID WE FIND A SUBROUTINE ? STB XREC NO, SO IN FUTURE NEVER REWIND THIS FILE * * APSNX JSB APOSN SET THE FILE BACK UP DEF *+6 DEF IDCB1 DEF IERR1 DEF IREC DEF IRB DEF IOFF * SSA ANY ERRORS ? JMP DORWN YES NOSCN CLA WE NEED TO RESET A FEW FLAGS STA LBS.L NOT A LIBRARY SCAN STA RSCNX NO LONGER RESCANNING THE FILE * LDB #SEGS GET THE # OF SEGS LOADED FLAG SSB,RSS WAS THE RESCAN DUE TO EOF OR NEW SEGMENT JMP LOADX NEW SEGMENT. SCAN SYS LIB FOR OLD SEG JMP RECLS EOF. SO GO CLOSE THE FILE . * SKP * * SMART JSB APOSN NO SO REWIND FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF XREC REC # DEF YREC REL BLOCK OFFSET WITHIN FILE DEF ZREC REL OFFSET WITHIN THE BLOCK * SSA,RSS ANY ERRORS ? JMP SCFLX NO, SO GO SET THE FLAGS LDB F1 YES JSB FLERR SO REPORT THE ERROR * SCFLX JSB POSTX KLUDGE FIX FOR FMGR BUG CLA NOW SET A FEW FLAGS STA SLIBF NOT SYS LIB STA LGOU NOT LG AREA CMA STA LBS.L IS A SCAN OF LIBRARY STA NOR.L NO ROUTINES LOADED STA NM1.L NAM MUST BE FIRST * JMP RREAD SKP POSTX NOP JSB POST DEF *+3 POST THE FILE TO CLEAR ALL OF CORE BIT IN FMGR DEF IDCB1 ALSO FIXES A FMGR BUG ! DEF IERR1 * SSA,RSS ANY ERRORS ? JMP POSTX,I NO * LDB F1 YES JSB FLERR GO REPORT * SKP * * * SAVIT SETS THE RESCAN POINT FOR A FILE. * ANY CHANGES SHOULD STILL HANDLE THE FOLLOWING CASES. * (WHERE THE FILE CONTAINS THE FOLLOWING THINGS IN THE * GIVEN ORDER). NOTE THAT SCANX ALSO CONTAINS SOME * CONDITION CHECKS. * MAIN = PROGRAM MAIN * SUB = SUBROUTINE * SEG = SEGMENT * * = PLACE THAT RESCAN POINTER SHOULD * BE SET TO. * IN THE FILES WHERE NO MAIN APPEARS, ASSUME THAT THE MAIN * WAS IN A PREVIOUS FILE. * * * ------------------------------------------------------- * ! MAIN ! SUB ! SUB ! SEG ! SUB ! SEG ! SUB ! SUB ! SUB ! * ------------------------------------------------------- * * * * -------------------------------------------------- * ! MAIN ! SEG ! SEG ! SEG ! SUB ! SUB ! SUB ! SUB ! * -------------------------------------------------- * * * * -------------- ------- * ! MAIN ! SUB ! ! SEG ! * -------------- ------- * NO RESCAN NO RESCAN * * -------------- ------------- * ! MAIN ! SEG ! ! SUB ! SEG ! * -------------- ------------- * NO RESCAN * * * ------------------------------------------- * ! SUB ! SEG ! SUB ! SUB ! SEG ! SUB ! SUB ! * ------------------------------------------- * * * * ------------------------------- * ! SEG ! SEG ! SEG ! SEG ! SEG ! * ------------------------------- * NO RESCAN * * ------------------------------------------- * ! SEG ! SEG ! SEG ! SUB ! SUB ! SUB ! SUB ! * ------------------------------------------- * * * * ------------------------------------------- * ! SEG ! SEG ! SUB ! SEG ! SUB ! SUB ! SEG ! * ------------------------------------------- * * * * ------------------------------- * ! SUB ! SUB ! SUB ! SUB ! SUB ! * ------------------------------- * NO RESCAN * * ------------------------- ------------------- * ! SUB ! SEG ! SUB ! SUB ! ! SUB ! SEG ! SEG ! * ------------------------- ------------------- * * * * * -------------------------- * ! MAIN ! SEG ! SEG ! SEG ! * -------------------------- * NO RESCAN * * ------------------------------------------- * ! SEG ! SUB ! SUB ! SEG ! SEG ! SUB ! SUB ! * ------------------------------------------- * * * * * SKP * SAVIT NOP LDA SXREC DID WE ALREADY FIND THE SZA RESCAN POINT? JMP SAVIT,I YES LDA PGT.L GET THE NAM TYPE CPA P5 SEGMENT ? JMP SAVIT,I YES, FORGET IT * * LDA RSCNX WE IN THE RESCAN MODE ? SSA,RSS YES JMP SAVIT,I NO FORGET IT * JSB POSNT OK,SO BACK UP THE FMGR POINTER BY ONE DEF *+4 DEF IDCB1 DEF IERR1 DEF N1 * SSA ERRORS JMP XYZER YES * JSB LOCF SAVE THE POSITION DEF *+6 DEF IDCB1 DEF IERR1 DEF XREC DEF YREC DEF ZREC * SSA ERRORS ? JMP XYZER YES * JSB POSNT MOVE POSITION BACK DEF *+4 DEF IDCB1 DEF IERR1 DEF P1 * SSA ANY ERRORS ? JMP XYZER YES ISZ SXREC NO, SET FLAG-RESCAN PT HAS BEEN SET JMP SAVIT,I RETURN * XYZER LDB F1 YES JSB FLERR * * IREC NOP IRB NOP RSCNX NOP 0/-1 NO RESCAN/ RESCAN OF FILE IN PROGRESS IOFF NOP LGOU NOP LG (SYS LIBRARY) IN USE FLAG #SEGS NOP #OF SEGMENTS IN THIS FILE FLAG XREC NOP RESCAN REC # YREC NOP RESCAN BLOCK OFFSET # ZREC NOP RESCAN OFFSET IN BLOCK SXREC NOP 0/NON ZERO HAVE NOT/HAVE SET UP RESCAN PT * SKP * TEST FOR VALID REC * TESTR JSB L.CLS CLASSIFY RECORD DEF *+3 DEF RIC STORE TYPE DEF SUBFD STORE SUBFIELD * CPA N1 ERROR? JMP CSERR YES-PROCESS CHECKSUM ERROR CPA N2 ERROR? JMP RCERR YES-PROCESS ILLEGAL REC TYPE ERROR * * CPA P1 TYPE=NAM? JMP NAMRX YES-PROCESS NAM REC CPA P2 TYPE=ENT? JMP ENTR YES-PROCESS ENT REC CPA P3 TPE=DBL? JMP DBLR YES-PROCESS DBL REC CPA P4 TYPE=EXT? JMP EXTR YES-PROCESS EXT REC CPA P6 TYPE=EMA? JMP EMARC YES-PROCESS EMA REC CPA P7 TYPE=ASCII? JMP LDRIN YES-IGNORE JMP ENDIT MUST BE AN END REC * * CHECKSUM ERROR. PRINT MODULE NAME * (MODULE NAME WILL BE IN MBUF IF A NAM REC * HAS ALREADY BEEN READ. OTHERWISE, IT WILL NOT * BE PRINTED SINCE IT MAY BE GARBAGED IN THE * THE NAM RECORD ITSELF. * CSERR JSB CPRNM PRINT NAME IF ANY LDA ERR01 CODE 01 = CHECKSUM ERROR JMP ABOR PRINT DIAGNOSTIC ON SYSTEM TTY & ABORT THYSELF * * * * ILLEGAL RECORD TYPE * RCERR EQU * JSB CPRNM PRINT MODULE NAME,IF GOOD LDA ERR02 CODE 02 = ILLEGAL REC JMP ABOR * * PRINT NAME OF MODULE(OR ENTRY POINT) * * CALLING SEQUENCE: * JSB PRNAM * DEF TO NAME TO BE PRINTED * * PRNAM NOP PRINT 5 CHARACTERS LDA P5 LDB PRNAM,I GET NAME ADDR ISZ PRNAM BUMP FOR RETURN JSB SYOUT PRINT MESSAGE JMP PRNAM,I RETURN * * CHECK IF GOOD REC HAS BEEN READ BEFORE * PRINT NAME. * CPRNM NOP LDA NM2.L,I GET "VALID NAME" FLAG SZA,RSS NAME READ? JMP CPRNM,I NO, EXIT LDA NM2.L SET THE DEF TO THE NAME INA GET PAST THE COUNT STA CPRN1 JSB PRNAM PRINT NAME CPRN1 NOP JMP CPRNM,I EXIT * * * SKP * * *** PROCESS END RECORD *** * * * ENDIT JSB BREAK SEE IF WE SHOULD BREAK * JSB L.REL PROCESS END RECORD DEF *+2 DEF FLAG * CPA N6 ERROR? JMP CMERR YES, PROCESS COMMON ALLOC ERROR CPA N8 ERROR? JMP NMERR YES, PROCESS REC OUT OF SEQ JMP NOCLR SKIP CLEARING OF BIT15 IN LST1 * FLAG NOP ERROR RETURNED HERE * * * COMMON ALLOCATION ERROR * CMERR JSB CPRNM PRINT MODULE NAME LDA ERR06 ELSE ERROR 06 - COMMON BLOCK JMP ABOR ERROR. * NOCLR LDA XBUFA RESET ADDR CPA XCUR IF ALREADY SET JMP NOUSE THEN NO USE CHECKING FURTHER LDB XBHLF GET THE ODD SEC BOUNDARY CMB,INB ADB XCUR IS CURRENT IN EVEN OR ODD SZB IF ZERO THEN IN LOWER HALF SSB LDA XBHLF SET FOR ODD SECTOR STA XCUR LGO BUFFER ON END REC. LDB N128 SET DOWN COUNTER TO PROPER VALUE CPA XBHLF LDB N64 STB LGT1 NOUSE CLA SET REC INDEX STA XCNT = 0 TO GET SECTOR. LDA ALBUF GET ADDR OF L.BUF ADA P3 ADJUST FOR WORD 3 OF END REC STA CURAL SET CURRENT L.BUF ADDR SKP * * * PRINT MEMORY MAP ENDKY LDA PRENT,I GET PRIMARY ENTRY POINT. SZA SKIP - PRENT NOT SET JMP ENDK1 TEST FOR DEBUG LOADED LDA PRI.L GET PRIMARY ENTRY POINT SZA,RSS ANY? JMP NOPRE NO, OMIT PRIMARY ENTRY POINT PROCESSING STA PRENT,I YES, SET IN ID SEGMENT LDB NM2.L GET ADDRESS INB INC TO PROG NAME 1,2 LDA B,I GET PROG NAME 1,2 STA NAM12,I SET IN ID SEGMENT INB INC TO PROG NAME 3,4 LDA B,I GET PROG NAME 3,4 STA NAM34,I SET IN ID SEGMENT INB INC TO PROG NAME 5 LDA B,I GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR * LDB SEG.L NOW GET THE SEGMENT LOAD FLAG ERB,ERB TO E. LDB PTYPE GET THE PROG TYPE SEZ THIS A SEGMENT OR MAIN ? LDB M25 SEGMENT, SO SET TYPE & SEG BIT. IOR B * STA NAM5,I AND SET IN ID SEGMENT. AND P7 ISOLATE PROG TYPE CPA P5 IF PROCESSING SEGMENT JMP IDSN0 THEN FORGET REMAINING PARMS LDA NM4.L,I GET PRIORITY SZA,RSS JMP CAPOK USER DIDN'S SET PRIORITY, DEFAULT 99 LDB P99 CKECK IF PRIORITY IS >,= 99 CMB,INB ADA B THEN SSA,RSS DON'T CARE IF USER IS IN SESSION JMP CAPFN LDB IADR OTHERWISE, GET SCB ADDR SZB,RSS IF IT IS 0, JMP CAPFN THEN IT IS NON-SESSION SSB JMP CAPFN IF NOT IN SESSION, CAP LEVEL IS OK JSB CAPGT IF IN SESSION, GET CAP LEVEL JSB SERPR SEARCH "PR" LEVEL IN $CMND CAPFN LDA NM4.L,I THE CAP LEVEL IS O.K. STA PRIOR,I SAVE THE PRIORITY CAPOK LDB NM4.L GET ADDRESS INB LDA B,I IF RESOLUTION SZA,RSS CODE = 0, SKIP SETTING OTHER JMP IDSN0 TIME PARAMETERS. AND P7 PUT ALF,ALF RESOLUTION ALF,RAL CODE (3 BITS) STA TEMP1 IN 15-13 INB LDA B,I AND AND M7770 EXECUTION MULTIPLE IOR TEMP1 IN 11-00 STA RESL,I ADB P3 LDA B,I GET SECONDS MPY P100 SCALE TO TMS LDB NM4.L ADB P6 ADA B,I TMS+SCALED SECONDS STA TEMP2 SAVE ADB N3 LDA B,I GET HOURS MPY P60 SCALE TO MINUTES LDB NM4.L ADB P4 ADA B,I ADD MINUTES MPY P6K SCALE TO TMS CLE SET FOR DOUBLE ADD ADA TEMP2 TMS+SCALED SECONDS SEZ WAS THERE A CARRY ? INB YES, BUMP (B) SET01 CLE,SSB JMP SET02 ADA NDAY+1 SEZ,CLE INB ADB NDAY JMP SET01 SET02 DST TMDY1,I SAVE FOR ID SEG * SKP * TEST FOR DUPLICATE PROG NAMES IDSN0 CCA STA NMFLG SET PROG NAME FLAG IDSN JSB MIDN FIND THE ID IF ONE JMP NOPRE NONE SO OK LDA P2 IF OPERATION IS REPLACEMENT CPA EDFLG RSS THEN CHECK FOR COPIES OF THE PROGRAM JMP IDSN1 ELSE BE FRIENDLY & RENAME THE PROGRAM * JSB COPY. B-REG = ID ADDR/ SEE IF ANY COPIES OF PROGRAM JMP NOPRE WE GOT BACK ! MUST NOT BE ANY COPIES. * IDSN1 LDB NM2.L GET ADDRESS INB INC TO NAME LDA B,I GET THE NAME STA MESS7+12 AND PUT IN DUPLICATE PROG INB LDA B,I NAME MESSAGE BUFFER STA MESS7+13 INB LDA B,I STA MESS7+14 LDA P27 LDB MESS7 MESS7 = ADDR: DUPLICATE PROG NAM JSB SYOUT PRINT: DUPL. PROG NAME ISZ NMFLG SKIP - TRY RESETTING PROG NAM JMP IDSN2 INVALID RESET PROG NAME LDA RENAM GET ASCII '##' LDB NM2.L GET ADDRESS INB SET TO NAME STA B,I SET PROG NAME 1,2 = '..' STA NAM12,I IN BOTH COPIES. LDA P8 LDB WNG32 NOW SEND A WARNING MESSAGE JSB SYOUT JMP IDSN REPEAT DUPLICATE PROG NAME SCAN * IDSN2 LDA ERR32 GET ERROR MESSAGE & JMP ABOR ABORT THYSELF. SPC 1 WNG32 DEF *+1 ASC 4,W-DU PGM P27 DEC 27 M25 OCT 25 M7770 OCT 7777 TEMP1 NOP TEMP2 NOP RENAM ASC 1,.. MESS7 DEF *+1 ASC 14,DUPLICATE PROG NAME - * * THIS SUBROUTINE SEARCH FOR THE "PR" IN THE SESSION $CMND TABLE. * AND ALSO CHECK THE CAPABILITY LEVEL. * SERPR NOP XLA $CMAD GET THE ADDR OF TESTER ADA P2 ADVANCED TO END OF CMND SEARCH XLB A,I FETCH THE WORD STB STOP SAVE THE STOP ADDRESS * CAP2 INA ADVANCED TO FIRST(NEXT) LEVEL XLB A,I FETCH CAP LEVEL (NEG. #) INA POINT AT START ADDR FOR THIS LEVEL ADB LCAP COMPARE TO USERS LEVEL SSB IF USER LEVEL IS LOWER JMP CAP2 GO TO TRY NEXT ONE * * FOUND START SEARCH ADDR (IN THE A REG) * XLB A,I NXCMD XLA B,I FETCH CMND CPA PR IS PR CMND ? JMP SERPR,I YES- LET THEM DO IT ADB P2 NO- ADVANCE TO NEXT ONE CPB STOP END OF TABLE? JMP CPER1 YES- GIVE WARNING AND FORCE TO 99 JMP NXCMD NO - GO TO NEXT CMND * * * GIVE WARNING MESSAGE IF NOT FOUND "PR" IN THE CMND TABLE * CPER1 LDB NM2.L INB LDA B,I PUT THE NAME IN THE STA MESS6+14 WARNING MESSAGE INB LDA B,I STA MESS6+15 INB LDA B,I STA MESS6+16 LDA P31 READY TO PRINT OUT LDB MESS6 THE WARNING MESSAGE JSB SYOUT LDA ERR23 JSB ERROR AND IN-CAP ERROR MESSAGE JSB SPACE JMP CAPOK FORCE PRIOR 99, GO BACK * PR ASC 1,PR LCAP NOP USER CAPABILITY LEVEL IADR NOP SCB ADDR STOP NOP CMND TABLE STOP ADDR MESS6 DEF *+1 ASC 16,FORCE PROG PRIORITY 99 - * * SPC 1 ENDK1 JSB DEBUG TEST FOR DEBUG LOADED NOPRE LDA IGN.L SZA IF LAST SCAN USEFUL JMP SLTST STA TRY2 THEN CLEAR 2ND TRY ALLOWED FLAG JSB PRMAP THEN PRINT MEM MAP SPC 1 * SLTST CLA CLEAR "VALID NAME" FLAG STA NM2.L,I LDA SLIBF GET DISC LIB LOAD FLAG SZA LOADING SYSTEM LIB ? JMP RSET? YES, CHECK ON NEXT OPERATION. * * LDA SEG.L IS THIS A SEGMENTED PROGRAM ? CPA P2 WELL ? RSS YES JMP LDRIN NO,GET NEXT RECORD * LDA PGT.L THIS MODULE A SEGMENT ? CPA P5 WELL ? RSS YES JMP LDRIN NO, GO GET THE NEXT RECORD. * LDA LBS.L WE, SCANNING AT THE MOMENT ? SZA WELL ? JMP LDRIN NO, GET THE NEXT MODULE * CCA SET THE LIBRARY SCAN FLAG STA LBS.L CLA,INA SET THE SCAN TILL NEXT SEGMENT FLAG STA SCSEG JMP LDRIN GO GET THE NEXT SEGMENT * * NMFLG NOP PROG NAME FLAG COMIN NOP COMMON DECLARATION FLAG MESS9 DEF COM ACOM3 DEF COM+3 ACOM6 DEF COM+6 COM ASC 9,COM SKP * * * PROCESS EMA RECORD. * * EMARC JSB L.REL PROCESS EMA RECORD DEF *+2 DEF FLAG * CPA N10 ERROR? JMP LL19 YES PROCESS EMA DEC. TWICE OR IN A SEG ERROR * CPA N5 ERROR? JMP LOVER YES, SYMBOL TABLE OVERFLOW. * CPA N8 ERROR? JMP NMERR YES, RECORD OUT OF SEQUENCE * LDB #PGS *E SZB ANY SPECIFIED SIZE GIVEN? JMP NOPG1 YES, CHECK AGAINST 32K MAX * LDA MSG.L GET THE MSEG SIZE INA ACCOUNT FOR I/O OVERFLOW CPA P1 IF JUST 1 INA THEN SET MIN MSEG SIZE ALF,ALF NOW ADJUST TO # OF PAGES RAL,RAL CMA,INA & SET NEW UPPER BOUNDS FOR CODE ADA B7777 SPACE STA LWA JMP NOPG *E * NOPG1 LDA URFWA GET LOAD PT IN # PGS ALF *E RAL,RAL CONVERT TO # PAGES ADA B ADD # OF PAGES SPECIFIED LDB MSG.L *E INB ACCOUNT FOR I/O OVERFLOW PAGE CPB P1 DEFAULTED EMA? INB YES, BUMP FOR MINIMUM SIZE ADA B (A) = # PAGES REQUIRED CMA,INA WITH EXTRA BP INA TAKE OUT EXTRA BP ADA D32 SUBTRACT FROM 32K LOGICAL SSA EXCEEDED 32K? JMP ER.18 YES. * NOPG JSB BLKID GO COUNT ID SEGS LDA BID9 SEE IF THERE ARE ANY SZA,RSS ID EXTENSIONS JMP LL20 IF NOT ABORT THYSELF JMP LDRIN GET THE NEXT RECORD * LL19 LDA ERR19 JMP ABOR ER.18 LDA ERR18 JMP ABOR LL20. JSB $LIBX RETURN FROM PRIV PROCESSING DEF *+1 DEF *+1 LL20 LDA ERR20 JMP ABOR B7777 OCT 77777 * * * * WHEN LOADING AND A TYPE 5 NAM IS ENCOUNTERED * THEN CONTROL TRANSFERS HERE. ALL RELOCATABLE READ * POINTERS ARE SAVED AND THE SYSTEM LIBRARY IS SCANNED * FOR THE LAST MAIN OR SEGMENT. * * SEOF LDA SEG.L GET THE SEGMENT LOADING FLAG SZA,RSS IS IT SET ? ISZ SEG.L NO, SO SET IT. CLA RESET THE SCAN TILL SEGMENT FLAG STA SCSEG LDB SGM.L GET THE SEGMENT BASE ADDRESS CPB TH1.L IF SAME AS CURRENT SEGMENT THEN JMP NAMR3 LAST SEGMENT LOADED. THIS IS NEW ONE * * ISZ #SEGS INCREMENT THE # OF SEGMENTS ENCOUNTERED FLAG LDA N60 GET NEG COUNT JSB MOVE DEF L.BUF+0 SOURCE OF MOVE DEF SGNAM DESTINATION (SEGMENT NAM BUFFER) * LDA TYPE1 GET THE INPUT TYPE WORD ERA,SLA WHERE IS THE INPUT FROM ? RSS A FILE JMP LOADX SO FOR GET ABOUT ANY RESCAN * JSB LOCF OK SO SAVE OUR POSITION IN THE FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF IREC RECORD # IN FILE USED IN JUST A SECOND DEF IRB DEF IOFF * SSA,RSS ANY ERRORS ? JMP *+3 NO * LDB F1 GET THE FILE NAME JSB FLERR AND REPORT * JMP SCANX RESCAN THE FILE * RRSCN NOP 0/-1 NO FILE RESCAN/ALLOW RESCAN ON UNDEFS RSCAN NOP 0/1 NO/YES VARY SYS LIB SCAN SEQUENCE SCSEG NOP 0/1 NO/YES SCAN TILL SEGMENT FOUND #NAMS NOP # OF NAMS FOUND WHILE SCAN FOR NEXT SEG. RSRSC NOP 0/-1 NOT OK/OK TO RESCAN FILE * * * NAMR3 CCA SET FLAG TO STA RSRSC OK TO RESCAN FILE JMP NAMR1 NOW * * SKP * PROCESS NAM REC NAMRX LDA LBS.L IF SCANNING TILL NEXT SEG,THEN ADA SCSEG LOOK AT THE SEG ELS IF JUST SZA SCANNING LIB JMP NAMR1 THEN AVOID SEGMENT LOOKUP. LDB L.BUF+9 GET THE NAM TYPE CPB P5 IF SEGMENT JMP SEOF SEE IF THIS FIRST ONE & SAVE NAM BUFFER SPC 1 * NAMR1 LDA SCSEG IS THIS A SCAN TILL SEG FOUND OPERATION ? SZA WELL ? ISZ #NAMS YES, SO COUNT THE NAMS * JSB L.REL PROCESS THE NAM RECORD DEF *+2 DEF FLAG * CPA N8 ERROR? JMP NMERR PROCESS REC OUT OF SEQ ERROR CPA N6 ERROR? JMP CMERR PROCESS COMMON BLOCK ERROR CPA N3 ERROR? JMP LGERR PROCESS MEM OVERFLOW ERROR * * LDA L.BUF+8 GET COMMON LENGTH SZA,RSS SKIP - HAS COMMON JMP CKSUB NO COMMON, CHECK FOR SEGMENT LOAD LDB LBS.L IF THIS IS A LIBRARY SCAN SZB THEN CHECK COMMON ALLOC AT THE END REC JMP CKSUB ISZ COMIN YES, HAS COMMON. SKIP IF FIRST & LOCAL. JMP CKSUB ASSUME COMMON OK TILL 'END' IS READ LDA CAD.L PUT FWA OF COMMON INTO A REG LDB ACOM3 GET ADDR OF COMMON MSG (LOW) JSB CONVD CONVERT LOWER COMMON BOUND LDA TH1.L GET LOW PROG BOUND ADA N1 ACTUAL LWA COMMON LDB ACOM6 GET ADDR OF COMMON MSG (HI) JSB CONVD CONVERT UPPER COMMON BOUND LDA PLIST GET LIST/NO LIST FLAG SLA SKIP TO LIST MEMORY BOUNDS JMP CKSUB OMIT LISTING, TEST COM BOUNDS. LDA P18 LDB MESS9 ADDR OF COMM BUF JSB DRKEY LIST COMMON BOUNDS JMP CKSUB COMMON DECLARATION IS OK * * MEMORY OVERFLOW ERROR * LGERR JSB CPRNM PRINT MODULE NAME LDA ERR03 03 = MEMORY OVERFLOW JMP ABOR * * RECORD OUT OF SEQUENCE * NMERR JSB CPRNM PRINT MODULE NAME(IF ANY) LDA ERR09 09 = REC OUT OF SEQUENCE JMP ABOR * * CKSUB JSB SAVIT YES, SO LOOK FOR REWIND POINT LDA NAM#1 1ST NAM IN FILE SZA YES JMP LDRIN NO, GET NEXT REC CCB RESET STB NAM#1 SO WE KNOW WE DID IT LDA PGT.L GET TYPE SZA,RSS IF ZERO ISZ #NAMS INC #NAMS CMA,INA ELSE MAKE IT NEG ADA P5 ADD 5 SSA IF WAS GREATER THAN 5 ISZ #NAMS INC #NAMS JMP LDRIN GET THE NEXT RECORD * NAM#1 NOP 0/-1 1ST NAM IN FILE/NOT 1ST NAM IN FILE P100 DEC 100 P60 DEC 60 P6K DEC 6000 M37 OCT 37 SKP * * READ DISK REC TO DBUF * * THE DREAD SUBROUTINE READS A DISK REC (1 SECTOR) TO DBUF. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DREAD * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DREAD NOP JSB EXEC REQUEST DISK READ DEF *+7 DEF P1 READ REQUEST CODE DEF DSKUN DISK LOGICAL UNIT NO. ADBUF DEF DBUF ADDR OF DISK I/O BUFFER DEF P128 NO. WORDS DEF DTRAK DISK TRACK DEF DSECT DISK SECTOR JMP DREAD,I RETURN SPC 2 * * WRITE DBUF TO DISK * * THE DWRIT SUBROUTINE WRITES THE CURRENT REC ON THE DISK. * THE ADDRESS OF THE REC IS CONTAINED IN DISKO * AND THE LENGTH OF THE REC IN DLGTH. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DWRIT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DWRIT NOP JSB EXEC REQUEST DISK WRITE DEF *+7 DEF P2 WRITE REQUEST CODE DEF DSKUN DISK LOGICAL UNIT NO. DEF DBUF ADDR OF OUTPUT BUFFER DEF P128 BUFFER LENGTH DEF DTRAK DISK TRACK DEF DSECT DISK SECTOR JMP DWRIT,I RETURN * * * * * TEST AND SET FOR DEBUG CONTROL * * DEBUG TESTS IF THE CURRENT PROG LOADED WAS DEBUG. IF IT WAS, * THE PRIMARY ENTRY POINT OF THE PROG IS SET INTO * 'DEBUG', THE PRIMARY ENTRY POINT OF DEBUG IS SET INTO THE * ID SEGMENT, AND THE ADDR OF DEBUG IS SET TO BE INDIRECT. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DEBUG * * RETURN: CONTENTS OF A AND B ARE DESTROYED,. * DEBUG NOP LDA DBFLG IS DEBUG ALLOWED ? SZA,RSS WELL ? JMP DEBUG,I NO, SO FORGET IT * LDA IGN.L YES SO SEE IF THIS MODULE IS DEBUG SZA IF LAST SCAN WAS USELESS JMP DEBUG,I THEN DON'T LOOK FOR MATCH LDB NM2.L INB LDA B,I GET PROG NAME 1,2 CPA DB1 CHARS = D,B? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' INB LDA B,I GET PROG NAME 3,4 CPA DB2 CHARS = U,G? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' INB LDA B,I GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR CPA DB3 CHAR = R? RSS YES - CONTINUE JMP DEBUG,I RETURN - PROG IS NOT 'DEBUG' * CLA,INA SET A REG TO ONE STA MORS SET FOR SEGMENT * * JSB L.ADD FIND DEBUG IN SYMBOL TABLE DEF *+5 MAKE IT 6 WHEN ADD MORS DEF CHRDE DEF VALU VALUE OF SYMBOL DEF SADD LST ENTRY ADDR * DEF MORS SEGMENT DEF RSLT * * LDA RSLT CPA P1 NOT FOUND? HLT 0 .DBUG NOT FOUND IN LST CPA P2 UNDEFINED? HLT 0 .DBUG UNDEFINED LDA PRENT,I THE PROG OR SEG PRIMARY ENT PT LDB VALU AND PUT IT INTO ENTRY POINT * JSB OUTAB 'DEBUG'(ON THE DISC) DEF *+3 DEF *+2 DUMMY DEFS TO FAKE OUT DEF *+1 OUTAB * LDA CURAL,I GET DEBUG TRANSFER ADDR ADA TH1.L ADD CURRENT PROG RELOCATION ADDR STA PRENT,I SET 'DEBUG' TRANSFER IN ID SEG. * JMP DEBUG,I RETURN * MORS NOP MAIN/SEG 0/1 VALU NOP VALUE OF SYMBOL SADD NOP LST ENTRY ADDRESS DB1 ASC 1,DB DB2 ASC 1,UG DB3 OCT 51000 R DB1X ASC 1,.S ASC 1,TD OCT 41000 * * PROCESS ENT,EXT RECS * ENTR EQU * ENT REC PROCESSOR EXTR JSB L.REL PROCESS ENT AND EXT RECORDS DEF *+2 DEF FLAG * * CPA N10 ERROR? JMP LL19 YES,EMA DECLARED 2 TIMES OR IN A SEG CPA N7 ERROR? JMP DEERR YES,DUPLICATE ENTRY POINT CPA N5 ERROR? JMP LOVER YES,SYMBOL TABLE OVERFLOW CPA N9 ERROR? JMP ORD? ASM PRODUCED ILLEGAL REC CPA N8 ERROR? JMP NMERR YES, REC OUT OF SEQUENCE JMP LDRIN GET NEXT REC * * DUPLICATE ENTRY POINT * DEERR JSB CPRNM PRINT MODULE NAME LDB TSY.L GET CURRENT SYMBOL TABLE ENTRY ADB N5 BACK UP ONE ENTRY LDA B,I GET CURRENT SYMBOL RAL,CLE,ERA CLEAR SIGN BIT STA TBUF STORE 1ST 2 LETTERS INB LDA B,I STORE 3RD AND 4TH LETTERS STA TBUF+1 IN TEMP INB LDA B,I STORE 5TH LETTER STA TBUF+2 IN TEMP JSB PRNAM PRINT ENTRY POINT NAME DEF TBUF LDA ERR07 07 = DUPLICATE ENT JMP ABOR * * * N5 DEC -5 * * SKP * PROCESS DBL REC DBLR ISZ DBLFL SKIPS ONLY ON 1ST DBL REC OF A SEGMENT JMP DBL0 LDA L.BUF+3 GET THE RELOCATION BASE FOR 1ST WORD ADA TH2.L ADD THAT TO THE HIGH +1 SO FAR STA TH2.L SO THAT BSS'S IN SEGMENTS AREN'T ZEROED STA FWA SET NEW FWA FOR LOAD OPERATION * DBL0 JSB L.REL PROCESS DBL RECORD DEF *+2 DEF FLAG * * CPA N2 ERROR? JMP RCERR YES, ILLEGAL REOCRD CPA N9 ERROR? JMP ORD? ASMB PRODUCED ILLEGAL RECORD CPA N11 ERROR? JMP LL27 YES, ATTEMPT TO REF EMA EXT WI/ OFFSET OR INDIRECT CPA N8 ERROR? JMP NMERR YES, RECORD OUT OF SEQUENCE CPA N4 ERROR? RSS YES, FIXUP TABLE OVERFLOW * JMP LDRIN GET NEXT RECORD * * FIXUP TABLE OVERFLOW JSB CPRNM PRINT MODULE NAME LDA ERR12 FIXUP TABLE OVERFLOW ERROR JMP ABOR GO ABORT * * SKP * *********** LIBRARY FILE SCAN MODULE ************ * * LOADX CLB STB PNTR INITIALIZE FOR L.LUN INB LDA SEG.L IF MAIN SET TO 1 CPA P2 ADB N1 IF SEG SET TO 0 STB MORS * JSB L.LUN ANY UNDEFINED? DEF *+4 DEF SADD DEF PNTR DEF MORS * SZB,RSS JMP LOADQ NO - GO LOOK FOR PRIMARY ENT JSB LIBSC YES - GO SCAN FOR LIBRARIES JMP LOADQ GO SCAN SYSTEM LIBRARY * * SKP LIBSC NOP LDA START,I ANY LIBRARIES TO SEARCH ? SZA,RSS WELL ? JMP LIBSC,I NO, SO FORGET THE WHOLE THING. * * * LIBRARY FILE(S) EXIST * * LDB TYPE1 OK, BUT IS THERE ALSO A CURRENT INPUT STB SVTP1 FILE THAT WE ARE RELOCATING ? SZB,RSS WELL ? JMP LOADK NO INPUT FILE, BUT A LIBRARY FILE EXISTS. * * *********** LIBRARY EXISTS BUT WE HAVE AN INPUT FILE OPEN ************ * * ERB,SLB FILE OR LU OPEN ? RSS FILE. JMP LOADK LU. * JSB CLOS1 CLOSE THE INPUT FILE SSA,RSS ANY ERRORS ? JMP LOADK NO LDB F1 YES JSB FLERR * * ****** SET UP FOR LIBRARY SCAN ******** * * * LOADK LDA START GET THE 1ST LIB FILE PARAMETERS STA F1 SET INTO ERROR FLAG STA INCX AND THE OPEN CALL ADA P3 SET SEC CODE & CART ALSO STA INCY INA STA INCZ * NXLIB JSB OPEN OPEN THE LIB FILE DEF *+8 DEF IDCB1 DEF IERR1 INCX NOP NAME DEF IPTN1 NONEXCLUSIVE OPEN INCY NOP SECURITY CODE INCZ NOP CART REF DEF IDCBS # OF WORDS TO USE * LDB P3 SET FILE IN USE FLAG STB TYPE1 * SSA,RSS ANY ERRORS JMP STFLG NO, GO READ THE RELO CODE. LDB F1 YES, JSB FLERR GO SEND ERROR MESSAGE * RWNDL JSB POSTX FIX FOR FMGR BUG JSB APOSN REWIND THE FILE DEF *+6 DEF IDCB1 DEF IERR1 DEF P1 DEF ANOP DEF ANOP * SSA,RSS ANY ERRORS JMP STFLG NO * LDB F1 YES JSB FLERR * STFLG CCA SET FLAGS STA LBS.L LIB SCAN STA NOR.L NO ROUTINES LOADED STA NM1.L NAM MUST BE FIRST STA FLIB SET THE FILE LIB SCAN FLAG CLA STA LGOU LG AREA NOT IN USE STA SLIBF NOT A SYS LIB SCAN JMP RREAD HOP TO IT ! * * LBRTN JSB CLOS1 CLOSE THE FILE SSA,RSS ANY ERRORS JMP *+3 NO. LDB F1 YES JSB FLERR SEND ERROR * CLB STB PNTR INITIALIZE FOR L.LUN INB LDA SEG.L IF MAIN SET TO 1 CPA P2 ADB N1 IF SEG SET TO 0 STB MORS * JSB L.LUN ANY UNDEFINED? DEF *+4 DEF SADD DEF PNTR DEF MORS * SZB,RSS JMP LOADW NO JUMP TO LOADW * LDA INCX YES -SET UP NEXT LIBRARY ADA P5 LDB A,I IS THERE A NEXT LIB ? SZB WELL ? CPB END WELL ? JMP LOADW NOPE. * STA F1 SET ERROR POINTER & STA INCX SET UP THE OPEN CALL LDA INCY ADA P5 STA INCY * LDA INCZ ADA P5 STA INCZ * JMP NXLIB GO GET 'EM ROVER ! * ANOP NOP * LOADW CLA LIB SCAN DONE STA FLIB * LDA DEFF1 SET ORGINAL F1 BACK UP STA F1 * LDA SVTP1 GET THE OLD TYPE WORD . STA TYPE1 & RESET SZA,RSS WAS A PREVIOUS FILE OPEN ? JMP LIBSC,I NO, SO RETURN * ERA,SLA YES, FILE OR LU RSS FILE JMP LIBSC,I LU SO RETURN * JSB OPENN OPEN THE ORGINAL FILE JSB APOSN POSITION FILE TO CORRECT DEF *+6 DEF IDCB1 AREA DEF IERR1 DEF IREC DEF IRB DEF IOFF * SSA,RSS ANY ERRORS JMP LIBSC,I NO, SO RETURN * LDB F1 GET THE FILE NAME JSB FLERR REPORT THE ERROR * * * * START DEF LIBRY LIBRY BSS 5 LIBRARY FILE 1 BSS 5 LIBRARY FILE 2 BSS 5 LIBRARY FILE 3 BSS 5 LIBRARY FILE 4 BSS 5 LIBRARY FILE 5 BSS 5 LIBRARY FILE 6 BSS 5 LIBRARY FILE 7 BSS 5 LIBRARY FILE 8 BSS 5 LIBRARY FILE 9 BSS 5 LIBRARY FILE 10 END DEF * END OF LIBRARY AREA SKP * * * LOAD FROM PROG LIB * LOADQ LDA TYPE1 SEE IF THERE STILL A FILE OPEN. ERA,SLA IF THERE IS RSS (THERE IS) JMP LOADZ (THERE ISN'T) * POSTR JSB POSTX THEN THIS MUST BE A SEGMENTED PROGRAM * AND WE ARE GOING TO DO A LIB SCAN. * IF WE CALL POST THEN WE CAN USE THE * 256 WORDS AS BUFFER SPACE FOR THE SCAN. * * LOADZ LDA PRENT,I GET PRIMARY ENTRY POINT SZA SKIP - NO PRIMARY ENTRY POINT JMP LOADN LOAD FROM PROG LIB LDA ERR08 CODE 08 = NO TRANSFER ADDR JMP ABOR AND ABORT THYSELF LOADN CCA SET FLAG STA SLIBF FOR 'LOADING FROM SYS LIB' STA LBS.L 'SCANNING LIB' STA LGOU DUMMY UP 'LG BEING USED' FLAG STA LSTBK SET UP POINTERS TO DISC LIB SUCH LDB SYSLN GET THE START OF USER ENTS STB DCNT LDA PLIST GET LIST/NO LIST FLAG SLA,RSS SKIP LISTING ? JSB SPACE NO, THEN SPACE OVER. JMP RSET? GO FIGURE OUT THE NEXT MOVE * * * COMMAND IS TRANSFERED HERE IF AFTER A SYS LIBRARY * SCAN NO MORE UNDEFINED EXTERNALS EXIST. SPC 1 * RNDEX LDA SEG.L GET THE SEGMENTED PROG FLAG SZA ARE WE SEGMENTED ? JMP SEGT YES LDA TYPE2 NO, GET THE CMND FILE TYPE SZA IS THERE A COMMAND FILE ? JMP NXTOP YES SO GET THE NEXT COMMAND JMP NODEX NO, SO GO FINISH LOAD. * SEGT LDA TYPE2 GET THE CMND FILE FLAG WORD SZA,RSS IS THERE A COMMAND FILE JMP NODEX NO, MIGHT BE END OF LOAD LDA SKP.1 GET THE SE RE EXECUTED FLAG SSA HAVE WE DONE ANY OF THESE YET JMP NODEX NO, SO FINISH LOAD LDA OP? YES, GET THE LAST OPCODE CPA SE WAS IT AN SE ? JMP NXTOP YES, MUST HAVE BEEN AN SE,< > COMMAND CPA MS WAS IT AN MS? JMP NXTOP MUST HAVE BEEN AN MS,<> COMMAND JMP NODEX NO, WE NEED TO FINISH THE SEGMENT LOAD * * * SKP * * SCAN THE DIRECTORY OF ENTRY POINTS * SYLOK NOP LDA DCNT CPA #ENTS IF NO MORE SYMBOLS JMP EMPTY THEN RETURN WITH NO MATCH ISZ DCNT BUMP TO NEXT ENT JSB GTENT GET NEXT ENT * CLB IF MAIN MORS = 0 LDA SEG.L ELSE CPA P2 IF SEG INB MORS = 1 STB MORS * JSB L.ADD SEE IF IN SYMBOL TABLE DEF *+5 MAKE IT 6 WHEN ADD MORS DEF TBUF NAME DEF VALU VALUE DEF SADD * DEF MORS FOR LATER OPTIMIZATION DEF RSLT * LDA RSLT CPA P2 FOUND AND UNDEFINED? JMP GTSUB YES JMP SYLOK+1 NO,CHECK NEXT SYMBOL * * GTSUB LDA TBUF+3 (GET THIS SUB) GET SYMBOL TYPE. CPA P1 IF NOT FIXED JMP GTSU GO SET UP TO LOAD * SZA IS IT MEM RES ? JMP GTMEM NO, AN RP OR ABS LDB SSGA NOW SEE IF SSGA CPB P1 ACCESS IS ALLOWED. JMP GTMEM IT IS. LDA TBUF+4 CMA NO. SO IF THE ADDRESS XLB $DLP IS ABOVE START OF COMMON ADA B SSA,RSS THEN CHECK FURTHER JMP GTMEM ELSE CONTINUE XLB $COML GET LENGTH OF COMMON BLF,BLF CONVERT TO PAGES RBL,RBL ADA B ADD TO CURRENT LOCATION SSA,RSS IF POS, THEN THE ENT IS IN COMMON JMP LL24 AND ITS AN ERROR. * GTMEM JSB L.MAT FIX ALL REFERENCES DEF *+5 DEF TBUF SYMBOL NAME DEF TBUF+3 SYMBOL TYPE DEF TBUF+4 SYMBOL VALUE DEF RSLT * JMP SYLOK+1 CHECK NEXT SYMBOL * * GTSU LDA TBUF+4 GET DISC ADDR OF LIB SUB ALF,ALF RAL SET UP DISC ADDRES IN LG READ ROUTINE AND M377 STA LGTRK SET TRACK ADDR LDA TBUF+4 AND M177 SECTOR ADDR CLB,CLE ERA,RAL ERB STB LBOEF SET LIB ODD/EVEN FLAG STA LGSEC LDA XBUFA STA XCUR CLA STA LGT1 STA LGT2 STA XCNT RSS (P+1) RETURN FOR MATCH FOUND EMPTY ISZ SYLOK CCA STA IGN.L STA NM1.L STA NOR.L JMP SYLOK,I (P+2) RETURN FOR NO MATCH * * DCNT NOP CURRENT DBUF COUNT SSGA NOP 0/1 USE / DON'T USE SSGA RSLT NOP * LL24 JSB PRNAM PRINT EXTERNAL NAME DEF TBUF LDA ERR24 JMP ABOR * SKP * * * GTENT - ROUTINE TO GET AN "ENT" OFF THE DIRECTORY IN THE * SYSTEM LIBRARY. BEFORE IT IS CALLED, SECT# MUST BE SET TO * THE 15 BIT DISC ADDR IN BLOCKS. "OFLE1" MUST BE SET TO * 0 OR 16, DEPENDING IF THE DIRECTORY STARTS IN AN EVEN OR * ODD SECTOR. CALLED: * LDA ENT# THE ENTRY NUMBER ON LIB. * JSB GTENT 4 WORD ENT IN TBUF 1-4. * GTENT NOP ENTRY A-REG = ENT NUMBER ADA OEFL1 ADJUST FOR POSS. ODD SECTOR CLB DIV P32 DETERMINE THE RELETIVE BLOCK ADA BLOK# NOW THE ABS BLOCK # BLS,BLS BUMP TO REL WORD IN BLOCK ADB ETBFA BUFFER STB IOFFS SET PNTR CPA LSTBK HAS BLOCK NUMBER CHANGED? JMP GTNT1 NO, CONTINUE STA LSTBK YES, UPDATE BLOCK BUFFER JSB READD READ LU=2 OFF DISC LDB IOFFS GET INDEX INTO BUFFER GTNT1 LDA B,I GET 1ST WORD STA TBUF AND PUT IN TBUF 1- 5 INB LDA B,I GET 2DN WORD STA TBUF+1 INB LDA B,I GET 3RD WORD AND M7400 GET 5TH CHAR STA TBUF+2 XOR B,I GET LO BYTE STA TBUF+3 AND PUT IN 4TH WORD INB LDA B,I GET 4TH WORD STA TBUF+4 AND PUT IN 5TH WORD JMP GTENT,I RETURN DONE SPC 1 P32 DEC 32 * * * SUBROUTINE TO READ A DIRECTORY BLOCK (128 WORDS) * SPC 1 READD NOP ENTRY B=BUFFER ADDR CLB A=ABS BLOCK NUMBER ALS MPY BY 2 FOR 64 WORD SECTS DIV SECT2 BY THE NUMB SECTS / TRACK STA GTNT2 SAVE TRACK # STB GTNT3 AND SECTOR NUMBER JSB EXEC READ DISC LU=2 DEF *+7 DEF P1 DEF P2 LU = 2 FOR SYSTEM DISC ETBFA DEF SBUF DEF P128 WORDS DEF GTNT2 DEF GTNT3 JMP READD,I SPC 1 LSTBK DEC -1 IOFFS NOP GTNT2 NOP GTNT3 NOP #ENTS NOP TOTAL # OF ENTS IN SYSTEM SPC 1 * * SLIBF NOP * * * * SKP * * SET UP DISC ADDRESSES , SECTOR OFFSET AND SYMBOL * COUNT TO SCAN DIRECTORY FROM START. * CSUBR NOP CLB STB PNTR INITIALIZE INB LDA SEG.L IF MAIN SET TO 1 CPA P2 ELSE IF SEG SET TO 0 ADB N1 STB MORS * JSB L.LUN ANY UNDEFINED ? DEF *+4 DEF SADD DEF PNTR DEF MORS * SZB,RSS JMP RNDEX NO JMP CSUBR,I RETURN * PNTR NOP POINTER INTO SYMBOL TABLE.LIB WILL UPDATE * * SCAN OF THE SYSTEM LIBRARY STARTS HERE. ALL SYSTEM * ROUTINES LOADED RETURN HERE AFTER THE END RECORD IS * PROCESSED. * RSET? CLB STB PNTR INITIALIZE INB LDA SEG.L IF MAIN,SET MORS TO 1 CPA P2 ADB N1 ELSE IF SEG, SET MORS TO 0 STB MORS * JSB L.LUN ANY UNDEF? DEF *+4 DEF SADD DEF PNTR DEF MORS * SZB,RSS JMP RNDEX NO EXIT LOOP * JSB SYLOK SCAN DIRECTORY JMP LDRN2 MATCH FOUND - GET THIS SUB * LDB SYSLN SET UP FOR LIBRARY SCAN STB DCNT START OF THE SCAN JSB CSUBR INITIALIZE LST & ANY UNDEF ? JSB SYLOK SCAN DIRECTORY JMP LDRN2 MATCH FOUND - GET THIS SUB CLB STB DCNT SET START OF SCAN=0 JSB SYLOK SCAN DIRECTORY JMP LDRN2 MATCH FOUND- GET THIS SUB JSB CSUBR TAKE ONE LAST LOOK AT THE SYM TABLE * * SPC 1 * CONTROL IS TRANSFERED HERE WHEN THE ENTIRE SYS LIB HAS BEEN * SCANNED AND UNDEFINED EXTERNALS REMAIN. WE NOW DECIDE WHAT * TO DO WITH THE UNDEFS. * CAN GET HERE UNDER THE FOLLOWING CONDITIONS : * 1. LOADING MAIN & SEG ENCOUNTERED. * 2. LOADING SEG & NEXT SEG ENCOUNTERED. * 3. SE,<> COMMAND * 4. END OF RELOC INPUT FROM LU OR FILE & NO COMMAND FILE. * * DNON1 LDA TYPE2 NO, IS THERE A COMMAND FILE OPEN? SZA IS THERE ? JMP SE..? YES SEE WHAT LAST COMMAND WAS DNON2 LDA SEG.L IS THE PROG SEGMENTED ? SZA,RSS WELL? JMP FLUSH NO, FLUSH THE TURKEY !!! ISZ RRSCN DO WE RESCAN THE ENTIRE FILE ? RSS NO JMP SCANX YES * CPA P1 IS THIS THE MAIN OF THE SEG JMP NODEX YES SO LOAD IT ANYWAY * FLUSH JSB PUDF MAIN OR SEG W/UNDEFS, SO LIST THEM LDA FORCD IS THE FORCE SSA FLAG SET? JMP FIXCL YES,GO FIX THE FIX UP TABLE * UNDF CCA GET A -1 CPA TRY2 ALREADY PROCESSING 2ND TRY JMP IUNDF SO ABORT THIS TIME CPA BATCH RUNNING UNDER BATCH? JMP IUNDF YES, NO DICE STA UNFLG NO,SET THE SPECIAL UNDEF PROCESSING FLG STA TRY2 SET FLAG, IF END ENTERED NO 2ND TRY LDA P8 LDB WNG28 SEND WARNING MESSAGE JSB SYOUT * LDA OP? SAVE THE STA SVOP LOADR OP * LDA TYPE2 GET THE COMMAND TYPE ERA,SLA FILE OR LU? JMP SVF2 FILE - SO SAVE FILE INFO LDA DFLAG LU - SEE IF INTERACTIVE SZA,RSS JMP SVF2 NO, SO SAVE LU INFO JSB SVF1 YES, SAVE THE RELOCATABLE JMP LREAD & GO PROMPT * SVF2 LDA N6 JSB MOVE SAVE DEF FILE2 COMMAND FILE OR LU DEF SFIL2 LDA DFLAG SAVE INTERACTIVE FLAG STA SF2IN * LDA TYPE2 IF AN LU ERA,SLA THEN RSS JMP SVFX SEE ABOUT SAVING RELOC FILE INFO * JSB LOCF ELSE IF FILE, SAVE POSITION DEF *+6 DEF IDCB2 DEF IERR2 DEF SF2RC DEF SF2RB DEF SF2OF * JSB CLOS2 AND CLOSE THE FILE * SVFX JSB SVF1 SAVE RELOC FILE INFO * LDA MYLU# RESET DEFAULT LU IOR M400 SET THE ECHO BIT FOR THE PROMPT STA FILE2 AS COMMAND LU CLA,INA STA TYPE2 SET THE TYPE TO LU STA DFLAG SET INTERACTIVE FLAG JMP LREAD & GO PROMPT * SVF1 NOP LDA TYPE1 GET TYPE FLAG SZA,RSS IF ZERO JMP SVF1,I JUST RETURN-NO FILE TO SAVE * LDA N6 JSB MOVE SAVE DEF FILE1 RELOCATABLE FILE OR LU DEF SFIL1 NAMR * LDA TYPE1 FILE OR LU? ERA,SLA RSS JMP SVF1,I LU, SO DONE * LDA IREC FILE SO SAVE POSITION STA SF1RC LDA IRB STA SF1RB LDA IOFF STA SF1OF * JSB CLOS1 CLOSE THE FILE JMP SVF1,I RETURN * * IUNDF LDA ERR28 NO, SO ABORT THYSELF JMP ABOR * * WNG28 DEF *+1 ASC 4,W-UN EXT SFIL2 BSS 3 SAVED COMMAND FILE SF2TY NOP SAVED TYPE WORD, FILE OR LU SF2SC NOP SECURITY CODE SF2CR NOP CARTRIDGE REFERENCE SF2IN NOP 0/1 NON/INTERACTIVE CMMD LU UNFLG NOP -1/0 UNDEF'S/NO UNDEF'S TRY2 NOP 0/-1 2ND TRY OK/IF END THEN JUST END * SF2RC NOP SAVED CMMD FILE NEXT REC SF2RB NOP SAVED CMMD FILE BLOCK SF2OF NOP SAVED CMMD FILE OFFSET IN BLOCK * SFIL1 BSS 3 SAVED RELOC FILE SF1TY NOP SAVED RELOC TYPE, FILE OR LU SF1SC NOP SECURITY CODE SF1CR NOP CARTRIDGE REFERENCE * SF1RC NOP SAVED RELOC NEXT REC SF1RB NOP SAVED RELOC BLOCK SF1OF NOP SAVED RELOC OFFSET IN BLOCK * SVOP NOP LAST OP CODE SKP * * * LIST UNDEFINED EXTS * * PUDF NOP ENTRY POINT CLA SET UP FLAG FOR NO UNDEFS STA PNTR INITIALIZE STA UN# LDA DONE? GET THE PARAMETER CHECK DONE FLAG SZA,RSS ANY PARAMETER CHECKS DONE ? JMP NPUDF NO, THUS NO UNDEFS LDA P14 LDB MESS3 MESS3 = ADDR: UNDEFINED EXTS JSB SYOUT PRINT: UNDEFINED EXTS * CLB,INB LDA SEG.L SET MORS TO 1 IF MAIN CPA P2 ADB N1 SET MORS TO 0 IF SEG STB MORS * XSCAN JSB L.LUN GET NEXT UNDEFINED EXTERNAL DEF *+4 DEF SADD DEF PNTR DEF MORS * SZB,RSS SEE IF REACHED THE END? JMP PSUSP END OF EXTS ISZ UN# INCREMENT THE UNDEFS # LDA P5 LDB SADD GET ADDR OF SYMBOL JSB SYOUT PRINT UNDEFINED EXT JMP XSCAN TRY NEXT LST ENTRY * PSUSP LDA UN# GET THE # OF UNDEFS SZA ARE THERE ANY UNDEFS ? JMP PUDF,I YES, LIST IS PRINTED * NPUDF LDA P12 LDB NMESS JSB SYOUT TELL THE FOLKS NO UNDEFS JMP PUDF,I RETURN TO CALLER * CONSTANTS * MESS3 DEF *+1 ASC 7,UNDEFINED EXTS NMESS DEF *+1 ASC 6, NO UNDEFS UN# NOP SKP * SE..? LDA SKP.1 HAS ANY RE OR SE COMMAND BEEN EXECUTED ? SSA WELL JMP DNON2 NO, SO FORGET ABOUT THE SE COMMAND * LDA OP? GET THE LAST OPCODE CPA SE WAS IT A SEARCH (IE NO NAMR) JMP NXTOP YES SO GET THE NEXT OPCODE CPA MS WAS IT A MSEARCH (NO NAMR) JMP NXTOP YES, GET NEXT OP CODE JMP DNON2 NO, GO SEE IF IT WAS A FORCED LOAD * * * JMP DEBUG,I RETURN * * * PRINT MESSAGE ON LIST DEVICE * * THE DRKEY SUBROUTINE PRINTS A MESSAGE ON THE LIST OUTPUT DEVICE. * * CALLING SEQUENCE: * A = NO. CHARACTERS (POS.) TO BE PRINTED. * B = ADDRESS OF MESSAGE * JSB DRKEY * * RETURN: CONTENTS OF A AND B ARE DESTROYED * DRKEY NOP STA CHAR# SAVE THE # OF CHARACTERS * ADB N1 BACK THE ADDRESS UP BY ONE STB MADDR AND SAVE FOR LU WRITE STB MADDF OR FILE WRITE LDA B,I GET THE WORD PRIOR TO THE BUFFER STA LTEMP AND SAVE IT LDA BLNK2 GET A BLANK STA B,I AND PUT IT IN THE BUFFER * LDB CHAR# GET THE # OF CHARACTERS ADB P3 ALLIGN TO A WORD & ACCOUNT FOR THE BLANK CLE,ERB DIV BY 2 . NOW HAVE WORD COUNT STB COUNT SAVE FOR LU OR FILE WRITE * LDB CHAR# GET THE # OF CHARS SLB,INB,RSS ODD # ? JMP GOWRT NO, SO WRITE THE BUFFER OUT CLE,ERB INDEX ADB MADDR THE THE LAST WORD LDA B,I GET IT & PUT A BLANK AND M7400 IN THE LOW END ADA D32 STA B,I * GOWRT LDA TYPE3 OK, SO NOW FIND OUT WHERE THE ERA,SLA WRITE GOES JMP WFILE A FILE * LDA LISTU GET THE LU TO WRITE TO AND M77 WITHOUT ANYTHING ELSE LDB MYLU# GET MY DEFAULT LU # SZA,RSS NULL OR BIT BUCKET ? STB LISTU YES THEN SET IT UP * JSB EXEC REQUEST WRITE DEF *+5 DEF P2 WRITE REQUEST CODE DEF LISTU ADDR OF LIST OUTPUT UNIT NO. MADDR DEF 0 BUFFER LOCATION DEF COUNT CURRENT WORD COUNT LDA LTEMP GET AND RESTORE STA MADDR,I THE ALTERED WORD JMP DRKEY,I * WFILE JSB WRITF DO THE FILE WRITE DEF *+5 DEF IDCB3 DEF IERR3 MADDF NOP BUFFER ADDRESS DEF COUNT BUFFER LENGTH * LDB LTEMP GET THE ALTERED WORD STB MADDR,I AND RESTORE IT SSA,RSS ANY FILE ERRORS JMP DRKEY,I NO, SO RETURN * JSB FCLOS YES, SO ATTEMPT TO CLOSE ALL FILES LDB F3 GET THE FILE NAME LDA IERR3 AND THE ERROR TYPE JSB FLERR AND REPORT THE ERROR SPC 1 COUNT BSS 1 CURRENT MESSAGE LENGTH LTEMP NOP D32 DEC 32 BLNK2 ASC 1, DOUBLE BLANK CHAR# NOP INPUT # OF CHARACTERS * * PRINT DIAGNOSTIC ON SYS. TTY. * * ERROR IS USED TO PRINT ALL DIAGNOSTIC MESSAGES. * * CALLING SEQUENCE: * A = 2-DIGIT ERROR CODE (DECIMAL) * B = IGNORED * JSB ERROR * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * ERROR NOP MPY P3 CALC OFFSET INTO LIST OF ERR CODES ADA EMESS ADD START ADDR OF LIST STA MERR1 SAVE ADDR LDB A,I GET 1ST 2 CHARS STB MERR+1 MOVE TO MESSAGE INA GET LDB A,I NEXT 2 CHARS STB MERR+2 MOVE THESE TO MESSAGE INA LDB A,I GET FINAL 2 CHARS STB MERR+3 FINISH OFF MESSAGE LDA P8 LENGTH OF MESS IN CHARS LDB MESS5 ADDR OF MESS JSB SYOUT OUTPUT /LOADR: L-XX XXX JMP ERROR,I RETURN SPC 1 MESS5 DEF *+1 MERR ASC 4,L-77 XXX MERR1 NOP ADDRESS OF LOADR ERROR MESSAGE EMESS DEF EMSS-3 * * EMSS ASC 3,CK SUM CHECKSUM ERROR ASC 3,IL REC ILLEGAL RECORD ASC 3,OV MEM MEMORY OVERFLOW ASC 3,OV BSE BASE PAGE OVERFLOW ASC 3,OV SYM SYMBOL TABLE OVERFLOW ASC 3,CM BLK COMMON BLOCK ERROR ASC 3,DU ENT DUPLICATE ENTRY POINT ASC 3,TR ADD NO TRANSFER ADDRESS ASC 3,RE SEQ RECORD OUT OF SEQUENCE ASC 3,IL PRM ILLEGAL PARAMETER ASC 3,CO RES ATTEMPT TO REPLACE A CORE RESIDENT PROG ASC 3,OV FIX FIXUP TABLE OVERFLOW ASC 3,LM LIB LIMIT ON # OF LIBRARIES REACHED ASC 3,IL REL ASMB PRODUCED ILLEGAL RELOCATABLE ASC 3, UNUSED ASC 3,IL PTN ILLEGAL PARTITION NUMBER ASC 3,RQ PGS # PGS REQUIRED > AMT IN PARTITION ASC 3,OV PTN REQUESTED PGS > LARGEST ADDR SPACE FOR PROG ASC 3,ML EMA MULTIPLE DECLARATION OF EMA ASC 3,ID EXT NO ID EXTENS AVAILABLE FOR EMA PROG ASC 3,SZ EMA EMA SIZE TOO LARGE FOR CORR PTTN ASC 3,IL SCB SCB CAP LEVEL IS NEGATIVE ASC 3,IN CAP USER CAP LEVEL IS LOWER THAN 60 AND TRY TO PU,PE,RP ASC 3,SS ENT SSGA ACCESS NOT DECLARED BUT TRIED TO ACCESS ASC 3,IL CMD ILLEGAL COMMAND,BATCH PU, OR PU/LI FROM TR FILE ASC 3,ID SEG NOT ENOUGH ID SEGS TO FINISH LOAD ASC 3,RF EMA ILLEGAL REFERENCE TO EMA ARRAY ASC 3,UN EXT UNDEFINED EXTERNALS EXIST ASC 3,EX CPY ATTEMPT TO RP OR PU PROG WHERE COPIES EXIST ASC 3,RP CPY ATTEMPT TO REPLACE A COPIED PROG ASC 3,PE LDR ONLY 'LOADR' MAY DO PERM LOADS OR PURGES ASC 3,DU PGM DUPLICATE PROGRAM NAME ASC 3,NO IDS NOT ENOUGH ID SEGS TO FINSH LOAD(NONE DONE) ASC 3,RP PGM ATTMPT TO REPLACE PROG NOT DORMANT OR IN A PTTN SKP * * NEW LINE ON LIST OUTPUT DEVICE * * THE SPACE SUBROUTINE IS CALLED TO PAGE UP THE PRINTER. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SPACE * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SPACE NOP CLA SET COUNT = 0. LDB ALBUF B = DUMMY ADDR. JSB DRKEY NEW LINE JMP SPACE,I RETURN * * OUTPUT MESSAGE TO SYS. TTY. * * THE SYOUT SUBROUTINE PRINTS ALL DIAGNOSTICS ON THE SYSTEM * TELETYPE. THESE INCLUDE ALL OPERATOR MESSAGES AND ALL * ERROR DIAGNOSTICS. EACH MESSAGE IS PRECEDED WITH THE * CHARACTERS: * * /LOADR: * * * CALLING SEQUENCE: * A = NO. OF CHARACTERS IN MESSAGE (POSITIVE) * B = MESSAGE ADDRESS * JSB SYOUT * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * SYOUT NOP STB TTYAD SET MESSAGE ADDR CMA,INA STA B ARS CHANGE NO. CHARS. TO NO. WORDS STA WDCNT SET MESSAGE LENGTH ADB N8 ADJUST FOR LENGTH OF /LOADR: STB TTYNO SET NO. OF CHARACTERS IN MESSAGE * LDB SYM4 GET ADDR OF MESSAGE BUFFER SYOU LDA TTYAD,I GET WORD FROM MESSAGE STA B,I SET WORD INTO MESSAGE BUFFER INB INCR BUFFER ADDR ISZ TTYAD INCR MESSAGE ADDR ISZ WDCNT SKIP - MESSAGE MOVED TO BUFFER JMP SYOU CONTINUE MOVING MESSAGE * LDA TTYNO GET THE # OF CHARS CMA,INA LDB DSYMS AND THE ADDRESS JSB DRKEY OUTPUT MESSAGE * LDA TYPE3 WAS WRITE ERA,SLA TO A FILE? JMP LOGIT YES, SO WASN'T LOG LU LDA LISTU IS LIST DEVICE AND M77 CPA MYLU# LOG DEVICE? JMP SYOUT,I YES,DONE * LOGIT LDA BLNK2 GET A BLANK STA MADDR,I PUT IN BUFFER,(MADDR SET UP IN DRKEY) LDA MADDR GET BUFFER LOCATION STA BLOC STORE IT FOR THE WRITE * JSB EXEC REQUEST WRITE DEF *+5 DEF P2 WRITE CODE DEF MYLU# LOG LU BLOC DEF 0 BUFFER LOCATION DEF COUNT CURRENT COUNT * LDA LTEMP RESTORE STA MADDR,I ALTERED WORD * JMP SYOUT,I RETURN * N8 DEC -8 TTYAD BSS 1 TTYNO BSS 1 SYM4 DEF SYMES+4 SYMES ASC 20, /LOADR: ASC 15 DSYMS DEF SYMES POINTER TO MESSAGE BUFFER * N2 DEC -2 P64 OCT 100 P1 OCT 1 P10 DEC 10 N20 DEC -20 MEM1 BSS 1 LOW MAIN ADDR OF DUMMY ID MEM2 BSS 1 HIGH MAIN MEM3 BSS 1 LOW BASE PAGE MEM4 BSS 1 HIGH BASE PAGE DMAIN BSS 1 DISC ADDR OF PROG SKP * * SUBROUTINE: "SETID" * * PURPOSE: THIS ROUTINE INSURES THAT A BLANK * ID SEGMENT IS AVAILABLE FOR A PROG * ADDITION OR NORMAL BG LOAD, * ALLOCATES SPACE FOR A DUMMY SEGMENT * IN UPPER MEMORY (BELOW THE DUMMY BASE * PAGE AREA), PRESETS SOME VALUES IN * THE DUMMY ID SEGMENT, AND SETS THE * ADDRESS OF EACH WORD IN A LINK WORD * IN THE DATA SECTION OF THE LOADER. * * IF A BLANK ID SEGMENT IS NOT AVAILABLE * OR THERE ARE INSUFFICIENT NUMBER OF * SEGMENTS FOR MAIN/SEGMENT LOADING, THE * MESSAGE: * "NO BLANK ID SEGMENTS" * IS PRINTED AND THE LOADER IS SUSPENDED. * THE OPEATOR MAY DELETE A PROG FROM * THE SYSTEM (OF COMMAND) OR TERMINATE * THE LOADER. * * * CALL: (A):= 0 FOR ADDITION (BLANK ID SEG. REQ) * = 1 FOR REPLACEMENT (BLANK IDS NOT REQ) * (B)= 0 FOR LONG ID SEG (18 WORDS) * = 1 FOR SHORT ID SEG (9 WORDS) * (P) JSB SETID * (P+1) -RETURN- REGISTERS MEANINGLESS * * THE ALLOCATION OF CORE IS AS FOLLOWS : * LONG DUMMY ID SHORT DUMMY ID * ------------- -------------- * * PRIOR PRENT(ENTRY POINT) * PRENT(ENTRY POINT) NAM12 * NAM12 NAM34 * NAM34 NAM5 * NAM5 MEM1 * RESL MEM2 * TMDY1 MEM3 * TMDY2 MEM4 * MEM1 DMAIN * MEM2 * MEM3 * MEM4 * DMAIN * EMAID * SHIGH * SESW1 * SESW2 * SESW3 * IDEX1 * IDEX2 * * SKP * SETID NOP STB TYPID SAVE LONG/SHORT FLAG ISZ ID# SZA,RSS IF NOT ADDITION, SKIP JSB COIDS ELSE COUNT THE IDS * * ALLOCATE DUMMY ID SEGMENT IN UPPER CORE. * LDB TYPID GET LONG/SHORT FLAG LDA N20 SZB SHORT ID ? LDA N9 YES, SET (A)=-9. STA SET6 SET NEGATIVE LENGTH OF ID ADA FXN.L THE FIXUP TABLE STA SET2 SET NEW END LDB FXN.L CURRENT ADDRESS TO B STA FXN.L SET NEW END OF FIXUP TBL. SETI0 CPB FXS.L END OF TABLE? JMP SETI1 YES * LDA B,I NO MOVE A WORD STA SET2,I MOVE IT INB STEP THE ADDRESSES ISZ SET2 JMP SETI0 AROUND WE GO * SETI1 LDA FXN.L CMA,INA TEST FOR SYMBOL ADA LSY.L OVERFLOW SSA,RSS WELL JMP LOVER ALL OVER NOW * LDA FXS.L SUBTRACT PROPER LENTH FROM ADA SET6 CURRENT ID SEG ADDR. STA FXS.L FOR NEW ADDR. LDB FXS.L SET CLA DUMMY SETI STA B,I ID INB SEGMENT ISZ SET6 = TO JMP SETI ZERO. * LDA FXS.L LDB TYPID GET LONG/SHORT FLAG SZB SKIP ON LONG ID JMP SHID SET UP SHORT ID SEG. STA PRIOR SET ADDR OF PRIORITY INA STA PRENT SET ADDR OF PRIMARY ENT. PT. INA STA NAM12 SET ADDR OF NAME 1,2 INA STA NAM34 SET ADDR OF NAME 3,4 INA STA NAM5 SET ADDR OF NAME 5, TYPE INA STA RESL SET ADDR OF RESOLUTION CODE INA STA TMDY1 SET ADDR OF TIME OF DAY, LS INA STA TMDY2 SET ADDR OF TIME OF DAY , MS INA STA MEM1 SET ADDR OF LOW MEMORY BOUND INA STA MEM2 SET ADDR OF HIGH MEMORY BOUND INA STA MEM3 SET ADDR OF LOW BP BOUND INA STA MEM4 SET ADDR OF HIGH BP BOUND INA STA DMAIN SET DISK ADDR OF MAIN PROG INA STA EMAID SET EMA WORD INA STA SHIGH HIGH MAIN + LARGEST SEG + 1 INA STA SESW1 SESSION MONITOR WORD # 1 INA STA SESW2 SESSION MONITOR WORD # 2 INA STA SESW3 SESSION MONITOR WORD # 3 INA STA IDEX1 ID EXTENSION WORD # 1 INA STA IDEX2 ID EXTENSION WORD # 2 * * LDA P99 INITIALIZE STA PRIOR,I PRIORITY = 99 * * CLA STA RESL,I AND DLD NDAY INITIALIZE STB TMDY1,I TIME OF DAY, LS HALF STA TMDY2,I TIME OF DAY, MS HALF JMP SETID,I RETURN * P99 DEC 99 * SHID STA PRENT SET ADDR OF PRIMARY ENT. PT. INA STA NAM12 SET ADDR OF NAME 1,2 INA STA NAM34 SET ADDR OF NAME 3,4 INA STA NAM5 SET ADDR OF NAME 5 & TYPE INA STA MEM1 SET ADDR OF LOW MAIN BOUND INA STA MEM2 SET ADDR OF HIGH MAIN BOUND INA STA MEM3 SET ADDR OF LOW BP BOUND INA STA MEM4 SET ADDR OF HIGH BP BOUND INA STA DMAIN SET DISC ADDR OF SEGMENT JMP SETID,I RETURN * * SET6 NOP TMDY1 NOP ADDR OF TIME OF DAY TMDY2 NOP SETM DEF *+1 ASC 10,NO BLANK ID SEGMENTS * ID# NOP # OF DUMMY ID SEGMENTS ALLOCATED TYPID NOP LONG(0) / SHORT(1) ID FLAG EMAID NOP ADDRESS OF EMA WORD SHIGH NOP ADDRESS OF HIGH MAIN + SEG + 1 SESW1 NOP SESSION WORDS 1 - 3 SESW2 NOP SESW3 NOP IDEX1 NOP ID EXTENSION WORD 1 IDEX2 NOP ID EXTENSION WORD 2 SKP COIDS NOP THIS ROUTINE COUNTS THE IDS JSB BLKID GO COUNT LDB ID# GET THE REQUIRED NUMPER CMB,INB SET NEGATIVE ADA B SUBTRACT FROM AVAILABLE SSA,RSS IF ENOUGH JMP COIDS,I RETURN SPC 1 * SEND NO ID MESSAGE * NOIDS LDA P20 LDB SETM JSB SYOUT LDA ERR33 JMP ABOR NOW ABORT THE POOR GUY * * * ORD? JSB CPRNM PRINT MODULE NAME LDA ERR14 ASMB GAVE EXT REF IN DBL REC JMP ABOR BUT NO EXT REC. ASMB ERROR * * * * LL27 LDA ERR27 JMP ABOR ABORT LOAD * SKP * * THE OUTAB ROUTINE IS CALLED TO OUTPUT A WORD TO THE DISC * * CALLING SEQUENCE: * A = VALUE OF WORD * B = ADDRESS OF WORD * JSB OUTAB * DEF RETURN FORM REQUIRED BY LOADER LIBRARY * DEF ADDR ADDRESS OF WORD * DEF VALUE VALUE OF WORD * RETURN: CONTENTS OF A AND B ARE DESTROYED * OUTAB NOP ROUTINE TO OUTPUT * * TEST FOR MAIN OR BASE PAGE FIXUP. * STA ABWRD ALL ABS CODE STB ABADD SAVE WORD (A) AND ADDRESS (B) CMB SET ADDRESS NEGATIVE * LDA OUTAB FAKE OUT RETURN ADA P3 LOADR LIB THINKS STA OUTAB WE HAVE 3 DEFS STB A SAVE IT ADB FWA BELOW CURRENT MODULE? SSB,RSS WELL? JMP OUTA3 YES COULD BE BP OR MAIN FIXUP * ADA TH2.L BEYOND LAST WORD PUT OUT? INA SSA,RSS WELL?? JMP OUTA2 NO JUST PUT THE WORD TO ABOUT * * ZERO ANY BSS 'S FOUND IN PROGRAM * OUTA1 CLA ZERO'S LDB TH2.L NEXT ADDRESS CPB ABADD THIS THE ADDRESS TO WRITE? JMP OUTA2 YES GO DO IT * JSB ABOUT ELSE SEND A ZERO JMP OUTA1 CHECK IF ANOTHER NEEDED * * DO NORMAL OUTPUT OF A NORMAL INSTRUCTION * OUTA2 LDA ABWRD GET THE WORD LDB ABADD AND THE ADDRESS JSB ABOUT AND SEND IT JMP OUTAB,I RETURN * OUTA3 STA B ADDRESS NOT IN CURRENT MAIN ADA M2000 IN BP? SSA,RSS WELL?? JMP OUTA6 YES GO DO BASE PAGE FIX * * FIXUP OF A MAIN OF A SEGMENTED PROGRAM * STB A GET ANOTHER COPY ADB SGM.L SEG-CURRENT ADDRESS ADA AFWA ABSOLUTE BASE-CURRENT ADDRESS SSB,RSS IF ABOVE SEGMENT BASE SSA,RSS OR BELOW MAIN JMP RCERR ERROR SHOULD NEVER GET HERE * LDA DMTBL SET ADDRESSES FOR ABOUT STA DTBL INA STA DTBL+1 INA STA DTBL+2 SO IT CAN GET BACK TO THE MAIN LDA ABWRD GET THE WORD LDB ABADD AND THE ADDRESS JSB ABOUT PUT IT OUT LDA DSTBL RESTOR ADDRESSES STA DTBL INA STA DTBL+1 INA STA DTBL+2 JMP OUTAB,I RETURN * * BP FIXUP (NOTE WE DON'T GO TO THE DISC YET ) * OUTA6 ADB BPFWA GET OFFSET INTO PGM. CMB BASE PAGE (MAIN AND SEG ARE CONTIG.) ADB FWABP TRANSLATE TO MEM. RES. DUMMY LDA ABWRD GET THE WORD STA B,I STORE IT IN THE BP JMP OUTAB,I RETURN * ABADD NOP TEMP TO HOLD LOAD ADDRESS * DMTBL DEF *+1 ADDRESS OF MAIN TRIPLET AFWA OCT 0,0,0 ABSOLUTE BASE DSTBL DEF *+1 NORMAL LOADING BASE ADDRESSES FWA NOP BASE OF CURRENT PROGRAM OR SEGMENT STRAK NOP BASE TRACK(=0 IF PROG NOT SEGMENTED) SSECT NOP BASE SECTOR (BOTH ARE RELATIVE TO ZERO FOR MAIN) * DTBL DEF FWA NORMAL SET UP OF DEF STRAK ABOUT LOAD ADDRESSES DEF SSECT CHANGED ONLY TO FIX UP MAIN * * * * SET2 NOP SKP * * * * CONVD CONVERTS THE CONTENTS OF A INTO ASCII (OCTAL) * AT THE LOCATION SPECIFIED BY THE ADDR IN B. * CALLING SEQUENCE: * A = NO. TO BE CONVERTED * B = ADDRESS OF CONVERTED NO. * JSB CONVD * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * * CONVD NOP STB ATEMP SAVE THE ADDRESS OF THE BUFFER CLE FORCE OCTAL CONVERSION LDB OPCOD GET THE OPCODE CPB P3 IF OPCODE = 3 CME THEN SET E FOR DECIMAL CONVERSION JSB $CVT3 DO THE CONVERSION LDB A,I GET 1ST ASCII RETURN STB ATEMP,I AND PUT IT WHERE THE CALLER WANTS INA ISZ ATEMP LDB A,I GET THE NEXT ONE STB ATEMP,I INA ISZ ATEMP LDB A,I STB ATEMP,I NOW WERE DONE JMP CONVD,I * ATEMP NOP * * * SPC 1 N17 DEC -17 N7 DEC -7 SKP MOVE NOP WORD MOVE SUBROUTINE STA WDCNT SAVE WORD COUNT LDA MOVE,I GET SOURCE STA ATEMP SET IN A TEMP ISZ MOVE STEP TO DEST. ADDR LDA MOVE,I GET DEST. ISZ MOVE STEP TO RETURN ADDR MOV1 LDB ATEMP,I GET A WORD STB A,I PUT IT AWAY ISZ ATEMP STEP SOURCE INA AND DEST. ADDRES ISZ WDCNT DONE? JMP MOV1 NO - CONTINUE JMP MOVE,I YES - EXIT * PRINT MEMORY MAP * * PRMAP SETS THE CURRENT MEMORY BOUNDS INTO THE MEMORY MAP * AND PRINTS THE MAP IF THIS OPTION WAS SELECTED. FOLLOWING * THIS, THE MEMORY BOUNDS ARE UPDATED FOR THE NEXT PROG. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB PRMAP * * RETURN: CONTENTS OF A AND B ARE DESTROYED * PRMAP NOP LDB NM2.L GET ADDRESS INB INC TO NAME LDA B,I NAME 1,2 INTO REG A STA MBUF SET IN BUFFER INB INC TO NAME 3,4 LDA B,I NAME 3,4 INTO REG A STA MBUF+1 SET INTO BUFFER INB INC TO NAME 5 LDA B,I NAME 5 INTO REG A STA MBUF+2 SET INTO BUFFER LDA TH1.L GET CURRENT PROG RELOC ADDR LDB AMEM3 GET ADDR IN MEMORY MAP JSB CONVD CONVERT TO OCTAL IN MAP CCA LDB PGL.L PROG LENGTH SZB IF ZERO SSB OR NEGATIVE JMP ADTH2 ADDING LWA IS CORRECT (NO LINKS) ADA TH1.L ELSE ADD CURR PROG RELOC ADDR ADA B AND LENGTH RSS ADTH2 ADA TH2.L GET LWA PROG LDB AMEM6 GET ADDR IN MEMORY MAP JSB CONVD CONVERT TO OCTAL IN MAP LDA PLIST GET LIST/NO LIST FLAG SLA SKIP - LIST MEMORY BOUNDS JMP PRMA1 OMIT LISTING LDA BLNK2 BLANK THE UNSET WORD STA MBUF+9 LDB NM3.L GET EXTENDED NAM COMMENT LDA B,I GET LENGTH OF COMMENT SZA,RSS IF ZERO - SKIP MOVE JMP PMAP1 CMA,INA SET TO MOVE COMMENT INB STB SORC SET SOURCE OF MOVE JSB MOVE SORC NOP FROM EXTENDED NAM COMMENT DEF MBUF+10 TO MBUF PMAP1 LDA P10 GET # OF WORDS IN MAP MESS ADA NM3.L,I ADD # WORDS IN COMMENT FIELD ALS CONVERT TO WORDS LDB MESS2 MESS2 = ADDR MEMORY MAP JSB DRKEY PRINT: XXXXX NNNNN NNNNN ***************************DEBUGGING STUFF****************** * LDA EUSED * LDB ECP1 * JSB CONVD * LDA P24 * LDB ECPM * JSB DRKEY * LDA CPL2 * LDB ECP1 * JSB CONVD * LDA P8 * LDB ECPM * JSB DRKEY * * * LDA STLK GET START LINK * CMA,INA MAKE NEG * LDB DUEN GET LAST SET ASIDE * ADB A ADD TO GET * STB ALCP # SET ASIDE * LDB REEN GET LAST ALLOCATED * ADB A AGAIN SUB START TO GET * STB USED # REALLY USED * CMB,INB SUBTRACT FROM * ADB ALCP THOSE SET ASIDE * STB A TO GET # WASTED * LDB CPMA1 * JSB CONVD # WASTED * LDA USED * LDB CPMA8 * JSB CONVD # USED * LDA ALCP * LDB CPM14 * JSB CONVD # ALLOCATED * LDA PLCT * LDB CPM23 * JSB CONVD # ATTEMPTED * LDA P62 * LDB CPMA * JSB DRKEY * CLA * STA PLIST ********************END DEBUGGING STUFF*********** * LDA PLIST GET THE LIST OPTION SZA IF HE WANTS ENTS WE GIVE HIM LINKS TOO. JMP PRMA1 NO ENTS OF BP LINKS ASKED FOR * LDA CBP.L CURRENT REAL BP ADDRESS LDB BPMSG SO CONVERT TO ASCII JSB CONVD * LDA P18 GET THE MSG LENGTH LDB BPADR AND THE ADDRESS JSB DRKEY AND REPORT TO THE USER JSB SPACE SPACE A LINE * **********************DEBUGGING STUFF******************* * LDA P2 * STA PLIST ************************END DEBUGGING STUFF*************** PRMA1 LDA TH2.L GET NEXT AVAIL ADDR STA TH1.L SET NEXT RELOCATION BASE JMP PRMAP,I RETURN * ******************DEBUGGING STUFF************* *ECPM DEF *+1 * ASC 12, LAST DUMMY USED *ECP1 DEF ECPM+1 *CPMA DEF *+1 * ASC 22, WASTED USED ALLOCATED * ASC 9, ATTEMPTED *CPMA1 DEF CPMA+1 *CPMA8 DEF CPMA+8 *CPM14 DEF CPMA+14 *CPM23 DEF CPMA+23 *P62 DEC 62 *ALCP NOP *USED NOP ****************************END DEBUGGING STUFF****** BPADR DEF *+1 ASC 18, BP LINKAGE XXXXX BPMSG DEF BPADR+7 * MESS2 DEF MBUF SKP * SCAN LST FOR SAME ENT/EXT * SPC 2 * * MATCH DIRECTORY ENTRY WITH LST * * THIS ROUTINE DETERMINES IF ENT ENTRY FROM DIRECTORY * (IN TBUF) MATCHES ANY EXT IN THE LST . THE START OF * LST MUST BE SET BEFORE CALLING THIS SUBROUTINE. * * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB MATCH * (P+1) - MATCH NOT FOUND * (P+2) - MATCH FOUND * MATCH NOP LDB TSY.L MACH? CPB LSY.L END OF LST ? JMP MATCH,I YES - RETURN (P+1) LDA B,I GET LST1 RAL,CLE,ERA CLEAR BIT15 CPA TBUF NAME 1 , 2 EQUAL ? JMP *+3 YES ADB P5 NO - BUMP (B) BY 5 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST2 RAL,CLE,ERA CLEAR BIT 15 CPA TBUF+1 NAME 3, 4 EQUAL ? JMP *+3 YES ADB P4 NO - BUMP (B) BY 4 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST3 AND M7400 MASK IN NAME 5 CPA TBUF+2 NAME 5 EQUAL ? JMP *+3 YES ADB P3 POINT TO NEXT LST1 JMP MACH? GET NEXT LST1 INB LDA B,I GET LST4 AND P7 MASK IN SYMBOL STATUS CPA P2 UNDEFINED ? JMP *+3 YES ADB P2 NO - FORGET ENT MATCHED TO ENT JMP MACH? GET NEXT LST1 ISZ MATCH BUMP TO (P+2) RETURN FOR MATCH JMP MATCH,I RETURN (P+2) * * SKP * * SCAN DUMMY LINKAGE AREA FOR OPERAND * * SCAN LOOKS THROUGH THE DUMMY BASE PAGE TO FIND IF A * BP LINK HAS ALREADY BEEN ALLOCATED FOR THIS WORD. * CALLING SEQUENCE: * B = VALUE TO SCAN FOR * JSB SCAN * DEF RETURN FORM REQUIRED BY LOADER LIBRARY * DEF VALUE VALUE TO SCAN FOR * DEF BPADR +N/-1 ADDRESS TO USE/NOT FOUND * ON RETURN : * * - MATCH FOUND ADDRESS TO USE RETURNED * * - NO MATCH - ADDRESS RETURNED AS -1 * SCAN NOP LDA SCAN,I STA RTRN SAVE RETURN ADDRESS ISZ SCAN LDA SCAN,I STA OPRND SAVE DEF TO VALUE ISZ SCAN LDA SCAN,I STA ADS SAVE DEF TO BP ADDR * LDA BPFWA FIRST LINK ALREADY CMA,INA MAKE NEGATIVE TO FIX UP ADA CBP.L ADD CURRENT LINK ADA FWABP ADD FIRST LINK ADDRESS STA CADR ADDR OF CURRENT LINK LDA FWABP GET THE LOWER BOUND SRC CPA CADR END OF ALREADY ALLOCATED LINKS ? JMP NOTFD DO NOT FOUND RETURN CPB A,I IS THIS THE GUY ? JMP FOUND YES ! INA NO, BUMP POINTER & TRY AGAIN JMP SRC * NOTFD CCB SET BPADDR TO -1 STB ADS,I MAKE NOT FOUND RETURN JMP RTRN,I * FOUND LDB FWABP NOW CALCULATE THE ABSOLUTE ADDRESS CMB,INB ADA B ADA BPFWA STA ADS,I SET BPADDR TO THIS ADDRESS JMP RTRN,I MAKE THE FOUND RETURN * OPRND NOP ADDRESS OF WORD WE'RE LOOKIN FOR. ADS NOP ADDRESS TO USE OR NEG ONE FOR NOT FOUND FWABP NOP ADDR OF 1ST WORD OF DUMMY LINK AREA RTRN NOP RETURN ADDRESS CADR NOP ADDRESS OF END OF ALLOCATED LINKS * ALLOCATE NEXT BP LINK ADDR * * ALLOC ALLOCATES A WORD IN BASE PAGE TO BE USED FOR INDIRECT * LINKAGES. IF THE BASE PAGE AREA HAS BEEN EXHAUSTED, A * DIAGNOSTIC IS PRINTED AND LOADING IS ABORTED. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB ALLOC * DEF RETURN FORM REQUIRED BY LOADER LIBRARY * DEF DUMMY RETURNED DUMMY BP ADDRESS * DEF REAL RETURNED REAL BP ADDRESS * * RETURN: * B = DUMMY AREA BASE PAGE ADDR * ALLOC NOP LDA ALLOC,I SAVE OFF RETURN ADDRESS STA RTRN ISZ ALLOC DLD ALLOC,I DST DBPA SAVE DEF TO DUMMY BP AND REAL BP * CCA SUBTRACT ONE TO GET ADA CBP.L LAST BP LINK USED CPA BKGBL WAS IT THE LAST ONE AVAILABLE? JMP ALLO1 YES - BP OVERFLOW * INA GET NEXT AVAILABLE BP LINK STA RBPA,I SAVE REAL BP ADDRESS ISZ CBP.L INCREMENT NEXT AVAILABLE LDB BPFWA GET FWA OF ACTUAL AREA CMB,INB MAKE NEGATIVE TO FIX UP ADB A ADD CURRENT TO GET OFFSET FROM BEGINNING ADB FWABP ADD ADDR OF 1ST DUMMY BP LINK CLA STA B,I ZERO THE LINK WORD STB DBPA,I SAVE DUMMY BP ADDRESS JMP RTRN,I RETURN * ALLO1 JSB CPRNM PRINT MODULE NAME (IF ANY) LDA ERR04 04 = BP LINKAGE OVERFLOW JMP ABOR * DBPA NOP DUMMY BASE PAGE ADDR DEF RBPA NOP REAL BASE PAGE ADDR DEF * * M1777 OCT 1777 * * * SET VALUE INTO SYSTEM * * THE SYSET SUBROUTINE SET THE CURRENT WORD (IN THE A REG) * INTO THE SPECIFIED LOCATION OF THE SYSTEM. THIS IS REQUIRED * FOR BOTH THE BASE PAGE LINKAGES AND THE ID SEGMENT. * * CALLING SEQUENCE: * A = CURRENT VALUE * B = CURRENT LOCATION * JSB SYSET * * RETURN: CONTENTS OF A AND B ARE THE SAME AS AT CALL * SYSET NOP JSB $LIBR TURN OFF NOP INTERRUPT SYSTEM XSA B,I STORE WORD INTO SYSTEM JSB $LIBX RESTORE INTERRUPT DEF SYSET SYSTEM AND RETURN * EMES DEF *+1 ASC 1, * ENTRY POINT BSS 6 LIST BUFFER BLANK OCT 40 * SKP * * NORMAL LOAD TERMINATION * NODEX LDA #PTTN IF NO PTTN SPECIFIED SZA THEN JMP NODEY CHECK INPUT #PAGES * XLB $MBGP GET THE MAX BG PROG LDA PTYPE & PROG TYPE CPA P2 IS PROG BG? RSS JMP *+3 XLB $MRTP NO, GET MAX RT SIZE * LDA EMA.L *E SZA IF EMA, RSS JMP *+3 XLB $MCHN USE MAX MOTHER PTTN SIZE * LDA #PGS GET THE # OF PAGES REQUESTED CMA,INA & CHECK AGAINST MAX SIZE ADA B *E INA ACCOUNT FOR BP SSA DID HE ASK FOR TOO MUCH? JMP ER.18 YES, SO FLUSH HIM * NODEY LDA EMA.L ANY EMA DECLARATION ? SZA,RSS WELL ? JMP NOEMA NO. * LDA SEG.L YES,GET SEGMENTED PROG FLAG SZA,RSS IF NOT SEGMENTED-END OF NORMAL LOAD JMP SETEM THEN SET DUMMY BP LDA MSEGF ELSE GET FINAL LOAD FLAG CPA P3 IS IT? RSS YES, SET DUMMY BP JMP NOEMA NO, DON'T SET IT * SETEM LDA SHIGH,I GET HIGHEST LOAD POINT SZA,RSS THIS IT ? LDA TH2.L NO. NOW WE HAVE IT ADA M1777 ALLIGN TO NEXT PAGE AND M0760 STA EMA.L,I AND STUFF INTO DUMMY BP * LDA #PGS GET SPECIFIED INPUT PAGES SZA,RSS ANY SPECIFIED? JMP NOEMA NO, FORGET IT * ADA N1 DON'T COUNT BP TWICE! ALF,ALF CONVERT #PAGES TO WORDS RAL,RAL *E ADA URFWA ADD TO LOAD PT STA EMA.L,I PUT START ADDR SEG.L INTO DUMMY BP * NOEMA LDA PLIST GET ENTRY POINT LIST FLAG ARS SZA SKIP - LIST ENTRY POINTS JMP NOLST OMIT ENT LISTING * * LIST LIB ENTRY POINTS * JSB SPACE NEW LINE LDA P12 LDB MESS8 MESS8 = ADDR: ENTRY POINTS JSB DRKEY PRINT : ENTRY POINTS JSB SPACE NEW LINE ON LIST OUTPUT DEVICE CLA STA PNTR START AT ZERO ELIST JSB L.LDF LIST DEFINED ENTS AND EXTS DEF *+4 DEF SADD DEF PNTR DEF N1 CK ALREADY LISTED BIT * SZB,RSS END OF LST? JMP NOLST YES-BYE-BYE * LDA B,I GET NAME 1,2 * STA EMES+2 SET NAME 1,2 INTO BUFFER INB LDA B,I GET NAME 3,4 STA EMES+3 SET INTO BUFFER INB LDA B,I GET NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK CHAR STA EMES+4 SET NAME 5 INTO BUFFER * INB LDA B,I GET THE TYPE OF CONTENTS OF LST5 INB AND B200 SZA,RSS IS V BIT SET JMP GOTAD NO, LST5 IS VALUE LDA BPFWA GET THE ADDR OF FIRST REAL AVAIL LINK CMA,INA ADA B,I ADD LINK ALLOCATED TO GET OFFSET INTO ADA FWABP DUMMY LINK TABLE LDA A,I NOW GET THE ADDRESS RSS GOTAD LDA B,I GET THE DEFINING ADDRESS LDB EMES GET ADDR OF 'NNNNN ' IN ADB P4 BUFFER. JSB CONVD CONVERT TO OCTAL IN MEMORY MAP LDA P14 LDB EMES ADDR OF ' *' BEFORE ENT BUFFER JSB DRKEY PRINT ENTRY POINT LISTING JMP ELIST CONTINUE ENTRY POINT SEARCH * NOLST JSB DWRIT WRITE LAST DISK SECTOR LDA FWA SET LOW MAIN STA MEM1,I ADDR LDA TH2.L SET STA MEM2,I ADDR LDA CBP.L CURRENT BP ADDRESS STA MEM4,I SET IN ID SEGMENT LDA SGB.L IF SEGMENT BEING LOADED, SZA,RSS LDA BPFWA IF SGB.L NOT SET YET STA MEM3,I SET AS LOW BOUND OF BP. LDA SGB.L GET CURRENT LOWER BOUND OF BP, SZA,RSS LDA BPFWA IF SGB.L NOT SET YET CMA,INA ADA CBP.L ADD CURRENT BP LINK ADDR LDB SEG.L (B) = M/SEG FLAG. CPB P1 IF LOADING MAIN, STA MTMP SAVE BP LENGTH SZA,RSS SKIP - SOME BP LINKAGES JMP NOBPL NO BP OUTPUT * * OUTPUT BASE PAGE LINKAGES * LDA FWA SET CMA,INA DBLAD ADA TH2.L = TO DISPLACEMENT ADA M177 TO START OF AND M7600 NEXT SECTOR ADA FWA FOR STA DBLAD BP AREA. CLA,INA SET ABT12 = 1, STA ABT12 FOR WRITING BASE PAGE. LDB SGB.L SET FWA OF CURRENT BASE PAGE SZB,RSS LDB BPFWA IF SGB.L NOT SET YET LDA BPFWA CMA,INA ADA B ADA FWABP END OF CALCULATION OF CURRENT BP LDB SEG.L M/SEG FLAG STA ABT13 AREA IN ABT13. CPB P1 IF NOT LOADING RSS MAIN, JMP NOLS1 JUMP TO OUTPUT BASE PAGE. LDA FWA SAVE MAIN: STA MTMP+1 FWA LDA TH1.L STA MTMP+2 TH1.L LDA DBLAD STA MTMP+3 DBLAD LDA ABT13 STA MTMP+4 FWABP LDA BPFWA CMA,INA ADA CBP.L ADA FWABP STA MTMP+5 CBP.L. * NOLS1 LDA BPFWA CALCULATE LAST USED BP ADDR CMA,INA ADA CBP.L ADA FWABP STA CBPT NOLS0 LDA ABT13 IF CURRENT ABT13 = LAST USED CPA CBPT BASE PAGE ADDR, JMP NOBPL THEN FINISHED. * LDA ABT13,I OUTPUT CURRENT LINK WORD LDB DBLAD JSB ABOUT ISZ DBLAD UPDATE ISZ ABT13 ADDRES JMP NOLS0 AND CONTINUE. * NOBPL CLA RESET BASE PAGE OUTPUT STA ABT12 FLAG FOR "ABOUT". LDA SEG.L SKIP NAME CPA P2 PROCESSING IF JMP MSGP1 SEGMENT LOAD LDB MESS4 GET ADDR OF TERM. MESSAGE LDA NAM12,I GET PROG NAME 1,2 STA B,I SET NAME INTO MESSAGE INB INCR CURRENT ID SEG ADDR LDA NAM34,I GET PROG NAME 3,4 STA B,I SET NAME INTO MESSAGE INB INCR CURRENT ID SEG ADDR LDA NAM5,I GET PROG NAME 5 AND M7400 ISOLATE UPPER CHAR IOR BLANK ADD BLANK CHAR STA B,I SET NAME INTO MESSAGE * JSB BREAK LAST CHANCE TO BREAK THE PROGRAM * LDA SEG.L CHECK FOR SPECIAL SZA,RSS MAIN/SEGMENT PROCESSING JMP NTRM0 -NO, NORMAL TERMINATION * MSGP1 CPA P1 IF MAIN LOADED, JSB MEND SET SEGMENT AREA OF LST. * JSB L.SGN RESET SEGMENT CONDITIONS DEF *+2 DEF LEVEL * LDB SSG.L ERASE PREVIOUS STB TSY.L * LDB OPCOD CHECK OPERATION CODE. CPB P1 -IF DEBUG LOAD, JMP MSGP3 SKIP. JMP MSGP4 CONTINUE. * MEND NOP JSB L.SG0 DEF *+2 DEF LEVEL RIGHT NOW SEND A 0:LATER MLS JMP MEND,I * MESS8 DEF *+1 ASC 6,ENTRY POINTS M7600 OCT 177600 DRSET ASC 1,BS LEVEL NOP CBPT NOP * * * MSGP3 LDA MSEGF SKIP DEBUG CHECK , ETC., CPA P3 IF FINAL JMP MSGP6 LOAD (=3). * LDA DRSET RESET .DBUG TO .DBSG TO GET SEGMENTS STA CHRBU SUBROUTINE THAT ACCESSES DBUG. * JSB L.SYE PUT .DBSG INTO LST DEF *+6 DEF CHRDE DEF P2 UNDEFINED DEF N1 NO VALUE DEF P1 DO NOT OVERRIDE DEF RSLT * LDA N3 GET # OF WORDS TO MOVE JSB MOVE MOVE EM DEF DB1X SOURCE DEF DB1 DESTINATION (SAVES 6 BP LINKS) * * SAVE "MAIN" BOUNDS IF MAIN JUST LOADED * MSGP4 LDA SEG.L CONTINUE IF CPA P2 PROCESSING A SEGMENT. JMP MSGP5 ISZ SEG.L SET 'SEG.L' = 2. * * SET CONDITIONS FOR NEXT SEGMENT. * MSGP5 LDA MSEGF SKIP IF CPA P3 FINAL LOAD. JMP MSGP6 LDA SGM.L RESET LOWER STA TH1.L BOUNDS VALUES FOR STA FWA TH1.L , FWA CCA SET LAST ACCESS PNTR STA LELAD USED BY OUTAB ROUTINE STA DBLFL SET 1ST DBL FLAG = -1 STA NM1.L NAM MUST BE 1ST. CLA STA LGOU STA SLIBF STA LBS.L * * LDA FXS.L (A) = ID SEGMENT ADDR(DUMMY) ADA P4 (A)= ADDR OF MEM1 OF SHORT ID LDB TYPID GET LONG/SHORT ID FLAG SZB,RSS LONG ID ? ADA P4 YES, (A)=ADDR OF LONG ID'S MEM1 JSB C#S CALCULATE # SECTORS. * ADA SSECT ADD IN STARTING SECTOR. CLB DIVIDE BY DIV TRKS# # SECTORS PER TRACK. STB SSECT SET REMAINDER AS NEW SSECT. ADA STRAK ADD IN STARTING TRACK TO STA STRAK QUOTIENT AND SET NEW STRAK. ALF,RAL ROTATE TRACK # TO RAL,RAL 14-07, ADD IN IOR SSECT SECTOR # AND STA ALLOC SAVE TEMPORARILY IN SUB HEAD * * ALLOCATE NEW ID SEGMENT. * LDB EDFLG SET CLA (A) = 1 IF CPB P2 A REPLACEMENT, INA OTHERWISE (A)=0, CLB,INB INDICATE SHORT ID JSB SETID ALLOCATE SHORT ID SEG * LDA ALLOC STORE NEW STARTING TRACK STA DMAIN,I AND SECTOR IN "DMAIN" * LDA PLIST CHECK LIST FLAG SLA SKIP IF NOT SUPPRESSED. JMP MSG10 GO TO LOAD NEXT * JSB SPACE TRIPLE JSB SPACE SPACE FOR JSB SPACE CLARITY ON LISTING. * MSG10 LDA N60 GET THE COUNT JSB MOVE MOVE SEGMENT NAM BUFFER BACK DEF SGNAM SOURCE DEF L.BUF+0 DESTINATION * JMP *+1,I REPROCESS THE SEGMENT NAM RECORD DEF TESTR (SAVE A BP LINK TOO !) * * MESS4 DEF *+1 PRAM ASC 6, READY PRAMX ASC 17, AT SKP * * RE-OUTPUT "MAIN" BASE PAGE LINKAGES * MSGP6 CLA STA PNTR START AT ZERO INA STA MORS START FOR MAIN * JSB L.LUN FIND UNDEFS DEF *+4 DEF SADD DEF PNTR DEF MORS SZB,RSS END OF SYMBOL TABLE? JMP MSGP9 NO LDA P6 LDB MESSM PRINT "MAIN'S" JSB SYOUT ISZ SEG.L JSB PUDF GO REPORT THE UNDEFINEDS CCA ADA SEG.L STA SEG.L LDA FORCD GET THE FORCE LOAD FLAG SSA,RSS DO WE IGN.L UNDEFS ? JMP IUNDF NO SO ABORT THYSELF. MSGP9 LDA MTMP SZA,RSS TRANSFER IF NO JMP NTRM0 BASE PAGE. * LDA MTMP+1 RESET "MAIN" WORDS. STA FWA FWA LDA MTMP+2 STA TH1.L TH1.L LDA MTMP+3 STA DBLAD DBLAD LDA MTMP+4 STA ABT13 FWABP LDA FWABP CMA,INA ADA MTMP+5 ADA BPFWA STA CBP.L CBP.L CLA SET STARTING TRACK STA STRAK AND SECTOR FOR STA SSECT PROG = 0. CLA,INA SET BP OUTPUT STA ABT12 FLAG. MSGP7 LDA ABT13 IF CURRENT ABT13 = LAST USED CPA MTMP+5 BASE PAGE ADDR, JMP NTRM0 THEN FINISHED. * LDA ABT13,I OUTPUT CURRENT LINK WORD LDB DBLAD JSB ABOUT ISZ DBLAD UPDATE ISZ ABT13 ADDRES JMP MSGP7 AND CONTINUE MTMP OCT 0,0,0,0,0,0 TEMP STORAGE FOR "MAIN" P17 DEC 17 P9 DEC 9 MESSM DEF *+1 ASC 3,MAIN'S SKP * * CHECK FOR AND DO NORMAL ON-LINE LOAD TERMINATION * FOR A MAIN OR SEGMENT , OR FOR MAIN AND SEGMENTS * IF NO EDITING. * NTRM0 JSB DWRIT DUMP LAST OF BASE PAGE LDB EMA.L GET THE EMA FLAG SZB,RSS ANY EMA DECLARED ? JMP NTRM. NO. * LDA MSG.L GET THE SUPPLIED MSEG SIZE SZA WAS ANY SUPPLIED JMP SETMS YES * LDA B,I GET THE EMA DEFINING ADDRESS ALF & CONVERT TO PAGE # RAL,RAL CMA ACCOUNT FOR I/O OVERFLOW ADA P32 NOW HAVE MAX POSSIBLE MSEG * STA MSG.L NO, USE MAX POSSIBLE SETMS ADA MSIGN NOW SET NON STANDARD MSEG BIT STA IDEX1,I AND PUT IN DUMMY ID SEGMENT * LDA EMS.L GET THE EMA SIZE LDB EMA.L,I & START PAGE OF MSEG RBL PLACE INTO PROPER FIELD SZA,RSS WAS EMA SIZE DEFAULTED ? ADB M2000 YES, SO SET DEFAULT BIT STB IDEX2,I & PLACE IN DUMMY ID * LDA URFWA NOW CHECK OUT EMA SIZE ALF FIRST GET PROG SIZE RAL,RAL AND M37 CMA,INA LDB EMA.L,I GET NEXT PAGE ADDRESS BLF RBL,RBL ADB A NOW HAVE PROG SIZE ADB EMS.L NOW HAVE REQ'D SIZE CMB,INB STB MESSM SAVE IT * LDA #PTTN WAS A PARTITION SPECIFIED ? SZA,RSS WELL ? JMP GTMCN NO * CCA YES ADA #PTTN MPY P7 INDEX TO PROPER ENTRY ADA P4 XLB $MATA OF $MATA TABLE ADA B XLA A,I GET THE AND B1777 # OF PAGES * JMP GTMC1 * GTMCN XLA $MCHN GET MAX SIZE SZA IS IT 0. JMP GTMC1 NO XLA $MBGP ASSUME BG LDB PTYPE CPB P2 IS IT ? RSS NO JMP *+3 XLA $MRTP NO * GTMC1 ADA MESSM NOW ADD IN SIZE SSA OK ? JMP LL21 NO. * NTRM. LDA SHIGH,I CALCULATE # OF PAGES VALUE FOR ID SZA,RSS PROG SEGMENTED ? LDA TH2.L NO * LDB URFWA GET LOAD POINT CMB MAKE NEG (ACCOUNT FOR HIGH MAIN '+' 1 ADA B A = # OF WORDS OF CODE ALF NOW ACCOUNT FOR PAGES RAL,RAL AND M37 ADA P2 ACCOUNT FOR BASE PAGE & CURRENT PAGE STA MES11+1 SAVE FOR # OF PAGES RELOCATED MESSAGE LDB #PGS GET ANY SUPPLIED SIZE SZB,RSS ANY SUPPLIED ? STA #PGS NO, SO USE CODE SIZE * CCB OK, SO BUILD ID SEG WORD 22 ADB #PTTN PUT PART'N WORD IN BITS 0-5 CCE,SSB SET BIT 15 IF PARTITION REQUESTED CLB,RSS IF NO PARTITION THE SET TO 0 RBL,ERB * CCA GET # PGS REQ'D LESS BP ADA #PGS ADA MSG.L ADD IN MSEG SIZE ALF,RAR # PGS IN BITS 14 - 10 IOR #MPFT MEM PROT FENCE INTO BITS 9-7 ALF,ALF RAR IOR B SAVE THE WORD STA PG.PT FOR THE MVIDS ROUTINE * * LDA FWABP SET UP ADDR ADA N20 OF DUMMY STA FXS.L ID SEGMENT. LDA ID# SET NEGATIVE CMA,INA INDEX FOR NUMBER OF STA ID## DUMMY ID SEGMENTS. LDA EDFLG CHECK FOR SZA LOADING OPERATION JMP ED00 -EDITING * * CONTROL TRANSFERS HERE FOR TEMPORARY LOADS & FOR PERM LOADS * WHERE NO PREVIOUS DISC SPACE IS AVAILABLE FOR THE PROG. * NTRM7 LDA FXS.L ADA P4 GET ADDR OF MEM1 LDB ID## CMB,INB CPB ID# ADA P4 STA ED61 AND SAVE IT. JSB C#S COMPUTE # OF SECTORS NEEDED STA ABT13 AND SAVE FOR LATER. LDB ED61 GET ADDR OF MEM1 ADB P4 AND SET (B)=DMAIN'S ADDR LDA B,I GET DMAN AND M177 ISOLATE SECTOR STA ED62 ADDR AND SAVE. LDA B,I GET DMAN AGAIN ALF,ALF ISOLATE RELATIVE STARTING RAL TRACK NUMBER AND AND M377 ADD BASE TRACK NUMBER. ADA TRAKB STA TRAKP SAVE ABSOLUTE TRACK ADDR ALF,RAL RAL,RAL STA ABT11 SAVE POSITIONED TRACK # LDA TRKLU GET LU OF USER TRACKS CLE,ERA PUT 0 OR 1 FOR LU2 OR CLA LU3 RESPECTIVLY ERA PUT BIT IN (A) IOR ABT11 MERGE IN TRACK IOR ED62 AND SECTOR ADDRES. STA B,I STORE REAL ADDR IN DMAN LDA EDFLG GET EDIT FLAG SZA EDIT OPERATION ? JMP NOSET YES LDB FXS.L NO, THEN SET BIT7 OF ADB P3 NAM5 WORD OF ID SEG LDA ID## CMA,INA TO INDICATE THAT CPA ID# 'PROG IN CORE ONLY'. INB LDA B,I GET NAM5 WORD IOR B200 MERGE IN BIT7 STA B,I STORE BACK IN NAM5 * NOSET LDA ABT13 GET # OF SECTORS REQD CLB DIVIDE BY # OF SEC/TRK DIV TRKS# TO FIND # OF TRKS REQD. SZB IF REMAINDER INA THEN BUMP TO WHOLE TRK. STA #TRAK SET AS NUMBER OF TRACKS LDA EDFLG GET EDIT FLAG SZA,RSS IF NOT DOING EDIT OPERATION JMP NTRM5 THEN DO NOT COMPRESS TRACKS. * * DETERMINED FOR MAIN/SEGMENT LOAD IF SEMENTS * HAVE TO BE COMPRESSED (MOVED UP ON USER * TRACKS IF PREVIOUS SEGMENTS OR MAIN HAVE * BEEN STUFFED IN SYSTEM AVAILABLE AREA). * LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN JMP NTRM5 THEN DO NOT MOVE. LDB FXS.L GET CURRENT DUMMY ID SEG ADDR ADB P17 (B)=DMAN ADDR OF PREVIOUS ID LDA ID## ADA ID# CPA P1 PROCESSING FIRST SEG ? ADB P4 YES, ADJUST DMAN'S ADDR. LDA B,I GET DMAN SSA IF PREVIOUS SEG/MAIN ON LU3 JMP NTRM5 THEN TOO DO NOT MOVE CMA,INA MAKE DMAN NEGATIVE AND ADA DSCLB ADD TO DISC LIB ADDR SSA DMAN POINT TO SYSTEM AREA ? JMP NTRM5 NO, THEN TOO DO NOT MOVE. LDA ID## ADA ID# CPA P1 IF PROCESSING FIRST SEGMENT JMP MOVEB THEN MOVE TO START OF USER TRKS CMA,INA SET NEG INDEX FOR NUMBER OF STA ED61 DUMMY IDS TO BE UPDATED. UPID ISZ ED61 REACHED MAIN'S ID ? RSS NO, THEN SKIP. ADB P4 YES, ADJUST DMAN'S ADDR. LDA B,I GET DMAN SSA IS THIS SEG ON LU 3 ? JMP MOVER YES, MOVE TO WHERE HE LEFT OFF. CMA,INA NO, THEN SUBTRACT FROM ADA DSCLB LIB ADDR SSA THIS SEG ON USER TRAKS ? JMP MOVER YES, MOVE TO WHERE HE LEFT OFF. LDA ED61 SZA,RSS EXAMINED MAIN'S ID ? JMP MOVEB YES, MOVE TO START OF USER TRKS. ADB P9 (B)=DMAIN ADDR OF PREVIOUS ID JMP UPID EXAMINE NEXT ID SKP * DETERMINE WHERE LAST SEGMENT OR MAIN LEFT OFF * ON USER TRACKS. * B200 OCT 200 * MOVER LDA B,I SAVE DMAN OF LAST ID STA BID2 POINTING TO USER TRACKS. LDA B ADA N4 (A)=ADDR OF MEM1 JSB C#S DETERMINE NUMBER OF SECTORS STA BID1 AND SAVE THE NUMBER LDA BID2 GET DMAN AND M177 GET SECTOR ADDR ADA BID1 ADD TO TOTAL REQUIRED CLB DTERMINE TRACK OFFSET BY DIV TRKS# DIVIDING BY SECS/TRK STA BID1 SAVE NUMBER OF TRACKS LDA BID2 GET DMAN AGAIN ALF,ALF MASK IN RAL TRACK AND M377 ADDR (RELATIVE) ADA BID1 ADD TRK OFFSET FOR MOVE STA ED66 SET AS DESTINATION TRACK STB ED67 AND SET DESTINATION SECTOR JMP SHIFT GO DO MOVE * DESLU NOP IDCNT NOP * * MOVE TO BEGINNING OF USER TRACKS * MOVEB LDA TRAKB GET BASE TRACK ADDR STA ED66 SET DESTINATION TRACK CLB AND SECTOR TO VERY STB ED67 BEGINNING. * * * MOVE CURRENT AND REMAINING SEGMENTS * UPWARD ON USER TRACKS. * SHIFT LDB ID## SET # OF SEGS TO BE MOVED STB IDCNT INCLUDING CURRENT LDA DSKUN SET DESTINATION LU STA DESLU OF USER TRACKS LDB FXS.L SET ADDR OF ID SEG STB BID2 BEING PROCESSED. LDA ED66 GET TARGET TRACK NUMBER CPA TRAKP SAME AS SOURCE TRACK # ? CLA,RSS YES, THEN SKIP. JMP DIFTR NO (ATLEAST 1 TRK DIFFERENCE) LDB ED67 GET TARGET SECTOR ADDR CMB,INB MAKE NEGATIVE TO GET REMAINDER JMP SAMTR GO FIND REMAINING SECS ON TRK DIFTR INA GET NUMBER OF TRACKS CMA,INA TO BE ADA TRAKP SHIFTED THROUGH MPY TRKS# CONVER TO NUMBER OF SECTORS LDB ED67 GET DESTINATION SEC ADDR CMB,INB SUBTRACT FROM SECS/TRK ADB TRKS# TO NUM LEFT ON TRACK. SAMTR ADB ED62 ADD TO OFFSET FROM SOURCE ADB A ADD FOR TRACK OFFSET CMB,INB MAKE NEGATIVE STB BID1 SAVE NEGATIVE SEC OFFSET CLA CLEAR NUMBER STA ED21 OF SECS TO BE MOVED. * * UPDATE DMAN OF CURRENT AND REMAINING * ID SEGMENTS AND DETERMINE TOTAL NUMBER * OF SECTORS TO BE MOVED. * LDA BID2 GET ID SEG ADDR OF CURRENT ID MORID ADA P4 (A)=ADDR OF MEM1 JSB C#S FIND # OF SECS FOR THIS ID ADA ED21 ADD TO TOTAL NUMBER OF STA ED21 SECTORS TO BE MOVED. LDB BID2 ADB P8 (B)=DMAN'S ADDR LDA B,I GET DMAN AND M177 ISOLATE SECTOR ADDR STA BID4 SAVE SECTOR ADDR TEMPORARILY LDA B,I GET DMAIN AGAIN ALF,ALF POSITION RAL AND AND M377 MASK IN RELATIVE TRK ADDR MPY TRKS# GET EQUIVALENT SEC COUNT ADA BID4 ADD SECTOR OFFSET (ADDR IN SECS) ADA BID1 DECREMENT BY SEC OFFSET CLB,CCE (A)=NEW ADDR IN SECS DIV TRKS# GET RELATIVE TRK & SEC ADDR ALF,RAL POSITION REL TRK ADDR RAL,RAL IOR B MERGE IN SECTOR ADDR LDB DSKUN GET THE CURRENT DISC LU CPB P3 IS IT LU 3 ? RAL,ERA THEN DON'T FORGET THE SIGN BIT. LDB BID2 ADB P8 (B)=ADDR OF DMAIN STA B,I UPDATE DMAIN ISZ IDCNT ALL IDS UPDATED ? RSS NO JMP FSHFT YES, GO MOVE USER TRACKS. LDA BID2 SET ADDR OF NEXT ADA N9 ID SEGMENT (EXTENDING STA BID2 DOWNWARD IN CORE) JMP MORID UPDATE NEXT ID * * MOVE USER TRACKS FSHFT LDA ED21 SET NEGATIVE NUMBER CMA,INA NUMBER OF TRACKS TO STA ED21 BE MOVED. JSB ED15 MOVE USER TRACKS * * NTRM5 LDB FXS.L GET CURRENT ID SEG ADDR ADB P8 (B)=ADDR OF DMAN LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN'S ADB P4 THEN ADJUST ADDR OF DMAN LDA B,I GET DMAN ALF,ALF POSITION AND RAL ISOLATE ACTUAL AND M377 STARTING TRACK NUMBER STA BID2 SAVE IT LDA B,I GET DMAIN AGAIN AND M177 GET SECTOR OFFSET CMA,INA,SZA,RSS IF NO OFFSET JMP TRBDY THEN NO SPECIAL FIX ADA TRKS# GET SEC LEN - OFFSET CMA,INA TO GET # OF SECS USED IN 1ST TRK ADA ABT13 SUBRTRACT FROM TOTAL SECS NEEDED SSA CROSSED TRACK BOUNDARY ? JMP NTRM9 NO - THEN TAT OK. CLB YES - THEN FIND TRACKS REQD. DIV TRKS# (EXCLUDING OFFSET) SZB IF REMAINDER INA THEN BUMP TO WHOLE TRACK STA #TRAK SET NEW TRACK LENGTH ISZ BID2 ALSO FORGET ABOUT FIRST TRACK TRBDY LDA #TRAK SET NUMBER OF CMA,INA,SZA,RSS TRKS AS NEGATIVE COUNT. JMP NTRM9 TAT OK IF ON TRK BOUNDARY STA ABT1 COUNT. LDA TRKLU SET (B) = FWA OF LDB TATSD SYSTEM CPA P2 OR AUXILIARY CLB DISC'S TRACK BASE ADB TAT ADB BID2 (B)=ADDR IN TAT STB ABT2 SAVE TAT'S ADDR * NTRM2 LDA MSIGN (A)=100000 FOR SYSTEM ASSIGNED. LDB ABT2 (B)= TAT ADDR JSB SYSET SET VALUE IN TAT CLA CHECK CPA EDFLG OPERATION JMP NTRM8 -NORMAL LDA MSIGN -EDITING- CHANGE LDB ABT2 WORD IN JSB SYRUW TAT ON DISC NTRM8 ISZ ABT2 ADD 1 TO TAT ADDR. ISZ ABT1 INDEX TRACK # COUNTER. JMP NTRM2 -DO NEXT TRACK. * * * DO FINAL ID SEGMENT PROCESSING * NTRM9 CLB CLA,INA (A)=1 FOR ADDITION CPB EDFLG IF NOT EDITING CLA THEN (A)=0 FOR NORMAL LOAD LDB ED25 (B)=ADDR OF TARGET ID IF ANY JSB MVIDS MOVE DUMMY TO REAL ID JSB FIX FIX FOR TRYING LONG TO SHORT MOVE CLA CPA SEG.L DOING MAIN/SEGMENT LOAD JMP NTRM4 NO, THEN TERMINATE. JMP *+1,I YES, SET UP FOR NEXT SEG. DEF ED183 (SAVE A BP LINK TOO !) * SPC 1 NTRM4 LDA MES11+1 GET THE # OF PAGES RELOCATED JSB CNV99 CONVERT TO ASCII STA MES11+1 AND PUT INTO USER INFO BUFFER * LDA PLIST SLA LOADR LISTING SUPPRESSED? JMP PTNCK YES, SKIP #PAGES MESS. JSB SPACE * LDB P3 STB OPCOD SPECIFY DECIMAL CONVERSION * * LDA EMA.L SZA,RSS ANY EMA ? JMP LOUT NO . LDA MSG.L YES JSB CNV99 GET ASCII MSEG SIZE STA AMSEG+2 LDA EMS.L GET EMA SIZE SZA,RSS DEFAULTED ? JMP EDFLT YES LDB AEMAD GET ADDRESS OF ASCII JSB CONVD CONFERT IT JMP LOUT * EDFLT LDA N4 JSB MOVE DEF IDFLT DEF AEMA+2 * LOUT LDA #PGS GET # OF PAGES OF CODE LDB EMA.L AND EMA DECLARATION SZB,RSS ANY EMA ? JMP *+4 NO ADA EMS.L YES, SO ADD EMA SIZE CPA #PGS IF DEFAULTED INA ADD 1 LDB PGRQD GET ADDRESS JSB CONVD AND CONVERT TO ASCII * * LDA P72 GET CHAR COUNT LDB MES11 & ADDRESS JSB DRKEY NOW GO TELL THGE FOLKES * * LDA P56 GET LENGTH LDB MES12 AND MESS JSB DRKEY TO OUTPUT OPTIONS SET * * * PTNCK LDB PTYPE CHECK #PAGES REQ'D DOESN'T LDA #MXBG CPB P2 RT OR BG PROG LDA #MXRT * INA ADD 1 FOR BASE PAGE LDB #PGS CMB,INB ADB A #PAGES REQ'D SSB > MAX ? JSB WN.17 YES, GIVE WARNING JMP DONE FINISHED * * * ISSUE WARNING FOR CODE EXCEEDING PTTN SIZE * CALL SEQUENCE: JSB WN.17 * WN.17 NOP LDA P8 (A)=CHAR COUNT LDB WNG17 (B)=MESSAGE ADDR JSB SYOUT PRINT: 'W 17' JMP WN.17,I RETURN * WNG17 DEF *+1 ASC 4,W-RQ PGS CODE > PTTN SIZE * MES11 DEF *+1 ASC 18,00 PAGES RELOCATED 0000 PAGES REQ'D AEMA ASC 9, NO PAGES EMA AMSEG ASC 9, NO PAGES MSEG MS11# EQU MES11+1 P72 DEC 72 PG.PT NOP WORD 22 OF ID SEG OF MAIN AEMAD DEF AEMA PGRQD DEF MES11+10 IDFLT ASC 4,DEFAULT MES12 DEF *+1 ASC 17,LINKS:BP PROGRAM:BG LOAD:TE ASC 11, COMMON:NC P56 DEC 56 * SPC 1 DONE LDA #IDAD INA GET ADDR OF ID TEMP AREA LDB #IDAD ADB P10 GET ADDR OF B-REG SAVE WORD STB WORD WITHIN THE ID SEG JSB SYSET SET TEMP ADDR IN B LDB EDFLG SZB,RSS JMP *+3 LDB WORD IF PERMANENT, UPDATE JSB SYRUW ID SEG ON DISC TOO * JSB FTIME TELL THE FOKES THE TIME DEF *+2 DEF PRAMX+2 * LDA P46 LDB MESS4 MESS4 = ADDR: XXXXX READY ETC. JSB SYOUT PRINT: XXXXX READY - LOADING ETC * ************************DEBUGGING STUFF************** * LDA DCPA * LDB ECP1 * JSB CONVD * LDA P8 * LDB ECPM * JSB DRKEY * LDA NGEND * CMA,INA * LDB ECP1 * JSB CONVD * LDA P8 * LDB ECPM * JSB DRKEY *********************END DEBUGGING STUFF****************** * * EXIT JSB SPACE DO A LINE FEED LDA P4 SET UP TO LDB ENDMS SEND END MESSAGE. * LTERM JSB SYOUT SEND TERMINATE MESSAGE * * LDB BATCH GET BATCH FLAG * LDA OPCOD GET OP CODE * CPA P4 IS IT DELETE ? * SZB YES - NON-BATCH OPERATION ? * JMP DLEN NO - THEN GO THROUGH PAGE-EJECT * JMP EXIT1 AVOID PAGE EJECT FOR NON-BATCH DELETE DLEN LDA PLIST GET LIST/NO LIST FLAG CPA P3 SKIP PAGE EJECT IF JMP EXIT1 NOT LISTING ANYTHING AT ALL * LDA TYPE3 GET THE LIST TYPE ERA,SLA FILE OR LU ? JMP EXIT1 FILE. PAGE EJECT NOT NECESSARY * LDA LISTU GET THE LIST LU AND M77 TO A IOR M1100 SET THE PAGING BITS STA RELAD SET FOR EXEC CALL JSB EXEC DEF *+4 CALL TO EJECT A PAGE ON A DEF P3 PRINTER OR DEF RELAD SPACE 2 LINES ON DEF N2 A TTY * * EXIT1 JSB EXEC RELEASE DEF *+3 ANY TRACKS DEF P5 NOT DEF N1 ACCOUNTED FOR. * * JSB FCLOS CLOSE ALL OPEN FILES * * * PASS BACK PROG NAME TO BATCH MONITOR * LDB BLNK2 GET A BLANK BLANK LDA PRAM+4 IS IT AN ERROR? SZA YES, OK STB PRAM+4 NO, BLANK OUT THE RE SZA STB PRAM+3 JSB PRTN CALL ROUTINE DEF *+2 DEF PRAM ADDR OF NAME BUF * SPC 1 JSB EXEC REQUEST PROG COMPLETION DEF *+2 DEF P6 6 = PROG COMPLETION CODE SPC 1 $END ASC 2,$END M1100 OCT 1100 SPC 1 RELAD BSS 1 RELATIVE BG ADDR M40 OCT 40 P46 DEC 46 TEMPP BSS 1 ABSOLUTE PROG WORD LELAD DEC -1 OFFSET INTO CURRENT LOAD MODULE ABWRD NOP SAVED ABSOLUTE PROG WORD ENDMS DEF $END SKP * P21 DEC 21 * SUBROUTINE: "MEM?" IDENTIFY LONG/SHORT ID SEGMENT * * THIS SUBROUTINE IDENTIFIES WHETHER THE ID SEGMENT * UNDER CONSIDERATION IS LONG OR SHORT. * * (NOTE: THIS ROUTINE NOT USED FOR DUMMY ID SEGMENTS * SET UP BY THE LOADER) * * CALL: (B)=ADDRESS OF NAM5 WORD IN ID SEGMENT * (P) JSB MEM? * * RETURN (P+1) FOR SHORT ID SEGMENT * (P+2) FOR LONG ID SEGMENT * REG-B = ADDRESS OF MEM1 IN ID SEGMENT. * REG-A = OCT 20 IF (P+1) RETURN * = 0 IF (P+2) RETURN * * MEM? NOP XLA B,I GET NAM5 WORD FROM ID SEG AND M20 MASK IN 'SS' BIT INB (B)=MEM1 ADDR OF SHORT ID SZA LONG ID ? ('SS' BIT = 0) JMP MEM?,I NO, SHORT ID RETURN. ADB P7 (B)=MEM1 ADDR OF LONG ID ISZ MEM? BUMP TO (P+2) RETURN JMP MEM?,I LONG ID RETURN * SKP * SUBROUTINE: "MIDN" MATCH ID SEGMENT NAME * * THIS ROUTINE SEARCHES THE SYSTEM ID SEGMENTS * TO FIND A MATCH WITH THE NAME IN THE CURRENT * DUMMY ID SEGMENT. * * CALL: (P) JSB MIDN * (P+1) -NO MATCH RETURN- * (P+2) -MATCH RETURN, ID SEG ADDR IN ABT1 AND (B) * MIDN NOP LDA KEYWD INITIALIZE STA ABT1 KEYWORD LIST ADDR. * MIDN1 XLB ABT1,I IF END-OF-LIST, SZB,RSS RETURN TO JMP MIDN,I NO MATCH RETURN, P+1. * ADB P12 COMPARE XLA B,I NAME CPA NAM12,I AREAS INB,RSS OF JMP MIDN2 DUMMY ID SEG. XLA B,I AND CPA NAM34,I CURRENT INB,RSS SYSTEM ID SEG. JMP MIDN2 XLA B,I STA BLKID SAVE THE TYPE WORD AND M7400 STA B LDA NAM5,I AND M7400 CPA B JMP MIDN3 MATCH - MIDN2 ISZ ABT1 INDEX FOR NEXT ID SEGMENT- JMP MIDN1 CONTINUE SCAN. * MIDN3 ISZ MIDN MATCH - ADJUST RETURN TO (P+2) XLB ABT1,I (B) = ADDR OF MATCH ID SEG. LDA BLKID GET THE ID WORD AND P7 STRIP TO TYPE CPA P1 RESIDENT JMP ERL11 ERROR GO SEND MESSAGE AND ABORT JMP MIDN,I RETURN. SPC 1 ERL11 LDA ERR11 SEND L11 MESSAGE JMP ABOR AND ABORT SPC 2 * * CONVERT TO DECIMAL ASCII (MAX VALUE = 99) * CALL SEQUENCE: LDA VALUE * JSB CNV99 * STA ASCII * CNV99 NOP QUICK CONVERSION CLB BINARY TO DECIMAL ASCII DIV P10 MAX VALUE = 99 SZA ADA M20 FORCE LEADING BLANK IF ZERO ADA M40 ALF,ALF PUT IN LEFT HALF IOR B FILL UNITS IN RIGHT IOR B60 JMP CNV99,I RETURN ASCII IN (A) B60 OCT 60 SKP * THE COPY. SUBROUTINE CHECKS TO MAKE SURE THAT ALL PROGRAM * PURGES OR REPLACES DON'T RUN AFOUL OF COPIED PROGRAMS. THE * PROBLEM TO AVOID IS RELEASING THE DISC TRACKS THAT THE PROGRAM * YOU ARE PURGING OR REPLACING RESIDES ON IF OTHER COPIES OF * THAT PROGRAM'S ID SEGMENT ARE STILL LAYING AROUND. * IF THE PROGRAM TO BE PURGED IS A COPY THAT'S OK. IF THE PROGRAM * YOU ARE REPLACING IS A COPY, THAT'S NOT OK. * * * CALLING SEQUENCE JSB COPY. * B - REG = ID ADDRESS OF PROG TO PURGE * * * COPY. NOP STB IDADR SAVE THE ID ADDRESS OF PROG TO BE PURGED ADB P14 GET TO TYPE BIT XLA B,I AND P7 THIS A CPA P5 SEGMENT ? JMP COPY.,I THEN NOT TO WORRY. * ADB P17 NOW GET 2ND SESSION WORD XLA B,I AND M1000 IS THIS PROGRAM SZA A COPY ? JMP CHKED YES, SEE IF THIS IS A REPLACE * XLA B,I GET THE WORD AGAIN. THIS PROG NOT A COPY AND M2000 BUT ARE COPIES POSSIBLE ? SZA JMP COPY.,I NO, SO ALLS WELL * ADB N5 OK, THIS PROG NOT A COPY, BUT COPIES POSSIBLE. XLA B,I GET THE DISC ADDRESS OF THE PROG STA DSKAD AND SAVE. * LDA KEYWD GET THE KEYWORD ADDRESS STA KEY AND SET UP FOR SEARCH * DSRCH XLB KEY,I GET THE PROG ID ADDRESS CPB IDADR THIS THE PROG WE'RE WORKING ON ? JMP NXTID THEN GET NEXT ID * SZB,RSS ANY MORE ID'S ? JMP ITOK? NO SO SEE IF ALLS WELL * ADB P12 GET THE NAME WORD XLA B,I SZA,RSS IF THE ID IS EMPTY FORGET CHECK JMP NXTID AND LOOK AT THE NEXT ONE * ADB P2 NOW LOOK AT THE TYPE XLA B,I AND M20 CPA M20 THIS A SEGMENT ? JMP ITOK? YES, WERE DONE, SEE IF EVERYTHING OK * ADB P12 OK, SO INDEX TO THE DISC ADDRESS OF XLA B,I IF IT IS THE SAME AS THE ONE WE ARE CPA DSKAD GOING TO REPLACE THEN THAT'S A NO NO. JSB PRTER PRINT THE OFFENDING PROGRAM NAME & CONTINUE * NXTID ISZ KEY BUMP ID POINTER & JMP DSRCH LOOK AT THE NEXT ID SEG. * ITOK? LDA ERFLG ANY ERRORS ? SZA,RSS WELL ? JMP COPY.,I NO, SO CONTINUE WITH THE LOAD. * LDA ERR29 GET THE ERROR CODE & JMP ABOR ABORT THYSELF * CHKED LDA EDFLG GET THE EDITING FLAG SZA,RSS WE DOING A REPLACE OPERATION ? JMP COPY.,I NO, JUST PURGING A PROG. * LDA ERR30 YOU CAN'T REPLACE A COPIED PROG ! JMP ABOR * * KEY NOP M1000 OCT 1000 ERFLG NOP COPIED PROGRAM ERROR FLAG N14 DEC -14 DSKAD NOP IDADR NOP DBUF1 DEF *+1 NBUF BSS 3 * * * THE PRTER ROUTINE JUST PRINTS THE ERRORS THAT COPY. FINDS. * IT WILL TELL THE USER OF ALL PROGS THAT ARE COPYS OF THE * ORGINAL THAT HE IS TRYING TO REPLACE. * * * CALLING SEQUENCE JSB PRTER * B-REG = ADDRESS OF ID WORD 26 * * PRTER NOP ADB N14 BACK UP TO THE PROGRAM' NAME WORD. XLA B,I AND PULL NAME IN LOCALLY STA NBUF * INB XLA B,I STA NBUF+1 * INB XLA B,I STA NBUF+2 * * LDA P5 GET THE CHAR COUNT LDB DBUF1 & ADDRESS JSB SYOUT &AND PRINT THE PROGRAM NAME ISZ ERFLG BUMP THE ERROR FLAG JMP PRTER,I RETURN SKP UREAD NOP DISC READ SUBROUTINE JSB EXEC READS 64 WORDS DEF *+7 DEF P1 DEF P2 ALBUF DEF L.BUF+0 DEF P64 DEF TRACK DEF SECTR JMP UREAD,I * TRACK NOP SECTR NOP * * * * THIS ROUTINE CONVERTS A MEMORY OP SYS ADDRESS TO A DISC * ADDRESS. ON INPUT A REG = LOCATION (MEMORY ADDRESS) * * TRK NOP GENERAL MEMORY TO DISC ADDRESS CONVERSION SUBROUTINE CLB WILL NOT WORK FOR BASE PAGE LOCATIONS ! DIV D6144 DIVIDE BY TRK SIZE-CAUTION MAY BE RESET STA TRACK TO RELATIVE TRACK XLA $STRK ADD THE ABSOLUTE START TRACK ADA TRACK STA TRACK WE NOW HAVE THE TRACK LDA B CLB GET READY FOR ANOTHER DIVIDE DIV P64 DIVIDE BY SECTR SIZE STB WORD WORD = WORD OFFSET IN SECTR (0 - 63) * XLB $SSCT GET THE START SECTR OF OP SYS ADA B ADD IN RELATIVE SECTR TO GET ABS SECTR OF PATCH STA SECTR SECTR = SECTOR WHERE THE WORD IS LDB SECT2 CHECK FOR SECTOR OVERFLOW CMB,INB ADA B SSA TOO MANY SECTERS ? JMP TRK,I NO STA SECTR OPPS , TOO MANY ISZ TRACK INCREMENT TO THE NEXT TRACK JMP TRK,I NOW GO BACK * * DM96 DEC -96 DM1K DEC -1024 D6144 DEC 6144 WORD NOP D18 DEC 18 *THIS IS A GENERAL PURPOSE DISC PATCH SUBROUTINE * CALLING SEQUENCE JSB SYRUW * A REG = MEMORY ADDRESS (LOCATION) * B REG = REPLACEMENT VALUE * THE MEMORY LOCATION WILL BE CHANGED TO A DISC ADDRESS * AND THE CONTENTS OF THE B REG WILL BE PLACED THERE * THIS ROUTINE SHOULD ONLY BE USED TO MODIFY OP SYSTEM * LOCATIONS !!!!!! * SYRUW NOP UPDATE $BGFR & $RTFR ON DISC SWP FIX FROM DFINE TO WORK IN LOADR (CMM) STB UPDT1 JSB TRK GET THERE TRACK ADDRESS JSB UREAD READ THEIR SECTOR LDA WORD GET THE ADDRESS ADA ALBUF WITHIN THE SECTOR LDB UPDT1 GET CONTENTS OF THE NEW $RTFR WORD STB A,I STICK IT INTO THE BUFFER * ISZ P1 NOW MAKE IT A WRITE JSB UREAD PATCH ON DISC CLA,INA FIX P1 STA P1 JMP SYRUW,I UPDT1 NOP * SKP * OUTPUT ABSOLUTE PROG WORD * * ABOUT PUTS OUT THE CURRENT ABSOLUTE PROG WORD. * * IF THE CURRENT PROGRAM WORD IS TO BE LOCATED IN A DIFFERENT * SECTOR FROM THE CURRENT SECTOR, THE CURRENT SECTOR IS WRITTEN ON * THE DISK AND THE APPROPRIATE SECTOR READ. * * * CALLING SEQUENCE: * A = CURRENT PROGRAM WORD * B = ADDRESS * DTBL SET UP AS FOLLOWS: *DTBL DEF BASE MEMORY ADDRESS * DEF BASE TRACK OFSET -STRAK * DEF BASE SECTOR OFSET -SSECT * * JSB ABOUT * * RETURN: CONTENTS OF A AND B ARE DESTROYED * ABOUT NOP STB TEMPQ SAVE THE ADDRESS STA TEMPP SAVE ABSOLUTE PROG WORD LDA DTBL,I SUBTRACT FWA OF CMA,INA AREA FROM CURRENT ADA B ADD CURRENT RELOCATION ADDR. STA RELAD SAVE RELATIVE ADDR. LDA MSIGN SET ABT14 TO INA BE 100001 FOR NO SUSPENSION, STA ABT14 1 TRACK ALLOCATION. * CLA,INA IF FLAG SAYS DUMMY BASE PAGE CPA ABT12 AREA IS BEING OUTPUT, JMP AB0 SKIP OVERFLOW CHECK. * CMB,INB FROM LWA OF AREA. ADB LWA -ERROR SSB IF AREA IS JMP LGERR EXCEEDED. * AB0 CLB DIVIDE RELATIVE ADDR LDA RELAD BY 64 (SECTOR SIZE). DIV P64 STB SPOS SAVE REMAINDER (POSITION) ADA DTBL+2,I ADD STARTING SECTOR OF PROG.=0 IF MAIN CLB DIVIDE BY # OF DIV TRKS# SECTORS PER TRACK. CLE SET FOR ERB,RBL EVEN SECTOR BOUNDARIES STB TSECT SAVE SECTOR # IN TRACK. LDB P64 SEZ,RSS IF SECTOR WAS ODD JMP *+3 * ADB SPOS OFFSET POSITION TBY 64 STB SPOS ADA DTBL+1,I ADD THE PGRM BASE TRACK AND(=0 IF MAIN) STA B SAVE FOR TEST OF OVERFLOW ADA TRAKB ADD IN TRACK BASE ADDR. STA TTRAK SAVE AS ABSOLUTE TRACK # LDA #TRAK SUBTRACT # OF TRACKS ALLOCATED CMA,INA FROM RELATIVE TRACK #, ADA B A POSITIVE RESULT MEANS TRACK SSA,RSS OVERFLOW, GO TO JMP AB3 OVERFLOW SECTION. * * TRACK/SECTOR OF CURRENT WORD IS DETERMINED. * LDA TTRAK CHECK FOR CURRENT TRACK/SECTOR CPA DTRAK = TRACK/SECTOR IN CORE. RSS TRACKS =. JMP AB1 LDA TSECT CHECK FOR SECTOR CPA DSECT # NEEDED. JMP AB2 -CURRENTLY IN CORE. * * WRITE OUT SECTOR IN CORE, READ IN NEW SECTOR * AB1 JSB DWRIT WRITE CURRENT SECTOR. LDA TTRAK SET STA DTRAK NEW LDA TSECT TRACK/SECTOR #'S. STA DSECT JSB DREAD READ IN DESIRED SECTOR. * AB2 LDB ADBUF ADD POSITION IN SECTOR OF NEW ADB SPOS WORD TO ADDR OF DBUF. LDA TEMPP STORE ABSOLUTE WORD INTO STA B,I DBUF CLA,INA RETURN IMMEDIATELY IF DUMMY CPA ABT12 BASE PAGE AREA IS JMP ABOUT,I BEING OUTPUT * * CHECK FOR NEW UPPER BOUND * LDA TEMPQ ABSOLUTE LOAD ADDR, INA ADD 1, STA B SAVE. CMA,INA -SUBTRACT THIS ADDR ADA TH2.L FROM CURRENT UPPER BOUND, SSA IF CURRENT IS LARGER, * * SET UP TH2.L HIGH LOAD +1 !!!!!!!!!!!!! * STB TH2.L SET NEW ADDR. LDA SEG.L GET THE SEG.L FLAG CPA P2 THIS A SEGMENT ? RSS YES. JMP ABOUT,I NO, JUST RETURN LDA SHIGH,I GET THE PAST HIGH CMA,INA ADA B IS THIS HIGH BIGGER ? SSA,RSS WELL ? STB SHIGH,I YES, SO SET UP NEW HIGH MAIN +SEG + 1 JMP ABOUT,I * TEMPQ NOP * * * OVERFLOW OF TRACK ALLOCATION * AB3 LDB TRAKB GET THE BASE TRACK ADB #TRAK ADD IN THE # OF TRACKS SO FAR LDA TRKLU GET THE LU OF THE TRACK CPA P3 = LU # 3 ? ADB TATSD YES SO ADD IN # OF TRKS ON SYS DISK ADB TAT NOW ADD ADDRESS OF START OF TAT XLA B,I THIS TRACK FREE ? SZA WELL ? JMP AB10 NO * ISZ #TRAK YES SO BUMP TRACK # LDA XEQT GET MY ID ADDRESS JSB SYSET POST TO TAT JMP AB0 AND CONTINUE LOADING * AB10 LDA #TRAK SAVE STA ABT1 CURRENT LDA TRAKB VARIBLES STA ABT2 ASSOCIATED STA ABT9 LDA TRKLU WITH STA ABT3 TRACK LDA TRKS# ALLOCATION STA ABT4 LDA SSECT STA ABT5 LDA STRAK STA ABT6 * JSB DWRIT WRITE OUT CURRENT SECTOR. ISZ #TRAK CLB SET UP TO MPY LDA #TRAK MPY NO. OF TRACKS MPY ABT4 TIMES SECTS PER TRACK SZB ONE WORD HLT 3 SSA 15 BITS HLT 4 CMA,INA NEG TOTAL # SECTS REQUIRED STA #SECT SAVE OFF JSB ITRAK LARGER THAN PREVIOUS. * LDA ABT2 OLD TRAKB + OLD #TRAK ADA ABT1 TO ABT7 FOR LIMIT STA ABT7 ON MOVE. LDA TRAKB STA ABT8 CLA SET STARTING STA ABT10 SECTOR # = 0 FOR BOTH STA ABT11 SOURCE AND DESTINATION TRACKS. * * MOVE PREVIOUS INFORMATION TO NEW SET OF TRACKS * AB11 JSB EXEC READ SECTOR DEF *+7 DEF P1 DEF ABT3 SOURCE LOGICAL UNIT DEF DBUF DBUF INPUT DEF P128 DEF ABT9 CURRENT TRACK DEF ABT10 CURRENT SECTOR * JSB EXEC WRITE SECTOR DEF *+7 DEF P2 DEF TRKLU DESTINATION LOGICAL UNIT DEF DBUF DEF P128 DEF ABT8 CURRENT TRACK DEF ABT11 CURRENT SECTOR * LDA ABT10 UPDATE SOURCE ADA P2 SECTOR #. CPA ABT4 IF = TO # SECTORS PER TRACK, CLA RESET TO ZERO STA ABT10 AND RESTORE. SZA,RSS IF RESET ISZ ABT9 ADD 1 TO CURRENT TRACK #. LDA ABT9 CHECK FOR TERMINATION CPA ABT7 TRACK #. JMP AB12 -YES. * LDA ABT11 UPDATE DESTINATION ADA P2 SECTOR #. CPA TRKS# IF = TO # SECTORS PER TRACK CLA RESET TO ZERO STA ABT11 AND RESTORE. SZA,RSS IF RESET, ISZ ABT8 ADD 1 TO CURRENT TRACK #. LDA TRAKB CHECK FOR POSSIBLE ADA #TRAK OVERFLOW OF NEW CPA ABT8 ALLOCATION. HLT 0 ?????????????????????????????????????? JMP AB11 -NO, CONTINUE COPY * AB12 LDA TRAKB SET UP "DREAD" STA DTRAK AND CLA READ IN SECTOR 0 STA DSECT OF FIRST TRACK JSB DREAD TO INITIALIZE. * * RELEASE OLD SET OF TRACKS * JSB EXEC DEF *+5 DEF P5 DEF ABT1 DEF ABT2 DEF ABT3 * LDA ABT5 RESET RELATIVE STA SSECT STARTING TRACK AND SECTOR LDA ABT6 FOR CURRENT STA STRAK LOAD. * * ADJUST RELATIVE DMAN IN SEGMENTS' IDS IF * PROCESSING SEGMENTS (MAIN'S RELATIVE * DMAN IS ALREADY SET UP - ZERO). * CLA,INA CPA ID# IF PROCESSING SEGMENTS RSS JMP AJST THEN ADJUST THEIR DMAN * * CHECK FOR DIFFERENT SIZE DISCS * LDA ABT4 IF # OF SECTORS IS THE SAME CPA TRKS# ON BOTH ALLOCATIONS, JMP AB0 THEN CONTINUE TO LOAD. * CLA IF NOT DOING MAIN/SEGMENT CPA SEG.L LOADING, THEN ALSO JMP AB0 CONTINUE TO LOAD. * * NEED TO ADJUST BASE TRACK/SECTOR BASES FOR * MAIN AND SEGMENTS. * * AJST LDA ID# SET INDEX AS # OF DEFINED CMA,INA DUMMY ID SEGMENTS STA ABT1 FOR MAIN/SEGMENT. CCB SET 'STRAK' & 'SSECT' TO STB ABT7 BE SET ONLY ONCE. LDA FXS.L (A)= STARTING ADDR. * AB14 ADA P8 SET (ABT2) = ADDR OF ID STA ABT2 SEGMENT WORD (DISC ADDR) ISZ ABT1 IF ABOUT TO UPDATE MAIN'S ID RSS JMP AB0 THEN AVOID - DMAN ALREADY ZERO. LDA ABT2,I GET DISC ADDR AND M177 ISOLATE AND SAVE STA ABT5 SECTOR #. LDA ABT2,I GET AGAIN ALF,ALF FOR RAL ISOLATING AND M377 TRACK #. MPY ABT4 MULTIPLY BY PREVIOUS # SECT/TRAK ADA ABT5 ADD SECTOR BASE, CLB DIVIDE BY NEW TRKS# TO GET NEW DIV TRKS# TRACK/SECTOR BASE. ISZ ABT7 IF 'STRAK' & 'SSECT' SET ONCE JMP *+3 THEN DO NOT MODIFY AGAIN. STA STRAK SET RELATIVE TRACK & SECTOR STB SSECT ADDR FOR NEXT ID SEGMENT. ALF,ALF ROTATE TRACK TO 14-07, RAR AND -OR- SECTOR # IOR B INTO 06-00, STA ABT2,I RESTORE WORD IN ID SEGMENT. LDA ABT2 (A)= ID SEGMENT (DUMMY) ADDR. INA JMP AB14 -CONTINUE TO PROCESS. * P22 DEC 22 ABT1 NOP TEMPORARY ABT2 NOP ABT3 NOP STORAGE ABT4 NOP ABT5 NOP FOR ABT6 NOP ABT7 NOP "ABOUT" ABT8 NOP ABT9 NOP ROUTINE. ABT10 NOP ABT11 NOP ABT12 NOP ABT13 NOP ABT14 NOP SPC 1 SKP * * SUBROUTINE: "MVIDS" MOVE ID SEGMENT * * PURPOSE: THIS IS A GENERAL ROUTINE TO PROCESS * THE DUMMY ID SEGMENTS GENERATED DURING * BOTH A NORMAL LOAD AND AN EDITING * OPERATION. IT PERFORMS THE FOLLOWING * FUNCTIONS ACCORDING TO THE TYPE OF * LOAD OPERATION: * * 1) NORMAL BG LOAD: * * -FIND BLANK ID SEGMENT * -MOVE DUMMY ID SPECIFIED BY * THE CONTENTS OF "FXS.L" TO * THE POSITION OF THE BLANK * ID SEGMENT IN THE SYSTEM AREA. * * 2) EDITING OPERATION: * * ADDITION: SAME AS FOR A NORMAL * LOAD EXCEPT THAT THE NEW * ID SEGMENT IS WRITTEN IN THE * APPROPRIATE AREA ON THE SYSTEM * DISC TO MAKE THIS A PERMANENT * ADDITION. * * * * CALLING SEQUENCE: (FXS.L) = ADDR. OF DUMMY * ID SEGMENT * * (A):= 0 FOR NORMAL LOAD * * = 1 FOR EDITING ADDITION * * (B) = ID SEGMENT ADDR IF A * PARTICULAR ONE IS TO * BE USED FOR ADDITION. * * (P) JSB MVIDS * (P+1) -ERROR - NO BLANK ID'S- * (P+2) - NORMAL RETURN- * SKP * MVIDS NOP JSB $LIBR GO PRIVILEDGED !!!!!!!!!!!!!!!!!!! NOP STA ABT10 SAVE EDIT NO-EDIT FLAG STB ABT11 SAVE DESTINATION ID ADDR * LDA DESA INITIALIZE DESTINATION STA DESAM ADDR ARRAY PNTR. LDA KLUGE GET THE KLUGE FLAG SZA,RSS ARE WE DOING THE STUPID SYS MOVE JMP DMYMV NO, THEN IT IS IN DUMMY. * * SOURCE ID IS IN SYSTEM AREA AND SO DESTINATION * MUST BE SPECIFIED. ONLY MEM1 TO DMAN NEED TO * BE MOVED FROM SOURCE TO DESTINATION. * THIS KLUGE WAS NOT MY DOING (C.M.M.) * LDB FXS.L ADB P14 (B) = NAM5 ADDR OF SOURCE ID JSB MEM? GET ADDR OF MEM1 NOP STB SRADR SET FWA OF SOURCE LDB ABT11 GET DESTINATION ID ADDR ADB P14 (B)=NAM5 ADDR OF DESTINATION ID JSB MEM? GET ADDR OF MEM1 NOP LDA N5 SET MOVE COUNT = 5 WORDS STA NUMWD FOR MEM1 TO DMAN. JSB STRFR TRANSFER ADDRES INTO ARRAY JMP MOVID MOVE TO SYSTEM AREA * * SET ADDRESS ARRAY FOR CONSEQUETIVE MOVE. * (A) = NUMBER OF WORDS TO BE MOVED * (B) = FIRST WORD DESTINATION ADDR * STRFR NOP SADRS STB DESAM,I SET DESTINATION ID WORD ADDR ISZ DESAM MOVE UP TO NEXT ARRAY STORAGE INB BUMP ID WORD ADDR INA,SZA ALL ADDRES STORED ? JMP SADRS NO, THEN CONTINUE. JMP STRFR,I RETURN * * * SOURCE ID IS IN DUMMY AREA. SET SOURCE * ADDRESS AND COUNT AND ALSO CHECK IF * DESTINATION ID HAS BEEN SPECIFIED. * * DMYMV LDB FXS.L SET ADDR STB SRADR OF SOURCE ID. LDA ID# CHECK IF SOURCE CMA,INA ID IS FOR CPA ID## MAIN (LONG ID) ? CLA,RSS SET FLAG FOR LONG ID = 0 CCA SET FLAG FOR SHORT ID = -1 STA SSFLG SOURCE ID TYPE FLAG LDB N9 SET MOVE COUNT=-9 (SHRT ID) SZA,RSS IF LONG ID LDB N20 THEN SET MOVE COUNT=-20. STB NUMWD JSB BLKID GET CURRENT ID EXT LDB ABT11 GET DESTINATION ID ADDR SZB,RSS DESTINATION SPECIFIED ? JMP FBLNK NO, THEN USE BLANK ID. * * DESTINATION ID HAS BEEN SPECIFIED * ADB P14 (B)=NAM5 ADDR OF DESTINATION ID JSB MEM? FIND IF ID LONG OR SHORT. CCB,RSS SHORT ID, SET (B)=-1. CLB LONG ID, SET (B)=0. SZB DESTINATION ID LONG ? JMP SCHK NO, GO CHECK SOURCE ID. CPB SSFLG YES. IS SOURCE ID ALSO LONG. JMP DB13B YES, THEN SET 13 WORD TRANSFER. JMP SDS9B NO, SET 9 TO 13 WORD TRANSFER. SCHK CPB SSFLG IS SOURCE ID SHORT TOO ? JMP DS9S YES, SET 9 TO 9 WORD TRANSFER. MBACK JSB $LIBX ERROR RETURN (LONG TO SHORT ILLEGAL). DEF MVIDS * * FIND BLANK ID OF APPROPRIATE LENGTH * FBLNK JSB NAMOK SEE IF PROG NAME STILL OK. LDB SSFLG GET SOURCE ID FLAG SZB,RSS SOURCE ID SMALL ? JMP SLNG NO, ANALYZE FOR LONG ID. LDA BID4 SET ADDR OF SMALL ID STA ABT11 W/O DISC ALLOCATION. LDB BID8 GET # OF SMALL IDS W/O DISC ALLOC SZB ANY SMALL IDS W/O DISC ALLOCATION ? JMP DS9S YES, SET 9 WORD SMALL-TO-SMALL TRFR LDA BID3 SET ADDR OF SMALL ID STA ABT11 WITH LEAST DISC ALLOCATION. LDB BID6 (B)=3 SMALL IDS WITH & W/O DSC ALLOC SZB ANY AVAILABLE ? JMP DS9S YES, SET 9 WORD SMALL-TO-SMALL TRFR * SLNG LDB BID7 GET # OF LONG IDS W/O DISC ALLOC LDA BID2 (A)=LONG ID ADDR W/O DISC ALLOC SZB ANY LONG ID W/O DISC ALLOCATION ? JMP SSCHK YES LDA BID1 (A)=LONG ID ADDR WITH LEAST DSC ALLOC LDB BID5 (B)=# OF LONG IDS WITH & W/O DSC ALLC SZB,RSS ANY LONG ID WITH DISC ALLOCATION ? JMP OSHIT NO, DO ERROR RETURN. * SSCHK STA ABT11 SET DESTINATION ID ADDR LDA SSFLG GET SOURCE ID FLAG SZA,RSS SOURCE ID LONG ? JMP DB13B YES, SET 13 WORD BIG-TO-BIG TRANSFER SKP SDS9B LDB FXS.L ADB P3 (B)=NAM5 ADDR IN SHORT ID LDA B,I GET NAM5 WORD CONTAINING 'SS' BIT XOR M20 MASK OFF 'SS' BIT STA B,I AND STORE BACK NAM5 * * * TRANSFER FROM SMALL ID IN DUMMY AREA TO * BIG ID IN SYSTEM AREA. * LDB ABT11 GET DESTINATION ID ADDR ADB P7 (B)=ADDR OF PRIM ENTRY POINT STB DESAM,I SET ADDR IN ARRAY ISZ DESAM ADB P5 (B)=ADDR OF NAM12 LDA N3 (A)=-3 FOR TRFR OF NAM12 TO NAM5 JSB STRFR TRANSFER ADDR PNTRS ADB P7 (B)=ADDR OF MEM1 LDA N5 (A)=-5 TO TRFR MEM1 TO DMAN PNTRS JSB STRFR TRANSFER MEM1 TO DMAN ADDRES JMP MOVID DO MOVE TO SYSTEM AREA * * * TRANSFER FROM SMALL ID IN DUMMY AREA TO * SMALL ID IN SYSTEM AREA. * DS9S LDB ABT11 (B)=DESTINATION ID ADDR ADB P11 POSITION TO PRENT OF ID SEG LDA N9 (A)=-9 TO TRANSFER 9 WORDS JSB STRFR TRANSFER ADDR PNTRS JMP MOVID DO MOVE TO SYSTEM AREA * N3 DEC -3 P11 DEC 11 * * TRANSFER FROM BIG ID IN DUMMY AREA * TO BIG ID IN SYSTEM AREA. * DB13B LDB ABT11 GET DESTINATION ID ADDR ADB P31 INDEX TO 2ND SESSION WORD XLA B,I & PULL IT IN. AND B170K KEEP ONLY UPPER 4 BITS IOR COPY? SET UP THE COPY BIT IOR OWNER AND THE OWNER WORD STA SESW2,I & SET INTO THE 2ND SESSION WORD. * LDB ABT11 GET DESTINATION ID ADDR AGAIN ADB P6 (B)=ADDR OF PRIORITY WORD LDA N2 (A)=-2 TO TRFR PRIOTY & PRM EN PNT JSB STRFR TRANSFER ADDR PNTRS ADB P4 (B)=ADDR OF NAM12 LDA N3 (A)=-3 TO TRFR NAM12 TO NAM5 PNTRS JSB STRFR TRANSFER ADDR PNTRS ADB P2 (B)=ADDR OF RESL WORD LDA N3 (A)=-3 FOR RESL TO TMDY2 ADDR TRFR JSB STRFR TRANSFER ADDR PNTRS ADB P2 (B)=ADDR OF MEM1 LDA N5 (A)=-5 FOR MEM1 TO DMAN ADDR TRFR JSB STRFR TRANSFER ADDR PNTRS INB (B) = ADDR OF EMAID LDA N5 A = -5 FOR EMAID TO SESW3 JSB STRFR TRANSFER ADDRESS POINTERS * * * * LDA EMA.L GET THE EMA FLAG SZA ANY DECLARED ? JMP DOEMA YES LDA N18 NO. CHANGE THE MOVE COUNT STA NUMWD TO 18. (IE DON'T USE ID EXTENSION) JMP MOVID GO MOVE THE DUMMY ID SEGMENT * DOEMA LDB BID9 GET THE ADDRESS OF THE ID EXT TO USE SZB,RSS IS THERE ONE ? JMP LL20. NO, EN ERROR LDA N2 SET FOR TRANSFER (ADDRESS IF ID EXTENSION) JSB STRFR SET UP THE POINTERS * LDA BID10 GET THE ID EXT # ALF,ALF ROTATE TO UPPER END RAL,RAL LDB EMS.L GET THE EMA SIZE SZB,RSS WAS IT DEFAULTED INA SET A FLAG ADA B NO, SO USE SPECIFIED SIZE STA EMAID,I AND PUT IN DUMMY ID SEGMENT * * SKP * * * MOVE INTO SYSTEM ID AREA TAKES PLACE FROM * SOURCE (FIRST WORD ADDR IN 'SRADR' AND * AND BUMPED CONSEQUETIVELY) TO DESTINATION * (ADDRESS POINTERS SET UP IN 'DESAM' ARRAY). * NUMBER OF WORDS TO BE MOVED IS IN 'NUMWD'. * * KLUGE INDICATES THAT THE SOURCE IS ALSO IN * THE SYSTEM AREA (AS OPPOSED TO THE DUMMY AREA) * AND THEREFORE ONE MUST USE CROSS MAP LOADS TO GET IT * MOVID LDB DESA INITIALIZE DESTINATION STB DESAM ADDR ARRAY PNTR. LDB SRADR AND SOURCE TOO. STB SRAD2 LDB NUMWD STB NUMW2 ALSO # OF WORDS TO MOVE KEPON LDB KLUGE ARE WE DOING KLUDGY SZB SYS ID TO SYS ID? JMP KEPNX YES, GO DO CROSS MAP LDA SRADR,I NO, GET WORD FROM SOURCE ID JMP *+3 AND CONTINUE KEPNX XLA SRADR,I KLUDGE - DO CROSS MAP LDB DESAM,I (B)=ADDR OF DESTINATION ID WORD XSA B,I STORE IN SYSTEM ID ISZ DESAM BUMP DESTINATION ARRAY ADDR ISZ SRADR BUMP SOURCE ADDR OF ID WORD ISZ NUMWD ALL WORDS MOVED ? JMP KEPON NO, DO MORE. * JSB $LIBX RESTORE INTERUPT DEF *+1 PROCESSING DEF *+1 * CLA CLEAR SESSION WORD FOR DISC XFER STA SESW3,I LDA COPY? STA SESW2,I & KEEP ONLY COPY BIT FOR DISC * * LDB ABT10 GET THE EDIT FLAG SZB,RSS PERM ADDITION ? JMP NODSK NO, SO DON'T USE THE DISC * LDB DESA INITIALIZE SOURCE POINTERS STB DESAM DODSK LDB KLUGE ARE WE DOING KLUDGE? SZB SYS ID MOVE TO SYS ID? JMP DDSKX YES, GO DO XMAP LOAD LDA SRAD2,I NO, JUST GET THE WORD JMP *+3 AND KEEP GOING DDSKX XLA SRAD2,I KLUDGE - CROSS MAP LOAD LDB DESAM,I GET THE DESTINATION JSB SYRUW FIX THE DISC ISZ DESAM ISZ SRAD2 ISZ NUMW2 ARE WE DONE ? JMP DODSK NO, SO PLAY IT AGAIN SAM * NODSK ISZ MVIDS SET UP THE SUCCESSFUL RETURN * LDB ABT11 ADB P14 GET THE PROG TYPE WE JUST LAID DOWN XLA B,I AND P7 CPA P5 SEGMENT ? JMP MVIDS,I YES, SO WERE DONE. * LDB ABT11 MAIN, SO DO SOME MORE PROCESSING STB #IDAD SAVE THE ID ADDRESS * LDA PG.PT GET PAGES/ PART'N WORD ADB P21 AND ADDRESS JSB SYSET AND SET UP THE WORD * LDB ABT10 PERM LOAD ? SZB,RSS JMP MVIDS,I NO, WE'RE DONE * LDA PG.PT LDB ABT11 ADB P21 JSB SYRUW * JMP MVIDS,I **RETURN** * * 'MVIDS' CONSTANTS * NUMWD NOP NUMBER OF WORDS TO BE MOVED SRADR NOP FWA OF SOURCE ID MOVE DESA DEF MVBUF ARRAY CONTAINING ADDRES * IN DESTINATION ID AREA DESAM NOP CURRENT PNTR TO ARRAY SSFLG NOP 0 FOR LONG, -1 FOR SHORT SOURCE ID LL21 LDA ERR21 JMP ABOR P31 DEC 31 N18 DEC -18 NUMW2 NOP SRAD2 NOP * OSHIT JSB $LIBX RETURN TO INTERUPT PROCESSING DEF *+1 DEF *+1 LDA SSFLG LONG OR SHORT ID ? JMP NOIDS LONG LDA ERR26 SHORT JMP ABOR ABORT THYSELF WITH A L-26 ERROR B170K OCT 170000 COPY? NOP 0/2000 COPIES OK/DON'T COPY OWNER NOP OWNER WORD FOR TARGET ID SEG * SKP * * THE NAMOK ROUTINE CHECKS THE IDS IN THE SYSTEM TO MAKE * SURE THAT THE PROGRAM JUST RELOCATED STILL HAS A UNIQUE * NAME. THAT IS, THAT SOMEBODY DIDN'T SNEAK AN RP IN ON US. * * * NAMOK NOP LDA SSFLG GET THE LONG/SHORT ID FLAG LDB FXS.L AND THE DUMMY ID ADDRESS SSA,RSS SHORT OR LONG ? INB 0 = LONG INB -1 = SHORT * STB NAM12 INB SET UP NAME FOR TEST STB NAM34 INB STB NAM5 * CCA SET UP FLAG FOR # OF TESTS STA NMFLG SET PROG NAME FLAG * ONEMR JSB MIDN FIND THE ID IF ONE JMP NAMOK,I NONE SO OK LDA P2 IF OPERATION IS REPLACEMENT CPA EDFLG EDITING, IGN.LE DUPLICATE, JMP NAMOK,I AND CONTINUE. * LDA NAM12,I GET THE NAME STA MESS7+12 AND PUT IN DUPLICATE PROG LDA NAM34,I NAME MESSAGE BUFFER STA MESS7+13 LDA NAM5,I STA MESS7+14 LDA P27 LDB MESS7 MESS7 = ADDR: DUPLICATE PROG NAM * JSB $LIBX RETURN TO INT PROCESSING DEF *+1 DEF *+1 * JSB SYOUT PRINT: DUPL. PROG NAME ISZ NMFLG SKIP - TRY RESETTING PROG NAM JMP IDSN2 ABORT THE GUY LDA RENAM GET ASCII '##' STA NAM12,I SET PROG NAME 1,2 = '..' LDB SSFLG IF MAIN, SET INTO OUTPUT MESSAGE SSB,RSS STA MESS4,I LDA P5 LDB NAM12 JSB SYOUT TELL THEM THE NEW NAME * JSB $LIBR NOP JMP ONEMR REPEAT DUPLICATE PROG NAME SCAN * SKP * * SUBROUTINE: "C#S" CALCULATE # SECTORS * * THIS ROUTINE CALCULATES THE TOTAL # OF WORDS * IN THE MAIN BODY AND BASE PAGE AREA FOR A PROG * AND DETERMINES THE # OF SECTORS REQUIRED. * * CALL: (A) = ADDRESS OF MEM1 IN ID SEGMENT * * (P) JSB C#S * (P+1) -RETURN- (A) = # SECTORS REQUIRED * * C#S NOP JSB SETAB * LDA ABT4,I DETERMINE CMA,INA # OF ADA ABT5,I MAIN WORDS STA ABT1 LDA ABT6,I DETERMINE CMA,INA # OF ADA ABT7,I BASE PAGE WORDS C#SXX CLB DIV P64 DIVIDE BP BY SZB 64 AND INA ROUND AND SLA SKIP IF EVEN SECTOR COUNT INA ELSE BUMP TO EVEN SECTOR COUNT STA ABT2 SAVE. CLB DIVIDE MAIN # WORDS LDA ABT1 BY 64, DIV P64 ROUND TO WHOLE SECTOR SZB INA SLA IF ODD SECTOR COUNT INA THEN MAKE EVEN. ADA ABT2 ADD TO BASE PAGE COUNT FOR TOTAL JMP C#S,I RETURN. * * * * * SUBROUTINE: "C#SMX" CALCULATE # SECTORS * * THIS ROUTINE CALCULATES THE TOTAL # OF WORDS * IN THE MAIN BODY AND BASE PAGE AREA FOR A PROG * AND DETERMINES THE # OF SECTORS REQUIRED. * IT USES CROSS LOADS BECAUSE THE ID SEGMENT IS NOT A * DUMMY ID SEGMENT, RATHER, IT IS AN ID IN MEMORY. * CALL: (A) = ADDRESS OF MEM1 IN ID SEGMENT * * (P) JSB C#SMX * (P+1) -RETURN- (A) = # SECTORS REQUIRED * * C#SMX NOP JSB SETAB * XLA ABT4,I DETERMINE CMA,INA # OF XLB ABT5,I MAIN WORDS ADA B STA ABT1 XLA ABT6,I DETERMINE CMA,INA # OF XLB ABT7,I BASE PAGE WORDS ADA B LDB C#SMX SET RETURN STB C#S JMP C#SXX * * SETAB NOP STA ABT4 INA STA ABT5 SET UP THE ADDR OF BOUNDS INA STA ABT6 INA STA ABT7 JMP SETAB,I * * SKP * * * * * * * * SUBROUTINE: "BLKID" * * THIS ROUTINE SCANS THE SYSTEM ID SEGMENTS AND * AND RECORDS THE FOLLOWING : * * BID1 = ADDRESS OF BIG ID WITH LEAST DISC ALLOC. * BID2 = ADDRESS OF BIG ID WITHOUT DISC ALLOCATION * BID3 = ADDRS OF SMALL ID WITH LEAST DISC ALLOC. * BID4 = ADDRS OF SMALL ID WITHOUT DISC ALLOCATION * BID5 = # OF BIG IDS WITH & WITHOUT DISC ALLOC. * BID6 = # OF SMALL IDS WITH & WITHOUT DISC ALLOC. * BID7 = # OF BIG IDS WITHOUT DISC ALLOCATION * BID8 = # OF SMALL IDS WITHOUT DISC ALLOCATION * BID9 = ADDRS OF 1ST AVAIL ID EXTENSION, = 0 IF NONE * BID10 = ORDINAL # OF THE FREE ID EXT * BID11 = # OF FREE ID EXTENSIONS * * (NOTE: ABOVE PARAMETERS ARE ZERO IF NOT SET) * * * CALL: (P) JSB BLKID * (P+1) -RETURN- * (A) = # AVAIL (SMALL+BIG) OR 0 * IF NO BIG AVAILABLE (TOTAL * INCLUDES WITH AND W/O DISC * ALLOCATION). * (B) = MEANINGLESS * BLKID NOP CLA CLEAR STA BID1 ADDR OF BIG WITH LEAST DISC ALLOC STA BID2 ADDR OF BIG WITHOUT DISC ALLOCATION STA BID3 ADDR OF SMALL WITH LEAST DISC ALLOC STA BID4 ADDR OF SMALL WITHOUT DISC ALLOC STA BID5 # OF BIG IDS WITH & WITHOUT DISC ALOC STA BID6 # OF SMALL IDS WITH & W/O DISC ALLOC STA BID7 # OF BIG IDS WITHOUT DISC ALLOCATION STA BID8 # OF SMALL IDS W/O DISC ALLOCATION STA BID9 ADDRESS OF FREE ID EXT STA BID10 FREE ID EXTENSION'S ORDINAL # STA BID11 # OF FREE ID EXTENSIONS STA DISPS CLEAR DISC ALLOC FOR SHORT ID STA DISPL AND FOR LONG ID LDA KEYWD INITIALIZE ADDR OF STA KEYPT KEYWORD LIST. * XLA $IDEX GET THE ADDR OF ID EXTENSION BLOCK STA IDEX AND SAVE JMP *+3 CNTEX ISZ IDEX BUMP POINTER ISZ BID10 BUMP ID EXTENSION # XLA IDEX,I GET THE ADDRESS SZA,RSS IF END OF LIST JMP BLK1A GO TO ID SEGS XLB A,I ELSE GET THE CONTENTS OF 1ST WORD SZB IS THIS ONE FREE ? JMP CNTEX NO STA BID9 SAVE THE ADDRESS ISZ BID11 COUNT IT AS FREE NXIDX ISZ IDEX BUMP POINTER XLA IDEX,I GET THE ADDRESS SZA,RSS FINISHED ? JMP BLK1A YES, COUNT REST OF IDS XLA A,I GET THE 1ST WORD SZA,RSS IS IT FREE ? ISZ BID11 YES, SO COUNT IT JMP NXIDX GO LOOK AT THE NEXT ONE * BLK1 ISZ KEYPT BUMP KEYWORD ADDR BLK1A XLB KEYPT,I GET KEYWORD SZB,RSS IF END OF LIST JMP BLK3 THEN GO TO SET COUNTS. ADB P12 (B)=ADDR OF NAM12 CLA STA FLGSS CLEAR ID TYPE FLAG XLA B,I IF NAM12=0 SZA,RSS THEN ITS A BLANK ID JMP BLK2 CPA P1 CHECK FOR REPLACE OPERATION FLAG JMP BLK2 CPA P2 JMP BLK2 * JMP BLK1 ELSE CONTINUE SCAN * * ANALYZE BLANK ID * BLK2 ADB P2 (B)=ADDR OF NAM5 JSB MEM? FIND IF ID LONG OR SHORT CCA,RSS SHORT ID, SET (A)=-1. CLA LONG ID, SET (A)=0. STA FLGSS SET ID TYPE FLAG ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DMAN SZA ANY DISC ALLOCATION ? JMP DSCAL YES * LDA FLGSS GET SHORT/LONG ID FLAG SZA,RSS LONG ID ? JMP LGND YES ISZ BID8 BUMP COUNT FOR SHORT ID W/O DSC CLA XLB KEYPT,I GET ID SEG ADDR CPA BID4 ADDR OF 1ST SMALL W/O DSC SET ? STB BID4 NO, SET ADDR OF SMALL ID. JMP BLK1 YES, CONTINUE SCAN. LGND ISZ BID7 COUNT LONG ID W/O DSC ALOC. XLB KEYPT,I GET ID SEG ADDR CPA BID2 ADDR OF 1ST BIG W/O DSC SET ? STB BID2 NO, SET ADDR OF LONG ID. JMP BLK1 YES, CONTINUE SCAN. * * P15 DEC 15 * DSCAL XLA KEYPT,I GET ID SEG ADDR ADA P15 (A)=ADDR OF MEM1 OF SHORT ID LDB FLGSS GET ID TYPE FLAG SZB,RSS LONG ID ? JMP DLGND YES,ADJUST (A) FOR MEM1 OF BIG ID. JSB C#SMX DETERMINE # OF SECTORS LDB DISPS GET DISC ALLOC COMPARATOR SZB,RSS ANY DISC ALLOC SET UP YET ? JMP SHNEW NO, THEN SET THIS ONE. STA B SAVE SEC COUNT TEMPORARILY CMA,INA SUBTRACT THIS SPACE FROM PREVIOUS ADA DISPS SSA IS THIS DISC SPACE < PREVIOUS ? JMP SHCNT NO, LET PREVIOUS BE THERE. LDA B RESTORE SECTOR COUNT SHNEW STA DISPS SET DISC SPACE ALLOCATION XLB KEYPT,I SET ADDR OF SMALL ID WITH STB BID3 LEAST DISC ALLOCATION. SHCNT ISZ BID6 COUNT SHORT IDS WITH DISC ALLOC JMP BLK1 CONTINUE SCAN * DLGND ADA P7 (A)=MEM1 ADDR OF LONG ID JSB C#SMX DETERMINE NUMBER OF SECTORS LDB DISPL GET DISC ALLOC COMPARATOR SZB,RSS ANY ALLOC SET UP YET ? JMP LGNEW NO, THEN SET THIS ONE IN. STA B SAVE SECTOR COUNT TEMPORARILY CMA,INA SUBTRACT THIS ALLOC ADA DISPL FROM PREVIOUS. SSA IS THIS ALLOC LESS ? JMP LGCNT NO LDA B RESTORE SECTOR COUNT LGNEW STA DISPL SET ALLOCATION XLB KEYPT,I SET ADDR OF LONG ID STB BID1 WITH LEAST ALLOCATION. LGCNT ISZ BID5 COUNT LONG IDS WITH JMP BLK1 DISC ALLOCATION & CONTINUE SCAN. * BLK3 LDA BID8 SET BID8= # OF SMALL IDS ADA BID6 WITH AND WITHOUT STA BID6 DISC ALLOCATION. LDA BID7 SET BID5= # OF LONG IDS ADA BID5 WITH AND WITHOUT STA BID5 DISC ALLOCATION. SZA,RSS ANY BIG IDS AVAILABLE ? JMP BLKID,I NO, RETURN WITH (A)=0. ADA BID6 YES, RETURN WITH (A) = TOTAL JMP BLKID,I NUMBER OF IDS. * * * CONSTANTS * BID1 NOP BID2 NOP BID3 NOP BID4 NOP BID5 NOP BID6 NOP BID7 NOP BID8 NOP BID9 NOP BID10 NOP BID11 NOP FLGSS NOP =0 FOR LONG ID, NON-ZERO FOR SHORT IDEX NOP POINTER TO ID EXTENSION LIST DISPL NOP LONG ID SECTOR COUNT DISPS NOP SHORT ID SECTOR COUNT KEYPT NOP KEYWORD * SKP * * SUBROUTINE: "ITRAK" -INTIIALIZE TRACK ALLOCATION * * CALL: "#TRAK" CONTAINS # OF TRACKS * TO BE ALLOCATED * "#SECT" CONTAINS -# OF SECTORS * REQUIRED * * A AND B MEANINGLESS * (P) JSB ITRAK * (P+1) -RETURN- A AND B MEANINGLESS * * THE FOLLOWING WORDS OF STORAGE ARE SET * AND ALL TRACKS HAVE BEEN SET TO ZERO: * * #TRAK - # OF TRACKS ALLOCATED * TRAKB - STARTING TRACK # (BASE TRACK) * TRKLU - LOGICAL UNIT OF DISC * TRKS# - # OF SECTORS PER TRACK * * IF THE TRACK ALLOCATION CANNOT BE MADE, THE * LOADER PRINTS THE MESSAGE * "/LOADR: WAITING FOR DISC SPACE" * AND REPEATS THE REQUEST WITH THE SUSPENSION * OPTION. THE LOADR CONTINUES WHEN TRACKS BECOME * AVAILABLE. THE LOADR MAY BE ABNORMALLY * TERMINATED BY THE OPERATOR IN THIS STATE. * * ITRAK NOP ITRK9 LDA #TRAK SET SIGN BIT OF #TRAK WORD IOR MSIGN FOR NO SUSPENSION IF TRACKS STA #TRAK NOT AVAILABLE. * ITRK1 JSB EXEC REQUEST DEF *+6 DISC DEF P4 SPACE DEF #TRAK DEF TRAKB DEF TRKLU DEF TRKS# * LDA #TRAK REMOVE RAL,CLE,ERA SIGN BIT FROM STA #TRAK # TRACKS WORD. CCA IF STARTING TRACK # = -1, CPA TRAKB THEN NO TRACKS AVAILABLE, JMP ITRK3 PRINT MESSAGE(WILL RETRY FOR 1ST ALLOC) * * * THE NUMBER OF SECTORS PER TRACK MAY DIFFER BETWEEN WHERE * THE LOADR HAS TRACKS NOW AND WHERE THE NEWLY REQUESTED * TRACKS ARE. CONSEQUENTLY, WE'D BETTER CHECK THE NUMBER OF * SECTORS WE REALLY WANT AGAINST THE NUMBER WE GET. * THE INITIAL REQUEST FOR TRACKS FALLS OUT BECAUSE #SECT= 0 * IE #SECTS IS NOT SET SO IT IS = 0 * * CLB SET UP TO MPY LDA #TRAK NO. OF TRKS MPY TRKS# TIMES SECTS PER TRK SZB SHOULD FIT IN ONE WORD HLT 1 SSA SHOULD FIT IN 15 BITS HLT 2 ADA #SECT SUBTRACT # OF SECTS REQUIRED * SSA,RSS HAVE ENOUGH? JMP ITRK2 POS,YES, CONTINUE * JSB EXEC NEG,NO,RELEASE DEF *+5 WHAT WE JUST GOT DEF P5 DEF #TRAK DEF TRAKB DEF TRKLU * ISZ #TRAK AND ASK FOR MORE JMP ITRK9 * * ITRK2 LDA TRKLU DSKUN = DISC'S STA DSKUN LU # LDA TRAKB ITRKB = STARTING TRACK # ADA #TRAK ITRK6 = ENDING TRACK STA ITRK6 # +1. * ISZ TKTRY NO MORE RETRYS ALLOWED JMP ITRAK,I RETURN * * PRINT WAITING MESSAGE * ITRK3 LDA TKTRY GET THE RETRY FLAG SZA,RSS CAN WE RETRY ? JMP ITRK4 YES * * ITRK8 LDA P22 GET THE BUFFER LENGTH LDB ITRKM JSB SYOUT JMP ITRK1 * * ITRK4 LDA #TRAK GET THE # WE ASKED FOR LAST TIME ADA N2 SUBTRACT 2 SZA,RSS DID WE ASK FOR 2 LAST TIME ? JMP ITRK5 YES ,SO FORGET IT CCA NO SO SUBTRACT ONE AND TRY AGAIN ADA #TRAK STA #TRAK JMP ITRK9 DO IT AGAIN * ITRK5 ISZ #TRAK BUMP REQUEST BACK TO 4 ISZ #TRAK JMP ITRK8 AND SUSPEND THYSELF * ITRKM DEF *+1 ASC 11,WAITING FOR DISC SPACE * ITRK6 NOP * * #TRAK DEC 4 # OF TRACKS ALLOCATED TRAKB NOP STARTING TRACK # (BASE TRACK) TRKLU NOP LOGICAL UNIT OF DISC TRKS# NOP # OF SECTORS PER TRACK SPOS NOP RELATIVE SECTOR POSITION TSECT NOP TEMPORARY SECTOR AND TTRAK NOP TRACK #. TKTRY NOP RETRY FLAG FOR TRACKS #SECT NOP NEG # OF SECTORS REQUIRED SKP * * 'EDIT' COMPLETION * ED00 LDA SEG.L GET MAIN/SEG FLAG SZA PROCESSING MAIN/SEG ? JMP ED18 YES * * SINGLE PROGRAM OPERATION * CLA,INA CHECK CPA EDFLG TYPE JMP ED10 ADDITION * * PROGRAM REPLACEMENT * E0D JSB MIDN FIND MATCHING ID SEGMENT JMP ED10 -NO, TREAT AS ADDITION. * ED0 STB ED25 SAVE MATCH ID ADDR. ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP STB A CALCULATE JSB C#SMX # SECTORS STA ED60 AND SAVE * LDB ED25 JSB COPY. ANY COPIES OF THIS PROG ? * LDB TAT NO, SO SET SIGN BIT XLA B,I ON SYS DISC TO TEST JSB SYRUW WRITE PROTECT BEFORE DAMAGE IS DONE * LDB ED25 ADB P12 SET ADDR OF NAM12 STB LH1 OF ID SEG. ADB P2 (B)=NAM5 ADDR OF MATCHED ID XLA B,I GET NAM5 AND AND P7 MASK IN PROG TYPE. STA SWPID SAVE THE TYPE FOR A MOMENT CPA P5 IS THIS A SEGMENT ? JMP ED004 YES, FORGET DORMANY CHECK. ADB N6 (B)=ADDR OF SUSPEND WORD XLA B,I POINT OF SUSPENSION? SZA ZERO - CONTINUE JMP ED003 SUSPEND ADB P7 GET XLA B,I STATUS: SZA DORMANT? JMP ED003 NO - SUSPEND ADB P2 GET XLA B,I TIME LIST: AND BIT12 IN LIST? SZA WELL JMP ED003 * * ADB P4 GET LAST PARTITION PROGRAM WAS IN XLA B,I AND M77 KEEP ONLY PARTITION MPY P7 NOW INDEX INTO $MATA TABLE XLB $MATA ADA B ADA P2 GET RESIDENT PROG XLA A,I CPA ED25 DID PROG TERM SERIALLY REUSABLE ? RSS YES, YOU LOSE JMP ED004 * * * SKP ED003 LDA P18 PRINT MESSAGE LDB MES70 JSB SYOUT PROG IS NON-DORMANT LDA ERR34 AND ABORT THYSELFZERO JMP ABOR * MES70 DEF *+1 ASC 9,SET PRGM INACTIVE BIT12 OCT 10000 LH1 NOP * ED004 LDB OPCOD GET THE OPERATION FLAG CPB P4 THIS A PURGE ? CLB,RSS YES, SET NAME = 0 CLB,INB SET REPLACE FLAG INTO ID * KEEPS OTHER LOADRS & FMGR HONEST JSB $LIBR TURN OFF INTERUPTS NOP XSB LH1,I ZERO ISZ LH1 NAME XSB LH1,I IN ISZ LH1 CORE XLA LH1,I ID AND M20 SEGMENT (LEAVE 'SS' BIT) XSA LH1,I * CLA LDB SWPID GET THE PROGRAM TYPE CPB P5 IS IT A SEGMENT ? JMP NOZAP FORGET ABOUT ID EXTENSION * LDA LH1 NOW GET THE ADDRESS OF ADA P14 THE ID EXT WORD XLA A,I PULL IT IN SZA,RSS ANY ID EXTENSION JMP NOZAP NO. * ALF YES RAL,RAL GET THE # TO LOW END AND M77 & KEEP ONLY THE # XLB $IDEX ADD START OF TABLE ADA B XLA A,I NOW HAVE THE ADDRESS CLB XSB A,I AND ZAP THE WORD NOZAP JSB $LIBX RESTORE DEF *+1 INTERRUPT DEF *+1 SYSTEM * SZA,RSS WAS THERE AN ID EXT ? JMP TKREL NO, GO RELEASE THE TRACKS SWP YES, SO ZAP THE DISC AS WELL. JSB SYRUW * * RELEASE "OLD" TRACKS * TKREL LDB ED25 GET MATCHED ID SEG ADDR ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DISC WORD AND SAVE STA ED63 TEMPORARILY. SSA TRACKS ON LU3 ? JMP CLEAR YES, THEN RELEASE TRKS. CMA,INA SUBTRACK FROM DISC LIB ADDR ADA DSCLB AND IF SSA,RSS IN SYSTEM AREA JMP ED01 THEN DON'T RELEASE TRKS CLEAR CLA CLEAR JSB SYSET DISC WORD. JSB SYRUW DISC TOO LDB ED63 RESTORE DISC WORD TO B. LDA ED60 JSB DREL GO RELEASE TRACKS UNLESS GLOBAL * SKP ED01 LDB ED25 GET ID SEGMENT ADDR TO B JSB TATCL GO CLEAR ANY TRACKS ASSIGNED TO PGM LDB ED25 CLEAR ADB P12 NAME STB ED63 WORDS (3) LDB N3 STB ED60 ED02 CLA CCB CPB ED60 IF CLEARING NAM5 RSS JMP *+3 XLA LH1,I THEN GET SAME VALUE AS IN CORE LDB ED63 JSB SYRUW ISZ ED63 ISZ ED60 JMP ED02 LDA OPCOD CPA P4 IF PURGE OPERATION JMP EXIT THEN DONE SO GO TERMINATE JMP PADD GO TO TREAT AS ADDITION * * * PROGRAM ADDITION * ED10 CLA CLEAR MATCHED STA ED25 ID SEG ADDR STORAGE. RSS SKIP MESSAGE OUTPUT FOR NOW ED03 JMP NOIDS GO TELL THER ARE NO ID SEGMENTS PADD JSB BLKID DETERMINE # BLANK ID'S. LDB ID## CMB,INB CPB ID# IF LOOKING FOR MAIN'S ID JMP BIGID THEN SKIP SETTING UP FOR SMALL LDA BID6 (A)=TOTAL # OF SMALL IDS LDB BID8 (B)=# OF SMALL IDS WITHOUT DISC ALOC SZA SETTLE FOR LONG IF SMALL UNAVAILABLE JMP *+3 SKIP SETTING FOR LONG IDS BIGID LDA BID5 (A)=TOTAL # OF LONG IDS LDB BID7 (B)=# OF LONG IDS WITHOUT DISC ALLOC SZA,RSS IF NONE, JMP ED03 PRINT MESSAGE CPA B IF NONE WITH DISC ALLOC, JMP NTRM7 GO TO USE FIRST BLANK. * LDA FXS.L GET ID SEGMENT ADDR ADA P4 (A)=MEM1 ADDR OF SHORT ID LDB ID## CMB,INB CPB ID# IF PROCESSING MAIN ADA P4 THEN (A)=MEM1 ADDR OF LONG ID JSB C#S CALCULATE # OF SECS REQUIRED STA ED20 SAVE # OF SECTORS CMA,INA SAVE STA ED21 NEGATIVE # OF SECTORS LDA KEYWD SAVE STARTING KEYWORD STA ED22 LIST ADDR. CLA CLEAR STA ED23 ACCUMULATOR * ED11 XLB ED22,I GET NEXT ID SEGMENT ADDR. SZB,RSS JMP ED14 -END OF LIST * ADB P12 CHECK NAME(1) XLA B,I IF SZA,RSS = JMP ED17 0, CHECK FURTHER. CPA P1 JMP ED17 ED12 ISZ ED22 CHECK JMP ED11 NEXT SEGMENT. * ED17 ADB P2 (B)=NAM5 ADDR XLA B,I GET THE TYPE OF PROGRAM AND P7 CPA P1 MEM RES? JMP ED12 YES FORGET IT * JSB MEM? GET ADDR OF MEM1 NOP (REG-A NOT 0 FOR SHORT ID RETURN) ADB P4 (B)=ADDR OF DMAIN XLA B,I SZA,RSS IF NO DISC ALLOCATION TO THIS SEG JMP ED12 THEN CONTINUE SCAN. * SSA TRACK ALLOC ON LU 3? JMP ED12 YES, FORGET THIS,TOO CMA,INA IS THE TRACK ABOVE THE ADA DSCLB LIB OF SYS ENTRY POINTS? SSA WELL? JMP ED12 WELL, WE CAN'T USE THAT EITHER * LDA B ADA N4 (A)=MEM1 ADDR JSB C#SMX GET SECTOR COUNT STA B SAVE ADA ED21 SUBTRACT DUMMY FROM THIS SSA # OF SECTORS. JMP ED12 IF DUMMY >, CONTINUE SCAN. * LDA ED23 GET PREVIOUS MIN # SECTORS SZA,RSS IF 0, JMP ED13 GO TO USE THIS ALLOCATION. CMA,INA SUBTRACT ADA B PREVIOUS FROM NEW, SSA,RSS USE NEW # IF < OLD. JMP ED12 NO, KEEP CHECKING ED13 STB ED23 SET ALLOCATION #. XLA ED22,I ALSO, SET STA ED24 ID SEGMENT ADDR. JMP ED12 GO TO CHECK NEXT. * * * MODIFY WORD IN ID IN SYSTEM AREA * MODID NOP JSB SYSET STORE IN CORE JSB SYRUW STORE ON DISC JMP MODID,I RETURN * * ED14 LDA ED23 IF SPACE NOT FOUND IN SYSTEM SZA,RSS AREA, GO TO USE A BLANK ID SEG JMP NTRM7 AND KEEP PROG ON USER TRACKS * SKP * * * MOVE PROGRAM INTO SYSTEM AREA * LDB FXS.L GET DUMMY ID ADDR ADB P8 (B)=DMAN ADDR OF SHORT ID LDA ID## CMA,INA CPA ID# IF PROCESSING MAIN ADB P4 THEN (B)=DMAN ADDR OF LONG ID LDA B,I GET RELATIVE STARTING ALF,ALF TRACK # RAL AND AND M377 ADD ADA TRAKB BASE TRACK. STA TRAKP SET ABSOLUTE TRACK ADDR LDA B,I GET DMAN AGAIN AND M177 MASK IN SEC ADDR STA ED62 SET SECTOR ADDR * LDB ED24 GET DESTINATION ID ADDR ADB P14 (B)=ADDR OF NAM5 JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DESTINATION AREA ON SYS DSC ALF,ALF SET STARTING RAL TRACK AND M377 NUMBER. STA ED66 XLA B,I AND M177 SET STARTING STA ED67 SECTOR NUMBER. LDA P2 SET STA DESLU DESTINATION LU. LDA ED23 GET NUMBER OF ADA ED21 SECTORS LEFT OVER. SZA,RSS IF NO SECTORS LEFT JMP MPRG THEN ONLY MOVE THE PROG. SKP * * ALLOCATE LEFTOVER SPACE TO A BLANK * ID SEGMENT WITHOUT DISC ALLOCATION. * MPY P64 FIND # OF WORDS LEFT OVER STA ED23 AND SAVE FOR LATER. JSB BLKID FIND BLANK ID ALLOCATION LDB BID7 (B)=# OF IDS W/O DISC ALLOC SZB ANY BIG ID W/O DISC AVAIL ? JMP LFND YES, SET IT UP FOR ALLOC. LDB BID8 (B)=# OF SMALL IDS W/O DSC ALOC SZB,RSS ANY SMALL ONES AVAILABLE ? JMP MPRG NO, THEN GO TO MOVE PROG. LDB BID4 (B)=ADDR OF SHORT ID W/O DSC ALOC ADB P15 (B)=MEM1 ADDR OF SHORT ID JMP SBND SKIP OVER LONG ID'S SET UP LFND LDB BID2 (B)=ADDR OF LONG ID W/O DISC ALOC ADB P22 (B)=MEM1 ADDR OF LONG ID SBND STB BID2 SET ADDR OF MEM1 CLA JSB MODID SET LOW MAIN = 0 ISZ BID2 SET ADDR OF MEM2 LDA ED23 GET NUMBER OF WORDS LEFT OVER LDB BID2 GET ADDR OF MEM3 JSB MODID SET HIGH MAIN=WORDS LEFT OVER ISZ BID2 SET ADDR OF MEM3 LDB BID2 SET LOW BASE =0 CLA JSB MODID ISZ BID2 SET ADDR OF MEM4 LDB BID2 GET MEM4 ADDR CLA JSB MODID SET HIGH BASE =0 ISZ BID2 SET ADDR OF DMAN LDA ED67 GET STARTING SECTOR ADDR ADA ED20 MOVE UP TO END OF USED AREA CLB GET DISC ADDR OF AREA LEFT DIV SECT2 FIND # OF TRKS ADA ED66 GET ACTUAL DISC ADDR ALF,RAL POSITION TRACK RAL,RAL ADDR. IOR B MERGE IN SECTOR ADDR LDB BID2 GET DMAN ADDR JSB MODID SET DISC ADDR IN DMAN * SKP * MPRG JSB ED15 MOVE PROG TO SYSTEM AREA JMP ED16 SET UP IDS * ED15 NOP BGN JSB EXEC READ 1 SECTOR FROM DEF *+7 SOURCE AREA DEF P1 DEF DSKUN DEF L.BUF+0 DEF P64 DEF TRAKP DEF ED62 * JSB EXEC WRITE SAME SECTOR DEF *+7 INTO DESTINATION DEF P2 DEF DESLU DEF L.BUF+0 DEF P64 DEF ED66 DEF ED67 * ISZ ED21 INDEX SECTOR MOVE COUNT RSS -NOT FINISHED. JMP ED15,I -FINISHED. * LDA ED62 INDEX INA SOURCE SECTOR #. CPA TRKS# IF = # SECTORS/TRACK, CLA SET = 0, STA ED62 RESTORE. SZA,RSS IF = 0 ISZ TRAKP ADD 1 TO TRACK #. * LDA ED67 INDEX INA DESTINATION SECTOR #. CPA SECT2 IF = # SECTORS/TRACK, CLA SET = 0, STA ED67 RESTORE. SZA,RSS IF = 0, ISZ ED66 ADD 1 TO TRACK #. JMP BGN SKP * * COMPLETE ID SEGMENT PROCESSING * ED16 LDB ED24 GET OLD ID SEG ADDR ADB P14 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP ADB P4 (B)=ADDR OF DMAIN XLA B,I GET DISC ADDR STA ED63 SAVE TEMPORARILY LDB FXS.L STORE IT ADB P8 IN LDA ID## DMAN CMA,INA OF CPA ID# NEW ADB P4 ID LDA ED63 SEGMENT STA B,I * LDB ED24 IF SAME ID-SEGMENT CPB ED25 THEN RSS SKIP JSB SWPID ELSE SWAP THE ID-SEGMENTS ON THE DISC JSB FIX24 IDS NOT SWAPPED - CLEAN ED24'S. CLA,INA (A) = 1 FOR ADDITION JSB MVIDS JSB FIX FIX FOR TRYING LONG TO SHORT MOVE LDA SEG.L PROCESSING MAIN/SEG ? SZA,RSS THEN SKIP. JMP NTRM4 ELSE TERMINATE * * MAIN/SEGMENT REPLACEMENT OR ADDITION * ED183 LDA FXS.L SET ADDR OF ADA N9 NEXT SHORT DUMMY STA FXS.L ID SEGMENT. ISZ ID## END OF SEGMENTS ? CLB,RSS NO, THEN SKIP JMP NTRM4 TERMINATE, ALL MAIN/SEGS DONE. CPB EDFLG EDIT OPERATION ? JMP NTRM7 NO, GO BACK TO TEMP LOAD. JMP ED181 YES, SET UP FOR NEXT SEG. * ED18 LDA FXS.L INA * ED181 CLB,INB CPB EDFLG ADDITION ? JMP ED10 YES, ATTEMPT TO USE SYSTEM AREA. INA IT IS REPLACEMENT SO STA NAM12 SET UP INA ADDRES STA NAM34 OF NAM12, NAM34 INA AND NAM5. STA NAM5 JMP E0D GO LOOK FOR MATCHING ID SEG. SKP * SAVE MEM BOUNDS AND DISC ADDR OF MATCHED ID INTO * ID SEG WHOSE DISC SPACE WE USED. * SWPID NOP ROUTINE TO SWAP SYS ID-SEG TACKS STB FIX SAVE OFF B REG LDA FXS.L SAVE THE DUMMY ID ADDR STA DREL IN DREL ENTRY LDA ED25 GET THE ID-SEGMENT TO MOVE SZA,RSS IF NO OLD ID-SEGMENT JUST JMP SWPID,I RETURN, ELSE * LDB A ID ADDR TO B REG ADB P14 JSB MEM? GET ADDR OF MEM1 NOP ADB P4 B= ADDR OF DMAIN XLA B,I GET THE DISC SPACE SSA IF ON LU 3 FORGET IT JMP SWPID,I * CMA,INA IF NOT BELOW DISC LIB ENTS ADA DSCLB THEN SSA JMP SWPID,I FORGET IT ALSO * LDA ED25 STA FXS.L SET IT IN FXS.L FOR MVIDS AND STA MIDN SAVE FOR LATER CLA,INA SET EDIT FLAG STA KLUGE & KLUGE FLAG (THE PERSON WHO WROTE THIS * SHOULD BE SHOT LDB FIX RESTORE B REG JSB MVIDS AND CALL MVIDS TO SET UP NOP IGN.L ERROR RETURN CLB STB KLUGE LDB DREL RESTORE STB FXS.L THE DUMMY ID-ADDR LDB MIDN AND THE MOVED (AND NOW FREE) STB ED25 ID-SEGMENT ADDR ISZ SWPID BUMP RETURN ADDR FOR SWAP DONE JMP SWPID,I RETURN * KLUGE NOP FLAG USED ONLY BY SWPID FOR MOVING MEM1 * FROM NEW ID TO OLD ONE. * * * THIS ROUTINE IS EXECUTED WHEN "MVIDS" DOES AN ERROR * RETURN FOR ATTEMPTING TO MOVE A LONG ID INTO A SHORT * ONE. "FIX" ROUTINE BLANKS OUT MEM BOUNDS AND DMAIN * OF THE SHORT ID AND THEN GOES TO "MVIDS" WITHOUT * SPECIFYING A TARGET ID. "MVIDS" SHOULD NEVER RUN * INTO THE PROBLEM OF RUNNING OUT OF LONG ID SEGS. * FIX NOP LDA N5 SET UP TO BLANK OUT STA SWPID MEM1 TO DMAIN OF SHORT ID. LDA ABT11 SET UP ADDR OF MEM1 OF ADA P11 SHORT ID SEGMENT. STA DREL WIPE CLA WRITE 0 IN MEM1 TO DMAIN LDB DREL JSB MODID ISZ DREL ISZ SWPID DONE ? JMP WIPE NO CLB CLA,INA CPB EDFLG SKIP IF EDITING CLA JSB MVIDS SET UP ID IN SYSTEM HLT 0 ** SHOULD NEVER HAPPEN ** JMP FIX,I RETURN * SKP * * DISC TRACK RELEASE ROUTINE * A = # OF TRACKS TO RELEASE * B = DISC SWAP WORD * * DREL NOP STA ED63 LDA TAT STARTING SSB BASE ADA TATSD ADDR STA ED64 FOR DISC UNIT. (ED64 = TAT ADDRESS) LDA SECT2 SET APPROPRIATE SSB # SECTORS/TRACK LDA SECT3 FOR STA ED62 DISC LDA B GET AND M177 MASK THE TRACK SWP SWAP ALF,ALF STARTING RAL TRACK AND M377 #. ADA ED64 ADD TO STA ED64 BASE ADDR. LDA B SET STARTING SECTOR CMA,INA,SZA,RSS IF ZERO JMP DREL1 JUMP ISZ ED64 ELSE DO NOT RELEASE FIRST TRACK ADA ED62 COMPUTE NUMBER LEFT ON TRACK CMA,INA AND DREL1 ADA ED63 SUBTRAC FROM NUMBER TO RELEASE SSA IF NEGATIVE JMP DREL,I RETURN NO TRACKS START WITH THIS ID SEGMENT CLB TOTAL # OF DIV ED62 SECTORS BY # SECTORS/TRACK. SZB ROUND INA TO # OF TRACKS INVOLVED, CMA,INA,SZA,RSS SET NEG. IF ZERO JMP DREL,I EXIT DONE STA ED62 FOR INDEX. * DR LDB ED64 CLEAR XLA B,I DO NOT SSA,RSS RELEASE JMP DR2 GLOBAL TRACKS LDA XEQT ASSIGN TRACK TO SELF JSB SYSET IN TRACK CLA JSB SYRUW DR2 ISZ ED64 TABLE. ISZ ED62 JMP DR JMP DREL,I SKP * * CLEAR ENTRY IN TAT * TATCL NOP SUBROUTINE TO RELEASE ALL TRACKS STB DREL CURRENTLY ASSIGNED TO PROG ID ADDR IN B LDB TATLG SET TAT LENGTH STB FIX24 FOR COUNT LDB TAT SET INITIAL ADDR STB FIX & SAVE NXTRK LDA DREL GET ID SEGMENT ADDR TO A XLB FIX,I THIS TRACK BELONG?? CPA B RSS YES SKIP JMP NXTR1 NO STEP TO NEXT ONE LDA XEQT ASSIGN JSB SYSET TRACK TO SELF NXTR1 ISZ FIX STEP TRACK ADDR ISZ FIX24 DONE?? JMP NXTRK NO TRY NEXT TRACK JMP TATCL,I YES REETURN * * ROUTINE TO CLEAN OUT THE ID SEG (MEM1 TO DMAIN) * WHOSE DISC SPACE WE UTILIZED BUT 'SWAPID' * DID NOT SAVE ANYTHING IN IT. USEFUL IF THIS * ID HAPPENS TO BE A LONG ONE BUT THE DUMMY IS SHORT. * ALSO EXECUTED WHEN ED24 AND ED25 HAVE SAME ID ADDR. * FIX24 NOP LDB ED24 ADB P14 (B)= NAM5 ADDR JSB MEM? GET ADDR OF MEM1 NOP STB DREL SET UP MEM1 ADDR LDB N5 SET COUNT TO BLANK STB SWPID TO BLANK OUT MEM1-DMAIN. WIPE1 CLA (A)=0 LDB DREL (B)=ADDR OF WORD IN ID SEG JSB MODID MODIFY THE ID SEG ISZ DREL BUMP ADDR ISZ SWPID DONE ? JMP WIPE1 NO LDB ED25 (B)=0 FOR NO PARTICULAR ID JMP FIX24,I RETURN * SKP * MAPOF DEC 34 * * TRAKP NOP ID## NOP ED20 NOP ED21 NOP ED22 NOP ED23 NOP ED24 NOP ED25 NOP ED60 NOP ED61 NOP ED62 NOP ED63 NOP ED64 NOP ED66 NOP ED67 NOP * PTYPE DEC 3 PROGRAM DEFAULT = 3 = PRIVLEGED EDFLG NOP EDIT FLAG: 1 = ADDITION, 2 = REPLACEMENT, 0 = TEMP #PTTN NOP SPECIFIED PARTITION # #PGS NOP SPECIFIED # OF PAGES IN PROGRAM (INCLUDES BP) #MPFT NOP INDEX TO MEMORY PROTECT FENCE TABLE OPCOD NOP 1ST WORD OF OPCODE FIELD LISTU NOP LIST OUTPUT UNIT # DFLAG NOP 0/1 NON INTERACTIVE / INTERACTIVE LU # FILE1 BSS 3 NAME OF INPUT FILE TYPE1 NOP PARSED TYPE WORD FOR FILE OR LU # F1SC NOP AND SECURITY CODE F1DSC NOP AND DISC LU OR CARTRIDGE # F2 DEF FILE2 FILE2 BSS 3 NAME OF COMMAND FILE TYPE2 NOP TYPE WORD FOR COMMAND FILE OR LU F2SC NOP AND ITS SECURITY CODE F2DSC NOP AND ITS LU OR CART REF PRIOR NOP ADDR OF PRIORITY IN ID SEG PRENT NOP ADDR OF PRIMARY ENTRY POINT NAM12 NOP ADDR OF NAME 1,2 NAM34 NOP ADDR OF NAME 3,4 NAM5 NOP ADDR OF NAME 5, TYPE RESL NOP ADDR OF 10'S MILLS. IN ID SEG DBLAD NOP DATA BLOCK RELOCATION ADDR WDCNT NOP TEMPORARY COUNTER DSKUN NOP CURRENT DISK LOGICAL UNIT NO. DTRAK NOP CURRENT DBUF TRACK DSECT NOP CURRENT DBUF SECTOR CURAL NOP CURRENT L.BUF ADDR TBUF BSS 5 TEMPORARY BUFFER MSEGF NOP MAIN/SEGMENT FINAL LOAD FLAG LWA NOP LOADING AREA, BPFWA NOP FWA OF ACTUAL BP LINK AREA LWABP NOP BASE PAGE AREA. DBLFL NOP FIRST DBL REC: -1,YES: 0,NO FORCD NOP FORCE FLAG 0/-1 NO FORCE /FORCE LOAD N1 DEC -1 N6 DEC -6 N9 DEC -9 N10 DEC -10 N11 DEC -11 N60 DEC -60 N4 DEC -4 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P12 DEC 12 P14 DEC 14 P18 DEC 18 P19 DEC 19 P20 DEC 20 P28 DEC 28 P29 DEC 29 P30 DEC 30 P33 DEC 33 P34 DEC 34 M7 EQU P7 M20 OCT 20 M77 OCT 77 M177 OCT 177 M300 OCT 300 M377 OCT 377 M1600 OCT 1600 M2000 OCT 2000 M0760 OCT 76000 M7400 OCT 177400 NDAY OCT 177574,025000 ENTRL DEF *+3 RELOCATION BASE TABLE NOP ABSOLUTE BASE BLOK# NOP MSIGN OCT 100000 CHRDE ASC 1,.D DO NOT CHRBU ASC 1,BU CHANGE THIS UCHRG OCT 43400 ORDER AMEM3 DEF MBUF+3 AMEM6 DEF MBUF+6 OEFL1 NOP ODD/EVEN SECTOR FLAG LBOEF NOP LIB ODD/EVEN SECOR FLAG #IDAD NOP ADDR OF LONG ID SEGMENT * TABLE OF SUBROUTINES FOR LIBRARY SUBTB DEF ALLOC ALLOC BP LINK SUB DEF SCAN SCAN FOR EXISTING BP LINK SUB DEF OUTAB OTPT A WORD THAT HAS JUST BEEN RELOCATED SUB * SPC 1 #MNPG NOP LOWEST PAGE NO. USED BY PROG #MXPG NOP HIGHEST PAGE NO. USED BY PROG #MXRT DEC -1 #PAGES IN LARGEST RT PTTN #MXBG DEC -1 #PAGES IN LARGEST BG PTTN ER.16 LDA ERR16 ILLEGAL PTTN # JMP ABOR SPC 1 SKP * * ERROR CODES * ERR01 EQU P1 ERR02 EQU P2 ERR03 EQU P3 ERR04 EQU P4 ERR05 EQU P5 ERR06 EQU P6 ERR07 EQU P7 ERR08 EQU P8 ERR09 EQU P9 ERR10 EQU P10 ERR11 EQU P11 ERR12 EQU P12 ERR13 EQU P13 ERR14 EQU P14 * ERR16 EQU P16 ERR17 EQU P17 ERR18 EQU P18 ERR19 EQU P19 ERR20 EQU P20 ERR21 EQU P21 ERR22 EQU P22 ERR23 EQU P23 ERR24 EQU P24 ERR25 EQU P25 ERR26 EQU P26 ERR27 EQU P27 ERR28 EQU P28 ERR29 EQU P29 ERR30 EQU P30 ERR31 EQU P31 ERR32 EQU P32 ERR33 EQU P33 ERR34 EQU P34 SKP * BASE PAGE COMMUNICATION VALUES * A EQU 0 B EQU 1 * . EQU 1650B ESTABLISH ORIGIN OF AREA * INTLG EQU .+5 NUMBER OF INTERRUPT TBL ENTRIES TAT EQU .+6 FWA OF TRACK ASSIGNMENT TABLE KEYWD EQU .+7 FWA OF KEYWORD BLOCK XEQT EQU .+39 ID SEGMENT ADDR OF LOADR IDSDA EQU .+56 DISC ADDR. OF FIRST ID SEGMENT IDSDP EQU .+57 -POSITION WITHIN SECTOR BPA2 EQU .+59 LWA RT DISC RES. BP LINK AREA RTORG EQU .+62 FWA OF REAL-TIME AREA RTCOM EQU .+63 LENGTH OF REAL TIME COMMON AREA RTLWA EQU .+65 LWA OF RT DISC RESIDENT AREA BKORG EQU .+66 FWA OF BG AREA BKCOM EQU .+67 LENGTH OF BG COMMON AREA TATLG EQU .+69 LENGTH OF TRACK ASSIGNMENT TABLE TATSD EQU .+70 # OF TRACKS ON SYSTEM DISC SECT2 EQU .+71 # SECTORS/TRACK ON LU 2 (SYSTEM) SECT3 EQU .+72 # SECTORS/TRACK ON LU 3 (AUX.) DSCLB EQU .+73 DISC ADDR OF RES LIB ENTRY PTS DSCLN EQU .+74 # OF RES LIB ENTRY POINTS DSCUT EQU .+75 DISC ADDR OF RELOC UTILITY PROGS SYSLN EQU .+76 # OF RELOC UTILITY PROGS LGOTK EQU .+77 LOAD-N-GO: LU,STG TRACK,# OF TRKS LGOC EQU .+78 CURRENT LGO TRACK/SECTOR ADDR BKLWA EQU .+87 LWA OF MEMORY IN BG SPC 1 SPC 1 SPC 1 BPA1 EQU P2 FWABP USER RT DISC RES BPA3 EQU BPA1 FWABP USER BG DISC RES BKGBL EQU BPA2 LWABP USER BG DISC RES URFWA NOP FWA USE RT DISC RES AREA URLWA OCT 77777 LWA USER RT DISC RES AREA UBFWA EQU URFWA FWA USER BG DISC RES AREA UBLWA EQU URLWA LWA USER BG DISC RES AREA * BSS 0 SIZE OF LOADR SPC 3 END LOADR