Trailing-Edge
-
PDP-10 Archives
-
decuslib10-07
-
43,50460/xglob.mac
There are no other files named xglob.mac in the archive.
TITLE XGLOB GENERATE REVERSE GLOBS FOR OVERLAY SETUP %1
SUBTTL B. SCHREIBER
SEARCH JOBDAT,UUOSYM,MACTEN,SCNMAC
.DIREC .XTABM
SALL
AC= 0 ;TMP
T1= 1 ;ALSO
T2= 2 ;
T3= 3
T4= 4
P1= 5
P2= 6
P3= <N=7> ;NAME SCANNED
P4= <C=10> ;LAST CHARACTER
F= 11 ;FLAGS
B= 12 ;CURRENT TITLE BLOCK POINTER
P= 17 ;PUSHDOWN AC
;FLAGS IN LH OF F
FL.NAM==(1B0) ;ON WHEN BLOCK TYPE 6 (NAME) SEEN
FL.SKP==(1B1) ;ON WHEN SKIPING A MULT DEFINED BLOCK
FL.TTO==(1B2) ;ON IF TTY IS OUTPUT DEVICE
FL.PP== (1B3) ;ON FOR PRETTY PRINT (FFEED EVERY 60 LINES)
FL.FSA==(1B4) ;ON IF FILE SPACE ALLOCATED
; FL.NAR==(1B5) ;ON IF /NARROW (SET BY SCAN)
FL.HSE==(1B6) ;ON IF BLOCK 3 (HISEG) SEEN
OPDEF CALL [PUSHJ P,]
OPDEF RETURN [POPJ P,]
SW.LIB==1B18 ;THIS IS A LIBRARY
SW.NAR==1B5 ;THIS OUTPUT IS IN NARROW FORMAT
FL.NAR==SW.NAR ;THE VALUE IN THE FLAG WORD
.FXLIB==.FXLEN ;-1 IF A LIBRARY FILE
ND FTDDT,1 ;1 FOR DEBUG FEATURES (SLIM)
ND FTCPU,0 ;1 TO PRINT CPU PGM WILL RUN ON
ND FT2SEG,0 ;1 FOR TWOSEGMENT VERSION
ND PDSIZ,^D50 ;PUSHDOWN LIST LENGTH
ND FBLKSZ,.FXLEN+1 ;LENGTH OF SCAN FILE BLOCK
;LAST WORD IS FLAGS
ND NIBUF,6 ;INPUT BUFFER COUNT
ND NOBUF,2 ;OUTPUT BUFFER COUNT
EXT <.ISCAN,.TSCAN,.TSTRG,.TCHAR,.STOPN,.LKWLD,.MNRET,.TCRLF,
.SAVE1,.SAVE2,.SAVE3,.SAVE4,.TSPAC,
.POPJ,.POPJ1,.TSIXN,.TTABC,.TOLEB,.TOCTW,.TYOCH,.TTIME,
.TTIMN,.TDATE,.TDATN,.FMSG,.FMSGN,.FMSGD,.FMSGO,.FMSGF,
E.DFL,F.NAM,.TDECW>
ICH== 1 ;INPUT CHANNEL
OCH== 2 ;OUTPUT CHANNEL
TTY== 3 ;CHANNEL FOR BUFFERED TTY OUTPUT
;VERSION INFORMATION
XGBWHO==0 ;LOCAL UPDATE
XGBVER==2 ;MAJOR VERSION
XGBMIN==0 ;MINOR VERSION
XGBEDT==4 ;EDIT LEVEL
COMMENT \ REVISION HISTORY
1 CREATION
2 FIX UP F40 SO IT HANDLES MAIN PGMS OK
3 FIX LISTING--GRQ'S MISSING CALL TO INIEGO
2(4) ADD CODE TO SUPPORT COMMON INFORMATION
\
IFN FT2SEG,<
TWOSEG
RELOC 400000
>
IFE FT2SEG,<
RELOC 0
>
LOC .JBVER
VRSN. XGB
RELOC
DEFINE SAVE ($X)<
XLIST
IRP $X,<PUSH P,$X>
LIST
>
DEFINE RESTOR ($X)<
XLIST
IRP $X,<POP P,$X>
LIST
>
SUBTTL DEFINE THE DATA STRUCTURE
COMMENT \THERE ARE TWO TYPES OF DATA STRUCTURES: 1) THE TITLE BLOCK,
WHICH CONTAINS LINKS TO THE GLOBAL REQUEST LIST AND THE ENTRY
LIST, AS WELL AS THE FILE SPECIFICATION FOR THE SOURCE OF THIS
MODULE. 2) ENTRY, GLOBAL REQUEST, LOCAL SYMBOL BLOCK. THESE BLOCKS ARE IN A
LIST OFF OF THE TITLE BLOCK. EACH LINK CONTAINS NAME, FLAGS, AND
A FEW POINTERS.
\
;DEFINE THE TITLE BLOCK
PHASE 0
TL$BAK:! ;LH LINK BACKWARDS
TL$NXT:!BLOCK 1 ;RH LINK FORWARDS
TL$FLG:!BLOCK 1 ;LH COMPILER TYPE AND PROCESSOR CODE
;RH FLAGS
TL$NAM:!BLOCK 1 ;SIXBIT TITLE NAME
TL$ENT:!BLOCK 1 ;LH 0, R PTR TO ENTRY LIST
TL$GRQ:!BLOCK 1 ;LH 0, RH PTR TO GLBL REQ LIST
TL$SIZ:!BLOCK 1 ;LH=HISEG SIZE,RH=LOWSEG SIZE
TL$COM:!BLOCK 1 ;LH TOTAL COMMON SIZE, RH PTR TO LIST
TL$DEV:!BLOCK 1 ;SIXBIT DEVICE
TL$PPN:!BLOCK 1 ;PPN
TL$FIL:!BLOCK 1 ;SIXBIT FILENAME
TL$EXT:! ;SIXBIT EXTENSION
TL$END:!
TTLSIZ==TL$END+1 ;SIZE OF A TITLE BLOCK
DEPHASE
;NOW DEFINE THE ENTRY, GLOBAL REQUEST, AND COMMON LISTS
PHASE 0
EG$BAK:! ;LH LINK BACKWARDS
EG$NXT:!BLOCK 1 ;RH LINK FORWARDS
EG$FLG:!BLOCK 1 ;FLAGS
EG$NAM:!BLOCK 1 ;SIXBIT NAME
EG$TTL:! ;RH LINK TO TITLE BLOCK
EG$ORD:!EG$END:! ;LH LINK TO NEXT ENTRY OR GRQ IN ALPHA ORDER
EGLSIZ==EG$END+1 ;SIZE OF AN EGR BLOCK
DEPHASE
;DEFINE THE FLAGS USED IN THESE BLOCKS
FT$LIB==1B18 ;ON IF THIS IS FROM A LIBRARY
FT$REF==1B19 ;ON IF THIS LIB MODULE HAS BEEN REFERENCED
FT$SCN==1B20 ;THIS LIBRARY MODULE HAS BEEN SCANED
SUBTTL MAIN PROGRAM
XGLOB: TDZA T1,T1 ;NORML ENTRY
MOVEI T1,1 ;CCL ENTRY
RESET ;STOP THE WORLD
MOVEM T1,OFFSET ;SAVE START OFFSET FOR SCAN
MOVEM .SGNAM,SGNAM ;SAVE INITIAL SPECS
MOVEM .SGPPN,SGPPN
MOVEM .SGDEV,SGDEV
MOVEM .SGLOW,SGLOW
MOVEI T1,XGLOB2 ;RESET START ADDR
HRRM T1,.JBSA ;SO ^C START WILL WORK
XGLOB1: MOVE P,[IOWD PDSIZ,PDLIST] ;INIT PUSHDOWN LIST
STORE T1,F.ZER,L.ZER,0 ;CLEAR CORE
INIT TTY,.IOASC ;GET THE TTY FOR OUTPUT
SIXBIT /TTY/
XWD TOBHR,0
HALT ;CAN'T HAPPEN!!
OUTBUF TTY,2 ;SETUP BUFFERS NOW
OUTPUT TTY, ;DUMMY OUTPUT
MOVE T1,[3,,[0 ;ARGBLOCK FOR SCAN -- NO RESCAN
XWD OFFSET,'XGB';STARTING OFFSET, CCL NAME
XWD 0,TOCHAR ;DEFAULT INPUT, BUFFERED OUTPUT ROUTINE
]
]
CALL .ISCAN ;INITIALIZE THE SCANNER
MOVE T1,.JBFF ;SAVE INITIAL CORE END
HRL T1,.JBREL ;AND END OF CORE
MOVEM T1,SAVJFF ;...
JRST GBXSCN
XGLOB2: RESET ;HERE ON ^C START
JRST XGLOB1
GBXSCN: SETZ F, ;CLEAR THE FLAGS
CALL UPSCN ;MAKE SURE HISEG IS THERE
MOVEI B,LSTHED ;INITIALIZE THE POINTER
MOVE T1,[11,[IOWD GBXSWL,GBXSWN ;ARGBLOCK FOR .TSCAN
XWD GBXSWD,GBXSWM
EXP GBXSWP ;POINTER TO SWITCH POINTERS
EXP -1 ;USE JOB TABLE FOR NAME
XWD CLRANS,CLRFIL
XWD ALCIN,ALCOUT
XWD 0,0 ;MEMSTK,APLSTK
0
EXP SWTSTO ;STORE SWITCHES
]
]
CALL .TSCAN ;PARSE A LINE
IOR F,FLAGS ;GET THE FLAGS
CALL SCNCHK ;LEGALIZE THE SCAN BLOCKS
SETZM WLDTMP ;CLEAR TEMP STORE FOR WILD
MOVEI T1,O.AREA ;BEGINNING OF OUTPUT SPEC
MOVEI T2,OPNBLK ;ADDRESS OF 3 WORD OPEN BLOCK
MOVE T3,[.RBSIZ+1,,LKPBLK] ;SIZE,,ADDRESS OF LOOKUP BLOCK
HLRZM T3,LKPBLK ;SET SIZE INTO LOOKUP BLOCK
CALL .STOPN ;CONVERT SCAN BLOCK TO OPEN/ENTER BLOCK
JRST [MOVE T1,OPNBLK+.OPDEV ;GET DEVICE
DEVCHR T1, ;FIND WHAT SORT IT IS
TXNE T1,DV.DIR ;HAVE A DIRECTORY?
JRST E.WOI ;YES, ERROR THEM
JRST DOXGLB] ;NO, FORGE AHEAD
DOXGLB: HLRZ T1,OPNBLK+.OPDEV;GET THE DEVICE NAME
CAIN T1,'TTY' ;TTY IS DIFFERENT
JRST [TLO F,FL.TTO;YES, OUTPUT TO TTY
JRST DOXGL1] ;BUT INPUT IS THE SAME
MOVEI T1,.IOASC ;OPEN OUTPUT IN ASCII
IORM T1,OPNBLK+.OPMOD
MOVSI T1,OUTBHR ;BUFFER HEADER
MOVEM T1,OPNBLK+.OPBUF
OPEN OCH,OPNBLK ;GET THE DEVICE
JRST E.OPN ;CAN'T
ENTER OCH,LKPBLK ;WRITE THE FILE
JRST E.ENT ;CAN'T
MOVEI T1,OUTBUF ;SET UP BUFFERS
EXCH T1,.JBFF
OUTBUF OCH,NOBUF
MOVEM T1,.JBFF ;RESTORE JOBFF
; SETZ T1, ;GET MY RUNTIME
; RUNTIM T1,
; MOVEM T1,TIMEON
;HERE TO GET NEXT INPUT FILE
DOXGL1: CALL UPSCN ;MAKE SURE SCAN IS THERE
MOVE T1,[4,,[INBEG,,INEND ;INPUT START,INPUT END
OPNBLK,,LKPBLK ;
FBLKSZ,,.RBSIZ+1;INPUT SIZE,,OUTPUT SIZE
EXP 1B0+WLDTMP
]
]
CALL .LKWLD ;FIND A FILE
JRST DOXGLF ;FINISH UP, NO MORE FILES
HRR F,WLDTMP ;GET ADDRESS OF CURRENT SCAN BLOCK
MOVEI T1,.IOBIN ;DO THE INPUT IN BINARY
IORM T1,OPNBLK+.OPMOD
MOVEI T1,INPBHR ;INPUT HEADER
MOVEM T1,OPNBLK+.OPBUF
OPEN ICH,OPNBLK ;OPEN THE DEVICE
JRST E.OPN ;CAN'T
LOOKUP ICH,LKPBLK
JRST E.LKP
MOVEI T1,INPBUF ;SETUP BUFFERS
EXCH T1,.JBFF
INBUF ICH,NIBUF
MOVEM T1,.JBFF
CALL DWNSCN ;DOWN WITH HISEG
CALL DOFILE ;PROCESS THE FILE
JRST DOXGL1 ;DO NEXT FILE
DOXGLF: CALL DWNSCN ;.TOUTS IS IN THE LOWSEG
CALL LISTIT ;OUTPUT THE LISTING
TLNE F,FL.TTO ;IF TTY OUTPUT
JRST XGLF1 ;SKIP AHEAD
MOVEI T1,.CHFFD ;BOOT TO NEW PAGE AT END
CALL OBYTE ;...
CLOSE OCH,
RELEASE OCH,
XGLF1: RELEASE ICH,
; SETZ T1,
; RUNTIM T1, ;SEE HOW LONG IT TOOK
; SUB T1,TIMEON ;IN MILLISECS
; CALL .TTIME ;TYPE THE TIME
; MOVEI T1,[ASCIZ\ CPU TIME
;\]
; CALL .TSTRG ;OUTPUT IT
JRST GBXSCN ;NEXT COMMAND
SUBTTL SCNCHK VERIFIES SCANNED COMMAND
SCNCHK: CALL .SAVE1 ;
MOVEI T2,O.AREA ;GET POINTER TO OUTPUT SPEC
MOVSI T1,'LPT' ;YES, GET DEFAULT DEVICE
SKIPN .FXDEV(T2) ;DID USER SPECIFY ONE?
MOVEM T1,.FXDEV(T2) ;NO, USE DEFAULT
SKIPN P1,INBEG ;GET ADDRESS OF INPUT SPEC
JRST E.NIS ;WASN'T ANY?
SKIPN T1,.FXNAM(P1) ;WAS THERE A NAME?
JRST E.NFI ;NO
SKIPN .FXNAM(T2) ;WAS THERE AN OUTPUT NAME?
MOVEM T1,.FXNAM(T2) ;NO, USE FIRST INPUT NAME
MOVSI T1,-1 ;SET TO CHECK NAME
TDNE T1,.FXEXT(T2) ;WAS EXTENSION GIVEN?
JRST SCNCK1 ;YES, DON'T DIDDLE
MOVE T4,.FXMOD(T2) ;NO, GET FLAG
HRLOI T1,'LST' ;INCASE DEFAULT NEEDED
TXNE T4,FX.NUL ;EXPLICITLY NULL?
MOVEM T1,.FXEXT(T2) ;NO, STORE DEFAULT
SCNCK1: SKIPN .FXNAM(P1) ;INPUT NAME SPECIFIED?
JRST E.NFI
MOVSI T1,-1 ;
TDNE T1,.FXEXT(P1) ;GIVEN?
JRST SCNCK2 ;YES, CHECK NEXT BLOCK
MOVE T2,.FXMOD(P1) ;GET FLAGS
HRLOI T1,'REL' ;INCASE NEEDED
TXNE T2,FX.NUL ;SPECIFICALLY NULL?
MOVEM T1,.FXEXT(P1) ;NO, STORE DEFAULT
SCNCK2: CAMN P1,INEND ;DONE SCANNING INPUT BLOCKS?
RETURN ;YES
ADDI P1,FBLKSZ ;NO, MOVE TO NEXT ONE
JRST SCNCK1 ;CHECK IT OUT
E.NFI: M.FAIL (NULL FILENAME ILLEGAL)
E.WOI: M.FAIL (WILD CARD ON OUTPUT ILLEGAL)
E.NIS: M.FAIL (NULL INPUT SPEC ILLEGAL)
E.TMO: M.FAIL (TOO MANY OUTPUT SPECS)
E.OPN: MOVE N,OPNBLK+.OPDEV ;GET DEVICE NAME
M.FAIN (OPEN ERROR FOR DEVICE )
E.ENT: MOVEI N,O.AREA ;POINT AT THE SPEC
M.FAIF (ENTER ERROR FOR )
E.LKP: CALL E.DFL
SCNERR: MOVE P,[IOWD PDSIZ,PDLIST] ;RESET PDLIST
CALL .CLRBF## ;CLEAR THE INPUT TYPE AHEAD
JRST GBXSCN ;FORGE ONWARD
SUBTTL CLRANS/ALCOUT/ALCINP
CLRFIL: SKIPL T1,INXTZ ;BLOCK ALLOC?
JRST CLRFL1 ;NO
HRRZS T1 ;YES, CLEAR LH
HRRZ T2,SAVJFF ;START OF LIST
CAMN T1,T2 ;THIS THE FIRST?
SETZM INBEG ;YES, START OVER
SUBI T1,FBLKSZ ;COMPUTE END OF CORE
MOVEM T1,.JBFF
CLRFL1: SETZM INXTZ
RETURN
CLRANS:
STORE T1,SCN.F,SCN.Z,0 ;CLEAR SCANNER INFO
MOVE T1,SAVJFF ;RESTORE JOBFF
HRRZM T1,.JBFF
HLRZS T1 ;GET JOBREL BACK
CAME T1,.JBREL ;IS IT THE SAME?
CORE T1, ;NO, SHRINK IT BACK
JFCL ;IGNORE THE ERROR
RETURN ;BACK TO SCAN
ALCOUT: MOVEI T1,O.AREA ;GET ADDRESS
MOVEI T2,O.SIZE ;AND SIZE
SETOM OUTDON ;FLAG OUTPUT SIDE DONE
RETURN
ALCIN: SKIPGE INXTZ ;FUNNY IN PROGRESS?
JRST ALCIN1 ;YES
MOVEI T1,FBLKSZ ;SIZE OF BLOCK
CALL GETCOR ;GET SOME SPACE
SKIPN INBEG ;FIRST ONE?
MOVEM T1,INBEG ;YES, REMEMBER WHERE IT IS
MOVEM T1,INEND ;SAVE ADDRESS OF LAST
ALCIN2: HRR F,T1 ;BLOCK ADDRESS INTO F
MOVEI T2,.FXLEN ;RETURN SIZE
RETURN
ALCIN1: HRRZS T1,INXTZ ;CLEAR FUNNY FLAG
JRST ALCIN2 ;BLOCK IS ALREADY ALLOCATED
SWTSTO: SKIPL OUTDON ;GOT OUTPUT?
RETURN ;NO,IGNORE
SKIPE F.NAM ;GLOBAL SWTCHES?
JRST SWTLOC ;NO
MOVX T1,SW.LIB ;YES, GET LIB SWITCH
IORM T1,FLAGS
IORM T1,FLAGS+1
RETURN
SWTLOC: SKIPN T1,INXTZ ;BLOCK SET UP?
JRST SWTLC1 ;NO
SWTLC2: SETOM .FXLIB(T1) ;STORE FLAG ON
RETURN
SWTLC1: CALL ALCIN ;GET A BLOCK
HRROM T1,INXTZ ;FLAG FUNNY
JRST SWTLC2 ;GO STORE
;GETCOR
;CALL: MOVEI T1,WORDS
; CALL GETCOR
; *RETURN T1=ADDR OF CORE*
GETCOR: MOVE T2,T1 ;COPY # WORDS
MOVE T1,.JBFF ;GET ADDRESS OF BLOCK
ADDB T2,.JBFF ;UPDATE NEW END OF CORE
CAMG T2,.JBREL ;OK?
RETURN ;YES, IN MY MEMORY
CORE T2, ;NO, GET SOME MORE
SKIPA ;???CAN'T
RETURN
CALL UPSCN ;SEE ABOUT THE HISEG
MOVEI T1,[ASCIZ\?GBXNEC NOT ENOUGH CORE
\]
CALL .TSTRG
CALL .MNRET
JRST .-1 ;NO HOPE
IFN FT2SEG,<
DWNSCN= .POPJ ;WE'RE UP THERE TOO!
UPSCN= .POPJ
>
IFE FT2SEG,< ;ARE WE IN THE LOWSEGMENT?
DWNSCN: SKIPGE SCNDWN ;WHERE IS THE LITTLE RASCAL?
RETURN ;HE WENT AWAY
MOVSI T1,1 ;STILL HERE,
CORE T1, ;BUT THIS SHOULD GET HIM
RETURN ;DIDN'T? SNH
SETOM SCNDWN ;SAY SCAN HAS GONE AWAY
RETURN ;AND GO AWAY
UPSCN: SKIPL SCNDWN ;IS SCAN MISSING?
RETURN ;NO, HE'S RIGHT ABOVE ME
MOVEM 17,SAV17 ;SAVE ACS OVER GETSEG UUO
MOVEI 17,SAV0 ;STASH THEM AWAY
BLT 17,SAV0+16 ;...
MOVE T1,SGDEV ;GET DEVICE
MOVEM T1,SEGBLK ;PUT IN SEG BLOCK
MOVE T1,SGNAM ;DITTO FOR THE REST
MOVEM T1,SEGBLK+1
SETZM SEGBLK+2
SETZM SEGBLK+3
MOVE T1,SGPPN
MOVEM T1,SEGBLK+4
SETZM SEGBLK+5
SEGAGN: MOVEI T1,SEGBLK
GETSEG T1,
SKIPA
JRST [SETZM SCNDWN
MOVSI 17,SAV0
BLT 17,17
RETURN]
OUTSTR [ASCIZ\?XGBNGS CANNOT GET HISEG BACK
\]
EXIT 1,
JRST SEGAGN
SEGBLK: BLOCK 6 ;ARGLIST FOR GETSEG UUUO
SAV0: BLOCK 20 ;SAVE ACS OVER GETSEG UUO
SAV17=.-1
SCNDWN: BLOCK 1 ;-1 WHEN SCAN HAS TAKEN A VACATION
>;END IFE FT2SEG
SUBTTL DO ONE FILE
DOFILE: CALL .SAVE2 ;NEED P1,P2
SETZM HSEGOR ;CLEAR ORIGINS
SETZM LSEGOR ;...
TLZ F,FL.NAM!FL.SKP!FL.HSE ;CLEAR VITAL FLAGS
FILREAD:JSP T2,IBYTEJ ;GET NEXT BLOCK TYPE
HLRZ P1,T1 ;GET BLOCK CODE
HRRZ P2,T1 ;AND SIZE
CAIN P1,14 ;IF INDEX BLOCK
JRST RDNDXB ;DO SPECIAL
CAIE P1,400 ;CHECK FOR F40
CAIN P1,401 ;OR MANTIS
JRST RDF40 ;YES
MOVSI T3,-NBLKTY ;AOBJN
CAME P1,BLKTYP(T3) ;THIS IT/
AOBJN T3,.-1 ;NO, LOOP FOR ALL
JUMPGE T3,FILRD4 ;JUMP IF NOT FOUND YET
JSP T2,IBYTEJ ;SKIP RELOC WORD
CAIGE P1,100 ;LEGAL BLOCK TYPE (OLDSTYLE)
CALL COUNT ;YES, GET CORRECT COUNT
SOJG P2,@BLKDIS(T3) ;COUNT RELOC WORD AND JUMP OFF
JRST FILREAD ;NULL BLOCK (RELOC WORD ONLY)
FILRD4: CAIL P1,100 ;OLD TYPE LEGAL?
JRST FILRD2 ;NO, MUST CHECK SOME MORE
FILRD1: CALL COUNT ;COMPUTE CORRECT SIZE
FILRD3: SOJL P2,FILREAD ;JUMP IF DONE
JSP T2,IBYTEJ
JRST FILRD3 ;MORE
FILRD2: CAIL P1,1000 ;IS IT A NEW BLOCK TYPE?
CAIL P1,1777 ;...
SKIPA ;NO, SEE IF ASCII
JRST FILRD3 ;YES, SKIP IT
CAIG P1,3777 ;IS IT ASCII?
JRST E.BLKT ;NO, ILLEGAL TYPE
JSP T2,IBYTEJ
JUMPN T1,.-2 ;WATCH FOR THE 'Z' IN ASCIZ
JRST FILREAD ;GET NEXT BLOCK
BLKTYP: EXP 4 ;ENTRY BLOCK
EXP 1001 ;ENTRY BLOCK
EXP 1002 ;LONG ENTRY BLOCK
EXP 3 ;HISEG BLOCK
EXP 6 ;NAME BLOCK
EXP 1003 ;NAME BLOCK
EXP 2 ;SYMBOL
EXP 20 ;COMMON ALLOCATION
EXP 5 ;END BLOCK
EXP 1040 ;END BLOCK
NBLKTY==.-BLKTYP
BLKDIS: EXP RDNTRY
EXP RDNTRY
EXP RDNTRY
EXP RDHSEG
EXP RDNAME
EXP RDNAME
EXP RDSYMB
EXP RDCOMM
EXP RDEND
EXP RDEND
IBYTEJ: CALL IBYTE ;GET A BYTE
RETURN ;EOF
JRST (T2) ;OK, RETURN
RDNDXB: HRRZ T3,T1 ;GET SIZE OF BLOCK
JSP T2,IBYTEJ ;SKIP ONE
SOJG T3,.-1 ;SKIP THEM ALL
JRST FILREAD ;CONTINUE
RDHSEG: TLO F,FL.HSE ;FLAG HISEG SEEN
JSP T2,IBYTEJ ;GET HIGH SEG ORIGIN
SOS P2 ;COUNT HISEG ORIGIN
SETZM LSEGOR ;CLEAR IN CASE NONE
HRRZM T1,HSEGOR ;SAVE HISEG ORIGIN
SOJL P2,FILREAD ;JUMP IF NO 2ND WORD
JSP T2,IBYTEJ ;GET LOWSEG ORIGIN
HRRZM T1,LSEGOR ;...
JRST FILRD3 ;CONTINUE
;HERE TO READ COMMON ALLOCATION BLOCK
RDCOMM: JSP T2,IBYTEJ ;GET NAME
SOS P2
CALL R50T6 ;CONVERT TO SIXBIT
CALL NTRCOM ;ENDTER IN THE LIST
JRST [JSP T2,IBYTEJ ;ALREADY DEFINED IN THIS MODULE
JRST RDCOM1] ;IGNORE IT
MOVE P1,T1 ;REMEMBER WHERE BLOCK IS
JSP T2,IBYTEJ ;GET SIZE
HLRZ T2,TL$COM(B) ;GET TOTAL COMMON ALLOC SO FAR
ADDI T2,(T1) ;TOTAL NEW
HRLM T2,TL$COM(B) ;SAVE
HRLM T1,EG$FLG(P1) ;STORE COMMON ALLOCATION IN COMMON BLOC
RDCOM1: SOJLE P2,FILREAD ;EXIT IF ENOUGH
JRST RDCOMM ;THERE IS MORE
RDSYMB: JSP T2,IBYTEJ ;GET THE SYMBOL
LDB T2,[POINT 4,T1,3] ;GET CODE
CAIE T2,14 ;GLOBAL REQUEST?
JRST RDSYM1 ;***NO, IGNORE THIS SYMBOL
CALL R50T6 ;CONVER TO SIXBIT IN T1
CALL NTRGRQ ;ENTER THIS REQUEST INTO THE CHAIN
RDSYM1: SOJL P2,FILREAD ;COUNT SYMBOL AND JUMP IF AT END OF BLOCK
JSP T2,IBYTEJ ;SKIP VALUE
SOJG P2,RDSYMB ;JUMP IF MORE SYMBOLS
JRST FILREAD ;NO, READ NEXT BLOCK TYPE
RDEND: TLZ F,FL.SKP ;CLEAR SKIP FLAG
TLZN F,FL.NAM ;HAVE A NAME BLOCK?
JRST RDEND1 ;NO NOT TODAY
JSP T2,IBYTEJ ;GET FIRST DATA WORD
SOS P2 ;COUNT IT
TLZN F,FL.HSE ;YES, HAVE A HISEG BLOCK?
JRST RDEND2 ;NO, LOWSEG ONLY
SUB T1,HSEGOR ;YES, COMPUTE HISEG SIZE
HRLM T1,TL$SIZ(B) ;SAVE IN TITLE BLOCK
SOJL P2,FILREAD ;JUMP IF DONE
JSP T2,IBYTEJ ;GET LOWSEG BREAK
SUB T1,LSEGOR ;COMPUTE SIZE
HRRM T1,TL$SIZ(B)
RDEND1: SOJL P2,FILREAD
JSP T2,IBYTEJ ;SKIP ANY LEFT
JRST RDEND1
RDEND2: SUB T1,LSEGOR ;COMPUTE LOWSEG SIZE
HRRZM T1,TL$SIZ(B) ;SAVE
JRST RDEND1 ;CONTINUE
RDNTRY: TLNE F,FL.NAM ;HAVE A TITLE BLOCK?
JRST RDNT1 ;YES
SETZ T1, ;NO, REQUEST ONE
CALL NTRTTL ;WITH NULL NAME
HALT . ;DIAGNOSTIC
TLO F,FL.NAM ;WE HAVE ONE NOW
RDNT1: MOVSI P1,-22 ;RELOC WORD EVERY 18
RDNT2: JSP T2,IBYTEJ ;GET ENTRY NAME
CALL R50T6 ;CONVERT TO SIXBIT
CALL NTRENT ;PUT IT IN THE LIST OF ENTRIES
SOJLE P2,FILREAD ;JUMP IF END OF BLOCK
AOBJN P1,RDNT2 ;JUMP IF NOT RELOC TIME
JSP T2,IBYTEJ ;GET RELOC WORD
SOJG P2,RDNT1 ;JUMP IF MORE ENTRIES
JRST FILREAD ;NO, GET NEXT BLOCK
RDNAME: JSP T2,IBYTEJ ;GET THE NAME
SOS P2 ;COUNT THE NAME
CALL R50T6 ;CONVERT TO SIXBIT
TLNN F,FL.NAM ;ALREADY HAVE TITLE BLOCK?
JRST RDNAM1 ;NO, CONTINUE
SKIPE TL$NAM(B) ;YES, IS THERE A NAME?
HALT ;DIAGNOSTIC
MOVEM T1,TL$NAM(B) ;NO, STORE IT
JRST RDNAM2 ;CONTINUE
RDNAM1: CALL NTRTTL ;ENTER IT
TLO F,FL.SKP ;ALREADY DEFINED
TLO F,FL.NAM ;WE HAVE NAME BLOCK
RDNAM2: SOJL P2,FILREAD ;JUMP IS NO FLAG WORD
JSP T2,IBYTEJ ;GET FLAG WORD
HLLM T1,TL$FLG(B) ;STORE CPU/XLATR FLAGS
LDB T2,[POINT 12,T1,17] ;GET XLATOR TYPE
CAIN T2,CBLXLT ;IS IT COBOL?
JRST FILRD3 ;YES--RH IS SIZE OF STATIC LOW SEG
HRRZ P1,T1 ;GET POSSIBLE BLANK COMMON ALLOC
JUMPE P1,FILRD3 ;JUMP IF NONE
MOVE T1,[SIXBIT/.COMM./] ;BLANK COMMON NAME
PUSHJ P,NTRCOM ;ENTER IT
JRST FILRD3 ;??ALREADY DEFINED??
HRLM P1,EG$FLG(T1) ;STORE BLANK COMMON SIZE
HLRZ T2,TL$COM(B) ;CURRENT SIZE THIS MODULE
ADDI T2,(P1) ;ADD NEW
HRLM T2,TL$COM(B) ;STORE
JRST FILRD3 ;CONTINUE
RDF40: JSP T2,IBYTEJ ;SKIP OVER CODE
HLRZ T2,T1 ;[2] GET CODE BITS
ANDI T2,770000 ;[2] TRIM TO TYPE
CAIN T2,40000 ;[2] GLOBAL DEFINITION?
JRST [ ;[2] YES--ENTER IT
CALL R50T6 ;[2] CONVERT TO SIXBIT
CALL NTRENT ;[2] ENTER THE ENTRY
JRST RDF40 ;[2] CONTINUE THE SCAN
]
CAME T1,[-2] ;
JRST RDF40 ;NOT YYET
MOVEI T3,3 ;SKIP TWO WORDS
JSP T2,IBYTEJ
SOJG T3,.-1
MOVE T3,T1 ;GET LAST WORD
JUMPE T3,RDF40A ;JUMP IS NULL SECTION
JSP T2,IBYTEJ
SOJG T3,.-1
RDF40A: JSP T2,IBYTEJ ;GET # GLOBAL REQUESTS
JUMPE T1,RDF40C ;JUMP IF NONE
MOVE P2,T1 ;COPY IT
RDF40B: JSP T2,IBYTEJ ;GET SYMBOL
CALL R50T6 ;CONVERT TO SIXBIT
CALL NTRGRQ ;PUT IN GLOBAL REQUEST LIST
SOJG P2,RDF40B ;GET ALL OF THEM
RDF40C: JSP T2,IBYTEJ ;# WORDS IN SCLAR SECTION
JUMPE T1,RDF40D ;JUMP IF NONE
MOVE T3,T1 ;COPY IT
JSP T2,IBYTEJ ;GET ONE
SOJG T3,.-1 ;SKIP THEM ALL
RDF40D: JSP T2,IBYTEJ ;GET # WORDS IN ARRAY SECTION
JUMPE T1,RDF40E ;JUMP IF NONE
MOVE T3,T1
JSP T2,IBYTEJ
SOJG T3,.-1
RDF40E: JSP T2,IBYTEJ ;NUMBER WORDS IN NEXT SECTION
JUMPE T1,RDF40F ;JUMP IF EMPTY
MOVE T3,T1
JSP T2,IBYTEJ
SOJG T3,.-1
RDF40F: JSP T2,IBYTEJ ;SKIP A WORD
JSP T2,IBYTEJ ;GET # WORDS IN COMMON SECTION
JUMPE T1,RDF40G ;JUMP IF NONE
MOVE T3,T1
JSP T2,IBYTEJ
SOJG T3,.-1
RDF40G: TLZ F,FL.NAM ;THIS IS THE END
JRST FILREAD ;READ NEXT BLOCK
;E.BLKT: CALL UPSCN ;PUT SCAN BACK
E.BLKT: MOVEI T1,[ASCIZ\%GBXUBA UNKNOWN BLOCK TYPE \]
CALL .TSTRG
MOVE T1,P1
CALL .TOCTW ;TELL WHAT SORT IT IS
MOVEI T1,[ASCIZ\, ATTEMPTING RECOVERY
\]
CALL .TSTRG
; CALL DWNSCN ;MAKE SCAN DISAPPEAR
JRST FILRD3 ;IGNORE ILLEGAL BLOCK TYPES
;CALL WITH SYMBOL IN T1 IN RADIX 50
;RETURN WITH SIXBIT SYMBOL IN T1
;USES T1-3
R50T6: TLZ T1,740000 ;CLEAR CODE BITS
SETZ T3, ;CLEAR RESULT
;CODED INLINE FOR SPEED
REPEAT 4,<
XLIST
IDIVI T1,50 ;PEEL OFF A DIGIT
SKIPE T2,R50TAB(T2) ;LOAD UP SIXBIT
LSHC T2,-6 ;ADD INTO T3
CAIG T1,50 ;DOWN TO LAST DIGIT?
JRST R50T6X ;YES
LIST
>;END REPEAT 4
IDIVI T1,50 ;GET NEXT TO LAST DIGIT
SKIPE T2,R50TAB(T2) ;GET FIFTH CHAR
LSHC T2,-6 ;STORE IT
R50T6X: SKIPE T2,R50TAB(T1) ;ONCE MORE
LSHC T2,-6
MOVE T1,T3 ;POSITION
RETURN
DEFINE R50 (C)<
XLIST
IRPC C,<
''C''
>
LIST
>
R50TAB: R50 ( 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$% )
;CALL WITH COUNT IN P2
;RETURN WITH CORRECT COUNT (INCLUDING RELOC WORDS IN P2)
COUNT: HRRZ T1,P2 ;GET COUNT
IDIVI T1,22 ;COUNT #18 GROUUPS
ADDI P2,(T1) ;ONE RELOC WORD FOR EACH
SKIPE T2 ;ANY STRAGGLERS?
AOS P2 ;YES, ONE MORE RELOC WORD
RETURN ;BACK
SUBTTL NTRTTL/NTRGRQ/NTRENT
;NTRTTL
;CALL: MOVE T1,SIXBIT NAME
; CALL NTRTTL
; *RETURN IF ALREADY DEFINED*
; *RETURN THIS DEFINES IT*
NTRTTL: CALL IFDFIN ;SEE IF MODULE DEFINED
AOSA (P) ;NO, ENTER IT
RETURN ;YES, RETURN CPOPJ
SAVE T1 ;SAVE THE SYMBOL
MOVEI T1,TTLSIZ ;GET CORE FOR IT
CALL GETCOR ;...
EXCH B,T1 ;SAVE LAST, GET NEW
SETZM (B) ;CLEAR THE BLOCK
MOVSI T2,(B)
HRRI T2,1(B) ;FORM BLT WORD
BLT T2,TTLSIZ-1(B) ;CLEAR THE BLOCK
RESTOR TL$NAM(B) ;ENTER THE NAME
MOVE T2,OPNBLK+.OPDEV;GET THE DEVICE
MOVEM T2,TL$DEV(B) ;STORE
MOVE T2,LKPBLK+.RBNAM;FILENAME
MOVEM T2,TL$FIL(B) ;
MOVE T2,LKPBLK+.RBEXT;EXTENSION
HLLZM T2,TL$EXT(B)
MOVE T2,LKPBLK+.RBPPN;AND THE PPN
MOVEM T2,TL$PPN(B)
MOVX T2,FT$LIB ;GET BIT FOR LIBRARY
SKIPE .FXLIB(F) ;LIBRARY?
IORM T2,TL$FLG(B) ;YES, INDICATE IT
HRRM B,(T1) ;STORE LINK TO THIS ONE
HRLM T1,(B) ;STORE BACK LINK
RETURN ;SKIP BACK
;CALL WITH T1 SIXBIT NAME
;SKIP IF TITLE BLOCK DEFINED, NO SKIP IF NOT
IFDFIN: MOVEI T2,LSTHED ;START THE SEARCH
IFDF1: HRRZ T2,(T2) ;MOVE ALONG THE LIST
JUMPE T2,.POPJ ;JUMP IF NOT FOUND
CAME T1,TL$NAM(T2) ;IS THIS ME?
JRST IFDF1 ;NO, KEEP SEARCHING
JRST .POPJ1 ;YES, SKIP BACK
;NTRENT TO ENTER AN ENTRY
;NTRGRQ TO ENTER A GLOBAL REQUEST
;NTRLOC TO ENTER A LOCAL SYMBOL (FUTURE)
NTRENT: TLNE F,FL.SKP ;IGNORING THIS BLOCK?
RETURN
MOVEI T2,TL$ENT(B) ;INIT THE POINTER
CALL ENTRIT ;PUT IT ON THE LIST
RETURN ;ALREADY DEFINED
MOVEI T2,ENTLST-EG$ORD;POINT AT LIST MINUS OFFSET
PJRST ENTSRT ;PUT THIS ENTRY IN THE SORTED LIST NOW
NTRGRQ: TLNE F,FL.SKP
RETURN
MOVEI T2,TL$GRQ(B)
CALL ENTRIT ;PUT IN THE TABLE
RETURN ;ALREADY THERE
MOVEI T2,GLBLST-EG$ORD;PUT THIS ENTRY IN ALPHA LIST
PJRST ENTSRT ;...
NTRCOM: TLNE F,FL.SKP ;SKIPPING?
RETURN ;YES
MOVEI T2,TL$COM(B) ;GET THE LIST
CALL ENTRIT ;ENTER COMMON IN THE LIST
RETURN ;ALREADY DEFINED
AOS (P)
RETURN ;RETURN WITH ADDR IN T1
;CALL HERE TO PUT ITEM IN THE LIST
;RETURN CPOPJ IF ALREADY IN
;RETURN CPOPJ1 IN JUST INSERTED WITH PTR IN T1
ENTRIT: MOVE T3,T2 ;REMEMBER WHERE WE CAME FROM
HRRZ T2,(T2) ;GET NEXT
JUMPE T2,ENTRT2 ;JUMP IF AT END OF LIST
CAMN T1,EG$NAM(T2) ;IS THIS IT?
RETURN ;YES, RETURN
CAMLE T1,EG$NAM(T2) ;NO, SHOULD IT GO IN HERE ALPHABETICALY?
JRST ENTRIT ;NO, KEEP LOOKING
ENTRT3: CALL ENTRT5 ;PUT NAME IN THE CORE WE WILL GET
MOVE T2,(T3) ;GET PTR TO NEXT LINK
HRRM T2,(T1) ;MAKE THIS ONE POINT AT IT
HRLM T3,(T1) ;SET IN THE BACK LINK
HRLM T1,(T2) ;SET IN BACK LINK ON NEXT LINK
HRRM T1,(T3) ;MAKE PREDECESSOR POINT AT ME
JRST ENTRTX ;GO FINISH UP
ENTRT2: CALL ENTRT5 ;GET CORE AND INSERT NAME
HRRM T1,(T3) ;SET THIS LINK INTO TH CHAIN
HRLZM T3,(T1) ;SET IN BACK LINK,,CLEAR FORWARD LINK
ENTRTX: SETZM EG$FLG(T1) ;CLEAR THE FLAGS
HRRZM B,EG$TTL(T1) ;AND POINT TO TITLE BLOCK
JRST .POPJ1 ;SKIP BACK--WE JUST INSERTED IT
ENTRT5: SAVE T1 ;SAVE NAME
MOVEI T1,EGLSIZ ;GET BLOCK SIZE
CALL GETCOR ;GET NEEDED CORE
RESTORE EG$NAM(T1) ;PUT THE NAMEIN THE TABLE
RETURN
;CALL HERE TO ENTER ENTRY OR GLOBAL REF INTO LINKED ALPHABETICAL TABLE
;T1=PTR TO THIS ENTRY
;T2=PTR TO ENTLST OR GLBLST
ENTSRT:
ENTSR2: MOVE T3,T2 ;SAVE LAST
HLRZ T2,EG$ORD(T2) ;GET NEXT
JUMPE T2,ENTSR1 ;JUMP IF AT END
MOVE T4,EG$NAM(T1) ;GET NAME WE ARE AT
CAMLE T4,EG$NAM(T2) ;DOES IT GO IN HERE?
JRST ENTSR2 ;NO, SEARCH SOME MORE
ENTSR1: HRLM T2,EG$ORD(T1) ;SAVE LINK
HRLM T1,EG$ORD(T3) ;PUT THIS ONE IN THE LIST
RETURN
SUBTTL LISTING ROUTINES
LISTIT: CALL .SAVE4 ;MIGHT AS WELL...
CALL LINKER ;GO LINK EVERYTHING UP
MOVEI B,ENTLST-EG$ORD ;INIT THE PERM POINTER
TLNE F,FL.TTO ;OUTPUTTING TO TTY?
JRST LSTIT1 ;YES, SKIP AHEAD
MOVEI T1,OBYTE ;SET UP OUTPUT ROUTINE
CALL .TYOCH ;WITH SCAN
SAVE T1 ;BUT REMEMBER WHAT IT WAS
MOVEI T1,^D60 ;SET UP LINES/PAGE
MOVEM T1,LINKNT
TLO F,FL.PP ;PRETTY PRINT
LSTIT1: MOVEI T1,[ASCIZ\XGLOB %\]
CALL .TSTRG
MOVE T1,.JBVER ;MY VERSION
CALL .TVERW## ;TYPE IT
MOVEI T1,HEDMSG ;OUTPUT FIRST MESSAGE
CALL .TSTRG ;OUTPUT THE HEADER
LSTNXT: HLRZ B,EG$ORD(B) ;GET THE NEXT IN THE LIST
JUMPE B,LSTDUN ;QUIT AT THE END (AS USUAL)
HRRZ P2,EG$TTL(B) ;LINK TO TITLE BLOCK
MOVE T1,TL$FLG(P2) ;GET FLAGS
TRNN T1,FT$LIB ;IS THIS A LIBRARY
JRST LSTNX1 ;NO
TRNN T1,FT$REF ;YES, WAS IT REF?
JRST LSTNXT ;NO
MOVE T1,EG$FLG(B) ;GET FLAGS FOR THIS ENTRY
TRNN T1,FT$REF ;HAS IT BEEN REFERENCED?
JRST LSTNXT ;NO, DON'T PRINT IT
LSTNX1: SETZ P4, ;CLEAR COUNT OF REFERENCES TO THIS ENTRY
MOVE P3,.JBFF ;REMEMBER THE START OF THE LIST
CALL FNDREF ;FIND ALL REFERENCES, MAKE LIST AT END OF CORE
;POINTING TO TITLE BLOCKS OF REFERENCING MODULS
MOVEM P3,.JBFF ;***RESTORE .JBFF NOW, WHILE WE THINK OF IT
; HRRZ P2,EG$TTL(B) ;GET LINK TO TITLE BLOCK
; MOVE T1,TL$FLG(P2) ;GET THE FLAGS
; TRNE T1,FT$LIB ;IS THIS A LIBRARY?
; JUMPE P4,LSTNXT ;YES, AND IF WE JUMP IT WAS NEVER REFERENCED
CALL LSTENT ;NO, LIST THIS ENTRY
JRST LSTNXT ;AND GO ON TO THE NEXT ONE
LSTDUN: TLNE F,FL.TTO ;TTY OUTPUT?
RETURN ;YES, ALLDONE
RESTOR T1 ;GET TYPEOUT ADDRESS BACK
PJRST .TYOCH ;RESTORE AND RETURN
LINKER: MOVEI B,LSTHED ;POINT AT TITLE LIST
LINK1: HRRZ B,(B) ;LINK TO NEXT
JUMPE B,LINK2 ;JUMP IF DONE WITH PHASE ONE
MOVE T1,TL$FLG(B) ;NO, GET FLAGS
TRNE T1,FT$LIB ;LIBRARY?
JRST LINK1 ;YES, IGNORE IT
MOVEI P1,TL$GRQ(B) ;NO, POINT AT GLOBAL REQUEST LIST
CALL LNKSAT ;FLAG ALL MODULES THAT SATISFY GLB REQ
JRST LINK1 ;DO ALL NON-LIB MODULES
LINK2: MOVEI B,LSTHED ;NOW DO ALL LIBRARY MODULES
SETZM FOUND1 ;CLEAR THE FLAG TO GO AGAIN
LINK3: HRRZ B,(B) ;CHAIN TO NEXT
JUMPE B,LINK4 ;JUMP AT THE END
MOVE T1,TL$FLG(B) ;GET THE FLAGS
TRNE T1,FT$LIB ;IS IT A LIBRARY?
TRNN T1,FT$REF ;YES, HAS IT BEEN REFERENCED?
JRST LINK3 ;NO TO ONE OF ABOVE
TRNE T1,FT$SCN ;BEEN SCANED YET/
JRST LINK3 ;YES, ONLY DO IT ONCE
MOVEI P1,TL$GRQ(B) ;NO, GET GRQ LIST
CALL LNKSAT ;FIND SATISFYING MODULES
JRST LINK3
LINK4: SKIPE FOUND1 ;DO ANYTHING?
JRST LINK2 ;YES, GO AGAIN
RETURN ;NO, RETURN
LNKSAT:
LSAT1: HRRZ P1,(P1) ;MOVE ALONG GRQ LIST
JUMPE P1,.POPJ ;RETURN ON NULL
MOVE T4,EG$NAM(P1) ;GET THE NAME
MOVEI T3,LSTHED ;POINT AT THE LIST
LSAT2: HRRZ T3,(T3) ;CHAIN TO NEXT
JUMPE T3,LSAT1 ;FINISED?
MOVE T2,TL$FLG(T3) ;NO, GET FLAGS
TRNE T2,FT$LIB ;LIBRARY?
TRNE T2,FT$REF ;YES, REFERENCED?
JRST LSAT2 ;NOT LIB OR ALREADY REF
MOVEI T2,TL$ENT(T3) ;POINT AT ENTRY LST
LSAT3: HRRZ T2,(T2) ;LINK TO NEXT
JUMPE T2,LSAT2 ;JUMP ON END
CAME T4,EG$NAM(T2) ;ENTRY SATISFY GRQ?
JRST LSAT3 ;NO
MOVEI T1,FT$REF ;YES, GET FLAG BIT
IORM T1,TL$FLG(T3) ;FLAG IN TITLE BLOCK
IORM T1,EG$FLG(T2) ;SET ENTRY ENTRY REFERENCED
MOVEI T2,FT$SCN ;GET SCANNED FLAG
IORM T2,TL$FLG(P1) ;FLAG THIS BLOCK SCANNED
SETOM FOUND1 ;FLAG TO GO AGAIN
JRST LSAT2 ;FIND MORE
;CALL HERE TO LIST ONE ENTRY
LSTENT: CALL .TCRLF ;START WITH NEW LINE
MOVEI T1,STARS ;START OUT WITH SOME STARS
CALL .TSTRG
MOVE T1,EG$NAM(B) ;GET THE NAME
CALL .TSIXN ;OUTPUT IT
MOVEI T1,STARS ;MORE STARS
CALL .TSTRG
MOVEI T1,[ASCIZ\
FOUND IN \]
CALL .TSTRG
CALL LISFLS ;OUTPUT THE FILE SPEC
MOVEI T1,[ASCIZ\, MODULE \]
CALL .TSTRG
MOVE T1,TL$NAM(P2) ;THE MODULE NAME
CALL .TSIXN
MOVEI T1,[ASCIZ\, COMPILED BY \]
CALL .TSTRG
LDB T1,[POINT 12,TL$FLG(P2),17] ;COMPILER VALUE
CAILE T1,MXLATR ;CHECK FOR ONE WE KNOW
MOVEI T1,0 ;NO, USE ???
MOVE T1,XLATOR(T1) ;GET STRING ADDRESS
CALL .TSTRG
IFN FTCPU,<
MOVEI T1,[ASCIZ\ FOR \]
CALL .TSTRG
LDB T1,[POINT 6,TL$FLG(P2),5] ;CPU IT WILL RUN ON
CAILE T1,MAXCPU
MOVEI T1,0 ;MUST BE KL
MOVE T1,CPUTYP(T1)
CALL .TSTRG
>;END IFN FTCPU
CALL .TCRLF ;NEXT LINE
MOVEI T1,[ASCIZ\MODULE SIZE IS \]
CALL .TSTRG ;TELL THE SIZZE
HLRZ T1,TL$SIZ(P2) ;GET HISEG SIZE
JUMPE T1,LSTEN1 ;JUMP IF NO HISEG
CALL TOCDEC ;TYPE OCTAL AND DECIMAL
MOVEI T1,[ASCIZ\ [HISEG] \]
CALL .TSTRG
LSTEN1: HRRZ T1,TL$SIZ(P2)
CALL TOCDEC
MOVEI T1,[ASCIZ\ [LOWSEG] \]
CALL .TSTRG
HLRZ T1,TL$COM(P2) ;GET COMMON ALLOCATION
JUMPE T1,[CALL .TCRLF ;JUMP IF NONE
JRST LSTEN2] ;AND CONTINUE
CALL TOCDEC ;TYPE THE SIZE
MOVEI T1,[ASCIZ\ [COMMON]
\]
CALL .TSTRG ;
LSTEN2: CALL LSENTR ;LIST ENTRY POINTS
CALL LSGRQ ;LIST GLOBAL REQUESTS
CALL LSTCOM ;LIST COMMON ALLOCATION THIS MODULE
CALL LISREF ;LIST REFERENCES TO THIS ENTRY POINT
RETURN ;***END LIST ONE ENTRY
STARS: ASCIZ \***\ ;PRETTY!
HEDMSG: ASCIZ \
E - ENTRY POINTS INTO THE MODULE
G - GLOBAL REFERENCES
C - COMMON DECLARED IN THIS MODULE
NOTE: COMMON LENGTH NOT INCLUDED IN MODULE SIZE
R - MODULES THAT REFERENCE THIS ONE
\
DEFINE P(A)<[ASCIZ\'A\]>
XLATOR: P UNKNOWN
P F40
P COBOL
CBLXLT==.-XLATOR-1 ;COBOL COMPILER TYPE
P ALGOL-60
P NELIAC
P PL/1
P BLISS-10
P SAIL
P FORTRAN-10
P MACRO
P FAIL
MXLATR==.-XLATOR
IFN FTCPU,<
CPUTYP: P <EITHER CPU>
P <KA10 CPU>
P <KI10 CPU>
MAXCPU==.-CPUTYP
>;END IFN FTCPU
LISFLS: MOVEI T2,TL$PPN-.RBPPN(P2) ;FAKE OUT .TOLEB A BIT
MOVEI T1,TL$DEV-.OPDEV(P2) ;AND SOME MORE TRICKERY
PJRST .TOLEB ;GO TYPE THE FILE SPEC
FNDREF: MOVEI T3,GLBLST-EG$ORD ;INIT THE POINTER
FNDRF1: MOVE T4,EG$NAM(B) ;GET NAME WE ARE LOOKING FOR
FNDNXT: HLRZ T3,EG$ORD(T3) ;NEXT LINK
JUMPE T3,.POPJ ;EXIT ON NULL LINK
CAME T4,EG$NAM(T3) ;FIND IT?
JRST FNDNXT ;NO, KEEP LOOKING
HRRZ P1,EG$TTL(T3) ;GET LINK TO TITLE BLOCK
MOVE T1,TL$FLG(P1) ;GET THE FLAGS
TRNN T1,FT$LIB ;IS THIS A LIBRARY?
JRST FNDRF3 ;NO, GO AHEAD
TRNN T1,FT$REF ;YES, HAS IT BEEN REFERENCED ?
JRST FNDNXT ;NO, MOVE ALONG
FNDRF3: JUMPE P4,FNDRF2 ;JUMP IF THIS IS THE FIRST
MOVN T4,P4 ;NO, GET - COUNT OF REFERENCES
HRLZS T4 ;POSITION IN LH
HRR T4,P3 ;POINT AT THE LIST ON THE END OF CORE
CAME P1,(T4) ;IS THIS IT (ALREADY REQUESTED?)
AOBJN T4,.-1 ;NO, LOOP FOR ALL
JUMPL T4,FNDRF1 ;JUMP IF WE FOUND ONE
MOVE T4,EG$NAM(B) ;NO, RESTORE THE NAME
FNDRF2: MOVEI T1,1 ;ADD 1 TO THE LIST
CALL GETCOR ;WHICH ALSO DESTROYS T2
MOVEM P1,(T1) ;STORE ON LIST AT END OF CORE
AOJA P4,FNDNXT ;COUNT AND GO FOR MORE
LSENTR: MOVEI T1,[ASCIZ\E \] ;START THE LINE
CALL .TSTRG
MOVEI P1,TL$ENT(P2) ;LINK TO ENTRYS
LSEGGO: CALL INIEGO ;INITIALIZE THE FORMATTER
LSENXT: HRRZ P1,(P1) ;GET THE NEXT ONE
JUMPE P1,.TCRLF ;QUIT ON NULL
MOVE T1,EG$NAM(P1) ;GET THE NAME
CALL .TSIXN ;TYPE IT
SOSG MODKNT ;CHECK IF TIME FOR NEW LINE
JRST [CALL .TCRLF ;YES, FORCE ONE
CALL INIEGO ;INIT THE NEW LINE
HRRZ T1,(P1) ;GET LINK TO NEXT
JUMPE T1,.POPJ;JUMP IF NO MORE TO PRINT
JRST .+1] ;YES, TAB OVER AND CONTINUE
CALL .TTABC ;MOVE TO NEXT TAB STOP
JRST LSENXT ;LIST NEXT ENTRY
LSGRQ: MOVEI T1,[ASCIZ\G \] ;START FOR GLOBAL REQUESTS
CALL .TSTRG
MOVEI P1,TL$GRQ(P2) ;LINK TO GLOBAL REQUESTS
JRST LSEGGO ;[3] GO DO IT
LISREF: JUMPN P4,LISRF1 ;CHECK FOR NEVER REFERENCED
MOVEI T1,[ASCIZ\NEVER REFERENCED
\]
PJRST .TSTRG ;OUTPUT AND RETURN
LISRF1: MOVEI T1,[ASCIZ\R \] ;START THE LINE
CALL .TSTRG
CALL INIRFL ;INIT FOR TYPEOUT
LISRF2: MOVE P2,(P3) ;GET THE POINTER TO TITLE BLOCK
CALL LISFLS ;OUTPUT THE NAME
CALL .TSLSH ;AND A SLASH
MOVE T1,EG$NAM(P2) ;GET THE MODULE NAME
CALL .TSIXN ;OUTPUT IT
CALL .TSLSH ;ANOTHER SLASH
SOSG MODKNT ;CHEK IF END OF LINE
JRST [CALL .TCRLF ;YES, NEW LINE
SOJLE P4,.POPJ;RETURN IF DONE
CALL INIRFL ;INIT FOR A NEW LINE
CALL .TTABC ;ELSE, SPACE OVER
AOJA P3,LISRF2] ;AND CONTINUE
CALL .TTABC ;SPACE OVER
SOJLE P4,.TCRLF ;QUIT WHEN DONE
AOJA P3,LISRF2 ;NO, BUMP POINTER AND GET NEXT
.TSLSH: MOVEI T1,"/"
PJRST .TCHAR
TOCDEC: SAVE T1 ;SAVE THE NUMBER
CALL .TOCTW ;TYPE OCTAL
MOVEI T1,[ASCIZ\ (\]
CALL .TSTRG
RESTORE T1 ;GET NUMBER BACK
CALL .TDECW ;TYPE DECIMAL
MOVEI T1,[ASCIZ\.) \]
PJRST .TSTRG ;OUTPUT AND RETURN
INIEGO: MOVEI T1,^D15 ;PUT 15 ENTRIES AND GLBREQ / LINE
TXNE F,FL.NAR ;/NARROW?
MOVEI T1,^D8 ;THEN ONLY 8
MOVEM T1,MODKNT ;STORE
RETURN
INIRFL: MOVEI T1,3 ;THREE ACROSS
TXNE F,FL.NAR ;IF /NAROW
MOVEI T1,2 ;THEN ONLY 2
MOVEM T1,MODKNT
RETURN
;HERE TO LIST COMMON DECLARED HERE
LSTCOM: HLRZ T1,TL$COM(P2) ;SEE IF ANY
JUMPE T1,.POPJ ;JUMP IF NOT
MOVEI T1,[ASCIZ\C \] ;START THE LINE
CALL .TSTRG
MOVEI P1,TL$COM(P2) ;INIT THE PTR
CALL INIRFL ;INIT THE FORMATTER
COMNXT: HRRZ P1,(P1) ;GET NEXT
JUMPE P1,.TCRLF ;QUIT ON NULL
CALL .TSLSH ;SLASH
MOVE T1,EG$NAM(P1) ;THE NAME
CALL .TSIXN ;OUTPUT IT
CALL .TSLSH ;SLASH
CALL .TSPAC ;SPACE
HLRZ T1,EG$FLG(P1) ;SIZE
CALL TOCDEC ;LIST IT
SOSG MODKNT ;CHECK FOR NEW LINE
JRST [CALL .TCRLF ;YES
CALL INIRFL
HRRZ T1,(P1) ;SEE IF ANOTHER
JUMPE T1,.POPJ;JUMP IF AT END
CALL .TTABC ;TAB OVER
JRST .+1] ;NO--FORGE ON
CALL .TSPAC ;SPACE OVER
JRST COMNXT ;CONTINUE
SUBTTL I/O ROUTINES
;CALL WITH T1 ASCII BYTE FOR OUTPUT
OBYTE: SOSG OUTBHR+2 ;ROOM?
JRST OBYBUF ;NO
OBYTE1: IDPB T1,OUTBHR+1
TLNE F,FL.PP ;PRETTY PRINT?
CAIN T1,.CHLFD ;YES--IS THIS A LINEFFEED?
SOSLE LINKNT ;YES--TIME TO FORMFEED?
RETURN ;NOT A LINEFEED OR NOT TIME
MOVEI T1,^D60 ;YES, RESET THE COUNTER
MOVEM T1,LINKNT ;...
MOVEI T1,.CHFFD ;GET A FORMFEED
JRST OBYTE ;AND SEND IT
; AOS BYTCNT ;COUNT FOR FORMATTING
RETURN
OBYBUF: OUT OCH,
JRST OBYTE1 ;NO ERRORS
JRST OBYTE1 ;***FIXUP LATER
;CALL HERE TO GET 36-BIT BYTE INTO T1
;SKIP RETURN WITH THE BYTE, OR CPOPJ IF EOF
IBYTE: SOSGE INPBHR+2 ;ANYTHING THERE/
JRST IBYTEN ;NO
ILDB T1,INPBHR+1
AOS (P)
RETURN
IBYTEN: IN ICH, ;GET NEW BUFFER
JRST IBYTE ;OK, GO GET DATA
GETSTS ICH,T1 ;OOPS, GET STATUS BITS
SAVE T1 ;REMEMBER THEM
TXZ T1,IO.ERR ;CLEAR ERROR BITS
SETSTS ICH,(T1) ;CLEAR WITH MON
RESTOR T1 ;GET BITS BACK
TXNN T1,IO.EOF ;END OF FILE?
JRST IBYTE ;NO, GO PROCESS DATA
RETURN ;YES, POPJ BACK
;CALL WITH CHAR FOR TTY OUTPUT IN T1
TOCHAR: SOSG TOBHR+2 ;ROOM?
OUTPUT TTY, ;NO, BOOT THE BUFFER
IDPB T1,TOBHR+1 ;STORE IN THE BUFFER
; AOS BYTCNT ;COUNT FOR FORMATTING
CAIN T1,.CHLFD ;IF A LINEFEED
OUTPUT TTY, ;OUTPUT IT ANYWAY
RETURN
SUBTTL SCAN SWITCH TABLES
DEFINE SWTCHS,<
SS *LIBRAR,.FXLIB,1
SN *NARROW,<POINTR(FLAGS,SW.NAR)>,FS.NUE
>
DOSCAN (GBXSW)
SUBTTL STORAGE
IFN FT2SEG,<RELOC>
SGNAM: BLOCK 1 ;SAVE-GET ARGS
SGPPN: BLOCK 1
SGDEV: BLOCK 1
SGLOW: BLOCK 1
PDLIST: BLOCK PDSIZ ;PUSHDOWN LIST
SAVJFF: BLOCK 1 ;ORIG. .JBFF
OFFSET: BLOCK 1 ;START OFFSET FOR CCL
F.ZER==.
OUTBHR: BLOCK 3 ;OUTPUT BUFFER HEADER
INPBHR: BLOCK 3 ;INPUT BUFFER HEADER
LKPBLK: BLOCK .RBSIZ+1 ;EXTENDED LOOKUP BLOCK
WLDTMP: BLOCK 1 ;WILD STORES CURRENT BLOCK ADR HERE
OPNBLK: BLOCK 3 ;DEVICE OPEN BLOCK
OUTBUF: BLOCK 203*NOBUF ;OUTPUT BUFFERS
INPBUF: BLOCK 203*NIBUF ;INPUT BUFFERS
BYTCNT: BLOCK 1 ;REGISTER FOR FORMATTING OUTPUT
LINKNT: BLOCK 1 ;COUNTER FOR LINES/PAGE
MODKNT: BLOCK 1 ;NO. MODULES /LINE
TIMEON: BLOCK 1 ;FOR COUNTING CPU USAGE
FOUND1: BLOCK 1 ;-1 IF NEED ANOTHER PASS IN LINKER
LSEGOR: BLOCK 1 ;LOWSEG ORIGIN
HSEGOR: BLOCK 1 ;HISEG ORIGIN
SCN.F==. ;START OF SCAN INFO AREA
FLAGS: BLOCK 2 ;PERMANENT FLAGS DURING SCAN
O.AREA: BLOCK .FXLEN ;OUTPUT SPEC SIZE
O.SIZE==.FXLEN
SWTWRD: BLOCK 2 ;SWITCH STORE AREA
INBEG: BLOCK 1 ;ADDRESS OF START OF INPUT SPECS
INEND: BLOCK 1 ;ADDRESS OF LAST INPUT SPEC
INXTZ: BLOCK 1 ;CURRENT BLOCK
LSTHED: BLOCK 1 ;POINTER TO FIRST TITLE BLOCK
ENTLST: BLOCK 1 ;POINTER TO SORTED ENTRY LIST
GLBLST: BLOCK 1 ;POINTER TO SORTED GLOBAL LIST
OUTDON: BLOCK 1 ;OUTPUT HAS BEEN SETUP
SCN.Z==.-1 ;END OF SCANINFO AREA
TOBHR: BLOCK 3 ;TTY OUTPUT BUFFER HEADER
L.ZER==.-1
END XGLOB