Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
COMMENT VALID 00027 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE CREF %51.(20) CROSS REFERENCE PROGRAM
C00006 00003 SUBTTL REVISION HISTORY
C00007 00004 SUBTTL SYMBOLIC DEFINITIONS
C00009 00005 SUBTTL BIT DEFINITIONS FOR FLAGS IN ACCUMULATOR "IO"
C00014 00006 SUBTTL INITIALIZATION
C00020 00007 SUBTTL INITIALIZATION - LSTSET - SETUP DESTINATION DEVICE
C00025 00008 SUBTTL INITIALIZATION - INSET - PROCESS INPUT FILE NAME
C00028 00009 SUBTTL PROCESS CREF INPUT FILE
C00034 00010 SUBTTL SEARCH FOR A SYMBOL, ENTER ANOTHER REFERENCE
C00043 00011 SUBTTL HANDLE NEW-STYLE INPUT
C00048 00012 SUBTTL DEFMAC, DEFSYM, COMBIN
C00054 00013 SUBTTL LABELS AND BLOCKS. SETLAB, DLAB, BBEG, BBEND, BLKPRN,SETLIN
C00060 00014 SUBTTL EOF SEEN. OUTPUT TABLES AND FINISH UP.
C00064 00015 SUBTTL SORT SYMBOL TABLE
C00070 00016 SUBTTL OUTPUT ROUTINES. OUTP, GETVAL, CNVRT, OUTASC
C00074 00017 SUBTTL OUTPUT ROUTINES - TABOUT, LINOUT, WRITE
C00076 00018 SUBTTL HERE TO EXPAND CORE - XCEED
C00077 00019 SUBTTL SCAN COMMAND INPUT
C00081 00020 SUBTTL SWITCH PROCESSING
C00083 00021 SUBTTL COMMAND SWITCH TABLE
C00085 00022 SUBTTL RUN ANOTHER PROGRAM
C00087 00023 SUBTTL INPUT FILE HANDLING
C00091 00024 SUBTTL TTYIN COMMAND CHARACTER INPUT ROUTINE
C00094 00025 SUBTTL FILE INPUT
C00096 00026 SUBTTL ERROR MESSAGES/ERROR TYPEOUT
C00100 00027 SUBTTL FIXED DATA STORAGE
C00104 ENDMK
C;
TITLE CREF %51.(20) CROSS REFERENCE PROGRAM
SUBTTL CCL SYSTEM - BOWERING/RPG/PMH/NGP/TNH/TWE
SUBTTL /HPW 12-MAR-74
; FAIL AND STANFORD FEATURES: WFW,DCS,RFS,REG
SUBTTL /REG 7-JUN-74
STANSW==1 ;STANFORD ASSEMBLY
;This program is based on CREF, a program Copyright 1968, 1969, 1970,
;1971, 1972, 1973, 1974, by Digital Equipment Corporation, Maynard,
;Massachusetts. The extent of the improvements over the original
;justify calling this a a different program.
;
; Ralph E. Gorin
; Stanford University Artificial Intelligence Laboratory
; Stanford, California
VCREF==51 ;MAJOR CREF VERSION NUMBER
VWHO==0 ;WHO MADE EDIT
VMINOR==0 ;MINOR VERSION NUMBER
VEDIT==20 ;EDIT NUMBER
INTERNAL .JBVER
LOC <.JBVER==137>
BYTE (3) VWHO (9) VCREF (6) VMINOR (18) VEDIT
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 >
HASH==145
SUBTTL REVISION HISTORY
;17 ----- MODIFY FOR FORTRAN-10 VERSION 2
;20 ----- MODIFY THE DEC VERSION FOR FULL FAIL FEATURES REG 5/18/74
;1/18/76 - REG 1. Use ###CRF.TMP not QQCREF.RPG
; 2. default output device is DSK
;
SUBTTL SYMBOLIC DEFINITIONS
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
IO=16 ;HOLDS FLAGS
P=17 ;PUSH DOWN POINTER
;DEFINITIONS FOR LENGTHS OF LINES AND PAGES
RADIX 5+5 ;CAREFUL HOW YOU WRITE THIS.
WPLLPT==14 ;IN OUTPUT LPT LISTING, 14 REFERENCES/LINE
IFN STANSW,< WPLLPT==10 > ;(NARROW LPT)
WPLTTY==8 ;IN OUTPUT TTY LISTING, 8 REFERENCES/LINE
.LPP==53 ;LINES PER PAGE IN LISTING
RADIX 4+4 ;RETURN TO OCTAL
PDL==30 ;PUSH DOWN STACK LENGTH
SUBTTL 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
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
; 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!
;DEFINITIONS FOR "OLD STYLE" CODES FROM VARIOUS PROCESSORS
%OP==33
%EOF==37 ;MULTIPLE-PROGRAM BREAK CHARACTER
CTLI==1 ;CONTROL DEVICE NUMBER (INPUT)
CHAR==2 ;INPUT DEVICE NUMBER
LST==3 ;LISTING DEVICE NUMBER
;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
; 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
;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
;MNEMONIC FOR ERROR MESSAGES
;MNEMONIC SEVERITY MEANING
;CRFIDC WARNING IMPROPER INPUT DATA
;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
;CRFBTB FATAL BUFFERS TOO BIG
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 ;START HERE FROM (.JBSA)+1
RESET ;CLEAR IO AND INITIALIZE .JBFF
MOVE P,[IOWD PDL,PPSET] ;INIT PUSH DOWN LIST
IFN TEMPC,< SETZM TMPFLG ;ZERO TMPCOR FLAG
TLNN IO,IOCCL ;IS THIS A CCL TYPE CALL?
JRST TMPEND ;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 1,TMPFIL] ;SET UP FOR READ FROM CORE
TMPCOR TEMP, ;READ AND DELETE FILE "CRE"
JRST TMPEND ;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
TMPEND: >;IFN TEMPC
MOVEI TEMP,1 ;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
MOVEI AC0,3 ;JOB # IS 3 CHARS LONG
PJOB TEMP, ;GET JOB #
CREF1: IDIVI TEMP,12
ADDI TEMP+1,'0' ;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'
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
;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: TLO IO,IOPAGE!IOSYM!IOMAC
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?
SETZM STCLR ;CLEAR FIXED DATA AREA
MOVE 0,[XWD STCLR,STCLR+1]
BLT 0,ENDCLR
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
SUBTTL INITIALIZATION - LSTSET - SETUP DESTINATION DEVICE
IFE STANSW,<
MOVSI ACDEV,'LPT'
MOVEM ACDEV,LSTDEV ;DEFAULT LIST DEVICE IS LPT:
>;IFE STANSW
IFN STANSW,<
MOVSI ACDEV,'DSK'
MOVEM ACDEV,LSTDEV ;DEFAULT LIST DEVICE IS LPT:
>;IFN STANSW
MOVSI ACEXT,'LST' ;DEFAULT EXTENSION IS "LST"
MOVEM ACEXT,LSTDIR+1
PUSHJ P,NAME1 ;GET NEXT DEVICE
CAIN C,"!" ;RUN ON NEXT PROGRAM?
JRST RUNUUO ;YES
CAIE C,"_" ;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 ;BH 11/19/74 DATE75. WAS MOVEM.
MOVEM ACPPN,LSTDIR+3 ;SET UP PROJ,PROG NUMBER
LSTS2: 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
OUTBUF LST,2 ;MAKE BUFFERS
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.
;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.
TLNE ACTMP+1,20 ;MAG TAPE?
SKIPA ACTMP,[PUSHJ P,DMPOUT] ;YES. SET OUTPUT INSTR. FOR MTA
MOVSI ACTMP,(<OUT LST,>) ;OUTPUT INSTRUCTION FOR ALL EXCEPT MTA.
MOVEM ACTMP,DMPXCT ;SET OUTPUT INSTRUCTION
CAIE C,"_" ;LISTING DEVICE SPECIFIED?
JRST INSET1 ;NO
TLNN ACTMP+1,20 ;SKIP IF OUTPUT ON MTA
JRST LSTSE4 ;NOT MTA. AVOID 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
LSTSE4: TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED?
UTPCLR LST, ;YES.
SUBTTL INITIALIZATION - INSET - PROCESS INPUT FILE NAME
PUSHJ P,NAME1 ;GET NEXT COMMAND NAME
INSET1: TLNE IO,IOCCL ;IN CCL MODE?
OUTSTR [ASCIZ /CREF:/] ;YES. TYPE OUR NAME
INSET2: 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
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
SKIPN FIRSTL ;HAS INITIAL PRINTING LINE BEEN REQUESTED?
JRST LSTS7 ;NO
TLNE IO,IOCCL
JRST LSTS4 ;NO MESSAGE OUTPUT FOR CCL SYSTEM
OUTSTR [ASCIZ /RESTART LISTING AT LINE: /]
INPUT CTLI, ;INPUT THE ANSWER
LSTS4: MOVEI ACTMP,0 ;INIT DECIMAL NUMBER ASSEMBLER
LSTS5: PUSHJ P,TTYIN ;GET CHARACTER
CAIL C,"0" ;IS IT A DIGIT?
CAILE C,"9"
JRST LSTS6 ;NO
IMULI ACTMP,12 ;YES
ADDI ACTMP,-"0"(C)
JRST LSTS5
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
SUBTTL PROCESS CREF INPUT FILE
MOVEI FREE,BLKST-1
MOVEM FREE,BLKND ;INITIALIZE FOR COMBG
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
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,[SIXBIT /%CRFIDC IMPROPER INPUT DATA - CONTINUING@/]
PUSHJ P,PNTMSG ;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
JRST SRCH
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
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.
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 FISRT 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
;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)
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
;; JFR 7-30-76 make SIXBIT conversion work for lowercase as well
;;;; SUBI C,40 ;CONVERT TO SIXBIT
TRZN C,100 ;COPY 100 BIT INTO 40 BIT
TRZA C,40
TRO C,40
;; JFR ^
TLNE AC0,770000 ;SKIP IF WORD IS EXHAUSTED
IDPB C,AC0 ;STUFF THIS CHARACTER
SOJG TEMP1,FM4 ;LOOP WHILE CHARACTER COUNT LASTS
MOVE AC0,FRDTMP ;LOAD RESULT INTO AC0 (AC0=0 - DON'T DO SKIPN)
JUMPE AC0,ERROR ;ERROR IF ZERO.
POPJ P,
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 SYYMBOL
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.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 ; 1 PREVIOUS SYMBOL IS REFERENCED
JRST DLAB ; 2 PREVIOUS SYMBOL IS DEFINED
MOVSI SX,IOOP ; 3 OPCODE REFERENCE - GOBBLE NAME
MOVSI SX,IOOP!IODF2 ; 4 OPCODE DEFINITION - GOBBLE NAME
MOVSI SX,IOMAC ; 5 MACRO REFERENCE
MOVSI SX,IOMAC!IODF2 ; 6 MACRO DEFINITION
SETZB SX,SVLAB ; 7 FAIL TAKES BACK A MISTAKEN OCCURANCE
JRST COMBIN ;10 COMBINE TWO FIXUP CHAINS FOR FAIL
JRST DEFSYM ;11 DEFINE SYMBOL (CHANGE NUMBER TO NAME)
JRST ERROR ;12 LF
JRST DEFMAC ;13 DEFINE MACRO (CHANGE NUMBER TO NAME)
JRST ERROR ;14 FF
JRST BBEG ;15 BLOCK BEGIN
JRST BBEND ;16 BLOCK END
JRST SETLIN ;17 READ LINE NUMBER FROM FILE
DTABLN==.-DTAB
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) ;SET FLAG IN TEMP1 IF FLAG WAS ON 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
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.
JRST FM6 ;STUFF IT.
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,OUTASC ;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,OUTASC
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]
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,[SIXBIT /[CRFXKC @/] ;[17] IDENTIFY MESSAGE
PUSHJ P,PNTM0 ;[17] IDENTIFY MESSAGE
MOVE C,.JBREL
LSH C,-12 ;CONVERT WORDS TO K
ADDI C,1
PUSHJ P,TYDEC ;[20] TYPE DECIMAL
MOVEI RC,[SIXBIT/K CORE]@/]
PUSHJ P,PNTM0 ;PRINT MESSAGE
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
CCLFN2: PUSHJ P,TTYIN
CAIG C,15
CAIGE C,12
SKIPA ;C>15 OR C<12
JRST CCLFN2 ;LOOP GOBBLING CRLF, ETC.
MOVSI C,70000 ;BACK UP ONE CHARACTER
ADDM C,CTIBUF+1
AOS CTIBUF+2 ;PUT THAT CHARACTER BACK IN THE BUFFER
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).
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
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 OUTPUT ROUTINES. OUTP, GETVAL, CNVRT, OUTASC
OUTASC:
OUTAS2: MOVEI C,0 ;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,OUTAS2
POPJ P,
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
POPJ P, ;THERE IS NO NEXT
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
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
SIXBIT /?CRFOUE OUTPUT ERROR, @/ ;[17] 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,
SUBTTL SCAN COMMAND INPUT
NAME1: SETZB ACDEV,ACFILE
SETZB ACEXT,ACDEL
SETZB TIO,CS
MOVEI ACPPN,0
NAME3: MOVSI ACPNTR,(<POINT 6,ACTXT>) ;SET POINTER
TDZA ACTXT,ACTXT ;CLEAR SYMBOL
SLASH: PUSHJ P,SW0
GETIOC: PUSHJ P,TTYIN ;GET INPUT CHARACTER
MOVEM C,CMDTRM ;SAVE LAST COMMAND CHARACTER
CAIN C,"/"
JRST SLASH
CAIN C,"("
JRST SWITCH
CAIN C,":"
JRST DEVICE
CAIN C,"."
JRST NAME
CAIE C,"_"
CAIG C,12 ;ALT MODES AND RETURN CHANGED TO LINE FEED
JRST TERM
CAIE C,","
CAIN C,"!"
JRST TERM ; ! IS FOR RUNNING NEXT PROGRAM
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 ERRCM ;NOT NUMERIC EITHER, COMMAND ERROR
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: SKIPA ACDEV,ACTXT ;DEVICE NAME
NAME: MOVE ACFILE,ACTXT ;FILE NAME
MOVE ACDEL,C ;SET DELIMITER
JRST NAME3 ;GET NEXT SYMBOL
TERM: CAIE ACDEL,":" ;IF PREVIOUS DELIMITER
CAIN ACDEL,0 ;ASSUME FILE NAME IF NOTHING ELSE
MOVE ACFILE,ACTXT ;SET FILE
CAIN ACDEL,"." ;IF PERIOD,
HLLZ ACEXT,ACTXT ;SET EXTENSION
POPJ P, ;EXIT
PROGNP: PUSHJ P,TTI8 ;BUILD A PROJECT, PROGRAMMER NUMBER
CAIE C,","
JRST ERRCM
HRLZ ACPPN,ACTMP
PUSHJ P,TTI8
CAIE C,"]"
JRST ERRCM
HRR ACPPN,ACTMP
JRST GETIOC
IFE STANSW,<
TTI8: MOVEI ACTMP,0 ;BUILD AN OCTAL NUMBER
TTI8B: PUSHJ P,TTYIN
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
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
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
SW0: PUSHJ P,TTYIN
SW1: MOVEI C,-"A"(C) ;CONVERT FROM ASCII TO NUMERIC
CAILE C,"Z"-"A" ;WITHIN BOUNDS?
JRST ERRCM ;NO, ERROR
XCT SWTAB(C) ;EXECUTE THE SWITCH FUNCTION FOR THIS SWITCH
POPJ P, ;EXIT
SUBTTL COMMAND SWITCH TABLE
SWTAB: ADDI CS,1 ;A - ADVANCE FILE
SUBI CS,1 ;B - BACKSPACE FILE
JRST ERRCM ;C
JRST ERRCM ;D
JRST ERRCM ;E
JRST ERRCM ;F
JRST ERRCM ;G
JRST HELP ;H
JRST ERRCM ;I
JRST ERRCM ;J
TLZ IO,IOSYM ;K - KILL (SUPPRESS) SYMBOL TABLE LISTING
JRST ERRCM ;L
TLZ IO,IOMAC ;M - SUPPRESS MACRO TABLE LISTING
JRST ERRCM ;N
TLO IO,IOOP ;O - ENABLE OPCODE TABLE LISTING
TLO IO,IOPROT ;P - PROTECT (I.E. DON'T DELETE) INPUT FILES
JRST ERRCM ;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 ERRCM ;U
JRST ERRCM ;V
TLO TIO,TIORW ;W - REWIND TAPE
JRST ERRCM ;X
JRST ERRCM ;Y
TLO TIO,TIOCLD ;Z - ZERO DECTAPE DIRECTORY
;HERE FOR HELP
IFE STANSW,<
HELP: PUSHJ P,TTYIN ;LOOK FOR END OF LINE
CAIE C,12
JRST HELP ;LINE FEED IS THE END
MOVE 1,[SIXBIT 'CREF']
PUSHJ P,.HELPR
JRST CREF ;AND START OVER
>
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
IFE STANSW,< MOVE 0,[1,,1] ;USED BY CORE UUO >
IFN STANSW,< MOVEI 0,1 ;USED BY CORE UUO >
JRST 10 ;GO SHRINK CORE AND DO RUN
CORRUN: CORE 0, ;10 SHRINK
JFCL ;11 IGNORE FAILURE
RUN 7, ;12 GET NEXT PROGRAM
COREND: HALT ;13 LET MONITOR PRINT ANY ERROR MESSAGES
CRLF: BYTE(7)15,12
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
MOVEM ACPPN,INDIR+3 ;STORE PROJ,PROG IN DIRECTORY
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
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
HRRZS CS,.JBFF
MOVEM CS,IOJFF ;SAVE .JBFF TO RECLAIM THIS BUFFER SPACE
INBUF CHAR,IFN STANSW,<=19;>2
ADDI CS,203*IFN STANSW,<=19+2;>2+2;LEAVE ROOM FOR BIG BUFFERS (+ SLOP)
CAMG CS,.JBFF ;WERE BUFFERS BIGGER THAN EXPECTED?
JRST ERRBUF ;YES, PROBLEM IN BUFFER SIZES
MOVEM CS,.JBFF ;NO, LEAVE THIS ROOM FOR NEXT FILE
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
SIXBIT /?CRFCFF CANNOT FIND FILE, @/ ;[17] 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
TLNN IO,IOCCL ;TYPE FILE NAME IF IN CCL MODE
JRST CPOPJ1 ;SUCCESS RETURN
OUTCHR [11]
MOVEI CS,INDIR ;GET ADR OF INPUT FILE NAME
PUSHJ P,PNTSIX ; AND PRINT NAME
OUTSTR CRLF ;FOLLOWED BY CARRIAGE RETURN
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
SUBTTL TTYIN COMMAND CHARACTER INPUT ROUTINE
TTYIN2: AOS CTIBUF+1 ;FLUSH SOS LINE NUMBERS
MOVNI C,5
ADDM C,CTIBUF+2
TTYIN: ;COMMAND CHARACTER INPUT SUBROUTINE
CCLIN: 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
CAIE C," " ;AND BLANKS
CAIN C,11 ;AND TABS
JRST TTYIN
CAIN C,"="
MOVEI C,"_" ;EQUAL WILL REPLACE LEFT ARROW
CAIE C,175
CAIN C,176
MOVEI C,12 ;CHANGE ALL ALT MODES TO LINE FEED
CAIE C,33
CAIN C,15
MOVEI C,12 ;CHANGE ESC AND RETURN TO LINE FEED
CAIN C,32
JRST TTYIN ;IGNORE ^Z (EOF)
CAIL C,"A"+40
CAILE C,"Z"+40
POPJ P,
TRZ C,40 ;CHANGE LOWER CASE TO UPPER CASE
POPJ P, ;NO, EXIT
CKCCLI:
IFN TEMPC,< SKIPE TMPFLG ;IS TMPCOR UUO IN ACTION?
JRST TMPDON ;YES, EXIT>
IN CTLI,0 ;READ ANOTHER BUFFER
JRST CCLIN1
STATO CTLI,740000
JRST CCLCK2 ;EOF
GETSTS CTLI,ERRSTS
MOVEI CS,CTIDEV
JSP RC,DVFSTS ;PRINT MESSAGE AND ERR #
SIXBIT /?CRFCFE COMMAND FILE INPUT ERROR, @/ ;[17] IDENTIFY MESSAGE
JRST CREF
IFN TEMPC,<
TMPDON: MOVE AC0,[XWD 2,TEMP]
MOVSI TEMP,'CRF'
MOVEI TEMP1,0
TMPCOR AC0, ;DELETE TMPCOR FILE "CRE"
JFCL ;FAILED, SO WHO CARES>
LEAVE: EXIT 1, ;EXIT
JRST CREF
CCLCK2: TLNN IO,IOCCL ;IN CCL MODE?
JRST CREF ;NO, START OVER
SETZB TEMP,TEMP+1 ;YES, DELETE COMMAND FILE
SETZB TEMP+2,TEMP+3
RENAME CTLI,TEMP
JFCL
JRST LEAVE
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
SIXBIT /?CRFINE INPUT ERROR, @/ ;[17] 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
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,[INDEV] ;INPUT DEVICE INIT FAILURE
ERRAVL: MOVEI CS,LSTDEV ;LISTING DEVICE INIT FAILURE
JSP RC,DVFNEX
SIXBIT /?CRFDNA DEVICE NOT AVAILABLE, @/ ;[17] IDENTIFY MESSAGE
JRST CREF
ERRENT: MOVEI CS,LSTDEV ;ENTER FAILURE
JSP RC,DVFDIR
SIXBIT /?CRFCEF CANNOT ENTER FILE, @/ ;[17] IDENTIFY MESSAGE
JRST CREF
ERRCOR: JSP RC,ERRMSG ;CORE UUO FAILURE
SIXBIT /?CRFIMA INSUFFICIENT MEMORY AVAILABLE@/ ;[17] IDENTIFY MESSAGE
JRST CREF
IFN STANSW,<HELP:>
ERRCM: JSP RC,ERRMSG ;[17] IDENTIFY MESSAGE
IFE STANSW,< SIXBIT \?CRFCME COMMAND ERROR - TYPE /H FOR HELP@\ >
IFN STANSW,< SIXBIT \?CRFCME COMMAND ERROR@\ >
JRST CREF
ERRBUF: JSP RC,DVFNEX
SIXBIT /?CRFBTB INPUT BUFFERS TOO BIG, @/ ;[17] IDENTIFY MESSAGE
JRST CREF
ERRMSG: PUSHJ P,PNTMSG ;FOR SIMPLE ERROR MESSAGES
OUTSTR CRLF ;TYPE CRLF
JRST (RC) ;RETURN TO AFTER SIXBIT TEXT
DVFDIR: HRRZ C,2(CS) ;PRINT MESSAGE WITH DIR ERR #
MOVEM C,ERRSTS
DVFSTS: PUSHJ P,PNTMSG ;PRINT MESSAGE, ERR #, DEV:FILENAM.EXT
PUSH P,RC ;SAVE RETURN AT END OF SIXBIT TEXT
PUSHJ P,PNTSTS
OUTCHR [" "]
JRST DVFN2
DVFNEX: PUSHJ P,PNTMSG ;PRINT MESSAGE DEV:FILENAME.EXT
PUSH P,RC ;SAVE RETURN AT END OF SIXBIT TEXT
DVFN2: 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
POPJ P,
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
PNTMSG: OUTSTR CRLF ;PRINT SIXBIT MESSAGE
PNTM0: HRLI RC,(<POINT 6,0>)
PNTM1: ILDB C,RC
CAIN C,40 ;STOP AT @
AOJA RC,CPOPJ ;POINT TO LOCATION AFTER SIXBIT
ADDI C,40 ;CONVERT TO ASCII
OUTCHR C
JRST PNTM1
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,
;THE LITERALS ARE XLISTED FOR YOUR READING PLEASURE
XLIST
LIT
LIST
SUBTTL FIXED DATA STORAGE
IFN SEGSW,< RELOC 0 ;IMPURE DATA AREA >
SVJFF: BLOCK 1
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
.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
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
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
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
BLKND: BLOCK 1
ENDCLR= .-1
END CREF