--- /dev/null
+TITLE CREF V40A - CROSS REFERENCE PROGRAM\r
+SUBTTL CCL SYSTEM - BOWERING/RPG/PMH/NGP/TNH/TWE/JBS - 01-MAY-71\r
+;*****(C)COPYRIGHT 1968,1969,1970,1971, DIGITAL EQUIPMENT CORP., MAYNARD MASS.,USA *****\r
+\r
+INTERNAL JOBVER,PURE\r
+LOC <JOBVER==137>\r
+ XWD 0,000040 ;CREF VERSION NUMBER\r
+\r
+IFNDEF PURE,<PURE=1>\r
+ IFN PURE,<HISEG>\r
+\r
+EXTERNAL JOBFF, JOBREL, JOBDDT, JOBSYM\r
+INTERNAL CREF\r
+\r
+IFNDEF TEMPC,<TEMPC==1> ;TMPCOR UUO ALLOWED IF SET TO 1\r
+IFNDEF FAILC,<FAILC==1> ;NO FAIL BLOCK STRUCTURE UNLESS REQUESTED\r
+;ACCUMULATOR DEFINITIONS\r
+AC0=0\r
+TEMP=1\r
+TEMP1=2\r
+WPL=3 ;CONTAINS COUNT OF HOW MANY REFERENCES/LINE IN LISTING\r
+RC=WPL\r
+SX=4\r
+BYTEX=5\r
+BYTEM=6\r
+TX=BYTEM\r
+TIO=6 ;AC USED FOR MTAPE FLAGS IN COMMAND SCANNER LOGICTX=BYTEM\r
+C=7\r
+CS=10\r
+LINE=11 ;HOLDS LINE #\r
+FLAG=12\r
+FREE=13 ;POINTS TO HIGH END OF INCREMENT BYTE TABLE\r
+SYMBOL=14 ;POINTS TO ENTRY COUNT AT LOW END OF SYMBOL TABLE\r
+TOP=15 ;CONTAINS HIGHEST AVAILABLE ADR IN MEMORY\r
+IO=16 ;HOLDS FLAGS\r
+PP=17 ;PUSH DOWN POINTER\r
+\f;DEFINITIONS FOR LENGTHS OF LINES AND PAGES\r
+WPLLPT==^D14 ;IN OUTPUT LPT LISTING, 14 REFERENCES/LINE\r
+WPLTTY==8 ;IN OUTPUT TTY LISTING, 8 REFERENCES/LINE\r
+.LPP==^D53 ;LINES PER PAGE IN LISTING\r
+PDL==30 ;PUSH DOWN STACK LENGTH\r
+\r
+IOLST== 000001 ;IF 1, SUPPRESS PROGRAM LISTING\r
+IONCRF==000002 ;1 IF COMMAND STRING SEARCH LIMITS BEING USED\r
+IOPAGE==000004 ;IF 1, DO A FORM FEED\r
+IOFAIL==000010 ;1 IF "NEW STYLE" CREF DATA HAS BBEN SEEN\r
+IODEF== 000020 ;1 IF SYMBOL IS A DEFINING OCCURRANCE\r
+IOENDL==000040\r
+IORPG== 000100 ;1 IF RPG SYSTEM IN USE (SET BY STATTING AT (JOBSA)+1)\r
+IOTABS==000200 ;"RUBOUT A" SEEN AT AND OF CREF DATA (INSERT TAB IN LISTING)\r
+IOEOF== 000400 ;END OF FILE SEEN\r
+IONLZ== 001000 ;LEADING ZERO TEST\r
+IOTB2== 002000 ;FOR F4\r
+IOTTY== 004000 ;1 IF LISTING DEVICE IS TTY\r
+IOERR== 010000 ;IMPROPER INPUT DATA SEEN\r
+IODF2== 020000 ;DEFINING OCCURRANCE OF A SYMBOL\r
+IOSYM== 040000 ;SYMBOL DEFINED WITH = OR :\r
+IOMAC== 100000 ;MACRO NAME\r
+IOOP== 200000 ;OPDEF, OP CODE, OR PSEUDO INSTRUCTION OCCURRANCE\r
+IOPROT==400000 ;1 IF INPUT 'CRF' OR 'LST' FILE IS PROTECTED\r
+ ;BY /P SWITCH\r
+\r
+\f;DEFINITIONS FOR "OLD STYLE" CODES FROM VARIOUS PROCESSORS\r
+%OP==33\r
+%MAC==34\r
+%LINE==35\r
+%SYM==36\r
+%EOF==37 ;MULTIPLE-PROGRAM BREAK CHARACTER\r
+\r
+A==0 ;ASCII MODE\r
+AL==1 ;ASCII LINE MODE\r
+\r
+CTLI==1 ;CONTROL DEVICE NUMBER (INPUT)\r
+CHAR==2 ;INPUT DEVICE NUMBER\r
+LST==3 ;LISTING DEVICE NUMBER\r
+\r
+; COMMAND STRING ACCUMULATORS\r
+\r
+ACDEV=TEMP ;DEVICE\r
+ACFILE=TEMP1 ;FILE\r
+ACEXT=LINE ;EXTENSION\r
+ACDEL=4 ;DELIMITER\r
+ACPNTR=5 ;BYTE POINTER\r
+\r
+;FLAGS USED IN AC TIO\r
+\r
+TIORW==1000 ;MTAPE REWIND FLAG\r
+TIOLE==2000 ;SET(BUT NOT USED ANYWHERE) BY BACKSPACE REQUEST\r
+TIOCLD==20000 ;CLEAR DIRECTORY FLAG\r
+\r
+OPDEF RESET [CALLI 0]\r
+OPDEF DEVCHR [CALLI 4]\r
+OPDEF WAIT [MTAPE 0]\r
+OPDEF CORE [CALLI 11]\r
+OPDEF UTPCLR [CALLI 13]\r
+\r
+OPDEF DDTOUT [CALLI 3]\r
+OPDEF EXIT [CALLI 12]\r
+TMPCOR==44 ;TMPCOR UUO CALLI #\r
+\f\r
+MLON\r
+\r
+CREF: TDZA IO,IO ;START HERE FROM (JOBSA)\r
+ MOVSI IO,IORPG ;START HERE FROM (JOBSA)+1\r
+ RESET\r
+ MOVEI ENDCLR\r
+ MOVEM JOBFF ;INIT JOBFF TO 1ST FREE LOCATION\r
+ MOVE PP,[IOWD PDL,PPSET] ;INIT PUSH DOWN LIST\r
+\r
+IFN TEMPC,<\r
+ SETZM TMPFLG ;ZERO TMPCOR FLAG\r
+ TLNN IO,IORPG ;IS A CCL TYPE CALL?\r
+ JRST TMPEND ;NO\r
+ HRRZ AC0,JOBFF ;GET START OF BUFFER AREA\r
+ HRLI AC0,-200 ;-LENGTH IN LH FOR TMPCOR IOWD\r
+ MOVEM AC0,TMPFIL+1 ;STORE IT IN TMPCOR IOWD\r
+ SOS TMPFIL+1 ;MAKE IT CONFORM TO IOWD FORMAT\r
+ HRRM AC0,CTIBUF+1 ;SET UP DUMMY BYTE POINTER\r
+ MOVSI TEMP,(SIXBIT /CRE/) ;SETUP 2 WORD BLOCK FOR TMPCOR UUO\r
+ MOVEM TEMP,TMPFIL\r
+ MOVE TEMP,[XWD 1,TMPFIL] ;SET UP FOR READ FROM CORE\r
+ CALLI TEMP,TMPCOR ;READ AND DELETE FILE "CRE"\r
+ JRST TMPEND ;FILE NOT THERE, TRY THE DISK\r
+ ADD AC0,TEMP ;GET END OF BUFFER\r
+ MOVEM AC0,JOBFF ;DUMMY UP JOBFF\r
+ MOVEM AC0,SVJFF ;SAVE NEW JOBFF\r
+ IMULI TEMP,5 ;CALCULATE THE CHARACTER COUNT\r
+ ADDI TEMP,1 ;MAKE SURE YOU GET THE LAST CHARACTER IN THE BUFFER\r
+ MOVEM TEMP,CTIBUF+2 ;DUMMY UP CHARACTER COUNT IN HEADER\r
+ MOVEI TEMP,440700 ;SET UP REST OF BYTE POINTER\r
+ HRLM TEMP,CTIBUF+1 ;HEADER NOW COMPLETE\r
+ SETOM TMPFLG\r
+ MOVSI IO,IOPAGE!IOSYM!IOMAC!IORPG\r
+ JRST RETRPG ;RETURN TO MAIN FLOW\r
+TMPEND:>\r
+ MOVEI TEMP,AL ;OPEN FILE IN ASCII LINE MODE\r
+ MOVSI TEMP+1,(SIXBIT /TTY/)\r
+ TLNE IO,IORPG ;USING CCL MODE?\r
+ MOVSI TEMP+1,(SIXBIT /DSK/) ;YES\r
+ MOVEM TEMP+1,CTIDEV ;SAVE DEVICE NAME\r
+ MOVEI TEMP+2,CTIBUF ;SET UP INPUT BUFFER HEADER ADDRESS\r
+ OPEN CTLI,TEMP ;OPEN INPUT COMMAND FILE\r
+ JRST CREF ;OPEN FAILURE, START OVER\r
+ INBUF CTLI,1 ;SET UP 1 INPUT BUFFER\r
+ HRRZ JOBFF\r
+ MOVEM SVJFF ;SAVE JOBFF\r
+ TLNN IO,IORPG\r
+ JRST RETRPG ;NOT IN CCL MODE\r
+\f;THE FOLLOWING CODE LOOKS UP A FILE -DSK:NNNCRE.TMP\r
+;AND TRIES TO INITIALIZE IT. IF EVERYTHING WORKS, THAT FILE IS\r
+;USED FOR THE COMMAND DATA TO CREF. IF SOMETHING GOES WRONG,\r
+;CREF IS STARTED AT ITS USUAL PLACE AND AN ASTERISC IS TYPED.\r
+;THIS CODE IS USED ONLY FOR THE NEW COMMAND LANGUAGE AND IS STARTED\r
+;BY STARTING AT: (JOBSA)+1\r
+\r
+ MOVEI AC0,3 ;JOB # IS 3 CHARS LONG\r
+ CALLI TEMP,30 ;GET JOB #\r
+CREF1: IDIVI TEMP,12\r
+ ADDI TEMP+1,"0"-40 ;CHANGE REMAINDER TO SIXBIT DIGIT\r
+ LSHC TEMP+1,-6 ;SHOVE DIGITS INTO TEMP+2\r
+ SOJG AC0,CREF1 ;3 DIGITS YET?\r
+ HRRI TEMP+2,(SIXBIT /CRE/)\r
+ MOVEM TEMP+2,CTIDIR ;SET UP ###CRE\r
+ MOVSI TEMP,(SIXBIT /TMP/)\r
+ MOVEM TEMP,CTIDIR+1 ;SET UP EXTENSION\r
+ SETZM CTIDIR+3 ;CLEAR PROJ,PROG\r
+ LOOKUP CTLI,CTIDIR ;DO LOOKUP ON COMMAND FILE\r
+ JRST CREF ;FILE ###CRE.TMP NOT FOUND\r
+\r
+\fRETRPG: TLO IO,IOPAGE!IOSYM!IOMAC\r
+ HRRZ 0,SVJFF ;GET THE SAVED JOBFF\r
+ MOVEM 0,JOBFF ;RESTORE JOBFF\r
+ SKIPE JOBDDT\r
+ JRST .+3 ;NO CORE UUO WHEN USING DDT\r
+ CORE 0, ;SHRINK CORE\r
+ JRST CREF ;CORE FAILURE\r
+ SETZM STCLR\r
+ MOVE 0,[XWD STCLR,STCLR+1]\r
+ BLT 0,ENDCLR ;CLEAR OUT VARIABLE AREA\r
+\r
+ MOVE PP,[IOWD PDL,PPSET] ;INIT PUSH DOWN LIST POINTER\r
+ HLLOS UPPLIM ;?\r
+\r
+ TLNE IO,IORPG ;IN CCL MODE?\r
+ JRST LSTSET ;YES, NO *\r
+ PUSHJ PP,CRLF ;NO\r
+ MOVEI C,"*"\r
+ PUSHJ PP,TYO ;OUTPUT *\r
+\f;THIS CODE IS USED TO SET UP SOURCE AND\r
+;DESTINATION DEVICES, DO MAGTAPE SPACING COMMANDS, ETC.\r
+\r
+LSTSET: MOVSI ACDEV,(SIXBIT /LPT/)\r
+ MOVEM ACDEV,LSTDEV ;DEFAULT LIST DEVICE IS LPT:\r
+ PUSHJ PP,NAME1 ;GET NEXT DEVICE\r
+ CAIE C,"_" ;LISTING DEVICE SPECIFIED?\r
+ JRST LSTS2 ;NO\r
+ SKIPE ACDEV\r
+ MOVEM ACDEV,LSTDEV ;SAVE DEVICE NAME\r
+ MOVEM ACFILE,LSTDIR ;STORE FILE NAME\r
+ MOVEM ACEXT,LSTDIR+1\r
+\r
+LSTS2: MOVEI FLAG,AL ;INIT DEVICE IN ASCII LINE MODE\r
+ MOVE FLAG+1,LSTDEV ;GET DEVICE NAME\r
+ MOVSI FLAG+2,LSTBUF ;BUFFER HEADER ADDRESS\r
+ OPEN LST,FLAG ;TRY TO INIT DEVICE\r
+ JRST ERRAVL ;OPEN FAILED\r
+ OUTBUF LST,2\r
+\r
+ CAIE C,"_" ;LISTING DEVICE SPECIFIED?\r
+ JRST INSET1 ;NO\r
+ DEVCHR ACDEV, ;GET OUTPUT DEVICE CHARACTERISTICS\r
+ TLNE ACDEV,10 ;IS IT A TTY?\r
+ TLO IO,IOTTY ;YES, SET TTY FLAG\r
+ TLZE TIO,TIORW ;REWIND REQUESTED?\r
+ MTAPE LST,1 ;YES\r
+ JUMPGE CS,LSTSE3\r
+ MTAPE LST,17 ;BACKSPACE MTA\r
+ AOJL CS,.-1 ;IF COUNT IS NEG., BACKSPACE AGAIN\r
+ WAIT LST, ;WAIT FOR TAPE TO STOP SO LOAD POINT CAN BE SENSED\r
+ STATO LST,1B24 ;SKIP IF AT LOAD POINT-\r
+ ; THIS PUTS TAPE ON CORRECT SIDE OF EOF\r
+ MTAPE LST,16 ;SPACE FORWARD 1 FILE\r
+LSTSE3: SOJG CS,.-1 ;LOOP UNTIL POS. COUNT RUNS OUT\r
+\r
+ TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED?\r
+ UTPCLR LST, ;YES, CLEAR IT\r
+ ENTER LST,LSTDIR\r
+ JRST ERRENT\r
+\fINSET: PUSHJ PP,NAME1 ;GET NEXT COMMAND NAME\r
+INSET1: SKIPN ACDEV\r
+ MOVSI ACDEV,(SIXBIT /DSK/)\r
+ MOVEM ACDEV,INDEV ;SAVE DEVICE FOR ERR MESSAGES\r
+ SKIPN ACFILE\r
+ MOVE ACFILE,[SIXBIT /CREF/]\r
+ MOVEM ACFILE,INDIR ;STORE FILE IN DIRECTORY\r
+\r
+ MOVEI ACDEV-1,A ;INIT DEVICE IN "A" MODE\r
+ MOVEI ACDEV+1,INBUF ;SET UP ARG FOR BUFFER HEADER\r
+ OPEN CHAR,ACDEV-1 ;OPEN CHANNEL\r
+ JRST ERRAVI ;FAILED\r
+\r
+ TLZE TIO,TIORW ;REWIND?\r
+ MTAPE CHAR,1 ;YES\r
+ JUMPGE CS,INSET2\r
+ MTAPE CHAR,17\r
+ MTAPE CHAR,17\r
+ AOJL CS,.-1\r
+ WAIT CHAR,\r
+ STATO CHAR,1B24\r
+ MTAPE CHAR,16\r
+INSET2: SOJGE CS,.-1\r
+\fINSET3: INBUF CHAR,2\r
+ JUMPN ACEXT,INSET4 ;TAKE USER'S EXTENSION IF NON-BLANK\r
+ MOVE ACEXT,[SIXBIT /LSTCRF/] ;TRY CRF 1ST, THEN LST\r
+ JSP ACDEV,INSETI ;LOOKUP FILE (DON'T RETURN IF FOUND)\r
+ JUMPN ACEXT,.-1 ;KEEP LOOKING UNTIL EXT'S GONE\r
+ MOVSI ACEXT,(SIXBIT /TMP/) ;FINALLY TRY TMP THEN NULL\r
+ JSP ACDEV,INSETI\r
+INSET4: MOVEI ACDEV,ERRFND ;RETURN IS CONTINUE OR JRST ERRFND\r
+\r
+INSETI: HLLM ACEXT,INDIR+1 ;STORE EXTENSION\r
+ LSH ACEXT,^D18 ;SLIDE NEXT EXT INTO PLACE\r
+ LOOKUP CHAR,INDIR\r
+ JRST (ACDEV) ;NOT FOUND\r
+\r
+ SKIPN FIRSTL ;HAS INITIAL PRINTING LINE BEEN REQUESTED?\r
+ JRST LSTS7 ;NO\r
+ TLNE IO,IORPG\r
+ JRST LSTS4 ;NO MESSAGE OUTPUT FOR RPG SYSTEM\r
+ MOVEI TEMP,[ASCIZ /RESTART LISTING AT LINE: /]\r
+ DDTOUT CTLI,\r
+ INPUT CTLI, ;INPUT THE ANSWER\r
+LSTS4: MOVEI AC0,0 ;INIT DECIMAL NUMBER ASSEMBLER\r
+LSTS5: PUSHJ PP,TTYIN ;GET CHARACTER\r
+ CAIL C,"0" ;IS IT A DIGIT?\r
+ CAILE C,"9"\r
+ JRST LSTS6 ;NO\r
+ IMULI AC0,12 ;YES\r
+ ADDI AC0,-"0"(C)\r
+ JRST LSTS5\r
+\r
+LSTS6: MOVEM AC0,FIRSTL ;SAVE DECIMAL NUMBER\r
+LSTS7: ;TO HERE IF NO INITIAL LINE SPECIFIED\r
+\fIFN FAILC,<\r
+ MOVEI FREE,BLKST-1 ;SET UP THINGS FOR COMBG\r
+ MOVEM FREE,BLKND\r
+>\r
+\r
+RECYCL: HRRZ FREE,JOBFF ;RETURN FOR MULTIPLE F4 PROGS\r
+ ADDI FREE,1\r
+ TRZ FREE,1 ;SET UP BYTE TABLE ADR ON EVEN LOCATION\r
+\r
+ HRRZ C,JOBREL ;SET UP HIGH ADR OF SYMBOL TABLE\r
+ SKIPE JOBDDT\r
+ HRRZ C,JOBSYM ;SAVE DDT'S SYMBOL TABLE WHEN IN USE\r
+ SOS TOP,C ;ALLOW 1 WORD SLOP\r
+ SUBI C,LENGTH ;MOVE AN INITIAL VESTIGIAL SYMBOL TABLE TO HIGH MEMORY\r
+ MOVE SYMBOL,C\r
+ HRLI C,SYMNUM\r
+ BLT C,0(TOP) ;MOVE THE 5 WORDS STARTING AT SYMNUM BELOW\r
+ PUSHJ PP,SRCHI\r
+ MOVEI LINE,1 ;INITIALIZE LINE COUNTER\r
+ PUSHJ PP,READ ;TEST FIRST CHARACTER\r
+ CAIE C,%EOF ;PROGRAM BREAK?\r
+ JRST M2A ;NO, PROCESS\r
+ JRST M2 ;YES, BYPASS\r
+\r
+;THIS IS AN INITIAL VESTIGIAL SYMBOL TABLE - IT MAKES INITIALIZATION\r
+;OF THE SYMBOL TABLE SEARCH EASY\r
+\r
+SYMNUM: EXP LENGTH/2 ;COUNT OF INITIAL ENTRIES IN SYMBOL TABLE\r
+ 1B0 ;MOST NEGATIVE POSSIBLE SYMBOL\r
+ -1 ;GARBAGE VALUE FOR MOST NEG. SYMBOL\r
+ -1B36 ;MOST POSITIVE POSSIBLE SYMBOL\r
+ -1 ;GARBAGE VALUE FOR MOST POS. SYMBOL\r
+LENGTH= .-SYMNUM\r
+\fMLON\r
+M1: TLNN IO,IOLST ;IS PROGRAM LISTING SUPPRESSED?\r
+ PUSHJ PP,WRITE ;NO, OUTPUT CHARACTER\r
+M2: PUSHJ PP,READ ;GET NEXT CHARACTER\r
+M2A: CAIN C,177 ;RUBOUT?\r
+ JRST FAILM ;ALL "NEW STYLE" CREF DATA BEGINS WITH RUBOUT\r
+ CAIN C,12\r
+ JRST M1\r
+ CAIN C,15\r
+ JRST FCKLF\r
+ CAIG C,%EOF ;IS CHAR IN RANGE OF "OLD STYLE" CREF CONTROL CHARS.?\r
+ CAIGE C,%OP\r
+ SKIPA ;NO\r
+ JRST M2C ;YES\r
+ TLZE IO,IOENDL\r
+ TLNE IO,IOLST\r
+ JRST M1\r
+ PUSH PP,C\r
+ MOVEI C,11\r
+ PUSHJ PP,WRITE\r
+ POP PP,C\r
+ JRST M1\r
+\r
+M2C: TLNE IO,IOFAIL ;IF "NEW STYLE" DATA SEEN (IOFAIL=1),IGNORE OLD\r
+ JRST M1 ;IGNORE "OLD STYLE" CREF DATA\r
+ TLZ IO,IOENDL\r
+ TLO IO,IOTB2\r
+ XCT MTAB-%OP(C) ;DO SOMETHING (USUALLY SET BITS) WITH CONTROL CHAR\r
+ JRST M3 ;BITS WERE SET (EITHER IOOP,IOMAC, OR IOSYM)\r
+\r
+M2B: TLNN IO,IOLST\r
+ PUSHJ PP,CNVRT ;IF MAKING LISTING, CONVERT (LINE) TO TEXT\r
+ TLNE IO,IOTABS\r
+ JRST [MOVEI C,11\r
+ TLNN IO,IOLST\r
+ PUSHJ PP,WRITE\r
+ JRST M2B1\r
+ ]\r
+M2B1: AOJA LINE,M2 ;INDEX LINE NUMBER AND START ON NEXT LINE\r
+\r
+\fM3: MOVEI AC0,0 ;INIT RADIX 50 SYMBOL\r
+M4: PUSHJ PP,READ ;GET NEXT CHAR FOR SYMBOL\r
+ CAIL C,"$"\r
+ CAILE C,"Z"\r
+ JRST M5A ;CHAR NOT IN RADIX 50 SET\r
+ HLRZ C,CSTAT-" "(C) ;GET RADIX 50 CODE FOR CHAR\r
+ JUMPE C,M5A ;CHAR NOT IN RADIX 50 SET\r
+ IMULI AC0,50 ;BUILD SYMBOL AND LOOP\r
+ ADD AC0,C\r
+ JRST M4\r
+\r
+M5A: PUSHJ PP,M5 ;LEFT JUSTIFY SYMBOL AND STORE IN DATA TABLES\r
+ JRST M2\r
+\r
+ IMULI AC0,50\r
+M5: CAMG AC0,[RADIX5 0,%%%%% ]\r
+ JUMPN AC0,.-2 ;MULTIPLY BY 50 UNTIL LEFT JUSTIFIED\r
+ JUMPN AC0,M6 ;SYMBOL GOOD IF NOT ZERO, SAVE IN TABLES\r
+ERROR: JSP RC,ERRMSG ; MOVE PP,[IOWD PDL,PPSET] ;RESTORE PP\r
+ SIXBIT /?IMPROPER INPUT DATA@/\r
+\r
+M6: TDNE IO,SX ;IS THIS TYPE OF SYMBOL BEING CROSS REFERENCED?\r
+ TLNE IO,IONCRF\r
+ POPJ PP, ;NO\r
+ IOR AC0,SX ;PUT SYMBOL TYPE BITS INTO SYMBOL\r
+\r
+ CAML LINE,LOWLIM ;IS THIS LINE INSIDE THE COMMAND STRING RANGE REQUEST?\r
+ CAMLE LINE,UPPLIM\r
+ TDZA FLAG,FLAG ;NO\r
+ MOVSI FLAG,(1B0) ;YES, SET FLAG TO STORE IN DATA TABLES\r
+ JRST SRCH ;STORE SYMBOL, SYM TYPE, AND RANGE FLAG IN TABLES\r
+ POPJ PP,\r
+\r
+;THIS TABLE'S ENTRIES ARE EXECUTED FROM M2C+4\r
+\r
+MTAB: MOVSI SX,IOOP ;CODE TYPE IS OP CODE, OPDEF,PSEUDO INSTRUCTION \r
+ MOVSI SX,IOMAC ;MACRO NAME\r
+ SKIPA C,LINE\r
+ MOVSI SX,IOSYM ;NORMAL SYMBOL (DEFINED WITH = OR :)\r
+ JRST R0 ;BREAK BETWEEN PROGRAMS\r
+\r
+FCKLF: TLNE IO,IOTABS!IOTB2\r
+ TLO IO,IOENDL\r
+ JRST M1\r
+\fR0: TLO IO,IOPAGE\r
+ SETZM FIRSTL ;FOR TABLES, EVERYTHING GETS LISTED\r
+ PUSH PP,SYMBOL\r
+IFN FAILC,<\r
+ SKIPE BYTEX,BLKST ;CHECK FOR FAIL BLOCK STRUCTURE\r
+ PUSHJ PP,BLKPRN\r
+>\r
+ SOS SX,0(SYMBOL)\r
+ MOVSI FLAG,IOSYM\r
+R1: PUSHJ PP,LINOUT\r
+R1B: SOJE SX,FINIS\r
+ ADDI SYMBOL,2\r
+ SKIPL 2(SYMBOL)\r
+ JRST R1B\r
+ MOVE C,1(SYMBOL)\r
+ HRRZ BYTEX,2(SYMBOL)\r
+ ADDI BYTEX,1\r
+ HRLI BYTEX,(POINT 6,0,5)\r
+ MOVE BYTEM,-1(BYTEX)\r
+\r
+R1A: TDZE C,FLAG\r
+ JRST R2\r
+ TLO IO,IOPAGE\r
+ LSH FLAG,1\r
+ JUMPN FLAG,R1A\r
+\r
+R2: TLZ IO,IONLZ ;NO NON-ZEROS YET (FOR F4 ONLY)\r
+ PUSHJ PP,R50ASC\r
+ MOVEI LINE,0\r
+\r
+R3: PUSHJ PP,GETVAL\r
+ JRST R1\r
+ PUSHJ PP,CNVRT\r
+ JRST R3\r
+\f;SUBROUTINE TO CONVERT LINE NUMBERS TO ASCII TEXT\r
+CNVRT: MOVEI TEMP,6 ;OUTPUT SPACES FOR LEADING ZEROS\r
+CNVR1: MOVEI C+1," "-"0"\r
+ SKIPE C\r
+ IDIVI C,12\r
+ HRLM C+1,(PP)\r
+ SOSG TEMP\r
+ SKIPE C\r
+ PUSHJ PP,CNVR1\r
+ HLRZ C,(PP)\r
+ MOVEI C,"0"(C)\r
+ JRST WRITE\r
+\r
+R50ASC: IDIVI C,50\r
+ PUSH PP,CS\r
+ SKIPE C\r
+ PUSHJ PP,R50ASC\r
+ POP PP,C\r
+ HRRZ C,CSTAT(C)\r
+ CAIN C,"0" ;TEST FOR LEADING 0'S\r
+ TLNE IO,IONLZ\r
+ TLOA IO,IONLZ\r
+ MOVEI C," "\r
+ JRST WRITE0\r
+\fFREAD: PUSHJ PP,READ ;GET CHARACTER COUNT\r
+ MOVE TEMP1,C ;1ST CHAR IS COUNT OF CHARS IN FOLLOWING SYMBOL\r
+ MOVEI AC0,0\r
+FM4: PUSHJ PP,READ\r
+ CAIL C,"$"\r
+ CAILE C,"Z" ;CHECK RANGE\r
+ JRST ERROR\r
+ HLRZ C,CSTAT-" "(C)\r
+ JUMPE C,ERROR ;ILLEGAL RADIX50\r
+ IMULI AC0,50\r
+ ADD AC0,C\r
+ SOJG TEMP1,FM4 ;MORE CHARS TO GO?\r
+ POPJ PP,\r
+\r
+FAILM: PUSHJ PP,READ ;IS THIS REALLY THE START?\r
+ CAIE C,102 ;RUBOUT B BEGINS ALL "NEW STYLE" CREF DATA\r
+ JRST NOTINF\r
+ TLZ IO,IOENDL ;INFORMATION WAS SEEN\r
+ TLO IO,IOFAIL ;THIS IS FAIL\r
+FM2: PUSHJ PP,READ\r
+ CAIN C,177 ;POSSIBLE END?\r
+ JRST TEND ;CHECK\r
+ CAILE C,16 ;IN RANGE?\r
+ JRST ERROR\r
+ XCT DTAB-1(C)\r
+ TLZE SX,IODF2 ;DO WE WANT TO DEFINE IT?\r
+ TLO IO,IODEF ;YES, SET FLAG\r
+ PUSHJ PP,FREAD ;GET THE SYMBOL\r
+FM6: PUSHJ PP,M5 ;GO ENTER SYYMBOL\r
+ JRST FM2\r
+\r
+NOTINF: PUSH PP,C ;PUT IT OUT AS IT WAS READ\r
+ MOVEI C,177\r
+ TLNN IO,IOLST\r
+ PUSHJ PP,WRITE\r
+ POP PP,C\r
+ JRST M1 ;BACK INTO MAIN STREAM\r
+\r
+TEND: MOVE AC0,SVLAB ;IS THERE A LABEL TO PUT IN\r
+ SETZM SVLAB\r
+ MOVSI SX,IOSYM\r
+ SKIPE AC0\r
+ PUSHJ PP,M5\r
+ PUSHJ PP,READ ;CHECK FOR END CHARACTER\r
+ CAIN C,101\r
+ TLO IO,IOTABS ;CREF DATA TERMINATED WITH "RUBOUT A" MEANS\r
+ ;INSERT TAB IN LISTING\r
+ CAIE C,103 ;ALL NEW STYLE CREF DATA ENDS WITH "RUBOUT A" OR "RUBOUT C"\r
+ CAIN C,101\r
+ SKIPA\r
+ JRST ERROR ;BAD CREF DATA\r
+ MOVE C,LINE ;SET UP TO ENTER\r
+ JRST M2B\r
+\f;TABLE FOR NEW STYLE CREF CONTROL CHARACTERS\r
+;THE TABLE ENTRIES ARE EXECUTED FROM FM2+5\r
+\r
+DTAB: JRST SETLAB ;FOLLOWING SYM DEFINED WITH = OR :\r
+ JRST DLAB ;THE DEFINING OCCURANCE OF THE ABOVE SYMBOL\r
+ MOVSI SX,IOOP ;FOLLOWING SYM IS OP CODE, OPDEF, OR PSEUDO INSTRUCTION\r
+ MOVSI SX,IOOP!IODF2 ;DEFINING OCCURANCE OF THE ABOVE (I. E. OPDEF)\r
+ MOVSI SX,IOMAC ;MACRO NAME\r
+ MOVSI SX,IOMAC!IODF2 ;MACRO DEFINITION\r
+ REPEAT 6,<JRST ERROR>\r
+IFN FAILC,<\r
+ JRST BBEG ;BEGINNING OF A BLOCK FOR THE STANFORD "FAIL" ASSEMBLER\r
+ JRST BBEND ;END OF THE ABOVE BLOCK\r
+>\r
+\r
+IFE FAILC,<\r
+ JRST ERROR ;BLOCK STRUCTURE NOT ASSEMBLED IN\r
+ JRST ERROR\r
+>\r
+\fSETLAB: PUSHJ PP,FREAD ;GET LABEL\r
+ EXCH AC0,SVLAB ;CHANGE FOR OLD\r
+ JUMPE AC0,FM2 ;NO OLD, GO GET MORE\r
+ MOVSI SX,IOSYM ;SET TO DEFINE\r
+ JRST FM6\r
+\r
+DLAB: MOVE AC0,SVLAB ;USE LAST LABEL\r
+ SETZM SVLAB\r
+ JUMPE AC0,ERROR ;ERROR IF NONE THERE\r
+ MOVSI SX,IOSYM\r
+ TLO IO,IODEF\r
+ JRST FM6\r
+\r
+IFN FAILC,<\r
+BBEG: AOS TEMP,LEVEL ;GET CURRENT LEVEL\r
+ MOVSI SX,0\r
+ PUSHJ PP,COMBG ;GO INSER\r
+ JRST FM2\r
+\r
+BBEND: MOVE TEMP,LEVEL ;CURRENT LEVEL\r
+ MOVEI SX,1\r
+ PUSHJ PP,COMBG\r
+ SOS LEVEL ;RESET\r
+ JRST FM2\r
+\r
+COMBG: PUSHJ PP,FREAD ;GET NAME\r
+ SKIPA\r
+ IMULI AC0,50\r
+ CAMG AC0,[RADIX50 0,%%%%% ]\r
+ JRST .-2\r
+ MOVE TEMP1,FREE\r
+ ADDI FREE,4 ;RESERVE 4 WORDS\r
+ CAML FREE,SYMBOL\r
+ PUSHJ PP,XCEED ;OVERLAP\r
+ MOVEM AC0,(TEMP1) ;SAVE NAME\r
+ HRLZM TEMP,1(TEMP1) ;AND LEVEL\r
+ MOVEM LINE,2(TEMP1) ;AND CURRENT LINE\r
+ HRLM SX,2(TEMP1)\r
+ MOVE TEMP,BLKND ;SAVE CURRENT POINTER\r
+ HRRM TEMP1,1(TEMP) ;SET UP LINK\r
+ MOVEM TEMP1,BLKND\r
+ POPJ PP,\r
+>\r
+\fIFN FAILC,<\r
+BLKPRN: PUSHJ PP,LINOUT\r
+ MOVE C,@BLKND\r
+ PUSHJ PP,R50ASC\r
+ MOVEI C,11\r
+ PUSHJ PP,WRITE\r
+ MOVE C,[RADIX50 0,PROGRA]\r
+ PUSHJ PP,R50ASC\r
+ MOVEI C,"M"\r
+ PUSHJ PP,WRITE\r
+BLKP3: PUSHJ PP,LINOUT\r
+ HLRZ BYTEM,1(BYTEX)\r
+ LSH BYTEM,-1\r
+ JUMPE BYTEM,BLKP1\r
+ PUSHJ PP,TABOUT\r
+ SOJG BYTEM,.-1\r
+BLKP1: HLRZ BYTEM,1(BYTEX)\r
+ HLRZ SX,2(BYTEX)\r
+ TRNE BYTEM,1\r
+ ADDI SX,4\r
+ JUMPE SX,BLKP2\r
+ MOVEI C," "\r
+ PUSHJ PP,WRITE\r
+ SOJG SX,.-1\r
+BLKP2: MOVE C,(BYTEX)\r
+ PUSHJ PP,R50ASC\r
+ HLRZ SX,2(BYTEX)\r
+ MOVNS SX\r
+ ADDI SX,5\r
+ MOVEI C," "\r
+ PUSHJ PP,WRITE\r
+ SOJG SX,.-1\r
+ HRRZ C,2(BYTEX)\r
+ PUSHJ PP,CNVRT\r
+ HRRZ BYTEX,1(BYTEX)\r
+ JUMPN BYTEX,BLKP3\r
+ TLO IO,IOPAGE\r
+ POPJ PP,\r
+>\r
+\f;THE LEFT HALF OF THIS TABLE IS USED TO CONVERT FROM ASCII TEXT\r
+ ;TO RADIX 50 CODE- THE FIRST LOCATION STARTS AT 40 (SPACE)\r
+ ;ZERO ENTRIES IN LEFT HALF INDICATE INVALID RADIX 50 CHAR\r
+;THE RIGHT HALF IS USED TO CONVERT FROM RADIX 50 TO ASCII\r
+\r
+CSTAT:\r
+ XWD 00," "\r
+ XWD 00,"0"\r
+ XWD 00,"1"\r
+ XWD 00,"2"\r
+ XWD 46,"3"\r
+ XWD 47,"4"\r
+ XWD 00,"5"\r
+ XWD 00,"6"\r
+\r
+ XWD 00,"7"\r
+ XWD 00,"8"\r
+ XWD 00,"9"\r
+ XWD 00,"A"\r
+ XWD 00,"B"\r
+ XWD 00,"C"\r
+ XWD 45,"D"\r
+ XWD 00,"E"\r
+\r
+ XWD 01,"F"\r
+ XWD 02,"G"\r
+ XWD 03,"H"\r
+ XWD 04,"I"\r
+ XWD 05,"J"\r
+ XWD 06,"K"\r
+ XWD 07,"L"\r
+ XWD 10,"M"\r
+\r
+ XWD 11,"N"\r
+ XWD 12,"O"\r
+ XWD 00,"P"\r
+ XWD 00,"Q"\r
+ XWD 00,"R"\r
+ XWD 00,"S"\r
+ XWD 00,"T"\r
+ XWD 00,"U"\r
+\f XWD 00,"V"\r
+ XWD 13,"W"\r
+ XWD 14,"X"\r
+ XWD 15,"Y"\r
+ XWD 16,"Z"\r
+ XWD 17,"."\r
+ XWD 20,"$"\r
+ XWD 21,"%"\r
+\r
+ XWD 22,0\r
+ XWD 23,0\r
+ XWD 24,0\r
+ XWD 25,0\r
+ XWD 26,0\r
+ XWD 27,0\r
+ XWD 30,0\r
+ XWD 31,0\r
+\r
+ XWD 32,0\r
+ XWD 33,0\r
+ XWD 34,0\r
+ XWD 35,0\r
+ XWD 36,0\r
+ XWD 37,0\r
+ XWD 40,0\r
+ XWD 41,0\r
+\r
+ XWD 42,0\r
+ XWD 43,0\r
+ XWD 44,0\r
+;----\r
+\f;SEARCH THE SYMBOL TABLE AND STORE STUFF IN IT\r
+SRCH: HRRZ SX,SRCMID ;GET POINTER TO SYM IN MIDDLE OF TABLE\r
+SRCH01: HRRZ TX,SRCMSB ;GET "MOST SIGNIFICANT BIT"\r
+ ; OF TABLE ENTRY COUNT\r
+\r
+;START LOGORITHMIC SEARCH\r
+SRCH10: CAML AC0,-1(SX) ;IS SYMBOL HIGHER THAN THIS?\r
+ JRST SRCH30 ;YES\r
+SRCH12: SUB SX,TX ;NO,MOVE DOWN BY DELTA INCREMENT\r
+SRCH13: LSH TX,-1 ;DIVIDE DELTA INCREMENT BY 2\r
+ CAMG SX,TOP ;OVER THE TOP OF THE TABLE?\r
+ JUMPN TX,SRCH10 ;NO,GO LOOK SOME MORE (SEARCH IS OVER WHEN DELTA=0)\r
+ JUMPN TX,SRCH12 ;YES,MOVE DOWN INTO TABLE (SEARCH IS OVER WHEN DELTA=0)\r
+ CAMLE LINE,UPPLIM ;SYMBOL NOT FOUND, SAVE SYMBOL IF IT MIGHT BE \r
+ ;IN RANGE (SPECIFIED IN COMMAND STRING) OR IF NO RANGE GIVEN\r
+ POPJ PP,\r
+ SUBI SX,1 ;MAKE SX POINT TO 1ST SYM TO BE MOVED\r
+ MOVEI TX,-2(SYMBOL)\r
+ CAILE TX,2(FREE) ;IS THERE ROOM LEFT BETWEEN THE TWO TABLES?\r
+ JRST SRCH20 ;YES\r
+ PUSHJ PP,XCEED ;NO, GET MORE CORE AND MOVE SYM TABLE UP\r
+ ADDI SX,2000 ;UPDATE SY TABLE POINTERS BY AMOUNT OF NEW CORE\r
+ ADDI TX,2000\r
+\r
+SRCH20: MOVE SYMBOL,TX\r
+ HRLI TX,2(TX)\r
+ BLT TX,-2(SX) ;MOVE SYM TABLE TO MAKE HOLE\r
+ AOS 0(SYMBOL) ;INDEX SYM TAB ENTRY COUNT TO ACCOUNT FOR NEW ENTRY\r
+ MOVE TX,FREE ;GET 1ST ADR OF A WORD PAIR FOR STORING INCREMENTS\r
+ MOVEI BYTEX,1(FREE) ;GET ADR OF 2ND BYTE FOR 1ST WORD PAIR\r
+ HRLI BYTEX,(POINT 6,,5) ;SET UP POINTER FOR 2ND BYTE OF 1ST WORD PAIR\r
+ ADDI FREE,2 ;UPDATE FREE WORD POINTER\r
+ MOVEM AC0,-1(SX) ;SAVE SYMBOL IN SYMBOL TABLE\r
+ SETZM 1(TX) ;ZERO BYTES AND POINTER TO 2ND WORD PAIR\r
+ MOVEI C,1 ;ASSUME NON-DEF OCCURANCE OF SYMBOL\r
+ TLNE IO,IODEF ;CORRECT ASSUMPTION?\r
+ TRC C,3 ;NO, 2 INDICATES A DEF OCCURANCE (1 IS NON-DEF)\r
+ DPB C,[POINT 6,1(TX),5] ;SAVE REASON (DEF OR NOT) OF \r
+ ;LAST OCCURANCE OF SYM IN 1ST BYTE\r
+ MOVE C,LINE\r
+ LSH C,1 ;LINE # IS STORED SHIFTED LEFT 1 TO LEAVE ROOM FOR A 1 BIT\r
+ ;FOR A DEF OCCR OF THE SYMBOL\r
+ TLZN IO,IODEF\r
+ IORI C,1 ;IT WAS DEF OCCURANCE, TURN ON BIT\r
+ HRLM LINE,0(SX) ;SAVE LINE # AND DEFINE BIT IN LEFT HALF OF SYM VALUE\r
+ HRRM TX,0(SX) ;SAVE POINTER TO BYTE WORD PAIRS\r
+ ; IN RIGHT HALF OF SYM VALUE\r
+ PUSHJ PP,SRCHI ;CALCULATE NEW MIDDLE ADR OF SYM TABLE AND \r
+ ;A NEW STARTING DELTA\r
+ JRST STV12\r
+\fSRCH30: CAMN AC0,-1(SX) ;HAS THE SYMBOL BEEN FOUND?\r
+ JRST STV10 ;YES\r
+ ADD SX,TX ;NO, LOOK HIGHER IN TABLE\r
+ JRST SRCH13\r
+\r
+\f;SYMBOL FOUND IN TABLE\r
+STV10: LDB C,[POINT 17,0(SX),17] ;GET LAST LINE # WHERE SYMBOL WAS SEEN\r
+ HRRZ TX,0(SX) ;GET ADR OF 1ST WORD OF 1ST WORD PAIR\r
+ ;WHERE INCREMENTS ARE STORED\r
+ CAME C,LINE ;IS THIS OCCR ON SAME LINE AS LAST OCCR?\r
+ JRST STV10A ;NO\r
+ LDB TEMP,[POINT 6,1(TX),5];YES, GET REASON (DEF OR NOT) FOR STORING LAST TIME\r
+ TLNN IO,IODEF ;IS THIS OCCR A DEF ONE?\r
+ JRST STV10B ;NO\r
+ TROE TEMP,2 ;YES, WAS THE PREVIOUS ONE DEF? (A LINE MAY HAVE BOTH\r
+ ;DEF AND NON-DEF OCCRS)\r
+ POPJ PP, ;YES, DO NOTHING (2 DEFG OCCURANCES ON SAME LINE)\r
+ JRST STV10C ;NO,DEF+NON-DEF OCCRS ON SAME LINE\r
+STV10B: TROE TEMP,1 ;WAS PREVIOUS OCCR NON-DEF?\r
+ POPJ PP, ;YES, DO NOTHING (2 NON-DEF OCCRS ON SAME LINE)\r
+STV10C: DPB TEMP,[POINT 6,1(TX),5];SAVE TYPE (DEF OR NOT) OF OCCR IN 1ST BYTE\r
+ JRST STV10D ;STORE INDICATING DEF+NON-DEF ON SAME LINE\r
+\r
+;THIS SYMBOL IS A NEW SYMBOL NEVER BEFORE SEEN\r
+STV10A: MOVEI TEMP,1 ;ASSUME THIS IS A NON-DEF OCCR\r
+ TLNE IO,IODEF ;CORRECT ASSUMPTION?\r
+ TRC TEMP,3 ;NO, CHANGE 1 TO A 2 TO SHOW DEFING OCCR\r
+ DPB TEMP,[POINT 6,1(TX),5] ;SAVE NEW LINE # IN BITS 0-17 OF SYM VALUE\r
+STV10D:\r
+ DPB LINE,[POINT 17,0(SX),17]\r
+ LSH LINE,1\r
+ TLZN IO,IODEF\r
+ IORI LINE,1 ;MAKE DEFINE BIT BE LOW ORDER BIT OF 2*LINE#\r
+ LSH C,1\r
+ SUBM LINE,C ;CALCULATE DELTA LINE#\r
+ LSH LINE,-1 ;NOW ELIMINATE DEFINE BIT\r
+ MOVE BYTEX,0(TX) ;GET BYTE POINTER TO LAST BYTE FOR LAST SYM OCCURRANCE\r
+\f\r
+STV12: ORM FLAG,0(SX) ;SAVE SYMBOL TYPE (MACRO, SYMBOL,OP CODE)\r
+ CAIGE C,^D32 ;IS DELTA LINE# (OR LINE# THE 1ST TIME)\r
+ ; BIGGER THAN 1 BYTE?\r
+ JRST STV20 ;NO, IT FITS\r
+ MOVEM PP,PPTEMP ;2 (OR MORE) BYTES NEEDED\r
+\r
+;DIVIDE 2*LINE#+DEFINE BIT INTO 5 BIT BYTES, TURN ON\r
+;BIT 30 WHENEVER THERE ARE MORE BYTES LEFT. CALL\r
+;STV20 TO STORE THE BYTES AWAY. FOR THE LAST BYTE DO NOT TURN ON BIT 30,\r
+;THUS INDICATING NO MORE BYTES\r
+STV14: IDIVI C,^D32\r
+ PUSH PP,CS\r
+ CAIL C,^D32\r
+ JRST STV14\r
+STV16: TRO C,40\r
+ PUSHJ PP,STV20\r
+ POP PP,C\r
+ CAME PP,PPTEMP\r
+ JRST STV16\r
+\r
+STV20: TRNE BYTEX,1 ;IS BYTE POINTER IN 1ST WORD OF WORD PAIR? OR\r
+ CAML BYTEX,[POINT 6,,16] ;IN LEFT HALF OR 2ND WORD OF PAIR?\r
+ JRST STV22 ;YES, CONTINUE USING THIS WORD PAIR\r
+ HRRM FREE,0(BYTEX) ;NO,MAKE RH OF 2ND WORD OF PAIR POINT TO NEW WORD PAIR\r
+ MOVE BYTEX,FREE ;INIT ADREESS OF BYTE POINTER IN NEW WORD PAIR\r
+ HRLI BYTEX,(POINT 6,,);INIT BYTE POINTER PARTS TO LEFT BYTE OF\r
+ ; 1ST WORD OF NEW PAIR\r
+ ADDI FREE,2 ;UPDATE FREE END OF TABLE\r
+ CAML FREE,SYMBOL ;ROOM AVAILABLE?\r
+ PUSHJ PP,XCEED ;NO, GET MORE CORE AND MOVE SYMBOL TABLE UP\r
+\r
+STV22: IDPB C,BYTEX ;STORE INCREMENT BYTE AWAY\r
+ MOVEM BYTEX,0(TX) ;SAVE BYTE POINTER IN 1ST WORD OF 1ST WORD PAIR\r
+POPOUT: POPJ PP,\r
+\fGETVAL: TLZN IO,IODEF\r
+ JRST GETV20\r
+ MOVEI C,"#"\r
+ PUSHJ PP,WRITE\r
+GETV20: CAMN BYTEX,BYTEM\r
+ POPJ PP,\r
+ AOS 0(PP)\r
+ PUSHJ PP,TABOUT\r
+ MOVEI C,0\r
+GETV10: TRNE BYTEX,1\r
+ CAML BYTEX,[POINT 6,,16]\r
+ JRST GETV12\r
+ MOVE BYTEX,0(BYTEX)\r
+ HRLI BYTEX,(POINT 6,,)\r
+\r
+GETV12: ILDB CS,BYTEX\r
+ ROT CS,-5\r
+ LSHC C,5\r
+ JUMPN CS,GETV10\r
+ TRNN C,1 ;SET DEFINED FLAG\r
+ TLO IO,IODEF\r
+ LSH C,-1\r
+ ADDB LINE,C\r
+ POPJ PP,\r
+\fTABOUT: MOVEI C,11\r
+ SOJGE WPL,WRITE0\r
+ PUSHJ PP,LINOUT\r
+ JRST TABOUT\r
+\r
+LINOUT: SOSG LPP\r
+ TLO IO,IOPAGE\r
+ MOVEI C,15\r
+ PUSHJ PP,WRITE\r
+ MOVEI C,12\r
+ PUSHJ PP,WRITE\r
+ MOVEI WPL,WPLLPT ;ASSUME LINES FOR LPT\r
+ TLNE IO,IOTTY ;CORRECT ASSUMPTION?\r
+ MOVEI WPL,WPLTTY ;NO, SET UP LINES TO TTY\r
+\r
+ POPJ PP,\r
+\r
+WRITE0: TLZN IO,IOPAGE\r
+ JRST WRITE\r
+ PUSH PP,C\r
+ MOVEI C,14\r
+ PUSHJ PP,WRITE\r
+ MOVEI C,.LPP\r
+ MOVEM C,LPP\r
+ POP PP,C\r
+\r
+WRITE: CAMGE LINE,FIRSTL ;HAVE WE REACHED REQUESTED LINE?\r
+ POPJ PP,\r
+ SOSG LSTBUF+2\r
+ PUSHJ PP,DMPLST\r
+ IDPB C,LSTBUF+1\r
+ CAIN C,12 ;IF NOT LINE-FEED, OR\r
+ TLNN IO,IOTTY ;IF NOT TTY, DON'T OUTPUT EVERY LINE\r
+ POPJ PP,\r
+ JRST DMPLST ;OUPUT LINE\r
+\f;GET 1K MORE CORE AND MOVE THE SYMBOL TABLE (BOTH DDT'S AND CREF'S)\r
+;UP INTO THE NEW SPACE\r
+\r
+XCEED: PUSH PP,0\r
+ PUSH PP,1\r
+ PUSH PP,2\r
+ HRRZ 1,JOBREL ;GET CURRENT TOP\r
+ MOVEI 0,2000(1)\r
+XCEED2: CORE 0, ;REQUEST MORE CORE\r
+ JRST ERRCOR ;ERROR, BOMB OUT\r
+ HRRZ 2,JOBREL ;GET NEW TOP\r
+\r
+XCEED1: MOVE 0,0(1) ;GET ORIGIONAL\r
+ MOVEM 0,0(2) ;STORE IN NEW LOCATION\r
+ SUBI 2,1 ;DECREMENT UPPER\r
+ CAMLE 1,SYMBOL ;HAVE WE ARRIVED?\r
+ SOJA 1,XCEED1 ;NO, GET ANOTHER\r
+ MOVEI 1,2000\r
+ ADDM 1,SYMBOL\r
+ ADDM 1,JOBSYM\r
+ ADDM 1,TOP\r
+ POP PP,2\r
+ POP PP,1\r
+ POP PP,0\r
+\r
+;FIND LEFT MOST BIT OF NUMBER OF ENTRIES IN SYMBOL TABLE AND\r
+;STORE IT IN SRCMSB. FIND MIDDLE ADR OF SYMBOL TABLE AND STORE\r
+;THE ADR IN SRCMID\r
+\r
+SRCHI: PUSH PP,0\r
+ PUSH PP,1\r
+ MOVEI 1,0\r
+ FAD 1,0(SYMBOL)\r
+ LSH 1,-^D27\r
+ MOVEI 0,1000\r
+ LSH 0,-357(1)\r
+ HRRZM 0,SRCMSB\r
+ LSH 0,1\r
+ ADD 0,SYMBOL\r
+ HRRZM 0,SRCMID\r
+ POP PP,1\r
+ POP PP,0\r
+ POPJ PP,\r
+\fFINIS: POP PP,SYMBOL\r
+FINIS3: TLZN IO,IOEOF ;END OF FILE SEEN?\r
+ JRST RECYCL ;NO, RECYCLE\r
+ TLNE IO,IORPG ;SEEN AN END-OF-FILE\r
+ JRST RPGFN ;NO.\r
+ PUSHJ PP,CRLF\r
+ PUSHJ PP,CRLF\r
+ MOVE C,JOBREL\r
+ ADD C,FREE\r
+ SUB C,SYMBOL\r
+ LSH C,-^D10\r
+ ADDI C,1\r
+ IDIVI C,^D10\r
+ JUMPE C,FINIS1\r
+ ADDI C,"0"\r
+ PUSHJ PP,TYO\r
+FINIS1: MOVEI C,"0"(CS)\r
+ PUSHJ PP,TYO\r
+ MOVE RC,[POINT 6,[SIXBIT /K CORE@/]]\r
+ PUSHJ PP,PNTM1 ;PRINT MESSAGE\r
+\fRPGFN: CLOSE LST,\r
+ PUSHJ PP,TSTLST ;YES, TEST FOR ERRORS\r
+ RELEAS LST,\r
+ CLOSE CHAR,\r
+RPGFN1: RELEAS CHAR,\r
+ TLNN IO,IORPG\r
+ JRST CREF ;RETURN FOR NEXT ASSEMBLY\r
+ MOVSI IO,IORPG\r
+RPGFN2: PUSHJ PP,TTYIN\r
+ CAIG C,15\r
+ CAIGE C,12\r
+ SKIPA\r
+ JRST RPGFN2\r
+ MOVSI C,70000\r
+ ADDM C,CTIBUF+1\r
+ AOS CTIBUF+2\r
+ JRST RETRPG\r
+\fNAME1: SETZB ACDEV,ACFILE\r
+ SETZB ACEXT,ACDEL\r
+ SETZB TIO,CS\r
+\r
+NAME3: MOVSI ACPNTR,(POINT 6,AC0) ;SET POINTER\r
+ TDZA AC0,AC0 ;CLEAR SYMBOL\r
+\r
+SLASH: PUSHJ PP,SW0\r
+GETIOC: PUSHJ PP,TTYIN ;GET INPUT CHARACTER\r
+ CAIN C,"/"\r
+ JRST SLASH\r
+ CAIN C,"("\r
+ JRST SWITCH\r
+ CAIN C,":"\r
+ JRST DEVICE\r
+ CAIN C,"."\r
+ JRST NAME\r
+ CAIE C,"_"\r
+ CAIG C,15\r
+ JRST TERM\r
+ CAIN C,33 ;NEW ALT MODE?\r
+ JRST TERM ;YES\r
+ CAIN C,"["\r
+ JRST PROGNP ;GET PROGRAMER NUMBER PAIR\r
+ SUBI C,40 ;CONVERT TO 6-BIT\r
+ TLNE ACPNTR,770000 ;HAVE WE STORED SIX BYTES?\r
+ IDPB C,ACPNTR ;NO, STORE IT\r
+ JRST GETIOC ;GET NEXT CHARACTER\r
+\r
+DEVICE: SKIPA ACDEV,AC0 ;DEVICE NAME\r
+NAME: MOVE ACFILE,AC0 ;FILE NAME\r
+ MOVE ACDEL,C ;SET DELIMITER\r
+ JRST NAME3 ;GET NEXT SYMBOL\r
+\r
+TERM: CAIE ACDEL,":" ;IF PREVIOUS DELIMITER\r
+ CAIN ACDEL,0 ;ASSUME FILE NAME IF NOTHING ELSE\r
+ MOVE ACFILE,AC0 ;SET FILE\r
+ CAIN ACDEL,"." ;IF PERIOD,\r
+ HLLZ ACEXT,AC0 ;SET EXTENSION\r
+ POPJ PP, ;EXIT\r
+\fPROGNP: JUMPL PP,PROGN2 ;ERROR IF OUTPUT\r
+ERRCM: JSP RC,ERRMSG\r
+ SIXBIT /?COMMAND ERROR@/\r
+\r
+PROGN1: HRLZM RC,INDIR+3 ;COMMA, STORE LEFT HALF\r
+PROGN2: MOVEI RC,0 ;CLEAR AC\r
+PROGN3: PUSHJ PP,TTYIN\r
+ CAIN C,","\r
+ JRST PROGN1 ;STORE LEFT HALF\r
+ HRRM RC,INDIR+3 ;ASSUME TERMINAL\r
+ CAIN C,"]"\r
+ JRST GETIOC ;YES, RETURN TO MAIN SCAN\r
+ LSH RC,3 ;SHIFT PREVIOUS RESULT\r
+ ADDI RC,-"0"(C) ;ADD IN NEW NUMBER\r
+ JRST PROGN3 ;GET NEXT CHARACTER\r
+\fSWITCH: PUSHJ PP,TTYIN\r
+ CAIL C,"0"\r
+ CAILE C,"9"\r
+ JRST SWIT1\r
+ PUSHJ PP,GETLIM\r
+ CAIE C,","\r
+ JRST ERRCM\r
+ MOVEM RC,LOWLIM\r
+ PUSHJ PP,TTYIN\r
+ PUSHJ PP,GETLIM\r
+ CAIE C,")"\r
+ JRST ERRCM\r
+ MOVEM RC,UPPLIM\r
+ CAMGE RC,LOWLIM\r
+ TLO IO,IONCRF\r
+ JRST GETIOC\r
+\r
+SWIT1: CAIN C,")"\r
+ JRST GETIOC\r
+ PUSHJ PP,SW1\r
+ PUSHJ PP,TTYIN\r
+ JRST SWIT1\r
+\r
+GETLIM: TDZA RC,RC\r
+GETLI1: PUSHJ PP,TTYIN\r
+ CAIL C,"0"\r
+ CAILE C,"9"\r
+ POPJ PP,\r
+ IMULI RC,^D10\r
+ ADDI RC,-"0"(C)\r
+ JRST GETLI1\r
+\r
+SW0: PUSHJ PP,TTYIN\r
+SW1: MOVEI C,-"A"(C) ;CONVERT FROM ASCII TO NUMERIC\r
+ CAILE C,"Z"-"A" ;WITHIN BOUNDS?\r
+ JRST ERRCM ;NO, ERROR\r
+ MOVE RC,[POINT 4,BYTAB]\r
+ IBP RC\r
+ SOJGE C,.-1 ;MOVE TO PROPER BYTE\r
+ LDB C,RC ;PICK UP BYTE\r
+ JUMPE C,ERRCM ;TEST FOR VALID SWITCH\r
+ CAIG C,TEMP\r
+ JUMPL PP,ERRCM\r
+ XCT SWTAB-1(C) ;EXECUTE INSTRUCTION\r
+ POPJ PP, ;EXIT\r
+\f DEFINE SETSW (LETTER,INSTRUCTION) <\r
+ INSTRUCTION\r
+J= <"LETTER"-"A">-^D9*<I=<"LETTER"-"A">/^D9>\r
+ SETCOD \I,J>\r
+\r
+ DEFINE SETCOD (I,J)\r
+ <BYTAB'I=BYTAB'I!<.-SWTAB>B<4*J+3>>\r
+\r
+BYTAB0= 0 ;INITIALIZE TABLE\r
+BYTAB1= 0\r
+BYTAB2= 0\r
+\r
+SWTAB:\r
+ SETSW Z,<TLO TIO,TIOCLD >\r
+ SETSW A,<ADDI CS,1 >\r
+ SETSW B,<SUBI CS,1 >\r
+ SETSW K,<TLZ IO,IOSYM >\r
+ SETSW M,<TLZ IO,IOMAC >\r
+ SETSW O,<TLO IO,IOOP >\r
+ SETSW S,<TLO IO,IOLST >\r
+ SETSW T,<TLO TIO,TIOLE >\r
+ SETSW W,<TLO TIO,TIORW >\r
+ SETSW R,<SETOM FIRSTL>\r
+\r
+BYTAB:\r
+ +BYTAB0\r
+ +BYTAB1\r
+ +BYTAB2\r
+\f\r
+CRLF: MOVEI C,15 ;OUTPUT CARRIAGE RETURN\r
+ PUSHJ PP,TYO\r
+ MOVEI C,12 ;AND LINE FEED\r
+TYO: LSH C,35\r
+ HRRI C,C\r
+ DDTOUT C, ;TELETYPE CHARACTER OUTPUT\r
+ POPJ PP,\r
+\fTTYIN: ;COMMAND CHARACTER INPUT SUBROUTINE\r
+RPGIN: SOSG CTIBUF+2\r
+ JRST CKRPGI\r
+RPGIN1: IBP CTIBUF+1\r
+ MOVE C,@CTIBUF+1\r
+ TRNN C,1\r
+ JRST RPGIN2\r
+\r
+ AOS CTIBUF+1\r
+ MOVNI C,5\r
+ ADDM C,CTIBUF+2\r
+ JRST RPGIN\r
+RPGIN2: LDB C,CTIBUF+1\r
+ JUMPE C,RPGIN\r
+ CAIE C," " ;SKIP BLANKS\r
+ CAIN C," "\r
+ JRST TTYIN\r
+ CAIE C,175\r
+ CAIN C,176\r
+ MOVEI C,33 ;CHANGE ALL ALT MODES TO 033\r
+ CAIN C,32\r
+ JRST TTYIN ;IGNORE ^Z (EOF)\r
+ CAIL C,140\r
+ TRZ C,40 ;CHANGE LOWER CASE TO UPPER CASE\r
+ POPJ PP, ;NO, EXIT\r
+\fCKRPGI:\r
+IFN TEMPC,< SKIPE TMPFLG ;IS TMPCOR UUO IN ACTION\r
+ JRST TMPDON ;YES, EXIT>\r
+ IN CTLI,0\r
+ JRST RPGIN1\r
+ STATO CTLI,740000\r
+ JRST RPGCK2\r
+ JSP RC,ERRMSG\r
+ SIXBIT /?DATA ERROR READING COMMAND FILE@/\r
+IFN TEMPC,<\r
+TMPDON: MOVE AC0,[XWD 2,TEMP]\r
+ MOVSI TEMP,(SIXBIT /CRE/)\r
+ MOVEI TEMP1,0\r
+ CALLI AC0,TMPCOR ;DELETE TMPCOR FILE "CRE"\r
+ JFCL ;FAILED, SO WHO CARES>\r
+LEAVE: CALLI 1,12 ;EXIT\r
+ JRST CREF\r
+\r
+RPGCK2: TLNN IO,IORPG ;IN CCL MODE?\r
+ JRST CREF ;NO, START OVER\r
+ SETZB TEMP,TEMP+1 ;YES, DELETE COMMAND FILE\r
+ SETZB TEMP+2,TEMP+3\r
+ RENAME CTLI,TEMP\r
+ JFCL\r
+ JRST LEAVE\r
+\fREAD: SOSG INBUF+2 ;BUFFER EMPTY?\r
+ JRST READ3 ;YES\r
+READ1: ILDB C,INBUF+1 ;PLACE CHARACTER IN C\r
+ JUMPE C,READ\r
+ POPJ PP,\r
+\r
+READ3: INPUT CHAR,0 ;GET NEXT BUFFER\r
+ STATO CHAR,762000 ;ERROR?\r
+ JRST READ1 ;NO, GET CHARACTER\r
+ TLO IO,IOEOF ;EOF SEEN. FIRST TIME?\r
+ STATO CHAR,742000\r
+ JRST R0\r
+\r
+ MOVEI CS,INDEV\r
+ JSP RC,DVFNEX\r
+ SIXBIT /?INPUT DATA ERROR, @/\r
+\r
+DMPLST: OUTPUT LST,0 ;OUTPUT BUFFER\r
+TSTLST: STATO LST,740000 ;ANY ERRORS?\r
+ POPJ PP, ;NO, EXIT\r
+\r
+ MOVEI CS,LSTDEV\r
+ JSP RC,DVFNEX\r
+ SIXBIT /?OUTPUT DATA ERROR, @/\r
+\fERRAVI: SKIPA CS,[INDEV] ;INPUT DEVICE INIT FAILURE\r
+ERRAVL: MOVEI CS,LSTDEV ;LISTING DEVICE INIT FAILURE\r
+ JSP RC,DVFNEX\r
+ SIXBIT /?DEVICE NOT AVAILABLE, @/\r
+\r
+\r
+ERRENT: MOVEI CS,LSTDEV\r
+ JSP RC,DVFNEX\r
+ SIXBIT /?CANNOT ENTER FILE @/\r
+\r
+ERRFND: MOVEI CS,INDEV\r
+ JSP RC,DVFNEX\r
+ SIXBIT /?CANNOT FIND FILE @/\r
+\r
+ERRCOR: JSP RC,ERRMSG\r
+ SIXBIT /?INSUFFICIENT MEMORY AVAILABLE@/\r
+\r
+\fERRMSG: PUSHJ PP,PNTMSG ;FOR SIMPLE ERROR MESSAGES\r
+ JRST ERRFIN\r
+\r
+DVFNEX: PUSHJ PP,PNTMSG ;PRINT MESSAGE DEV:FILENAME.EXT\r
+ PUSHJ PP,PNTSIX ;PRINT DEVICE\r
+ MOVEI C,":"\r
+ PUSHJ PP,TYO ;PRINT COLON\r
+ ADDI CS,1 ;ADVANCE POINTER TO FILENAME\r
+ SKIPN (CS) ;IS FILENAME 0?\r
+ JRST ERRFIN ;YES, NO FILENAME\r
+ PUSHJ PP,PNTSIX ;NO, PRINT FILENAME\r
+ ADDI CS,1 ;ADVANCE POINTER TO EXTENSION\r
+ HLLZS C,(CS) ;ZERO OUT OTHER HALF. EXTENSION=0?\r
+ JUMPE C,ERRFIN ;EXTENSION 0?\r
+ MOVEI C,"." ;NO\r
+ PUSHJ PP,TYO ;PRINT DOT\r
+ PUSHJ PP,PNTSIX ;PRINT EXTENSION\r
+\r
+ERRFIN: PUSHJ PP,CRLF\r
+ JRST CREF ;START CREF OVER\r
+\r
+PNTSIX: HRLI CS,(POINT 6,0) ;PRINT 1 WORD OF SIXBIT\r
+PNTSX1: TLNN CS,770000 ;NEXT ILDB GO OVER WORD BOUNDARY?\r
+ POPJ PP, ;YES, FINISHED\r
+ ILDB C,CS\r
+ JUMPE C,.-2 ;STOP AT A 0\r
+ ADDI C,40 ;CONVERT TO ASCII\r
+ PUSHJ PP,TYO\r
+ JRST PNTSX1\r
+\r
+PNTMSG: PUSHJ PP,CRLF ;PRINT SIXBIT MESSAGE\r
+ HRLI RC,(POINT 6,0)\r
+PNTM1: ILDB C,RC\r
+ CAIN C,40 ;STOP AT @\r
+ POPJ PP,\r
+ ADDI C,40 ;CONVERT TO ASCII\r
+ PUSHJ PP,TYO\r
+ JRST PNTM1\r
+\fLIT\r
+\f\r
+ IFN PURE, <LOC 140>\r
+\r
+SVJFF: BLOCK 1\r
+\r
+CTIBUF: BLOCK 3 ;COMMAND FILE INPUT BUFFER HEADER\r
+CTIDEV: BLOCK 1 ;INPUT COMMAND DEVICE\r
+CTIDIR: BLOCK 4\r
+TMPFIL: BLOCK 2 ;SIXBIT /CRE/\r
+ ;XWD -200,C(JOBFF)\r
+ ;FOR TMPCOR UUO\r
+TMPFLG: BLOCK 1 ;FLAG FOR TMPCOR UUO IN PROGRESS\r
+\r
+\r
+STCLR: ;START BLT CLEAR HERE\r
+\r
+INBUF: BLOCK 3\r
+INDEV: BLOCK 1 ;INPUT DEVICE (FOR ERR MESSAGES ONLY)\r
+INDIR: BLOCK 4\r
+\r
+LSTBUF: BLOCK 3\r
+LSTDEV: BLOCK 1 ;LIST DEVICE (FOR ERR MESSAGES ONLY)\r
+LSTDIR: BLOCK 4\r
+\r
+PPSET: BLOCK PDL\r
+LPP: BLOCK 1\r
+\r
+PPTEMP: BLOCK 1\r
+FIRSTL: BLOCK 1 ;LINE # AFTER WHICH TO PRINT LISTING\r
+\r
+SRCMSB: BLOCK 1 ;MOST SIGNIFICANT BIT (USED BY SRCH)\r
+SRCMID: BLOCK 1 ;ADR IN MIDDLE OF SYM TABLE (USED BY SRCH)\r
+\r
+LOWLIM: BLOCK 1\r
+UPPLIM: BLOCK 1\r
+LEVEL: BLOCK 1\r
+SVLAB: BLOCK 1\r
+IFN FAILC,<\r
+BLKST: BLOCK 1\r
+BLKND: BLOCK 1\r
+>\r
+\r
+ENDCLR: END CREF\r
+\f\r
git://git.sky-visions.com / retro-software/dec/tops10/v4.5.git / commitdiff