File TECO.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

	/PS/8 TECO

IN=	6200		/INPUT BUFFER AT 06200
OUT=	6600		/OUTPUT BUFFER AT 06600
ZMAX=	7640		/ABOUT 4000 [10] CHARACTERS IN TEXT BUFFER
APMAX=	ZMAX-310	/=ZMAX-200[10]
QMAX=	3720		/ABOUT 2000[10]CHARACTERS IN Q-REGS
DMAX=	0600		/NUMBER OF CHARACTERS IN I/O BUFFERS

INHNDL=	7200		/ADDRESS OF INPUT HANDLER
OUHNDL=	7400		/OUTPUT HANDLER LOAD POINT


	/TECO USES LOCS 12-17

	*20		/TECO PSEUDO-OPERATIONS:
PUSH=	JMS I .;	PUSHXX
POP=	JMS I .;	POPXX
PUSHJ=	JMS I .;	PUSHJY
POPJ=	JMP I .;	POPJXX
PUSHL=	JMS I .;	PUSHLX
POPL=	JMS I .;	POPLX
ERR=	JMS I .;	ERRXX
SORT=	JMS I .;	SORTB
RESORT=	JMP I .;	SORTA2
SCAN=	JMS I .;	SGET
RESCAN=	JMS I .;	SREGET
LISTEN=	JMS I .;	TYI
TYPE=	JMS I .;	TYO
CTLTYP=	JMS I .;	TYPCTL
CTVTYP=	JMS I .;	TYPCTV
CRLF=	JMS I .;	TYCRLF
QGET=	JMS I .;	GETX
QPUT=	JMS I .;	PUTX
SKPSET=	JMS I .;	SETSKP
NCHK=	JMS I .;	CHKNF
CCHK=	JMS I .;	CHKCF
BZCHK=	JMS I .;	CHKBZ
QCHK=	JMS I .;	CHKQF
QSKP=	JMS I .;	QOVER
CLNCHK=	JMP I .;	CHKCLN
QREF=	JMS I .;	QREFER
QSUM=	JMS I .;	QSUMR
QSTUFF=	JMS I .;	QPUTS


SFAIL,	0	/SEARCH FAIL FLAG
CFLG,	0	/COMMA FLAG
CLNF,	0	/COLON FLAG
NFLG,	0	/NUMBER FLAG
OFLG,	0	/OPERATOR FLAG
QFLG,	0	/QUOTED STRING FLAG
M,	0	/NUMBER ARGS
N,	0
CHAR,	0	/CHARACTER BUFFER
CSAVE,	0	/FOR PACKING ROUTINES
ITRST,	0	/ITERATION FLAG
TFLG,	0	/TRACE MODE
MPDL,	0	/MACRO FLAG
SCHAR,	0	/LAST CHAR SORTED
	INPUT=	JMS I .
INR,	ERRXX	/INPUT ROUTINE
ICHAR,	0	/INPUT ROUTINE TEMPORARY
REND,	0	/INPUT END-OF-FILE FLAG
	OUTPUT=	JMS I .
OUTR,	ERRXX	/OUTPUT ROUTINE
OCHAR,	0	/OUTPUT ROUTINE TEMPORARY
WEND,	0	/OUTPUT END-OF-FILE FLAG
SCANP,	0	/COMMAND LINE EXECUTION POINTER
PDLP,	0	/PUSH-DOWN-LIST POINTER
QNMBR,	0	/LAST Q-REG REFERENCED
QCMND,	0	/COMM LINE OR MACRO POINTER
P,	0	/CURRENT PNTR TO TEXT BUFFER
ZZ,	0	/END OF TEXT BUFFER POINTER
Q,	0	/EXTRA BUFFER POINTERS
R,	0
APPLST=	.
CASP,	40	/SPACE
	14	/FORM FEED
	12	/LINE FEED
CTLZ,	32	/^Z
YFLG,	7777	/IN MODE SW: BRIEF
	MASK=.	/ASCII CHARACTER MASK
CARO,	177	/RUBOUT
XFLG,	7777	/OUT MODE SW: EXPANDED
QP,	0	/Q REGISTER POINTER
QR,	0	/EXTRA Q-REG POINTER
QZ,	0	/END OF Q-REG POINTER
KFLG,	7777	/ECHO MODE SWITCH: ON
QREGS,	QPNTR	/Q-REG POINTER ARRAY
SERR,	ERR	/ILLEGAL COMMAND ENCOUNTERED
OUTLST,	14	/FF: END OF PAGE
CALF,	12	/LF
CACR,	15	/CR
CAHT,	11	/HT
CAAM,	33	/ALT MODE
APM12,	-12	/END OF LIST
MQLMUY=	JMS I .;MUYMQL
CLAMQA=	JMS I .;MQACLA
MQLDVI=	JMS I .;DVIMQL
NAME,	ZBLOCK 4	/NAME BUILD BUFFER
ODEV,	0	/OUTPUT DEVICE NUMBER
OMAXLN,	0	/SIZE OF HOLE
OUTHND,	0
INHND,	0
EBFLG,	0	/EDIT BACKUP FLAG
USR,	7700	/MONITOR CALL LOCATION
	PAGE

