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+1 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