mirror of
https://github.com/PDP-10/stacken.git
synced 2026-03-01 01:19:17 +00:00
1789 lines
56 KiB
Plaintext
1789 lines
56 KiB
Plaintext
TITLE GLOB -- GLOBAL CROSS-REFERENCE DIRECTORY LISTING %5C(141)
|
||
SUBTTL PARAMETERS AND DEFINITIONS D.PLUMMER/DJB/CAM/PFC/DAL/MFB/PY/MRB 26-FEB-88
|
||
|
||
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1968,1984,1986,1988.
|
||
;ALL RIGHTS RESERVED.
|
||
;
|
||
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
|
||
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
|
||
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
|
||
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
|
||
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
|
||
;TRANSFERRED.
|
||
;
|
||
;
|
||
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
|
||
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
|
||
;CORPORATION.
|
||
;
|
||
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
|
||
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
|
||
;
|
||
|
||
%GLOB==5
|
||
VWHO==0
|
||
VMINOR==3
|
||
VEDIT==141
|
||
|
||
;. . . 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
|
||
|
||
; EDIT#130 - ADD SFD SUPPORT TO THE COMMAND SCANNER.
|
||
|
||
; EDIT#131 - MFB 9-APR-80
|
||
; ADD SUPPORT FOR POLISH BLOCKS ONLY TO EXTENT WHERE
|
||
; PROGRAM THAT SYMBOL IS DEFINED IN WILL BE PRINTED.
|
||
; THE VALUE WILL STILL BE UNKNOWN.
|
||
|
||
|
||
; EDIT#132 - PY 13-MAY-83
|
||
; ADD SUPPORT FOR NEW STYLE REL BLOCKS (ABOVE 1000).
|
||
; IGNORE THEM ALL FOR NOW.
|
||
|
||
; EDIT#133 - PY 5-JUL-83
|
||
; REMOVE 2 WORDS OF CODE.
|
||
|
||
; EDIT#134 - PY 1-AUG-83
|
||
; CLEAR THE OUTPUT FILESPEC BLOCK. FIXES DATE-75
|
||
; AND OTHER BUGS.
|
||
|
||
; EDIT#135 - MRB 13-OCT-83 QAR# 125603
|
||
; CORRECTION TO EDIT 131. CAUSES LOOPING WHEN
|
||
; READING GLOBAL SYMBOLS.
|
||
|
||
; EDIT#136 - MRB 13-OCT-83 QAR# 125604
|
||
; FIX THE "/H" COMMAND. REMOVE EDIT 123 AND FIX THE
|
||
; PROBLEM WITH "/X" ON THE SOURCE SIDE.
|
||
|
||
; EDIT#137 - PY 15-JUL-84 SPR 10-34726
|
||
; ALLOW SPACES BEFORE BREAK CHARACTERS IN COMMANDS.
|
||
|
||
; EDIT#140 - LEO 6-SEP-85
|
||
; Do Copyrights.
|
||
|
||
; EDIT#141 - BAH 26-FEB-88
|
||
; Do copyrights. Also add a REQUEST of HELPER to help TOPS20 builds.
|
||
|
||
;ASSEMBLY INSTRUCTIONS:
|
||
;
|
||
; .LOAD GLOB ;[ED#117]
|
||
; .SSAVE DSK:GLOB
|
||
|
||
|
||
SEARCH UUOSYM
|
||
|
||
.REQUEST REL:HELPER
|
||
|
||
|
||
.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==50> ;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
|
||
|
||
|
||
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1968,1988. ALL RIGHTS RESERVED.
|
||
\;END COPYRIGHT MACRO
|
||
|
||
|
||
;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
|
||
|
||
.PTPPN==2 ;PPN WORD OFFSET IN PATH BLOCK
|
||
SFDLVL==5 ;MAX SFD LEVEL
|
||
|
||
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
|
||
;**;[134] Insert 1 Line after EXTWRD==4 PY 1-Aug-83
|
||
PROWRD==5 ;[134] PROTECTION WORD
|
||
DIRWRD==6 ;DIRECTORY WORD
|
||
DIRPTH==7 ;START OF PATH BLOCK
|
||
BUFST==DIRPTH+.PTPPN+SFDLVL+2 ;PUT IT AT END OF PATH BLOCK
|
||
|
||
;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 ; ..
|
||
;**;[134] Insert 4 lines after NEXLIN+6 Lines PY 1-Aug-83
|
||
SETZM OPENO+PROWRD ;[134] CLEAR PROTECTION WORD
|
||
MOVE T,[OPENO+PROWRD,,OPENO+DIRWRD] ;[134] AND THE PPN WORD
|
||
BLT T,OPENO+DIRPTH+.PTPPN+SFDLVL ;[134] AND PATH BLOCK
|
||
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,[OPENI+DIRWRD,,OPENI+DIRWRD+1]
|
||
BLT T1,OPENI+DIRPTH+.PTPPN+SFDLVL ;CLEAR PATH BLOCK
|
||
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: TLZ F,TITL ;[136]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
|
||
;**; [132] INSERT BEFORE NXTBLK+12 PY 13-MAY-83
|
||
CAIL T,1000 ;[132] CHECK FOR NEW BLOCK TYPE
|
||
JRST NEWBLK ;[132] YES--GO HANDLE 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
|
||
;**; [131] INSERT BEFORE IGNORE MFB 9-APR-80
|
||
CAIN T,11 ;[131] POLISH BLOCK TYPE?
|
||
JRST POLTYP ;[131] YES
|
||
IGNORE: PUSHJ P,GETWRD ;NO,IGNORE REST OF BLOCK
|
||
JRST NXTBLK ;FINISHED THIS BLOCK
|
||
;**; [132] REPLACE AT IGNORE+2 PY 13-MAY-83
|
||
JRST IGNORE ;[132] IGNORE REST OF THIS BLOCK
|
||
;**; [132] INSERT BEFORE PRGTYP PY 13-MAY-83
|
||
;[132] HERE TO HANDLE NEW BLOCKS.
|
||
NEWBLK: ;[132] ALL NEW BLOCKS ARE IGNORED.
|
||
NEWIGN: JUMPE C,NXTBLK ;[132] DONE?
|
||
PUSHJ P,GETBIN ;[132] NO, GET ANOTHER WORD
|
||
SOJA C,NEWIGN ;[132] 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
|
||
;**; [131] CHANGE @ JUSTFZ + 4L MFB 9-APR-80
|
||
CAIN NX,14 ;[131] NO,IS IT A GLOBAL REQUEST?
|
||
;**; [131] INSERT @ JUSTFZ + 5L MFB 9-APR-80
|
||
JRST SYMTP1 ;[131] GLOBAL REQUEST
|
||
CAIN NX,5 ;[131] GLOBAL DEF RH DEFERRED?
|
||
JRST SYMDEF ;[131] YES
|
||
CAIN NX,15 ;[131] GLOBAL DEFERRED SUPP. RH!LH?
|
||
JRST SYMDEF ;[131] YES
|
||
JRST SYMTYP ;NO,MUST BE LOCAL,IGNORE
|
||
;**; [131] INSERT & ADD TAG @ JUSTFZ + 6L MFB 9-APR-80
|
||
SYMTP1: TLNE V,500000 ;[131] ADDITIVE GLOBAL W/RAD50 SYM NAME?
|
||
JRST SYMTP2 ;[131] YES, DEFINING A SYM NOT REQUESTING
|
||
MOVEI V,0 ;INDICATE NOT MULT.SPEC.
|
||
PUSHJ P,SYMREQ ;EXECUTE SYMBOL REQUEST
|
||
;**; [131] ADD TAG @ JUSTFZ + 8L MFB 9-APR-80
|
||
SYMT1A: TLNN F,FFLAG ;[131] SKIP IF DOING FORTRAN IV FORM
|
||
JRST SYMTYP ;GO BACK FOR MORE SYMBOLS
|
||
JRST GLOBRQ ;GO BACK FOR MORE GLOBAL REQUESTS
|
||
;**; [131] INSERT @ JUSTFZ + 11L MFB 9-APR-80
|
||
SYMTP2: PUSH P,V ;[131] SAVE THE SYMBOL NAME
|
||
PUSH P,B ;[131] SAVE REQUEST TOO
|
||
PUSHJ P,SYMJUS ;[135][131] JUSTIFY THE SYMBOL
|
||
CAME B,LSTSYM ;[131] TRYING TO FIX IT UP?
|
||
JRST [POP P,B ;[131] NO, RESTORE B & V
|
||
POP P,V
|
||
JRST SYMTP1+2] ;[131] THEN DO NORMAL THING
|
||
SETZM LSTSYM ;[131] CLEAR THE LAST SYM PARTIALLY DEFINED
|
||
PUSHJ P,SFIND ;[131] ALREADY IN TABLE?
|
||
JRST SYMERR ;[131] NO, ERROR IN BLOCK TYPE 2
|
||
MOVSI B,200000 ;[131] SET ADDITIVE GLOBAL BIT
|
||
IORM B,3(MC) ;[131] IN THE LINK WORD
|
||
POP P,B ;[131] POP JUNK OFF THE STACK
|
||
POP P,V ;[131]
|
||
JRST SYMTP1+2 ;[131] REJOIN COMMON CODE
|
||
;**; [131] INSERT @ SYMDEF MFB 9-APR-80
|
||
SYMDEF: TLZ B,740000 ;[131] CLEAR THE CODE BITS
|
||
MOVEM B,LSTSYM ;[131] SAVE AS LAST SYM PARTIALLY DEFINED
|
||
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
|
||
;**; [131] INSERT @ SYMDF1 + 8L MFB 9-APR-80
|
||
SYMERR: PUSHJ P,PRFILE ;[131] PRINT THE FILE NAME
|
||
JSP T1,ENDMES ;[131] PRINT MESSAGE & START OVER
|
||
ASCIZ / encountered additive request for non-existent symbol /
|
||
;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
|
||
;**; [131] CHANGE @ PARDEF + 3L MFB 9-APR-80
|
||
HRRM PT,3(T) ;[131] 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
|
||
;**; [131] CHANGE @ PARDEF + 9L MFB 9-APR-80
|
||
HRRM MC,(PT) ;[131] 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
|
||
;**; [131] CHANGE @ NEWSYM + 5L MFB 9-APR-80
|
||
HRRM PT,3(T) ;[131] 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
|
||
;**; [131] CHANGE @ NEWSYM + 13L MFB 9-APR-80
|
||
HRRM MC,(PT) ;[131] 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
|
||
;**; [131] ADD ROUTINE @ TABIG + 7L MFB 9-APR-80
|
||
;[131] ROUTINE TO READ THROUGH POLISH BLOCKS TO DETERMINE IF THE RESULT
|
||
;[131] WILL BE A SYMBOL FIXUP. IF SO, ENTER THE ROUTINE THAT THE SYMBOL
|
||
;[131] IS BEING FIXED UP IN AS THE DEFINING ROUTINE.
|
||
POLTYP: PUSHJ P,GETWRD ;[131] LOAD B WITH DATA WORD
|
||
JRST PERROR ;[131] SHOULD NOT HAPPEN
|
||
PUSH P,S ;[131] SAVE SOME AC'S
|
||
PUSH P,T ;[131]
|
||
MOVE T1,[POINT 18,B] ;[131] SET UP BYTE PTR TO B
|
||
POL1: PUSHJ P,HLFWRD ;[131] GET A HALF WORD
|
||
JRST PDONE ;[131] GONE THROUGH ENTIRE BLOCK
|
||
CAIL T,-7 ;[131] ABOVE THE STORE OP RANGE?
|
||
JRST POL1A ;[131] SOME SORT OF OPERATOR
|
||
CAILE T,2 ;[131] IS IT AN OPERATOR?
|
||
JRST POL1 ;[131] YES, GET ANOTHER HALF WORD
|
||
CAIN T,0 ;[131] A DATA HALF WORD FOLLOWING?
|
||
JRST POLDA1 ;[131] YES
|
||
JRST POLDA2 ;[131] MUST BE A FULL WORD OF DATA
|
||
|
||
;
|
||
; HERE FOR SOME KIND OF STORE OPERATOR
|
||
;
|
||
POL1A: CAIGE T,777775 ;[131] SYMBOL FIXUP?
|
||
JRST POL2 ;[131] YES
|
||
POL3: PUSHJ P,HLFWRD ;[131] NO, FINISH OFF BLOCK
|
||
JRST PDONE ;[131] ALL DONE
|
||
JRST POL3 ;[131] KEEP AT IT
|
||
POL2: PUSH P,[0] ;[131] NEED A TEMPORARY LOCATION
|
||
PUSHJ P,HLFWRD ;[131] GET THE SYMBOL INTO B
|
||
JRST PERROR ;[131] BAD BLOCK
|
||
HRLM T,0(P) ;[131] PUT IN CORRECT HALFS
|
||
PUSHJ P,HLFWRD ;[131]
|
||
JRST PERROR ;[131]
|
||
HRRM T,0(P) ;[131]
|
||
POP P,B ;[131] GET SYMBOL INTO B
|
||
PUSHJ P,SYMJUS ;[131] LEFT JUSTIFY SYMBOL IN 6 CHAR FIELD
|
||
PUSHJ P,SFIND ;[131] SEE IF SYMBOL IS IN THE TABLE
|
||
JRST POL3 ;[131] NOT THERE, FINISH OFF BLOCK AND RETURN
|
||
HRRZ T,2(MC) ;[131] GET THE NAME POINTER
|
||
SKIPN T ;[131] IF ALREADY DEFINED, DO NOT CHANGE IT
|
||
HRRM PN,2(MC) ;[131] SAY WHERE ITS DEFINED
|
||
MOVSI T,400000 ;[131] SET THE SIGN BIT OF LINK
|
||
IORM T,3(MC) ;[131] TO THE NEXT SYMBOL
|
||
JRST POL3 ;[131] FINISH OFF BLOCK
|
||
POLDA2: PUSHJ P,HLFWRD ;[131] GET A HALF WORD
|
||
JRST PDONE ;[131] DONE WITH THIS BLOCK
|
||
POLDA1: PUSHJ P,HLFWRD ;[131] GET ANOTHER
|
||
JRST PDONE
|
||
JRST POL1 ;[131] GET NEXT CODE
|
||
PDONE: POP P,T ;[131] RESTORE THE AC'S
|
||
POP P,S ;[131]
|
||
JRST NXTBLK ;[131] GO PROCESS THE NEXT BLOCK
|
||
;**;[133] Replace at PERROR PY 5-Jul-83
|
||
;[133] THERE MAY BE DATA WORDS ON THE STACK. THIS IS ACCEPTABLE
|
||
;[133] BECAUSE PERROR DOES NOT RETURN.
|
||
PERROR: PUSHJ P,PRFILE ;[133] PRINT THE FILE NAME
|
||
JSP T1,ENDMES ;[131] PRINT THE MESSAGE
|
||
ASCIZ/ bad Polish block encountered /
|
||
|
||
;
|
||
; ROUTINE TO READ HALF WORDS INTO T (USES GETWRD)
|
||
;
|
||
HLFWRD: TLNE T1,770000 ;[131] FINISHED WITH THIS WORD?
|
||
JRST HWRD1 ;[131] NO, SKIP CALL TO GETWRD
|
||
PUSHJ P,GETWRD ;[131] YES, GET ANOTHER FULL WORD
|
||
POPJ P, ;[131] DONE WITH THIS BLOCK
|
||
MOVE T1,[POINT 18,B] ;[131] SET UP BYTE PTR TO B
|
||
HWRD1: ILDB T,T1 ;[131] GET A HALF WORD INTO T
|
||
AOS (P) ;[131] SET UP SKIP RETURN
|
||
POPJ P, ;[131] RETURN
|
||
|
||
;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
|
||
;**; [131] CHANGE & INSERT @ OUT0 MFB 9-APR-80
|
||
OUT0: HRRZ BG,3(BG) ;[131] GET NEXT SYMBOL IN THIS LETTER BUCKET
|
||
SKIPN BG ;[131]
|
||
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
|
||
;**; [131] INSERT & ADD TAG @ OCTPNT + 23L MFB 9-APR-80
|
||
SKIPL T1,3(SP) ;[131] DEFINED IN TERMS OF POLISH?
|
||
JRST OUTLI0 ;[131] NO
|
||
MOVEI T1,POLMES ;[131] YES, WRITE OUT "* POLISH *"
|
||
PUSHJ P,PMESS ;[131] FOR THE VALUE
|
||
JRST OUTLI2 ;[131] AND SKIP TRYING TO WRITE OUT A VALUE
|
||
OUTLI0: TLNN T1,200000 ;[131] ADDITIVE GLOBAL?
|
||
JRST OUTLI1 ;[131] NO
|
||
MOVEI T1,ADDGLB ;[131] PRINT "* ADD GLB *"
|
||
PUSHJ P,PMESS ;[131]
|
||
JRST OUTLI2 ;[131] DON'T TRY TO WRITE A VALUE
|
||
OUTLI1: PUSHJ P,OCTPNT ;[131] PRINT VALUE OF SYMBOL
|
||
MOVE T1,(SP) ;GET CODE BITS AGAIN
|
||
TLNE T1,RELOC ;IS SYMBOL RELOCATABLE?
|
||
PUSHJ P,QUOTE ;YES, PRINT SINGLE QUOTE
|
||
;**; [131] ADD TAG @ OCTPNT + 27L MFB 9-APR-80
|
||
OUTLI2: PUSHJ P,TAB ;[131] 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
|
||
|
||
;**; [131] ADD POLMES & ADDGLB AFTER TABMS MFB 9-APR-80
|
||
POLMES: ASCIZ /* POLISH */ ;[131] MEANS SYMBOL DEFINED IN TERMS OF POLISH
|
||
|
||
ADDGLB: ASCIZ /* ADD GLB */ ;[131] ADDITIVE GLOBAL REQUEST
|
||
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#136 DELETED TWO INSTRUCTIONS
|
||
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#136 INSERTED TWO INSTRUCTIONS
|
||
MOVE SWTBYT,[POINT 6,SWT];RESET BYTE POINTER TO BUILD SWITCHES[ED#136]
|
||
MOVEI SWT,0 ;CLEAR SWITCH REGISTER [ED#136]
|
||
;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
|
||
;**;[137] Add after DISPTB+12 Lines PY 15-Jun-84
|
||
XWD " ",BSPACE ;[137] IGNORE SPACE AS BREAK CHARACTER
|
||
DISPLN==.-DISPTB
|
||
JRST SYNTAS ;ILLEGAL CHARACTER
|
||
|
||
;**;[137] Add before BUILD PY 15-Jun-84
|
||
;[137] HANDLE SPACE
|
||
|
||
BSPACE: ILDB CH,T1 ;[137] GET THE NEXT CHARACTER
|
||
JRST BREAK ;[137] TRY AGAIN FOR BREAK
|
||
|
||
;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: GETPPN CC, ;GET OUR PPN
|
||
JFCL ;AVOID JACCT SKIP
|
||
PUSH P,CC ;AND SAVE IT
|
||
PUSHJ P,OCTIN ;GET PROJECT NUMBER
|
||
SKIPN CC ;SKIP IF A NUMBER TYPED
|
||
HLRZ CC,(P) ;ELSE USE OURS
|
||
HRLZM CC,DIRWRD(T) ;STORE AWAY
|
||
CAIE CH,"," ;VERIFY COMMA SEPARATOR
|
||
JRST [POP P,(P) ;PRUNE STACK
|
||
JRST SYNTAS] ;NO--ERROR
|
||
PUSHJ P,OCTIN ;GET PROGRAMMER NUMBER
|
||
SKIPN CC ;SKIP IF NUMBER TYPED
|
||
HRRZ CC,(P) ;ELSE USE OURS
|
||
HRRM CC,DIRWRD(T) ;STORE AWAY
|
||
POP P,(P) ;CLEAR PPN
|
||
CAIE CH,"," ;START OF PATH?
|
||
JRST .+3 ;NOPE
|
||
PUSHJ P,GETPTH ;GET IT
|
||
JRST SYNTAS ;IF ERROR
|
||
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
|
||
;GET PATH FROM INPUT
|
||
|
||
GETPTH: MOVEI CC,DIRPTH(T) ;GET ADDR OF PATH BLOCK
|
||
EXCH CC,DIRWRD(T) ;PUT IN PPN WORD AND GET PPN
|
||
MOVEM CC,DIRPTH+.PTPPN(T) ;STORE IN PATH BLOCK
|
||
HRLI T,-SFDLVL ;SET AOBJN LIMIT FOR SFD'S
|
||
GETPT1: PUSHJ P,SIXIN ;GET SFD FROM INPUT
|
||
JUMPE CC,CPOPJ ;ILLEGAL IF NULL
|
||
MOVEM CC,DIRPTH+.PTPPN+1(T) ;STORE IN PATH BLOCK
|
||
CAIE CH,"," ;MORE COMMING?
|
||
AOSA T ;INCREMENT POINTER FOR SETZM
|
||
AOBJN T,GETPT1 ;YES, LOOP IF NOT TOO MANY
|
||
SETZM DIRPTH+.PTPPN+1(T) ;ZERO FINAL WORD IN BLOCK
|
||
JRST CPOPJ1 ;GIVE SKIP RETURN
|
||
|
||
;ROUTINE TO GET NEXT SIXBIT NAME FROM INPUT
|
||
; RETURNS CPOPJ WITH NAME IN CC, BREAK CHAR IN CH
|
||
|
||
SIXIN: PUSH P,T ;SAVE T
|
||
MOVEI CC,0 ;CLEAR NAME
|
||
MOVE T,[POINT 6,CC] ;GET DESTINATION BYTE POINTER
|
||
SIXIN1: ILDB CH,T1 ;GET NEXT CHARACTER
|
||
CAIL CH,"A"+40 ;LOWER
|
||
CAILE CH,"Z"+40 ; CASE?
|
||
CAIA ;NO
|
||
SUBI CH,40 ;YES, CONVERT TO UPPER
|
||
CAIL CH,"0" ;VALID
|
||
CAILE CH,"Z" ; SYMBOL?
|
||
JRST TPOPJ ;NO
|
||
CAILE CH,"9"
|
||
CAIL CH,"A"
|
||
TRCA CH,"A"-'A' ;YES, CONVERT TO SIXBIT
|
||
JRST TPOPJ ;RETURN
|
||
TLNE T,770000 ;MORE ROOM IN THE WORD?
|
||
IDPB CH,T ;YES, STORE IT
|
||
JRST SIXIN1 ;AND LOOP
|
||
TPOPJ: POP P,T ;RESTORE T
|
||
POPJ P, ;AND RETURN
|
||
;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 BUFST+1 ;OUTPUT OPEN UUO ARRAY
|
||
OPENI: BLOCK BUFST+1 ;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
|
||
;**; [131] INSERT AFTER OBUF MFB 9-APR-80
|
||
LSTSYM: BLOCK 1 ;[131] LAST PARTIALLY DEFINED SYMBOL
|
||
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
|
||
|