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