$TITLE OBJECT CARD PROCESSING ROUTINE GLOBAL PROCEDURE LOADCARD(R14); BEGIN EQUATE NSYMBOLS SYN 96; COMMENT MAX # EXTERNAL SYMBOLS; EQUATE ESDITEMS SYN 4*NSYMBOLS; EQUATE ESDLIMIT SYN 16*NSYMBOLS - 16; EQUATE FLAG SYN #1; COMMENT END OF CHAIN FLAG; GLOBAL DATA LOADDATA BASE R11; ARRAY ESDITEMS LOGICAL ESDTABLE; COMMENT SYMBOL DICTIONARY; ARRAY NSYMBOLS LOGICAL NAME1 SYN ESDTABLE(0), NAME2 SYN ESDTABLE(4); ARRAY NSYMBOLS INTEGER ADDR SYN ESDTABLE(8); ARRAY NSYMBOLS INTEGER CHAIN SYN ESDTABLE(12); INTEGER ESDINDEX; INTEGER LOCORE, HICORE, LOADBASE; INTEGER ENTRYPOINT; COMMENT EXECUTION ENTRY ADDRESS; BYTE ENTRYSET, INIT, LOADERR; ARRAY 133 BYTE ERRBUF; INTEGER REGISTER I SYN R3, J SYN R4, K SYN R5, T SYN R6, W SYN R7, LINK SYN R8; ARRAY 65 SHORT INTEGER MODTABLE; SHORT INTEGER ESDID; FUNCTION DECR(6,#0600); ARRAY 12 INTEGER REGSAVE; INTEGER REGISTER XR SYN R9; BYTE MEMOVFL SYN 1, ESDOVFL SYN 2, DUPSEG SYN 3, ESDSEQ SYN 2; PROCEDURE ERROR(LINK); BEGIN COMMENT XR - ERROR TYPE; STC(XR,LOADERR); GOTO EXIT; END; PROCEDURE LOOKUP(LINK); BEGIN COMMENT R0,R1 - NAME OF SEGMENT TO LOCATE OR ENTER, SETS I; LOGICAL WSAVE; WSAVE := W; FOR I := 0 STEP 16 UNTIL ESDINDEX DO IF R0 = NAME1(I) AND R1 = NAME2(I) THEN GOTO X; I := ESDINDEX + 16; IF I > ESDLIMIT THEN BEGIN XR := @ESDOVFL; ERROR; END; ESDINDEX := I; W := @ESDTABLE(I); STM(R0,R1,MEM(W)); R0 := 0; COMMENT ZERO ADDRESS BEFORE ALLOCATION; R1 := FLAG; COMMENT END-OF-CHAIN; STM(R0,R1,MEM(W+8)); X: W := WSAVE; END; PROCEDURE ALLOCATESEG(LINK); BEGIN COMMENT I - ESDTABLE POINTER, W - SEG LENGTH; INTEGER LENGTH; LENGTH := W; W := ADDR(I); IF W ~= 0 THEN BEGIN W := @NAME1(I); MVC(7,ERRBUF(44),MEM(W)); XR := @DUPSEG; ERROR; END; R0 := LOADBASE - LENGTH AND #FFFFF8; IF R0 < LOCORE THEN BEGIN R0 := _1; REGSAVE(0) := R0; COMMENT NO SPACE; W := ESDID - 1; ESDID := W; GOTO EXIT; END; LOADBASE := R0; ADDR(I) := R0; END; ARRAY 20 LOGICAL CARD SYN MEM(R10); ARRAY 40 SHORT INTEGER SCARD SYN CARD; STM(R0,R10,REGSAVE); R10 := R0; IF R1 < LOCORE THEN LOCORE := R1; CLI(#00,LOADERR); IF = THEN BEGIN COMMENT PROCESS BUFFER CARD; IF INIT THEN BEGIN RESET(INIT); R0 := 0; ESDID := R0; R1 := FLAG; FOR K := 0 STEP 2 UNTIL 128 DO MODTABLE(K) := R1; COMMENT MARK EMPTY; END; BEGIN R0 := CARD(0); IF R0 = "ESD" THEN BEGIN COMMENT EXTERNAL SYMBOL DICTIONARY; FOR J := 16 STEP 16 UNTIL SCARD(10) DO BEGIN T := 0; IC(T,CARD(J+8)); W := ESDID + 1; IF W > 64 THEN BEGIN XR := @ESDSEQ; ERROR; END; ESDID := W; K := W + W; R0 := CARD(J); R1 := CARD(J+4); LOOKUP; MODTABLE(K) := I; IF T = 0 THEN COMMENT SD; BEGIN W := CARD(J+12); ALLOCATESEG; END; END; END ELSE IF R0 = "TXT" THEN BEGIN COMMENT EBCDIC TEXT; K := SCARD(14) SHLA 1; I := MODTABLE(K); R1 := ADDR(I) + CARD(4); W := SCARD(10); DECR(W); EX(W,MVC(0,B1,CARD(16))); END ELSE IF R0 = "RLD" THEN BEGIN COMMENT RELOCATION DICTIONARY; W := SCARD(10) + 8; SCARD(10) := W; FOR J := 16 STEP 8 UNTIL SCARD(10) DO BEGIN K := SCARD(J+2) SHLA 1; I := MODTABLE(K); W := CARD(J+4) AND #FFFFFF + ADDR(I); K := SCARD(J) SHLA 1; I := MODTABLE(K); R0 := MEM(W) SHLA 12 OR CHAIN(I); COMMENT BYTE 0 = RELOCATION FACTOR (IN PAGES); MEM(W) := R0; CHAIN(I) := W; END; END ELSE IF R0 = "END" THEN SET(INIT); END; END; EXIT: LM(R0,R10,REGSAVE); END. $TITLE DIRECTORY MERGE ROUTINE GLOBAL PROCEDURE ENDLOAD(R14); BEGIN EQUATE NSYMBOLS SYN 96; COMMENT MAX # OF EXTERNAL SYMBOLS; EQUATE ESDITEMS SYN 4*NSYMBOLS; EQUATE ESDLIMIT SYN 16*NSYMBOLS - 16; EQUATE FLAG SYN #1; COMMENT END-OF-CHAIN FLAG; EXTERNAL DATA LOADDATA BASE R11; ARRAY ESDITEMS LOGICAL ESDTABLE; COMMENT SYMBOL DICTIONARY; ARRAY NSYMBOLS LOGICAL NAME1 SYN ESDTABLE(0), NAME2 SYN ESDTABLE(4); ARRAY NSYMBOLS INTEGER ADDR SYN ESDTABLE(8); ARRAY NSYMBOLS INTEGER CHAIN SYN ESDTABLE(12); INTEGER ESDINDEX; INTEGER LOCORE, HICORE, LOADBASE; INTEGER ENTRYPOINT; BYTE ENTRYSET, INIT, LOADERR; ARRAY 133 BYTE ERRBUF; INTEGER REGISTER I SYN R3, J SYN R4, K SYN R5, N SYN R6, T SYN R7, W SYN R8; DUMMY BASE R9; COMMENT LIBRARY DIRECTORY FORMAT; INTEGER LIBTABLEN; COMMENT LENGTH OF DIRECTORY; INTEGER LIBENTRY, LIBERROR, LIBDATA; ARRAY 48 LOGICAL LIBTABLE; ARRAY 16 INTEGER LIBNAME1 SYN LIBTABLE, LIBNAME2 SYN LIBTABLE(4); ARRAY 16 INTEGER LIBADDR SYN LIBTABLE(8); CLOSE BASE; ARRAY 10 INTEGER REGSAVE; BYTE UNDEFSYM SYN 4, NOENTRY SYN 5; STM(R0,R9,REGSAVE); R9 := R0; CLI(#00,LOADERR); IF = THEN BEGIN COMMENT MERGE DIRECTORIES, FIX UP ADDRESSES; FOR I := 0 STEP 16 UNTIL ESDINDEX DO BEGIN R0 := NAME1(I); R1 := NAME2(I); R2 := ADDR(I); IF R2 ~= 0 THEN BEGIN COMMENT MAKE SPECIAL ENTVECT ENTRIES; IF R1 = "C001" AND R0 = "AWXS" THEN BEGIN R1 := REGSAVE(4); COMMENT ENTVECT BASE; MEM(R1+64) := R2; SET(ENTRYSET); END ELSE IF R1 = "CTBL" AND R0 = "AWXR" THEN BEGIN R1 := REGSAVE(4); COMMENT ENTVECT BASE; MEM(R1+68) := R2; END; END ELSE BEGIN N := FLAG; J := 0; K := LIBTABLEN; COMMENT BINARY SEARCH; WHILE J <= K AND N = FLAG DO BEGIN W := J + K SHRL 1; T := W * 12S; IF R0 = LIBNAME1(T) THEN BEGIN IF R1 = LIBNAME2(T) THEN N := T ELSE IF > THEN J := W + 1 ELSE K := W - 1; END ELSE IF > THEN J := W + 1 ELSE K := W - 1; END; IF N = FLAG THEN BEGIN W := @UNDEFSYM; STC(W,LOADERR); W := @NAME1(I); MVC(7,ERRBUF(44),MEM(W)); GOTO EXIT; END; R2 := LIBADDR(N); ADDR(I) := R2; END; W := CHAIN(I); WHILE W ~= FLAG DO BEGIN N := MEM(W) AND #FFFFFF; T := T-T; IC(T,MEM(W)); T := T SHLA 12 + R2; COMMENT BYTE 0 = RELOCATION FACTOR (PAGES); MEM(W) := T; W := N; END; END; EXIT: END; IF ~ENTRYSET THEN BEGIN CLI(#00,LOADERR); IF = THEN BEGIN W := @NOENTRY; STC(W,LOADERR); END; END; CLI(#00,LOADERR); IF ~= THEN BEGIN MVC(18,ERRBUF," *** LOADING ERROR,"); W := 0; IC(W,LOADERR); CASE W OF BEGIN MVC(19,ERRBUF(20),"INSUFFICIENT STORAGE"); MVC(18,ERRBUF(20),"TOO MANY PROCEDURES"); MVC(22,ERRBUF(20),"DUPLICATE GLOBAL NAME -"); MVC(22,ERRBUF(20),"UNDEFINED GLOBAL NAME -"); MVC(23,ERRBUF(20),"NO EXECUTABLE STATEMENTS"); END; END ELSE BEGIN R0 := LIBENTRY; ENTRYPOINT := R0; END; END.