Trailing-Edge
-
PDP-10 Archives
-
BB-D868C-BM
-
4-sources/cref.mac
There are 43 other files named cref.mac in the archive. Click here to see a list.
TITLE CREF %53A(60) CROSS REFERENCE PROGRAM
SUBTTL BOWERING/RPG/PMH/NGP/TNH/TWE/HPW/ASM/RDH/ILG/JNG 3-Nov-77
;COPYRIGHT (C) 1974, 1975, 1976, 1977, 1978 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;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.
;THE VERSION OF CREF
VCREF==53 ;MAJOR CREF VERSION NUMBER
VWHO==0 ;WHO MADE EDIT
VMINOR==1 ;MINOR VERSION NUMBER
VEDIT==60 ;EDIT NUMBER
INTERNAL .JBVER
LOC <.JBVER==137>
BYTE (3) VWHO (9) VCREF (6) VMINOR (18) VEDIT
.REQUEST REL:HELPER
SUBTTL REVISION HISTORY
;17 ----- MODIFY FOR FORTRAN-10 VERSION 2
;20 ----- MODIFY THE DEC VERSION FOR FULL FAIL FEATURES REG 5/18/74
;21 ----- MODIFY FOR (ALGOL) LONG SYMBOLS DGS 3/13/75
;22 16016 CHECK SEQUENCE OF LINE NUMBERS ILG 4/18/75
;23 13344 ALLOW INPUT BUFFERS TO BE BIGGER THAN 200 WORDS ILG 11/8/74
;24 16636 FIX EOF <CRLF> PROBLEM SER 9/12/75
;25 16859 CHANGED EDIT 22 TO ALLOW MULTI-STATEMENT LINES SER 9/19/75
;26 17543 CHANGED EDIT 22 TO ALLOW MULTI-PROGRAM INPUT FILES EHM 10/28/75
;27 17596 FAIL FILES SKIP EDIT 21 TEST FOR LONG(ALGOL) SYMBOLS EHM 11/11/75
;30 ----- GENERAL COSMETIC EDITS (MAKE LISTING NEATER) 04-APR-76
;31 ----- GET RID OF .LOW FILE FROM TENEX GARBAGE 04-APR-76
;32 ----- ADD SFD CAPABILITY 04-APR-76
;33 ----- ADD COMMAND FILE CAPABILITY (@CREF.CCL, ETC) 05-APR-76
;34 ----- PUT ERROR MESSAGES IN UPPER/LOWER CASE 05-APR-76
;35 ----- CHANGE OVER TO "=" FROM "_" (NETWORK SYNTAX) 06-APR-76
;36 ----- CLEAN UP COMMAND HANDLING - OLD ALTMODES, ETC. 06-APR-76
;37 ----- TEACH CREF ABOUT COMMENTS (";") AND CONT ("-") 06-APR-76
;40 ----- TEACH CREF ABOUT /MESSAGE:(PREFIX,FIRST) 06-APR-76
;41 ----- CALL NON-BREAK CONTROL CHAR .LT. <LF> SYN ERROR 07-APR-76
;42 ----- ADD "?CRFUKS UNKNOWN SWITCH" 08-APR-76
;43 ----- DO RESCAN ON CCL ENTRY FOR ".CREF V=V/O/P" ETC. 08_APR-76
;44 ----- ADD DSK:SWITCH.INI SUPPORT 08-APR-76
;45 ----- PROBLEM WITH ".CREF A=B/R" TYPE COMMAND 08-APR-76
;46 ----- [33] BROKEN BY MOVING AROUND ERROR ROUTINES 02-MAY-76
;47 ----- READ SWITCH.INI FROM LOGGED-IN PPN (SCAN'S WAY) 02-MAY-76
;50 ----- DELETE ALL FILES IF MULTIPLE INPUT 05-MAY-76
;51 ----- MAKE ".CREF/H" EXIT, MORE STRINGENT SCANNING 05-MAY-76
;52 18277 ADDRESS CHECK ON FORTRAN MULTI-INPUT PROGS 06-MAY-76
;53 ----- [50] OVERZEALOUS, DELETE ONLY EXT OF .CRF, .LST 08-DEC-76
;START OF VERSION 53A
;54 22405 ALLOW DIFFERENTIAL LINE NUMBERS TO BE NEGATIVE, SO NON-
; MONOTONIC LINE NUMBERS WON'T BOTHER CREF. THIS REMOVES
; EDITS 22, 25, 26.
;55 ----- DON'T EAT TYPE-AHEAD IF NOTHING RETURNED FROM RESCAN.
;56 ----- FIX CREF'ING OF FAIL OUTPUT - BROKEN BY EDIT 22.
;57 ----- DON'T TRY TO PUT LISTING CREATION DATE IN THE FUTURE.
;60 ----- UPDATE COPYRIGHT DATE, AND RELEASE AS CREF %53A(60).
SUBTTL GLOBAL, ACCUMULATOR, AND OTHER DEFINITIONS
;EXTERNAL AND INTERNAL DECLARATIONS
EXTERNAL .JBFF, .JBREL
INTERNAL CREF
;ACCUMULATOR DEFINITIONS
AC0=0 ;THIS HAD BETTER ALWAYS BE ZERO!
TEMP=1
TEMP1=2
WPL=3 ;CONTAINS COUNT OF HOW MANY REFERENCES/LINE IN LISTING
RC=WPL
SX=4
BYTEX=5
BYTEM=6
TX=BYTEM
C=7
CS=10
LINE=11 ;HOLDS LINE #
FLAG=12
FREE=13 ;POINTS TO HIGH END OF INCREMENT BYTE TABLE
SYMBOL=14 ;POINTS TO ENTRY COUNT AT LOW END OF SYMBOL TABLE
TEMPX=15
IO=16 ;HOLDS FLAGS
P=17 ;PUSH DOWN POINTER
;COMMAND STRING ACCUMULATORS
ACTXT==0 ;STORES TEXT FOR DEVICES, FILENAMES, EXT.
ACDEV==1 ;DEVICE
ACFILE==2 ;FILE
ACEXT==3 ;EXTENSION
ACDEL==4 ;DELIMITER
ACPNTR==5 ;BYTE POINTER
ACPPN==6 ;HOLDS PROJ,PROG FOR COMMAND SCANNER
;C=7 ;INPUT TEXT CHARACTER
;CS=10
ACTMP==11 ;TEMP AC
TIO==15 ;HOLDS MTAPE FLAGS
;IO=16 ;CREF FLAGS SET BY COMMAND SCANNER
;P=17 ;PUSH DOWN POINTER
;USEFUL OPDEF'S
OPDEF PJRST [JRST] ;[24][30]
;CONDITIONAL ASSEMBLY SWITCHES
IFNDEF STANSW,<STANSW==0> ;SET TO 1 FOR STANFORD A.I. LAB FEATURES
IFN STANSW,<SEGSW==0> ;
IFNDEF SEGSW,<SEGSW==1> ;SET TO 1 FOR TWO-SEGMENT SHARABLE ASSEMBLY
IFNDEF TEMPC,<TEMPC==1> ;SET TO 1 TO ALLOW TMPCOR UUO
IFN SEGSW,< TWOSEG
RELOC 400000 > ;END IFN SEGSW,
IFE SEGSW,< RELOC 0> ;BACK TO RELOC AFTER LOC .JBVER
IFE STANSW,< EXTERN .HELPR >
;I/O CHANNELS
CTLI==1 ;CONTROL DEVICE NUMBER (INPUT)
CHAR==2 ;INPUT DEVICE NUMBER
LST==3 ;LISTING DEVICE NUMBER
SINI==4 ;[44] READ DSK:SWITCH.INI
;DEFINITIONS FOR LENGTHS OF LINES AND PAGES
WPLLPT==^D14 ;IN OUTPUT LPT LISTING, 14 REFERENCES/LINE
IFN STANSW,< WPLLPT==^D10 > ;(NARROW LPT)
WPLTTY==^D8 ;IN OUTPUT TTY LISTING, 8 REFERENCES/LINE
.LPP==^D53 ;LINES PER PAGE IN LISTING
;OTHER RANDOM DEFINITIONS
PDL==30 ;PUSH DOWN STACK LENGTH
HASH==145 ;HASH SIZE
TXTSIZ==^D32 ;SIZE OF COMMAND TEXT BUFFER
ERRSIZ==^D20 ;[40] SIZE OF ERROR BUFFER
TTRSIZ==^D20 ;[43] AREA FOR TTY RESCAN INPUT
PTHLEN==11 ;[32] LENGTH OF PATH BLOCK
IFN TEMPC,<.TCRDF==2> ;[33] TMPCOR READ & DELETE FUNCTION
IO.EOF==1B22 ;[44] EOF BIT FOR BUFFERED INPUT
DV.TTA==1B4 ;[37] DEVCHR BIT - DEVICE IS CONTROLLING TTY
.GTWCH==35 ;[40] GETTAB FOR WATCH BITS
JW.WMS==7B11 ;[40] /MESSAGE LEVEL
JW.WCN==1B9 ;[40] /MESSAGE:CONTINUATION
JW.WFL==1B10 ;[40] /MESSAGE:FIRST
JW.WPR==1B11 ;[40] /MESSAGE:PREFIX
;DEFINITIONS NECESSARY FOR TENEX FILE SYSTEM FEATURES.
OPDEF COMPT. [CALLI 147]
CP.OPN==1 ;OPEN FUNCTION
CP.REN==2 ;RENAME FUNCTION
CP.PPN==3 ;PPN TO DIRECTORY FUNCTION
CP.RUN==4 ;RUN UUO SIMULATION
CP.MON==4 ;FIRST MONITOR WITH COMPT.
CP.NAM==5 ;NAMING FUNCTION
;BIT DEFINITIONS FOR FLAGS IN ACCUMULATOR "IO"
IOLST== 000001 ;IF 1, SUPPRESS PROGRAM LISTING
IOSAME==000002 ;SET TO 1 WHEN NEXT SYMBOL TO OUTPUT NEEDS A BLOCK NAME
IOPAGE==000004 ;IF 1, DO A FORM FEED
IOFAIL==000010 ;1 IF "NEW STYLE" CREF DATA HAS BBEN SEEN
IODEF== 000020 ;1 IF SYMBOL IS A DEFINING OCCURRANCE
; IOENDL==000040 ;REPLACED BY M0XCT FEATURE
IORSCN==000040 ;[43] IN (OR NEED) RESCAN FOR CCL ENTRY
IOCCL== 000100 ;1 IF CCL SYSTEM IN USE (SET BY STARTING AT (.JBSA)+1)
IOTABS==000200 ;"RUBOUT A" SEEN AT END OF CREF DATA (INSERT TAB IN LISTING)
IOEOF== 000400 ;END OF FILE SEEN
IOSINI==001000 ;[44] WE'RE PROCESSING SWITCH.INI
; IONLZ==001000 ;LEADING ZERO TEST, HANDLED BY RECODING OUTASC
IOTB2== 002000 ;FOR F4
IOLSTS==004000 ;SET IF PROGRAM OUTPUT IS BEING SUPPRESSED
IOERR== 010000 ;IMPROPER INPUT DATA SEEN
; ROOM FOR ANOTHER
IOSYM== 040000 ;SYMBOL DEFINED WITH = OR :
IOMAC== 100000 ;MACRO NAME
IOOP== 200000 ;OPDEF, OP CODE, OR PSEUDO INSTRUCTION OCCURRANCE
IOPROT==400000 ;1 IF INPUT 'CRF' OR 'LST' FILE IS PROTECTED BY /P SWITCH
IODF2== 020000 ;DEFINING OCCURRANCE OF A SYMBOL. FLAG IN REGISTER SX ONLY!
;FLAGS USED IN AC TIO
TIORW==1000 ;MTAPE REWIND FLAG
TIOLE==2000 ;SET(BUT NOT USED ANYWHERE) BY BACKSPACE REQUEST
TIOCLD==20000 ;CLEAR DIRECTORY FLAG
;DEFINITIONS FOR "OLD STYLE" CODES FROM VARIOUS PROCESSORS
%OP==33
%EOF==37 ;MULTIPLE-PROGRAM BREAK CHARACTER
;DEFINITION FOR "NEW STYLE" CODES
I.BEGN=="B" ;[17] ALL NEW STYLE CREF INFO BEGINS WITH
;[17] <RUBOUT>B
I.FTAB=="A" ;[17] END CREF INFO WITH LINE # AND TAB
I.FNTB=="C" ;[17] END CREF INFO WITH LINE # BUT NO TAB
I.FINV=="D" ;[17] DO NOT PRINT ANYTHING AFTER CREF INFO
I.BRK=="E" ;[17] SUBROUTINE BREAK - OUTPUT CURRENT
;[17] INFORMATION NOW AND RESET
I.NLTB=="F" ;[21] NO LINE NUMBER, NO TAB
;[45] SYMBOLS FOR ALL THE SWITCHES
;[45] LEFT HALF, "/A" TO "/R"
SWT.AA==1B00 ;A - ADVANCE ONE FILE
SWT.BB==1B01 ;B - BACKSPACE ONE FILE
SWT.CC==1B02 ;C - CANCEL SWITCH.INI SWITCH DEFAULTING
SWT.DD==1B03 ;D - DEFAULTS (I.E., SWITCH.INI SWITCH DEFAULTING)
SWT.EE==1B04 ;E - UNDEFINED
SWT.FF==1B05 ;F - UNDEFINED
SWT.GG==1B06 ;G - UNDEFINED
SWT.HH==1B07 ;H - HELP (UNDEFINED IF STANSW .EQ. 0)
SWT.II==1B08 ;I - UNDEFINED
SWT.JJ==1B09 ;J - UNDEFINED
SWT.KK==1B10 ;K - KILL (SUPPRESS) SYMBOL TABLE LISTING
SWT.LL==1B11 ;L - UNDEFINED
SWT.MM==1B12 ;M - SUPPRESS MACRO TABLE LISTING
SWT.NN==1B13 ;N - UNDEFINED
SWT.OO==1B14 ;O - OPCODE TABLE LISTING (ENABLE)
SWT.PP==1B15 ;P - PRESERVE INPUT FILES (DON'T DELETE THEM)
SWT.QQ==1B16 ;Q - UNDEFINED
SWT.RR==1B17 ;R - RESTART LISTING @ USER SPECIFIED LINE NUMBER
;[45] LEFT HALF, "/S" TO "/Z"
SWT.SS==1B18 ;S - SUPPRESS PROGRAM LISTING (ONLY LIST SYMBOL TABLES)
SWT.TT==1B19 ;T - ADVANCE TO END OF TAPE
SWT.UU==1B20 ;U - UNDEFINED
SWT.VV==1B21 ;V - UNDEFINED
SWT.WW==1B22 ;W - REWIND TAPE
SWT.XX==1B23 ;X - UNDEFINED
SWT.YY==1B24 ;Y - UNDEFINED
SWT.ZZ==1B25 ;Z - ZERO DECTAPE DIRECTORY
;MNEMONIC FOR ERROR MESSAGES
;MNEMONIC SEVERITY MEANING
;CRFIDC WARNING IMPROPER INPUT DATA
;CRFPUE WARNING PLEASE USE "=" RATHER THAN "_"
;CRFSIH WARNING /H OR /R ILLEGAL IN SWITCH.INI ([44])
;CRFSII WARNING SYNTAX ERROR IN SWITCH.INI ([44])
;CRFSIO WARNING I/O READ ERROR IN SWITCH.INI ([44])
;CRFRLL INFORMATION ASKS USER FOR LINE # TO RESTART LISTING ([45])
;CRFXKC INFORMATION SIZE OF LOW SEGMENT IN K OF CORE
;CRFCFF FATAL CANNOT FIND FILE
;CRFCFE FATAL COMMAND FILE INPUT ERROR
;CRFINE FATAL INPUT ERROR
;CRFOUE FATAL OUTPUT ERROR
;CRFDNA FATAL DEVICE NOT AVAILABLE
;CRFCEF FATAL CANNOT ENTER FILE
;CRFIMA FATAL INSUFFICIENT MEMORY AVAILABLE
;CRFCME FATAL COMMAND ERROR
;CRFCDN FATAL CAN'T GET CMD FILE DEVICE ([33])
;CRFCLC FATAL CAN'T LOOKUP COMMAND FILE ([33])
;CRFCFI FATAL CAN'T FIND INPUT FILE
;CRFUKS FATAL UNKNOWN SWITCH ([42])
;CRFIBP FATAL INPUT BUFFER SIZE PHASE ERROR
SUBTTL INITIALIZATION
CREF0: TLNN IO,IOCCL ;IF OPEN FAILED IN CCL, START OVER
EXIT ;IF OPEN FAILED NOT IN CCL, THEN EXIT
CREF: TDZA IO,IO ;START HERE FROM (.JBSA)
MOVSI IO,IOCCL ! IORSCN ;[43] START HERE FROM (.JBSA)+1
MOVE P, [IOWD PDL, PPSET] ;[44] SETUP STACK
RESET ;CLEAR IO AND INITIALIZE .JBFF
SETZM BZCOR ;[37] START OF TO-BE-ZERO'ED AREA
MOVE ACTMP, [BZCOR,,BZCOR+1] ;[37] BLT POINTER TO
BLT ACTMP, STCLR - 1 ;[37] ZERO INITIAL CORE AREA
GETPPN ACTMP, ;[32] GET MY PPN
JFCL ;[32] BLOODY JACCT BIT!!!!!
MOVEM ACTMP, MYPPN ;[32] SAVE AWAY FOR FUTURE REFERENCE
HRROI ACTMP, .GTWCH ;[40] NEED TO GET THE WATCH BITS
GETTAB ACTMP, ;[40] IN CASE OF ERRORS
SETO ACTMP, ;[40] ???
TLNN ACTMP, (JW.WMS) ;[40] WHOLE FIELD NULL?
TLO ACTMP, (JW.WPR!JW.WFL) ;[40] YES - DEFAULT /MES:(PRE,FIR)
MOVEM ACTMP, MYWCH ;[40] AND SAVE FOR FUTURE REFERENCE
HRROI ACTMP,[ASCIZ /CRF/]
MOVEM ACTMP,EXTNAM ;SET UP ARGS
HRROI ACTMP,TXTHLD
MOVEM ACTMP,OUTARG+2 ;""
MOVE ACTMP,[1,,FLAG]
;[43] THIS MUST BE A BUG - THERE'S
;[43] NO MOVEM, NO REFERENCES . . .
PUSHJ P, DOSINI ;[44] GO DO SWITCH.INI DEFAULTS
TLNN IO, IORSCN ;[43] NEED DO A RESCAN?
JRST REGSET ;[43] NO - REGULAR (.R CREF) ENTRY
;**;[55] Insert @ CREF+26L JNG 10-Apr-77
RESCAN 1 ;[55] YES - PREPARE TO READ THE
SKPINL ;[43] MAKE SURE SOMETHING THERE
JRST NORSCN ;[43] BZZZZT! NOTHING IN TTY BUFFER?
SETOB FLAG, CTIBUF + 1 ;[43] USER'S TYPED COMMAND
PUSHJ P, TTISIX ;[43] EAT THE ".CREF" PART FIRST
;[43] SHOULD SEE IF "CREF" ?????
CAIN C, 12 ;[43] ANYTHING ELSE ON LINE?
JRST NORSCN ;[43] NO - JUST DO REGULAR CCL STUFF
PUSHJ P, TTRSCN ;[43] BUILD MASK OF SWITCHES
JRST TTRSXX ;[43] OOPS - FILE SPECS THERE TOO!!!
TLNE ACTXT, (SWT.HH) ;[45] WAS THERE A "/H" ???
JRST HELP43 ;[43] YES - SIGH - ZAP THE WORLD
TLZE ACTXT, (SWT.RR) ;[45] "/R" SEEN?????
SETOM RRFLAG ;[45] YES - MUST BE KEPT SEPERATE
MOVEM ACTXT, TTRSWT ;[43] REMEMBER STICKY SWITCHES
NORSCN: TLZ IO, IORSCN ;[43] AND DO NORMAL CCL STUFF
IFN TEMPC,< SUBTTL TMPCOR PROCESSING FOR CCL ENTRY
;[43] *** FALL HERE FROM PREVIOUS PAGE ON CCL ENTRY ***
TLNN IO,IOCCL ;IS THIS A CCL TYPE CALL?
JRST REGSET ;[43] NO. SKIP READING TMPCOR
HRRZ AC0,.JBFF ;GET START OF BUFFER AREA
HRLI AC0,-200 ;-LENGTH IN LH FOR TMPCOR IOWD
MOVEM AC0,TMPFIL+1 ;STORE IT IN TMPCOR IOWD
SOS TMPFIL+1 ;MAKE IT CONFORM TO IOWD FORMAT
HRRZM AC0,CTIBUF+1 ;SET UP DUMMY BYTE POINTER
MOVE TEMP,.JBFF ;[20] MAKE SURE THERE'S ROOM ENOUGH
ADDI TEMP,200 ;[20]
CAMG TEMP,.JBREL ;[20] SKIP IF THERE'S NO ROOM ABOVE .JBFF
JRST TMP1 ;[20]
CORE TEMP, ;[20] ASK FOR MORE
JRST ERRCOR ;[20] LOSE
TMP1: MOVSI TEMP,'CRE' ;SETUP 2 WORD BLOCK FOR TMPCOR UUO
MOVEM TEMP,TMPFIL
MOVE TEMP,[XWD .TCRDF,TMPFIL] ;[33] SET UP FOR READ FROM CORE
TMPCOR TEMP, ;READ AND DELETE FILE "CRE"
JRST REGSET ;FILE NOT THERE, TRY THE DISK
ADD AC0,TEMP ;GET END OF BUFFER
MOVEM AC0,.JBFF ;DUMMY UP .JBFF
MOVEM AC0,SVJFF ;SAVE NEW .JBFF
IMULI TEMP,5 ;CALCULATE THE CHARACTER COUNT
ADDI TEMP,1 ;ADJUST CHARACTER COUNT BY 1 TO
;ACCOUNT FOR THE STANDARD READ ROUTINE
MOVEM TEMP,CTIBUF+2 ;DUMMY UP CHARACTER COUNT IN HEADER
MOVEI TEMP,440700 ;SET UP REST OF BYTE POINTER
HRLM TEMP,CTIBUF+1 ;HEADER NOW COMPLETE
SETOM TMPFLG
JRST RETCCL ;RETURN TO MAIN FLOW
> ;[43] IFN TEMPC
;[43] HERE IF USER TYPED MONITOR COMMAND OF FORM ".CREF A=B"
;[43] I.E., MORE THAN MERELY SWITCHES. MUST "FAKE IT"
TTRSXX: ADDI FLAG, <TTRSIZ * 5> + 1 ;[43] GET POSITIVE COUNT OF CHARS SO FAR
MOVEM FLAG, CTIBUF + 2 ;[43] FAKE COUNT
MOVE FLAG, [POINT 7, TTRBUF] ;[43] POINTER TO BUFFER
MOVEM FLAG, CTIBUF + 1 ;[43] FAKE THAT ALSO
SETOM LEAFLG ;[45] ONLY ONE LINE ALLOWED IN THIS MODE
JRST RETCCX ;[43] AND GO PROCESS AS IF NORMAL CCL
SUBTTL SETUP FOR COMMAND INPUT
;[43] HERE FOR BOTH CCL-DISK FILE (###CRE.TMP) AND REGULAR STYLE
;[43] COMMAND INPUT (.R CREF) FROM TTY:
REGSET: MOVEI TEMP,1 ;[43] OPEN FILE IN ASCII LINE MODE
MOVSI TEMP+1,'TTY'
TLNE IO,IOCCL ;USING CCL MODE?
MOVSI TEMP+1,'DSK' ;YES
MOVEM TEMP+1,CTIDEV ;SAVE DEVICE NAME
MOVEI TEMP+2,CTIBUF ;SET UP INPUT BUFFER HEADER ADDRESS
OPEN CTLI,TEMP ;OPEN INPUT COMMAND FILE
JRST CREF0 ;OPEN FAILURE, START OVER
INBUF CTLI,1 ;SET UP 1 INPUT BUFFER
HRRZ AC0,.JBFF
MOVEM AC0,SVJFF ;SAVE .JBFF
TLNN IO,IOCCL
JRST RETCCL ;NOT IN CCL MODE
;NOW, LOOKUP DSK:###CRE.TMP (WHERE ### IS THE 3-DIGIT DECIMAL JOB NUMBER.
;THAT FILE WILL BE USED FOR COMMAND INPUT. IF ANYTHING GOES WRONG, CREF
;IS RESTARTED AND IT WILL ACCEPT COMMANDS FROM USER'S TERMINAL
IFE STANSW,< MOVEI AC0,3 ;JOB # IS 3 CHARS LONG
PJOB TEMP, ;GET JOB #
CREF1: IDIVI TEMP,12
ADDI TEMP+1,"0"-40 ;CHANGE REMAINDER TO SIXBIT DIGIT
LSHC TEMP+1,-6 ;SHOVE DIGITS INTO TEMP+2
SOJG AC0,CREF1 ;3 DIGITS YET?
HRRI TEMP+2,'CRE'
MOVSI TEMP,'TMP' >;IFE STANSW
IFN STANSW,< MOVE TEMP+2,['QQCREF']
MOVSI TEMP,'RPG' >;IFN STANSW
MOVEM TEMP+2,CTIDIR ;SET UP ###CRE
MOVEM TEMP,CTIDIR+1 ;SET UP EXTENSION
SETZM CTIDIR+3 ;CLEAR PROJ,PROG
LOOKUP CTLI,CTIDIR ;DO LOOKUP ON COMMAND FILE
JRST CREF ;FILE ###CRE.TMP NOT FOUND
;[43] *** CAN FALL HERE FROM LOOKUP OF ###CRE.TMP ***
;THE END OF ONE CCL COMMAND LINE AND THE BEGINNING OF THE NEXT
;RETURNS TO HERE. THE INPUT COMMAND BUFFER IS PRESERVED. THE
;OUTPUT AND INPUT FILE BUFFERS ARE RECLAIMED PRIOR TO PROCESSING
;THE NEXT CCL COMMAND LINE.
RETCCL: SKIPE LEAFLG ;[43] NEED TO EXIT INSTEAD?
JRST LEAVE ;[43] YES - SO GO EXIT
HRRZ 0,SVJFF ;GET THE SAVED .JBFF
MOVEM 0,.JBFF ;RESTORE .JBFF
CORE 0, ;(POSSIBLY SHRINK TO ORIGINAL SIZE)
JRST CREF ;HOW COULD YOU LOSE?
RETCCX: TLO IO, IOPAGE!IOSYM!IOMAC ;[43] SET DEFAULT FLAGS
SETZM STCLR ;CLEAR FIXED DATA AREA
MOVE 0,[XWD STCLR,STCLR+1]
BLT 0,ENDCLR
IFN SEGSW,< ;[31]
MOVE 0, [TNXHGH,,TNXLOW] ;[31] GET BLT POINTER
BLT 0, TNXLOW + TNXLEN - 1> ;[31] SET UP RUN AND OTHER STUFF
MOVE P,[IOWD PDL,PPSET] ;INIT PUSH DOWN LIST POINTER
HLLOS UPPLIM ;ASSUME VERY LARGE UPPER LIMIT
MOVE AC0,[TDNN IO,SX] ;SETUP M6X
MOVEM AC0,M6X ;SKIP IF WE'RE CREFING THIS KIND OF SYM
TLNN IO,IOCCL ;SKIP IF IN CCL MODE.
OUTSTR [ASCIZ/
*/] ;LOOK READY FOR A COMMAND
MOVSI ACDEV,'LPT'
MOVEM ACDEV,LSTDEV ;DEFAULT LIST DEVICE IS LPT:
MOVSI ACEXT,'LST' ;DEFAULT EXTENSION IS "LST"
MOVEM ACEXT,LSTDIR+1
SUBTTL INITIALIZATION - LSTSET - SETUP DESTINATION DEVICE
LSTS00: PUSHJ P,NAME1 ;[43] GET NEXT DEVICE
CAIN C, "@" ;[33] COMMAND FILE NEEDED?
JRST CMDFIL ;[33] YES - SWITCH COMMAND INPUT
CAIN C,"!" ;RUN ON NEXT PROGRAM?
JRST RUNUUO ;YES
CAIE C,"=" ;[35] LISTING DEVICE SPECIFIED?
JRST LSTS2 ;NO
JUMPN ACDEV,LSTS1 ;USE SPECIFIED DEVICE. BUT IF
MOVSI ACDEV,'DSK' ;DEVICE NULL, USE DSK IF
SKIPE ACFILE ;A FILE IS SPECIFIED
LSTS1: MOVEM ACDEV,LSTDEV ;SAVE DEVICE NAME
MOVEM ACFILE,LSTDIR ;STORE FILE NAME
SKIPE ACEXT ;EXTENSION NULL?
HLLZM ACEXT,LSTDIR+1 ;[57]
JUMPE ACPPN, LSTS1A ;[32] 0 IS OK - DEFAULT
TLNE ACPPN, -1 ;[32] EXTENDED PATH?
JRST LSTS1A ;[32] NO - DON'T WORRY 'BOUT IT
MOVSI ACTMP, (ACPPN) ;[32] YES - MUST NEEDS
IORI ACTMP, LSTPTH ;[32] COPY IT OVER
BLT ACTMP, LSTPTH + PTHLEN - 1 ;[32] SO DON'T LOSE IT
MOVEI ACPPN, LSTPTH ;[32] USE IT AS PPN NOW
LSTS1A: MOVEM ACPPN,LSTDIR+3 ;[32] SET UP PROJ,PROG NUMBER
LSTS2: MOVE ACTMP,[TXTBUF,,TXTHLD]
BLT ACTMP,TXTHLD+TXTSIZ-1 ;MOVE NAME
CAIN C,"=" ;[35] OUTPUT NAME SPECIFIED?
JRST MADEIT ;YES. GO ON
HRROI ACTMP,[ASCIZ/ LPT:/] ;NO. GET DEFAULT
MOVEM ACTMP,OUTARG+2 ;TO ARG BLOCK
MADEIT: MOVEM TIO,OFLAG ;SAVE SWITCHES
MOVEM CS,OFLAG1
MOVEM C,OFLAG2
CAIN C,"=" ;[35] OUTPUT SPEC?
PUSHJ P,NAME1 ;GET NEXT COMMAND NAME
INSET1: TLNE IO,IOCCL ;IN CCL MODE?
OUTSTR [ASCIZ /CREF:/] ;YES. TYPE OUR NAME
INSET2: SETOM NOIOJF ;[51] SET FLAG TO WAIT ON INBUF
;[51] SINCE MUST NOT SET IOJFF
;[51] TILL OUTPUT IS SETUP.
PUSHJ P,INFILE ;DO INPUT OPEN AND LOOKUP
JRST [TLNN IO,IOCCL ;LOOKUP FAILURE
JRST CREF ;NOT IN CCL MODE, START OVER
MOVE C,CMDTRM
CAIE C,"," ;WAS FILE TERMINATOR A COMMA?
JRST CCLFN3 ;NO,LOOK FOR NEXT CCL LINE
PUSHJ P,NAME1 ;YES, LOOK FOR NEXT FILE
JRST INSET2 ] ;AND GO LOOK IT UP
SETZM NOIOJF ;[51] NOW CLEAR FLAG LEST WE FORGET
MOVE TIO,OFLAG ;GET FLAGS BACK
MOVE CS,OFLAG1
MOVE C,OFLAG2
MOVE ACTXT,[CHAR,,CP.NAM] ;GET NAME OF IN FILE
HRROI ACTXT+1,TXTBUF ;WHERE NAME WULL GO
MOVSI ACTXT+2,(1B8) ;NAME ONLY
MOVE ACTMP,[3,,ACTXT]
COMPT. ACTMP, ;GET THE NAME
JRST DOOPN ;[51] FAILED - GO TRY OPEN
MOVE ACTMP,[ASCIZ /LPT/] ;[T20-40] DEFAULT
MOVEM ACTMP,LSTNM1 ;[T20-40] TO DEFAULT BLOCK
SKIPN LSTDEV ;[T20-40] HAVE A LIST DEVICE?
JRST NOLSTD ;[T20-40] NO
MOVE ACTMP,[POINT 6,LSTDEV] ;[T20-40] YES. CONVERT
MOVE ACTMP+1,[POINT 7,LSTNM1];[T20-40] WHERE TO PUT ASCII
CNVT: ILDB ACTMP+2,ACTMP ;[T20-40] GET BYTE
JUMPE ACTMP+2,CNVTD ;[T20-40] DONE
ADDI ACTMP+2,40 ;[T20-40] MAKE IT ASCII
IDPB ACTMP+2,ACTMP+1 ;[T20-40] STORE IT
TLNE ACTMP,770000 ;[T20-40] DONE ALL SIX?
JRST CNVT ;[T20-40] NO DO ALL
SETZ ACTMP+2, ;[T20-40] YES. DONE THEN
CNVTD: IDPB ACTMP+2,ACTMP+1 ;[T20-40] TIE IT OFF
NOLSTD: MOVE ACTMP,[10,,OUTARG] ;[T20-40] DO OUT ARG
COMPT. ACTMP, ;OPEN OUT FILE
JRST DOOPN ;[51] ??!!FAILED!!??
JRST GDOPN ;MADE IT. GO ON
DOOPN: MOVEI ACTMP,0 ;INIT DEVICE IN ASCII MODE
MOVE ACTMP+1,LSTDEV ;GET DEVICE NAME
MOVSI ACTMP+2,LSTBUF ;BUFFER HEADER ADDRESS
OPEN LST,ACTMP ;TRY TO INIT DEVICE
JRST ERRAVL ;OPEN FAILED
SETZ ACTMP, ;ENTER NEEDED
GDOPN: PUSH P,ACTMP ;SAVE THIS FOR LATER
OUTBUF LST,2 ;MAKE BUFFERS
MOVEI ACTMP+1,LST ;USE CHANNEL NYMBER
DEVCHR ACTMP+1, ;GET OUTPUT DEVICE CHARACTERISTICS
MOVEI ACTMP,WPLLPT ;ASSUME LINES FOR LPT
TLNE ACTMP+1,10 ;IS DEVICE REALLY TTY?
MOVEI ACTMP,WPLTTY ;YES. SET UP LINES FOR TTY
MOVEM ACTMP,.WPL ;SAVE NUMBER OF ENTRIES/LINE
TLNE ACTMP+1,10 ;SKIP IF NOT TTY
SKIPA ACTMP,[CAIE C,12] ;WRITE LINE-BY-LINE ON TTY.
MOVSI ACTMP,(<POPJ P,>)
MOVEM ACTMP,WRITEX ;SET INSTR. TO XCT TO EXIT FROM WRITE.
TLNN ACTMP+1,20 ;MAG TAPE?
JRST LSTSE4 ;NO. AVOID RANDOM TESTS AND MTAPES
TLZE TIO,TIORW ;REWIND REQUESTED?
MTAPE LST,1 ;YES
TLZE TIO,TIOLE
MTAPE LST,10 ;ADVANCE TO END OF TAPE
JUMPGE CS,LSTSE3
MTAPE LST,17 ;BACKSPACE MTA
AOJL CS,.-1 ;IF COUNT IS NEG., BACKSPACE AGAIN
MTAPE LST,0 ;[20] SOME CRETINS DON'T READ MANUALS.
;[20] WAIT FOR TAPE TO STOP SO LOAD
;[20] POINT CAN BE SENSED
STATO LST,1B24 ;SKIP IF AT LOAD POINT-
;THIS PUTS TAPE ON CORRECT SIDE OF EOF
MTAPE LST,16 ;SPACE FORWARD 1 FILE
LSTSE3: SOJGE CS,.-1 ;[20] LOOP UNTIL POS. COUNT RUNS OUT
;[45] *** FALL HERE FROM PREVIOUS PAGE ***
;FOR MTA OUTPUT WE NEED TO TEST IOEOT WHICH IS NOT TESTED BY AN OUT UUO.
;THEREFORE, WE CALL A ROUTINE TO DO OUTPUT, STATZ FOR EVERY BUFFER.
;IN ALL OTHER CASES, WE MINI-OPTIMIZE BY DOING ONLY ONE UUO.
SKIPA ACTMP,[PUSHJ P,DMPOUT] ;SET OUTPUT INSTR. FOR MTA
LSTSE4: MOVSI ACTMP,(<OUT LST,>) ;OUTPUT INSTRUCTION FOR ALL EXCEPT MTA.
MOVEM ACTMP,DMPXCT ;SET OUTPUT INSTRUCTION
TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED?
UTPCLR LST, ;YES.
POP P,FLAG ;DOI COMPT. WORK FLAG
SKIPE FLAG ;COMPT. WORKED?
JRST INSET3 ;YES. DONT DO ENTER
MOVE ACFILE,INDIR ;GET INPUT FILENAME
SKIPN LSTDIR ;LISTING FILENAME NULL?
MOVEM ACFILE,LSTDIR ;MAKE IT SAME AS INPUT FILENAME
IFN STANSW,< MOVSI ACFILE,400000 ;AT STANFORD, SET DUMP NEVER BIT
MOVEM ACFILE,LSTDIR+2 >
ENTER LST,LSTDIR ;INPUT FILE FOUND, ENTER OUTPUT FILE
JRST ERRENT ;ENTER FAILED FOR LISTING DEVICE
INSET3: SETO FLAG ;[45] IN CASE NEED NO INPUT
SKIPN FIRSTL ;[45] "/R" SWITCH SEEN?
JRST LSTS3 ;[45] NO - SEE IF A STICKY ONE AROUND
SKIPL LEAFLG ;[45] CCL-TTY-RESCAN ENTRY???
TLNN IO, IOCCL ;[45] CCL OR REGULAR ENTRY
JRST LSTS3A ;[45] REGULAR - PROMPT USER FOR LINE #
PUSHJ P, TTIDEC ;[45] CCL - NUMBER IN INPUT STREAM ALREADY
JRST LSTS4 ;[45] COMMON CODE . . .
LSTS3: SKIPN RRFLAG ;[45] STICKY "/R" FROM TTY RESCAN?
JRST LSTS7 ;[45] NO - JUST GO DO THE CREFFING
LSTS3A: PUSH P, CTIBUF + 2 ;[45] MUST PROMPT USER FOR INPUT
SETOM CTIBUF + 2 ;[45] SO MUST FORCE IMMED TTCALL'S
TLO IO, IORSCN ;[45] . . .
SKPINC ;[45] ZAP ^O, JUST IN CASE . . .
JFCL ;[45] . . .
PUSHJ P, LSTS5M ;[45] GIVE PROMPTING MESSAGE
PUSHJ P, TTIDEC ;[45] READ IN LINE NUMBER
TLZ IO, IORSCN ;[45] CLEAR THIS TTCALL FLAG
POP P, CTIBUF + 2 ;[45] RESTORE OTHER COUNT (MIGHT BE IN
;[45] COMMAND FILE BY NOW)
LSTS4: MOVEM ACTMP, FIRSTL ;[45] SET STARTING LINE NUMBER
JRST LSTS6 ;[45] AND GO DO CREFFING
LSTS5M: MOVEI RC, [[ASCIZ/%CRFRLL Restart listing at line: /]] ;[45]
PJRST PNTM0 ;[45] SEND OUT PROMPT MESSAGE
SUBTTL PROCESS CREF INPUT FILE
LSTS6: MOVEM ACTMP,FIRSTL ;SAVE DECIMAL NUMBER
SKIPA C,[JRST WRITE1] ;INITIAL WRITE-ENTRANCE INSTRUCTION
LSTS7: MOVE C,[SOSG LSTBUF+2] ;SET UP WRITE ENTRANCE INSTRUCTION
MOVEM C,WRITEE
MOVE C,.JBFF ;[51] NOW MAY SET IOJFF SINCE THE LISTING
MOVEM C,IOJFF ;[51] BUFFERS ETC. ARE SAFELY ENSCONCED
;[51] BELOW .JBFF/IOJFF
INBUF CHAR,2 ;[51] NOW - DO THE DELAYED INBUF
MOVEI FREE,BLKST-1
MOVEM FREE,BLKND ;INITIALIZE FOR COMBG
MOVE C,.JBFF ;[52] SAVE FOR FORTRAN MULTI STUFF
MOVEM C,FRJFF ;[52] AND CRFIBP CHECK
RECYCL: HRRZ FREE,.JBFF ;RETURN FOR MULTIPLE F4 PROGS
ADDI FREE,1
TRZ FREE,1 ;MAKE SURE FREE STARTS OUT EVEN
MOVEM P,PPSAV ;SAVE P IN CASE OF IMPROPER INPUT DATA
;**;[54] Remove edit 26 @ RECYCL+4L JNG 24-Mar-77
SETZM FSTPNT#
MOVEI LINE,1
CAMGE LINE,LOWLIM
TLO IO,IOLST ;WE DON'T WANT LISTING YET. LOWLIM>LINE
TLNN IO,IOLST ;LISTING SUPPRESSED?
SKIPA C,[WRITE]
MOVEI C,CPOPJ
MOVEM C,AWRITE ;WRITE BY PUSHJ P,@AWRITE.
MOVSI C,(<JFCL>)
MOVEM C,M0XCT ;SET UP INSTRUCTION FOR M0
PUSHJ P,READ ;TEST FIRST CHARACTER
CAIE C,%EOF ;PROGRAM BREAK?
JRST M2A ;NO, PROCESS
JRST M2 ;YES, BYPASS
NOTINF: SKIPA TEMP,[177] ;HERE TO INSERT RUBOUT (WASN'T NEW FORMAT)
M0A: MOVEI TEMP,11 ;HERE TO INSERT TAB
EXCH C,TEMP
PUSHJ P,@AWRITE
MOVSI C,(<JFCL>)
MOVEM C,M0XCT ;SET UP INSTRUCTION FOR M0
MOVEI C,(TEMP)
M0: XCT M0XCT ;WRITE NORMAL CHARACTER. (JFCL, OR JRST M0A)
M1: PUSHJ P,@AWRITE ;WRITE CHARATER
M2: PUSHJ P,READ ;READ NEXT
M2A: CAIN C,177 ;RUBOUT?
JRST FAILM ;YES. PROBABLY NEW STYLE CREF
CAILE C,%EOF ;MIGHT THIS BE A SPECIAL CHARACTER.
JRST M0 ;NO WAY. THIS HAS TO BE NORMAL.
CAIL C,%OP ;IN RANGE FOR OLD-STYLE CREF?
JRST M2C ;YES. SPECIAL CHARACTER FOR OLD-STYLE CREF
CAIN C,12 ;LF?
JRST M1 ;PASS IT DIRECTLY
CAIE C,15 ;CR?
JRST M0 ;NO. THIS IS NOT ANY SPECIAL CHARACTER.
MOVE TEMP,[JRST M0A]
TLNE IO,IOTABS!IOTB2 ;HANDLE CR. TAB FLAGS ON?
MOVEM TEMP,M0XCT ;YES. ARRANGE TO WRITE TAB LATER
JRST M1 ;GO WRITE CR.
;DISPATCH FOR OLD-STYLE CREF. XCT'ED FROM M2C+4
MTAB: MOVSI SX,IOOP ;33 OPCODE REF
MOVSI SX,IOMAC ;34 MACRO REF
SKIPA C,LINE ;35 END OF LINE
MOVSI SX,IOSYM ;36 SYMBOL REF
JRST R0 ;37 BREAK BETWEEN PROGRAMS
;HERE FOR OLD-STYLE CREF FORMAT
M2C: TLNE IO,IOFAIL ;ARE WE DOING NEW-STYLE ALREADY?
JRST M0 ;YES. THEN THESE AREN'T SPECIALS
MOVSI TEMP,(<JFCL>)
MOVEM TEMP,M0XCT ;SEEN TEXT ON LINE. FLUSH TAB INSERTION INSTR.
TLO IO,IOTB2 ;NEED TAB
XCT MTAB-%OP(C) ;(CAN SKIP)
JRST M3 ;FLAG SET. GOBBLE SYMBOL NAME
M2B: TLNE IO,IOLSTS ;PERMANENT LISTING SUPPRESS?
AOJA LINE,M2 ;YES. JUST INCREMENT LINE AND READ MORE
CAML LINE,LOWLIM ;LINE ABOVE LOWER LIMIT?
CAMLE LINE,UPPLIM ;YES. SKIP IF BELOW HIGH LIMIT
TLOA IO,IOLST ;ASSUME OUT OF BOUNDS
TLZA IO,IOLST ;LINE IN BOUNDS, CLEAR LISTING SUPPRESS
SKIPA TEMP,[CPOPJ] ;SUPPRESS OUTPUT
MOVEI TEMP,WRITE
MOVEM TEMP,AWRITE ;PUSHJ P,@AWRITE TO OUTPUT A CHARACTER
TLNE IO,IOLST
AOJA LINE,M2
PUSHJ P,CNVRT ;WRITE LINE NUMBER
MOVEI C,11
TLNE IO,IOTABS ;NEED TO DO TABS?
PUSHJ P,WRITE ;YES. WRITE A TAB
AOJA LINE,M2
;OLD STYLE-CREF. GOBBLE SYMBOL
M3: MOVEI AC0,0 ;ACCUMULATE SIXBIT LEFT ADJUSTED IN AC0
MOVSI TEMP,440600 ;BYTE POINTER TO AC0
M4: PUSHJ P,READ ;GET CHARACTER.
CAIGE C,40
JRST M5A ;NOT SIXBIT. THIS BREAK DEFINES END OF SIXBIT
SUBI C,40 ;CONVERT ASCII TO SIXBIT
TLNE TEMP,770000 ;SKIP IF AC0 FULL
IDPB C,TEMP ;STUFF CHARACTER
JRST M4
ERROR: MOVE P,PPSAV ;RESTORE P
TLOE IO,IOERR ;ANY ERRORS ALREADY?
JRST M2 ;YES. DON'T REPORT AGAIN
MOVEI RC, [[ASCIZ /%CRFIDC Improper input data at line /]] ;[34]
PUSHJ P,PNTMSG ;IDENTIFY MESSAGE
MOVE C,LINE ;TELL WHAT LINE #
PUSHJ P,ECNVRT
MOVEI RC, [[ASCIZ/, continuing/]] ;[34]
PUSHJ P,PNTM0 ;IDENTIFY MESSAGE.
OUTSTR CRLF
JRST M2 ;TRY TO CONTINUE
M5A: JUMPE AC0,ERROR ;ERROR IF ZERO
CAIN C,33 ;SPECIAL BREAK CHARACTER?
TLO IO,IODEF ;YES. THIS SYMBOL IS BEING DEFINED.
PUSH P,[M2] ;SET RETURN ADDRESS FROM M6/SRCH. FALL INTO M6
M6: XCT M6X ;TDNN IO,SX -- SKIP IF WE'RE CREFFING THIS
; KIND OF SYMBOL, OR,
; POPJ P, -- LISTING RANGE IS EMPTY.
POPJ P, ;NOT CREFFING THIS KIND OF SYMBOL
CAML LINE,LOWLIM
CAMLE LINE,UPPLIM
TDZA FLAG,FLAG ;OUT OF BOUNDS
MOVSI FLAG,400000 ;FLAG THAT SYMBOL WAS USED INSIDE RANGE OF INTEREST
SUBTTL SEARCH FOR A SYMBOL, ENTER ANOTHER REFERENCE
COMMENT $
There are 3 tables (symbols, opcodes, and macros). Each is indexed by
a hash code. The table entry points to a chain of symbol-entry blocks.
Each symbol-entry block is 4 words:
0/ Sixbit symbol name
1/ link-out to next
2/ byte(1)flag(17)lastline(18)refchain
3/ AUXHEAD,,AUXTAIL, later becoming: AUXHEAD,,block name addr
Flag is on if this symbol was ever seen within the line-limit range.
lastline: the last line number on which this symbol was used.
Auxhead and Auxtail are pointers to auxiliary refchains which must be
output before the main refchain.
the refchain points to a 2-word block:
0/ byte pointer to next rd
1/ byte(6)rfb,rd1,rd2(18)link to next refchain entry
subsequent 2-word blocks on the refchain contain 9 6-bit bytes of rd,
and an 18-bit link-out.
The rd are reference-data, which are differential line numbers, with a bit
to specify reference/definition. The rd are stored radix 32 (decimal), with
a bit in each 6-bit byte to specify continuation/lastbyte.
Differential line number =
2*(this line - last line where used) + if reference then 1 else 0
$
SRCH: MOVEI C,1 ;SET UP SOME BITS TO SAVE CODE AND TIME
TLZE IO,IODEF ; LATER
MOVEI C,2
MOVEM C,REFBIT ;2=DEFINING OCCURENCE, 1= REFERENCE
ANDI C,1
MOVEM C,REFINC ;0=DEFINING OCCURENCE, 1= REFERENCE
MOVE BYTEX,AC0 ;GET SIXBIT
TLNN BYTEX,770000 ; [21] POINTER TO LONG SYMBOL ?
MOVE BYTEX,(BYTEX) ; [21] YES - GET FIRST WORD.
IDIVI BYTEX,HASH
MOVMS TX
TLNE SX,IOOP ;SELECT APPROPRIATE TABLE
MOVEI TX,OPTBL(TX) ;SEARCH CORRECT ONE
TLNE SX,IOMAC
MOVEI TX,MACTBL(TX)
TLNE SX,IOSYM
MOVEI TX,SYMTBL(TX)
SKIPN SX,(TX) ;SEARCH FOR SYMBOL
JRST NTFND ;NONE THERE.
TLNN AC0,770000 ; [21] LONG SYMBOL ?
JRST LNSRCH ; [21] YES - DO SEPARATELY
CAMN AC0,(SX) ;MATCHES FIRST SYMBOL?
JRST STV10B ;YES. (AVOID MOVING SYM TO FRONT OF CHAIN)
SKIPN BYTEX,1(SX) ;ADVANCE TO NEXT.
JRST NTFND ;NOT FOUND.
SRCH1: CAMN AC0,(BYTEX) ;MATCH?
JRST STV9 ;YES. (BYTEX=CURRENT, SX=PREVIOUS)
SKIPN SX,1(BYTEX)
JRST NTFND
CAMN AC0,(SX) ;SEARCH HASH CHAIN FOR SYMBOL
JRST STV10 ;GOT IT (SX=CURRENT, BYTEX=PREVIOUS)
SKIPE BYTEX,1(SX) ;SEARCH NEXT (BYTEX=CURRENT, SX=PREVIOUS)
JRST SRCH1 ;KEEP LOOKING
NTFND: SKIPE SX,FSTPNT ;FAILURE. MAKE NEW ENTRY FOR THIS SYM.
JRST [MOVE BYTEX,1(SX) ;GET 4-WORD BLOCK FROM FREE STORAGE
MOVEM BYTEX,FSTPNT ;RESET FREE STG
JRST NTFND1]
MOVE SX,FREE ;OTHERWISE, GET 4-WORDS FROM END OF MEM.
ADDI FREE,4 ;GET A SPACE TO PUT NEW SYMBOL
CAML FREE,.JBREL
PUSHJ P,XCEED ;GET MORE CORE
NTFND1: MOVEM AC0,(SX) ;STORE SIXBIT FOR SYMBOL
MOVE BYTEX,(TX) ;GET FIRST LINK ON THIS CHAIN
MOVEM BYTEX,1(SX) ;STORE THAT IN OUR LINK-OUT
MOVEM SX,(TX) ;STORE OUR ADDRESS AT HEAD OF CHAIN
SETZM 3(SX)
MOVE TX,FREE ;NEXT, WE NEED A 2-WORD BLOCK
ADDI FREE,2
CAML FREE,.JBREL
PUSHJ P,XCEED
SETZM 1(TX)
MOVEI BYTEX,1(TX)
HRLI BYTEX,(<POINT 6,0,5>) ;POINTER FOR DEPOSITING RD (REF DATA)
MOVE C,REFBIT ;2=DEFINED, 1=REFERNCED
DPB C,[POINT 6,1(TX),5] ;DEPOSIT REFTYPE BITS
MOVE C,LINE
LSH C,1
IOR C,REFINC ;LINE*2+(IF REF THEN 1 ELSE 0); LAST REFLINE
HRLM LINE,2(SX) ;STORE LASTLINE ON WHICH REF OCCURED.
HRRM TX,2(SX) ;ADDRESS OF REFCHAIN
JRST STV12
LNSRCH: ; LONG SYMBOL - AC0 IS POINTER
; SX IS HEAD OF HASH-CHAIN
HLRZ C,AC0 ; [21] GET LENGTH
HLRZ TEMP,(SX) ; [21] GET LENGTH OF FIRST-OF-CHAIN
CAIE C,(TEMP) ; [21] = ?
JRST LNSRC1 ; [21] NO - NO CHANCE
PUSHJ P,COMPLN ; [21] YES - COMPARE NAMES
JRST STV10B ; [21] = - DON'T BOTHER TO MOVE TO HEAD
LNSRC1: MOVE BYTEX,SX ; [21] ADVANCE
SKIPN SX,1(SX) ; [21] TO NEXT
JRST NTFND ; [21] END OF CHAIN - NOT FOUND
HLRZ TEMP,(SX) ; [21] GET LENGTH
CAIE C,(TEMP) ; [21] SAME ?
JRST LNSRC1 ; [21] NO - TRY NEXT
PUSHJ P,COMPLN ; [21] YES - COMPARE NAMES
JRST STV10 ; [21] = - DONE
JRST LNSRC1 ; [21] NOT - TRY AGAIN
COMPLN: ; COMPARE LONG NAMES. POINTERS IN (SX) & AC0. SKIP IF NOT =.
; LENGTHS ARE = ON ENTRY, IN C (WORDS)
; PRESERVE BYTEX,SX,AC0, C(UNLESS =)
HRRZM AC0,L1 ; [21] SAVE ADDRESS 1
MOVE TEMP,(SX) ; [21] GET, &
HRRZM TEMP,L2 ; [21] SAVE ADDRESS 2
CMPLN1: MOVE TEMP,@L1 ; [21] COMPARE
CAME TEMP,@L2 ; [21] A WORD
JRST CMPLN2 ; [21] UNEQUAL
AOS L1 ; [21] ADVANCE
AOS L2 ; [21] ADDRESSES
SOJG C,CMPLN1 ; [21] & LOOP, UNLESS DONE
HRRZ C,AC0 ; [21] EQUAL - RETURN NEW BUFFER
HLRZ AC0,AC0 ; [21] C:=POINTER; AC0:=LENGTH;
LSH AC0,-2 ; [21] AC0:= # OF 4-WORD BLOCKS
CMPLN3: MOVE TEMP,C ; [21] ADDR OF 4-WORD BLOCK
EXCH TEMP,FSTPNT ; [21] CHAIN INTO
MOVEM TEMP,1(C) ; [21] FREE CORE CHAIN
ADDI C,4 ; [21] ADVANCE TO NEXT BLOCK,
SOJG AC0,CMPLN3 ; [21] IF ANY
POPJ P, ; [21] SAY EQUAL
CMPLN2: HLRZ C,AC0 ; [21] RESTORE C
AOS (P) ; [21] AND SKIP
POPJ P, ; [21] RETURN
;MOVE SX TO HEAD OF LIST.
STV9: EXCH SX,BYTEX ;MAKE SX=CURRENT, BYTEX=PREVIOUS
STV10: MOVE C,(TX) ;GET LIST-HEAD
EXCH C,1(SX) ;SAVE THAT IN OUR LINKOUT
MOVEM C,1(BYTEX) ;OUR OLD LINKOUT INTO PREVIOUS LINKOUT
MOVEM SX,(TX) ;OUR ADDRESS IN LIST HEAD
STV10B: LDB C,[POINT 17,2(SX),17] ;GET LINE NUMBER OF PREVIOUS REFERENCE
HRRZ TX,2(SX) ;POINTER TO REFCHAIN
CAME C,LINE ;LAST LINE THE SAME AS THIS LINE?
JRST STV10A ;NOPE.
LDB TEMP,[POINT 6,1(TX),5] ;GET THE REFERENCE TYPE BITS
TDOE TEMP,REFBIT ;TURN ON A BIT FOR THIS TYPE OF REFERENCE
POPJ P, ;THIS KIND OF REF EXISTS ALREADY.
JRST STV10C
STV10A: MOVE TEMP,REFBIT ;SET REFERENCE/DEFINITION TYPE
STV10C: DPB TEMP,[POINT 6,1(TX),5] ;STORE REFTYPE
DPB LINE,[POINT 17,2(SX),17] ;STORE CURRENT LINE NUMBER
SUBM LINE,C ;C_(CURRENT LINE-PREVIOUS REF LINE)
;**;[54] Insert @ STV10C+3L JNG 24-Mar-77
HRRZ C,C ;[54] MIGHT BE NEGATIVE, STORE
;[54] 18 BITS NOW & EXTEND LATER
LSH C,1 ;DOUBLE DIFFERENCE
IOR C,REFINC ;PLUS 1 IF REFERENCE
MOVE BYTEX,0(TX) ;GET THE BYTE POINTER
;HERE C= 2*(THIS LINE-PREVIOUS REF LINE)+(IF DEFINING THEN 0 ELSE 1)
;BYTEX=BYTE POINTER FOR RD (REF DATA)
;CONTENTS OF C ARE STORED AS RADIX =32 BYTES, WITH THE 40 BIT ON IN EVERY
;BYTE BUT THE LAST. THESE BYTES ARE STORED IN 6-BIT FIELDS.
STV12: ORM FLAG,2(SX) ;STORE FLAG (SIGN BIT)
CAIGE C,40
JRST STV20 ;SMALL OPTIMIZATION
MOVEM P,PPTEMP
STV14: IDIVI C,40
PUSH P,CS
CAIL C,40
JRST STV14
STV16: TRO C,40
PUSHJ P,STV20
POP P,C
CAME P,PPTEMP
JRST STV16
;HERE WITH C CONTAINING A BYTE OF REFERENCE DATA
STV20: TRNE BYTEX,1 ;SKIP END-TEST IF EVEN WORD
CAML BYTEX,[POINT 6,0,16] ;AT END?
JRST STV22 ;NOT AT END (OF 9-BYTE RD STRING)
HRRM FREE,0(BYTEX) ;STORE FREE POINTER INTO REFCHAIN
MOVE BYTEX,FREE ;SET BYTE POINTER TO POINT AT FREE
HRLI BYTEX,(<POINT 6,0>)
ADDI FREE,2 ;INCREMENT FREE POINTER
CAML FREE,.JBREL
PUSHJ P,XCEED
STV22: IDPB C,BYTEX ;STOW BYTE
MOVEM BYTEX,0(TX) ;AND BYTE POINTER
POPJ P,
SUBTTL HANDLE NEW-STYLE INPUT
;HERE TO READ A SYMBOL NAME
FREAD: PUSHJ P,READ ;READ A LABEL. GET CHARACTER COUNT
MOVEI TEMP1,(C) ;SAVE CHARACTER COUNT
SETZM FRDTMP ;ACCUMULATE SIXBIT HERE.
MOVE AC0,[POINT 6,FRDTMP] ;POINTER FOR 6-BIT DEPOSIT
FM4: PUSHJ P,READ ;GET A CHARACTER
SUBI C,40 ;CONVERT TO SIXBIT
TLNN AC0,770000 ; [21] IF WORD IS EXHAUSTED
JRST LNGSYM ; [21] GO HANDLE LONG SYMBOL
IDPB C,AC0 ;STUFF THIS CHARACTER
SOJG TEMP1,FM4 ;LOOP WHILE CHARACTER COUNT LASTS
JRST LB5 ;[51]
FAILM: PUSHJ P,READ ;177 SEEN. GET THE NEXT.
CAIN C,I.BRK ;[17] BREAK BETWEEN FORTRAN SUBROUTINES?
JRST R0 ;YES. FLUSH PRESENT CREF DATA AND REINITIALIZE
CAIE C,I.BEGN ;IS THIS THE START
JRST NOTINF ;NO. PUT THE 177 INTO THE OUTPUT STREAM
TLO IO,IOFAIL ;THIS IS A NEW-STYLE PROGRAM
FM2: PUSHJ P,READ ;GET NEXT
CAIN C,177 ;RUBOUT?
JRST TEND ;YES. CHECK FOR END
CAILE C,DTABLN ;IN RANGE?
JRST ERROR ;FOO!
XCT DTAB-1(C) ;EXCECUTE SPECIFIC FUNCTION
JUMPE SX,FM2 ;JUMP IF NO FLAGS WERE SET - GOBBLE MORE CREF DATA
TLZE SX,IODF2 ;DO WE WANT TO DEFINE IT?
TLO IO,IODEF ;YES, SET REAL DEFINITION FLAG
PUSHJ P,FREAD ;GET THE SYMBOL NAME
FM6: PUSHJ P,M6 ;GO ENTER SYMBOL
JRST FM2
TEND: MOVE AC0,SVLAB ;IS THERE A LABEL TO PUT IN?
JUMPE AC0,TEND1 ;NO.
SETZM SVLAB ;CLEAR SAVED LABEL
MOVSI SX,IOSYM
PUSHJ P,M6 ;PUT THE LABEL IN
TEND1: PUSHJ P,READ ;CHECK FOR VALID END CHARACTER
CAIN C,I.FINV ;
JRST M2 ;177D JUST GOBBLE CREF INFO BUT NO LINE NUMBER
MOVSI TEMP,(<JFCL>)
MOVEM TEMP,M0XCT ;INFORMATION WAS SEEN ON LINE. FLUSH TAB WRITER
CAIN C,I.NLTB ;[21] NO LINE NUMBER, NO TAB
JRST M2 ;[21] YES.
CAIN C,I.FTAB
TLOA IO,IOTABS ;TAB AFTER LINE NUMBER
CAIN C,I.FNTB ;OTHER LEGAL END CHARACTER?
SKIPA C,LINE ;LEGAL END CHARACTER. C GETS LINE NUMBER
JRST ERROR ;LOSE - ILLEGAL INPUT FORMAT
JRST M2B ;GO WRITE THE LINE NUMBER
;DISPATCH TABLE FOR SPECIAL CHARACTERS (1-17)
DTAB: JRST SETLAB ; ^A=1 PREVIOUS SYMBOL IS REFERENCED
JRST DLAB ; ^B=2 PREVIOUS SYMBOL IS DEFINED
MOVSI SX,IOOP ; ^C=3 OPCODE REFERENCE - GOBBLE NAME
MOVSI SX,IOOP!IODF2 ; ^D=4 OPCODE DEFINITION - GOBBLE NAME
MOVSI SX,IOMAC ; ^E=5 MACRO REFERENCE
MOVSI SX,IOMAC!IODF2 ; ^F=6 MACRO DEFINITION
SETZB SX,SVLAB ; ^G=7 FAIL TAKES BACK A MISTAKEN OCCURANCE
JRST COMBIN ; ^H=10 COMBINE TWO FIXUP CHAINS FOR FAIL
JRST DEFSYM ; ^I=11 DEFINE SYMBOL (CHANGE NUMBER TO NAME)
JRST ERROR ; ^J=12 LF
JRST DEFMAC ; ^K=13 DEFINE MACRO (CHANGE NUMBER TO NAME)
JRST ERROR ; ^L=14 FF
JRST BBEG ; ^M=15 BLOCK BEGIN
JRST BBEND ; ^N=16 BLOCK END
JRST SETLIN ; ^O=17 READ LINE NUMBER FROM FILE
DTABLN==.-DTAB
SUBTTL LONG SYMBOLS.
LNGSYM: PUSH P,TEMP ; [21] SAVE AN AC
MOVEI AC0,6(TEMP1) ; [21] ALLOW FOR 6 ALREADY DONE
IDIVI AC0,6 ; [21] LENGTH
SKIPE TEMP ; [21] IN
ADDI AC0,1 ; [21] WORDS
TRNE AC0,1 ; [21] MAKE IT EVEN *** MUST BE ***
ADDI AC0,1 ; [21]
TRNE AC0,2 ; [21] MAKE MULTIPLE OF 4
ADDI AC0,2 ; [21]
MOVE TEMP,FREE ; [21] GET
ADD FREE,AC0 ; [21] SOME
CAML FREE,.JBREL ; [21] CORE, IF
PUSHJ P,XCEED ; [21] NEEDED.
HRLZ AC0,AC0 ; [21]
HRR AC0,TEMP ; [21]
EXCH AC0,FRDTMP ; [21] SAVE WORD-COUNT,,PNTR, GET 1ST WORD
MOVEM AC0,(TEMP) ; [21] SAVE 1ST WORD OF SYMBOL IN BUFFER
ADD TEMP,[
POINT 6,1] ; [21] FORM BYTE-POINTER TO 2ND WORD
LB0: IDPB C,TEMP ; [21] PUT CHARACTER AWAY
SOJLE TEMP1,LB1 ; [21] SEE IF DONE
PUSHJ P,READ ; [21] NOT - GET NEXT CHARACTER
SUBI C,40 ; [21] TO SIXBIT
JRST LB0 ; [21] AND LOOP
LB1: TLNN TEMP,770000 ; [21] WHOLE WORD ?
JRST LB3 ; [21] YES.
MOVEI C,0 ; [21]
IDPB C,TEMP ; [21] NULL FILL
JRST LB1 ; [21] & TRY AGAIN
LB3: POP P,TEMP ; [21]
LB5: MOVE AC0,FRDTMP ;[51] LOAD RESULT INTO AC0 (AC0=0 - DON'T DO SKIPN)
JUMPE AC0,ERROR ;ERROR IF ZERO.
POPJ P,
SUBTTL DEFMAC, DEFSYM, COMBIN
;REDEFINE SYMBOL NAME FOR FAIL (CHANGES NUMERIC NAME TO ITS PRINTING NAME)
DEFMAC: SKIPA SX,[MACTBL] ;CODE 13
DEFSYM: MOVEI SX,SYMTBL ;CODE 11
MOVE AC0,SVLAB
JUMPE AC0,DEFS0 ;NO SAVED SYMBOL
SETZM SVLAB
;ENTER SAVED SYMBOL BEFORE REDEFINING A SYMBOL NAME, IN CASE IT'S THE SAVED
;SYMBOL THAT'S BEING REDEFINED.
PUSH P,SX ;SAVE SX
MOVSI SX,IOSYM ;SET TO DEFINE OLD SYMBOL
PUSHJ P,M6 ;STUFF SYMBOL
POP P,SX
DEFS0:
PUSHJ P,FREAD ;GET SYMBOL NAME
MOVE BYTEX,AC0
IDIVI BYTEX,HASH
MOVMS TX ;HASH IT
ADDI TX,(SX) ;ADDRESS OF CHAIN HEADER
SKIPN SX,(TX)
JRST DEFBYP ;NOT FOUND
DEFS1: CAMN AC0,(SX) ;FIND SYMBOL
JRST DEFFD
SKIPE SX,1(SX)
JRST DEFS1
DEFBYP: PUSHJ P,FREAD ;HERE IF SYMBOL IS NOT FOUND (ERROR?)
JRST FM2
;HERE IF THE SYMBOL IS FOUND. SX POINTS TO OUR ENTRY FOR IT
DEFFD: PUSHJ P,FREAD ;NOW GET DEFINITION
MOVEM AC0,(SX) ;STORE DEFINITION
MOVE AC0,BLKND ;GET BLOCK NAME
HRRM AC0,3(SX) ;STORE IT WITH SYMBOL
JRST FM2
;HERE WHEN FAIL DISCOVERS THAT TWO FORMERLY DIFFERENT SYMBOLS ARE THE SAME.
;COMBINE THEIR CREF SYMBOLS INTO ONE NEW SYMBOL.
COMBIN: PUSHJ P,FREAD ;GET FIRST
MOVE BYTEX,AC0
IDIVI BYTEX,HASH
MOVMS TX
MOVEI SX,SYMTBL-1(TX)
CMB1: MOVE TEMP,SX ;FIND IT (TEMP IS THE PREVIOUS POINTER)
SKIPN SX,1(TEMP)
JRST DEFBYP ;NOT FOUND (ERROR?)
CAME AC0,(SX)
JRST CMB1
PUSHJ P,FREAD ;FOUND FIRST. NOW, GET NEXT NAME
MOVE BYTEX,AC0
IDIVI BYTEX,HASH
MOVMS TX
MOVEI TEMP1,SYMTBL-1(TX)
CMB2: MOVE TX,TEMP1
SKIPN TEMP1,1(TX)
JRST MOVSYM ;SECOND NOT FOUND
CAME AC0,(TEMP1)
JRST CMB2
LDB BYTEX,[
POINT 17,2(TEMP1),17] ;GET LINE NUMBER FROM SECOND
LDB AC0,[
POINT 17,2(SX),17] ;AND FROM FIRST.
CAML BYTEX,AC0 ;AND SEE WHICH IS SMALLER
JRST CMBOK ;SMALLER IS ONE TO DELETE (SX)
MOVE AC0,2(SX) ;SWAP FIRST AND SECOND TO MAKE SX SMALLER
EXCH AC0,2(TEMP1)
MOVEM AC0,2(SX)
MOVE AC0,3(SX)
EXCH AC0,3(TEMP1)
MOVEM AC0,3(SX)
CMBOK: MOVE BYTEX,FREE ;GOBBLE A 2-WORD BLOCK
ADDI FREE,2
CAML FREE,.JBREL
PUSHJ P,XCEED
MOVSI AC0,400000 ;PREPARE TO SET FLAG IN (TX) IF NEEDED
SKIPGE C,2(SX) ;SKIP IF FLAG OFF IN SX (C _ REFCHAIN)
IORM AC0,2(TEMP1) ;TURN ON BIT IN TEMP1 IF BIT WAS SET IN SX
HLL C,3(TEMP1) ;AUXCHAIN FROM MAIN SYMBOL
MOVEM C,(BYTEX) ;STORE: AUX POINTER,,REFCHAIN ADDRESS
SKIPN 3(TEMP1) ;WAS THERE AN OLD MERGE POINTER?
MOVEM BYTEX,3(TEMP1) ;NO. "TAIL" OF AUXLIST = (BYTEX)
MOVE C,3(SX) ;GET AUXLIST FROM DELETED SYMBOL
HLLM C,3(TEMP1) ;STUFF IT AS OUR AUXLIST.
JUMPE C,CMB4 ;JUMP IF THERE IS NO OLD AUXLIST.
HRLM BYTEX,(C) ;APPEND NEW LIST (BYTEX) TO OLD AUXLIST
CMB3: MOVE TX,FSTPNT ;PUT DELETED SYMBOL BACK ON FREE LIST
EXCH TX,1(SX) ;AND LINK IT OUT OF THE SYMBOL TABLE
MOVEM SX,FSTPNT
MOVEM TX,1(TEMP)
JRST FM2
CMB4: HRLM BYTEX,3(TEMP1) ;NO OLD AUXLIST. (BYTEX)=HEAD OF NEW AUXLIST
JRST CMB3
COMMENT $
THE LAST WORD OF A SYMBOL ENTRY POINTS TO THE HEAD AND TAIL OF AN AUXILIARY
LIST OF ENTRIES FOR THIS SYMBOL (LH=HEAD, RH=TAIL).
THE AUXILIARY LIST CONTAINS TWO-WORD ENTRIES OF:
0/ LINKOUT,,REFCHAIN ADRESS
1/ UNUSED
$
MOVSYM: MOVE BYTEX,AC0 ;GET THE SYMBOL NAME AGAIN
TLNN BYTEX,770000 ; [21] POINTER TO LONG SYMBOL ?
MOVE BYTEX,(BYTEX) ; [21] YES - FOLLOW IT
IDIVI BYTEX,HASH
MOVMS TX
SKIPE TEMP1,FSTPNT ;GET A BLOCK
JRST [MOVE BYTEX,1(TEMP1)
MOVEM BYTEX,FSTPNT
JRST MOVS1]
MOVE TEMP1,FREE
ADDI FREE,4
CAML FREE,.JBREL
PUSHJ P,XCEED
MOVS1: MOVE BYTEX,SYMTBL(TX) ;INSERT SYMBOL INTO SYMBOL TABLE
MOVEM BYTEX,1(TEMP1)
MOVEM TEMP1,SYMTBL(TX)
MOVEM AC0,(TEMP1)
HRLI BYTEX,2(SX)
HRRI BYTEX,2(TEMP1)
BLT BYTEX,3(TEMP1) ;COPY INFO FROM DELETED SYMBOL
MOVE TX,FSTPNT ;PUT DELETED SYMBOL BACK ON FREE LIST
EXCH TX,1(SX) ;AND LINK IT OUT OF THE SYMBOL TABLE
MOVEM SX,FSTPNT
MOVEM TX,1(TEMP)
JRST FM2
SUBTTL LABELS AND BLOCKS. SETLAB, DLAB, BBEG, BBEND, BLKPRN,SETLIN
SETLAB: PUSHJ P,FREAD ;GET LABEL. SYMBOL REFERENCE
EXCH AC0,SVLAB ;CHANGE FOR OLD LABEL
JUMPE AC0,FM2 ;IF NO OLD LABEL, GO GET MORE
MOVSI SX,IOSYM ;SET TO REFERENCE OLD LABEL
JRST FM6 ;ADD OLD LABEL TO SYMBOL TABLE
DLAB: MOVE AC0,SVLAB ;USE LAST LABEL. DEFINE PREVIOUS SYMBOL
SETZM SVLAB ;NO OLD LABEL NOW.
JUMPE AC0,ERROR ;ERROR IF NONE THERE
MOVSI SX,IOSYM ;SET FOR SYMBOL TABLE
TLO IO,IODEF ;SET FOR DEFINING OCCURANCE.
PUSHJ P,M6 ; [22] STUFF IT
;**;[56] Remove @ DLAB+6L JNG 10-Apr-77
JRST FM2 ; [22] ONWARD
BBEG: AOS TEMP,LEVEL ;GET CURRENT LEVEL. BEGIN A BLOCK
MOVSI SX,0 ;FLAG BEGIN FOR COMBEG
JRST COMBG ;GO INSERT BEGIN IN BLOCK LIST
BBEND: MOVE TEMP,LEVEL ;CURRENT LEVEL
SOSGE LEVEL ;RESET LEVEL
SETZM LEVEL ;BUT NOT TO GO NEGATIVE (PRGEND DOES THIS!)
MOVEI SX,1 ;FLAG BEND FOR COMBEG
COMBG: PUSHJ P,FREAD ;GET BLOCK NAME
MOVE TEMP1,FREE
ADDI FREE,4 ;RESERVE 4 WORDS
CAML FREE,.JBREL
PUSHJ P,XCEED
MOVEM AC0,(TEMP1) ;SAVE BLOCK NAME
HRLZM TEMP,1(TEMP1) ;AND LEVEL
MOVEM LINE,2(TEMP1) ;AND CURRENT LINE
HRLM SX,2(TEMP1) ;AND FLAG TO SELECT BEGIN/BEND
MOVE TEMP,BLKND ;ADD THIS BLOCK TO END OF LIST
HRRM TEMP1,1(TEMP)
MOVEM TEMP1,BLKND ;SET END OF THE LIST TO POINT HERE
JRST FM2
COMMENT $
BLOCK NAME LIST
Block names are entered on a single-linked list of four-word elements.
Each element contains:
0/ block name (sixbit)
1/ block level,,link to next element
2/ BEGIN/BEND flag,,Line number where the BEGIN/BEND occured
3/ Unused
BLKND points to the last entry (initially to BLKST-1, which is the head of the list).
$
;PRINT BLOCK NAMES. CALL WITH BYTEX POINTING TO THE LIST OF BLOCK NAMES
BLKPRN: PUSHJ P,LINOUT ;PRINT BLOCK LIST
MOVE CS,@BLKND ;NAME OF THE OUTER BLOCK IS PROGRAM NAME
PUSHJ P,OUTAS2 ;[27] SKIP ALGOL TEST & WRITE IN ASCII
MOVEI C,11
PUSHJ P,WRITE
MOVE CS,[SIXBIT /PROGRA/] ;GET THE "M" LATER...
PUSHJ P,OUTASC
MOVEI C,"M"
PUSHJ P,WRITE
BLKP3: PUSHJ P,LINOUT ;NEXT LINE
HLRZ BYTEM,1(BYTEX) ;GET BLOCK LEVEL
LSH BYTEM,-1 ;DIVIDE BY 2
;(INDENT 4 SPACES HALF-TAB FOR EACH LEVEL)
JUMPE BYTEM,BLKP1
PUSHJ P,TABOUT ;OUTPUT MANY TABS
SOJG BYTEM,.-1 ;HALF AS MANY TABS AS NESTING LEVEL
BLKP1: HLRZ BYTEM,1(BYTEX) ;GET THE BLOCK LEVEL AGAIN
HLRZ SX,2(BYTEX) ;0=BEGIN, 1=BEND
TRNE BYTEM,1 ;ODD LEVEL?
ADDI SX,4 ;YES. NEED 4 MORE SPACES
JUMPE SX,BLKP2 ;NOW WRITE SPACES FROM COUNT IN SX
MOVEI C," " ;(ONE EXTRA SPACE FOR BEND)
PUSHJ P,WRITE
SOJG SX,.-1 ;WRITE ENOUGH SPACES
BLKP2: MOVE CS,(BYTEX) ;GET AND WRITE THE BLOCK NAME
PUSHJ P,OUTAS2 ;[27] SKIP ALGOL TEST
HLRZ SX,2(BYTEX) ;0=BEGIN, 1=BEND
MOVNS SX
ADDI SX,5 ;4 SPACES FOR BEND, 5 FOR BEGIN
SKIPN CS,(BYTEX)
JRST BLKP2A ;BLANK BLOCK NAMES ARE NOT GENERATED BY FAIL
JRST .+2
LSH CS,-6
TRNN CS,77
AOJA SX,.-2 ;COUNT TRAILING SPACES IN THE BLOCK NAME
BLKP2A: MOVEI C," "
PUSHJ P,WRITE
SOJG SX,.-1 ;WRITE SPACES TO GET TO A NICE COLUMN
HRRZ C,2(BYTEX) ;GET THE LINE NUMBER
PUSHJ P,CNVRT ;AND WRITE IT
HRRZ BYTEX,1(BYTEX) ;ADVANCE TO NEXT BLOCK NAME
JUMPN BYTEX,BLKP3 ;LOOP UNLESS LIST EXHAUSTED
TLO IO,IOPAGE ;TIME FOR A NEW PAGE
POPJ P,
SETLIN: PUSHJ P,READ ;[17] READ LINE NUMBER FROM FILE
MOVEI TEMP,(C) ;[17] SAVE CHARACTER COUNT
MOVEI LINE,0 ;[17] ACCUMULATE NEW VALUE
SETLI1: PUSHJ P,READ ;[17] GET A DIGIT
IMULI LINE,12 ;[17]
ADDI LINE,-"0"(C) ;[17]
SOJG TEMP,SETLI1 ;[17]
;**;[54] Remove edits 22,25 @ SETLI1+4L JNG 24-Mar-77
JRST FM2 ;[17] DONE. SCAN MORE.
SUBTTL EOF SEEN. OUTPUT TABLES AND FINISH UP.
R0: MOVE C,[SOSG LSTBUF+2] ;SET UP WRITE ENTRANCE INSTRUCTION
MOVEM C,WRITEE ;SO THAT CREF DATA WILL BE WRITTEN
SKIPE BYTEX,BLKST ;CHECK FOR FAIL BLOCK STRUCTURE
PUSHJ P,BLKPRN ;PRINT FAIL BLOCK STRUCTURE
MOVE CS,@BLKND ;SET FOR PURGED SYMBOL W/O BLOCK NAME
MOVEM CS,BLKST-1 ;BLOCK NAME OF OUTER BLOCK SAVED HERE.
TLZ IO,IOSAME ;CLEAR FLAG FOR OUTP
MOVEI BYTEX,SYMTBL
TLNE IO,IOSYM ;SKIP IF NO SYMBOL OUTPUT REQUIRED
PUSHJ P,SORT ;SORT SYMTBL - OUTPUT SYMTBL
MOVEI BYTEX,MACTBL
TLNE IO,IOMAC ;SKIP IF NO MACRO OUTPUT REQUIRED
PUSHJ P,SORT ;SORT AND OUTPUT MACTBL
MOVEI BYTEX,OPTBL
TLNE IO,IOOP ;SKIP IF NO OPCODE OUTPUT REQUIRED
PUSHJ P,SORT ;SORT AND OUTPUT OPTBL
MOVE P,PPSAV ;RE-INITIALIZE STACK.
TLZN IO,IOEOF ;END OF FILE SEEN?
JRST RECYCL ;NO, RECYCLE (F40 PROGRAM?)
CLOSE LST, ;FINISH LISTING (IN CASE OF TTY OUTPUT)
PUSHJ P,TSTLST ;YES, TEST FOR ERRORS
RELEAS LST,
TLNE IO,IOCCL
JRST CCLFN
MOVEI RC, [[ASCIZ /[CRFXKC /]] ;[17][34] IDENTIFY MESSAGE
PUSHJ P,PNTM0 ;[17] IDENTIFY MESSAGE
EXCH IO, MYWCH ;[40]
TLNN IO, (JW.WFL) ;[40] /MES:FIR??
JRST R0X ;[40] NO - SKIP
MOVE C,.JBREL
LSH C,-12 ;CONVERT WORDS TO K
ADDI C,1
PUSHJ P,TYDEC ;[20] TYPE DECIMAL
OUTSTR [ASCIZ/K core/] ;[34]
TLNN IO, (JW.WPR) ;[40] /MES:(PRE,FIR) ??
OUTCHR [" "] ;[40] NO - ONLY /MES:FIR
R0X: OUTCHR ["]"] ;[40] CAP OFF MESSAGE
EXCH IO, MYWCH ;[40] RESTORE STUFF
;[37] FALL INTO CCLFN
;[37] *** FALL HERE FROM PREVIOUS PAGE ***
CCLFN:
IFE STANSW,< HLRZ C,INDIR+1 ;GET INPUT FILE EXTENSION
CAIE C,'CRF' ;IS IT CRF OR
CAIN C,'LST' ; LST?
TLNE IO,IOPROT ;YES, IS IT PROTECTED (/P SWITCH)?
JRST CCLFN1 ;PROTECTED, OR NOT 'LST' OR 'CRF'
SETZB TEMP,TEMP+1 ;CRF OR LST AND NOT PROTECTED
SETZB TEMP+2,TEMP+3 ;LET'S DELETE IT
RENAME CHAR,TEMP ;RENAME FILE TO 0 TO DELETE IT
JFCL ;IGNORE RENAME FAILURES >
CCLFN1: RELEAS CHAR,
TLNN IO,IOCCL ;CCL MODE?
JRST CREF ;NO. RETURN FOR NEXT ASSEMBLY
CCLFN3: MOVSI IO,IOCCL
MOVE C, LASCHR ;[37] PICKUP LAST SEEN COMMAND CHAR
CAIE C, 12 ;[37] READY FOR NEW LINE OF COMMANDS
PUSHJ P, EATLIN ;[37] NO - EAT REST OF THIS LINE
JRST RETCCL
TYDEC: IDIVI C,12
HRLM CS,(P)
JUMPE C,.+2
PUSHJ P,TYDEC
HLRZ C,(P)
ADDI C,"0"
OUTCHR C
POPJ P,
SUBTTL SORT SYMBOL TABLE
COMMENT $
This sort routine should not be approached as a trivial programming
example. This is coded for speed and compactness, not clarity.
For each non-empty symbol chain, LSORT is called, which sorts that
one chain. Sorted chains are deposited into a compact table (SORT2)
which is terminated by a zero (SORT4). Then, adjacent pairs of lists
are merged by LMERGE, and deposited in a compact table. Each
pairwise merge pass continues until one of a pair is zero, at which
time a zero is deposited at the end of the compact area, and another
merge pass is started. The pairwise merge terminates when the second
word of the first pair is zero, at which point the result is the
first word of that pair.
The routine LSORT is recursive. A single-element is list is sorted.
For longer lists, break the list into two lists (of approximately
equal size) and sort those two lists (i.e., recur). The result of
those two sorts is merged (LMERGE again) to form one sorted list.
Also, this sort routines causes the hash table to be cleared to zero.
$
SORT: MOVEM BYTEX,SRTTMP ;SAVE FIRST ADDRESS OF HASH TABLE
HRLI BYTEX,-HASH ;AOBJN POINTER TO TABLE
MOVEI FLAG,-1(BYTEX) ;PUSHDOWN POINTER TO "FIRST FREE" HEADER
SORT1: SKIPN SX,(BYTEX) ;GET LIST HEADER
JRST SORT3 ;THIS IS EASY
SETZM (BYTEX) ;CLEAR OUT SOURCE ENTRY
PUSHJ P,LSORT ;SORT ONE CHAIN. RESULT IS POINTER IN SX
SORT2: PUSH FLAG,SX ;STORE SORTED CHAIN
SORT3: AOBJN BYTEX,SORT1 ;ADVANCE TO NEXT CHAIN
SORT5: HRRZ BYTEX,SRTTMP ;GET BACK THE HASH TABLE ADDRESS
SETZB SX,TX
EXCH SX,(BYTEX) ;GET FIRST CHAIN (STORE ZERO)
EXCH TX,1(BYTEX) ;ANY SECOND CHAIN? (STORE ZERO)
JUMPE TX,OUTP ;NO. RESULT IS IN SX. CALL OUTP
MOVEI FLAG,-1(BYTEX) ;INITIALIZE POINTER FOR DEPOSITS
SORT6: PUSHJ P,LMERGE ;MERGE SX,TX. RESULT IN SX
PUSH FLAG,SX ;STUFF RESULT
ADDI BYTEX,2 ;ADVANCE TO NEXT
SETZB SX,TX
EXCH SX,(BYTEX) ;GET FIRST OF NEXT PAIR (STORE ZERO)
JUMPE SX,SORT5 ;NO NEXT PAIR. DO ANOTHER MERGE PASS
EXCH TX,1(BYTEX) ;GET SECOND OF PAIR (STORE ZERO)
JUMPE TX,SORT2 ;NOT THERE. PUSH SX. (BYTEX>0)
JRST SORT6 ;LOOP UNTIL A PAIRWISE MERGE PASS COMPLETES
;SORT ONE NON-EMPTY LIST POINTED TO BY SX, RESULT IN SX.
LSORT: SKIPN TX,1(SX) ;GET NEXT LINK
POPJ P, ;LIST WITH ONE ELEMENT IS SORTED.
MOVE C,TX ;TAIL OF TX LIST
MOVE CS,SX ;TAIL OF SX LIST
LSORT1: MOVE TEMP,1(C) ;GET LINK-OUT OF TS-LIST
MOVEM TEMP,1(CS) ;STORE LINK-OUT OF NA-LIST
SKIPN CS,TEMP ;ADVANCE NA-TAIL
JRST LSORT2 ;NONE LEFT
MOVE TEMP,1(CS)
MOVEM TEMP,1(C)
SKIPE C,TEMP
JRST LSORT1
LSORT2: PUSH P,TX ;TX AND SX ARE EACH HALF THE LENGTH OF
PUSHJ P,LSORT ;ORIGINAL LIST. RECUR TO SORT EACH
EXCH SX,(P) ;SX AND TX GET EXCH'D HERE, BUT NO ONE CARES
PUSHJ P,LSORT
POP P,TX
;ENTER HERE TO MERGE TWO NON-EMPTY LISTS INTO ONE. ARGS IN SX,TX; RESULT IN SX
LMERGE: MOVEI CS,C-1 ;LIST HEAD (OF RESULT) INTO C.
SCOMP: MOVE TEMP,(SX) ;COMPARE CAR(SX), CAR(TX).
MOVE TEMP1,(TX) ; [21]
TLNN TEMP,770000 ; [21] LONG SYMBOL ?
JRST LSYM1 ; [21] YES
TLNN TEMP1,770000 ; [21] LONG SYMBOL ?
JRST LSYM2 ; [21] YES.
CAMGE TEMP,(TX) ;COMPARE SYMBOL NAMES
JRST LCOMP ;CAR(SX)<CAR(TX) DONE.
CAME TEMP,(TX) ;EQUAL?
JRST XCOMP ;NO. CAR(TX)<CAR(SX). EXCH THEM, THEN DONE
ECOMP: MOVE TEMP,3(SX) ;GET THE BLOCK POINTER
MOVE TEMP,(TEMP) ;GET THE BLOCK NAME (SX)
MOVE TEMP1,3(TX)
CAML TEMP,(TEMP1) ;SKIP IF SX IS THE SMALLER
XCOMP: EXCH SX,TX ;CAR(TX)<CAR(SX). TO MAKE SX THE SMALLER
LCOMP: ;SX IS NOW THE SMALLER
MOVEM SX,1(CS) ;APPEND SMALLER TO OUTPUT LIST
MOVEI CS,(SX) ;ADVANCE OUTPUT LIST TO INCLUDE THIS
SKIPE SX,1(SX) ;REPLACE LIST BY ITS CDR.
JRST SCOMP ;LOOP UNTIL SOME LIST EMPTIES
MOVEM TX,1(CS) ;SX EMPTY. APPEND TX LIST TO OUTPUT
MOVE SX,C ;RETURN HEAD OF OUTPUT-LIST
POPJ P,
SUBTTL SORT LONG SYMBOLS
LSYM1: ; (SX) IS POINTER IN TEMP: (TX) MAYBE POINTER TOO
TLNE TEMP1,770000 ; [21] POINTER ?
MOVEI TEMP1,(TX) ; [21] NO - MAKE IT SO
TLO TEMP1,1 ; [21] SAY 6 CHARS
JRST LSYM3 ; [21]
LSYM2: ; (TX) IS POINTER IN TEMP1; (SX)(IN TEMP1) ISN'T
MOVEI TEMP,(SX) ; [21] MAKE IT SO
TLO TEMP,1 ; [21] SET LENGTH = 1 WORD
LSYM3: HLRZM TEMP,L1 ; [21] SAVE
HLRZM TEMP1,L2 ; [21] LENGTHS
LSYML: MOVE TEMPX,(TEMP) ; [21] GET WORD
CAME TEMPX,(TEMP1) ; [21] = ?
JRST LSYMNE ; [21] NO
SOSG L1 ; [21] YES - CHECK LENGTHS
JRST LSYM4 ; [21] L1 FINISHED
SOSG L2 ; [21] NOT - L2 ?
JRST XCOMP ; [21] YES - (TX)<(SX)
JRST LSYML ; [21] NO - NEXT WORDS
LSYM4: SOSG L2 ; [21] L1 DONE - L2 ?
JRST ECOMP ; [21] YES - EQUAL
JRST LCOMP ; [21] NO - (SX)<(TX)
LSYMNE: CAML TEMPX,(TEMP1) ; [21] NOT = - WHICH LARGER ?
JRST XCOMP ; [21] (TX)<(SX)
JRST LCOMP ; [21] (SX)<(TX)
SUBTTL OUTPUT ROUTINES. OUTP, GETVAL, CNVRT, OUTASC
OUTASC: TLNN CS,770000 ; [21] POINTER ?
JRST OUTLNG ; [21] YES - DEAL WITH LONG SYMBOL
OUTAS2: MOVEI C,0 ;[27] SIXBIT IN CS, OUTPUT ASCII.
LSHC C,6
CAIE C,'0'
JRST OUTAS1
MOVEI C," "
PUSHJ P,WRITE0 ;CHANGE LEADING 0'S TO BLANKS FOR F4
JUMPN CS,OUTASC
POPJ P,
OUTLNG: HLRZM CS,L1 ; [21] SAVE LENGTH
HRRZM CS,L2 ; [21] SAVE POINTER
OUTLN2: MOVE CS,@L2 ; [21] GET WORD
PUSHJ P,OUTAS0 ; [21] OUTPUT
AOS L2 ; [21]
SOSLE L1 ; [21] MORE ?
JRST OUTLN2 ; [21] YES
JRST LINOUT ; [21] NO - CRLF & EXIT
OUTAS0: MOVEI C,0
LSHC C,6
OUTAS1: ADDI C,40
PUSHJ P,WRITE0
JUMPN CS,OUTAS0 ;ANY MORE TO PRINT?
POPJ P, ;DONE
OUTP: JUMPE SX,CPOPJ ;NO.
TLO IO,IOPAGE
OUTPA: SKIPL 2(SX) ;IGNORE SYMBOL?
JRST LNKOUT ;YES (IT WAS NEVER MENTIONED IN RANGE)
PUSHJ P,LINOUT ;SEND CRLF TO OUTPUT
MOVE CS,(SX) ;GET SYMBOL NAME
PUSHJ P,OUTASC ;CONVERT TO ASCII AND SEND TO OUTPUT
MOVE CS,(SX) ;GET SYMBOL NAME AGAIN
MOVE TX,1(SX) ;GET LINK TO NEXT SYMBOL.
CAMN CS,(TX) ;IS NEXT SYMBOL THE SAME AS THIS?
JUMPN TX,ISBLK ;YES. PRINT BLOCK NAME IF NEXT SYMBOL EXISTS
TLZN IO,IOSAME ;THIS MIGHT BE LAST OF A SET OF SAME NAMES
JRST NOBLK ;NO, THIS IS UNIQUE
SKIPA ;AVOID SETTING IOSAME
ISBLK: TLO IO,IOSAME ;NEXT LINE NEEDS BLOCK NAME.
PUSHJ P,TABOUT ;DO A TAB
MOVE CS,3(SX) ;GET A POINTER TO THE BLOCK NAME
MOVE CS,(CS) ;GET THE BLOCK NAME ITSELF
PUSHJ P,OUTASC ;WRITE IT
NOBLK: PUSHJ P,OUTP1 ;NOW, THE REST OF THE DATA FOR THIS SYM
LNKOUT: SKIPN SX,1(SX) ;GET LINK TO NEXT
PJRST LINOUT ;[24] NO NEXT - CRLF & EXIT
JRST OUTPA ;PROCESS NEXT
OUTP1: MOVEI FLAG,3(SX)
LINLP: HLRZ FLAG,(FLAG)
JUMPE FLAG,LAST
PUSH P,[LINLP] ;POPJ WILL RETURN TO LINLP
SKIPA BYTEX,(FLAG)
LAST: HRRZ BYTEX,2(SX)
HRLI BYTEX,(<POINT 6,0,5>)
ADDI BYTEX,1
MOVE BYTEM,-1(BYTEX)
MOVEI LINE,0
JRST GETV20 ;START OUTPUTTING VALUES
GETVAL: TLZN IO,IODEF
JRST GETV20
MOVEI C,"#"
PUSHJ P,WRITE
GETV20: CAMN BYTEX,BYTEM
POPJ P,
PUSHJ P,TABOUT
MOVEI C,0
GETV10: TRNE BYTEX,1
CAML BYTEX,[POINT 6,0,16]
JRST GETV12
MOVE BYTEX,0(BYTEX)
HRLI BYTEX,(<POINT 6,0>)
GETV12: ILDB CS,BYTEX
ROT CS,-5
LSHC C,5
JUMPN CS,GETV10
TRNN C,1 ;SET DEFINED FLAG
TLO IO,IODEF
LSH C,-1
;**;[54] Insert @ GETV12+7L JNG 24-Mar-77
HRRE C,C ;[54] EXTEND IN CASE NEGATIVE
ADDB LINE,C
PUSH P,[GETVAL] ;RETURN FROM CNVRT TO GETVAL
CNVRT: MOVEI TEMP,5 ;HERE TO OUTPUT A FIVE-DIGIT NUMBER FROM C
MOVEI TEMP1,0
CNVRT1: IDIV C,TABL(TEMP)
ADD TEMP1,C
ADDI C,40
SKIPE TEMP1
ADDI C,20
PUSHJ P,WRITE
MOVE C,CS
SOJGE TEMP,CNVRT1
POPJ P,
TABL: DEC 1,10,100,1000,10000,100000
SUBTTL OUTPUT ROUTINES - TABOUT, LINOUT, WRITE
LINOUT: SOSG LPP
TLO IO,IOPAGE
MOVEI C,15
PUSHJ P,WRITE
MOVEI C,12
MOVE WPL,.WPL
JRST WRITE
TABOU0: PUSHJ P,LINOUT
TABOUT: MOVEI C,11
SOJL WPL,TABOU0
WRITE0: TLZN IO,IOPAGE
JRST WRITE
PUSH P,C
MOVEI C,14
PUSHJ P,WRITE
MOVEI C,.LPP
MOVEM C,LPP
POP P,C
WRITE: XCT WRITEE ;SOSG LSTBUF+2 OR JRST WRITE1
PUSHJ P,DMPLST
IDPB C,LSTBUF+1
XCT WRITEX ;EXIT FROM WRITE (POPJ P, OR CAIE C,12)
POPJ P, ;WASN'T LF IN TTY OUTPUT MODE.
;FORCE TTY OUTPUT AFTER EVERY LINE.
DMPLST: XCT DMPXCT ;OUTPUT BUFFER (OUT OR PUSHJ P,DMPOUT)
POPJ P, ;WIN.
;LOSE.
TSTLST: STATO LST,742000 ;ANY ERROR. (EOT NOT TESTED BY OUT UUO)
POPJ P, ;NO ERRORS.
GETSTS LST,ERRSTS
MOVEI CS,LSTDEV
JSP RC,DVFSTS
[ASCIZ/?CRFOUE OUTPUT error, /] ;[17][34] IDENTIFY MESSAGE
JRST CREF
DMPOUT: OUTPUT LST,
STATZ LST,742000 ;CHECK FOR EOT ON TAPE OPERATIONS
AOS (P) ;ERROR STATUS. SKIP RETURN
POPJ P,
WRITE1: CAMGE LINE,FIRSTL ;TIME TO START WRITING YET?
POPJ P, ;NO.
PUSH P,C
MOVE C,[SOSG LSTBUF+2]
MOVEM C,WRITEE ;FIX THE WRITE ENTRANCE INSTRUCTION
POP P,C
JRST WRITE ;NOW GO AN PLUNK THAT CHARACTER
SUBTTL HERE TO EXPAND CORE - XCEED
XCEED: PUSH P,1 ;HERE TO EXPAND CORE
HRRZ 1,.JBREL ;GET CURRENT TOP
MOVEI 1,2000(1)
IFN SEGSW,< CAIGE 1,400000 ;DON'T EXPAND LOWER ABOVER 128K>
CORE 1, ;REQUEST MORE CORE
JRST ERRCOR ;ERROR, BOMB OUT
POP P,1
POPJ P,
;[51] HERE ON SYNTAX ERROR IN COMMAND SCANING
REPEAT 0, < ;[51] TRY THIS ON FOR SIZE
SCNERR: SETOM SYNERR ;[51] FLAG SYNTAX ERROR OCCURRED
CAIE C,12 ;[51] AT EOL?
PUSHJ P,EATLIN ;[51] NO - EAT REST OF LINE
MOVEM C,CMDTRM ;[51] REMEMBER FINISHED LINE
POPJ P, ;[51] RETURN TO ISSUE ERROR MESSAGE
> ;[51] END OF REPEAT 0 ON SCNERR
SYN ERRCM, SCNERR ;[51] NOW - BOMB USER BIG!
;HERE FOR HELP
IFE STANSW,<
HELP43: SETOM LEAFLG ;[51] FORCE EARLY EXIT
HELP: CAIE C,12 ;[51] IF IN MIDDLE OF LINE, THEN
PUSHJ P, EATLIN ;[37] EAT REST OF THIS LINE
MOVE 1,[SIXBIT 'CREF'] ;[43]
PUSHJ P,.HELPR
SKIPE LEAFLG ;[43] SPECIAL (".CREF/H")??
JRST LEAVE ;[43] YES - GO EXIT
JRST CREF > ;AND START OVER
SUBTTL SCAN COMMAND INPUT
NAME1: SETZB ACDEV,ACFILE
SETZB ACEXT,ACDEL
SETZB TIO,CS
SETZB ACPPN, SYNERR ;[32] NO SYNTAX ERROR
MOVEI FLAG, <TXTSIZ * 5> ;[31] # CHARS IN BUFFER
MOVE ACTXT,[POINT 7,TXTBUF] ;POINTER FOR TENEX
MOVEM ACTXT,ASCCNT ;TO WORD
NAME3: MOVSI ACPNTR,(<POINT 6,ACTXT>) ;SET POINTER
SETZ ACTXT, ;[51] READY FOR NEXT PASS
GETIOC: PUSHJ P,TTYIN ;GET INPUT CHARACTER
CAIN C,"/"
JRST SLASH
CAIN C,"("
JRST SWITCH
SOSLE FLAG ;ROOM IN TEXT BUFFER?
IDPB C,ASCCNT ;YES. PUT IT AWAY
MOVEM C,CMDTRM ;SAVE LAST COMMAND CHARACTER
CAIN C, "@" ;[33] ARE WE SEEING COMMAND FILE SPECS?
JRST NAMCMD ;[33] YES - GO FLAG AS SUCH
CAIE C,"=" ;[35] LOOKING AT OUTPUT SPECS
CAIN C,12 ;[41] ALT MODES AND RETURN CHANGED TO LINE FEED
JRST TERM
CAIE C,","
CAIN C,"!"
JRST TERM ; ! IS FOR RUNING NEXT PROGRAM
CAIN C,":"
JRST DEVICE
CAIE C, " " ;[43] SPACE?
CAIN C,"."
JRST NAME
CAIE C,"<"
CAIN C,"["
JRST PROGNP ;GET PROGRAMER NUMBER PAIR
CAIL C,"A"
CAILE C,"Z"
JRST [CAIL C,"0" ;NOT ALPHABETIC, IS IT NUMERIC?
CAILE C,"9"
JRST SCNERR ;[32]
JRST .+1]
SUBI C,40 ;CONVERT TO 6-BIT
TLNE ACPNTR,770000 ;HAVE WE STORED SIX BYTES?
IDPB C,ACPNTR ;NO, STORE IT
JRST GETIOC ;GET NEXT CHARACTER
DEVICE: JUMPN ACDEV, SCNERR ;[32] DUPLICATE NAME IS ERROR
MOVE ACDEV, ACTXT ;[32] SET DEVICE NAME
JRST NAME02 ;[32] COMMON CODE
NAMCMC: SETZ ACTXT, ;[33] ENTRY FROM PATH PROCESSING
NAMCMD: MOVEM C, CMDFLG ;[33] REMEMBER COMMAND FILE SPECS
SETZ C, ;[33] SET TO IGNORE IN ACDEL
NAME: CAIE ACDEL, "." ;[51] FOLLOW EXTENSION?
JRST NAME01 ;[51] NO - MUST BE NAME (IF ANYTHING)
JUMPN ACEXT, SCNERR ;[33] DUPLICATE EXTENSION IS ERROR
HLLO ACEXT, ACTXT ;[33] SET NEW-FOUND EXTENSION
JRST NAME02 ;[33] AND KEEP PARSING
NAME01: JUMPE ACTXT, NAME02 ;[51] IGNORE IF BLANK
JUMPN ACFILE, SCNERR ;[32] DUPLICATE FILENAME IS ERROR
MOVE ACFILE,ACTXT ;FILE NAME
NAME02: MOVE ACDEL,C ;[32] SET DELIMITER
JRST NAME3 ;GET NEXT SYMBOL
TERM: CAIN ACDEL,"." ;[51] IS ACTXT ACTUALLY EXTENSION?
JRST TERM01 ;[51] YES - DIFFERENT
JUMPE ACTXT,TERM02 ;[51] IF NOTHING THERE JUST LEAVE
JUMPN ACFILE,SCNERR ;[51] IF SOMETHING MUST BE FILENAME
MOVE ACFILE,ACTXT ;[51] SO SET IF NOT ALREADY SEEN ONE.
JRST TERM02 ;[51] AND CAP OFF EVERYTHING
TERM01: JUMPN ACEXT,SCNERR ;[51] DUPLICATE EXTENSION IS ERROR
HLLO ACEXT,ACTXT ;[51] SET EXTENSION
TERM02: SETZ ACTMP, ;[32]
DPB ACTMP,ASCCNT ;TIE OFF ASCII STRING
SKIPLE CMDFLG ;[33] NEED TO RETURN "@" FLAG?
MOVEI C, "@" ;[33] YES - THEN DO SO
PUSH P, FLAG ;[43] NEED 2 CONTIGUOUS (!!!) AC'S
MOVE ACTMP, TTRSWT ;[43] PICK UP USER CCL STICKY FLAGS
SKIPN SWTINI ;[44] USER NOT WANT SWITCH.INI DEFAULTS?
IOR ACTMP, SWSINI ;[44] NO - SLIP IN WITH OTHERS
TERM07: JFFO ACTMP, TERM10 ;[43] LOOP PROCESSING THEM ALL
POP P, FLAG ;[43] RESTORE FLAG FOR OUTSIDE WORLD
POPJ P, ;[43] RETURN WITH FILE SPECS ETC.
TERM10: XCT SWTAB(FLAG) ;[43] DO THIS SWITCH
MOVNI FLAG, (FLAG) ;[43] NOW NEED LSH INDEX
MOVSI ACTXT, (1B0) ;[43] AND BIT TO LSH
LSH ACTXT, (FLAG) ;[43] AND OF COURSE, A LSH
TDZ ACTMP, ACTXT ;[43] CLEAR OUT THIS "SWITCH"
JRST TERM07 ;[43] AND LOOP BACK FOR MORE
PROGNP: CAIE ACDEL, "." ;[32] DID WE FINISH OFF AN EXTENSION?
JRST PROG01 ;[32] NO - SKIP
JUMPN ACEXT, SCNERR ;[32] YES - IF DUPLICATE THEN ERROR
HLLO ACEXT, ACTXT ;[32] SAVE AWAY FILE EXTENSION
JRST PROG02 ;[32] AND BUILD PPN/PATH
PROG01: JUMPE ACTXT, PROG02 ;[32] 0 MEANS NOTHING HAPPENED OF INTEREST
JUMPN ACFILE, SCNERR ;[32] CAUSE ERROR IF DUPLICATE FILENAME
MOVE ACFILE, ACTXT ;[32] SET FILENAME
PROG02: MOVEI ACDEL, "[" ;[32] SET NEW ACDEL FLAG
JUMPN ACPPN, SCNERR ;[32] DUPLICATE PPN IS ERROR
PUSHJ P,TTI8 ;BUILD A PROJECT, PROGRAMMER NUMBER
CAIE C,"-" ;[32] EXPLICIT DEFAULT PATH?
JRST PROG07 ;[32] NO - SKIP
PUSHJ P, TTYIN ;[32] SKIP A CHARACTER
SOSLE FLAG ;[32] ROOM TO STASH AWAY?
IDPB C, ASCCNT ;[32] YES - STASH AWAY
JRST PROG50 ;[32] GO AWAY
PROG07: CAIE C,","
JRST SCNERR ;[32]
HRLZ ACPPN,ACTMP
PUSHJ P,TTI8
IORI ACPPN, (ACTMP) ;[32]
TLNN ACPPN, -1 ;[32] EXPLICIT PROJECT NUMBER?
HLL ACPPN, MYPPN ;[32] NO - FILL IN FROM LOGGED-IN PPN
TRNN ACPPN, -1 ;[32] EXPLICIT PROGRAMMER NUMBER?
HRR ACPPN, MYPPN ;[32] NO - FILL IN FROM LOGGED-IN PPN
CAIE C, "," ;[32] EXTENDED PATH????
JRST PROG50 ;[32] NO - SKIP NONSENSE
SETZM SCNPTH ;[32] YES - FIRST ZERO PATH BLOCK
MOVE ACTMP, [SCNPTH,,SCNPTH+1] ;[32] . . .
BLT ACTMP, SCNPTH + PTHLEN - 1 ;[32] . . .
MOVEM ACPPN, SCNPPN ;[32] SET PPN PART OF PATH
MOVE ACPPN, [IOWD <PTHLEN-3>,SCNPPN+1] ;[32] POINTER TO BUILD PATH
PROG20: PUSHJ P, TTISIX ;[32] READ IN SIXBIT SFD NAME
AOBJP ACPPN, SCNERR ;[32] MAKE SURE DON'T OVERFLOW
MOVEM ACTXT, (ACPPN) ;[32] SAVE AWAY LATEST ADDITION
CAIN C,"," ;[32] MORE???
JRST PROG20 ;[32] YEP - GO GET IT
MOVEI ACPPN, SCNPTH ;[32] RETURN EXTENDED PATH-BLOCK ADDRESS
PROG50: CAIE C,"]"
CAIN C,">"
JRST NAME3 ;[32] GO READ IN NEXT ITEM
CAIE C,"=" ;[32][35] ALSO ALLOW "=" / "_" TO TERMINATE
CAIN C,12 ;[32] DON'T FORGET BREAK CHARS ALSO
JRST TERM ;[32] END OF SCAN
CAIE C, "," ;[32] OTHER SCAN TERMINATORS
CAIN C, "!" ;[32] . . .
JRST TERM ;[32] OTHER SCAN TERMINATOR
CAIN C, "@" ;[33] COMMAND FILE?
JRST NAMCMC ;[33] YES - GO FLAG AS SUCH
JRST SCNERR ;[32] USER LOSES
IFE STANSW,<
TTI8: MOVEI ACTMP,0 ;BUILD AN OCTAL NUMBER
TTI8B: PUSHJ P,TTYIN
SOSLE FLAG
IDPB C,ASCCNT
CAIL C,"0"
CAILE C,"7"
POPJ P, ;RETURN ON A NON-OCTAL DIGIT
LSH ACTMP,3
ADDI ACTMP,-"0"(C)
JRST TTI8B
>;IFE STANSW
IFN STANSW,<
TTI8: MOVEI ACTMP,0
TTI8B: PUSHJ P,TTYIN
SOSLE FLAG
IDPB C,ASCCNT
CAIL C,"A"+40
CAILE C,"Z"+40
JRST TTI8C ;NOT LOWER CASE
SUBI C,40 ;LOWER TO UPPER CASE
TTI8A: LSH ACTMP,6
ADDI ACTMP,-" "(C)
JRST TTI8B
TTI8C: CAIL C,"A"
CAIL C,"Z"
JRST .+2
JRST TTI8A ;UPPERCASE
CAIL C,"0"
CAILE C,"9"
POPJ P, ;NOT VALID CHARACTER IN PPN
JRST TTI8A ;DIGITS
>;IFN STANSW
TTIDEC: SETZ ACTMP, ;[45] INITIALIZE
TTIDE1: PUSHJ P, TTYIN ;[45] NEXT CHARACTER
SOJLE FLAG, . + 2 ;[45] ROOM TO REMEMBER?
IDPB C, ASCCNT ;[45] LEAVE FOR TENEX FREAKS
CAIL C, "0" ;[45] DECIMAL DIGIT???
CAILE C, "9" ;[45] . . .
POPJ P, ;[45] NO - RETURN NUMBER IN ACTMP
IMULI ACTMP, 12 ;[45] READY FOR NEXT DECADE
ADDI ACTMP, -"0"(C) ;[45] NEXT DECADE
JRST TTIDE1 ;[45] LOOP FOR ENTIRE NUMBER
TTISIX: MOVSI ACPNTR, (POINT 6,) ;[32] ACTXT IS AC 0
SETZ ACTXT, ;[32]
TTISI1: PUSHJ P, TTYIN ;[32] NEXT CHARACTER
SOSLE FLAG ;[32] ROOM IN BUFFER
IDPB C, ASCCNT ;[32] YES - STUFF IN COMMAND CHAR
CAIL C, "0" ;[32] CAN POSSIBLY BE APHANUMERIC?
CAILE C, "Z" ;[32] . . .
POPJ P, ;[32] NO - RETURN
CAIL C, "9" ;[32] CAN . . .
CAIL C, "A" ;[32] . . .
CAIA ;[32] GOOD - ALPHANUMERIC
POPJ P, ;[32]
SUBI C, "0" - '0' ;[32] CONVERT TO SIXBIT CHARACTER
TLNE ACPNTR, (77B5) ;[32] ROOM IN WORD??
IDPB C, ACPNTR ;[32] YES - STUFF IT IN
JRST TTISI1 ;[32] AND LOOP
SUBTTL SWITCH PROCESSING
SWITCH: PUSHJ P,TTYIN
CAIL C,"0"
CAILE C,"9"
JRST SWIT1
PUSHJ P,GETLIM
CAIE C,","
JRST ERRCM
MOVEM ACTMP,LOWLIM
PUSHJ P,TTYIN
PUSHJ P,GETLIM
CAIE C,")"
JRST ERRCM
MOVEM ACTMP,UPPLIM
CAML ACTMP,LOWLIM
JRST GETIOC ;UPPLIM .GE. LOWLIM
MOVE ACTMP,[POPJ P,]
MOVEM ACTMP,M6X ;DON'T ENTER ANYTHING IN THE SYMBOL TABLE
JRST GETIOC
SWIT1: CAIN C,")"
JRST GETIOC
PUSHJ P,SW1
PUSHJ P,TTYIN
JRST SWIT1
GETLIM: TDZA ACTMP,ACTMP
GETLI1: PUSHJ P,TTYIN
CAIL C,"0"
CAILE C,"9"
POPJ P,
IMULI ACTMP,12 ;ACCUMULATE DECIMAL
ADDI ACTMP,-"0"(C)
JRST GETLI1
SLASH: ;[51] BE MORE STRINGENT
SW0: PUSHJ P,TTYIN
SW1: MOVEI C,-"A"(C) ;CONVERT FROM ASCII TO NUMERIC
CAILE C,"Z"-"A" ;WITHIN BOUNDS?
JRST ERRSWT ;[42] NO, ERROR
XCT SWTAB(C) ;EXECUTE THE SWITCH FUNCTION FOR THIS SWITCH
CAIN ACDEL,"/" ;[51] WAS LAST THING SEEN A SWITCH?
JUMPE ACTXT,GETIOC ;[51] YES - IF NOTHING SINCE JUST KEEP ON
MOVEI C,"/" ;[51] SET FOR LAST SEEN A SWITCH
JRST NAME ;[51] SEE IF WE CAPPED OFF FILENAME, ETC
SUBTTL COMMAND SWITCH TABLE
SWTAB: ADDI CS,1 ;A - ADVANCE FILE
SUBI CS,1 ;B - BACKSPACE FILE
SETOM SWTINI ;[44] C - CANCEL SWITCH.INI DEFAULTING
SETZM SWTINI ;[44] D - DEFAULTING (SWITCH.INI)
JRST ERRSWT ;E
JRST ERRSWT ;F
JRST ERRSWT ;G
JRST HELP ;H - HELP
JRST ERRSWT ;I
JRST ERRSWT ;J
TLZ IO,IOSYM ;K - KILL (SUPPRESS) SYMBOL TABLE LISTING
JRST ERRSWT ;L
TLZ IO,IOMAC ;M - SUPPRESS MACRO TABLE LISTING
JRST ERRSWT ;N
TLO IO,IOOP ;O - ENABLE OPCODE TABLE LISTING
TLO IO,IOPROT ;P - PROTECT (I.E. DON'T DELETE) INPUT FILES
JRST ERRSWT ;Q
SETOM FIRSTL ;R - USER WILL SPECIFY STARTING LINE NUMBER
TLO IO,IOLST!IOLSTS ;S - SUPPRESS PROGRAM. LIST ONLY TABLES.
TLO TIO,TIOLE ;T - ADVANCE TO END OF TAPE
JRST ERRSWT ;U
JRST ERRSWT ;V
TLO TIO,TIORW ;W - REWIND TAPE
JRST ERRSWT ;X
JRST ERRSWT ;Y
TLO TIO,TIOCLD ;Z - ZERO DECTAPE DIRECTORY
;[42] HERE ON UNKNOWN SWITCH SEEN
ERRSWT: MOVEI C, "A"(C) ;[42] BACK TO ASCII LETTER
MOVEI RC,[[ASCIZ\?CRFUKS Unknown switch "/\]] ;[42][44]
PUSHJ P, PNTMSG ;[44] PRINT FIRST PART OF MESSAGE
EXCH TIO, MYWCH ;[44] NEED BLASTED WATCH BITS
TLNN TIO, (JW.WFL) ;[44] /MES:FIR ON?
JRST ERRSW1 ;[44] NO - SKIP THIS CRUD
CAIE C,12 ;[51] DON'T TYPE "/<LF>"
OUTCHR C ;[44] TELL USER OFFENDING SWITCH
OUTCHR [""""] ;[44]
TLNE IO, IOSINI ;[44] IN SWITCH.INI PROCESSING?
OUTSTR [ASCIZ/ in DSK:SWITCH.INI/] ;[44] TELL USER THIS ALSO
ERRSW1: EXCH TIO, MYWCH ;[44] RESTORE THINGS
OUTSTR CRLF ;[44] CAP OFF MESSAGE
TLNE IO, IOSINI ;[44] REGULAR OR SWITCH.INI ERROR?
JRST LEAVE ;[44] SWITCH.INI - LEAVE NOW (NO LOOP)
JRST CREF ;[44] USER ERROR - REGULAR RESTART
SUBTTL PROCESS COMMAND FILE REQUEST
CMDFIL: TLZ IO, IORSCN ;[43] CLEAR WEIRD RESCAN FLAG
MOVE AC0, FIRSTL ;[45] NEED TO CHECK FOR ".CREF/R @X"
TDNE AC0, LEAFLG ;[45] I.E., BOTH THESE FLAGS 'ON'
SETOM RRFLAG ;[45] SET STICKY CCL-TTY-RESCAN /R FLAG
SETZM LEAFLG ;[43] AND IT'S ASSOCIATED KLUDGE
TLON IO, IOCCL ;[33] FAKE CCL-MODE OPERATION
JRST CMDF05 ;[33] . . .
SKIPE TMPFLG ;[33] WHOOPS - ALREADY IN CCL MODE!
JRST CMDF04 ;[33] ONLY TMPCOR - FLAG PROCESSED
SETZM CTIDIR ;[33] NOT TMPCOR - THEN DSK:###CRE.TMP
SKIPN CMDFLG ;[33] OR WAS IT CMD FILE - IF SO SKIP
RENAME CTLI, CTIDIR ;[33] JUST CCL .TMP FILE - DELETE IT
CMDF04: SETZM TMPFLG ;[33] SCROUNGE AN EXTRA WORD!
CMDF05: SETOM CMDFLG ;[33] FLAG IN CMD FILE NOW!!!!!
RESET ;[33] NOW - STOP THE WORLD
CAIN ACDEV, 0 ;[33] USER GIVE EXPLICIT DEVICE?
MOVSI ACDEV, 'DSK' ;[33] NO - USE GOOL OLE DSK:
MOVEM ACDEV, CTIDEV ;[33] REMEMBER IT FOR FUTURE
MOVEM ACFILE, CTIDIR ;[33] SAVE AWAY FILENAME,
MOVEM ACEXT, CTIDIR + 1 ;[33] FILE EXTENSION,
MOVEM ACPPN, CTIDIR + 3 ;[33] AND THE PATH
MOVEI ACDEV-1, 1 ;[33] SET OPEN MODE
MOVEI ACDEV+1, CTIBUF ;[33] AND INPUT RING HEADER
OPEN CTLI, ACDEV - 1 ;[33] GET COMMAND DEVICE
JRST NOCLDV ;[33] ERROR - CAN'T GET IT
INBUF CTLI, 1 ;[33] ONLY NEED ONE BUFFER!
MOVE ACTMP, .JBFF ;[33] ALSO NEED TO RESET .JBFF
MOVEM ACTMP, SVJFF ;[33] FOR FUTURE "RESETTING"
LOOKUP CTLI, CTIDIR ;[33] NOW - LOOKUP THE ACTUAL FILE
CAIA ;[33] OOPS - NOT THERE
JRST RETCCL ;[33] NOW GO DO ACTUAL CREFFING
JUMPN ACEXT, NOCLKP ;[33] IF EXPLICIT EXTENSION, ERROR
MOVSI ACEXT, 'CCL' ;[33] NO EXTENSION - TRY DEFAULT .CCL
MOVEM ACEXT, CTIDIR + 1 ;[33] . . .
MOVEM ACPPN, CTIDIR + 3 ;[33] ALSO RESTORE PATH
LOOKUP CTLI, CTIDIR ;[33] NOW TRY AGAIN
JRST NOCLKP ;[46] SIGH
JRST RETCCL ;[33] GOT IT - GO READ IT.
SUBTTL RUN ANOTHER PROGRAM
;SHRINK CORE, START ANOTHER PROGRAM WHEN A FILE SPEC TERMINATOR IS "!"
RUNUUO: SKIPN ACDEV ;IF NO DEVICE, DEFAULT IS SYS:
MOVSI ACDEV,'SYS'
MOVEM ACPPN,5 ;MOVE PROJ,PROG TO 5TH LOCATION
SETZB 4,6
;THIS LEAVES DEVICE IN AC1
;FILENAME IN AC2
;EXTENSION IN AC3
;0 IN AC4
;PROJ,PROG IN AC5
;0 IN AC6
MOVEI 7,1 ;ADDRESS OF RUN BLOCK
TLNE IO,IOCCL ;IN CCL MODE?
TLO 7,1 ;YES. SET STARTING ADDRESS INCREMENT
MOVE 0,[CORRUN,,10] ;MOVE INSTRUCTIONS TO ACS
BLT 0,10+COREND-CORRUN ;MOVE CODE INTO ACS
MOVE P,[3,,RUNARG]
IFE STANSW,< MOVE 0,[1,,1] ;USED BY CORE UUO >
IFN STANSW,< MOVEI 0,1 ;USED BY CORE UUO >
RESET ;KILL OPEN FILES
JRST 10 ;GO SHRINK CORE AND DO RUN
CORRUN: CORE 0, ;10 SHRINK
JFCL ;11 IGNORE FAILURE
COMPT. P, ;TRY SIMULATED RUN
JFCL ;OOPS. HARD TO RECOVER
RUN 7, ;12 GET NEXT PROGRAM
COREND: HALT ;13 LET MONITOR PRINT ANY ERROR MESSAGES
CRLF: BYTE(7)15,12
SUBTTL DSK:SWITCH.INI[,] SWITCH DEFAULTING
DOSINI: MOVEI TEMP, 1 ;[44] ASCII LINE MODE
MOVSI TEMP+1, 'DSK' ;[44] DEVICE GOOD-OLE-DSK
MOVEI TEMP+2, CTIBUF ;[44] RING HEADER BLOCK
OPEN SINI, TEMP ;[44] TRY FOR THE DEVICE
POPJ P, ;[44] OH FOR CRYING OUT LOUD!!
MOVEI TEMP, 3 ;[44] NOW BUILD LOOKUP BLOCK
MOVE TEMP+1, MYPPN ;[47] USE LOGGED-IN PPN FOR PATH
;[47] THIS IS THE SCHEME THAT SCAN
;[47] USES, GOOD A CONVENTION AS ANY.
MOVE TEMP+2, ['SWITCH'] ;[44] FILENAME
MOVSI TEMP+3, 'INI' ;[44] AND OF COURSE, THE EXTENSION
LOOKUP SINI, TEMP ;[44] SEE IF SWITCH.INI THERE
POPJ P, ;[44] AT ANY RATE, WE CAN'T HAVE IT
PUSH P, IO ;[44] SAVE FLAGS IN IO
PUSH P, .JBFF ;[44] SAVE CURRENT .JBFF
MOVEM P, PDSINI ;[44] PRESERVE STACK
INBUF SINI, 1 ;[44] ONLY NEED ONE BUFFER
MOVSI IO, IOSINI ;[44] FLAG NOW PROCESSING SWITCH.INI
SETOB FLAG, CTIBUF+2 ;[44] SOME GARBAGE FLAGS
DOSIN2: PUSHJ P, TTISIX ;[44] READ KEYWORD
CAMN ACTXT, ['CREF '] ;[44] IS IT FOR US?
JRST DOSIN4 ;[44] YES - GO SLURP IT UP
PUSHJ P, EATLIN ;[44] NAH - TOSS OUT LINE
JRST DOSIN2 ;[44] AND TRY AGAIN
DOSIN4: PUSHJ P, TTRSCN ;[44] GET SWITCH MASK
JRST ERSINI ;[44] OOPS - NAUGHTY NAUGHTY NAUGHTY
TLNE ACTXT, (SWT.HH ! SWT.RR);[45] /H OR /R IN SWITCH.INI
JRST ERSINH ;[44] YES - GOOD GRIEF
IORM ACTXT, SWSINI ;[44] ACCUMULATE SWITCHES
JRST DOSIN2 ;[44] KEEP LOOKING (GREEDY, AREN'T I?)
DOSIN6: RELEAS SINI, ;[44] TIME TO GO AWAY
MOVE P, PDSINI ;[44] GET BACK OLD "P"
POP P, .JBFF ;[44] RESTORE .JBFF
POP P, IO ;[44] AND IO FLAGS
POPJ P, ;[44] RETURN TO WHENCE-EVER
ERSINH: JSP RC, ERRMSG ;[44] LIKE I SAID . . .
[ASCIZ\%CRFSIH "/H" or "/R" switch illegal in SWITCH.INI defaulting\] ;[44]
JRST DOSIN6 ;[44] JUST A WARNING
ERSINI: JSP RC, ERRMSG ;[44] GARBAGE IN SWITCH.INI
[ASCIZ/%CRFSII Syntax error in SWITCH.INI defaults/] ;[44]
JRST DOSIN6 ;[44] JUST A WARNING
SUBTTL INPUT FILE HANDLING
;LOGIC FOR INPUT FILE HANDLING (DEFAULTS, OPEN AND LOOKUP)
INFILE: TLNE TIO,TIOCLD ;DIRECTORY CLEAR ILLEGAL FOR INPUT
JRST ERRCM
SKIPN ACDEV
MOVSI ACDEV,'DSK' ;DEFAULT INPUT DEVICE
MOVEM ACDEV,INDEV ;SAVE DEVICE FOR ERR MESSAGES
SKIPN ACFILE
MOVE ACFILE,[SIXBIT /CREF/]
MOVEM ACFILE,INDIR ;STORE FILE IN DIRECTORY
HLLZM ACEXT,INDIR+1 ;STORE EXTENSION TOO
MOVEM ACPPN,INDIR+3 ;STORE PROJ,PROG IN DIRECTORY
MOVEI ACTMP,2 ;YES. SET UP TRIES
TRYAGN: MOVE FLAG,[10,,INARG]
COMPT. FLAG, ;TRY TO OPEN INPUT FILE
JRST [TLNN FLAG,-1 ;UNIMPLEMENTED?
JRST MORMOR ;NO. GO ON TO TRY MORE
JRST EXTAGN] ;YES. TRY SIXBIT STUFF
SKIPE INDIR+1 ;ALREADY HAVE AN EXTENSION?
JRST GOTIN ;YES. USE IT
SETZM TXTBUF ;CLEAR PUT BUFFER
MOVE ACTXT,[CHAR,,CP.NAM] ;GET EXT NAME
HRROI ACTXT+1,TXTBUF ;THE BUFFER
MOVSI ACTXT+2,(1B11) ;EXTENSION ONLY
MOVE ACTMP,[3,,ACTXT]
COMPT. ACTMP, ;DO THE UUO
JFCL ;IT HAS TO WORK
MOVE ACTMP,TXTBUF ;GET TEXT BUFFER
MOVSI ACTXT,'CRF' ;TO FAK OUT DELETE CODE
CAME ACTMP,[ASCIZ /CRF/]
CAMN ACTMP,[ASCIZ /LST/]
MOVEM ACTXT,INDIR+1 ;STORE NAME TO BE DELETED
JRST GOTIN
MORMOR: SOSGE ACTMP ;MORE TRIES?
JRST EXTFAL ;NO. TSK TSK
HRRO FLAG,[[ASCIZ /TMP/]
[ASCIZ /LST/]](ACTMP) ;GET NEW EXTENSION
MOVEM FLAG,EXTNAM ;TO DEFAULT BLOCK
JRST TRYAGN ;AND DO IT AGAIN
EXTFAL: MOVE CS,INARG+2 ;THE BAD NAME
JSP RC, DVFNEX ;[34] GO PRINT ERROR
[ASCIZ/?CRFCFI Cannot find input file, /] ;[34]
POPJ P, ;AND GIVE UP
EXTAGN: SETZ FLAG,
SKIPE SYNERR ;SIXBIT SCAN GOOD?
JRST ERRCM ;NO. BOMB IT
MOVEI ACDEV-1,0 ;INIT DEVICE SETUP
MOVEI ACDEV+1,INBUF ;SET UP ARG FOR BUFFER HEADER
OPEN CHAR,ACDEV-1 ;OPEN CHANNEL
JRST ERRAVI ;FAILED
GOTIN: TLZE TIO,TIORW ;REWIND REQUESTED?
MTAPE CHAR,1 ;YES
TLZE TIO,TIOLE
MTAPE LST,10 ;ADVANCE TO END OF TAPE
JUMPGE CS,INFIL2 ;ADVANCE/BACKSPACE?
MTAPE CHAR,17
MTAPE CHAR,17
AOJL CS,.-1
MTAPE CHAR,0 ;[20] WAIT FOR TAPE TO STOP.
STATO CHAR,1B24 ;SKIP IF AT LOADPOINT
MTAPE CHAR,16 ;NOT LOADPOINT. ADVANCE OVER EOF MARK
INFIL2: SOJGE CS,.-1
SKIPE NOIOJF ;[51] CAN WE DO THE I/O BUFFERS?
JRST INFIL3 ;[51] NO - MUST BE DONE AT LSTS7
HRRZS CS,.JBFF
MOVEM CS,IOJFF ;SAVE .JBFF TO RECLAIM THIS BUFFER SPACE
INBUF CHAR,2
MOVE CS,.JBFF ;[52] SEE HOW BIG IT GREW
CAMLE CS,FRJFF ;[52] OVERFLOW PRE-ALLOCATED?
JRST CRFIBP ;[52] YES - CAN'T HAVE TIMESHARING
;[52] OF FREE CORE,IO BUFFERS
INFIL3: SKIPE FLAG ;NEED TO DO LOOKUP?
JRST INFILN ;NO. COMPT. WORKED
JUMPN ACEXT,INFIL4 ;TAKE USER'S EXTENSION IF NON-BLANK
MOVE ACEXT,[SIXBIT /CRFLST/] ;TRY CRF 1ST, THEN LST
JSP ACDEV,INFILI ;LOOKUP FILE (DON'T RETURN IF FOUND)
JUMPN ACEXT,.-1 ;KEEP LOOKING UNTIL EXT'S GONE
MOVSI ACEXT,'TMP' ;FINALLY TRY TMP THEN NULL
JSP ACDEV,INFILI
INFIL4: JSP ACDEV,INFILI
MOVEI CS,INDEV ;POINT TO INPUT DESCRIPTOR
JSP RC,DVFDIR ;GO PRINT MSG, AND FILE NAME
[ASCIZ/?CRFCFF Cannot find file, /] ;[17][34] IDENTIFY MESSAGE
TLO IO,IOPROT ;DON'T DELETE ANY INPUT FILES
POPJ P, ;ERROR RETURN
INFILI: HLLM ACEXT,INDIR+1 ;STORE EXTENSION
HRLZ ACEXT,ACEXT ;SLIDE NEXT EXT INTO PLACE
LOOKUP CHAR,INDIR
JRST (ACDEV) ;NOT FOUND
;**;[54] Remove edit 22 @ INFILN JNG 24-Mar-77
INFILN: TLNN IO,IOCCL ;TYPE FILE NAME IF IN CCL MODE
JRST CPOPJ1 ;SUCCESS RETURN
OUTCHR [11]
MOVE ACTMP,[3,,ACTXT] ;[T20] ARGS
MOVE ACTXT,[CHAR,,CP.NAM] ;[T20]
HRROI ACTXT+1,TXTBUF ;[T20]
MOVSI ACTXT+2,(1B8) ;[T20] NAME ONLY
COMPT. ACTMP, ;[T20] GET THE NAME
SKIPA CS,INARG+2 ;[T20] FAILED, USE OLD WAY
MOVEI CS,TXTBUF ;[T20] OUTPUT THE NAME
OUTSTR (CS) ;[T20]
OUTSTR CRLF ;FOLLOWED BY CARRIAGE RETURN
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
SUBTTL TTYIN COMMAND CHARACTER INPUT ROUTINE
;[37] HERE TO READ IN A COMMAND CHARACTER, HANDLING ALL THE USUAL
;[37] FORMATTING CONVENTIONS - CONTINUATION LINES ("-" FOLLOWED BY A
;[37] BREAK CHARACTER); COMMENTS (";" - NOTE THAT COMMENTS HAVE A
;[37] "HIGHER" PRIORITY THAN CONTINUATION - ";-<CR>" IS NOT A VALID
;[37] CONTINUATION LINE); SUPPRESS LINE-SEQUENCE NUMBERS IN INPUT;
;[37] CONVERT LOWER-CASE TO UPPER-CASE; CONVERT BREAK CHARACTERS TO
;[37] <LF> CHARACTER; COMPRESS <TAB> TO SPACE; CONVERT MULTIPLE SPACES
;[37] INTO ONE SPACE; SUPPRESS NULLS; AND IMMEDIATELY EXIT ON RECEIPT
;[37] OF EITHER ^C OR ^Z CHARACTERS.
;[37]
;[37] NOTE THAT TEMPORARILY "_" CHARACTER IS CONVERTED TO "=" AND A
;[37] WARNING MESSAGE IS ISSUED ("_" IS RESERVED FOR NETWORK USAGE).
;[37]
;[37] THE SEVEN-BIT ASCII CHARACTER WILL BE RETURNED IN ACCUMULATOR
;[37] C, RIGHT-JUSTIFIED. ALL OTHER AC'S WILL BE PRESERVED.
TTYIN: PUSHJ P, CCLIN ;[37] READ IN ANOTHER CHARACTER
CAIN C, "-" ;[37] POSSIBLE CONTINUATION LINE
JRST TTYDSH ;[37] YES - GO CHECK IT OUT
CAIN C, " " ;[43] SPACE ??
JRST TTYSPC ;[43] YES - GO EAT AS MANY AS POSSIBLE
CAIN C, ";" ;[43] COMMENT?
JRST EATLIN ;[43] YES - GO EAT REST OF LINE, RETURN <LF>
TTYINR: MOVEM C, LASCHR ;[43] SET LAST CHARACTER RETURNED
CAIN C, 12 ;[45] EOL??
TLZ IO, IORSCN ;[45] YES - END OF TTY RESCAN INPUT
POPJ P, ;[45] RETURN
;[37] HERE TO EAT THE REST OF THE LINE (AS FOR A COMMENT). ALL CHAR-
;[37] ACTERS UP TO THE NEXT BREAK CHARACTER IN THE COMMAND INPUT STREAM
;[37] WILL BE READ AND DISCARDED, THE BREAK CHARACTER WILL BE RETURNED
;[37] AS A <LF> IN ACCUMULATOR C.
EATLIN: PUSHJ P, CCLIN ;[37] READ NEXT CHARACTER
CAIE C, 12 ;[37] EOL YET?
JRST EATLIN ;[37] NOT YET - KEEP EATING THOSE CHARS
JRST TTYINR ;[43] RETURN WITH <LF>
TTYIN2: AOS CTIBUF+1 ;FLUSH SOS LINE NUMBERS
MOVNI C,5
ADDM C,CTIBUF+2
CCLIN: SKIPN C, RPTCHR ;[37] NEED TO "REPEAT" A CHARACTER?
JRST CCLIN0 ;[37] NO - SKIP NONSENSE
SETZM RPTCHR ;[37] YES - FLAG AS DONE
JRST CCLIN2 ;[37] AND CARRY ON ELSEWHERE
CCLIN0: SOSG CTIBUF+2
JRST CKCCLI ;NEED ANOTHER BUFFER
CCLIN1: IBP CTIBUF+1
MOVE C,@CTIBUF+1
TRNE C,1 ;TEST FOR SOS LINE NUMBERS
JRST TTYIN2 ;SOS LINE NUMBER SEEN
LDB C,CTIBUF+1
JUMPE C,CCLIN ;IGNORE NULLS
CCLIN2: CAILE C, " " ;[37] CONTROL OR PRINTING CHAR?
JRST CCLIN6 ;[37] PRINTING - GO ELSEWHERE
CAIN C, 15 ;[37] CONTROL - SUPPRESS <CR>'S
JRST CCLIN ;[37] I.E., EAT THEM WHOLE (RAW EVEN)
CAIN C, 11 ;[36] <TAB>??
MOVEI C, " " ;[36] YES - CONVERT TO SPACE
CAIE C, 3 ;[36] ^C
CAIN C, 32 ;[36] OR ^Z ??
JRST LEAVE ;[36] YES - GO EXIT
CAIE C, 33 ;[36] <ESC>
CAIN C, 7 ;[36] OR <BEL>??
JRST CCLIN4 ;[37] YES - BREAK - CONVERT TO <LF>
CAIE C, 13 ;[36] <VT>
CAIN C, 14 ;[36] OR <FF> ??
CCLIN4: MOVEI C, 12 ;[36] YES - BREAK - CONVERT TO <LF>
POPJ P, ;[37]
;[37] HERE ON REGULAR PRINTING CHARACTERS
CCLIN6: CAIN C, 177 ;[37] <DEL> CHARACTER?
JRST CCLIN ;[37] YES - EAT IT
CAIN C, "_" ;[36] "_" CHARACTER?
JRST TTYLAR ;[36] YES - SPECIAL HANDLING
CAIL C, "A" + 40 ;[36] LOWER CASE ALPHABETICS
CAILE C, "Z" + 40 ;[36] . . .
POPJ P, ;[36] NO - RETURN NEW CHARACTER IN C
SUBI C, 40 ;[36] YES - MAKE UPPER CASE
POPJ P, ;[36] AND RETURN
;[43] HERE TO SUPPRESS LEADING & TRAILING SPACES, COMPRESS
;[43] MULTPLE SPACES INTO ONE SPACE.
TTYSPC: SKIPN C, LASCHR ;[43] SEEN ANYTHING YET?
JRST TTYIN ;[43] NO - JUST EAT LEADING SPACE
CAIN C, 12 ;[43] LEADING SPACE THIS LINE?
JRST TTYIN ;[43] YES - ABSORB IT
TTYSP1: PUSHJ P, CCLIN ;[43] PEEK AT NEXT CHARACTER
CAIN C, " " ;[43] MULTIPLE SPACES
JRST TTYSP1 ;[43] YEP - COMPRESS
CAIN C, "-" ;[43] POSSIBLE CONTINUATION?
JRST TTYDSH ;[43] YES - GO CHECK IT OUT
CAIN C, ";" ;[43] HOW ABOUT A COMMENT?
JRST EATLIN ;[43] YEP! KRUMP REST OF LINE
MOVEM C, RPTCHR ;[43] NO - THEN NEED TO RETURN A SPACE
MOVEI C, " " ;[43] AND SAVE LAST CHARACTER TO BE RE-EATEN
JRST TTYINR ;[43] RETURN WITH SPACE IN C
TTYLAR: PUSH P, RC ;[35] REALLY SHOULD SAVE AC'S
MOVEI RC,[[ASCIZ/%CRFPUE Please use "=" rather than "_"
/]] ;[35]
PUSHJ P, PNTMSG ;[35] COMPLAIN AT USER FOR USING "_"
POP P, RC ;[35] RESTORE GRUNDGE ACS
MOVEI C, "=" ;[35] IN FUTURE, "_" IS FOR NETWORKS
JRST TTYINR ;[43] FOR NOW, MERELY RETURN "="
;[37] HERE TO IMPLEMENT CONTINUATION LINES
TTYDSH: PUSHJ P, CCLIN ;[37] SEE WHAT NEXT CHARACTER IS
CAIN C, " " ;[37] TRAILING SPACES?
JRST TTYDSH ;[37] YES - JUST ABSORB THEM
CAIN C, ";" ;[37] COMMENT FIELD EMBEDDED IN CONT LINE?
JRST TTYDS0 ;[37] YES - WHAT A PAIN!
CAIN C, 12 ;[37] . . .
JRST TTYDS1 ;[37] WAS A BREAK - CONTINUATION LINE
MOVEM C, RPTCHR ;[37] REGULAR - SAVE FOR NEXT CALL TO RE-GET
MOVEI C, "-" ;[37] AND RETURN A REAL "-" IN C
JRST TTYINR ;[37] . . .
TTYDS0: PUSHJ P, EATLIN ;[37] FIRST EAT THE BLOODY COMMENT
TTYDS1: SKIPE TMPFLG ;[37] ARE WE IN TMPCOR?
JRST TTYIN ;[37] YES - THEN JUST KEEP READING
MOVEI C, CTLI ;[37] NO - THEN WE NEED TO SEE
DEVCHR C, ;[37] WHAT THE COMMAND DEVICE IS
JUMPE C, TTYDS2 ;[37] NONE - ASSUME TTY
TLNN C, (DV.TTA) ;[37] IS DEVICE CONTROLLING TTY?
JRST TTYIN ;[37] NO - JUST GO ASK FOR MORE INPUT
SKPINL ;[37] YES - HAS USER TYPED A FULL LINE AHEAD?
TTYDS2: OUTCHR ["#"] ;[37] NO - THEN PROMPT HIM WITH A "#"
JRST TTYIN ;[37] AND GO READ MORE
CKCCLI: TLNE IO, IOSINI ;[44] IN SWITCH.INI?
JRST CKSINI ;[44] YES - READ IT THEN
IFN TEMPC,< SKIPE TMPFLG ;IS TMPCOR UUO IN ACTION?
JRST LEAVE > ;[33] YES, EXIT
TLNN IO, IORSCN ;[43] DOING TTY RESCAN INPUT?
JRST CKCCL5 ;[43] NO - REGULAR THING
CKCCL2: INCHWL C ;[43] YES - READ 'NOTHER CHAR
JUMPN C, CCLIN2 ;[43] AND GO DO IT
JRST CKCCL2 ;[43] YOU NEVER CAN TELL . . .
CKCCL5: IN CTLI,0 ;READ ANOTHER BUFFER
JRST CCLIN1
STATO CTLI,740000
JRST CKCCL7 ;[43] EOF
GETSTS CTLI,ERRSTS
MOVEI CS,CTIDEV
JSP RC,DVFSTS ;PRINT MESSAGE AND ERR #
[ASCIZ/?CRFCFE Command file INPUT error, /] ;[17][34] IDENTIFY MESSAGE
JRST CREF
CKCCL7: TLNN IO,IOCCL ;IN CCL MODE?
JRST LEAVE ;NO, GET OUT
SETZB TEMP,TEMP+1 ;YES, DELETE COMMAND FILE
SETZB TEMP+2,TEMP+3
SKIPN CMDFLG ;[33] DON'T DELETE USER COMMAND FILES
RENAME CTLI,TEMP ;[33] WAS CCL-ENTRY - ###CRE.TMP
JFCL ;[33] AND FALL INTO LEAVE CODE
LEAVE: EXIT 1, ;[33] EXIT POLITELY
JRST CREF ;[33] USER TYPED "CONTINUE"
;[44] HERE TO READ IN MORE OF SWITCH.INI
CKSINI: IN SINI, ;[44] NEED 'NOTHER BUFFER
JRST CCLIN1 ;[44] GOT IT
GETSTS SINI, C ;[44] DIDN'T GET IT
TRNE C, IO.EOF ;[44] GOOD OR BAD?
JRST DOSIN6 ;[44] ONLY EOF - THAT'S GOOD
JSP RC, ERRMSG ;[44] WAS ERROR - THAT'S BAD
[ASCIZ\%CRFSIO I/O error while reading SWITCH.INI\] ;[44]
JRST DOSIN6 ;[44] DOESN'T SEEM REASONABLE TO
;[44] CALL THIS FATAL
;[43] TTRSCN -- ROUTINE TO READ INPUT STREAM AND BUILD MASK OF
;[43] SWITCHES SEEN. WILL FORCE A ?CRFUKS ERROR IF ILLEGAL
;[43] SWITCH IS SEEN. RETURNS MASK IN ACTXT - 1B<N> IS ON FOR
;[43] <SWITCH - "A"> - I.E., A IS 1B0, B IS 1B1, ETC. ALSO, THE
;[43] ASCII TEXT STREAM IS LEFT IN TTRBUF FOR THOSE WEIRD PEOPLE
;[43] WHO LIKE IT, OR IN CASE OF NON-SWITCHES ENCOUNTERED (E.G., A
;[43] FILE SPEC).
;[43]
;[43] NORMAL RETURN IS CPOPJ1, ACTXT SET, C=<LF>
;[43] ERROR RETURN IS CPOPJ0, C=<ASCII CHAR>
TTRSCN: MOVNI FLAG, <TTRSIZ * 5> ;[43] MAX CHARS ALLOWABLE
MOVE CS, [POINT 7,TTRBUF] ;[43] BUFFER TO BE BUILT
SETZ ACTXT, ;[43] INITIALIZE MASK
CAIN C, " " ;[43] IGNORABLE SPACE???
TTRS01: PUSHJ P, TTYIN ;[43] NEXT CHARACTER
AOJGE FLAG, . + 2 ;[43] ROOM??
IDPB C, CS ;[43] YES
CAIN C, " " ;[43] SPACE?
JRST TTRS01 ;[43] YES - EAT IT
CAIN C, 12 ;[43] EOL?
JRST CPOPJ1 ;[43] YES - ALL DONE - GO AWAY
CAIE C, "/" ;[43] SWITCH COMING UP?
POPJ P, ;[43] NO - ERROR (OR SOMETHING)
PUSHJ P, TTYIN ;[43] YES - READ IN SWITCH
AOJGE FLAG, . + 2 ;[45] ROOM
IDPB C, CS ;[45] YES - REMEMBER
MOVEI C, -"A"(C) ;[43] MAKE INTO OFFSET
CAILE C, "Z" - "A" ;[43] IN RANGE???
JRST ERRSWT ;[43] NO - CAUSE ERROR
MOVE ACTMP, SWTAB(C) ;[43] SEE WHAT IT IS
CAMN ACTMP, . + 1 ;[43] LEGAL SWITCH?
JRST ERRSWT ;[43] NO - ISSUE ERROR MSG
MOVSI ACTMP, (1B0) ;[43] GET SET TO GENERATE
MOVNI C, (C) ;[43] LATEST BIT TO
LSH ACTMP, (C) ;[43] FLAG
IOR ACTXT, ACTMP ;[43] ACCUMULATE ALL SEEN SWITCHES
JRST TTRS01 ;[43] LOOP BACK FOR MORE
SUBTTL FILE INPUT
READ: SOSG INBUF+2 ;BUFFER EMPTY?
JRST READ3 ;YES
READ1: ILDB C,INBUF+1 ;PLACE CHARACTER IN C
JUMPE C,READ
POPJ P,
READ3: IN CHAR,0 ;GET NEXT BUFFER.
JRST READ1 ;OK SO FAR. (THIS IGNORES EOT AS AN ERROR)
GETSTS CHAR,C ;GET FILE STATUS
TRNE C,020000 ;EOF?
JRST READ4 ;YES.
MOVEM C,ERRSTS ;REAL ERROR. SAVE ERROR STATUS
MOVEI CS,INDEV
JSP RC,DVFSTS
[ASCIZ/?CRFINE INPUT error, /] ;[17][34] IDENTIFY MESSAGE
JRST CREF
READ4: MOVE C,CMDTRM ;GET COMMAND TERMINATION CHARACTER
CAIN C,","
JRST READ5 ;TERMINATOR WAS A COMMA. CONCATENATE FILES
TLO IO,IOEOF ;NO COMMA, THAT WAS LAST FILE
JRST R0 ;GO PRINT RESULTS
READ5: MOVE 0,[1,,CMDSAV+1] ;SAVE AC'S FOR COMMAND SCANNER.
BLT 0,CMDSAV+16 ;0 IS TEMP, 17 ALWAYS PDL
HLRZ 1,INDIR+1 ;[53] GET INPUT EXTENSION
CAIE 1,'CRF' ;[53] IS IT A .CRF
CAIN 1,'LST' ;[53] OR A .LST FILE?
TLNE 1,IOPROT ;[53] AND USER DIDN'T TYPE "/P"?
JRST READ6 ;[53] DO NOT DELETE INPUT FILE
SETZB 1,4 ;[50] NEED TO DELETE INPUT FILES
RENAME CHAR,1 ;[50] DELETE IT
JFCL ;[50] EH - SO WHAT?
READ6: PUSHJ P,NAME1 ;SCAN NEXT INPUT FILE
MOVE C,IOJFF ;RESTORE .JBFF TO REUSE BUFFER SPACE
MOVEM C,.JBFF
SETZM CMDSAV+C ;FLAG SUCCESS FOR INFILE
PUSHJ P,INFILE ;SET UP THE INPUT FILE
SETOM CMDSAV+C ;FLAG FAILURE FOR INFILE
MOVSI 16,CMDSAV ;RESTORE THE AC'S
BLT 16,16
JUMPE C,READ ;AND TRY TO READ THIS FILE'S INPUT
JRST READ4 ;INFILE FAILED. LOOK FOR NEXT FILE.
SUBTTL ERROR MESSAGES/ERROR TYPEOUT
ERRAVI: SKIPA CS,INARG+2 ;INPUT DEVICE INIT FAILURE
ERRAVL: MOVE CS,OUTARG+2 ;LISTING DEVICE INIT FAILURE
JSP RC,DVFNEX
[ASCIZ/?CRFDNA Device not available, /] ;[17][34] IDENTIFY MESSAGE
JRST CREF
ERRENT: MOVEI CS,LSTDEV ;ENTER FAILURE
JSP RC,DVFDIR
[ASCIZ/?CRFCEF Cannot ENTER file, /] ;[17][34] IDENTIFY MESSAGE
JRST CREF
ERRCOR: JSP RC,ERRMSG ;CORE UUO FAILURE
[ASCIZ/?CRFIMA Insufficient memory available/] ;[17][34] IDENTIFY MESSAGE
JRST CREF
;**;[54] Remove edit 22 @ ERRCOR+5L JNG 24-Mar-77
IFN STANSW,<HELP:>
ERRCM: JSP RC,ERRMSG ;[17] IDENTIFY MESSAGE
IFE STANSW,< [ASCIZ\?CRFCME Command error - type /H for help\] > ;[34]
IFN STANSW,< [ASCIZ\?CRFCME Command error\] > ;[34]
CAIE C,12 ;[51] ARE WE ALREADY AT EOL?
PUSHJ P,EATLIN ;[51] NO - EAT REST, DON'T RESCAN IT
JRST CREF
NOCLKP: MOVEI CS, CTIDEV ;[33] ADDR OF ERROR STUFF
JSP RC, DVFDIR ;[33] GO TYPE OUT MESSAGE
[ASCIZ/?CRFCLC Can't LOOKUP command file /] ;[34]
JRST CREF ;[33] OH WELL
NOCLDV: MOVEI CS, CTIDEV ;[33] ADDR OF ERROR STUFF
JSP RC, DVFDEV ;[33] GO TYPE MESSAGE
[ASCIZ/?CRFCDN Can't get command file device /] ;[34]
JRST CREF ;[33] GO PROMPT USER AGAIN
CRFIBP: MOVEI CS,INDEV ;[52] OFFENDING DEVICE
HLLZS INDEV+2 ;[52] GIVE A "0" (AS IF IT MATTERS)
JSP RC,DVFDIR ;[52] ISSUE ERROR MESSAGE
[ASCIZ/?CRFIBP Input buffer size phase error - /] ;[52]
JRST CREF ;[52] RESTART EVERYTHING
ERRMSG: PUSHJ P,PNTMSG ;FOR SIMPLE ERROR MESSAGES
OUTSTR CRLF ;TYPE CRLF
JRST (RC) ;RETURN TO AFTER SIXBIT TEXT
DVFNEX: PUSHJ P,PNTMSG ;PRINT MESSAGE DEV:FILENAME.EXT
EXCH IO, MYWCH ;[40] NEED WATCH BITS
TLNE IO, (JW.WFL) ;[40] IF NO /MESS:FIRST THEN SKIP
OUTSTR (CS) ;[34] FINISH OFF MESSAGE
JRST ERRFIN ;AND DONE
DVFDEV: PUSHJ P, PNTMSG ;[33] PRINT MESSAGE
EXCH IO, MYWCH ;[40] SEE IF /MESS:FIRST IS ON
TLNN IO, (JW.WFL) ;[40] . . .
JRST ERRFIN ;[40] WASN'T - NO MORE OUTPUT
PUSHJ P, PNTSIX ;[33] FOLLOWED BY OFFENDING DEVICE
OUTCHR [":"] ;[33] APPEND ":" FOR LOOKS
JRST ERRFIN ;[33] CAP OFF AND RETURN TO CALLER
DVFDIR: HRRZ C,2(CS) ;PRINT MESSAGE WITH DIR ERR #
MOVEM C,ERRSTS
DVFSTS: PUSHJ P,PNTMSG ;PRINT MESSAGE, ERR #, DEV:FILENAM.EXT
EXCH IO, MYWCH ;[40] GET COPY OF WATCH BITS
TLNN IO, (JW.WFL) ;[40] /MESS:FIRST ON?
JRST ERRFIN ;[40] NO - SKIP FURTHER OUTPUT
PUSH P,RC ;SAVE RETURN AT END OF SIXBIT TEXT
PUSHJ P,PNTSTS
OUTCHR [" "]
POP P,RC ;GET RETURN BACK NOW
PUSHJ P,PNTSIX ;PRINT DEVICE
OUTCHR [":"]
ADDI CS,1 ;ADVANCE POINTER TO FILENAME
SKIPN (CS) ;IS FILENAME 0?
JRST ERRFIN ;YES, NO FILENAME
PUSHJ P,PNTSIX ;NO, PRINT FILENAME
ADDI CS,1 ;ADVANCE POINTER TO EXTENSION
HLLZS C,(CS) ;ZERO OUT OTHER HALF. EXTENSION=0?
JUMPE C,ERRFIN ;EXTENSION 0?
OUTCHR ["."] ;NO
PUSHJ P,PNTSIX ;PRINT EXTENSION
ERRFIN: OUTSTR CRLF ;TYPE RETURN
EXCH IO, MYWCH ;[40] RESTORE STUFF
JRST 0(RC) ;RETURN
PNTMSG: OUTSTR CRLF ;PRINT SIXBIT MESSAGE
PNTM0: PUSH P, AC0 ;[40] NEED
PUSH P, TEMP ;[40] SOME
PUSH P, TEMP1 ;[40] GRUNDGE
PUSH P, RC ;[40] AC'S
PUSH P, SX ;[40] . . .
MOVE AC0, MYWCH ;[40] GET THE WATCH BITS
MOVEI RC, @(RC) ;[40] ADDRESS OF ERROR MESSAGE
HRLI RC, (POINT 7,) ;[40] THE USUAL BYTEPOINTER
MOVE SX, [POINT 7, ERRBUF] ;[40] WHERE TO BUILD THE MESSAGE
ILDB TEMP, RC ;[40] PICK UP FIRST CHAR ALWAYS
IDPB TEMP, SX ;[40] AND STUFF IT AWAY
TLNE AC0, (JW.WPR) ;[40] PREFIX ON?
JRST PNTM10 ;[40] YES - GO PRINT IT
IBP RC ;[40] NO - THEN ADJUST POINTER
AOJA RC, PNTM20 ;[40] AROUND PREFIX-PART
PNTM10: MOVEI TEMP1, 6 ;[40] LOOP COUNT FOR PREFIX
PNTM11: ILDB TEMP, RC ;[40] LOOP GETTING THE
IDPB TEMP, SX ;[40] PREFIX-PART
SOJG TEMP1, PNTM11 ;[40] (WHICH HAS 6 LETTERS)
PNTM20: SETZ TEMP, ;[40] NULL FOR EXIT
TLNE AC0, (JW.WFL) ;[40] /MESSAGE:FIRST?
PNTM30: ILDB TEMP, RC ;[40] GET NEXT CHARACTER
IDPB TEMP, SX ;[40] STUFF INTO OUTPUT BUFFER
JUMPN TEMP, PNTM30 ;[40] LOOP FOR WHOLE ASCIZ STRING
OUTSTR ERRBUF ;[40] OUTPUT MESSAGE TO USER TTY
POP P, SX ;[40] . . .
POP P, RC ;[40] S'CA
POP P, TEMP1 ;[40] EGDNURG
POP P, TEMP ;[40] EMOS
POP P, AC0 ;[40] DEEM
AOJA RC, CPOPJ ;[40] RETURN TO WHEREVER
PNTSIX: HRLI CS,(<POINT 6,0>) ;PRINT 1 WORD OF SIXBIT
PNTSX1: TLNN CS,770000 ;NEXT ILDB GO OVER WORD BOUNDARY?
POPJ P, ;YES, FINISHED
ILDB C,CS
JUMPE C,.-2 ;STOP AT A 0
ADDI C,40 ;CONVERT TO ASCII
OUTCHR C
JRST PNTSX1
PNTSTS: HRRZ RC,ERRSTS ;PRINT ERROR STATUS
PNTOCT: IDIVI RC,10 ;PRINT OCTAL NUMBER
HRLM RC+1,(P)
SKIPE RC
PUSHJ P,PNTOCT
HLRZ C,(P)
ADDI C,"0"
OUTCHR C
POPJ P,
ECNVRT: MOVEI TEMP,5 ;HERE TO TYPE A FIVE-DIGIT NUMBER FROM C
MOVEI TEMP1,0 ; LEFT-JUSTIFIED, ZERO-SUPPRESSED.
ECNVR1: IDIV C,TABL(TEMP)
ADD TEMP1,C
ADDI C,"0"
SKIPE TEMP1
OUTCHR C
MOVE C,CS
SOJGE TEMP,ECNVR1
POPJ P,
XLIST ;THE LITERALS ARE XLISTED FOR YOUR READING PLEASURE
LIT
LIST
SUBTTL FIXED DATA STORAGE
IFN SEGSW,< RELOC 0 ;IMPURE DATA AREA >
IFN SEGSW,< ;[31]
TNXLOW: RELOC ;[31] BACK TO HISEG (FOR TOPS-10)
TNXHGH: PHASE TNXLOW ;[31] BUILD PROTOTYPE FOR LOWSEG
> ;[31] END OF IFN SEGSW
OUTARG: LST,,CP.OPN ;OUTPUT ARG BLOCK
OUTBLK
-1,,TXTHLD
7B5+1B20
BLOCK 2
LSTBUF
RIB
OUTBLK: 1B0+1B17
377777,,377777
-1,,LSTNM1 ;[T20]
0
-1,,TXTBUF ;DEFAULT NAME
-1,,[ASCIZ /LST/]
BLOCK 5 ;REST IS DEFAULTED
LSTNM1: BLOCK 2 ;[T20]
RUNARG: CP.RUN ;ARG IS NOR USED
RUNBLK
-1,,TXTBUF
RUNBLK: 1B2+1B17 ;DEFAULT FOR RUN ARG
377777,,377777
-1,,SYSSTR ;FROM SYS
0
0
-1,,SAVSTR ;S SAVE FILE
BLOCK 5
INARG: CHAR,,CP.OPN
ALTARG ;LONG FORM
-1,,TXTBUF
7B5+1B19 ;READ ACCESS
0 ;MODE
0,,INBUF ;BUFFER HEADER
0
RIB
ALTARG: 1B2+1B17 ;OLD FILE
377777,,377777
BLOCK 3
EXTNAM: -1,,[ASCIZ /CRF/] ;CREF FILE
BLOCK 5
;FILE DEFITIONS FOR COMPT.
SYSSTR: ASCIZ /SYS/
SAVSTR: ASCIZ /SAV/
XLIST ;[31] EXPAND PHASED LITERALS
LIT ;[31]
LIST ;[31]
IFN SEGSW,< ;[31]
DEPHASE ;[31] BACK TO HISEG RELOCATION
TNXLEN==.-TNXHGH ;[31]
RELOC ;[31] BACK TO LOWSEG "CODE"
BLOCK TNXLEN ;[31] ALLOCATE LOWSEG AREA NEEDED
> ;[31] END OF IFN SEGSW
L1: BLOCK 1 ; [21] SAVE FOR LONG
L2: BLOCK 1 ; [21] SYMBOL ROUTINES
NOIOJF: BLOCK 1 ;[51] .NE. 0 TO DELAY IOJFF
SVJFF: BLOCK 1
MYPPN: BLOCK 1 ;[32] JOB'S PPN
MYWCH: BLOCK 1 ;[40] JOB'S WATCH BITS
ERRBUF: BLOCK ERRSIZ ;[40] BUFFER TO BUILD ERROR MESSAGES
TTRBUF: BLOCK TTRSIZ ;[43] BUFFER FOR TTY RESCAN
BZCOR: ;[37] START OF TO-BE-ZEROED ON PROG START
PDSINI: BLOCK 1 ;[44] P SAVE LOCATION
SWSINI: BLOCK 1 ;[44] SWITCH.INI SWITCH MASK
SWTINI: BLOCK 1 ;[44] .NE. 0 TO NOT USE SWITCH.INI DEFAULTS
TTRSWT: BLOCK 1 ;[43] MASK OF CCL STICKY SWITCHES
RRFLAG: BLOCK 1 ;[45] .NE. 0 IF /R IN TTY RESCAN
LEAFLG: BLOCK 1 ;[43] SPECIAL (I.E. KLUDGE) EXIT FLAG
LASCHR: BLOCK 1 ;[37] LAST COMMAND CHAR FROM TTYIN
RPTCHR: BLOCK 1 ;[37] .NE. 0 THEN CHAR TO RE-READ
CMDFLG: BLOCK 1 ;[33] .GT. 0 THEN TIME TO READ CMD FILE
;[33] .EQ. 0 THEN NOTHING
;[33] .LT. 0 THEN IN COMMAND FILE
CTIBUF: BLOCK 3 ;COMMAND FILE INPUT BUFFER HEADER
CTIDEV: BLOCK 1 ;INPUT COMMAND DEVICE
CTIDIR: BLOCK 4
TMPFIL: BLOCK 2 ;SIXBIT /CRE/
;XWD -200,C(.JBFF)
;FOR TMPCOR UUO
TMPFLG: BLOCK 1 ;FLAG FOR TMPCOR UUO IN PROGRESS
SCNPTH: BLOCK 2 ;[32] AREA TO BUILD PATH BLOCK
SCNPPN: BLOCK PTHLEN - 2 ;[32] PPN, SFD1, SFD2, ETC.
.WPL: BLOCK 1 ;NUMBER OF ENTRIES/LINE OF CREF (WPLTTY OR WPLLPT)
WRITEE: BLOCK 1 ;INSTR TO XCT TO GET INTO THE WRITE ROUTINE
WRITEX: BLOCK 1 ;INSTR TO XCT AT GET OUT OF THE WRITE ROUTINE
AWRITE: BLOCK 1 ;ADDRESS OF WRITER (EITHER WRITE OR CPOPJ)
M6X: BLOCK 1 ;INSTR TO XCT TO DECIDE WHETHER TO ENTER A SYMBOL
; IN THE SYMBOL TABLE
M0XCT: BLOCK 1 ;INSTRUCTION TO XCT TO WRITE A LEADING TAB.
DMPXCT: BLOCK 1 ;OUT LST, EXCEPT, FOR MTA OUTPUT: PUSHJ P,DMPOUT
SYNERR: BLOCK 1
TXTBUF: BLOCK TXTSIZ
STCLR: ;START BLT CLEAR HERE
OPTBL: BLOCK HASH+1 ;OPCODE TABLE (EXTRA CELLS NEEDED FOR MERGE)
MACTBL: BLOCK HASH+1
SYMTBL: BLOCK HASH+1
REFBIT: BLOCK 1 ;TEMP CELL FOR REFERENCE TYPE IN SRCH
REFINC: BLOCK 1 ;TEMP CELL FOR REFERENCE TYPE IN SRCH
SRTTMP: BLOCK 1 ;TEMP CELL FOR SORT
FRDTMP: BLOCK 1 ;TEMP CELL FOR FREAD
INBUF: BLOCK 3
INDEV: BLOCK 1 ;INPUT DEVICE (FOR ERR MESSAGES ONLY)
INDIR: BLOCK 4
LSTBUF: BLOCK 3
LSTDEV: BLOCK 1 ;LIST DEVICE (FOR ERR MESSAGES ONLY)
LSTDIR: BLOCK 4
LSTPTH: BLOCK PTHLEN ;[32] LIST DEVICE EXTENDED PATH
PPSAV: BLOCK 1 ;RESTORE P FROM HERE FOR "IMPROPER INPUT DATA"
PPSET: BLOCK PDL ;PUSH DOWN STACK; ALSO USED BY "RUN" UUO
CMDSAV: BLOCK 20 ;SAVE AC'S DURING COMMAND SCANNING
LPP: BLOCK 1
PPTEMP: BLOCK 1
FIRSTL: BLOCK 1 ;LINE # AFTER WHICH TO PRINT LISTING
ERRSTS: BLOCK 1 ;HOLDS ERROR STATUS FOR MESSAGES
CMDTRM: BLOCK 1 ;HOLS LAST CHARACTER IN COMMAND SCANNER
IOJFF: BLOCK 1 ;HOLDS .JBFF BEFORE INPUT BUFFERS SETUP
FRJFF: BLOCK 1 ;[52] HOLDS ORIGINAL IO BUFFER SIZE
;[52] FOR MULTI-INPUT OVERFLOW CHECK
LOWLIM: BLOCK 1 ;LOWER LIMIT (STARTING LINE #)
UPPLIM: BLOCK 1 ;UPPER LIMIT (ENDING LINE #)
SVLAB: BLOCK 1
LEVEL: BLOCK 1 ;BLOCK LEVEL FOR COMBG.
BLOCK 1 ;BLKST-1 IS CLOBBERD AT R0!!
BLKST: BLOCK 1
OFLAG: BLOCK 1
OFLAG1: BLOCK 1
OFLAG2: BLOCK 1
TXTHLD: BLOCK TXTSIZ
RIB: BLOCK 4
ASCCNT: BLOCK 1
BLKND: BLOCK 1
;**;[54] Remove edit 22 @ BLKND+2L JNG 24-Mar-77
ENDCLR= .-1
END CREF