;DP.MAC.3, 8-Dec-76 18:53:23, Edit by ENDERIN ;NAME: DP ;==== ;VERSION: 4 [13,40,144,176,210,215,225] ;======= ;AUTHOR: KIM WALDEN ;====== CLAES WIHLBORG ; Lars Enderin (DPEXT modifications) ;PURPOSE: DP PROCESSES THE DECLARATION LIST, DC, ;======= MADE AVAILABLE BY SD, AND MERGES IT WITH ; SYSTEM CLASSES AND VARIABLES. ; IT CONTAINS TWO SUBMODULES: ; DPSYS, WHICH PROCESSES SYSTEM RECORDS, AND ; DPEXT, WHICH PROCESSES EXTERNAL CLASSES AND PROC'S. ;ENVIRONMENT: DP IS CALLED BY: EXEC DP ;=========== AND EXITS BY: RETURN SALL SEARCH SIMMC1,SIMMAC,SIMMCR CTITLE DP (DECLARATION PROCESSING) SUBTTL PROLOGUE MACINIT TWOSEG RELOC 400000 INTERN DP,DPEXT ;[144] EXTERN O1DFOP,O1DF1,O1DFCL EXTERN O1RL,O1RLR,O1RLS,O1RLUNR EXTERN YBHEXT,YBREAK EXTERN I1RX50 ;[144] EXTERN O1EXT,O1EXCL,O1EXNP,O1EXRQ ;[144] EXTERN O1EXTB ;[225] EXTERN YDPD,YMAXFX EXTERN SH,SYS1,SDALLOC EXTERN YDPZQQ,YDPSOL,YDPLIN,YDPATH EXTERN YDPZUC,YDPFUN,YDPLUN,YDPUNR EXTERN T1AB,ZSE1,ZSE2 EXTERN YELIN1,YELIN2,YESEM EXTERN YELEXT,YEXZQU,YRQHEAD,YZQUGLO ;[144] EXTERN YATRDEV,YATRFN,YATRPPN,YATROFS ;[144] SUBTTL MACRO and OP DEFINITIONS OPDEF XEC [PUSHJ XPDP,] OPDEF GENABS [XEC O1RL] OPDEF GENREL [XEC O1RLR] OPDEF GENSYMB [XEC O1RLS] DEFINE APPEND ;ALLOW NEW ENTRIES IN SYMBOL TABLE DEFINE NOAPPEND ;FORBID NEW ENTRIES IN SYMBOL TABLE DEFINE TOGETHER(A,B,C,D)< IF IFN C-D, THEN IF JUMPN B,FALSE THEN L A,C ELSE SF C,ZDELNK(B) FI L B,D FI > DEFINE ZOUT(N) < IRP N > DEFINE ERROR(NO,TYP,MESSAGE)< LF ,ZQUTEM(XZQU) ST YELIN1 ST YELIN2 CLEARM YESEM ERR'TYP QT,Q1DP.T+NO ; IFN QDEBUG, > DF(ZUCFUN,0,36,35) DF(ZUCLUN,1,36,35) DF(ZUCLID,2,18,17) ;;;; [144] ;;;; OPDEF XEC [PUSHJ XPDP,] OPDEF findemall [XEC DPEXFA] OPDEF findmodules [XEC O1EXFM##] OPDEF zquremove [XEC DPEXRM] OPDEF getdevice [XEC DPEXGD] OPDEF openext [JSP O1EX.O##] OPDEF lookitup [XEC O1EXLU##] OPDEF filespec [XEC DPEXFS] OPDEF skipoverhead [XEC O1EXSO##] DF ZQUR50,3+OFFSET(ZHBUNR),36,35 ;Radix50 name of external module ;SWITCHES ;======== DSW (TYPZHB,0,\QZHB,X1) ;ACCUMULATOR ASSIGNMENTS: ;=========== =========== XZHEOF==2 XTAG==3 XPTR==4 XP==XTAG XSTA==5 XSTM==7 XEDA==12 XEDM==11 XID==X1ID1 XIDNO==X1NXT XID2==X1ID2 XA==14 XB==15 XZQU==4 XZHB==7 XZHE==4 XTYP==5 XKND==4 XMOD==1 XSUS==11 XSUL==12 XATS==7 XATL==13 XC==12 XD==13 XE==11 XZRQ==X2 ;[144] SUBTTL DPSYS DPSYS: PROC NOAPPEND LI XPTR,SYS1 EXEC DPSYSC TOGETHER(XSTM,XEDM,XSTA,XEDA) LF X2,ZHSSTR(,YDPD) LF X3,ZHSEND(,YDPD) IF JUMPE X2,FALSE ;[176] THEN L [3,,3] EXEC SDALLOC L [BYTE (3)QQZHE,QRBLOCK(12)0(18)-2] ST (XALLOC) TOGETHER(XSTM,XEDM,XALLOC,XALLOC) TOGETHER(XSTM,XEDM,X2,X3) FI LF X2,ZHSSTR(,YDPD+3) LF X3,ZHSEND(,YDPD+3) TOGETHER(XSTM,XEDM,X2,X3) LF X2,ZHSSTR(,YDPD+4) LF X3,ZHSEND(,YDPD+4) TOGETHER(XSTM,XEDM,X2,X3) L XPTR,XSTM RETURN EPROC SUBTTL DPSYSC (APPEND SYSTEM CLASSES) DPSYSC: PROC CLEARB XSTM,XEDM CLEARB XSTA,XEDA GOTO DPL1 DPL2: LF XPTR,ZQUFIX(XPTR) WHILE DPL1: SKIPN X14,(XPTR) GOTO FALSE DO LD XID,2(XPTR) EXEC SH JUMPE XIDNO,DPL2 ;IF COMPONENT NOT IN PROGRAM L X0,[XWD 3,3] ;CREATE ZQU-RECORD EXEC SDALLOC ST X14,(XALLOC) LF ,ZQUIND(XPTR) ST 1(XALLOC) SF XIDNO,ZQULID(XALLOC) TOGETHER(XSTM,XEDM,XALLOC,XALLOC) LF X1,ZQUTYP(XPTR) LF X2,ZQUKND(XPTR) IF CAIN X1,QREF GOTO TRUE CAIE X2,QCLASS GOTO FALSE THEN ;GET QUALIFICATION LD XID,4(XPTR) EXEC SH SF XIDNO,ZQUQID(XALLOC) ADDI XPTR,2 FI ADDI XPTR,4 L X1,(XPTR) IFOFFA TYPZHB GOTO DPL1 L X0,[XWD 4,4] ;CREATE ZHB-RECORD EXEC SDALLOC LD X2,1(XPTR) STD X1,(XALLOC) ST X3,3(XALLOC) TOGETHER(XSTA,XEDA,XALLOC,XALLOC) LF X14,ZHBNRP(XPTR,-1) LF X13,ZHETYP(XPTR) LI X15,QLOWID-1 ADDI XPTR,3 WHILE SOJL X14,FALSE DO ;CREATE ZQU-RECORDS FOR FORMAL PARAMETERS L X0,[XWD 3,3] EXEC SDALLOC ADDI X15,1 L (XPTR) ST (XALLOC) ANDI 77 SF ,ZQUIND(XALLOC) SF XALLOC,ZDELNK(XEDA) L XEDA,XALLOC SF X15,ZQULID(XALLOC) LF X0,ZQUTYP(XPTR) IF CAIE QREF GOTO FALSE THEN ;GET QUALIFICATION LD XID,1(XPTR) EXEC SH SF XIDNO,ZQUQID(XALLOC) ADDI XPTR,2 FI ADDI XPTR,1 OD IF CAIE X13,QCLASB GOTO FALSE THEN ;APPEND CLASS ATTRIBUTES STACK XSTM STACK XEDM STACK XSTA STACK XEDA EXEC DPSYSC TOGETHER(XSTM,XEDM,XSTA,XEDA) UNSTK XEDA UNSTK XSTA TOGETHER(XSTA,XEDA,XSTM,XEDM) UNSTK XEDM UNSTK XSTM FI OD ADDI XPTR,1 RETURN EPROC SUBTTL DPEXT EXTERN YRQDEV,YRQFIL,YRQPPN,YEXNAM ;[13] DPEXT:: PROC SAVE LF ,ZQUTEM(XZQU) ST YDPLIN ;LINE NO WHERE EXTERNAL WAS DECLARED LI XZHB,3(XZQU) skipoverhead ;[144] ;GET ATR HEADER GETEXT ST YDPATH ST YDPFUN ;CHECK AND MODIFY ZQU GETEXT XOR (XZQU) TLNE -1 GOTO XER1 ;TYPE AND/OR KIND ERROR GETEXT XB GETEXT XID GETEXT XID2 NOAPPEND EXEC SH LF X1,ZQULID(XZQU) CAME X1,XIDNO GOTO XER2 ;NAMES DO NOT CORRESPOND ADDM XB,1(XZQU) LF XTYP,ZQUKND(XZQU) GETEXT XID GETEXT XID2 IF JUMPE XID,FALSE THEN APPEND EXEC SH IF CAIE XTYP,QPROCE GOTO FALSE THEN LF ,ZQUQID(XZQU) CAME XIDNO GOTO XER3 ;QUALIFICATION ERROR FI SF XIDNO,ZQUQID(XZQU) FI AOS XID2,YMAXFX SF XID2,ZQUIND(XZQU) ;CHECK AND MODIFY ZHB LF ,ZHESOL(XZHB) SUBI 1 MOVSM YDPSOL GETEXT XA ADD XA,YDPSOL XOR XA,(XZHB) TRNE XA,-1 SKIPN YDPSOL SKIPA GOTO XER4 ;DLV ERROR XORM XA,(XZHB) GETEXT XA ST XA,1(XZHB) SF XID2,ZHEFIX(XZHB) GETEXT GETEXT XA LF ,ZHBSBL(XZHB) ST XA,3(XZHB) SF ,ZHBSBL(XZHB) GETEXT XID SF XID,ZHBUNR(XZHB) CAIE XTYP,QCLASS ST XID,YDPFUN L [2,,2] ;Put unique number info on a chain EXEC SDALLOC ST XID,(XALLOC) L YDPUNR ST 1(XALLOC) ST XALLOC,YDPUNR EXEC DPEXDF IF ;[4] Quick calling sequence procedure LF XA,ZHETYP(XZHB) CAIE XA,QPROCE GOTO FALSE LF XA,ZHBMFO(XZHB) CAIE XA,QEXMQI GOTO FALSE THEN ;[4] Change ZQQ just created L XA,YDPZQQ L XID,YDPATH ;Procedure entry SF XID,ZQQUNR(XA) FI ;[4] LF XA,ZDELNK(XZHB) STACK XZHB STACK XA ;READ ATTRIBUTES LI XATL,(XATS) CLEARB XSUS,XSUL EXEC DPEXTC UNSTK XA IF JUMPE XSUS,FALSE THEN SF XSUS,ZDELNK(XATL) SF XA,ZDELNK(XSUL) ELSE SF XA,ZDELNK(XATL) FI UNSTK XZHB ;CREATE ZHE(QQUACH) LI XZHE,5(XZHB) LF XA,ZDELNK(XZHE) APPEND HLL XB,(XZHE) WHILE GETEXT X1 JUMPE X1,FALSE DO L [3,,3] EXEC SDALLOC SF XALLOC,ZDELNK(XZHE) LI XZHE,(XALLOC) ST XB,(XZHE) GETEXT X1 SF X1,ZHEUNR(XZHE) GETEXT XID GETEXT XID2 EXEC SH SF XIDNO,ZHELID(XZHE) OD SF XA,ZDELNK(XZHE) ;CREATE ZUC-RECORD LI XZQU,-3(XZHB) L [3,,3] EXEC SDALLOC LF ,ZQULID(XZQU) SF ,ZUCLID(XALLOC) L YDPFUN SF ,ZUCFUN(XALLOC) L YDPLUN SF ,ZUCLUN(XALLOC) L YDPZUC SF ,ZDELNK(XALLOC) ST XALLOC,YDPZUC ;APPEND CODE TO REL.TMP IF SKIPN YDPSOL GOTO FALSE THEN ;EXTERNAL IS COPIED LF ,ZHETYP(XZHB) IF CAIE QCLASB GOTO FALSE THEN ;DEFINE ZCPSBL FOR THE CLASS LI X1,0 L X2,YDPATH TLO X2,40K LF X3,ZHBSBL(XZHB) MOVN X3,X3 GENSYMB ELSE ;PROCEDURE LF XA,ZHBMFO(XZHB) ;[4] IF ;MACRO (not QUICK) or FORTRAN procedure JUMPE XA,FALSE ;[4] CAIN XA,QEXMQI ;[4] GOTO FALSE ;[4] THEN ;[4] Generate symbol table, map, prototype EXEC DPSYMT EXEC DPMAP EXEC DPPROT FI FI FI ;[4] RETURN EPROC ;DPEXT SUBTTL DPSYMT, GENERATE SYMBOL TABLE DPSYMT: PROC ;[4] LI X0,0 GENABS IF ;FORTRAN procedure CAIGE XA,QEXFOR ;[4] GOTO FALSE THEN ;Define entry point MOVSI X1,40K L X2,YDPATH TLO X2,600K L X3,YBREAK SUBI X3,1 TLO X3,600K GENSYMB ;ENTRY OF FORTRAN PROCEDURE FI ;GENERATE NAME OF PROCEDURE LF X2,ZQULID(XZQU) L X0,YZSE1(X2) GENABS L X0,YZSE2(X2) GENABS L XB,YBREAK ;SAVE START ADDRESS OF SYMBOL TABLE MOVSI X0,(B3) CAIL XA,QEXFOR ;[4] MOVSI X0,(B3) HRRI 1(XB) GENREL LI XE,0 LF XC,ZHBNRP(XZHB) IF JUMPE XC,FALSE THEN ;PROCEDURE HAS FORMAL PARAMETERS LF XD,ZDELNK(XZHB) LOOP ;FOR EACH PARAMETER LF X0,ZQUIND(XD) LF X1,ZQUTMK(XD) HRL X0,X1 LF X1,ZQULID(XD) SKIPE YZSE2(X1) TLO X0,400K GENABS L X0,YZSE1(X1) GENABS L X0,YZSE2(X1) SKIPE X0 GENABS LF X1,ZQUQID(XD) SKIPE X1 EXEC DPEXCR LF ,ZQUMOD(XD) CAIN QNAME ADDI XE,1 LF XD,ZDELNK(XD) AS SOJG XC,TRUE SA FI RETURN ;[4] EPROC ;[4] DPSYMT SUBTTL DPMAP, GENERATE MAP DPMAP: PROC ;[4] L XC,YBREAK ;SAVE START ADDRESS OF MAP LI X0,0 ;THIS IS ALSO END OF SYMBOL TABLE GENABS IF CAIL XA,QEXFOR ;[4] GOTO FALSE THEN ;MACRO PROCEDURE (HAS NO LOCAL VARIABLES) GENABS GENABS LF XD,ZHELEN(XZHB) IFON ZHBNCK(XZHB) ;[4] ADDI XD,^D31*2 ;Max 31 parameters, all mode name ELSE ;FORTRAN PROCEDURE ; A FORTRAN PROCEDURE HAS 2 AREAS OF LOCAL VARIABLES. ; THE 1:ST AREA CONTAINS INTERMEDIATE LOCATIONS FOR PARAMETERS ; CALLED BY NAME (NO RELOCATION). THE 2:ND AREA ; CONTAINS THE ARGUMENT LIST (RELOCATED) LF X0,ZHELEN(XZHB) ASH XE,1 MOVN X1,XE HRL X0,X1 TLNN X0,-1 LI X0,0 GENABS LF X0,ZHELEN(XZHB) ADDI X0,1(XE) LF XD,ZHBNRP(XZHB) MOVN X1,XD HRL X0,X1 GENABS ADD XD,X0 LI XD,1(XD) FI SETZ ;[215] GENABS RETURN ;[4] EPROC ;[4] DPMAP SUBTTL DPPROT, Generate prototype DPPROT: PROC ;[4] MOVSI X1,40K LF X2,ZHBUNR(XZHB) TLO X2,40K L X3,YBREAK GENSYMB ;GENERATE PROTOTYPE ENTRY MOVSI X0,(XD) HRR X0,XC GENREL LF X1,ZHEEBL(XZHB) MOVSI X0,(X1) MOVN HRR X0,XB GENREL LF XB,ZHBNRP(XZHB) L XC,OFFSET(ZHBNCK)(XZHB) ;[4] IFONA ZHBNCK(XC) ;[4] LI XB,^D31 ;IF NOCHECK MOVSI X0,(XB) HRRI X0,2(X1) GENABS ;ZPCNRP,,ZPCDLE L X3,YBREAK LF X0,ZQUTYP(XZQU) ROT X0,-6 SKIPE XB SETONA ZPCPAR IFONA ZHBNCK(XC) ;[4] SETONA ZPCNCK CAIN XA,QEXF40 ;[4] SETONA ZPCF40 GENABS MOVSI X1,40K L X2,YDPATH CAIL XA,QEXFOR ;[4] FORTRAN or F40 L X2,[RADIX50 0,.PHFO] TLO X2,600K GENSYMB ;RELOCATE ZPCCAD ;OUTPUT ZFP FOR PARAMETERS IF ;NOCHECK procedure IFOFFA ZHBNCK(XC) ;[4] GOTO FALSE THEN ;Describe 31 integers by name LI X1,^D31 LF X0,ZHELEN(XZHB) HRLI X0,(BYTE (6)QINTEGER(3)QNAME,QSIMPLE(24)0) LOOP GENABS ADDI X0,2 AS SOJG X1,TRUE SA ELSE ;Describe all parameters LF XC,ZDELNK(XZHB) WHILE SOJL XB,FALSE DO LF X0,ZQUIND(XC) LF X1,ZQUTMK(XC) SF X1,ZFPTMK GENABS LF X1,ZQUQID(XC) SKIPE X1 EXEC DPEXCR LF XC,ZDELNK(XC) OD FI RETURN ;[4] EPROC ;[4] DPPROT SUBTTL findemall (DPEXFA) [144] Comment; 1) Finds all separate ATR files corresponding to external declarations. If a separate file x.atr corresponding to EXTERNAL ... x is found, the corresponding ZQU is taken off the chain starting with YEXZQU, and the information is read and processed by DPEXT. If the external spec was definite, i.e. of the form x=, the specified file is looked up. On lookup failure, ZQUIND is set to -1, leaving the message till later???. 2) If ZQU records now remain on the YEXZQU chain, any libraries on the SEARCH list are tried in order. The first index block is read in, and each name in the block is checked against the ZQU list. As soon as a matching name is found, the corresponding module is read in and processed by DPEXT. This goes on as long as there are index blocks and libraries left and the ZQU list contains entries. This processing order ensures that no unnecessary I/O positioning has to be done, and each file is read only once (except if a library is given to the right of an = sign in an external specification). ; DPEXFA::PROC SAVE SETOM YRQDEV ;No channel open yet HRRZS XZQU,YEXZQU ;Start of chain of unsatisfied external ref's WHILE ;List contains more JUMPE XZQU,FALSE DO LF ,ZQUTEM(XZQU) ST YDPLIN ;Declaration line no LI XZHB,3(XZQU) getdevice EXCH YRQDEV ;Open only if necessary CAME YRQDEV openext filespec LF ,ZQUIND(XZQU) STACK IF ;found lookitup GOTO FALSE THEN IF ;Non-specific request SKIPE YRQPPN GOTO FALSE THEN ;Process directly L1():! zquremove IF ;Global ZQU CAIE XZQU,YZQUGLO GOTO FALSE THEN ;Just note where old module found SETZ ;No offset EXEC O1EXNP ELSE ;External, read and process it EXEC O1EXTB ;[225] Read first block AOS YBHEXT+2 ;Adjust count L2():! EXEC O1EXRQ ;Note for output MOVSI (1B<%ZRQOUT>) IORM (X2) IORM YRQHEAD EXEC DPEXT FI ELSE ;Specific file requested, check for library EXEC DPRX50 ;RADIX50 name SETZ XZRQ, ;Just one module sought findmodules CAIN XZQU,YZQUGLO JUMPE XZRQ,L1 ;Was no library IF ;External module, not library file JUMPN XZRQ,FALSE THEN ;Back up byte pointer SOS YBHEXT+1 GOTO L2 FI IF ;Failed to find module in a library JUMPG XZRQ,FALSE THEN ;Error LF X1,ZQULID(XZQU) LF X2,ZHBXID(XZQU,3) ERROR(3,I2,Module not found in library) BRANCH DPAB FI FI EXEC O1EXCL SETOM YRQDEV ELSE ;Not found, error if specific request EXEC DPRX50 ;Note RADIX50 form of name IF ;Request was specific SKIPN YRQPPN GOTO FALSE THEN ;Error unless it was the global ZQU zquremove IF ;Not Global CAIN XZQU,YZQUGLO GOTO FALSE THEN EXEC DPEXER FI ELSE ;Remember as previous ZQU SKIPE YEXZQU HRLM XZQU,YEXZQU FI FI UNSTK XZQU OD ;;;;; Now try search list with remaining names ;;;;; L XZRQ,YRQHEAD IF ;Names remain and search list contains any libraries SKIPE YEXZQU IFOFFA ZRQSRC(XZRQ) GOTO FALSE THEN ;Try all remaining names with each library HRRZS XZRQ ;Clear flag bits LOOP ;Through ZRQ list IF ;File belongs to search list IFOFF ZRQSRC(XZRQ) GOTO FALSE THEN ;Try remaining names with this file LF ,ZRQDEV(XZRQ) EXCH YRQDEV CAME YRQDEV openext LF ,ZRQFIL(XZRQ) ST YRQFIL LF ,ZRQPPN(XZRQ) ST YRQPPN IF ;found lookitup GOTO FALSE THEN findmodules EXEC O1EXCL FI FI AS ;Long as neither list is empty LF XZRQ,ZRQZRQ(XZRQ) SKIPE YEXZQU JUMPN XZRQ,TRUE SA FI HRRZS XZQU,YEXZQU WHILE ;Chain not empty (unsatisfied externals) JUMPE XZQU,FALSE DO ;Generate error message CAIE XZQU,YZQUGLO ;Unless it is the global ZQU EXEC DPEXER ;(May return in later releases) HRLM XZQU,YEXZQU LF XZQU,ZQUIND(XZQU) OD RETURN EPROC DPRX50: PROC LF X1,ZQULID(XZQU) L YZSE1(X1) EXEC I1RX50 SF ,ZQUR50(XZQU) RETURN EPROC DPEXER::PROC ;[144] LF X1,ZHBXID(XZQU,3) L YZSE1(X1) ST YELEXT LF ,ZHBPPN(XZQU,3) ST YELEXT+3 LI X1,YELEXT L YLSLLS ST YELIN1 ST YELIN2 UNSTK (XPDP) ERRT QT,256 ;Name of file in message BRANCH DPAB EPROC SUBTTL getdevicename (DPEXGD), filespec (DPEXFS) [144] Comment; Finds out device name from ZHBDEV(XZHB). If zero, return 'DSK', otherwise 1st word of dictionary entry, in X0. ; DPEXGD::PROC LF X1,ZHBDEV(XZHB) MOVSI 'DSK' ;Default device IF ;Valid id no JUMPE X1,FALSE THEN ;Use dictionary entry L YZSE1(X1) FI RETURN EPROC ;*************************************** Comment; Filespec: Put file name in YRQFIL, PPN in YRQPPN; DPEXFS::PROC LF X1,ZHBXID(XZHB) L YZSE1(X1) ST YRQFIL LF ,ZHBPPN(XZHB) ST YRQPPN RETURN EPROC SUBTTL zquremove (DPEXRM) [144] Comment; Remove XZQU record from chain starting in YEXZQU. If chain becomes empty, clear YEXZQU. ; DPEXRM::PROC SAVE HLRZ X2,YEXZQU ;Previous ZQU or zero LF ,ZQUIND(XZQU) IF ;No previous ZQU in chain JUMPN X2,FALSE THEN ;Change YEXZQU ptr HRRM YEXZQU IF ;List is now exhausted JUMPN FALSE THEN SETZM YEXZQU FI ELSE ;Take out of chain SF ,ZQUIND(X2) FI L9():! RETURN EPROC SUBTTL DPEXTC APPEND EXTERNAL ATTRIBUTES TO DC1-LIST DPEXTC: WHILE GETEXT XA JUMPE XA,FALSE DO LF XTYP,ZQUTYP(,XA) LF XKND,ZQUKND(,XA) LF XMOD,ZQUMOD(,XA) IF CAIE XKND,QCLASS CAIE XMOD,QDECLARED GOTO FALSE THEN NOAPPEND ELSE APPEND FI GETEXT XB GETEXT XID GETEXT XID2 EXEC SH IF JUMPE XIDNO,FALSE THEN ;OBJECT APPENDED L [3,,3] EXEC SDALLOC SF XALLOC,ZDELNK(XATL) LI XATL,(XALLOC) HRR XA,YDPLIN STD XA,(XALLOC) SF XIDNO,ZQULID(XALLOC) GETEXT XID GETEXT XID2 IF CAIN XTYP,QREF GOTO TRUE JUMPE XID,FALSE CAIE XKND,QCLASS GOTO FALSE THEN APPEND EXEC SH SF XIDNO,ZQUQID(XALLOC) FI LF XMOD,ZQUMOD(XALLOC) IF CAIE XMOD,QDECLARED GOTO FALSE THEN ;NOT PARAMETER IF ;LABEL CAIE XTYP,QLABEL GOTO FALSE THEN ;LABEL AOS XID2,YMAXFX SF XID2,ZQUIND(XALLOC) EXEC DPEXDF ELSE IF CAIN XKND,QPROCEDURE GOTO TRUE CAIE XKND,QCLASS GOTO FALSE THEN ;CLASS OR PROCEDURE AOS XID2,YMAXFX SF XID2,ZQUIND(XALLOC) L [5,,5] EXEC SDALLOC IF JUMPE XSUL,FALSE THEN SF XALLOC,ZDELNK(XSUL) ELSE L XSUS,XALLOC FI L XSUL,XALLOC STACK XATS STACK XATL L XATS,XSUS L XATL,XSUL CLEARB XSUS,XSUL GETEXT XA GETEXT XB ADD XA,YDPSOL STD XA,(XALLOC) SF XID2,ZHEFIX(XALLOC) GETEXT GETEXT XA ST XA,3(XALLOC) GETEXT XID SF XID,ZHBUNR(XALLOC) EXEC DPEXDF EXEC DPEXTC IF JUMPE XSUS,FALSE THEN SF XSUS,ZDELNK(XATL) ELSE L XSUL,XATL FI L XSUS,XATS UNSTK XATL UNSTK XATS FI FI FI ELSE ;SKIP THIS OBJECT GETEXT X1 GETEXT IF ;LABEL CAIE XTYP,QLABEL GOTO FALSE THEN ;STORE UNIQUE NUMBER ST X1,YDPLUN ELSE IF CAIE XKND,QPROCEDURE GOTO FALSE THEN ;SKIP FORMAL PARAMETERS GETEXT GETEXT GETEXT GETEXT GETEXT ST YDPLUN ;SET LAST UNIQUE NUMBER WHILE GETEXT X1 JUMPE X1,FALSE DO GETEXT GETEXT GETEXT GETEXT GETEXT OD FI FI FI OD RETURN SUBTTL DPEXDF (DEFINE EXTERNAL NAME OF FIXUP) DPEXDF: PROC SAVE ;CREATE A ZQQ-RECORD L [2,,2] EXEC SDALLOC L XA,YDPZQQ ST XALLOC,YDPZQQ SF XA,ZQQLNK(XALLOC) SF XID2,ZQQFIX(XALLOC) SF XID,ZQQUNR(XALLOC) ST XID,YDPLUN RETURN EPROC SUBTTL DPEXCR (CREATE REQUEST OF EXTERNAL SYMBOL) DPEXCR: PROC ; CHECK IF QUA IS EXTERNAL PROCEDURE LI X2,5(XZHB) WHILE ;[176] LF X2,ZDELNK(X2) JUMPE X2,FALSE WHENNOT X2,ZHE GOTO FALSE IFNEQF (X2,ZHETYP,QQUACH) GOTO FALSE SKIPGE 1(X2) GOTO FALSE DO LF ,ZHELID(X2) IF CAME X1,X0 GOTO FALSE THEN L X3,YBREAK LI X0,0 GENABS MOVSI X1,40K LF X2,ZHEUNR(X2) TLO X2,600K GENSYMB RETURN FI OD ;QUA IS SYSTEM CLASS ASSERT<;[176] CAIL X1,QIDTXT RFAIL NOT SYSTEM-ID AT DPEXCR > L X2,[IOIN IOOU IODF IOPF RADIX5 60,.SSST RADIX5 60,.SUSI RADIX5 60,.SSLG RADIX5 60,.SSLK RADIX5 60,.SSHD RADIX5 60,.SUPS]-QIDINF(X1) IF TLNE X2,-1 GOTO FALSE THEN ;PROTOTYPE IN HISEG L X0,X2 GENABS ELSE ;PROTOTYPE IN LOWSEG L X0,0 L X3,YBREAK GENABS MOVSI X1,40K GENSYMB FI RETURN EPROC SUBTTL MAIN PROCEDURE DP: PROC EXEC O1DFOP ;OPEN DF1 ;OUTPUT LEADING ZHB FOR BASICIO L XDPOUT,[BYTE (3)QQZHB,QPBLOC(12)0(18)-2] PUTDF1 XDPOUT L XDPOUT,YMAXFX PUTDF1 XDPOUT ADDI XDPOUT,5 ST XDPOUT,YMAXFX LI XDPOUT,0 REPEAT 3, ;MERGE SYSTEM COMPONENTS WITH DC1-LIST EXEC DPSYS SETZM YDPZQQ findemall ;[144] (the ATR modules) ;CLEAR OFFSET COUNTER LI XZHEOF,5 LOOP ;OUTPUT DC1-LIST TO FILE DF1 LF (XTAG) ZDETYP(XPTR) IF CAIE XTAG,QQZHE GOTO FALSE THEN ;(ZHE-RECORD FOUND) ; =================== IF LF ,ZHETYP(XPTR) CAIE QQUACH GOTO TRUE SKIPG 1(XPTR) GOTO FALSE ;SKIP THIS RECORD IF EMPTY QQUACH THEN LD X0,(XPTR) PUTDF1 PUTDF1 X1 FI LF (XPTR) ZDELNK(XPTR) ;NEXT RECORD WILL HAVE OFFSET RELATIVE TO START OF THIS ZHE LI XZHEOF,2 ELSE IF CAIE XTAG,QQZHB GOTO FALSE THEN ;(ZHB-RECORD FOUND) ; =================== LF ,ZHETYP(XPTR) CAIE QINSPEC CAIN QPBLOCK SETZ XZHEOF, ;CLEAR OFFSET COUNTER ;IN CASE OF PREFIXED BLOCK LF ,ZHEDLV(XPTR) MOVN SF ,ZHBSTD(XPTR) LD (XPTR) PUTDF1 PUTDF1 X1 ;OUTPUT WORD 2 (FROM PREV ZQU) ZOUT <-1> ZOUT 3 ;OUTPUT WORD 3 ;OUTPUT WORD 4, AND STEP OFFSET COUNTER SETZ XDPOUT, IFON ZHBEXT(XPTR) LF XDPOUT,ZHBUNR(XPTR) PUTDF1 XDPOUT LF XPTR,ZDELNK(XPTR) ADDI XZHEOF,5 ELSE ;(ZQU-RECORD FOUND) ; =================== ;OUTPUT WORD 0 (WITH ZQUZHE=0) HLLZ XDPOUT,(XPTR) SETOFA ZQUTPT(XDPOUT) ;[40] PUTDF1 XDPOUT ;OUTPUT WORD 1 (WITH UNUSED PART=0) ZOUT 1 ;OUTPUT WORD 2 (=ZQUQID,,0) HLLZ XDPOUT,2(XPTR) PUTDF1 XDPOUT ;OUTPUT WORD 3 (=0,,ZQULNE OR SYSTEM-FLAGS,,0) LF XDPOUT,ZQUTEM(XPTR) IFON ZQUSYS(XPTR) MOVS XDPOUT,XDPOUT LF X1,ZQULID(XPTR) IF SKIPN YZSE2(X1) GOTO FALSE THEN ;IDENTIFIER MORE THAN SIX CHAR SETONA ZQULO(XDPOUT) FI IFON ZQUTPT(XPTR) ;[40] SETONA ZQUPTD(XDPOUT) ;[40] PUTDF1 XDPOUT ;STORE OFFSET FOR THIS ZQU, TO BE USED BY CORRESPONDING ZHB (IF ANY) L XP,XPTR LF XPTR,ZDELNK(XPTR) HRLZM XZHEOF,2(XP) ADDI XZHEOF,4 FI FI AS JUMPG XPTR,TRUE SA ;OUTPUT A DUMMY ZHE-RECORD TO STOP READING BY CARL L XDPOUT,[BYTE (3)QQZHE,QRBLOC(30)0] PUTDF1 XDPOUT LI XDPOUT,0 PUTDF1 XDPOUT ;OUTPUT ZQQ-RECORDS (IF EXTERNALS ARE REFERENCED IN PROGRAM) L X1,YDPZQQ WHILE JUMPE X1,FALSE DO ;OUTPUT A RECORD LF X2,ZQQFIX(X1) PUTDF1 X2 LF X2,ZQQUNR(X1) PUTDF1 X2 LF X1,ZQQLNK(X1) OD PUTDF1 X1 ;OUTPUT END MARKER EXEC O1DFCL ;IF MAIN PROG OUTPUT COMMENT IN REL FILE CONTAINING USED EXTERNALS IFONA YSWEMP EXEC O1RLUNR ;CHECK IF CONFLICT BETWEEN UNIQUE NUMBER OF EXTERNALS (IF ANY) L X3,YDPZUC WHILE ;EXTERNALS EXIST JUMPE X3,FALSE DO LI X4,(X3) LF X5,ZUCFUN(X3) LF X11,ZUCLUN(X3) WHILE ;EVEN MORE EXTERNALS EXISTS LF X4,ZDELNK(X4) JUMPE X4,FALSE DO ;TEST CONFLICT LF X7,ZUCFUN(X4) LF X10,ZUCLUN(X4) IF CAML X11,X5 CAMGE X10,X7 GOTO TRUE CAML X11,X7 CAMGE X10,X5 GOTO FALSE THEN IF CAMGE X10,X5 CAML X11,X7 GOTO TRUE CAMGE X11,X5 CAML X10,X7 GOTO FALSE THEN ;CONFLICT LF ,YLSLLIN ST YELIN1 ST YELIN2 SETZM YESEM LF X1,ZUCLID(X3) LF X2,ZUCLID(X4) IF CAMN X1,X2 CAME X5,X7 GOTO FALSE CAME X11,X10 GOTO FALSE THEN ;SAME EXTERNAL DECLARED TWICE ERRI1 QE,Q1DP.E+1 ELSE ;CONFLICT BETWEEN DIFFERENT EXTERNALS ERRI2 QE,Q1DP.E FI FI FI OD LF X3,ZDELNK(X3) OD RETURN EPROC SUBTTL ERROR ROUTINES XER1:XER3: LF X1,ZQULID(XZQU) ERROR(0,I1,TYPE AND-OR KIND OF EXTERNAL DOES NOT CORRESPOND) BRANCH DPAB XER2: ERROR(1,I1,NAME OF EXTERNAL DOES NOT CORRESPOND) BRANCH DPAB XER4: LF X1,ZQULID(XZQU) LF X2,ZHEDLV(XZHB) TRC X2,-1 SUBI X2,1 ERROR(2,I2,EXTERNAL COMPILED ON WRONG BLOCK LEVEL) BRANCH DPAB DPAB: EXEC O1EXCL ;[144] To be able to go on BRANCH T1AB LIT END