TITLE CREF %53C(101) CROSS REFERENCE PROGRAM SUBTTL BOWERING/RPG/PMH/NGP/TNH/TWE/HPW/ASM/RDH/ILG/JNG/BPK/MS /JEH 22-AUG-85 ;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1974,1975,1976,1977,1978,1979,1980,1984,1985,1986. ALL RIGHTS RESERVED. ; ; ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ;TRANSFERRED. ; ; ;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ;CORPORATION. ; ;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ;THE VERSION OF CREF VCREF==53 ;MAJOR CREF VERSION NUMBER VWHO==0 ;WHO MADE EDIT VMINOR==3 ;MINOR VERSION NUMBER VEDIT==101 ;EDIT NUMBER INTERNAL .JBVER LOC <.JBVER==137> > IFDEF .MCRV.,< .VERSION CRFVER > SEARCH UUOSYM .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 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. 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). ;61 26783 A NULL LINE NO LONGER PRODUCES AN ERROR MESSAGE 08-MAR-79 ;62 26662 CREFFED LONG FORTRAN INSTRUCTIONS NO LONGER ; CONTAIN GARBAGE 19-MAR-79 ;63 ----- ONE UNDERBAR ERROR MESSAGE PER COMMAND LINE ; AND NO LONGER CAUSED BY SWITCH.INI 19-MAR-79 ;64 ----- ADDITION TO EDIT 61 FOR DEC-20'S 05-JUL-79 ;65 28017 CREF ONLY SORTS FIRST SIX CHARACTERS OF LONG ; SYMBOL NAMES. 06-JUL-79 ;66 28018 CREF LOOPS INFINITELY WHEN HANDLING SYMBOLS ; WITH LEADING SPACES. DISALLOW SPACES IN ; SYMBOLS (REMOVE THEM). ALSO FIX EDIT 62. 10-JUL-79 ;67 27990 CREF USES EXCESS CRLFS WHEN CREFFING ; LONG SYMBOLS. 12-JUL-79 ;70 28408 CHANGE LOWERCASE SYMBOLS TO UPPERCASE BEFORE ; CONVERTING TO SIXBIT. 13-JULY-79 ;71 28409 IF A COMMENT LINE PRECEEDS A CREF LINE IN ; SWITCH.INI, THE CREF LINE WILL NOT BE READ. 13-JULY-79 ;72 ----- ALGOL SHOULD NOT PRINT END BLOCK NAME 'E----1' ; AS PROGRAM NAME WHILE PRINTING NESTED-TABLE. 11-AUG-80 ; ;******* START OF VERSION 53B ******* ; ;73 32794 EXTEND EDIT 70 TO WORK FOR LONG SYMBOLS AS WELL. ; 10-AUG-82 ; ;74 32942 INCREASE ADDRESS OF HISEG TO 560K TO ALLOW CREF ; TO HANDLE LARGER PROGRAMS 14-SEP-82 ; ;75 DEVEL MODIFY TO USE LARGE BUFFERS FOR 7.02 ; 03-SEP-82 ; ;76 33145 FIX /T SWITCH ON INPUT FILE SPECS - CAUSES ; ?IO TO UNASSIGNED CHANNEL 12-NOV-82 ; ;77 None. BAH 2-Oct-84 ; Update copyrights. ; ;100 None COPY .RBVER TO OUTPUT FILE ; ;101 None. LEO 22-AUG-85 ; Do Copyrights. ; 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 HISEG==560000 ;[74] HISEG ADDRESS ;USEFUL OPDEF'S OPDEF PJRST [JRST] ;[24][30] ;CONDITIONAL ASSEMBLY SWITCHES IFNDEF STANSW, ;SET TO 1 FOR STANFORD A.I. LAB FEATURES IFN STANSW, ; IFNDEF SEGSW, ;SET TO 1 FOR TWO-SEGMENT SHARABLE ASSEMBLY IFNDEF TEMPC, ;SET TO 1 TO ALLOW TMPCOR UUO IFN SEGSW,< TWOSEG HISEG RELOC HISEG > ;[74] END IFN SEGSW, IFE SEGSW,< RELOC 0> ;BACK TO RELOC AFTER LOC .JBVER IFE STANSW,< EXTERN .HELPR > COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1974,1986. ALL RIGHTS RESERVED. \;END COPYRIGHT MACRO ;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 ;DEFINITIONS NECESSARY FOR TENEX FILE SYSTEM FEATURES. ; OPDEF COMPT. [CALLI 147] ;DEFINED IN UUOSYM 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] 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 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, + 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 SETZM CRFPUE ;[63] RESET FLAG TLNN IO,IOCCL ;SKIP IF IN CCL MODE. OUTSTR [ASCIZ/*/] ;[61] LOOK READY FOR A COMMAND ;[61] NO MORE EXTRA CRLF SETZM ACHR ;[61] SET NULL LINE FLAG 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 + .PTMAX - 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: TLNN IO,IOCCL ;[61] IN CCL MODE? JRST INSET2 ;[61] NO. SKIPE ACHR ;[61] YES. IS LINE EMPTY? OUTSTR [ASCIZ /CREF:/] ;[61] NO.. 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: MOVSI ACTMP,(1B7) ;[75]INIT DEV IN ASCII MODE, BIGBUF 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,0 ;[75] MAKE DEFAULT 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,() 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,() ;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 > PUSH P,ACFILE ;[100] MOVE ACFILE,LSTDIR MOVEM ACFILE,EXTBLK+.RBNAM MOVE ACFILE,LSTDIR+1 MOVEM ACFILE,EXTBLK+.RBEXT MOVE ACFILE,LSTDIR+2 MOVEM ACFILE,EXTBLK+.RBPRV MOVE ACFILE,LSTDIR+3 MOVEM ACFILE,EXTBLK+.RBPPN MOVEI ACFILE,.RBVER MOVEM ACFILE,EXTBLK+.RBCNT POP P,ACFILE ENTER LST,EXTBLK ;INPUT FILE FOUND, ENTER OUTPUT FILE JRST [PUSH P,EXTBLK+.RBEXT POP P,LSTDIR+2 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,0 ;[75] [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 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,() 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,() 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,() 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,() ;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) 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,() 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 CAIL C,"A"+40 ;[70] IS IT LOWER CASE? CAILE C,"Z"+40 ;[70] SKIPA ;[70] NO. SUBI C,40 ;[70] YES, MAKE IT UPPER SUBI C,40 ;CONVERT TO SIXBIT TLNN AC0,770000 ; [21] IF WORD IS EXHAUSTED JRST LNGSYM ; [21] GO HANDLE LONG SYMBOL SKIPE C ;[66] IF CHARACTER IS SPACE, DON'T SAVE 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,() 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: SKIPE C ;[66] IF CHARACTER IS SPACE, DON'T SAVE IDPB C,TEMP ; [21] PUT CHARACTER AWAY SOJLE TEMP1,LB1 ; [21] SEE IF DONE PUSHJ P,READ ; [21] NOT - GET NEXT CHARACTER CAIL C,"A"+40 ; [73] IS IT LOWER CASE? CAILE C,"Z"+40 ; [73] SKIPA ; [73] NO - SKIP SUBI C,40 ; [73] YES - CONVERT TO UPPER SUBI C,40 ; [21] TO SIXBIT JRST LB0 ; [21] AND LOOP LB1: TLNN TEMP,770000 ; [21] WHOLE WORD ? JRST LB2 ;[62] YES. MOVEI C,0 ; [21] IDPB C,TEMP ; [21] NULL FILL JRST LB1 ; [21] & TRY AGAIN LB2: ADDI TEMP,1 ;[62] ZERO REST OF FOUR WORD BLOCK HRRZ TEMP,TEMP ;[66] JUST WANT RIGHT HALF LB3: CAML TEMP,FREE ;[66] ARE WE DONE? JRST LB4 ;[62] YES. SETZM (TEMP) ;[62] NOPE, ZERO THAT WORD AOJA TEMP,LB3 ;[62] AND TRY AGAIN! LB4: POP P,TEMP ;[62][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 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 CAME CS,[SIXBIT /E----1/] ;[72] SKIP FOR ALGOL THE BLOCK-END ;[72] NAME AS 'E----1' 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] 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: OUTSTR [ASCIZ /] /] ;[40] [61] 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)) 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,() 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 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,HISEG ;[74] DON'T EXPAND LOWER ABOVE HISEG> 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, ;[31] # CHARS IN BUFFER MOVE ACTXT,[POINT 7,TXTBUF] ;POINTER FOR TENEX MOVEM ACTXT,ASCCNT ;TO WORD NAME3: MOVSI ACPNTR,() ;SET POINTER SETZ ACTXT, ;[51] READY FOR NEXT PASS GETIOC: PUSHJ P,TTYIN ;GET INPUT CHARACTER CAIN C,12 ;[61] ESC. AND RET. CHANGED TO LF. JRST TSTIOC ;[61] ONE OF THE THREE, LINE COULD BE EMPTY CAIN C," " ;[61] IS CHAR. A SPACE? JRST TSTIOC ;[61] YES, LINE COULD BE EMPTY CAIE C,11 ;[61] IS CHAR. A TAB? SETOM ACHR ;[61] NO, LINE IS NOT EMPTY TSTIOC: CAIN C,"/" ;[61] 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 + .PTMAX - 1 ;[32] . . . MOVEM ACPPN, SCNPPN ;[32] SET PPN PART OF PATH MOVE ACPPN, [IOWD <.PTMAX-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 "/" 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 SETOM CRFPUE ;[63] SET SO SWITCH.INI WON'T CAUSE "_" ERROR 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 CAIE C,12 ;[71] WE MAY HAVE GOTTEN A COMMENT LINE, IF SO ;[71] LINE ALREADY EATEN AND RETURNED IN C 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 SETZM CRFPUE ;[63] ENABLE UNDERBAR ERROR MESSAGE 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: SKIPN ACHR ;[64]ERROR CAUSED BY BLANK LINE? POPJ P, ;[64]YES, RETURN W/O ERROR MASSAGE 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 MOVSI ACDEV-1,(1B7) ;[75] INIT DEVICE SETUP W/ BIGBUF 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 CHAR,10 ;[76] 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,0 ;[75] BUILD DEFAULT BUFFERS 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 SKIPN ACHR ;[61] ERROR CAUSED BY NULL LINE? JRST IFIL4D ;[61] YES, TRY AGN. W/O ERROR MSG. JSP RC,DVFDIR ;GO PRINT MSG, AND FILE NAME [ASCIZ/?CRFCFF Cannot find file, /] ;[17][34] IDENTIFY MESSAGE IFIL4D: TLO IO,IOPROT ;[61] 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 PUSH P,ACEXT ;[100] STUFF AN AC MOVE ACEXT,INDIR MOVEM ACEXT,EXTBLK+.RBNAM MOVE ACEXT,INDIR+1 MOVEM ACEXT,EXTBLK+.RBEXT MOVE ACEXT,INDIR+3 MOVEM ACEXT,EXTBLK+.RBPPN MOVEI ACEXT,.RBVER MOVEM ACEXT,EXTBLK+.RBCNT POP P,ACEXT ;[100] LOOKUP CHAR,EXTBLK JRST [PUSH P,EXTBLK+.RBEXT POP P,INDIR+1 JRST (ACDEV)] ;[100] 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 - ";-" 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] CHARACTER; COMPRESS 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 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 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 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 'S JRST CCLIN ;[37] I.E., EAT THEM WHOLE (RAW EVEN) CAIN C, 11 ;[36] ?? 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] CAIN C, 7 ;[36] OR ?? JRST CCLIN4 ;[37] YES - BREAK - CONVERT TO CAIE C, 13 ;[36] CAIN C, 14 ;[36] OR ?? CCLIN4: MOVEI C, 12 ;[36] YES - BREAK - CONVERT TO POPJ P, ;[37] ;[37] HERE ON REGULAR PRINTING CHARACTERS CCLIN6: CAIN C, 177 ;[37] 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: SKIPE CRFPUE ;[63] HAVE WE ALREADY SEEN MESSAGE? JRST TTYLR2 ;[63] YES. ONCE IS ENOUGH SETOM CRFPUE ;[63] NO, SET FLAG FOR NEXT TIME 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 TTYLR2: MOVEI C, "=" ;[63][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 IS ON FOR ;[43] - 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= ;[43] ERROR RETURN IS CPOPJ0, C= TTRSCN: MOVNI FLAG, ;[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 IFN STANSW, 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,() ;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 CRFPUE: BLOCK 1 ACHR: BLOCK 1 ;[61] FLAG TO CHK. FOR NULL INPUT LINES 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 .PTMAX - 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 EXTBLK: BLOCK .RBVER+1 ;[100] EXTENDED BLOCK LSTBUF: BLOCK 3 LSTDEV: BLOCK 1 ;LIST DEVICE (FOR ERR MESSAGES ONLY) LSTDIR: BLOCK 4 LSTPTH: BLOCK .PTMAX ;[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 ENDCLR= .-1 END CREF