Trailing-Edge
-
PDP-10 Archives
-
ap-c796e-sb
-
glob.mac
There are 4 other files named glob.mac in the archive. Click here to see a list.
TITLE GLOB -- GLOBAL CROSS-REFERENCE DIRECTORY LISTING
SUBTTL PARAMETERS AND DEFINITIONS D.PLUMMER/DJB/CAM/PFC/DAL
;COPYRIGHT 1968,1969,1970,1971,1972, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
%GLOB==5
VWHO==0
VMINOR==2
VEDIT==127
;. . . EDIT HISTORY . . .
; VERSION 5:
; EDIT#117 - CHANGES /H PROCESSOR TO USE HELPER
; CHANGES VERSION DEFINITION TO STANDARD FORMAT
; AREAS AFFECTED: HELPSW AND PROGRAM HEADER
; EDIT#120 - ADDS DEFENSIVE CODE TO HANDLE REL FILES
; WITH NO NAME BLOCKS OR MULTIPLE NAME BLOCKS.
; AREAS AFFECTED: CROSS,PRGTYP,MODCNT
; EDIT#121 - CLEANS UP PROBLEM WITH REINITIALIZATION AFTER
; COMPLETING OUTPUT.
; EDIT#122 - MAKES /X ON DEST SIDE WORK
; EDIT#123 - MAKES /X ON SOURCE SIDE WORK
; EDIT#124 - MAKES GLOB GET LENGTH OF SECOND AND SUBSEQUENT
; RELOCATION GROUPS OF A BLOCK CORRECT
; EDIT#125 - MAKES GLOB HANDLE BLOCK TYPE 0 CORRECTLY
; EDIT#126 - ALLOWS ASCII TEXT IN THE .REL FILE SINCE
; THAT IS WHAT THE .TEXT PSEUDO-OP
; DOES IN MACRO V50
; EDIT#127 - SUPPORT BLOCK TYPE 100
;ASSEMBLY INSTRUCTIONS:
;
; .LOAD GLOB,SYS:HELPER ;[ED#117]
; .SSAVE DSK:GLOB
.JBVER==137
LOC .JBVER
BYTE (3)VWHO(9)%GLOB(6)VMINOR(18)VEDIT ;[ED#117]
RELOC
INTERNAL GLOB,.JBVER,%GLOB
EXTERNAL .JBFF,.JBREL,.JBREN
;PARAMETERS
IFNDEF PURESW,<PURESW==1> ;ASSEMBLE REENTRANT VERSION
IFNDEF PDLEN,<PDLEN==20> ;LENGTH OF PUSH DOWN LIST
IFNDEF SYMLIN,<SYMLIN==^D11> ;NUMBER OF REFERENCES PER LINE
IFNDEF PGLINE,<PGLINE==^D50> ;NUMBER OF LINES PER PAGE
IFN PURESW,<TWOSEG
RELOC 400000> ;SWITCH TO HIGH SEG
;ACS
F=0 ;FLAGS
A=1 ;LOCAL TEMPORARY
SW=2 ;TEMPORARY FOR CHARACTER SCREENING
B=3 ;RETURN BINARY WORD ON CALLS TO GETBIN
PN=4 ;POINTER TO CURRENT PROGRAM NAME
NX=5 ;NEXT ITEM IN LINKED CHAIN
V=6 ;VALUE OF CURRENT SYMBOL
MC=7 ;MODULE COUNT FOR OUTPUT LINE
BG=10 ;ADDRESS OF BEG LOC OF FREE STORAGE
EN=11 ;ADDRESS OF LAST LOC. IN FREE STORAGE
PT=12 ;SYMBOL TABLE POINTER SETUP BY CROSS
S=13 ;PC FOR JSP CALLS
T=14 ;1 CAHR. ON CALLS TO LSTOUT AND TTYOUT
T1=T+1 ;A TEMPORARY
R=16 ;RELOCATION BITS FOR CURRENT INPUT BLOCK
P=17 ;PUSH DOWN POINTER
C==A ;COUNT OF BINARY WORDS IN CURRENT BLOCK
C1==SW ;COUNT OF BINARY WORDS IN CURRENT SUB-BLOCK
LOC==C1 ;LOCATION COUNTER
SP==V ;SAVED SYMBOL POINTER
;ACS USED (IN SCAN ONLY)
CH==1 ;CHARACTER
NM==2 ;FILE NAME OR EXTENSION
CC==3 ;BREAK CHAR. INDEX
FC==4 ;COUNT OF FILE DESCRIPTORS
SWT==5 ;SWITCHS FOR CURRENT FILE
SWTBYT==6 ;BYTE POINTER TO SWITCH AC(SWT)
;LH FLAGS
ALTF==1 ;ALTMODE SEEN
ENDL==2 ;OTHER TERMINATOR SEEN
DEST==4 ;DESTINATION FILE TYPED
FST==10 ;FIRST TIME CROSS CALLED FLAG
TITL==20 ;TITLES ON LISTING CONTROL FLOP
COMMAF==40 ;COMMA PRINTED FLAG
LSWIT==100 ;LIBRARY SEARCH MODE
LSKIP==200 ;SKIPPING PROGRAM
NOFIL==400 ;FILE NOT FOUND ON LOOKUP
FCOM==1000 ;ENTERING COMMON BLOCK SYMBOL
FFLAG==2000 ;DOING FORTRAN IV FORM
MSPSW==4000 ;INCLUDE MULTIPLY SPECIFIED ROUTINES
;RH FLAGS
RSWIT==1 ;RELOCATABLE SYMBOLS ONLY
FSWIT==2 ;FIXED SYMBOLS ONLY
ESWIT==4 ;ERRORS (UNDEF & MULDEF) ONLY
SSWIT==10 ;MULTIPLY SPECIFIED SYMBOLS ONLY
NSWIT==20 ;NEVER REFERENCED SYMBOLS ONLY
ASWIT==40 ;PRINT ALL SYMBOLS
;RH FLAGS IN SCAN ROUTINE ONLY
PERF==1 ;PERIOD SEEN IN CURRENT FILE DESCRIPTOR
COLONF==2 ;COLON SEEN IN CURRENT FILE DESCRIPTOR
CRF==4 ;CARRIAGE RETURN(END OF STRING) SEEN
SRC==10 ;SOURCE=1,DESTINATION=0
ALF==20 ;ALTMODE SEEN FLAG
ALTS==40 ;ALTMODE SEEN DURING PRESCAN
NCHF==100 ;NO CHARACTER SEEN FLAG
;OTHER FLAGS
MULSPC==400000 ;"SYMBOL IS MULTIPLY SPECIFIED" FLAG
PTD==200000 ;"SYMBOL ALREADY PRINTED" FLAG
RELOC==100000 ;"SYMBOL IS RELOCATABLE" FLAG
MULDEF==40000 ;"SYMBOL IS MULTIPLY DEFINED" FLAG
;IO CHANNEL ASSIGNMENTS
TTYCHN==0 ;TTY CHANNEL
DESCHN==1 ;DESTINATION CHANNEL
SRCCHN==2 ;SOURCE CHANNEL
;OTHER PARAMETERS
AMODE==0 ;ASCII MODE
ALMODE==1 ;ASCII LINE MODE
BMODE==14 ;BINARY MODE
ERRORS==740000 ;ERROR STATUS BITS
BUFSIZ==2*204 ;MAX. SIZE OF 2 INPUT BUFFERS
DEVWRD==1 ;DEVICE WORD IN OPEN UUO ARRAY
FILWRD==3 ;FILE NAME WORD
EXTWRD==4 ;EXTENSION WORD
DIRWRD==6 ;DIRECTORY WORD
BUFST==7 ;FIRST BUFFER ORIGIN WORD
;SOME SPECIAL ASCII CODES
CTLC==3
CTLZ==32
CR==15
FF==14
VT==13
LF==12
ALTM1==175
ALTM2==176
ALTM3==33
LEFARR==137
SUBTTL CROSSX--MAIN PROGRAM AND I/O MODULE
GLOB: MOVEI EN,0 ;FLAG NO TABLE TO OUTPUT YET
SETZM FWAZER ;CLEAR OUT SCRATCH AREA
MOVE T,[FWAZER,,FWAZER+1]
BLT T,LWAZER
MOVEI T,AMODE ;PRESET I/O BLOCKS
MOVEM T,OPENO ;FILE MODE
MOVSI T,OBUF ;BUFFER
MOVEM T,OPENO+2 ; ..
MOVEI T,BMODE ;FILE MODE
MOVEM T,OPENI ; ..
MOVEI T,IBUF ;BUFFER
MOVEM T,OPENI+2 ; ..
MOVE T,.JBREL ;GET INITIAL CORE SIZE
MOVEM T,SAVREL ;SAVE IT FOR LATER
;HERE ON A REENTER
CROSX0: RESET ;STOP AND RELEASE ALL I/O
MOVE P,[IOWD PDLEN,PDLIST] ;SET PUSH DOWN POINTER
MOVE F,[MSPSW,,ASWIT] ;CLEAR FLAGS
MOVEI T,CROSX0 ;REENTRY ADDRESS
HRRM T,.JBREN ;SAVE FOR REENTER COMMAND
INIT TTYCHN,ALMODE ;INITIALIZE TTY FOR I&O
TTYSIX: SIXBIT /TTY/
XWD TOBUF,TIBUF
HALT ;SHOULD NEVER HAPPEN
INBUF TTYCHN,1 ;SETUP LINE AT A TIME BUFFER
OUTBUF TTYCHN,2 ;SETUP TWO TTY OUTPUT BUFFERS
MOVE T,.JBFF ;POINTS JUST BEYOND TTY BUFFERS
MOVEM T,OPENO+BUFST ;SAVE AS OUTPUT BUFFER ORIGIN
ADDI T,BUFSIZ ;ADD MAX SIZE OF TWO OUTPUT BUFFERS
MOVEM T,OPENI+BUFST ;SAVE AS INPUT BUFFER ORIGIN
MOVEI BG,BUFSIZ(T) ;POINTER TO FREE STORAGE ORIGIN
;**AT TTYSIX+10 INSERTED 1 INSTRUCTION [EDIT#121]
MOVEM BG,SAVBG ;SAVE ADDRESS OF FREE STORAGE ORIGIN [ED#121]
CAMLE BG,SAVREL ;SEE IF BIGGER THAN INITIAL
MOVEM BG,SAVREL ;YES--UP MEMORY
CROSX1: PUSHJ P,NEXLIN ;GET FIRST LINE FROM TTY
PUSHJ P,SRCINI ;INITIALIZE FIRST SOURCE
JRST CROSX2 ;INITIAL ALTMODE RETURN
HRRZ EN,SAVREL ;SETUP END POINTER
MOVE T,EN ;DROP CORE
CORE T, ; TO LET OTHERS
JFCL ; IN (IGNORE ERROR)
PUSHJ P,CROSS ;CALL CROSS REFERENCE PROGRAM
FINISH: RELEAS SRCCHN, ;RELEASE SOURCE FOR OTHER USERS
CLOSE DESCHN, ;CLOSE OUTPUT FILE
TLNN F,DEST ;SEE IF ANY OUTPUT
JRST .+3 ;NO--SKIP ERROR TEST
STATZ DESCHN,ERRORS ;YES--CHECK FOR ANY LAST ERRORS
PUSHJ P,OUTPTE ;YES--GIVE A MESSAGE
RELEAS DESCHN, ;MAKE SURE OUTPUT COMPLETE
CLOSE TTYCHN,2 ;CLOSE ONLY OUTPUT IN CASE TTY IS DEST
JRST CROSX1 ;ASK FOR MORE COMMAND INPUT
CROSX2: JUMPGE EN,CROSX1 ;IGNORE ALTMODE IF NO TABLE TO PRINT
PUSHJ P,STOUT ;GO PRINT LISTING AGAIN
JRST FINISH ;CROSSP ALWAYS RETURNS HERE
NEXLIN: TLZ F,ALTF+ENDL+LSWIT+400000 ;CLEAR END, ALTMODE SEEN,
;LIBRARY SEARCH FLAGS AND SIGN BIT
MOVSI T,'DSK' ;DEFAULT OUTPUT DEVICE
MOVEM T,OPENO+DEVWRD ; ..
MOVEM T,OPENI+DEVWRD ;AND INPUT DEVICE
MOVSI T,'GLB' ;DEFAULT OUTPUT EXTENSION
MOVEM T,OPENO+EXTWRD ; ..
MOVE T,[SIXBIT /GLOB/] ;PRESET DEFAULT OUTPUT FILE NAME
MOVEM T,LASTIN ; ..
PUSHJ P,TCRLF ;TYPE CRLF
PUSHJ P,PSTAR ;PRINT ASTERISK
OUTPUT TTYCHN, ;DO IT
INPUT TTYCHN, ;GET COMMAND STRING
MOVSI T,OPENO ;ADDRESS OF OPEN UUO ARRAY
MOVSI T1,OPENI ;SET ADDRESS AND COUNT FOR SOURCE SCAN
MOVEM T1,OPENCT ;SAVE SOURCE FILE COUNT
MOVE T1,TIBUF+1 ;GET INPUT BYTE POINTER
PUSHJ P,DSCAN ;SCAN FOR DESTINATION FILE
JRST SYNTAX ;SYNTAX ERROR
TLOA F,400000 ;FLAG NO DEST FILE SPECIFIED
TLO F,400000 ;FLAG NO DEST FILE SPECIFIED
;**AT NEXLIN+20 [EDIT#122]
JUMPL F,LAB1 ;IF NO DESTINATION SPECIFIED [ED#122]
MOVE A,TTYSIX ;SPECIAL CHECK FOR TTY [ED#122]
CAME A,OPENO+DEVWRD ;IS TTY OUTPUT DEVICE? [ED#122]
TLOA F,DEST+TITL ;NO, FLAG DESTINATION SPECIFIED
LAB1: TLZ F,DEST+TITL ;YES, CLEAR DEST SPECIFIED FLAG [ED#122]
PUSHJ P,SWITCH ;SET FLAGS ACCORDING TO SWITCHES [ED#122]
POPJ P, ;RETURN
STOUT: TLNN F,DEST ;ANY DESTINATION TO INIT?
JRST CROSSP ;NO, GO PRINT LISTING ON TTY
OPEN DESCHN,OPENO ;INIT OUTPUT DEVICE
JRST NOTAVO ;DEVICE NOT AVAILABLE
MOVE T,OPENO+BUFST ;ORIGIN OF OUTPUT BUFFERS
MOVEM T,.JBFF ;SET .JBFF TO RECLAIM OLD SPACE
OUTBUF DESCHN,2 ;SETUPT 2 OUTPUT BUFFERS
MOVE T,LASTIN ;GET LAST INPUT NAME JUST
SKIPN OPENO+FILWRD ; IN CASE NO OUTPUT NAME SPECIFIED
MOVEM T,OPENO+FILWRD ; RIGHT--SO USE IT
HLLZS OPENO+EXTWRD ;CLEAR AREA FOR ERROR CODE
ENTER DESCHN,OPENO+FILWRD ;ENTER FILE NAME
JRST DIRFUL ;DIRECTORY FULL
JRST CROSSP ;GO PRINT LISTING
;ROUTINE TO INITIALIZE NEXT SOURCE
;CALL: PUSHJ P,SRCINI
; XXX NO MORE SOURCE FILES - ALTMODE SEEN
; XXX NEXT ONE INITED
SRCINI:
SRCIN1: AOS T,OPENCT ;INCREMENT SOURCE FILE COUNT
MOVSI T1,'REL' ;DEFAULT INPUT EXTENSION
HLLM T1,OPENI+EXTWRD ; ..
SETZM OPENI+FILWRD ;CLEAR INPUT FILE NAME
SETZM OPENI+DIRWRD ;CLEAR INPUT DIRECTORY
MOVE T1,TIBUF+1 ;BP TO COMMAND STRING
PUSHJ P,SSCAN ;SCAN FOR NEXT SOURCE FILE
JRST SYNTAX ;SYNTAX ERROR
TLOA F,ALTF ;FLAG ALTMODE SEEN
TLO F,ENDL ;FLAG CR SEEN
PUSHJ P,SWITCH ;SET ANY SWITCHES SEEN
TLNE F,ALTF ;WAS ALTMODE SEEN?
POPJ P, ;YES,NO MORE SOURCE RETURN
TLNN F,ENDL ;WAS CR SEEN?
JRST SRCIN2 ;NO, GO INIT THIS FILE
PUSHJ P,NEXLIN ;YES, TRY FOR ANOTHER COMMAND LINE
JRST SRCIN1 ;AND SCAN FOR FIRST SOURCE FILE
SRCIN2: OPEN SRCCHN,OPENI ;INIT THIS FILE
JRST NOTAVI ;DEVICE NOT AVAILABLE
MOVE T,OPENI+BUFST ;GET ORIGIN OF INPUT BUFFERS
MOVEM T,.JBFF ;SET .JBFF TO RECLAIM USED SPACE
INBUF SRCCHN,2 ;SETUP TWO INPUT BUFFERS
SKIPE T,OPENI+FILWRD ;GET INPUT FILE NAME
MOVEM T,LASTIN ;IF NON-ZERO, STORE FOR OUTPUT DEFAULT
TLZ F,NOFIL ;CLR FLAGS EACH TIME
HLLZS OPENI+EXTWRD ;CLEAR ROOM FOR ERROR BITS
LOOKUP SRCCHN,OPENI+FILWRD ;IN CASE DIRECTORY DEVICE
JRST NOTFND ;FILE NOT FOUND ERROR
JRST CPOPJ1 ;SKIP RETURN
;ROUTINE TO RETURN NEXT BINARY SOURCE WORD
;CALL: PUSHJ P,GETBIN
; SOURCE BINARY WORD RETURNED IN AC B
GETBIN: SOSG IBUF+2 ;DECREMENT ITEM COUNT
JRST INPUT ;FINISHED THIS INPUT BUFFER
GETB1: ILDB B,IBUF+1 ;GET NEXT BINARY WORD
POPJ P, ;RETURN
INPUT: TLNE F,NOFIL ;WAS FILE FOUND?
JRST GETBNX ;NO
IN SRCCHN, ;GET NEXT INPUT BUFFER
JRST GETB1 ;OK RETURN FROM INPUT UUO
STATZ SRCCHN,ERRORS ;ANY ERROR BITS?
JRST SRCERR ;YES
;NO, ASSUME END OF FILE AND...
GETBNX: PUSHJ P,SRCINI ;INIT NEXT BINARY FILE
JRST INEND ;NONE LEFT - ALTMODE SEEN
TLZ F,LSKIP ;CLEAR SKIPPING FLAG IN CASE LEFT FROM BEFORE
JRST INPUT ;NEXT ONE READY
SRCERR: PUSHJ P,PRFILE ;PRINT FILE NAME
JSP T1,ENDMES ;PRINT ERROR MESSAGE
ASCIZ / input error/
INEND: POP P,A ;MATCHES PUSHJ CALL TO GETBIN
;FROM WHICH WE NEVER RETURN
HRRZ A,A ;GET ADDRESS
CAIE A,SCR1 ;SEE IF GETWRD
CAIN A,SCR2 ; ..
POP P,A ;YES--REMOVE ONE MORE
HRROM PT,EN ;TABLE COMPLETE - SAVE ITS END - SET FLAG
PUSHJ P,TCRLF ;START NEW TTY LINE
LDB T,[POINT 8,EN,25] ;GET CURRENT NUMBER OF CORE BLOCKS
ADDI T,1 ;MAKE IT ACCURATE
PUSHJ P,DECOUT ;PRINT AS DECIMAL NUMBER
MOVEI T1,CORM2 ;PRINT "K OF CORE"
PUSHJ P,MESS ;DO IT
OUTPUT TTYCHN, ;MAKE SURE OUTPUT HAPPENS
JRST STOUT ;GO PRINT LISTING
CORM2: ASCIZ /K of core used/
SWITCH: MOVE T1,[POINT 6,T]
SWITA: ILDB SW,T1 ;GET NEXT SIXBIT CHAR.
JUMPE SW,CPOPJ ;NULL TERMINATES
MOVSI A,-SW1TBL ;SEARCH FIRST TABLE
SWIT1B: HLRZ B,SW1TAB(A) ;GET SWITCH
CAME B,SW ;IS IT THE RIGHT ONE?
AOBJN A,SWIT1B ;NO--LOOP
HRRZ B,SW1TAB(A) ;GET DISPATCH ADDRESS
JUMPLE A,(B) ;GO DO IT IF MATCH
MOVSI A,-SWTABL ;TRY SECOND TABLE
SWITB: HLRZ B,SWTAB(A) ;SET SWITCH IN B
CAME B,SW ;IS IT THE WANTED SWITCH
AOBJN A,SWITB ;NO,TRY NEXT SWITCH
JUMPG A,ILLSW ;ILLEGAL SWITCH FOUND
HRR F,SWTAB(A) ;SET LATEST FLAG IN F
SWITC: TLNE T1,770000 ;FINISHED BYTE POINTER?
JRST SWITA ;NO
POPJ P, ;YES
SWITX: TLC F,TITL ;INVERT TITLE CONTROL FLAG
JRST SWITC
SWITM: TLZA F,LSWIT ;CLEAR LIBRARY SEARCH MODE (SKIP)
SWITL: TLO F,LSWIT ;SET LIBRARY SEARCH MODE
JRST SWITC ;BACK FOR THE REST OF THE SWITCHES
MSPOFF: TLZA F,MSPSW ;TURN OF MULT SPEC SYMBOLS
MSPON: TLO F,MSPSW ;TURN ON MULT SPEC SYMBOLS
JRST SWITC ;LOOP BACK FOR NEXT SWITCH
;TABLE OF LEGAL SWITCHES
SW1TAB: ;TABLE WITH SPECIAL PROCESSING
XWD 'H',HELPSW
XWD 'L',SWITL
XWD 'M',SWITM
XWD 'P',MSPON
XWD 'Q',MSPOFF
XWD 'X',SWITX
SW1TBL==.-SW1TAB
SWTAB: ;MUTUALLY EXCLUSIVE CONTROL SWITCHES
XWD 'A',ASWIT
XWD 'E',ESWIT
XWD 'F',FSWIT
XWD 'N',NSWIT
XWD 'R',RSWIT
XWD 'S',SSWIT
SWTABL== .-SWTAB
;HERE WHEN /H TYPED
HELPSW: MOVE 1,['GLOB '] ;[ED#117] TYPE HELP TEXT
PUSHJ P,.HELPR## ;[ED#117]
JRST CROSX0 ;[ED#117] REENTER PROGRAM
;HELPMS: REMOVED ENTIRE HELP MESSAGE [ED#117]
ENDMES: PUSHJ P,MESS ;MOVE ASCIZ MESSAGE TO OUTPUT BUFFER
PUSHJ P,TCRLF
ENDMS1: CLOSE TTYCHN, ;MAKE SURE OUTPUT COMPLETE
TLNE F,FST ;WAS CROSS CALLED BEFORE ERROR?
HRROM PT,EN ;YES, ENABLE PARTIAL PRINT
JRST CROSX0 ;START OVER AGAIN
ILLSW: JSP T1,ENDMES
ASCIZ "
?Illegal Switch
"
SYNTAX: JSP T1,ENDMES
ASCIZ \
? Command syntax error
Type /H for help
\
NOTAVO: TLOA F,400000 ;SET OUTPUT DEV FLAG
NOTAVI: TLZ F,400000 ;CLEAR OUTPUT DEV FLAG
MOVEI T1,DOTMS ;PRINT ERROR DOTS
PUSHJ P,MESS ;DO IT
TLZE F,400000 ;GET EITHER I OR O DEV NAME
SKIPA T1,OPENO+DEVWRD ;OUTPUT DEV NOT AVAILABLE
MOVE T1,OPENI+DEVWRD ;INPUT DEVICE NOT AVAILABLE
PUSHJ P,SIXOUT ;PRINT SIXBIT NAME
JSP T1,ENDMES
ASCIZ /: not available
/
DIRFUL: HRRZ T,OPENO+EXTWRD ;GET ERROR CODE
JUMPE T,DIRFLL ;DTA DIRECTORY IF 0
MOVEI T1,ENTERR ;ELSE, MUST BE DISK ERROR
PUSHJ P,MESS ;ISSUE MESSAGE
HRRZ T,OPENO+EXTWRD ;GET ERROR CODE
PUSHJ P,OCTOUT ;AND ISSUE IT
JRST TCRLF ;END LINE AND RETURN
DIRFLL: JSP T1,ENDMES ;DIRECTORY FULL
ASCIZ /
? Directory full
/
ENTERR: ASCIZ /
? Enter error /
NOTFND: TLO F,NOFIL ;SET FLAG TO SKIP INPUT
PUSHJ P,PRFILE ;PRINT FILE NAME
HRRZ T,OPENI+EXTWRD ;GET ERROR NUMBER
JUMPE T,NOTFNN ;NOT FOUND
MOVEI T1,LKERR ;ESOTERIC DISK ERROR
PUSHJ P,MESS ;TYPE MESSAGE
HRRZ T,OPENI+EXTWRD ;GET ERROR NUMBER
PUSHJ P,OCTOUT ;TYPE IT
PUSHJ P,TCRLF ;END LINE
JRST CPOPJ1 ;CONTINUE WITH NEXT FILE
NOTFNN: MOVEI T1,NFMS ;PRINT "NOT FOUND"
PUSHJ P,MESS ;PRINT
JRST CPOPJ1 ;CONTINUE WITH NEXT FILE
NFMS: ASCIZ / not found
/
LKERR: ASCIZ / lookup error /
CORFUL: MOVEI T1,CORM1
PUSHJ P,MESS
LDB T,[POINT 8,.JBREL,25]
ADDI T,2
MOVEI T1,"K"-"0"
PUSHJ P,DECOUK
PUSHJ P,TCRLF ;END LINE
JRST ENDMS1
CORM1: ASCIZ /
? Table overflow - CORE UUO failed
trying to expand to /
DOTMS: ASCIZ /
? /
;ROUTINE TO OUTPUT ON LISTING FILE
;CALL: MOVE T, CHARACTER
; PUSHJ P,LSTOUT
LSTOUT: TLNN F,DEST ;WAS DESTINATION FILE INITED?
JRST TTYOUT ;NO, SEND OUTPUT TO TTY
SOSG OBUF+2 ;DECREMENT COUNT OF ITEMS LEFT
JRST OUTPT ;NO MORE ROOM IN THIS BUFFER
LST1: IDPB T,OBUF+1 ;STORE NEXT CHARACTER AWAY
POPJ P,
OUTPT: OUTPUT DESCHN, ;OUTPUT THIS BUFFER
GETSTS DESCHN,A ;CHECK FOR ERRORS
TRNN A,ERRORS
JRST LST1 ;OK
OUTPTE: JSP T1,ENDMES ;ERROR PRINT
ASCIZ /
Destination device error/
;OCTAL OUTPUT ROUTINE
OCTOUT: IDIVI T,10 ;GET NEXT DIGIT
HRLM T1,(P) ;STORE AWAY
SKIPE T ;SEE IF DONE
PUSHJ P,OCTOUT ;NO--DO NEXT ONE
JRST DIGOUT ;YES--PRINT DIGIT
;DECIMAL OUTPUT ROUTINE
DECOUT: IDIVI T,12
DECOUK: HRLM T1,(P)
JUMPE T,.+2
PUSHJ P,DECOUT
DIGOUT: HLRZ T,(P)
ADDI T,"0" ;FALL INTO TTYOUT
;ROUTINE TO OUTPUT ON TTY
;CALL: MOVE T,CHAR.
; PUSHJ P,TTYOUT
TTYOUT: SOSG TOBUF+2
OUTPUT TTYCHN,
IDPB T,TOBUF+1
POPJ P,
;ROUTINE TO PRINT SIXBIT WORD
;CALL: MOVE T1,SIXBIT WORD
; PUSHJ P,SIXOUT
SIXOUT: MOVEI T,0
LSHC T,6
JUMPE T,CPOPJ ;IS IT NULL(END)?
ADDI T,40 ;NO, CONVERT TO ASCIZ
PUSHJ P,TTYOUT ;OUTPUT
JRST SIXOUT
EXPAND: MOVEI S,1 ;PREPARE POINTER TO CLEAR NEW CORE
ADD S,.JBREL ;FIRST LOC OF NEW CORE
HRLS S ;BLT POINTER
AOS S ;TO ZERO A BLOCK
PUSH P,S ;SAVE POINTER
MOVE S,.JBREL ;GET CURRENT REL MAX
ADDI S,2000 ;INCREASE BY 1K DECIMAL
CORE S, ;EXECUTE CORE UUO
JRST CORFUL ;ERROR RETURN
HRRZ EN,.JBREL ;SUCCESSFUL EXPANSION, UPDATE END POINTER
POP P,S ;SET UP BLT POINTER
SETZM -1(S) ;CLEAR FIRST WORD
BLT S,(EN) ;CLEAR 1K BLOCK
POPJ P, ;RETURN FROM INCPT IN CROSS
;ROUTINE TO TYPE CRLF
CRLFM: ASCIZ /
/
TCRLF: MOVEI T1,CRLFM
;ROUTINE TO PRINT AN ASCIZ MESSAGE
;CALL: MOVE T1, ADDRESS OF ASCIZ MESSAGE
; PUSHJ P,MESS
MESS: HRLI T1,440700
MESS1: ILDB T,T1
JUMPE T,CPOPJ
PUSHJ P,TTYOUT
JRST MESS1
;ROUTINE TO PRINT *
PSTARM: ASCIZ /*/
PSTAR: MOVEI T1,PSTARM
JRST MESS
;ROUTINE TO PRINT FILE NAME
PRFILE: MOVEI T1,FILE ;PRINT "FILE "
PUSHJ P,MESS
MOVE T1,OPENI+DEVWRD ;GET DEVICE NAME
PUSHJ P,SIXOUT
MOVEI T,":" ;FOLLOW BY COLON
PUSHJ P,TTYOUT ;PRINT IT
MOVE T1,OPENI+FILWRD ;PRINT FILE NAME
PUSHJ P,SIXOUT
MOVEI T,"." ;PRINT PERIOD
PUSHJ P,TTYOUT
HLLZ T1,OPENI+EXTWRD ;PRINT EXTENSION
JRST SIXOUT
FILE: ASCIZ /
? File /
SUBTTL CROSS PART 1--FILE PROCESSOR
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; THIS SECTION READS THE .REL FILES AND BUILDS A CORE TABLE ;;;
;;; IN THE FOLLOWING FORMAT: ;;;
;;; THERE IS NO ORDER TO THE TABLE ;;;
;;; ;;;
;;; EACH PROGRAM OR SUBROUTINE NAME OCCUPIES ONE WORD ;;;
;;; 0,RADIX50 NAME ;;;
;;; EACH REFERENCE TO A SYMBOL OCCUPIES ONE WORD ;;;
;;; REFERENCE CHAIN,,X+ADDR. OF PROGRAM NAME ;;;
;;; EACH SYMBOL DEFINITION OCCUPIES THREE WORDS ;;;
;;; FLAGS,RADIX50 SYMBOL NAME ;;;
;;; VALUE ;;;
;;; REFERENCE CHAIN,,X+ADDR. OF DEFINING PROG. ;;;
;;; WHERE: ;;;
;;; X=400000 IF MULT.SPEC. ;;;
;;; F=1B0: 1 (MEANS DEFINITION) ;;;
;;; 1B1: PRINTED ;;;
;;; 1B2: RELOCATABLE SYMBOL ;;;
;;; 1B3: MULTIPLY DEFINED ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;**AT CROSS INSERTED 4 INSTRUCTIONS [EDIT#121]
CROSS: SETZM HSHTBL ;PREPARE TO CLEAR HSHTBL [ED#121]
MOVE S,[HSHTBL,,HSHTBL+1] ;MAKE BLT-AC [ED#121]
BLT S,HSHEND ;AND CLEAR ALL HSHTBL [ED#121]
MOVE BG,SAVBG ;GET ADR OF FREE STORAGE ORIGIN [ED#121]
MOVEI PT,-1(BG) ;SET INITIAL POINTER
MOVEI S,1(BG) ;DESTINATION HALF OF BLT POINTER
HRL S,BG ;SOURCE HALF
SETZM (BG) ;CLEAR FIRST WORD OF STORAGE
BLT S,(EN) ;CLEAR REST OF STORAGE
TLO F,FST ;FLAG CROSS CALLED
;CROSS+6 INSERTED 4 INSTRUCTIONS [ED#120]
PUSHJ P,INCPT ;BUMP POINTER [ED#120]
AOS B,MODCNT ;FORM DUMMY NAME [ED#120]
MOVEM B,(PT) ;STORE AS PROG NAME [ED#120]
MOVE PN,PT ;REMEMBER ADDR OF NAME [ED#120]
CLRFTN: TLZA F,FFLAG ;CLEAR FORTRAN IV FLAG
INDXBL: SETZM IBUF+2 ;CLEAR COUNT TO FORCE NEW READ (IGNORE INDEX BLK)
NXTBLK: PUSHJ P,GETBIN ;GET BLOCK TYPE WORD - MAY NOT RETURN
;**AT NXTBLK+1 INSERTED 1 INSTRUCTION [EDIT#125]
;**AT NXTBLK+1 [EDIT#126]
TLNE B,(177B6) ;[126] IS THIS ASCII TEXT?
JRST NXTBLK ;[126] YES--THROW IT AWAY
JUMPE B,NXTBLK ;IF BOTH BLOCK TYPE AND WORD COUNT=0,GET [ED#125]
;NEXT BLOCK TYPE WORD
HRRZM B,C ;COUNT OF WORDS IN THIS BLOCK
HLRZM B,T ;BLOCK TYPE
;**AT NXTBLK+3 DELETED 1 INSTRUCTION [EDIT#125]
CAIN T,14 ;SEE IF INDEX BLOCK
JRST INDXBL ;YES--GO SKIP IT
PUSHJ P,GETBIN ;GET RELOCATION WORD
MOVE R,B ;SAVE IN R
MOVEI C1,^D18 ;SUB-BLOCK COUNT
CAIN T,4 ;ENTRY BLOCK?
JRST ENTYP ;YES, MAY HAVE TO CHECK FOR ENTRY POINTS
CAIE T,401 ;MANTIS?
CAIN T,400 ;FORTRAN IV CALL?
JRST FORCAL ;YES
TLNE F,LSKIP ;TEST IF SKIPPING THIS PROGRAM
JRST IGNORE ;YES, IGNORE THIS BLOCK
CAIN T,2 ;SYMBOL TABLE BLOCK TYPE?
JRST SYMTYP ;YES
CAIN T,6 ;NO, PROGRAM NAME BLOCK TYPE?
JRST PRGTYP ;YES
CAIN T,100 ;IS THIS A .ASSIGN BLOCK [127]
JRST ASSIGN ;YES--GO PROCESS IT
IGNORE: PUSHJ P,GETWRD ;NO,IGNORE REST OF BLOCK
JRST NXTBLK ;FINISHED THIS BLOCK
JRST .-2 ;IGNORE REST OF THIS BLOCK
PRGTYP: PUSHJ P,GETWRD ;GET PROGRAM NAME
HALT ;SHOULD NEVER HAPPEN
TLZ B,740000 ;CLEAR ALL BUT RADIX50 NAME
;PRGTYP+3 INSERTED 4 INSTRUCTIONS [ED#120]
HRRZ T,PN ;INDEX TO NAME IN TBL [ED#120]
MOVE T1,(T) ;GET NAME [ED#120]
CAMN T1,MODCNT ;IS IT DUMMY NAME? [ED#120]
JRST PRGTY1 ;YES,SUBSTITUTE [ED#120]
PUSHJ P,INCPT ;INCR & CHECK POINTER
MOVEM B,(PT) ;STORE NAME IN TABLE
MOVE PN,PT ;REMEMBER ADDRESS OF CURRENT NAME
JRST IGNORE ;IGNORE REST OF BLOCK
;ENTYP-1 INSERTED 2 INSTRUCTIONS [ED#120]
PRGTY1: MOVEM B,(T) ;REPLACE NAME [ED#120]
JRST IGNORE ;CONTINUE [ED#120]
ENTYP: TLNN F,LSWIT ;TEST IF IN LIBRARY SEARCH MODE
JRST IGNORE ;IF NOT, IGNORE ENTRY BLOCK
TLO F,LSKIP ;SET SKIP FLAG UNLESS FORCED TO LOAD THIS PROG
ENTYP1: PUSHJ P,GETWRD ;GET NEXT ENTRY POINT
JRST NXTBLK ;NONE LEFT, SKIP THIS PROGRAM
PUSHJ P,SYMJUS ;FOUND ONE, MAKE IT LIKE WOULD BE IN THE LIST
PUSHJ P,SFIND ;SEE IF IT MATCHES AN UNDEFINED GLOBAL REQ
JRST ENTYP1 ;HASNT BEEN REQUESTED, DONT FORCE LOADING
HRRZ R,2(MC) ;HAS BEEN REQUESTED, SEE IF IT HAS BEEN DEFINED
JUMPN R,ENTYP1 ;YES IF POINTER TO PROGRAM NAME NONZERO
TLZ F,LSKIP ;FORCE LOADING THIS PROG, SATISFY GLOBAL REQ
JRST IGNORE ;SEEN ENOUGH, SKIP THE REST OF THIS BLOCK
;THIS ROUTINE TAKES THE RADIX 50 SYMBOL IN B AND
;LEFT JUSTIFIES IT IN THE 6 CHARACTER FIELD.
SYMJUS: TLZ B,740000 ;ONLY SYMBOL NAME IN B
SKIPA T,B ;COPY SYMBOL INTO T
JUSTF1: MOVE T,T1 ;USE LOW ORDER PART OF PRODUCT
MULI T,50 ;MULTIPLY BY 50 OCTAL
JUMPN T,JUSTF2 ;DONE IF NON-ZERO HIGH ORDER PART
CAMGE T1,[50*50*50*50*50*50] ;DOES LOOP EXCEED 50^6?
JRST JUSTF1 ;NO, KEEP MULTIPLYING
JUSTF2: DIVI T,50 ;YES, MULTIPLIED ONCE TOO OFTEN
MOVE B,T ;RESTORE SYMBOL TO B
POPJ P, ;RETURN
SYMTYP: PUSHJ P,GETWRD ;GET SYMBOL WORD
JRST NXTBLK ;NONE LEFT
MOVEM B,V ;SAVE SYMBOL
PUSHJ P,GETWRD ;GET VALUE OR POINTER
HALT ;SHOULD NEVER HAPPEN
EXCH B,V ;SYMBOL IN B,VALUE IN V
JUSTF0: LDB NX,[POINT 4,B,3] ;GET CODE BITS
JUSTFZ: PUSHJ P,SYMJUS ;LEFT JUSTIFY SYMBOL IN 6 CHAR FIELD
CAIE NX,11 ;SUPPRESSED GLOBAL DEFINITION?
CAIN NX,1 ;IS IT A GLOBAL DEFINITION?
JRST SYMDEF ;YES
CAIE NX,14 ;NO,IS IT A GLOBAL REQUEST?
JRST SYMTYP ;NO,MUST BE LOCAL,IGNORE
MOVEI V,0 ;INDICATE NOT MULT.SPEC.
PUSHJ P,SYMREQ ;EXECUTE SYMBOL REQUEST
TLNN F,FFLAG ;SKIP IF DOING FORTRAN IV FORM
JRST SYMTYP ;GO BACK FOR MORE SYMBOLS
JRST GLOBRQ ;GO BACK FOR MORE GLOBAL REQUESTS
SYMDEF: PUSHJ P,SFIND ;IS SYMBOL ALREADY IN TABLE?
JRST NEWSYM ;NO,ADD IT
HRRZ T,2(MC) ;YES,GET NAME POINTER
JUMPE T,DEFIN ;HAS IT BEEN DEFINED?
SYMDF1: CAMN V,1(MC) ;YES ARE VALUES THE SAME?
JRST MNAME ;YES,GO FLAG AS MULTIPLY SPECIFIED
MOVSI T,MULDEF ;NO,FLAG AS MULTIPLY DEFINED
IORM T,(MC)
HLL PN,2(MC) ;SAVE POINTER TO REQUESTS
PUSHJ P,SFINDC ;IS SYMBOL IN TABLE FURTHER ON?
JRST NEWMUL ;NO,ADD NEW DEFINITION
JRST SYMDF1 ;YES GO CHECK VALUES
;HERE TO PROCESS ASSIGN BLOCK [127]
ASSIGN: PUSHJ P,GETWRD ;GET FIRST WORD [127]
JRST NXTBLK ;SHOULD NEVER HAPPEN[127]
MOVEM B,ASGNT1 ;SAVE WORD [127]
PUSHJ P,GETWRD ;GET SECOND WORD [127]
JRST NXTBLK ;SHOULD NEVER HAPPEN [127]
MOVEM B,ASGNT2 ;SAVE SECOND WORD [127]
PUSHJ P,GETWRD ;NOW DO THE SAME THING [127]
JRST NXTBLK ; FOR THE THIRD WORD [127]
MOVEM B,ASGNT3 ; .. [127]
MOVE B,ASGNT2 ;GET SYMBOL TO FIND [127]
PUSHJ P,SFIND ;LOOK UP IN TABLE [127]
JRST IGNORE ;FLUSH BLOCK IF UNDEF [127]
MOVE V,ASGNT3 ;GET ADDON VALUE [127]
ADDB V,1(MC) ;UPDATE VALUE [127]
MOVE B,ASGNT1 ;GET SYMBOL TO DEFINE [127]
PUSHJ P,SYMJUS ;JUSTIFY SYMBOL [127]
ASIGN1: JUMPE C,SYMDEF ;DEFINE NEW SYMBOL [127]
PUSH P,B ;SAVE SYMBOL [127]
PUSHJ P,GETWRD ;READ A WORD OF REL FILE [127]
HALT ;CAN NOT HAPPEN [127]
POP P,B ;IGNORE WHAT WE READ [127]
JRST ASIGN1 ;SEE IF DONE YET [127]
SYMREQ: PUSHJ P,INCPT ;INCREMENT POINTER
HRRZM PN,(PT) ;STORE REQUEST WORD
IORM V,(PT) ;INCLUDE MULT.SPEC. FLAG
MOVE V,PT ;SAVE REQUEST ADDRESS
PUSHJ P,SFIND ;IS SYMBOL DEFINED IN TABLE?
JRST PARDEF ;NO,GENERATE PARTIAL DEFINITION
MOVEI T,2(MC) ;YES,SET ADDRESS OF CHAIN POINTER
SYMRQ1: MOVE NX,T ;CONTINUE ALONG CHAIN
HLRZ T,(NX) ;GET NEXT WORD IN CHAIN
HRRZ B,(NX) ;B = POINTER TO PROGRAM NAME
CAMN B,PN ;SEE IF SAME AS CURRENT PROGRAM
;(PROBLEM IS ADDITIVE GLOBALS)
SOJA PT,CPOPJ ;ALREADY BEEN DEFINED IN THIS PROG
JUMPN T,SYMRQ1 ;END OF CHAIN YET?
HRLM V,(NX) ;YES,STORE POINTER TO REQUEST
POPJ P,
PARDEF: TLO B,400000 ;SET SIGN BIT
PUSHJ P,INCPT ;INCREMENT POINTER
MOVEM B,(PT) ;STORE SYMBOL NAME
MOVEM PT,3(T) ;LINK IN TO LAST SYMBOL
PUSHJ P,INCPT ;LEAVE VALUE ZERO
SETZM (PT) ; ..
PUSHJ P,INCPT ;INCREMENT POINTER AGAIN
HRLZM V,(PT) ;STORE POINTER TO REQUEST
PUSHJ P,INCPT ;GET ANOTHER CELL
MOVEM MC,(PT) ;AND LINK IT IN
POPJ P,
NEWMUL: TLO B,MULDEF ;FLAG AS MULTIPLY DEFINED
NEWSYM: TLO B,400000 ;SET SIGN BIT
TRNE R,1 ;IS SYMBOL RELOCATABLE?
TLO B,RELOC ;YES,SET RELOCATABLE FLAG
PUSHJ P,INCPT ;INCREMENT AND CHECK POINTER
MOVEM B,(PT) ;STORE SYMBOL NAME
MOVEM PT,3(T) ;LINK IN LAST SYMBOL
PUSHJ P,INCPT ;INCREMENT POINTER AGAIN
MOVEM V,(PT) ;STORE VALUE
PUSHJ P,INCPT ;INCREMENT POINTER AGAIN
HRRZM PN,(PT) ;STORE POINTER TO DEFINING PROGRAM NAME
TLNE B,MULDEF ;IS SYMBOL MULTIPLY DEFINED?
HLLM PN,(PT) ;YES,STORE POINTER TO REQUESTS
PUSHJ P,INCPT ;INC PTR AGAIN
MOVEM MC,(PT) ;AND CHAIN TO NEXT SYMBOL
TLNN F,FFLAG ;SKIP IF DOING FORTRAN IV FORM
JRST SYMTYP ;GO BACK FOR MORE REQUESTS
JRST TEXTR ;GO BACK FOR MORE TEXT
DEFIN: MOVSI T,RELOC ;SET UP RELOCATABLE BIT
TRNE R,1 ;IS THIS SYMBOL RELOCATABLE?
IORM T,(MC) ;YES,SET FLAG
MOVEM V,1(MC) ;STORE VALUE
HRRM PN,2(MC) ;STORE POINTER TO PROGRAM NAME
TLNN F,FFLAG ;SKIP IF FORTRAN IV FORM
JRST SYMTYP ;GO BACK FOR MORE SYMBOLS
JRST TEXTR ;GO BACK FOR MORE FORTRAN IV TEXT
MNAME: MOVEI V,MULSPC ;SET FLAG FOR MULTIPLY...
IORM V,2(MC) ;SPECIFIED SYMBOL
TLNE F,MSPSW ;SEE IF SAVING MULT.SPEC. REFERENCES
PUSHJ P,SYMREQ ;YES--GO TREAT AS REFERENCE
TLNN F,FFLAG ;SKIP IF FORTRAN IV FORM
JRST SYMTYP ;GO BACK FOR MORE SYMBOLS
JRST TEXTR ;GO BACK FOR MORE FORTRAN IV TEXT
;THIS SECTION PROCESSES FORTRAN IV REL INPUT AND PULLS OFF
;GLOBAL SYMBOL DEFINITIONS AND REQUESTS AND PUTS APPROPRIATE
;INFORMATION ON THE PUSHDOWN LIST. IT MUST ALSO KEEP THE
;LOCATION COUNTER - THE REST IT CAN IGNORE.
FORCAL: SETZ LOC, ;CLEAR LOCATION COUNTER
TLO F,FFLAG ;SET FORTRAN IV FLAG
JRST TEXTR1 ;B ALREADY = NEXT WORD
IGNOR1: PUSHJ P,GETBIN ;IGNORE NEXT WORD
TEXTR: PUSHJ P,GETBIN ;NEXT WORD TO B
TLNE F,FCOM ;SKIP UNLESS ENTERED A COMMON SYMBOL
JRST COM2 ;BACK INTO COMMON SECTION
TEXTR1: HLRZ NX,B ;NX=LEFT HALF
CAIE NX,-1 ;SKIP IF HEADER FORM
AOJA LOC,TEXTR ;NO, REGULAR CODE - BUMP LOCATION
;COUNTER AND LOOP
CAMN B,[-2] ;TEST IF END OF DATA
JRST ENDF ;YES
LDB NX,[POINT 12,B,35] ;GET SIZE OF BLOCK
ANDI B,770000 ;PICK OFF TYPE OF BLOCK
JUMPE B,IGNOR1 ;JUMP IF PROGRAMMER LABEL
CAIN B,600000 ;TEST IF GLOBAL DEFINITION
JRST GLOBDF ;YES
CAIN B,500000 ;TEST IF ABSOLUTE CODE
JRST ABSI ;YES
CAIN B,310000 ;TEST IF MADE LABEL
JRST IGNOR1 ;YES (DEFINED BY FTN)
CAIE B,770000 ;MANTIS DATA STATMT?
CAIN B,700000 ;TEST IF DATA STATEMENT
JRST DATAS ;YES, IGNORE (NX) WORDS
JRST CLRFTN ;ERROR - EXIT
ABSI: ADD LOC,NX ;BUMP LOCATION COUNTER FOR THIS
;BLOCK OF ABSOLUTE CODE
DATAS: PUSHJ P,GETBIN ;GET NEXT WORD
SOJG NX,.-1 ;IGNORE THE WORDS
JRST TEXTR ;GO BACK FOR MORE
GLOBDF: PUSHJ P,GETBIN ;GET SYMBOL WORD IN B
;GLOBAL DEFINTION CODE IS ALSO SET
TLNE F,LSKIP ;TEST IF SKIPPING THIS PROGRAM
JRST TEXTR ;YES WE ARE
GLOBD1: MOVEI R,1 ;NO, SET RELOCATABLE FLAG
MOVE V,LOC ;V=CURRENT VALUE OF THE LOCATION COUNTER
JRST JUSTF0 ;BACK INTO MAINSTREAM - RETURNS TO TEXTR
ENDF: PUSHJ P,GETBIN ;GET AND IGNORE STARTING ADDRESS
PUSHJ P,GETBIN ;ALSO NUMBER OF PERM. TEMPS
MOVEI C,1 ;SET TO IGNORE 1 TABLE
PUSHJ P,TABIG ;IGNORE CONSTANTS TABLE
PUSHJ P,GETBIN ;GET NUMBER OF GLOBAL REQUESTS
MOVE C,B ;C=NUMBER OF REQUESTS (POSSIBLY 0)
GLOBRQ: TLNE F,FCOM ;SKIP UNLESS CAME HERE AFTER
JRST TEXTR ;A COMMON BLOCK REQUEST.
SOJL C,ENDF1 ;JUMP IF LAST REQUEST DONE
PUSHJ P,GETBIN ;GET NEXT SYMBOL IN B
TLNE F,LSKIP ;TEST IF SKIPPING THIS PROGRAM
JRST GLOBRQ ;YES, DONT DO ANYTHING ABOUT THE GLOBAL REQUESTS
MOVEI NX,14 ;SET GLOBAL REQUEST FLAG
JRST JUSTFZ ;BACK INTO MAINSTREAM -RETURNS TO GLOBRQ
ENDF1: MOVEI C,3 ;SET TO IGNORE 3 TABLES
PUSHJ P,TABIG ;SCALARS, ARRAYS, AND ARRAY OFFSETS
PUSHJ P,GETBIN ;GET AND IGNORE COMBINED STORAGE NEEDED
ADD LOC,B ;ADD TO LOCATION COUNTER
TLNE F,LSKIP ;NO NEED TO WORRY IF SKIPPING THIS PROG
JRST ENDF2 ;JUST SKIP THE COMMON TABLE
TLO F,FCOM ;WE ARE ENTERING A COMMON BLOCK SYMBOL
PUSHJ P,GETBIN ;GET SIZE OF COMMON TABLE
MOVE C,B ;SET IT IN C
COM1: SOJL C,COM3 ;IF DONE, CLEAR FFLAG, START NEXT ROUTINE
PUSHJ P,GETBIN ;GET NEXT COMMON BLOCK SYMBOL
PUSHJ P,SYMJUS ;CLEAR CODE BITS, LEFT JUSTIFY SYMBOL
PUSHJ P,SFIND ;IS THIS BLOCK ALREADY IN SYMBOL TABLE?
JRST COM1A ;NO, DEFINE THE SYMBOL
HRRZ T,2(MC) ;YES, IS IT DEFINED?
JUMPE T,COM1A ;NO, THIS IS THE DEFN
TLOA B,600000 ;YES, THIS IS ONLY A REQUEST
COM1A: TLO B,040000
JRST GLOBD1 ;GO DO IT
COM2: ADD LOC,B ;COMES BACK HERE, ADD COMMN SIZE TO LOC
SOJG C,COM1 ;LOOP TILL COMMON BLOCKS EXHAUSTED
COM3: TLZ F,FCOM ;CLEAR COMMON FLAG
JRST CLRFTN ;CLEAR FFLAG AND START NEXT ROUTINE
ENDF2: PUSHJ P,TABIG ;C KNOWN LE 0, IGNORE 1 TABLE, THE COMMON TABLE
JRST CLRFTN ;CLEAR FFLAG AND LOOK FOR NEXT ROUTINE
;ROUTINE TO SKIP OVER THE NUMBER OF TABLES IN C
TABIG: PUSHJ P,GETBIN ;GET SIZE OF TABLE (POSSIBLY 0)
SKIPE NX,B ;NX=SIZE, SKIP IF 0
PUSHJ P,GETBIN ;GET, IGNORE NEXT WORD
SOJG NX,.-1 ;LOOP FOR TABLE
SOJG C,TABIG ;NUMBER OF TABLES TO IGNORE
POPJ P, ;EXIT
;GET NEXT BINARY WORD WITHIN CURRENT BLOCK
; CALL: PUSHJ P,GETWRD
; XXX NO MORE WORDS IN BLOCK
; XXX NEXT WORD IN B, RELOC BIT IN R35
GETWRD: SOJL C,CPOPJ ;FINISHED THIS BLOCK?
SOJGE C1,GETW1 ;NO, FINISHED SUB BLOCK?
PUSHJ P,GETBIN ;YES, GET NEXT RELOCATION BITS
SCR1==. ;FOR INEND CODING
MOVE R,B ;RELOCATION BITS IN R
;**AT GETWRD+4 [EDIT#124]
MOVEI C1,21 ;RESET SUB-BLOCK COUNT [ED#124]
GETW1: PUSHJ P,GETBIN ;GET NEXT DATA WORD
SCR2==. ;FOR INEND CODING
ROT R,2 ;SET BIT 35 OF R FOR THIS WORD
CPOPJ1: AOS (P) ;INCREMENT RETURN PC
CPOPJ: POPJ P, ;RETURN
;FIND A GIVEN SYMBOL IN TABLE
; CALL: MOVE B,<SYMBOL SOUGHT>
; PUSHJ P,SFIND
; XXX NOT FOUND RETURN
;; XXX SUCCESSFUL RETURN, MC SET
SFIND: MOVE MC,B ;GET THE SYMBOL
PUSH P,MC+1 ;SAVE REGISTER FOR DIVIDE
IDIV MC,[50*50*50*50] ;GET 1ST TWO CHARS
POP P,MC+1 ;RESTORE AC
MOVEI T,HSHTBL-3(MC) ;SET UP LETTER CHAIN IN CASE NULL
SKIPE MC,HSHTBL(MC) ;GET 1ST ENTRY FOR THIS LETTER PAIR
SFIND1: SKIPN NX,(MC) ;GET A SYMBOL
POPJ P, ;DIDN'T FIND ANY
TLZ NX,740000 ;MASK OUT FLAG BITS
CAMN NX,B ;IS IT THE DESIRED SYMBOL?
JRST CPOPJ1 ;YES, SKIP RETURN
CAMLE NX,B ;HIGHER IN ALPHABET?
POPJ P, ;YES, RETURN FAIL
SFINDC: HRRZ T,MC ;STORE WHERE WE ARE
HRRZ MC,3(MC) ;GET NEXT SYMBOL
JUMPN MC,SFIND1 ;AT END OF CHAIN?
POPJ P, ;YES,,NOT FOUND RETURN
;INCREMENT FREE STORAGE POINTER
; CALL: PUSHJ P,INCPT
; XXX SUCCESSFUL RETURN
; WILL NEVER RETURN IF INSUFFICIENT SPACE
INCPT: ADDI PT,1 ;INCREMENT POINTER
CAILE PT,(EN) ;OUT OF TABLE SPACE YET?
JRST EXPAND ;YES, GO TRY TO EXPAND CORE
POPJ P, ;NO, OK RETURN FROM INCPT
SUBTTL CROSS PART 2--PRINT SYMBOL LISTING
;CLEAR "ALREADY PRINTED" BITS IN TABLE
CROSSP: MOVEI S,0 ;ENTER INTO THE HASH TABLE
CROS01: CAIL S,50*50 ;ARE WE FINISHED?
JRST CRLF ;YES
SKIPN BG,HSHTBL(S) ;GET NEXT LETTER PAIR BUCKET
AOJA S,CROS01 ;EMPTY, GET NEXT LETTER PAIR
JRST OUT1 ;DO THE 1ST SYMBOL
OUT0: SKIPN BG,3(BG) ;GET NEXT SYMBOL IN THIS LETTER BUCKET
AOJA S,CROS01 ;NO MORE, GET NEXT LETTER
OUT1: MOVE NX,2(BG) ;1ST LINK OF REF. CHAIN
MOVE SP,BG ;AND ADDR OF SYMBOL
;FALL TO OUTLIN
;FALLS HERE FROM PREVIOUS PAGE
OUTLIN: TLZ F,COMMAF ;NEW LINE
JUMPE SP,CRLF ;RETURN TO CROSSX IF NO MORE TO PRINT
MOVSI T1,PTD ;SET ALREADY PRINTED BIT
IORM T1,(SP) ;MARK SYMBOL AS PRINTED
MOVE B,(SP) ;GET SYMBOL AND CODE BITS
PUSHJ P,PRCHK ;CHECK PRINT CONTROL FLAGS
JRST OUT0 ;DONT PRINT THIS SYMBOL
PUSHJ P,CRLFT ;START NEW LINE - WITH TITLE IF NECC
TLNE B,MULDEF ;IS SYMBOL MULTIPLY DEFINED?
PUSHJ P,PRNTM ;YES, PRINT M
MOVE NX,2(SP) ;GET POINTERS
TRNN NX,-1 ;IS IT UNDEFINED?
PUSHJ P,PRNTU ;YES, PRINT U
TRNE NX,MULSPC ;IS IT MULTIPLY SPECIFIED?
PUSHJ P,PRNTS ;YES,PRINT S
TLNN NX,-1 ;IS IT UNREFERENCED?
PUSHJ P,PRNTN ;YES, PRINT N
PUSHJ P,TAB ;FOLLOW FLAGS BY TAB
MOVE PT,SP ;SET POINTER FOR OUTSYM
PUSHJ P,OUTSYM ;PRINT SYMBOL
PUSHJ P,TAB ;FOLLOW BY TAB
HRRE PT,2(SP) ;GET NAME POINTER, EXTEND MULSPC
JUMPE PT,NOVAL ;SKIP VALUE AND NAME IF UNDEFINED
PUSHJ P,OCTPNT ;PRINT VALUE OF SYMBOL
MOVE T1,(SP) ;GET CODE BITS AGAIN
TLNE T1,RELOC ;IS SYMBOL RELOCATABLE?
PUSHJ P,QUOTE ;YES, PRINT SINGLE QUOTE
PUSHJ P,TAB ;FOLLOW BY TAB
TRZ PT,MULSPC ;RH OF PT POINTS TO PROGRAM NAME
PUSHJ P,OUTSYM ;PRINT PROGRAM NAME
SKIPGE PT ;WAS SYMBOL MULTIPLY SPECIFIED?
PUSHJ P,PPLUS ;YES, PRINT PLUS SIGN
PUSHJ P,TAB1 ;FOLLOW BY TAB AND FOUR SPACES
JRST PRREF ;GO PRINT REFERENCES TO IT
NOVAL: PUSHJ P,TAB3 ;UNDEFINED, PRINT THREE TABS INSTEAD
PRREF: HLRZ NX,2(SP) ;NX POINTS TO FIRST REQUEST
PRRF1: JUMPE NX,OUT0 ;DONE IF NO MORE REQUESTS
MOVE PT,(NX) ;GET REQUEST WORD
TLOE F,COMMAF ;HAS A COMMA BEEN TYPED?
PUSHJ P,COMMA ;YES, TYPE ANOTHER, CHECK FOR OVERFLOW
TRZE PT,MULSPC ;SEE IF MULT. SPECIFIER
PUSHJ P,PPLUS ;YES--SET FLAG
PUSHJ P,OUTSYM ;PRINT PROGRAM NAME
HLRZ NX,PT ;NX POINTS TO NEXT REQUEST
JRST PRRF1 ;CONTINUE ALONG REQUEST CHAIN
PRCHK: TRNE F,ASWIT ;PRINT ALL SYMBOLS?
JRST CPOPJ1 ;YES
MOVE T1,2(SP) ;GET POINTERS FOR THIS SYMBOL
TRNE T1,-1 ;IS SYMBOL UNDEFINED?
TLNE B,MULDEF ;NO, IS IT MULTIPLY DEFINED?
JRST PRCHKE ;YES, ERROR SYMBOL
TRNE F,ESWIT ;IS THIS ERRORS ONLY PRINT?
POPJ P, ;YES, THEN DONT PRINT
TRNN F,RSWIT ;RELOCATABLES ONLY?
JRST PRCHK1 ;NO, CONTINUE TESTS
TLNE B,RELOC ;YES, IS THIS SYMBOL RELOCATABLE?
JRST CPOPJ1 ;YES, PRINT IT
POPJ P, ;NO, DONT PRINT IT
PRCHK1: TRNN F,FSWIT ;FIXED SYMBOLS ONLY?
JRST PRCHK2 ;NO,CONTINUE TESTS
TLNN B,RELOC ;YES, IS THIS SYMBOL FIXED?
JRST CPOPJ1 ;YES, PRINT IT
POPJ P, ;NO, DONT PRINT IT
PRCHK2: TRNN F,SSWIT ;MULTIPLY SPECIFIED ONLY?
JRST PRCHK4 ;NO, CONTINUE TESTS
HRRE T1,2(SP) ;YES, IS THIS SYMBOL MULSPC?
JUMPL T1,CPOPJ1 ;YES, PRINT IT
POPJ P, ;NO, DONT
PRCHK4: TRNN F,NSWIT ;NEVER REFERENCED ONLY?
JRST CPOPJ1 ;NO, SOMETHING WRONG, PRINT IT
TLNN T1,-1 ;WAS SYMBOL REFERENCED?
TRNE T1,MULSPC ;NO, IS IT MULSPC?
POPJ P, ;YES, DONT PRINT
JRST CPOPJ1 ;NO, PRINT IT
PRCHKE: TRNE F,ESWIT ;ERRORS ONLY PRINT?
JRST CPOPJ1 ;YES, PRINT THIS ONE
POPJ P, ;NO, DONT PRINT
OUTSYM: MOVE T,(PT) ;PICK UP RADIX50 SYMBOL
TLZ T,740000 ;CLEAR CODE BITS
OUTSY1: IDIVI T,50 ;DIVIDE BY RADIX
HRLM T1,(P) ;SAVE REMAINDER
JUMPE T,.+2 ;START TO UNWIND IF ZERO QUOTIENT
PUSHJ P,OUTSY1 ;RECURSIVE CALL
HLRZ T,(P) ;GET REMAINDER FROM LIST
JUMPE T,CPOPJ ;IGNORE BLANKS
CAIG T,44 ;LETTER OR NUMBER?
ADDI T,57 ;YES
CAILE T,12+57 ;LETTER?
ADDI T,101-13-57 ;YES
CAIN T,45 ;PERIOD?
MOVEI T,"." ;YES
CAIN T,46 ;$?
MOVEI T,"$" ;YES
CAIN T,47 ;%?
MOVEI T,"%" ;YES
JRST LSTOUT ;FALL INTO OUTPUT
OCTPNT: MOVSI PN,440300+T1
HRROI T1,-7 ;PRESET DIGIT COUNTER
MOVEM T1,DIGCNT ; ..
MOVEI T1,1(SP) ;RH= ADDRESS OF OCTAL NUMBER,LH= CLEARED FLAG
OCTPT1: MOVEI T," " ;PREPARE A SPACE
AOSN DIGCNT ;INCREMENT DIGIT COUNT
PUSHJ P,LSTOUT ;HALF-WAY--PRINT SPACE
ILDB T,PN ;GET OCTAL DIGIT
ADDI T,"0" ;CONVERT TO ASCII
TLNN PN,770000 ;IS THIS THE LAST DIGIT?
JRST LSTOUT ;YES,LSTOUT POPJS BACK TO OUTLIN
TLO T1,(T) ;SET FLAG FOR NON ZERO CHARACTER TYPED
TLNN T1,7 ;IS THIS A ZERO WITH NO NON ZEROS TYPED?
MOVEI T," " ;YES, PRINT SPACE INSTEAD
PUSHJ P,LSTOUT ;GO PRINT OCTAL DIGIT
JRST OCTPT1 ;CONTINUE
PMESS: HRLI T1,440700 ;GENERAL MESSAGE PRINT ROUTINE
PMESS1: ILDB T,T1
JUMPE T,CPOPJ
PUSHJ P,LSTOUT
JRST PMESS1
COMMA: MOVEI T,"," ;PRINT COMMA
AOJL MC,LSTOUT ;PRINT ONLY COMMA IF NO LINE OVERFLOW
PUSHJ P,LSTOUT ;ON OVERFLOW, PRINT COMMA THEN...
PUSHJ P,CRLF ;CR AND FIVE TABS
PUSHJ P,TAB
PUSHJ P,TAB
TAB3: PUSHJ P,TAB ;ENTRY TO PRINT 3 TABS
PUSHJ P, TAB
TAB1: MOVEI T1,TABMS
JRST PMESS
TAB: MOVEI T,11 ;ENTRY TO PRINT SINGLE TAB
JRST LSTOUT
CRLF: AOSA C1 ;NEVER PRINT TITLE EVEN IF TOO MANY LINES
CRLFT: AOJGE C1,PTITLE ;START NEW PAGE IF TOO MANY LINES
MOVNI MC,SYMLIN ;NUMBER OF REFERENCES PER LINE
MOVEI T,15 ;CR
PUSHJ P,LSTOUT
MOVEI T,12 ;LF
JRST LSTOUT
QUOTE: MOVEI T,"'" ;SINGLE QUOTE
JRST LSTOUT
PPLUS: MOVEI T,"+" ;PLUS SIGN
JRST LSTOUT
PRNTM: MOVEI T,"M"
JRST LSTOUT
PRNTU: MOVEI T,"U"
JRST LSTOUT
PRNTS: MOVEI T,"S"
JRST LSTOUT
PRNTN: MOVEI T,"N"
JRST LSTOUT
TABMS: ASCIZ / / ;TAB AND FOUR SPACES
PTITLE: PUSHJ P,CRLF ;MAKE SURE AT LEFT MARGIN
MOVNI C1,PGLINE ;NUMBER OF LINES PER PAGE
TLNN F,TITL ;TITLE PRINT SURPRESSED?
POPJ P, ;YES
MOVEI T,14 ;FORM FEED
PUSHJ P,LSTOUT ;TOP OF NEW PAGE
MOVEI T1,TLINE ;MESSAGE ADDRESS
PUSHJ P,PMESS
TRNE F,ASWIT
MOVEI T1,ALINE
TRNE F,ESWIT
MOVEI T1,ELINE
TRNE F,RSWIT
MOVEI T1,RLINE
TRNE F,FSWIT
MOVEI T1,FLINE
TRNE F,NSWIT
MOVEI T1,NLINE
TRNE F,SSWIT
MOVEI T1,SLINE
PUSHJ P,PMESS
JRST CRLF
;VARIOUS TEXTS FOR TITLE LINES
TLINE: ASCIZ /Flags Symbol Octal Value Defined in Referenced in /
ALINE: ASCIZ /(all symbols)
/
ELINE: ASCIZ /(errors only)
/
RLINE: ASCIZ /(relocatable symbols only)
/
FLINE: ASCIZ /(fixed symbols only)
/
NLINE: ASCIZ /(never referenced symbols only)
/
SLINE: ASCIZ /(multiply specified only)
/
SUBTTL SCAN--COMMAND SCANNER
;THIS IS A REENTRANT TYPE 2 SUBROUTINE
;IT USES NO TEMPORARY LOC EXCEPT 6 LOC ON PD LIST
;IT PRESERVES ALL ACS
;THERE ARE TWO CALLS, ONE FOR SOURCE AND ONCE FOR DESTINATION
;SSCAN SCANS FOR LEFT ARROW FIRST BEFORE USING COUNT
;DSCAN STARTS SCANNING IMMEDIATELY,LEFT ARROW MUST BE PRESENT
;CALLING SEQUENCE:
; MOVE T,[XWD REL ADR OF OPEN UUO ARRAY,NTH FILE DESIRED]
; N=0 IS EQUIVALENT TO N=1 IE FIRST FILE WANTED
; MOVE T1,BYTE POINTER TO STRING OR FIRST REL ADR OF STRING
; PUSHJ P,DSCAN -OR- SSCAN
; XXX ;SYNTAX ERROR
; XXX ;NTH FILE NOT SPEIFIED - ALTMODE SEEN
; XXX ;NTH FILE NOT SPECIFIED - OTHER TERMINATOR SEEN
; XXX ;SUCCESSFUL RETURN, OPEN UUO ARRAY SET
;SIXBIT SWITCHES ARE RETURNED IN AC T LEFT JUSTIFIED
;BYTE POINTER IN AC T1 POINTS TO LAST CHAR SCANNED ON ALL RETURNS
;THE DEVICE NAME,FILE NAME AND EXTENSION ARE SET TO ZERO
;BEFORE EACH SCAN IS BEGUN
;THE OPEN UUO ARRAY HAS FOLLOWING FORMAT:
;WORD 0 NOT ALTERED
;WORD 1 RECEIVES DEVICE NAME
;WORD 2 UNALTERED
;WORD 3 RECEIVES FILE NAME
;WORD 4 RECEIVES EXTENSION IN LH, RH UNALTERED
;WORD 5 UNALTERED
;WORD 6 RECEIVES DIRECTORY
;SOURCE FILE ENTRY POINT
SSCAN: PUSHJ P,SAVACS ;SAVE ACS AND CLEAR FLAGS
TROA F,SRC ;SET SOURCE FLAG
;DESTINATION FILE ENTRY POINT
DSCAN: PUSHJ P,SAVACS ;SAVE ACS
ARRCHK: MOVE NM,T1 ;COPY STRING BP
ARRCK1: ILDB CH,NM
MOVSI CC,-IDSPLN
ARRCK2: HLRZ T,IDSPTB(CC)
CAME T,CH
AOBJN CC,ARRCK2
MOVE CC,IDSPTB(CC)
JRST (CC)
;SCAN NEXT FILE FIELD
ARPR: TRNE F,SRC ;IS THIS SOURCE SCAN?
MOVE T1,NM ;YES, CHANGE BP TO BEGIN AFTER ARROW
LOOPI: HLRZ T,(P) ;GET ADR OF OPEN UUO ARRAY
TRO F,NCHF ;SET BEGINNING OF LINE FLAG
;FALL INTO LOOP0
LOOP0: TRZ F,PERF+COLONF ;CLEAR SUBFIELD BREAK CHAR FLAGS
;**AT LOOP0+1 EDIT#123 INSERTED TWO INSTRUCTIONS
MOVE SWTBYT,[POINT 6,SWT] ;RESET BYTE POINTER TO BUILD SWITCHES [ED#123
MOVEI SWT,0 ;CLEAR SWITCH REGISTER [ED#123]
TRNE F,ALF ;HAS AN ALTMODE BEEN SEEN?
JRST ALTRTN ;YES, NOT FOUND RETURN
TRNE F,CRF ;HAS A CR BEEN SEEN?
JRST NTFOND ;YES, FIELD NOT FOUND RETURN
;**AT LOOP0+5 EDIT#123 DELETED TWO INSTRUCTIONS
;SCAN NEXT SUBFIELD
LOOP1: MOVE T,[POINT 6,NM] ;BYTE POINTER TO BUILD NAME
MOVEI NM,0 ;CLEAR NAME REGISTER
;GET NEXT CHAR IN SUBFIELD
LOOP2: ILDB CH,T1 ;GET NEXT CHARACTER IN COMMAND STRING
CAIL CH,"A"+40 ;CHECK FOR LOWER CASE
CAILE CH,"Z"+40 ; ALPHABETICS
JRST .+2 ;NO
SUBI CH,40 ;YES--CONVERT TO UPPER CASE
CAIL CH,"0" ;NUMBER OR LETTER?
CAILE CH,"Z"
JRST BREAK ;NO, BREAK OR ILLEGAL?
CAILE CH,"9"
CAIL CH,"A"
JRST BUILD ;YES, BUILD NAME IN AC NM
BREAK: CAIN CH,"/" ;SLASH?
JRST SLASH ;YES
CAIN CH,"(" ;NO, LEFT PAREN?
JRST LEFPAR ;YES
MOVSI CC,-DISPLN ;NO, SEARCH BREAK CHAR TABLE
;NAME FINISHED(DESTROY BYTE POINTER)
BRK1: HLRZ T,DISPTB(CC) ;GET NEXT BREAK CHAR.
CAME T,CH ;IS IT THIS ONE?
AOBJN CC,BRK1 ;NO, KEEP LOOKING
HLRZ T,(P) ;SETUP REL. ADR. OF OPEN UUO ARRAY
MOVE CC,DISPTB(CC) ;DISPATCH ACCORDING TO BREAK
JRST (CC)
;BREAK CHARACTER DISPATCH TABLE (FOR PRESCAN)
IDSPTB: XWD ALTM1,EOLA
XWD ALTM2,EOLA
XWD ALTM3,EOLA
XWD LEFARR,ARPR ;LOOK FOR PRESENCE OF LEFT ARROW
XWD "=",ARPR
XWD CR,EOL
XWD LF,EOL
XWD FF,EOL
XWD VT,EOL
XWD CTLC,DONE
XWD CTLZ,DONE
IDSPLN==.-IDSPTB
JRST ARRCK1 ;IF WE FALL THRU DISPATCH TABLE
;BREAK CHARACTER DISPATCH TABLE (FOR REAL SCAN)
DISPTB: XWD ":",COLON
XWD ".",PER
XWD ",",COMMR
XWD "[",DIR
XWD ALTM1,FINA
XWD ALTM2,FINA
XWD ALTM3,FINA
XWD CR,FIN
XWD LF,FIN
XWD FF,FIN
XWD VT,FIN
XWD LEFARR,FIN
XWD "=",FIN
DISPLN==.-DISPTB
JRST SYNTAS ;ILLEGAL CHARACTER
;BUILD NAME IN AC NM
BUILD: TRZ F,NCHF
TRC CH,40 ;CONVERT TO SIXBIT
TLNE T,770000 ;IS THERE ROOM IN NM?
IDPB CH,T ;YES, STORE CHAR IN NM
JRST LOOP2 ;GO GET NEXT CHAR.
;COLON
COLON: TRZ F,NCHF
TRZN F,PERF ;PERIOD PREVIOUS BREAK?
TROE F,COLONF ;NO, COLON PREVIOUS BREAK?
JRST SYNTAS ;YES, SYNTAX ERROR
ADDI T,DEVWRD ;NO, STORE DEVICE NAME
JRST PER1
;PERIOD
PER: TRZ F,NCHF
TROE F,PERF ;WAS PERIOD PREVIOUS BREAK?
JRST SYNTAS ;YES, SYNTAX ERROR
ADDI T,FILWRD ;NO, STORE FILE NAME
PER1: MOVEM NM,(T) ;I IN INDEX FIELD
JRST LOOP1 ;SCAN NEXT SUB FIELD
EOLA: TRO F,ALTS ;SET A/M SEEN FLAG
EOL: TRNE F,SRC ;IS THIS SOURCE SCAN?
JRST LOOPI ;YES, START AT BEGINNING OF LINE
TRNE F,ALTS ;NO, WAS A/M SEEN?
JRST ALTRTN ;A/M RETURN FOR NO DEST SPEC
JRST NTFOND ;NORMAL RETURN FOR NO DEST SPEC
;LEFT SQUARE BRACKET
DIR: PUSHJ P,OCTIN ;GET PROJECT NUMBER
HRLZM CC,DIRWRD(T) ;STORE AWAY
CAIE CH,"," ;VERIFY COMMA SEPARATOR
JRST SYNTAS ;NO--ERROR
PUSHJ P,OCTIN ;GET PROGRAMMER NUMBER
HRRM CC,DIRWRD(T) ;STORE AWAY
CAIL CH,ALTM1 ;SEE IF ALTMODE
MOVEI CH,ALTM3 ;YES--CHANGE TO ESCAPE
CAIE CH,"]" ;VERIFY CORRECT END
CAIG CH,40 ;NO--CHECK FOR END OF LINE
JRST .+2 ;YES--OK
JRST SYNTAS ;NO--ERROR
CAIN CH,"]" ;IF ], THEN
ILDB CH,T1 ; GET NEXT CHAR
JRST BREAK ;AND CHECK BREAKS
;GET OCTAL NUMBER FROM INPUT
OCTIN: MOVEI CC,0 ;CLEAR RESULT
OCTIN1: ILDB CH,T1 ;GET NEXT DIGIT
CAIL CH,"0" ;CHECK FOR OCTAL
CAILE CH,"7" ; ..
POPJ P, ;NO--RETURN AS SEPARATOR
LSH CC,3 ;MULTIPLY RESULT
ADDI CC,-"0"(CH) ;INCREMENT RESULT
JRST OCTIN1 ;AND GO AROUND LOOP
;CR,LF,FF,VT,ALTMODE,LEFTARROW
FINA: TROA F,ALF ;SET ALTMODE SEEN FLAG
FIN: TRO F,CRF ;SET OTHER TERMINATOR SEEN FLAG
TRNE F,NCHF ;IS TERMINATOR FIRST CHAR OF LINE?
JRST LOOP0 ;YES,GIVE NOT FOUND RETURN
;COMMA
COMMR: TRZ F,NCHF
SOJG FC,LOOP0 ;IS THIS THE DESIRED FILE FIELD?
TRNN F,PERF ;WAS PERIOD PREVIOUS BREAK?
JRST STONAM ;NO, STORE FILE NAME
ADDI T,EXTWRD ;YES, STORE EXTENSION
HLLM NM,(T)
JRST OKRET ;OK RETURN TO CALLER
STONAM: ADDI T,FILWRD ;STORE FILE NAME
MOVEM NM,@T ;I IN INDEX FIELD
OKRET: AOS -NOACS(P) ;OK RETURN
NTFOND: AOS -NOACS(P) ;NOT FOUND RETURN
ALTRTN: AOS -NOACS(P) ;NOT FOUND RETURN - ALTMODE SEEN
SYNTAS: POP P,T ;REMOVE INPUT ARG FROM PD LIST
MOVE T,SWT ;RETURN SWITCHES IN AC T
POP P,SWTBYT ;RESTORE ACS SAVED ON CALL
POP P,SWT
POP P,CC
POP P,FC
POP P,NM
POP P,F
POP P,CH ;RESTORE CH(MATCHES EXCH IN SAVACS)
POPJ P, ;RETURN TO CALLER OF DSCAN/SSCAN
;HERE IF ^Z OR ^C TYPED
DONE: RESET ;RESET I/O
EXIT 1, ;RETURN TO MONITOR
JRST CROSX0 ;IF CONT, DO A REENTER
;SLASH - BUILD SWITCH WORD
SLASH: JSP CC,STOSWT ;STORE SWITCH CHARACTER
JRST LOOP2 ;CONTINUE SUBFIELD SCAN
;LEFT PARENTHESIS - BUIILD SWITCHES UNTIL RT PAREN.
LEFPAR: JSP CC,STOSWT ;STORE NEXT SWITCH CHARACTER
JRST .-1 ;STORE SWITCH CHARS. UNTIL )
STOSWT: ILDB CH,T1 ;GET NEXT CHAR.
CAIN CH,")" ;IS IT RIGHT PAREN?
JRST LOOP2 ;YES, GO GET NEXT CHAR IN MAIN SCAN
CAIGE CH,140 ;SEE IF LOWER CASE
TRC CH,40 ;NO, CONVERT TO SIXBIT
TLNE SWTBYT,770000 ;IS THERE ROOM IN SYTBYT?
IDPB CH,SWTBYT ;YES, BUILD SWITCH CHARS.
JRST (CC) ;RETURN
;SAVE ACS ROUTINE
SAVACS: EXCH CH,(P) ;SAVE CH, GET RETURN
PUSH P,F ;SAVE ACS MAY BE REMOVED IF NOT NECESSARY
PUSH P,NM
PUSH P,FC
PUSH P,CC
PUSH P,SWT
PUSH P,SWTBYT
PUSH P,T ;SAVE REL ADR OF OPEN UUO ARRAY (LH)
NOACS==.-SAVACS ;NUMBER OF ACS SAVED
TLNN T1,-1 ;IS LH OF BYTE POINTER SET?
HRLI T1,440700 ;NO, FIRST BYTE
HRRZ FC,T
MOVEI F,0
MOVEI SWT,0 ;CLEAR SWITCH REGISTER
JRST (CH) ;RETURN - MATCHES PUSHJ CALL TO SAVACS
SUBTTL STORAGE
XLIST ;LITERALS
LIT
LIST
IFN PURESW,<RELOC> ;SWITCH TO LOW SEG
FWAZER:! ;START OF AREA TO ZERO ON START
MODCNT: BLOCK 1 ;MODULE COUNT (DUMMY NAME) [ED#120]
ASGNT1: BLOCK 1 ;3 WORDS USED BY BLOCK TYPE [127]
ASGNT2: BLOCK 1 ; 100 [127]
ASGNT3: BLOCK 1 ; [127]
PDLIST: BLOCK PDLEN+1 ;PUSH DOWN LIST
OPENO: BLOCK 10 ;OUTPUT OPEN UUO ARRAY
OPENI: BLOCK 10 ;INPUT OPEN UUO ARRAY
OPENCT: BLOCK 1 ;ARGUMENT TO SSCAN
DIGCNT: BLOCK 1 ;DIGIT COUNT FOR OUTPUT
LASTIN: BLOCK 1 ;DEFAULT FILE NAME FOR OUTPUT
SAVREL: BLOCK 1 ;ORIGINAL CORE SIZE [ED#121]
SAVBG: BLOCK 1 ;FREE STORAGE ORIGIN [ED#121]
TIBUF: BLOCK 3 ;TTY INPUT BUFFER HEADER
TOBUF: BLOCK 3 ;TTY OUTPUT BUFFER HEADER
IBUF: BLOCK 3 ;SOURCE BUFFER HEADER
OBUF: BLOCK 3 ;DESTINATION BUFFER HEADER
LWAZER==.-1 ;END OF AREA TO ZERO ON START
HSHTBL: BLOCK 50*50 ;TABLE OF LETTER CHAIN PTRS
HSHEND==.-1 ;TO USE FOR ZEROING HSHTBL [ED#121]
IFN PURESW,<RELOC>
PATCH: END GLOB