TECO, JMS IOSTRT /INITIALIZE I/O DCA P /RESET POINTERS DCA ZZ DCA TCASE /SET TO UPPER CASE T1, TAD (PDLBEG /RESET THE PUSHDOWN LIST DCA PDLP DCA QCMND /POINT TO COMMAND LINE DCA QNMBR /ANOTHER Q-REG POINTER TAD I QREGS /# OF CHARS IN PREV COMM LINE CIA /SUBTRACT FROM TAD QZ /Q-REG CONTENTS DCA QZ /NEW MAXIMUM DCA I QREGS /ZERO CHARS IN COMM LINE TAD (SFAIL-INR /CLEAR SEVERAL PAGE 0 DCA TSIG /REGISTERS TAD (SFAIL-1 DCA 10 /USING AUTO-INDEX DCA I 10 /OF COURSE ISZ TSIG JMP .-2 PUSHJ /RESTORE ALTM & $ AS IREST /STRING TERMINATORS PUSHJ /UNDO A FIX CNDO+2 JMS TSIG T2, LISTEN /BUILD COMMAND LINE SORT COMLST COMTAB-COMLST TAD (-100 /TEST FOR LETTERS SMA TAD TCASE /ADD CASE BIT TAD (100 /RESTORE DCA CHAR CTLTYP /ECHO COMMAND CHARACTER JMS SPUT /PUT INTO C.L. BUFFER JMP T2 /GO GET ANOTHER TALTM, TAD CAAM /ALTM IN COMM LINE DCA SCHAR /MAKE EVERY ALTM INTO 33 JMS COMPAR /2ND ALTM STARTS EXECUTION JMS SPUT /PUT IN EXTRA ALTM AT END CRLF /START COMM EXECUTION DCA SCANP /RESET TO BEGINNING T6, SCAN DCA CHAR /SAVE COMMAND CHAR TAD TFLG /SEE IF TRACE ON M140, SZA CLA /-140, LOC USED AS CONSTANT CTLTYP /YES, TYPE OUT COMM CHAR TAD CHAR T6A, TAD M140 /SEE IF LOWER CASE SMA TAD (-40 /MAKE LC INTO UPPER CASE TAD (140+CDSP /ADD BASE OF DISPATCH TABLE DCA T7 /LOK UP ENTRY IN TAD I T7 /COMMAND DISPATCH TABLE DCA T7 /CALL RECURSIVELY PUSHJ T7, 0 /CALL TO ROUTINE CLA /FINALLY FINISHED THAT ONE JMS BRKCHK /BREAK? TAD ITRST /INSIDE ITERATION? SZA CLA /LEGAL FOR SEARCHES TO FAIL? JMP T6 /YES, CONTINUE TAD SFAIL /NO, SEE IF IT DID SNA CLA JMP T6 /NO, CONTINUE JMP RECOUP /YES, STOP EXECUTION TQMK, JMS COMPAR /? IN COMM LINE JMS CLDO /2ND ? ERASES 1ST ? PUSHJ /AND RETYPES TQMF /COMMAND LINE SO FAR JMP T2 /TAKE IN MORE COMMANDS TSIG, 0 /RESET SCAN POINTER AND SIGNAL DCA SCANP /BEGINNING OF COMM LINE CRLF TAD (52 /* TYPE JMP I TSIG /RETURN ROCMND, TAD SCANP /SEE IF ANYTHING TO ERASE SNA CLA JMP T1 /NO, START ALL OVER RESCAN /YES CTVTYP /ECHO SCRUBBED CHAR JMS CLDO /REMOVE IT RESCAN /GET CHAR BEFORE DCA CHAR /MAKE IT PREV CHAR JMP T2 /PROCEED CLDO, 0 /COMM LINE DOWN ONE CHAR TAD SCANP /IF THERE ARE ANY CHARS SNA CLA JMP I CLDO /THERE WEREN'T, SO GO BACK STA TAD QZ /FIRST BACK UP THE DCA QZ /Q-REGISTER COUNT STA TAD SCANP /NOW BACK UP SCAN POINTER DCA SCANP STA TAD I QREGS /AND CHARACTER COUNT DCA I QREGS JMP I CLDO TQMF, TAD SCANP /TYPE COMM LINE UP TO SCANP CMA /SAVE FOR COUNTING DCA CLDO /MORE TIGHT CODING JMS TSIG /FLAG BEGINNING OF COMM LINE TBA1, ISZ CLDO /DONE? SKP /NO POPJ /YES, RETURN SCAN /GET A CHAR DCA CHAR CTLTYP /CTRL CHARS GET ^ JMP TBA1 /TYPE ANOTHER TCASE, 0 /LOWER CASE BIT: 0 OR 40 PAGE
/Q-REGISTER OPERATORS GETX, 0 /GET A Q-CHARACTER TAD I GETX /POINTER TO POINTER FOLLOWS DCA PUTX /WHY NOT? TAD I PUTX /INDIRECT INDIRECT CLL RAL /CHARACTERS PACKED 1/2 PER WORD DCA PUTX CDF 10 /PACKED IN FIELD ONE TAD I PUTX /GET FIRST HALF AND [7400 /MASK OFF TEXT BUFFER CLL RTL RTL DCA CSAVE /TEMP CHARACTER SAVE ISZ PUTX /GET SECOND HALF TAD I PUTX CDF AND [7400 TAD CSAVE /GET FIRST HALF RTL RTL RAL ISZ GETX /SKIP OVER POINTER JMP I GETX PUTX, 0 /FILL A Q-REGISTER AND MASK /JUST TO BE SURE CLL RTL /SHIFT LEFT RTL DCA CSAVE TAD I PUTX /GET POINTER ISZ PUTX DCA GETX TAD I GETX CLL RAL DCA GETX CDF 10 TAD I GETX AND MASK DCA PTEMP TAD CSAVE AND [7400 TAD PTEMP DCA I GETX ISZ GETX TAD I GETX AND MASK DCA PTEMP TAD CSAVE CLL RTL RTL AND [7400 TAD PTEMP DCA I GETX CDF JMP I PUTX PTEMP, 0 /"EX" AND "EC" COMMANDS EXITC, CMA /'EC' COMMAND EXIT, DCA EXITFG /'EX' COMMAND TAD WEND /CHECK FOR OPEN OUTPUT FILE SNA CLA JMP EXITG /NOPE, EXIT ALREADY EXLOOP, TAD REND /EOF? SNA CLA JMP EXOUT /YES, WRITE OUT LAST PAGE CMA /NO, DO A 'P' COMMAND DCA NLINES PUSHJ CPOA JMP EXLOOP EXOUT, PUSHJ /WRITE OUT LAST BUFFER CHRW PUSHJ /AND CLOSE FILE ENDFIL EXITG, ISZ EXITFG /EC OR EX? JMP CTLC /EXIT RETURNS TO MONITOR JMP CKALL /EC STAYS IN TECO! EXITFG, 0 IOSTRT, 0 /INITIAL I/O SELECTION TAD ERR-4400 /MUST SET UP I/O DCA OUTR /WITHIN PROGRAM TAD ERR-4400 DCA INR TAD (TPUT+6&177+5200 /JMP TPUT+6 DCA TPUT+1 JMP I IOSTRT BRKCHK, 0 KSF JMP I BRKCHK KRS AND MASK SZA CLA JMP I BRKCHK KCC ERR /STEAL CONTROL POPXX, 0 /POP ROUTINE CLA TAD PDLP TAD (-PDLBEG /CHECK FOR UNDERFILL SPA SNA CLA ERR /SPRUNG OUT THE TOP CLA CMA /LET POINTER TAD PDLP /BACK OUT OF DCA PDLP /THE BOX TAD I PDLP JMP I POPXX PAGE
/PUSH DOWN AND CHARACTER MOVE ROUTINES PUSHXX, 0 /PUSH ROUTINE DCA ACXX TAD PDLP TAD [-PDLEND-1 /CHECK FOR OVERFILL SMA CLA ERR /POKED OUT THE BOTTOM TAD ACXX DCA I PDLP ISZ PDLP /SQUISH POINTER JMP I PUSHXX POPJXX, DCA ACXY /POPJ ROUTINE POP DCA PUSHXX POPJXY, TAD ACXY JMP I PUSHXX PUSHJY, 0 /PUSHJ ROUTINE DCA ACXY IAC TAD PUSHJY PUSH TAD I PUSHJY DCA PUSHXX KSF /CHECK FOR BREAK JMP POPJXY JMS BRKCHK /BREAK? JMP POPJXY /CONTINUE POPJ ACXX, 0 /STORAGE FOR ACXY, 0 /PUSH-DOWN ACXZ, 0 /ROUTINES PUSHLX, 0 /PUSH AND CLEAR A LIST DCA POPLX /SET COUNTER POP /SAVE RETURN POINTER DCA ACXZ TAD I PUSHLX DCA ACXY TAD I ACXY PUSH DCA I ACXY ISZ PUSHLX ISZ POPLX JMP PUSHLX+4 TAD ACXZ /RESTORE RETURN POINTER PUSH JMP I PUSHLX POPLX, 0 /POP A LIST DCA PUSHLX /SET COUNTER POP /SAVE RETURN POINTER DCA ACXZ TAD I POPLX DCA ACXY POP DCA I ACXY ISZ POPLX ISZ PUSHLX JMP POPLX+4 TAD ACXZ /RESTORE RETURN POINTER PUSH JMP I POPLX ADJ, SPA /ADJUST BUFFER + OR - N CHARS JMP DNNC-1 /-N CHARACTERS UPPN, SNA /TEST FOR NOTHING POPJ /GO AWAY CLL /MOVE UP N CHARACTERS TAD ZZ /ADD TO MAX CHARACTER DCA R /NEW HIGHEST TAD R /SEE IF TOO HIGH TAD [-ZMAX SZL CLA /TWO PLACES FOR OVERFLOW THERE ERR TAD ZZ DCA Q TAD R DCA ZZ UPNL, TAD R CIA TAD P SNA CLA /FINISHED? POPJ /YES CMA TAD Q DCA Q CMA TAD R DCA R CDF 10 TAD I Q AND MASK DCA CSAVE TAD I R AND [7400 TAD CSAVE DCA I R CDF JMP UPNL CIA /REACHED FROM ADJ DNNC, TAD P /MOVE DOWN N CHARACTERS BZCHK /CHECK FOR OVERFLOW DCA Q /N IN AC TAD P DCA R CDF 10 DNN1, TAD ZZ CIA TAD Q SNA CLA /FINISHED? JMP UPNEND /YES TAD I Q AND MASK DCA CSAVE TAD I R AND [7400 TAD CSAVE DCA I R ISZ Q ISZ R JMP DNN1 UPNEND, CDF TAD R DCA ZZ POPJ PAGE
/COMMANDS C,D,J,K,L CHRJ, TAD N /COMMAND J NCHK CLA /ASSUME BJ JMP CLOQ CHRC, TAD N /COMMAND C NCHK STA /ASSUME -1C TAD P /OFFSET RELATIVE TO . CLOQ, BZCHK /SEE IF IN RANGE B,Z DCA P /IN RANGE POPJ CHRD, CCHK /COMMAND D JMP CDN /ONE ARG DCA NFLG /CLEAR NUMBER FLAG PUSHJ MFROMN /COMPUTE N-M SNA /ANYTHING TO DELETE? POPJ /NO CIA DCA CDT TAD M /SET POINTER DCA P /LOWER ARG JMP CDMN CDN, TAD N NCHK /SEE IF NUMBER FLAG UP STA /SET TO -1D IF NOT SNA /CHECK FOR 0D POPJ /0D IS IGNORED SMA JMP DNNC /+ND DCA CDT /-ND TAD CDT PUSHJ /DO (-)NC(+)ND CHRC+3 CDMN, TAD CDT JMP DNNC-1 CKALL, DCA ZZ /KILL WHOLE BUFFER JMP CLOQ+1 /RESET POINTER CHRL, TAD N /COMMAND L NCHK CLA /L MEANS 0L CIA CLL /MAKE NEGATIVE SMA /DID IT? CLCMA, CMA STL /NO, MAKE MORE NEGATIVE DCA SREGET /SAVE IN SUBR ENTRY TAD CLCMA /COMPUTE SWITCH SNL /WHICH DIRECTION? TAD (IAC-CMA /FORWARD DCA CLCH /CMA FOR -NL CLCH, JMP . /OR IAC FOR +NL TAD P /GET . DCA P /NEW . = OLD + OR - 1 CLA STL IAC /LOOK OUT FOR .=-1 TAD P /CLAMP AT ENDS OF BUFFER CIA CML /SEE IF AT HEAD SNA SZL CLA JMP CHRJ+2 /YES, EXIT TAD ZZ CIA CLL TAD P /SEE IF AT END SNA SZL CLA JMP CHRC+3 /YES, EXIT CLP, CDF 10 TAD I P CDF AND MASK TAD APM12 /CHECK FOR LINE FEED SNA CLA ISZ SREGET /FOUND ONE. ENOUGH? JMP CLCH /NO ISZ P /MOVE PAST LF POPJ CKT, 0 /TEMPORARY CDT, 0 /TEMPORARY SREGET, 0 /RESCAN LAST CHAR STA TAD SCANP SPA /ZEROTH CHARACTER? JMP I SREGET /YES, CALL IT NULL DCA SCANP SCAN JMP I SREGET /RETURN CHRK, CCHK /K COMMAND JMP CKN /1 ARG PUSHJ /CONVERT LNE LINES /#'S TO CHARS JMP CHRD+2 /DO M,ND CKN, NCHK /WHAT ARGS? JMP CKALL /K MEANS EVERYTHING JMS NLINES /CONVERT N LINES TO M,N JMP CHRD+2 /DO .,(NL).D LINES, TAD P /SAVE . PUSH PUSHJ /COMPUTE MFROMN /N-M PUSH /SAVE IT TAD M PUSH /SAVE IT PUSHJ CHRB PUSHJ /DOING BJML CHRJ POP /RETRIEVE M PUSHJ CHRL+3 /FIND LINE M TAD P DCA M POP /RETRIEVE N-M PUSHJ CHRL+3 TAD P DCA N POP /RETRIEVE ORIGINAL . DCA P POPJ TYCRLF, 0 /TYPE A CR AND LF TAD CACR /CR TYPE TAD CALF /LF TYPE JMP I TYCRLF /RETURN PAGE
/COMMANDS ^D,^K,,,N,R,S, AND _ CSCH, QCHK /SEARCH ROUTINE TAD SCANP DCA CST TAD P DCA CSP JMP CSG CSL, SCAN SORT SCHLST SCHTAB-SCHLST CSQ, CIA DCA CSNB CDF 10 TAD I P CDF AND MASK TAD CSNB CSWT, SZA CLA JMP CSF /FAIL TO MATCH ON THIS CHARACTER ISZ P CSG, TAD CSZCL DCA CSWT /RESTORE SEARCH TEST TAD ZZ CMA TAD P CSZCL, SZA CLA /CHECK FOR END OF BUFFER JMP CSL /NO QSKP /SKIP OVER SEARCH STRING DCA P CMA /SET SEARCH FAIL FLAG CSZ, DCA SFAIL POPJ CSK, ISZ CSN /GET NTH OCCURRENCE JMP CSF /MORE TO GO JMP CSZ /GOT IT CSF, TAD CST /RESET SCANP DCA SCANP ISZ CSP /INDEX P TAD CSP DCA P JMP CSG CHRS, JMS CSNB /COMMAND S PUSHJ CSCH CLNCHK /ASSIGN VALUE, IF ANY CHBA, TAD CHIRPY /COMMAND _ CHRN, TAD CHIRP /COMMAND N DCA CNXT JMS CSNB QCHK /SNAG QUOTING CHAR CNJ, TAD SCANP DCA RADIX /SAVE SCAN POINTER PUSHJ CSCH+1 /DO A SEARCH TAD SFAIL SMA CLA /SUCCESS? CLNCHK /YES, ASSIGN VALUE TAD REND /SEE IF FILE END SNA CLA CLNCHK /FAILED, ASSIGN VALUE TAD RADIX /OTHERWISE RESET SCANP DCA SCANP PUSHJ CNXT, 0 /CHRP OR CHRY JMP CNJ CSNB, 0 /SET # OF TIMES TO FINE TAD N NCHK IAC /ASSUME 1 CIA DCA CSN JMP I CSNB CSN, 0 /COUNTER CST, 0 /TEMP SCANP CSP, 0 /TEMP P CHIRPY, CHRY-CHRP /POINTER TO Y COMMAND CHIRP, CHRP /POINTER TO P COMMAND CHRR, JMS CSNB /COMMAND R PUSHJ CSCH /DO SEARCH PART TAD SCANP /SAVE SCAN POINTER DCA CSNB QSKP /COUNT UP STRING 2 TAD SFAIL SPA CLA CLNCHK /FAILED, SET VALUE & EXIT TAD CSNB /GET START OF STRING 2 TAD P /AND END OF STRING 1 CMA TAD SCANP /FROM END OF STRING 2 TAD CSP /AND START OF STRING 1 DCA CSN /NET CHANGE IN BUFFER SIZE TAD CSP /RESET DCA P /TEXT POINTER TAD CSNB /AND DCA SCANP /COMMAND POINTER TAD CSN PUSHJ ADJ /ADJUST BUFFER SIZE PUSHJ /INSERT CIL2 /STRING 2 CLNCHK /SET VALUE AND EXIT CTLK, TAD (ORAD-DRAD /COMMAND ^K CTLD, TAD (DRAD /COMMAND ^D DCA RADIX TAD I RADIX /FETCH 1000 OR 1750 DCA PRAD /TO "=" COMMAND ISZ RADIX TAD I RADIX /FETCH 10 OR 12 DCA PRAD+1 /TO "=" COMMAND TAD I RADIX /FETCH 10 OR 12 DCA NMRBAS /TO NUMBER PROCESSOR POPJ RADIX, 0 /SHARED WITH SEARCH ROUTINES CCMA, NCHK /COMMAND , ERR /NUMBER FLAG NOT SET TAD N /MOVE N TO M DCA M DCA N /AND CLEAR N STA DCA CFLG /SET COMMA FLAG POPJ PAGE
/NUMBER PROCESSORS: /COMMANDS B,F,H,Z,+,-,.,#,&,*,/,(, AND ) NMBR, TAD CHAR /NUMBER FOUND IN COMMAND STRING TAD (-60 DCA NMT NCHK /CHECK NUMBER FLAG JMP NNEW /NOT UP, NEW OPERAND TAD NP /MULTIPLY PREV DIGITS BY 10 MQLMUY NMRBAS, 12 /CHANGE TO 10 FOR OCTAL RADIX CLAMQA NMR, TAD NMT DCA NP /CURRENT NUMBER TAD NP NOPR, SKP /DISPATCH JUMP FOR OPERATOR CIA TAD NACC /CURRENT EXPRESSION VALUE NRET, DCA N CLA CMA /SET NUMBER FLAG DCA NFLG DCA OFLG /CLEAR OPERATOR FLAG POPJ CHRH, PUSHJ /COMMAND H CHRB PUSHJ CCMA /DO B AND , THEN Z CHRZ, TAD ZZ /COMMAND Z CHRB, /COMMAND B NCOM, DCA NMT /COMMON TO ALL NUMBER ROUTINES NNEW, TAD OFLG /CHECK OPERATOR FLAG SZA CLA /MIDDLE OF EXPRESSION? JMP NMR /YES DCA NACC /NO, CLEAR ACCUMULATOR TAD NSKP /ASSUME + DCA NOPR JMP NMR NMT, 0 /TEMP NP, 0 /VALUE OF CURRENT NUMBER NACC, 0 /VALUE OF EXPRESSION WITHOUT NP CDOT, TAD P /COMMAND . JMP NCOM CPLS, NCHK /COMMAND + DCA N TAD NSKP CMIP, DCA NOPR /COMMON TO ALL NUMERIC OPERATORS TAD N DCA NACC DCA NP STA /SET OPERATOR FLAG DCA OFLG DCA NFLG /CLEAR NUMBER FLAG POPJ CMIN, NCHK /COMMAND - DCA N /UNARY MINUS TAD (NOP JMP CMIP CAST, NCHK /COMMAND * JMP CLINE /WANTS CURRENT LINE NUMBER TAD [-2 /MAKE MQLMUY JMP .+3 CVIR, NCHK /COMMAND / JMP LLINE /WANTS LAST LINE NUMBER TAD (MQLDVI DCA NMC TAD (JMP NMLDV JMP CMIP CAMP, TAD [-2 /COMMAND & CNBS, TAD (JMP NIOR /COMMAND # JMP CMIP NAND, AND NACC /BITWISE .AND. OF BINARY NUMBERS JMP NRET /KEEP THESE TWO OPNS TOGETHER NIOR, CMA /BITWISE .IOR. OF BINARY VALUES AND NACC /USE VENN DIAGRAM TO PROVE IT TAD NP JMP NRET NMLDV, DCA NMC+1 /MUL & DIV OPNS TAD NACC /DIVIDE IS ONLY 12-BIT UNSIGNED NMC, MQLMUY /OR MQLDVI 0 /MULTIPLIER OR DIVISOR CLAMQA /TRUNCATE JMP NRET CHRF, PUSHJ /COMMAND F NCOM /MAKE A 0 PUSHJ CCMA /DO 0 AND , THEN / LLINE, TAD ZZ /FIND LAST LINE # NSKP, SKP CLINE, TAD P /FIND CURRENT LINE # CLL CMA DCA NP DCA NMT DCA R /USE AUX BUFFER POINTERS JMP LINA2 LINA1, CDF 10 TAD I R CDF AND MASK TAD APM12 /-LF SNA CLA /END OF LINE? ISZ NMT /YES, COUNT IT ISZ R LINA2, ISZ NP /FINISHED? JMP LINA1 /NO JMP NNEW /MAKE A NUMBER COPR, TAD OFLG /COMMAND ( SZA CLA /SEE IF OPENING OF EXPRESSION JMP .+3 /NO PUSHJ /YES, SO CLEAN UP FIRST NCOM /RECURSION IS NICE! TAD [-3 /PUSH 3 QUANTITIES PUSHL N NOPR NMC DCA NMT JMP CMIP-1 /CLEAN OUT INSIDE PARENS CCPR, TAD N /COMMAND ) DCA NMT TAD [-3 /POP 3 QUANTITIES FROM BEFORE POPL NMC NOPR NACC /OLD N JMP NMR /TREAT (...) AS A NUMBER PAGE
/COMMANDS =,?, AND \ /NUMERICAL OUTPUTS & DISPATCH SORT OPRNT, 0 /OCTAL PRINT JMS ZEROD ORAD, 1000 10 DECTYO, TPUT /TYPE OUT JMP I OPRNT CEQL, NCHK /COMMAND = ERR /NO NUMBER TAD DECTYO /TYPE OUT JMP DPRNT CBSL, NCHK /COMMAND \ JMP CBSN TAD (UPOC DPRNT, DCA DECDEV TAD N JMS ZEROD PRAD, 1750 /OR 1000 AND 10 12 /FOR OCTAL RADIX DECDEV, 0 POPJ CQSM, TAD TFLG /COMMAND ? CMA /CHANGE TRACE FLAG DCA TFLG POPJ UPOC, 0 /MOVE TEXT BUFFER UP ONE CHAR DCA OPRNT CLA IAC PUSHJ UPPN CDF 10 TAD I P AND [7400 TAD OPRNT DCA I P CDF ISZ P JMP I UPOC ZEROD, 0 /BINARY TO OCTAL OR DECIMAL DCA PTSAVE /CONVERSION WITH LEADING STA /ZEROS DELETED DCA LEADZ TAD [-3 /-MAX # OF DIGITS DELETED DCA ZCOUNT TAD (JMP I ZPNT DCA ZSWT /SET LEADING-ZERO SWITCH TAD I ZEROD /GET 8^3 OR 10^3 DCA DIV1 ISZ ZEROD TAD I ZEROD /GET 8 OR 10 DCA DIV2 ISZ ZEROD TAD I ZEROD /GET POINTER TO ROUTINE WHICH DCA DEVOUT /GETS DIGITS WE MAKE HERE. ISZ ZEROD /BUMP RETURN POINTER ZAGAIN, TAD PTSAVE /GET NUMBER TO BE CONVERTED MQLDVI DIV1, 0 /SUCCESSIVELY REDUCED BY 8 OR 10 DCA PTSAVE /RESIDUE CLAMQA SNA /IS DIGIT A ZERO? ZSWT, JMP I ZPNT /YES, SO JUMP THRU DISPATCH ISZ LEADZ /NO, IS IT FIRST NON-ZERO SKP /NO ISZ ZSWT /YES ALTER DISPPATCH NLZ, TAD (60 /ADD CONSTANT TO MAKE ASCII JMS I DEVOUT /PUT OUT DIGIT LZ, TAD DIV1 /REDUCE DIVISOR MQLDVI DIV2, 0 CLAMQA DCA DIV1 ISZ ZCOUNT /ENOUGH DIGITS? JMP ZAGAIN /NO TAD PTSAVE /YES , PUT OUT UNITS DIGIT TAD (60 /ZERO ALWAYS PRINTS OUT HERE JMS I DEVOUT /PUT IT OUT JMP I ZEROD /RETURN PTSAVE, 0 LEADZ, -1 ZCOUNT, 0 DEVOUT, 0 ZPNT, LZ NLZ SORTB, 0 /SORT AND BRANCH ROUTINE DCA SCHAR /SAVE SORT CHAR STA TAD I SORTB /GET POINTER TO LIST ISZ SORTB DCA 16 SORTA1, TAD I 16 /GET ITEM IN TEST LIST SPA /END MARKED BY NEG VALUE JMP SORTA2 /FELL OUT BOTTOM CIA TAD SCHAR SZA CLA /COMPARE SORT CHAR JMP SORTA1 /NOT IT. TAD 16 /GOT IT. NOW MAKE INDEX TAD I SORTB /TO JUMP TABLE DCA SORTC /THIS IS TABLE POINTER TAD I SORTC /GET JUMP ADDRESS FROM TABLE DCA SORTC /AND GO THERE CLA CLL JMP I SORTC SORTA2, CLA CLL /FELL OUT BOTTOM ISZ SORTB /SO CHARACTER NOT IN LIST TAD SCHAR /CARRY IT BACK TO JMP I SORTB /DO SOMETHING ELSE SORTC, 0 PAGE
/COMMANDS ^V,P,T,V, AND W NLINES, 0 /CONVERT TAD P /- OR + N LINES AROUND . DCA M /TO CHARS M,N STA DCA NFLG /SET NUMBER FLAG PUSHJ CHRL TAD P DCA N TAD M DCA P JMP I NLINES /RETURN CHRP, TAD N /COMMAND P NCHK /HOW MANY PAGES? IAC /P MEANS 1P CIA DCA NLINES CPOA, PUSHJ CHRW /DO N<WY> PUSHJ CHRY ISZ NLINES JMP CPOA POPJ CPOC, PUSHJ CHRH PUSHJ CTLV+2 /CLEAR COMMA & NUMBER FLAGS TAD OUTLST /PUT OUT A FORM FEED JMP CWOUT /AND POP FROM W ROUTINE CHRT, TAD (TYPE-OUTPUT /COMMAND T CHRW, TAD (OUTPUT /COMMAND W DCA CWOUT NCHK /ANY ARGS? JMP CPOC /NO, DO WHOLE BUFFER CCHK JMP .+4 /+N OR -N LINES AROUND . PUSHJ LINES /COMVERT LINES TO CHARS SKP JMS NLINES CWOA, DCA NFLG /CLEAR NUMBER FLAG PUSHJ MFROMN /COMPUTE N-M CSNCL, SNA CLA /LOCATION USED AS CONSTANT POPJ /NOTHING TO PUT OUT TAD M /STARTING CHAR DCA Q CWOB, CDF 10 TAD I Q CDF AND MASK CWOUT, 0 /TYPE, OUTPUT, CTVTYP, OR QPUT ISZ Q TAD Q CMA CLL TAD N SZL CLA /DONE? JMP CWOB /NO POPJ CHRV, TAD (TYPE-CTVTYP /COMMAND V CTLV, TAD (CTVTYP /COMMAND ^V DCA CWOUT CCHK SKP JMP CWOA /TYPE CHARS M+1 THRU N TAD N NCHK STA /V MEANS -1V TAD P BZCHK /SEE IF B<#<ZZ DCA N TAD P DCA M JMP CWOA /DO .,.+NV /SEARCH STRING MODIFIERS ^N,^Q,^S, AND ^X SCHTAB, SCHINV /^N: ANYTHING BUT SCHLIT /^Q: LITERALLY SCHSEP /^S: ANY SEPARATOR SCHSWT, CSWT /^X: ANYTHING CSK /ALTM OR QUOTE CSK /$ OR QUOTE SCHLIT, SCAN /^Q, GET NEXT CHARACTER SORT /EXCEPT ALTM OR QUOTE QUOTE SCHERR-QUOTE /^Q$ IS UNNECESSARY AND SOME JMP CSQ /ROUTINES CAN'T RECOGNIZE IT SCHINV, TAD CSNCL /^N, INVERT SKIP SENSE DCA I SCHSWT /IN MATCHING CHAIN JMP CSL SCHSEP, CDF 10 /^S, LOOK FOR SEPARATOR TAD I P CDF AND MASK JMS SCHSRT /SHARED SORTING ROUTINE JMP I SCHSWT /TEST AC FOR 0 OR NOT-0 SCHSRT, 0 /SORT LETTERS AND NUMBERS TAD (-173 /TEST FOR LOWER CASE, TOO SMA /BRACES AND VERT BAR JMP SCHS /SUCCESS TAD (32 /LOWER CASE LETTERS SMA JMP SCHF /AREN'T SEPARATORS TAD (7 /BRACKETS, CARET, UNDERSCORE, ETC SMA SZA JMP SCHS /ARE SEPARATORS TAD (32 /UPPER CASE LETTERS SMA SZA JMP SCHF /AREN'T TAD (7) /:,;,<,=,>,?,@ SMA SZA JMP SCHS /ARE TAD (12 /1,2,3,4,5,6,7,8,9,0 AREN'T CIA SCHS, SPA CLA /EVERYTHING ELSE IS SEPARATOR SCHF, STA /LETTERS AND NUMBERS COME HERE JMP I SCHSRT /TEST AC FOR 0 OR NOT-0 PAGE
/COMMANDS A,I, AND Y CHRA, NCHK /COMMAND A SKP /APPEND TO BUFFER JMP CHNA /(N)A:ASCII VALUE OF CHAR AT (N) TAD P DCA CAPP /SAVE CURRENT P TAD ZZ /APPEND AT END OF BUFFER DCA P JMP CALP-3 CHRY, TAD N /COMMAND Y NCHK IAC /ASSUME 1 CIA DCA CISP COYA, PUSHJ CKALL /KILL BUFFER DCA CAPP /SAVE B AS P PUSHJ CALP-3 ISZ CISP /DONE? JMP COYA /NO POPJ TAD ZZ CIA DCA CYMZ /SAVE -CURRENT END CALP, INPUT /CALL INPUT ROUTINE SORT APPLST APPTAB-APPLST CANP, JMS UPOC /PUT IT AWAY JMP CALP CAPP, 0 /TEMP P CYMZ, 0 /-CURRENT END OF TEXT BUFF APSP, TAD YFLG /APPENDING A SPACE SZA CLA /EXPAND MODE? JMP APHT /YES, TAKE IT DCA SPCNT /ZERO SPACE COUNTER ISZ SPCNT INPUT TAD (-40 SNA /ANOTHER SPACE? JMP .-4 /YES STA /NO, COMPUTE TABS TAD SPCNT SNA /MORE THAN ONE SPACE JMP APSP2 /NO, TAKE IN SPACE MQLDVI INHTC, 10 /TAB INCREMENT CLAMQA CMA /-(#TABS+1) DCA SPCNT TAD CAHT /TAB JMS UPOC ISZ SPCNT JMP .-3 APSP1, TAD ICHAR JMP CALP+1 APSP2, TAD CASP JMS UPOC /APPEND THE SPACE JMP APSP1 /AND CHAR FOLLOWING SPCNT, 0 APHT, TAD ICHAR /INPUT CHAR JMP CANP APLF, TAD ICHAR /LINE FEED - SAVE IT FIRST JMS UPOC CLA CLL TAD (-APMAX /SEE IF BUFFER NEARLY FULL TAD ZZ SNL CLA JMP CALP /SPACE STILL AVAILABLE CAFF, TAD CYMZ /COMPARE PREVIOUS END TAD ZZ /WITH PRESENT SNA CLA /DIFFERENT? JMP CALP /NO, SO NOTHING CAME IN TAD CAPP /YES, RESTORE POINTER DCA P POPJ /EXIT CHRI, NCHK /I COMMAND JMP CIL1 TAD N /INSERT CHAR WHOSE VALUE IS N AND MASK JMS UPOC POPJ CTLI, CLA CLL CMA /FOR TAB INSERT SKP /CANNOT BE QUOTED CIL1, QCHK /SEE IF QUOTED STRING TAD SCANP DCA CISP /SAVE SCAN POINTER QSKP /COUNT LENGTH OF INSERTION TAD CISP CMA TAD SCANP SNA /ANYTHING TO INSERT? JMP I QUOTAB /NO, RESTORE ALTM AS TERMINATOR PUSHJ /YES, OPEN A HOLE UPPN TAD CISP /RESET TO BEGINNING OF INSERTION DCA SCANP CIL2, SCAN /STICK CHARS INTO BUFFER SORT QUOTE QUOTAB-QUOTE DCA CSAVE CDF 10 TAD I P AND [7400 TAD CSAVE DCA I P CDF ISZ P /POINTER WINDS UP AT END JMP CIL2 /OF INSERTION CISP, 0 QUOTAB, IREST IREST PAGE
/COMMANDS <,>,; AND PART OF COMMAND DISPATCH TABLE CHLT, TAD [-3 /COMMAND < PUSHL ITRST ITRFIN ITRCNT TAD N NCHK /CHECK FOR ARG CLA CIA /MAKE NEGATIVE DCA ITRCNT /SET UP TERMINATION TAD SCANP /SAVE CURRENT SCAN PNTR DCA ITRST /ALWAYS .GE. 1 IN ITERATION POPJ CHGT, TAD SCANP /COMMAND > DCA ITRFIN /SET UP QUICK EXIT ISZ ITRCNT /LOOK FOR COUNT EXHAUSTED JMP CGTC /NO, CONTINUE CGSG, SZA /SCAN POINTER? DCA SCANP /YES, CATCH UP TAD [-3 POPL ITRCNT ITRFIN ITRST POPJ CGTC, TAD ITRST SNA ERR /IF NOT IN ITERATION DCA SCANP /RESET TO BEGINNING OF ITERATION POPJ CSEM, TAD ITRST /COMMAND ; SNA CLA ERR /IF NOT IN ITERATION TAD N NCHK JMP CSMF SPA CLA POPJ JMP .+3 CSMF, ISZ SFAIL /CHECK FOR TERMINATION POPJ /NO TAD ITRFIN /LOOK FOR QUICK EXIT SZA JMP CGSG /YES, DUCK OUT SKPSET /NO, PLOD THROUGH 76 /LOOKING FOR > CGSG /GO THERE WHEN FOUND ERR /OOPS! RAN OFF END SCAN /SKIP ^U COMMAND SKP CLA /GET RID OF Q-REG # QSKP /SKIP AN R COMMAND CSMQ, QSKP /SKIP OVER QUOTED STRING PUSHJ IREST /FIX UP QUOTE CHAR JMP I .+1 /OK, PLOD FORWARD SOME MORE CSMK /STRING SKIP ROUTINE ITRFIN, 0 /QUICK EXIT LOCATION ITRCNT, 0 /ITERATION COUNTER /COMMAND DISPATCH TABLE - OVERLAPS ONTO PAGE 13 CDSP, POPK;CTLA;CTLB;CTLC;CTLD;SERR;CTLF;CTLG /0-7 POPK;CTLI;ECHO;CTLK;ECHO;ECHO;SERR;SERR /10-17 SERR;SERR;SERR;SERR;CTLT;CTLU;CTLV;SERR /20-27 SERR;SERR;SERR;CALT;SERR;CTBR;CTUA;SERR /30-37 ECHO;CEXP;CDBQ;CNBS;CALT;CPCS;CAMP;CSGQ /40-47 COPR;CCPR;CAST;CPLS;CCMA;CMIN;CDOT;CVIR /50-57 NMBR;NMBR;NMBR;NMBR;NMBR;NMBR;NMBR;NMBR /60-67 NMBR;NMBR;CCLN;CSEM;CHLT;CEQL;CHGT;CQSM /70-77 CATS;CHRA;CHRB;CHRC;CHRD;CHRE;CHRF;CHRG /100-107 CHRH;CHRI;CHRJ;CHRK;CHRL;CHRM;CHRN;CHRO /110-117 CHRP;CHRQ;CHRR;CHRS;CHRT;CHRU;CHRV;CHRW /120-127 CHRX;CHRY;CHRZ;SERR;CBSL;SERR;CHUA;CHBA /130-137 /END OF DISPATCH TABLE
/COMMAND ^U CTLU, QREF /COMMAND ^U DCA CCUQ /SAVE Q-REG POINTER QCHK /SEE IF QUOTED TAD SCANP DCA CCUS /SAVE SCAN POINTER QSKP /COUNT UP STRING TAD CCUS CMA TAD SCANP /LENGTH OF STRING SNA JMP CCUC /NO STRING DCA CCUN TAD I CCUQ /# OF CHAR ALREADY THERE CLL CIA TAD CCUN /DIFFERENCE PUSHJ /ADJUST TO HOLD QADJ /NEW STRING CCUA, TAD CCUN /LENGTH OF NEW STRING DCA I CCUQ QSUM DCA QR TAD CCUS /RESET SCAN POINTER DCA SCANP CCUB, SCAN SORT QUOTE QUOTAB-QUOTE QPUT QR ISZ QR JMP CCUB CCUC, TAD I CCUQ /DELETE C(Q-REG) CLL CIA PUSHJ QADJ DCA I CCUQ /SET LENGTH TO 0 JMP IREST /RESTORE STRING TERM & POP CCUN, 0 /LENGTH OF STRING CCUQ, 0 /POINTER TO Q-REG CCUS=. /TEMP SCANP TYPCTL, 0 /ADD ^ TO CTRL CHARS TAD CHAR SORT CACR CTLTAB-CACR TAD (-40 /SEPARATE CTRL CHARS SPA /IS IT CTRL CHAR? JMP .+4 /YES TYCTL1, TAD CASP TYPE JMP I TYPCTL TAD (100 /CONVERT TO UPPER CASE DCA CCUN /SAVE IT TAD (136 /TYPE THE '^' TYPE TAD CCUN JMP TYCTL1 /NOW ADD BACK IN 40 CTLCR, CRLF JMP I TYPCTL CTLALT, TAD CAAM /44=33+11 CTLHT, TAD CAHT /11 JMP TYCTL1+1 ERRXX, 0 DCA CCUS /SAVE C(AC) CRLF CTLTYP TAD (72 /':' SEPARATOR TYPE STA TAD ERRXX /GET TRAP ADDRESS JMS OPRNT /TYPE IN OCTAL TAD (57 /'/' SEPARATOR TYPE TAD CCUS /GET C(AC) JMS OPRNT /TYPE IN OCTAL RECOUP, TAD (77 /? ERROR FLAG TYPE LISTEN /SEE WHAT HE WANTS TO DO SORT RECLST RECTAB-RECLST CLA /DEFAULT: NOTHING JMP T1 /RESTART COMMAND LINE CHNA, TAD N /ASCII VALUE OF CHAR AT N BZCHK /MAKE SURE IN BUFFER DCA R CDF 10 TAD I R CDF AND MASK JMP NCOM /MAKE IT A NUMBER PAGE
/COMMANDS ^A,^B,HT,LF,FF,CR,^T,SPACE,!,E, AND ^ CTLA, TAD (TYPE-OUTPUT /COMMAND ^A CTLB, TAD (OUTPUT /COMMAND ^B DCA CTLB2 QCHK /SEE IF QUOTED CTLB1, SCAN /GET A CHARACTER SORT QUOTE /SEE IF END QUOTAB-QUOTE CTLB2, JMP . /TYPE OR OUTPUT JMP CTLB1 /GET ANOTHER ECHO, TAD KFLG /COMMANDS CR,LF,HT,FF, & SPACE SNA CLA /TURNED ON? POPJ /NO TAD TFLG /TRACE MODE ON? SZA CLA POPJ /YES, DON'T REPEAT TAD CHAR /GET THE COMMAND TYPE /NOTE: THIS ISN'T CTLTYP POPJ CHUA, POP /COMMAND ^ CLA /MAKE NEXT LETTER A CTRL CHAR PUSHJ CHUA1 /CONVERSION ROUTINE JMP T6A /GO BACK TO COMM EXEC CHUA1, SCAN TAD (-100 /LOWER CASE BARELY ACCEPTABLE SPA ERR /WASN'T LETTER AT ALL AND (37 /MASK IT POPJ CHRE, SCAN /COMMAND E AND (137 /MASK OUT LC BIT SORT ENBLST ENBTAB-ENBLST ERR /NO SUCH COMMAND OUTTAB, OUTFF /DISPATCH TABLE FOR XFIX OUTLF OUTCR OUTHT SORTA2 /ALTM--NO CHANGE CTLTAB, CTLCR /DISPATCH TABLE FOR CTLTYP CTLHT CTLALT QPUTS, 0 /Q-REGISTER STUFFER QPUT QP ISZ QP JMP I QPUTS TYO, 0 /TELETYPE STUFFER JMS XFIX /TWIDDLE SOME CTRL CHARS TPUT /ACTUAL OUTPUT ROUTINE 0 /CHAR COUNT ON LINE -10 /LINE COUNT, 54[10] IN 9 INCHES JMP I TYO MFROMN, TAD N /COMPUTE N-M BZCHK /SEE IF N OK CLA CLL /OK TAD M BZCHK /SEE IF M OK CIA CLL TAD N SZL /IS M>N? POPJ /NO, SO CARRY BACK DIFF CLA /YES, INTERCHANGE TAD N /AND RECOMPUTE DCA QPUTS TAD M DCA N TAD QPUTS DCA M JMP MFROMN+3 CEXP, QCHK /COMMAND ! QSKP /PASS OVER HERE POPJ /RESUME EXECUTION CTLT, JMS TTYIN /COMMAND ^T CTVTYP /ECHO CHAR TYPED IN TAD ICHAR /GET IT BACK JMP NCOM /MAKE IT A NUMBER CHKQF, 0 /CHECK FOR EXPLICIT QUOTES TAD QFLG SNA CLA JMP I CHKQF /FLAG NOT SET SCAN /GET QUOTING CHAR DCA QUOTE /PUT INTO SEARCH TABLE TAD QUOTE DCA QUOTE+1 /ALSO FIX OUT DOLLAR SIGN JMP I CHKQF TTYIN, 0 /TO APPEND FROM TTY READER LISTEN DCA ICHAR /DEPOSIT AS INPUT CHAR TAD ICHAR JMP I TTYIN COMTAB, TBEL /DISPATCH TABLE FOR COMMAND EDIT TCRLF ROCMND TLOWER TUPPER TCTLC TALTM TALTM TALTM TQMK PAGE
/COMMANDS ^F,^^ CTLF, CLA OSR /COMMAND ^F JMP I IREST-2 /VALUE OF SWITCH REG. CTUA, SCAN /COMMAND ^^ JMP I IREST-2 /VALUE OF FOLL. CHAR /E COMMAND MODIFIERS ENBLST, 130 /X: EXIT 103 /C: CLOSE FILE 111 /I: SET INPUT MODE 117 /O: SET OUTPUT MODE 124 /T: WRITE GROUP MARK 106 /F: WRITE FILE MARK 115 /M: SET ECHO MODE 113 /K: KILL ECHO MODE ESKLST, 122 /R: OPEN INPUT FILE 127 /W: OPEN OUTPUT FILE 102 /B: EDIT BACKUP 7777 /FOR EXPANSION 7777 7777 CATS, STA /COMMAND @ DCA QFLG /NEXT STRING WILL BE QUOTED POPJ /SEARCH STRING MODIFIERS: SCHLST, 16 /^N: ANYTHING BUT 21 /^Q: LITERALLY 23 /^S: ANY SEPARATOR 30 /^X: ANYTHING QUOTE, 33 /ALTM OR QUOTE CHAR 44 /$ OR QUOTE CHAR CCLN, STA /COMMAND : DCA CLNF /NEXT SEARCH WILL HAVE POPJ /NUMERIC VALUE 102 /B: BRIEF 130 /X: EXPANDED EIN, CLA CLL CMA RAL /TERMINATES LIST EOUT, TAD (DCA XFLG /COMPUTE INSTRUCTION DCA EIO PUSHJ CHUA1 /CLEAR CASE AND ALPHA BITS TAD (100 /RESTORE ALPHA SORT EIN-2 /B OR X .+2-EIN+2 /ABOUT 14[8] ERR /INCOMPLETE COMMAND .+3 .+1 STA EIO, JMP . /DCA XFLG OR DCA YFLG POPJ CHKCLN, ISZ CLNF /SEARCH MODIFIED BY :? JMP IREST /NO, JUST RESTORE ALTM & $ ISZ SFAIL /YES, CHECK FAIL FLAG STA /AND ASSIGN VALUE PUSHJ /CALL NUMBER PROCESSOR NCOM DCA SFAIL /CLEAR FAIL FLAG IREST, TAD CAAM /ALT MODE DCA QUOTE TAD CDOL /$ DCA QUOTE+1 DCA QFLG /CLEAR FLAG POPJ /Q-REGISTER POINTERS: 0;0 /Q-REG 0 0;0 /Q-REG 1 0;0 0;0 0;0 0;0 0;0 0;0 0;0 0;0 /Q-REG 9 QPNTR, 0 /# OF CHARS IN COMM LINE CDOL, 44 /OTHERWISE UNUSED /DISPATCH TABLE FOR SKIPPING OVER COMMANDS: SKPTAB, 0 /TRAP ROUTINE CSMQ /! CSMO /> CSMI /< CSMD /" CSMC /^ CSMA /@ CSMQ /^A CSMQ /^B CSMQ /TAB CSMQ-3 /^U CSMD /^^ CSME /E ESKTAB, CSMQ /I CSMQ /N CSMQ /O CSMQ-1 /R CSMQ /_ CSMZ /ALTM CSMZ /$ PAGE
/UTILITIES RECSTK, TAD PDLP /PRINT OUT STACK REMNANTS CIA IAC DCA COMPAR TAD (PDLBEG-1 DCA 17 RECST1, CRLF TAD 17 TAD COMPAR SNA CLA JMP RECCML+2 TAD I 17 JMS OPRNT JMP RECST1 RECCML, PUSHJ /PRINT OUT COMMAND LINE TQMF CRLF JMP RECOUP RECTAB, CTLC /DISPATCH TABLE FOR RECOUP RECSTK RECSTK RECSTK RECCML COMPAR, 0 /LOOK FOR DOUBLED COMM LINE CHARS TAD SCHAR /MOST RECENT CIA TAD CHAR /PREVIOUS SZA CLA RESORT /NOT THE SAME CTLTYP /TYPE THE CHARACTER JMP I COMPAR /SAME-SPECIAL HANDLING TCTLC, JMS COMPAR /^C IN COMMAND LINE JMP CTLC /2ND ^C CALLS MONITOR TBEL, JMS COMPAR /^G IN COMMAND LINE JMP T1 /2ND ^G KILLS COMMAND LINE CHKBZ, 0 /SEE THAT B .LE. C(AC) .LE. ZZ DCA CHKCF /SAVE TAD CHKCF /PICK UP C(AC) CIA CLL TAD ZZ SNL CLA /13-BIT ARITHMETIC ERR /C(AC)>ZZ TAD CHKCF /O.K. JMP I CHKBZ CHKCF, 0 /SEE IF COMMA FLAG SET ISZ CFLG SKP CLA /C(AC):=0 IF FLAG NOT SET ISZ CHKCF /RETURN TO CALL+2 IF SET JMP I CHKCF /OR CALL+1 IF NOT APFS, DCA REND /MARK END-OF-FILE TAD ERR-4400 /GET ERRXX POINTER DCA INR /FURTHER INPUT IS ERROR JMP CAFF+4 /GO MAKE N & _ FAIL APGS= CAFF ENBTAB, EXIT /X-DISPATCH TABLE FOR E COMMANDS EXITC /C EIN /I EOUT /O ENDGRP /T ENDFIL /F EKON /M EKOFF /K ROPEN /R WOPEN /W EBAK /B 0 /FOR EXPANSION 0 0 TLOWER, JMS COMPAR /^L IN COMMAND LINE TAD (40 /2ND ^L SETS LOWER CASE SKP TUPPER, JMS COMPAR /^U IN COMMAND LINE DCA TCASE /2ND ^U SETS UPPER CASE JMP ROCMND /EXECUTE RUBOUT DEVTAB, PERD /DISPATCH TABLE FOR NAME PROCESSOR COLON NAMEC /IGNORE SPACES SYMTAB, CNDP /SYMBOLS FOR CNDP /CONDITIONAL CNDP /JUMP COMMAND PAGE
/COMMANDS ^C,^G, AND ^] CTBR, TAD N /COMMAND ^] NCHK /SET TABS TO N OR 8 TAD (10 /RESTORE TO 8 DCA CHKNF /SAVE TAD CHKNF DCA OUTHTC /CONSTANT IN XFIX TAD CHKNF DCA OUTHTD /CONSTANT IN XFIX TAD CHKNF DCA INHTC /CONSTANT IN APPEND POPJ EKON, STA /COMMAND EM EKOFF, DCA KFLG /COMMAND EK POPJ TYPCTV, 0 /FAKE OUT SUBROUTINE TYPCTL CIA /BY SUBTRACTING C(CHAR) TAD CHAR /FROM AD CIA CTLTYP /CALL TYPCTL JMP I TYPCTV /PRESERVE C(CHAR) CHKNF, 0 /CHECK AND RESET NUMBER FLAG ISZ NFLG SKP CLA /AC:=0 IF NO NUMBER ISZ CHKNF /SKP RETURN IF NUMBER JMP I CHKNF CTLG= . CTLC, 7600 /COMMAND ^C, OPERATE 2 CLA TSF /WAIT FOR FLAG JMP .-1 /THIS IS THE EVER-LOVIN' END! JMP I CTLC /GO TO MONITOR SPUT, 0 /PUT CHAR INTO COMM LINE CLA CLL IAC TAD QZ /TOTAL Q-REG CHARS DCA R TAD R TAD (-QMAX /LIMIT OF Q-REGS SZL CLA /TWO PLACES TO TRIP LINK ERR /TOO MUCH STUFF! TAD QZ /STICK ONTO END DCA QP /Q-REG POINTER TAD CHAR /LATEST COMM LINE CHAR QPUT QP ISZ QZ /INCREMENT Q-REG COUNT ISZ SCANP /POINT TO NEXT ISZ I QREGS /INCREMENT CHAR COUNT JMP I SPUT DRAD, 1750 /CONSTANTS FOR DECIMAL RADIX 12 SCHERR, NOP /^Q[ALTM] IN SEARCH STRING ERR /^Q$ IN SEARCH STRING PDLBEG, ZBLOCK 40 /BEGINNING OF PUSH-DOWN LIST PDLEND=PDLBEG+37 /END OF PUSH-DOWN LIST PAGE
/TELETYPE ROUTINES TPUT, 0 JMP .+5 /DON'T WAIT FIRST TIME JMS BRKCHK /BREAK? TSF /TELEPRINTER READY? JMP .-2 /NO, WAIT TAD TYI /GET THE CHAR BACK TAD (200 TLS CLA CLL TAD (DCA TYI DCA TPUT+1 JMP I TPUT TYI, 0 /KEYBOARD INPUT KSF JMP .-1 KRB AND MASK JMP I TYI XFIX, 0 /OUTPUT MANIPULATIONS DCA TYP TAD I XFIX DCA OUTP ISZ XFIX TAD TYP SORT OUTLST OUTTAB-OUTLST ISZ I XFIX /INCREMENT CHAR COUNT NOP /IT MIGHT SKIP XFIX1, ISZ XFIX ISZ XFIX JMS I OUTP /PUT AWAY CHAR JMP I XFIX OUTP, 0 LFCT, 0 NULLS, 0 TYP, 0 OUTCR, DCA I XFIX /RESET CHAR COUNT TAD TYP /CR JMP XFIX1 OUTLF, ISZ XFIX /LINE FEED ISZ I XFIX /INCREASE LINE COUNT JMP OUTLF1 /NOT END OF PAGE TAD (-66 /RESET LINE COUN DCA I XFIX /FOR NEXT PAGE JMP OUTLF1 /TYPE LINE FEED OUTFF, ISZ XFIX /FORM FEED TAD I XFIX /HOW MANY LINES LEFT? TAD (-14 /2 INCHES FOR MARGINS DCA LFCT /# OF LINES TO FEED TAD (-66 /RESET LINE COUNT DCA I XFIX /FOR NEXT PAGE TAD XFLG /EXPAND MODE? SNA CLA JMP FORM1 /NO TAD CALF /YES, DO LINE FEEDS JMP FORM3 OUTLF1, TAD TYP /LF JMP XFIX1+1 OUTHT, TAD I XFIX /CHAR COUNT TAD OUTHTC /ADD 1 TAB INCR MQLDVI OUTHTC, 10 CIA /SUBTRACT FROM TAD OUTHTC /WHOLE TAB CIA /MAKE NEGATIVE DCA LFCT CLAMQA MQLMUY /ADJUST CHAR COUNT OUTHTD, 10 CLAMQA DCA I XFIX /NEW CHAR COUNT ISZ XFIX TAD XFLG SNA CLA JMP TABU1 /COMPRESSED MODE TAD CASP /EXPAND MODE, SPACES JMP FORM3 FORM1, TAD OUTLST /FORM FEED DCA TYP /ADJUST CHAR SKP /FF GOES TWICE AS FAST AS TABU1, TAD LFCT /TABULATION TAD LFCT /X+X=2*X! CIA /MAKE POSITIVE TO DIVIDE MQLDVI 6 /1 IDLE PER 3 SPACES OR 6 LINES CLAMQA CIA /MAKE NEGATIVE AGAIN SNA /ANY IDLES? STA /AT LEAST ONE FORM2, DCA LFCT /# OF IDLES TAD TYP /PUT OUT ORIGINAL CHAR JMS I OUTP TAD CASP+1 /IDLE FORM3, DCA NULLS /IDLES, SPACES & LINE FEEDS TAD NULLS JMS I OUTP /PUT ONE OUT THE ISZ LFCT /WINDOW JMP FORM3+1 /STILL MORE INSIDE ISZ XFIX /DONE WITH THEM JMP I XFIX /RETURN PAGE
/Q-REGISTER MANIPULATIONS /COMMANDS G,M,$, AND ALTM CHRM, QREF /COMMAND M CLA CLL /THROW AWAY POINTER TAD [-4 /4 ITEMS PUSHED TO PUSHL /SAVE CURRENT MACRO STATE QCMND SCANP CMON MPDL TAD PDLP /MUST CHECK PDL AT END OF MACRO CIA DCA MPDL TAD N NCHK IAC /ASSUME 1 CIA DCA CMON /NUMBER OF TIMES TO EXECUTE TAD QNMBR /Q-REGISTER TO EXECUTE DCA QCMND CMOR, DCA SCANP /RESET TO BEGINNING OF REGISTER POPJ CMON, 0 /NUMBER OF TIMES TO EXECUTE CALT, TAD QCMND /COMMANDS $ AND ALTM SNA CLA /IN MACRO? JMP I [T1 /NO, END OF COMMAND LINE TAD PDLP /PDL IS CRUCIAL HERE TAD MPDL /SEE IF SAME AS STARTED SZA ERR /PDL FOULED UP ISZ CMON /SEE IF ANOTHER ROUND WANTED JMP CMOR /YES TAD [-4 /4 ITEMS POPPED TO POPL /RESTORE PREVIOUS MACRO STATE MPDL CMON SCANP QCMND POPJ CHRG, QREF /COMMAND G DCA CGOQ CCHK /SEE IF M,NG JMP CGOB /NO PUSHJ CHRD+2 /DELETE M,N CGOA, TAD I CGOQ /NUMBER OF CHARS IN Q-REG PUSHJ UPPN /MOVE TEXT BUFFER UP QSUM /COMPUTE Q-REG POSITION CLA TAD I CGOQ CMA DCA CGOQ /-# OF CHARS JMP QDNND QLOOP, QGET QP DCA CSAVE CDF 10 TAD I P AND [7400 TAD CSAVE DCA I P CDF ISZ QP ISZ P QDNND, ISZ CGOQ JMP QLOOP /KEEP GOING TILL DONE POPK, POPJ /END OF INSERTION CGOB, TAD N /POINTER POSITION TO INSERT NCHK /CONTENTS OF Q-REG TAD P /NOT GIVEN, ASSUME P DCA P JMP CGOA CGOP, 0 /TEXT BUFFER POINTER CGOQ, 0 /POINTER TO Q-REGISTER QADJ, SNL /ADJUST Q-REGS JMP QDNN-1 /TO HOLD NEW STRING SNA /CHECK FOR ZERO POPJ /NOTHING TO DO QUPN, CLL /MOVE Q-REGS UP TO TAD QZ /INSERT CHARS DCA R TAD R TAD [-QMAX /SEE IF OUT OF BOUNDS SZL CLA /TWO PLACES TO TOGGLE LINK THERE ERR /GETTING TOO FULL QSUM /COMPUTE POINTER TO Q-REG CLA CLL /WE JUST NEED TO SET QP TAD QZ DCA Q TAD R DCA QZ QPNL, TAD R CIA TAD QP SNA CLA POPJ /FINISHED CLA CMA TAD Q DCA Q CLA CMA TAD R DCA R QGET Q QPUT R JMP QPNL CIA /REACHED FROM QADJ QDNN, DCA Q /MOVE Q-REGS DOWN TO QSUM /ABSORB CHARS TAD Q DCA Q /TOP OF DELETION TAD QP DCA R /BOTTOM OF DELETION QDNN1, TAD QZ CIA TAD Q /-NUMBER OF CHARS TO MOVE SNA CLA /DONE? JMP QDNNF /YES QGET /MOVE ANOTHER CHAR Q QPUT R ISZ Q ISZ R JMP QDNN1 /LOOP AGAIN QDNNF, TAD R /SET NEW VALUE DCA QZ /OF HIGHEST CHAR POPJ /EXIT PAGE
/COMMANDS %,Q,U, AND X QSUMR, 0 /COMPUTE POINTER TO Q-REG TAD (QPNTR-24 /BASE ADDR OF Q-REG POINTERS DCA QSUMP TAD QNMBR SNA /IN COMMAND LINE? TAD (13 /YES, C.L. IS 11TH Q-REG CIA /COUNT DOWN DCA QSUMC QSUML, ISZ QSUMC /REACHED OUR REG? SKP /NO JMP QSUMB /YES, SET POINTER TAD I QSUMP /ADD # OF CHARS IN LOWER REG ISZ QSUMP /SKIP VALUE WORD ISZ QSUMP /POINT TO NEXT Q-REG JMP QSUML /ADD IN ANOTHER QSUMB, DCA QP /Q-REGISTER POINTER TAD QP /CARRY IT BACK JMP I QSUMR QSUMC, 0 /COUNTER FOR Q-REGS QSUMP, 0 /POINTER TO Q-REG POINTERS CQOQ, 0 /LOCAL POINTER TO Q-REG SGET, 0 /SCAN COMMAND LINE OR MACRO TAD QNMBR /SAVE Q-REG PNTR DCA CXON TAD QCMND /POINTER TO CMND LINE OR MACRO DCA QNMBR /FOR QSUM QSUM /GET BASE OF C.L. OR MACRO TAD SCANP /ADD IN USED-UP C.L. CHARS DCA QP /TO MAKE Q-REG POINTER TAD I QSUMP /# OF CHARS IN THIS C.L. OR Q-REG CIA CLL TAD SCANP /MAKE SURE STILL INSIDE! SZL CLA JMP CALT /END OF THAT COMMAND, PRETEND ALTMODE TAD CXON /RESTORE Q-REG PNTR DCA QNMBR QGET QP /NEXT CHAR OF C.L. OR MACRO ISZ SCANP /INCREMENT !AFTER! FETCH JMP I SGET /RETURN QREFER, 0 /SET UP POINTERS FOR Q-REG REFERENCE SCAN /GET NUMBER OF Q-REG TAD (-72 /CHECK FOR GOODNESS SMA ERR /BADNESS TAD (72-57 /Q-REGS ARE 0 THRU 9 SPA SNA ERR /REST OF BADNESS DCA QNMBR /THIS IS (Q-REG#)+1 STA /SUBTRACT ONE TAD QNMBR CLL RAL /TWO WORDS OF POINTERS PER Q-REG TAD (QPNTR-24 /ADD IN BASE OF POINTERS JMP I QREFER /CARRY BACK POINTER TO POINTERS CHRQ, QREF /COMMAND Q IAC /POINT TO SECOND WORD DCA CQOQ /SAVE POINTER NCHK /SEE IF LOADING OR USING JMP CQOA /USING TAD N /LOADING VALUE OF N DCA I CQOQ /PUT IT AWAY POPJ /DONE CHRU, QREF /COMMAND U DCA CQOQ /SAVE POINTER NCHK /SEE WHAT'S HAPPENING JMP CXOA+2 /DELETING CONTENTS OF Q-REG CCHK /ONE ARG OR TWO? SKP /ONE: +N OR -N CHRS JMP CXOA /TWO: CHARS M,N TAD N TAD P BZCHK /SEE IF REASONABLE DCA N /ONE LIMIT TAD P /. IS DCA M /OTHER LIMIT JMP CXOA CPCS, QREF /COMMAND % IAC /POINT TO VALUE WORD DCA CQOQ /SAVE POINTER ISZ I CQOQ /INCREMENT VALUE CQOA, TAD I CQOQ /OK EVEN ON SKIP JMP NCOM /MAKE A NUMBER CHRX, QREF /COMMAND X DCA CQOQ /SAVE POINTER NCHK /SEE WHAT THEY WANT JMP CXOB /WHOLE BAG CCHK JMP CXOA-1 /+N OR -N LINES PUSHJ LINES /LINES M,N SKP JMS NLINES /FIGURE LINES CXOA, PUSHJ MFROMN /COMPUTE N-M DCA CXON /LENGTH OF NEW STRING TAD I CQOQ CIA CLL TAD CXON /HOW MUCH TO ADJUST Q-REG SIZE PUSHJ /MAKE IT MORE OR LESS QADJ TAD CXON /LENGTH OF NEW STRING DCA I CQOQ /TO Q-REG POINTER TAD CXON /LENGTH OF STRING SNA CLA /IS THERE ANYTHING TO DO? POPJ /NO, GO BACK QSUM /ADD UP LOWER Q-REGS STA DCA CFLG /SET COMMA FLAG TAD (QSTUFF /CARRY POINTER FOR JMP CHRV+2 /TEXT OUTPUT ROUTINE CXOB, PUSHJ /X ALONE MEANS ENTIRE TEXT BUFFER CHRH /DO HU TO GET EVERYTHING JMP CHRU+2 /RESET COMMA & NUMBER FLAGS CXON, 0 /STRING LENGTH PAGE
/COMMAND O CHRO, DCA NFLG /AVOID TROUBLE QCHK /TEST FOR QUOTES TAD QUOTE /MOVE TO LOCAL POINT DCA COOZ TAD QUOTE+1 DCA COOZ+1 STA /SET ITERATION FLAG DCA COOL TAD QP /POINTER TO GOTO STRING IAC DCA COOQ /SAVE FOR RESTARTING TAD ITRST /START AT BEGINNING OF SNA /CURRENT ITERATION DCA COOL /NOT ITERATING, CLEAR FLAG DCA SCANP /RESET SCAN POINTER COOA, SKP CLA /AVOID QSKP FIRST TIME QSKP /SKIP A STRING COMMAND TAD COOQ /RESET TO BEGINNING OF GOTO DCA QR SKPSET /SKIP COMMANDS UNTIL 41 /! ENCOUNTERED COOC /WHERE TO PROCESS IT ISZ COOL /HERE ON $ OR ALTM ERR /TAG NOT MATCHED JMP COOA-1 /DO PART FROM BEGINNING COOL, 0 /FLAG FOR ITERATION COOQ, 0 /BEGINNING OF GOTO STRING COOT, 0 /TEMPORARY CSMI, POP /SAVE RETURN POINTER DCA CSPS PUSHJ /FOUND < CHLT /PUSH DOWN INTO ITERATION JMP .+5 CSMO, POP /SAVE RETURN POINTER DCA CSPS PUSHJ /FOUND > CGSG /POP OUT OF ITERATION TAD CSPS /RESTORE RETURN PUSH /POINTER JMP CSML /CONTINUE COOB, .+2 /END OF TAG STRING FOUND .+1 QGET QR /CHECK FOR END OF GOTO STRING SORT COOZ QUOTAB-COOZ /GO TO IREST IF IT IS JMP COOA /NOT END SO NO MATCH COOC, SCAN /FOUND TAG DEFINITION SORT QUOTE /WATCH OUT FOR END COOB-QUOTE /COOB IF END OF TAG CIA DCA COOT /NOT END, SAVE QGET QR /COMPARE WITH GOTO STRING ISZ QR SORT COOZ /WATCH FOR END HERE, TOO COOY-COOZ /START AGAIN IF END FOUND TAD COOT /NOT END, COMPARE SZA CLA JMP COOA+1 /DIFFERENT, START OVER JMP COOC /MATCH SO FAR SETSKP, 0 /SET UP TO SKIP COMMANDS TAD I SETSKP DCA SKPLST /CHAR TO TRAP ON ISZ SETSKP TAD I SETSKP /LOCATION TO SERVICE DCA SKPTAB /TRAP CHAR CSML, SCAN TAD (-100 /LOOK FOR LOWER CASE SMA AND CS137 /MASK TO UPPER CASE TAD CS100 /RESTORE 100 SORT SKPLST SKPTAB-SKPLST CSMK, CLA /NON-STRING COMMAND JMP CSML /KEEP SKIPPING CSMD, SCAN /CLEAR OUT MODIFIER JMP CSMK CSMC, PUSHJ /FOUND ^ CHUA1 /MAKE CTRL CHAR DCA SCHAR /RETURN TO SORT ROUTINE JMP SORTA1 /AS IF NOTHING HAPPENED CSME, SCAN /FOUND E COMMAND AND CS137 /MASK OUT LC BIT SORT ESKLST /LOOK FOR ER & EW ESKTAB-ESKLST /USE CSMQ TO SKIP JMP CSMK /NO STRING CSMZ, ISZ SETSKP /FOUND $ OR ALTM JMP I SETSKP /HOP BACK TO SEE IF ERROR CSPS, 0 /SAVE RETURN POINTER COOZ, 0 0 COOY, COOA+1 COOA+1 SKPLST, 0 /TRAP CHAR 41 /! 76 /> 74 /< 42 /" 136 /^ CS100, 100 /@ 1 /^A 2 /^B 11 /TAB 25 /^U 36 /^^ 105 /E 111 /I 116 /N 117 /O 122 /R 123 /S CS137, 137 /_ 33 /ALTM 44 /$ CSMA, PUSHJ /LIST TERMINATOR CATS /FOUND @ JMP CSML /CONTINUE SKIPPING PAGE
/I/O UTILITIES DECPUT, 0 /DEVICE INDEPENDENT I/O AND MASK TAD (200 /ADD ON PARITY BIT ISZ O3 /3RD CHAR OF 3? JMP O2 /NO JMS RT /YES, SPECIAL HANDLING TAD DECGET /TEMP STORAGE JMS RT TAD [-3 /RESET SWITCH DCA O3 ISZ OCRCNT /END OF BUFFER? JMP I DECPUT /NO CLA CLL /HAS HE GONE TOO FAR? TAD OCNT TAD OMAXLN SZL CLA JMP OERR /YES, KILL HIM JMS I OUTHND 4200 OUT OBLK, 0 HLT ISZ OBLK /BUMP RECORD POINTER ISZ OCNT /AND COUNT JMS OSETP /RESET POINTERS JMP I DECPUT /AND RETURN O2, DCA I OPTR1 /NORMAL HANDLING ISZ OPTR1 /BUMP POINTER JMP I DECPUT RT, 0 /HALF-CHAR PACK ROUTINE CLL RTL RTL DCA DECGET /TEMPORARY STORAGE TAD DECGET AND (7400 TAD I OPTR2 /ADD IT ON DCA I OPTR2 ISZ OPTR2 JMP I RT OPTR1, 0 OPTR2, 0 OCRCNT, 0 O3, 0 OERR, TAD (ERR-4400 DCA OUTR ERR OSETP, 0 /ROUTINE TO RESET OUTPUT POINTERS TAD [-3 /3-WAY SWITCH DCA O3 TAD (OUT /BUFFER POINTERS DCA OPTR1 TAD (OUT DCA OPTR2 TAD D7600 /=-200 DCA OCRCNT /CHARACTER COUNT JMP I OSETP DECGET, 0 /PS/8 CHARACTER INPUT D7600, 7600 /GROUP 2 CLA ISZ ICRCNT JMP I2 /NO NEED TO READ JMS I INHND /NOTHING IN BUFFER, GET SOME MORE 0200 IN IBLK, 0 SMA CLA /HALT ON FATAL ERROR SKP CLA /NORMAL RETURN HLT /YOU BLEW IT, DUMMY! ISZ IBLK /BUMP RECORD POINTER TAD (IN /AND RESET OTHER POINTERS DCA IPTR1 TAD (IN DCA IPTR2 TAD (-600 DCA ICRCNT TAD [-3 DCA I3 I2, ISZ I3 JMP I1 /NORMAL CHARACTER TAD [-3 /WEIRD CHARACTER-RESET SWITCH DCA I3 TAD I IPTR2 ISZ IPTR2 AND (7400 DCA ICHAR /TEMP TAD I IPTR2 ISZ IPTR2 AND (7400 CLL RTR RTR TAD ICHAR CLL RTR RTR JMP .+3 I1, TAD I IPTR1 ISZ IPTR1 AND MASK /MASK OFF GARBAGE DCA ICHAR TAD ICHAR JMP I DECGET /AND EXIT ICRCNT, 0 IPTR1, 0 IPTR2, 0 I3, 0 APPTAB, APSP /SPACE--MIGHT CONVERT TO TAB CAFF /FORM FEED--END OF PAGE APLF /LINE FEED--SEE IF TOO FULL APFS /^Z--END OF FILE CALP /NULL--IGNORE CALP /RUBOUT--IGNORE ENDGRP=CHRP GETUSR, 0 /SUBROUTINE TO LOCK MONITOR IN CORE IOF CIF 10 JMS I USR 10 TAD (200 DCA USR JMP I GETUSR PAGE
/FILE OPEN COMMMANDS: ROPEN, CLA CLL CML RTL /OPEN INPUT FILE JMS OPEN /LOOKUP CODE IN AC INHNDL /HANDLER ADDRESS DCA INHND /SAVE HANDLER ENTRY TAD STBLK DCA IBLK /FIRST BLOCK TAD [DECGET /DEVICE INDEPENDENT CODE DCA INR /INPUT ROUTINE CLA CLL CMA DCA ICRCNT /POINTER CLA CLL CMA DCA REND /CLEAR END-OF-FILE FLAG JMS DISMISS /KICK THE USR OUT JMP IREST /EXIT WOPEN, TAD [3 /OPEN OUTPUT FILE JMS OPEN /ENTER CODE IN AC OUHNDL /HANDLER ADDRESS DCA OUTHND /HANDLER ENTRY DCA EBFLG /CLEAR BACKUP FLAG TAD FLN /MAXIMUM FILE LENGTH DCA OMAXLN TAD STBLK /STARTING BLOCK DCA OBLK TAD (DECPUT /SETUP POINTER TO DCA OUTR /OUTPUT ROUTINE JMS OSETP /SET POINTERS CLA CLL CMA DCA WEND /CLEAR END-OF-FILE FLAG TAD DEVC+1 DCA ODEV /SAVE DEV # DCA OCNT /CLEAR BLOCK COUNT TAD NAME /SAVE FILENAME FOR CLOSE DCA OUNAM TAD NAME+1 DCA OUNAM+1 TAD NAME+2 DCA OUNAM+2 TAD NAME+3 DCA OUNAM+3 JMS DISMISS /KICK THE USR OUT JMP IREST /EXIT EBAK, TAD DX /EDIT BACKUP COMMAND DCA DISMISS+1 /KILL DISMISS SO USR STAYS IN CORE PUSHJ /DO LOOKUP FAKE ROPEN TAD DEVC+1 /DEVICE # TAD (7757 /SDVHND-1 DCA TX CDF 10 TAD I TX /DEVICE CODE CDF X7700, SMA CLA /NEGATIVE IF FILE-STRUCTURED JMP EBERR /YOU CAN'T DO THAT! TAD NAME+3 /SAVE EXTENSION FOR ENTER DCA TX TAD (213 /.BK EXTENSION DCA NAME+3 TAD DEVC+1 /DEVICE # CIF 10 JMS I USR /DELETE THE OLD BACKUP 4 DELPT, NAME 0 CLA CLL /WHO CARES IF IT'S NOT THERE? TAD TX /RESTORE THE EXTENSION DCA NAME+3 CIF 10 /CALL THE HANDLER INTO THE OUTPUT SLOT, TOO JMS I USR /RESET SYSTEM TABLES 13 /ZAP OPEN OUTPUT FILES TAD WOPEN+2 /PLACE TO LOAD HANDLER DCA .+5 TAD DEVC+1 /OUTPUT TO SAME DEVICE AS INPUT CIF 10 JMS I USR /GET THE HANDLER 1 OUHNDL JMP EBERR /(HOW DID THIS HAPPEN?) TAD .-2 /MOVE HANDLER ENTRY DCA OUTHND TAD DELPT /SET UP POINTER FOR ENTER DCA EBLK TAD DEVC+1 CIF 10 /ENTER THE OUTPUT FILE JMS I USR 3 EBLK, NAME 0 /USELESS LENGTH JMP EBERR /NO ROOM DCA DISMISS+1 /FIX DISMISS CLA CLL IAC /SET FLAG TO SHOW WE'RE DOING AN EB DCA EBFLG TAD EBLK+1 /MOVE OUTPUT POINTERS DCA OMAXLN /OVERFLOW PROTECTION TAD EBLK /MOVE STARTING BLOCK PUSHJ /AND THE OTHER CRAP WOPEN+10 JMP CHRY+2 /READ IN THE FIRST PAGE EBERR, DCA DISMISS+1 /FIX DISMISS JMS DISMISS /KICK MONITOR OUT ON ERROR ERR TX=. /TEMPORARY DISMISS, 0 /KICK USR OUT OF CORE (SOMETIMES) NOP CIF 10 JMS I USR 11 TAD X7700 /RESET MONITOR POINTER DCA USR DX, JMP I DISMISS OUNAM, ZBLOCK 4 PAGE
/COMMANDS " AND ' CNDLST, 103 /C 143 /C 76 />, OLD G 53 /+, NO EQV: 0 OR + 43 /#, OLD N 55 /-, NO EQV: 0 OR - 74 /<, OLD L 75 /=, OLD E CDBQ, NCHK /COMMAND " ERR /NO NUMBER TO TEST SCAN SORT CNDLST CNDTAB-CNDLST ERR /NO SUCH TEST CNDI, SCAN /HIT ANOTHER " STA /SO SKIP MATCHING ' TAD CNDN DCA CNDN RESORT /GO BACK TO CSML CNDO, ISZ CNDN /FOUND A ' RESORT /NEED ANOTHER: BACK TO CSML TAD (CSMD /FIX UP SKIP TABLE DCA SKPTAB+4 /USED ELSEWHERE CSGQ, POPJ /COMMAND ' NO ACTION TO TAKE CNDN, 0 /COUNTER FOR " NESTING TCRLF, TAD CACR /CR IN COMM LINE DCA CHAR CTLTYP /TYPE IT OUT JMS SPUT /PUT INTO COMM LINE TAD CALF /THEN PUT IN A LF DCA CHAR JMS SPUT JMP T2 /AND GET SOME MORE CNDTAB, CNDC /LEGAL CONSTITUENT OF CNDC /SYMBOL FOR ASSEMBLER .+6 /POSITIVE, NON-ZERO .+6 /POSITIVE OR ZERO .+6 /NON-ZERO .+6 /NEGATIVE OR ZERO .+6 /NEGATIVE .+6 /ZERO TAD [40 /SMA SZA-SMA TAD [40 /SMA-SZA TAD CNM110 /SZA-SPA SNA TAD [40 /SPA SNA-SPA TAD [40 /SPA-SNA TAD (SNA CLA DCA .+2 /COMPUTED INSTRUCTION TAD N /PERFORM TEST JMP . /INVERSE OF TEST SENSE POPJ /CONDITION SATISFIED CNDF, STA /NOT SATISFIED DCA CNDN /BEGINNING SKIPPING COMMANDS TAD (CNDI /TRAP OUT NESTED " DCA SKPTAB+4 SKPSET /CALL SKIPPING ROUTINE 47 /FIND A ' CNDO /PROCESS IT THERE ERR /NO MATCHING ' CNDC, TAD N /TEST FOR SYMBOL JMS SCHSRT /FIND LETTERS & NUMBERS SZA CLA /AC=0 IF NOT CNDP, POPJ /N IS A SYMBOL TAD N SORT /LOOK FOR $,%, AND . SYMLST SYMTAB-SYMLST JMP CNDF /N IS NOT A SYMBOL SYMLST, 44 /$ 45 /% 56 /. CNM110, -110 /SZA-SPA SNA, END OF LIST COMLST, 7 /^G, COMMAND LINE EDIT LIST 15 /CR, INSERT CR & LF 177 /RUBOUT 14 /^L, SET LOWER CASE 25 /^U, SET UPPER CASE RECLST, 3 /^C, ERROR RECOVERY AID LIST 33 /^[, ALT MODE 175 /ANOTHER ALT MODE 176 /YET ANOTHER ALT MODE 77 /? CBSN0, TAD (55-72 /SEE IF DIGIT SMA JMP CBSN2 /NO, STOP HERE TAD (72-60 SPA JMP CBSN2 /NOT DIGIT EITHER PUSHJ NMBR+2 /CALL DIGIT PROCESSOR ISZ P /POINT TO NEXT CHAR TAD (NOP-SZA /DON'T TAKE A - CBSN, TAD (SZA /TAKE INITIAL - DCA CBSN1 CDF 10 /TEST 1 CHAR TAD I P CDF AND MASK TAD (-55 /IS IT -? CBSN1, JMP . /SZA OR NOP JMP CBSN0 /SEE IF DIGIT PUSHJ CMIN /CALL - PROCESSOR JMP CBSN-2 /TEST NEXT CHAR CBSN2, CLA POPJ /FINISHED JMP I QOVER /TRICKY CODING HERE .-1 /TARGET OF A SORT LIST QOVER, 0 /ENTRY POINT AND TARGET OF SORT SCAN SORT QUOTE /SKIPPING OVER A STRING COMMAND QOVER-1-QUOTE CLA /NOT END JMP QOVER+1 /SKIP ANOTHER CHAR PAGE
/FILE OPEN ROUTINE OPEN, 0 /CALLED WITH MONITOR CODE IN AC DCA CODE /ENTER OR LOOKUP QCHK /CHECK FOR EXPLICIT QUOTE (@) TAD (5723 /PACKED SIXBIT FOR 'DSK:' DCA DEVC DCA DEVC+1 /CLEAR SECOND WORD TAD (72 /RESTORE : DCA DEVLST+1 NGO, DCA NAME /CLEAR NAME DCA NAME+1 DCA NAME+2 TAD (2001 /ASSUMED .PA EXTENSION DCA NAME+3 TAD (NAME /INITIALIZE POINTERS DCA NBASE CLA CLL CMA DCA PERDSW DCA NAMCNT NAMEC, SCAN SORT /END OF STRING? QUOTE DEVQOT-QUOTE SORT /NO - CHECK SPECIAL CHARS DEVLST /([,:,., AND SPACE DEVTAB-DEVLST TAD (-"9+177 /NO, SEE IF A-Z, 0-9 CLL TAD ("9+1-"0 SZL JMP DCDYES TAD ("0-"Z-1 CLL CML TAD CTLZ /=("Z-"A+1 SZL ERR /NO, BOMBED OUT DCDYES, SZL /YES, RESTORE CHAR TAD (57 IAC DCA TEMP TAD NAMCNT TAD (-6 D7700, SMA CLA /MORE THAN 6 CHARS? JMP NAMEC /YES, IGNORE TAD NAMCNT /NO, PACK IT CLL RAR TAD NBASE DCA TEMP1 TAD TEMP SZL JMP .+4 CLL RTL RTL RTL TAD I TEMP1 DCA I TEMP1 ISZ NAMCNT JMP NAMEC PERD, TAD NAME /PERIOD IN STRING SZA CLA ISZ PERDSW /FLIP FLOP ERR /DOUBLE PERIODS OR NO FILE NAME DCA NAME+3 /CLEAR EXTENSION DCA DEVLST+1 /DEVICE NO LONGER LEGAL ISZ NBASE /BUMP POINTER TAD (4 /AND RESET COUNT JMP NAMEC-1 COLON, TAD NAME /DEVICE - MOVE NAME DCA DEVC TAD NAME+1 DCA DEVC+1 JMP NGO-1 /RESET FOR FILE NAME DEVLST, 56 /. 72 /: 40 /SPACE DEVQOT, .+2 .+1 TAD I OPEN /MOVE HANDLER ADDRESS DCA DEVHND ISZ OPEN /AND BUMP POINTER CLA CLL CMA RAL /COMPUTE RESET CODE (=0 FOR INPUT, 1 FOR OUTPUT) TAD CODE DCA RSTSW /RESET SWITCH JMS GETUSR /LOCK USR IN CORE CIF 10 /AND RESET TABLES JMS I USR 13 RSTSW, 0 /DON'T ZAP OPEN FILES ON INPUT CIF 10 JMS I USR 1 /ASSIGN HANDLER DEVC, 0 0 DEVHND, 0 JMP MINCOR /ERROR - KICK USR OUT FIRST TAD (NAME /POINT TO NAME DCA STBLK TAD DEVC+1 /DEVICE # CIF 10 JMS I USR CODE, 0 /ENTER OR LOOKUP TEMP=. STBLK, 0 /FILLED WITH STARTING BLOCK TEMP1=. FLN, 0 /FILLED WITH -LENGTH JMP MINCOR /ERROR TAD DEVHND /HANDLER ADDRESS IN AC JMP I OPEN MINCOR, DCA DISMISS+1 /FIX DISMISS IF NECESSARY JMS DISMISS /KICK USR OUT BEFORE GIVING ERROR ERR PERDSW, 7777 /FLIP FLOP FOR EXTENSION NAMCNT, 0 /CHARACTER COUNT NBASE, NAME /POINTER PAGE
/EAE SUBROUTINES (FOR UNLUCKY PEOPLE) MQACLA, 0 CLA /FAKE CLA MQA TAD MQ JMP I MQACLA /EASY!! MUYMQL, 0 /FAKE MQL MUY DCA MQ DCA MQACLA /FAKE ACCUMULATOR TAD (-15 DCA STPCNT JMP MUYA2 MUYA1, TAD I MUYMQL SNL CLA CML TAD MQACLA CML RAR DCA MQACLA MUYA2, TAD MQ RAR DCA MQ ISZ STPCNT JMP MUYA1 /DO IT AGAIN TAD MQACLA ISZ MUYMQL /BUMP POINTER JMP I MUYMQL /RETURN WITH H.O. PRODUCT DVIMQL, 0 /FAKE MQL DVI DCA MQ DCA MQACLA /FAKE AC TAD I DVIMQL ISZ DVIMQL CIA CLL DCA MUYMQL /DIVISOR TAD (-15 DCA STPCNT JMP DVIA2 DVIA1, TAD MQACLA RAL DCA MQACLA /PARTIAL REMAINDER TAD MQACLA TAD MUYMQL /COMPARE SZL DCA MQACLA /NEW REMAINDER CLA /IN CASE OF SKIP DVIA2, TAD MQ RAL DCA MQ /PARTIAL QUOTIENT ISZ STPCNT JMP DVIA1 /DO IT AGAIN TAD MQACLA /REMAINDER JMP I DVIMQL MQ, 0 /FAKE M-Q REGISTER ENDFIL, TAD WEND /OPEN OUTPUT FILE? SNA CLA ERR /NO, THEN YOU CAN'T CLOSE ONE! DCA WEND /CLEAR FLAG TAD CTLZ /^Z END-OF-FILE OUTPUT TAD OCRCNT /OUTPUT CHARACTER COUNT TAD (200 /=-200 WHEN CLEAR SZA CLA JMP .-4 /FILL BUFFER WITH ZEROS JMS GETUSR /LOCK USR IN TAD [OUHNDL /SETUP POINTERS DCA .+5 TAD ODEV /MAKE SURE THE USR KNOWS THE HANDLER CIF 10 /IS IN CORE ('ER' MIGHT HAVE RESET JMS I USR /THE HANDLER TABLES) 1 OUHNDL /INTO OUTPUT SLOT (NATCH) HLT /HUH? TAD EBFLG /IS THIS AN EDIT BACKUP? SNA CLA JMP NORMAL /NO, JUST CLOSE FILE TAD OCNT-1 /YES, LOOKUP OLD FILE TO CHANGE NAME DCA ENDT TAD ODEV /INPUT AND OUTPUT ARE ON SAME DEVICE CIF 10 JMS I USR 2 STPCNT=. ENDT, OUNAM TY, 0 /USELESS LENGTH--USE IT FOR TEMPORARY JMP NORMAL /ERROR-JUST CLOSE FILE AND DON'T TELL ANYBODY CDF 10 /ALL THAT WAS JUST TO GET THE DIRECTORY IN CORE CLA CLL CMA /SO WE COULD FIDDLE WITH IT TAD I (17 /FORM POINTER TO DIRECTORY ENTRY TAD I (1404 DCA TY TAD (213 /CHANGE EXTENSION TO .BK DCA I TY TAD I (7 /DIRECTORY BLOCK IT CAME FROM AND (7 DCA .+5 CDF JMS I OUTHND 4210 /WRITE IT BACK OUT 1400 0 JMP .-4 /ERROR! KEEP TRYING-THIS CAN BLOW A DIRECTORY NORMAL, TAD ODEV /CLOSE FILE CIF 10 JMS I USR 4 OUNAM OCNT, 0 /NUMBER OF BLOCKS HLT TAD ERR-4400 /RESET OUTPUT SUB POINTER DCA OUTR JMS DISMISS /KICK THE MONITOR OUT POPJ /ALL DONE PAGE $



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search