TITLE SPELL SPELLING CHECK & CORRECTION ;;; Make ITS option reading better, not just first letter ********** ;;; or change documentation: at present, "J" denotes TJ6 ;;; Does ITS allow altmode in command line when not reading JCL? ;;; Fix it or document it. ;;; Originated by R. E. Gorin, 1971 ;;; Revised by W. E. Matson, 1974 ;;; Revised by W. B. Ackerman, 1978 ;;; %ITS = 1 for ITS, 0 for 10X or 20X ;;; %TNX = 1 for 10X or 20X, 0 for ITS ;;; %20X = 1 for 20X only ;;; %VTS = 1 for system (20X only) with virtual terminal stuff (RTCHR & VTSOP) %ITS==0 ? %TNX==1 ? %20X==1 ? %VTS==1 IFE .OSMIDAS-SIXBIT /ITS/,[%ITS==1 ? %TNX==0 ? %20X==0 ? %VTS==0] IFE .OSMIDAS-SIXBIT /TENEX/,[%20X==0 ? %VTS==0] SUBTTL DEFINITIONS ;THESE REGISTERS (AND REGISTER ZERO) ARE GENERAL TEMPORARIES A=1 ;A MUST BE 1 BECAUSE OF IDIVI'S AND LSHC'S B=2 ;B MUST BE A+1 BECAUSE OF LSHC'S C=3 ;TWENEX REQUIRES A, B, C, D AS SHOWN ANYWAY D=4 ;THESE REGISTERS HAVE A QUASI-GLOBAL SIGNIFICANCE AS INDICATED, ;AND MAY NEED TO BE PRESERVED BETWEEN VARIOUS SUBROUTINE CALLS W=5 ;LENGTH OF WORD FROM GETWD X=6 ;BYTE POINTER FROM GETLBP Y=7 ;BYTE POINTER FROM HASHCP ;Y MUST FOLLOW X BECAUSE OF IDIVI'S Z=10 ;POINTER TO DICTIONARY ITEM, FROM SEARCH, INSRTD ;THESE REGISTERS ARE GENERALLY NOT USED BY ANY SUBROUTINES, AND ;MAY BE USED FOR ANY PURPOSE BY THE TOP LEVEL PROGRAM K=11 L=12 M=13 N=14 ;THESE REGISTERS ARE GLOBAL FLAGS=16 ;VARIOUS FLAG BITS, DESCRIBED BELOW P=17 ;PUSHDOWN LIST POINTER NHASH==6760. ;NUMBER OF HASH CHAINS MHASH==11327. ;MULTIPLIER FOR HASHCP (MUST BE .LT. 16384) LPDL==100 ;PDL SIZE (MUST BE AT LEAST 28 TO HANDLE "J" COMMAND) LRBUF==200 ;SIZE OF DISK TRANSFERS WHEN READING MRBUF==20 ;MARGIN AROUND READ POINTER, FOR CONTEXT DISPLAY ;I-O CHANNELS: IFN %ITS,[DKIN==1 ;FILE INPUT CHANNEL DKO1==4 ;FILE OUTPUT CHANNEL ERCHN==5 ;CHANNEL FOR OPENING "ERR" DEVICE TTYI==6 ;TERMINAL INPUT TTYO==7 ;TERMINAL OUTPUT ] DEFINE TYPE ADR MOVEI ADR PUSHJ P,STTYO TERMIN ;RIGHT HALF FLAGS -- THESE ARE KEPT IN FLAGS REGISTER ;MODE BITS ARE ALSO KEPT IN LOCATION "MODE", SO THAT FLAG ;BITS CAN BE TEMPORARILY TURNED OFF WHEN READING A DICTIONARY SPLERR==1 ;WHEN QUERYING: ON IF ACTUAL SPELLING ERROR PRPTFG==2 ;PROPT: USED TO MAKE COMMAS LOOK NICE CANDFG==4 ;WHEN QUERYING: ON IF TRFX1 HAS BEEN CALLED CASERR==10 ;ON IF WORD HAS ANOMALOUS CASE LOW1==20 ;WHEN QUERYING: FIRST LETTER IS LOWER CASE LOW2==40 ;WHEN QUERYING: SECOND LETTER IS LOWER CASE NOCORR==100 ;SUPPRESS FILE OUTPUT TEMPF1==200 ;USED BY DICTIONARY DUMP ROUTINE AND BY EVAL/BVAL ;AND SET/NO FWRITE==400 ;DIRECT OUTPUT OF OUTC TO FILE (INSTEAD OF TTY) SPLOFF==1000 ;ON IF CHECKING HAS BEEN DISABLED BY "SPELLOFF" TFORCE==2000 ;FORCE TYPEOUT EVEN IF READING FROM JCL STRING RDICT==100000 ;ON IF READING DICTIONARY (USED BY GETWD) ;LEFT HALF FLAGS -- THESE ARE KEPT IN FLAGS REGISTER ;MODE BITS ARE ALSO KEPT IN LOCATION "MODE", SO THAT FLAG ;BITS CAN BE TEMPORARILY TURNED OFF WHEN READING A DICTIONARY TMODE==400 ;IN "TEX" JUSTIFIER MODE JMODE==1000 ;IN "TJ6" JUSTIFIER MODE RMODE==2000 ;IN "R" JUSTIFIER MODE PMODE==4000 ;IN "PUB" JUSTIFIER MODE SMODE==10000 ;IN "SCRIBE" JUSTIFIER MODE DMODE==20000 ;CONTEXT DISPLAY IS ON LMODE==40000 ;LISTING OF CLOSE WORDS IS ON CMODE==100000 ;CHECK CAPITALIZATION ; WORD FORMAT ;WORDS ARE USUALLY STORED IN WORDIX IN ASCII (5 PER MACHINE WORD) ;AND/OR IN WORDIN IN "5BIT" FORMAT (7 PER MACHINE WORD). ;WORDIX AND WORDIN ARE PADDED WITH ZERO AT THE END. ;REGISTER W GENERALLY CONTAINS THE NUMBER OF LETTERS. ;THEY MUST NEVER EXCEED 42 LETTERS, SINCE INSRTD REQUIRES A FULL ;MACHINE WORD OF ZERO AT THE END, AND WORDIN IS ALLOCATED AS 7 ;MACHINE WORDS. SINCE TRFIX MAY LENGTHEN IT BY ONE, NO WORD ;LONGER THAN 41 LETTERS MAY EVER BE READ IN. ;THE 5BIT CODES ARE UPPERCASE ASCII MINUS 75, OR A=4 ... Z=35 OCTAL. ;APOSTROPHE IS 36 OCTAL. THE REASON FOR MAKING THEM START AT 4 ;IS SO THAT EVERY NONEMPTY BYTE IS NONZERO IN THE LEFTMOST 3 ;BITS (AS OPPOSED TO THE LEFTMOST 5). SUBTTL VARIABLES AND TABLES WORDIN: BLOCK 7 ;WORD IN 5BIT (WITH FULL WORD OF ZERO AT END) WORDIX: BLOCK 11. ;WORD IN ASCII, MUST FOLLOW WORDIN!! WWLEN: BLOCK 1 DCTVER: BLOCK 2-%ITS ;VERSION OF LOADED DICTIONARY STTYA: BLOCK 1 ;USED BY STTYO RWSWT: BLOCK 1 ;USED BY OPENR/OPENW/CFFLSW FLSWSW: BLOCK 1 ;USED BY OPENR/OPENW/CFFLSW SAVCHR: BLOCK 1 ;SAVED CHAR IN GETWD (IF IT PEEKS AFTER APOSTROPHE) BRKCHR: BLOCK 1 ;BREAK CHAR IN GETWD (ALSO USED TO TELL IF AT ; BEGINNING OF LINE) TRMCHR: BLOCK 1 ;COMMENT TERMINATING CHAR IN GETWD PURE: 0 ;NONZERO IF PROGRAM IS PURE (I. E. MUST NOT ALTER ; EXISTING DICTIONARY ENTRIES) NWORDS: 0 ;COUNT OF WORDS DURING CORRECTION FIRSTL: 0 ;FIRST LINE TO CHECK MODE: RMODE+DMODE+LMODE,,0 ;CURRENT MODE, COPIED INTO FLAGS AT START OF COMMAND JCLFLG: BLOCK 1 ;CONTROLS JCL READING -- ON ITS THIS IS THE ACTUAL ; SCAN POINTER, ON TNX JUST A FLAG. ON EITHER ; SYSTEM NONZERO HERE MEANS THERE IS ANOTHER COMMAND ; FROM JCL AND CERTAIN PRINTOUTS SHOULD BE AVOIDED LWCASE: BLOCK 1 ;NONZERO IF TERMINAL HAS LOWERCASE ABILITY DICTNN: 0 ;NUMBER OF ENTRIES IN DICTIONARIES FLAGNN: 0 ;NUMBER OF FLAGS IN DICTIONARIES PDL: BLOCK LPDL ;HERE FOR THE INIT PDL HASHTB: BLOCK NHASH/2 ;HASH CHAIN HEADER TABLE LISTFF: DICTIO ;END OF DICTIONARY MEMTOP: 0 ;END OF AVAILABLE MEMORY (ALWAYS MULTIPLE OF 2000) IFN %ITS,[ DSPTTY: BLOCK 1 ;NONZERO IF THIS IS A DISPLAY TOPEND: BLOCK 1 ;NONZERO IF TTY HAS BEEN OPENED VPSTF: ASCIZ /V?H/ ;STUFF FOR VERTICAL CURSOR POSITIONING FNML: BLOCK 3 ;LIST OF FILE NAMES DEVICE: BLOCK 1 SNAME: BLOCK 1 ;DEFAULT SNAME TTIPTR: BLOCK 1 ;FOR READING COMMAND BUFFER CMDBFL=40. ;SIZE OF COMMAND BUFFER CMDBUF: BLOCK CMDBFL ;BUFFER FOR COMMAND LINE JCLBUF: BLOCK 100 ;BUFFER FOR JCL LINE JCLBFE=.-1 DUMPBF: BLOCK 10 ;WHERE TO PUT "PDUMP" STRING JNUM: BLOCK 1 JNAME: BLOCK 1 JOBFF: BLOCK 1 ] IFN %TNX,[ OLDMOD: BLOCK 1 ;SAVED TTY STATE TCHAR: BLOCK 1 ;TERMINAL CHARACTERISTICS WORD FOR VTS USAGE INJFN: BLOCK 1 OUTJFN: BLOCK 1 LTCTYP: BLOCK 1 LINOPN: BLOCK 1 ;NEGATIVE WHEN THE COMMAND LINE IS OPEN. ; ZERO WHEN CLOSED AFTER READING A LINE --> ; CLEAR JCLFLG. +1 INITIALLY --> LINE IS NOT ; OPEN, BUT DON'T CLEAR JCLFLG COMMIT: BLOCK 1 ;NONZERO WHEN THE COMMAND HAS BEEN ACTED ON BSAVE: BLOCK 1 ;SAVED FUNCTION BLOCK DURING COMND NOPNFG: BLOCK 1 ;NONZERO FOR "SAVE" COMMAND, SO IT WON'T ; OPEN THE FILE (IT DOES AN SSAVE ON THE UNOPENED JFN) ;; FUNCTION BLOCK FOR "CONFIRMING" -- WHEN NOT READING FROM JCL IT IS AS ;; SHOWN, OTHERWISE CMMBLK IS LINKED IN TO ALLOW COMMA CFMBLK: .CMCFM_27. ? 0 ? 0 ? 0 ;CARRIAGE RETURN CMMBLK: .CMCMA_27. ? 0 ? 0 ? 0 ;COMMA ;; FUNCTION BLOCK FOR "NOISE WORD" -- TEXT POINTER GETS STORED ;; IN RIGHT HALF OF NZBLK+1 NZBLK: .CMNOI_27. ? -1,,0 ? 0 ? 0 ;; STATE BLOCK FOR READING COMMANDS STBLK: 0,,0 ;CMFLG .PRIIN,,.PRIOUT ;CMIOJ, GETS MODIFIED IF READING FROM JCL -1,,[ASCIZ /SPELL -> /] ;CMRTY -1,,BFR ;CMBFP -1,,BFR ;CMPTR 149. ;CMCNT 0 ;CMINC -1,,ABP ;CMABP 99. ;CMABC GJBLK ;CMGJB GJBLK: BLOCK 16 ;AUXILIARY FUNCTION BLOCK FOR GTJFN ; WHEN PARSING FILE NAMES BFR: BLOCK 30. ABP: BLOCK 20. TTLARG: 7 ;BLOCK FOR "TEXTI" IN TYPLIN RD%BEL+RD%CRF+RD%JFN ;BREAK ON CR, LF, OR STUFF IN TABLE, ; PACK ONLY ^J IN BUFFER, NOT ^M ;LOWER BITS OF THIS WORD GET MODIFIED! .PRIIN,,.PRIOU ;JFNS TO USE 0 ;PACKING POINTER IN WORDIX, GETS MODIFIED 0 ;CHARACTER COUNT, GETS MODIFIED 440700,,WORDIX ;BEGINNING OF AREA TO PACK 0 ;(.CMRTY) ^R BUFFER, GETS FILLED WITH PROMPT .+1 ;BREAK CHARACTER TABLE 2220,,0 ;^G, LF, CR 20 ;? 0 0 ;TABLE OF DATA FOR ABSOLUTE CURSOR POSITIONING ;BEWARE -- THE "_" CHARACTERS ARE MODIFIED HPVP: ASCIZ /&a__r0C/ ;HP VT52VP: ASCIZ /Y_ / ;VT52 VTCVP: ASCIZ /[__;H/ ;VT100/ANN-ARBOR BALANCE ] IMLVP: ASCIZ /‘_/ ;IMLAC ] FLGTST: BLOCK 1 ; (PRIVATE TO WTEST/TESTFX) NEEDED FLAG TWRDX: BLOCK 7 ; (PRIVATE TO WTEST/TESTFX) SAVED WORDIN TWWSV: BLOCK 1 ; (PRIVATE TO WTEST/TESTFX) SAVED W TFFLG: BLOCK 1 ; (PRIVATE TO WTEST/TESTFX) FLAG BIT FOR FAILING WTEST TFPTR: BLOCK 1 ; (PRIVATE TO WTEST/TESTFX) WHERE THAT FLAG IS NEEDED SVWDWX: BLOCK 18. ; USED BY TRFX1, CORRE, AND EVAL/EVALB SVWDLN: BLOCK 1 ; SAME CANDS: BLOCK 1 ;NUMBER OF CANDIDATES IN CANDBF CNDPTL: BLOCK 11. ;LIST OF POINTERS INTO CANDBF (1 MORE THAN ;MAX NUMBER OF CANDIDATES) CANDID: BLOCK 1 CANDBF: BLOCK 25. ;HOLDS "CANDIDATES" (WORDS NEAR THE SUBJECT WORD) TLET.1: BLOCK 1 X1BYPT: BLOCK 1 SAVEXS: BLOCK 1 TLET.2: BLOCK 1 LINENO: BLOCK 1 IDNUM: BLOCK 1 ;2 * DICTIONARY NUMBER + 1 IF NONZERO, ELSE ZERO ;THESE ARE USED FOR READING AND WRITING FILES RDABF: BLOCK LRBUF+2*MRBUF+1 ;FILE INPUT BUFFER RBUFF=RDABF+2*MRBUF ;WHERE THE DISK TRANSFER ACTUALLY TAKES PLACE RSVLOC=RDABF+LRBUF+MRBUF ;WHEN READ POINTER GETS HERE, TIME TO GET ;ANOTHER BLOCK FROM DISK RDEPT: BLOCK 1 ;END OF CURRENT INPUT BUFFER RDAPT: BLOCK 1 ;BYTE POINTER FOR READING FILES RSVWD: BLOCK 1 ;SAVED WORD FROM RSVLOC RDLOP1: BLOCK 1 ;FIRST LOWER BUFFER LIMIT FOR CONTEXT DISPLAY RDLOP2: BLOCK 1 ;SECOND LOWER LIMIT (THE REAL ONE) WBUF1: BLOCK 200 ;OUTPUT BUFFER WPTR1: BLOCK 1 ;OUTPUT POINTER WCOUNT: BLOCK 1 ;NEGATIVE OUTPUT CHARACTER COUNT ; (ONLY TNX USES IT) PURBEG: ;START OF PURE AREA SUBTTL INITIALIZATION ;*** SHOULD CLEAR LOTS OF VARIABLES (BUT NOT "MODE") BEGIN: MOVE P,[-LPDL,,PDL-1] TRZ FLAGS,FWRITE+TFORCE ;SEND OUTPUT TO TERMINAL, UNLESS JCL PUSHJ P,SETUP ;INITIALIZE THINGS, PRINT VERSION ;FIRST, SET UP SOME THINGS USED BY MANY OPERATIONS TBLURB: MOVE [010700,,RBUFF+LRBUF-1] ;INITIALIZE STUFF FOR FILE READ MOVEM RDAPT SETZM RDEPT MOVE [010700,,RBUFF-1] MOVEM RDLOP1 ;WILL GO INTO RDLOP2, WHICH IS ;LOWER LIMIT FOR CONTEXT DISPLAY SETOM SAVCHR ;IF .GE. 0, TELLS GETWD IT HAS A SAVED CHAR MOVEI ^J ;LAST CHAR RETURNED BY GETWD MOVEM BRKCHR ; (TO LOOK FOR POINT AT LEFT MARGIN) SETZM RBUFF+LRBUF ;PUT PAD (^@) AT END OF READ BUFFER SETZM LINENO MOVE [010700,,WBUF1-1] ;INITIALIZE STUFF FOR FILE WRITE MOVEM WPTR1 ;INITIALIZE POINTER SETZM WCOUNT ;NEGATIVE BYTE COUNT TRZ FLAGS,RDICT+NOCORR+FWRITE+TFORCE ;CLEAR VARIOUS FLAGS HLL FLAGS,MODE ;LOAD THE OPTIONS MOVEI 3 MOVEM IDNUM ;SET DEFAULT DICT NUM = 1 FOR T, L, I COMMANDS SETZM FIRSTL ;WON'T START CHECKING UNTIL REACH THIS LINE JRST GETCMD ;SEE "COMMAND PARSING ROUTINES" SUBTTL SET, CLEAR OPTIONS MODSET: PUSHJ P,OPTPRS ;SET AN OPTION PUSHJ P,CONFRM HLLZ (D) ;GET BITS TO CLEAR ANDCAM MODE ;CLEAR ENTIRE FIELD (IF FORMATTER MODE, ANDCAM FLAGS ; CLEAR OTHER FORMATTER MODES) HRLZ (D) ;NOW GET BIT TO SET IORM MODE IORM FLAGS JRST ENDCMD MODCLR: PUSHJ P,OPTPRS ;CLEAR AN OPTION PUSHJ P,CONFRM HRLZ (D) ;GET BIT TO CLEAR ANDCAM MODE ANDCAM FLAGS JRST ENDCMD SUBTTL THE CORRECTION ROUTINE ITSCOR: IFN %TNX,[ PUSHJ P,OPREXT ;OPEN INPUT FILE WITH APPROPRIATE DEFAULT ; EXTENSION MOVEI Z,[ASCIZ /to corrected output file/] PUSHJ P,NOISE ] IFN %ITS,[ PUSHJ P,OPENR ] PUSHJ P,CFFLSW ;LOOK FOR OUTPUT FILE, SWITCH, OR NOTHING JRST ITSCRF ;GOT A FILE ;GOT SWITCH OR NOTHING, DISABLE WRITING TYPE [[ASCIZ /Warning: no correction file will be written. /]] TROA FLAGS,NOCORR ITSCRF: PUSHJ P,CFSWIT ;LOOK FOR SWITCH OR NOTHING JUMPE C,ITSCR1 ;JUMP IF NO SWITCH PUSHJ P,NUMLIN ;SWITCH MUST BE "LINE", LOOK FOR NUMBER MOVEM B,FIRSTL PUSHJ P,CONFRM ITSCR1: TYPE [[ASCIZ /You people never letta program sleep. /]] TRZ FLAGS,SPLOFF ;WILL GO ON IF SEE "SPELLOFF" SETZM NWORDS CORLOP: PUSHJ P,GETWD JUMPE W,CORCLO ;END OF INPUT FILE MOVE LINENO CAML FIRSTL ;SKIP IF HAVEN'T REACHED STARTING LINE TRNE FLAGS,SPLOFF ;ARE WE CHECKING? JRST CORLO2 ;NO AOS NWORDS ;COUNT WORDS CORLO7: PUSHJ P,WTEST JRST CORLO5 ;FOUND IT DIRECTLY JRST CORLO5 ;FOUND IT INDIRECTLY TRO FLAGS,SPLERR ;WORD IS UNKNOWN JRST CORERR CORLO5: TRZ FLAGS,SPLERR ;WORD IS SPELLED CORRECTLY TLNE FLAGS,CMODE ;CHECKING CAPITALIZATION? TRNN FLAGS,CASERR ;AND WORD IS IN ERROR? JRST CORLO2 ;ERRONEOUS WORD ENCOUNTERED, QUERY THE USER ABOUT IT ;MAY HAVE SPELLING OR CAPITALIZATION ERROR OR BOTH CORERR: TRZ FLAGS,CANDFG+FWRITE ;INITIALIZE SOME FLAGS TRO FLAGS,TFORCE ;REALLY PRINT THE STUFF, EVEN IF IN JCL ;CANDFG WILL BE ON WHEN TRFX1 HAS BEEN CALLED. ITS PURPOSE ; IS TO ALLOW THE "L" OPTION TO BE TURNED ON, BUT AVOID ; CALLING TRFX1 TWICE (TRFX1 IS VERY EXPENSIVE) MOVEM W,SVWDLN ;SAVE WORD LENGTH MOVE [WORDIN,,SVWDWX] BLT SVWDWX+17. ;AND WORDIN AND WORDIX ;THE OFFENDING WORD IS NOW IN SVWDWX ( = OLD WORDIN, WORDIX) ; AND SVWDLN ( = OLD W) SETZM CANDS ;NUMBER OF CANDIDATES FOUND ;DISPLAY THE VARIOUS THINGS REDISP: PUSHJ P,CLEARS ;CLEAR SCREEN TRNE FLAGS,SPLERR ;WORD MISSPELLED TLNN FLAGS,LMODE ;AND LOOKING FOR CANDIDATES? JRST .+3 ;NO TRON FLAGS,CANDFG ;SEE IF ALREADY LOOKED PUSHJ P,TRFX1 ;IF NOT, FIND ALL CANDIDATES TYPE [[ASCIZ / /]] ;THREE SPACES TO LINE UP WITH CANDIDATES TYPE WORDIX-WORDIN+SVWDWX ;DISPLAY THE OFFENDING WORD TRNE FLAGS,SPLERR JRST REDIS2 ;SPELLING ERROR, DISPLAY CANDIDATES TYPE [[ASCIZ / : Incorrect capitalization only/]] JRST CORLOE REDIS2: TRNN FLAGS,CASERR JRST REDIS3 TYPE [[ASCIZ / (Incorrect capitalization)/]] REDIS3: PUSHJ P,OUTCR ;NEED THIS IF ON A PRINTING TERMINAL TLNN FLAGS,LMODE ;DISPLAYING CANDIDATES? JRST CORLOE PUSHJ P,VPOS ? 3 ;GO TO LINE 3 SETZ C, DISLOP: CAML C,CANDS JRST CORLOE MOVE C ;GET INDEX OF CANDIDATE ADDI "0 ;CONVERT TO DIGIT PUSHJ P,OUTC ;PRINT IT TYPE [[ASCIZ / /]] ;TWO SPACES MOVE A,CNDPTL(C) ;POINTER TO WORD IN CANDBF PUSHJ P,OUT5 ;DISPLAY THE WORD PUSHJ P,OUTCR AOJA C,DISLOP CORLOE: TLNN FLAGS,DMODE ;SKIP IF CONTEXT DISPLAY OPTION ON JRST CORLO0 PUSHJ P,VPOS ? 16. ;GO TO LINE 16 TYPE [[ASCIZ /Line /]] MOVE LINENO PUSHJ P,DECPTR TYPE [[ASCIZ /: /]] PUSHJ P,DISLIN ;DISPLAY CONTEXT CORLO0: MOVE [SVWDWX,,WORDIN] ;RESTORE THINGS BLT WORDIN+17. MOVE W,SVWDLN PUSHJ P,VPOS ? 22. ;GO TO LINE 22 PUSHJ P,CLEARL TYPE [[ASCIZ /==> /]] ;NOW WORDIN, WORDIX, W = OFFENDING WORD FROM FILE ;SVWDWX, SVWDLN = SAME ;LOW1, LOW2 (FLAGS) = CASE INFO FROM FILE ;CANDFG ON IF TRFX1 HAS BEEN CALLED ;CANDS = NUMBER OF CANDIDATES (ZERO IF "L" OPTION OFF) ;CNDPTL = POINTERS TO CANDIDATES ;CANDBF = THE CANDIDATES, IN 5BIT ;FWRITE = 0, TFORCE = 1 (OUTPUT TO TERMINAL EVEN IF JCL) ;SCREEN HAS ;WORDIX AT TOP ;CANDIDATES (IF ANY) ;LINE NUMBER FROM TEXT FILE ;UP TO 3 LINES OF CONTEXT ;PROMPTING ARROW AT BOTTOM CORRED: PUSHJ P,TTYIN CAIN A,^G JRST CORCG ;^G : ABORT THE ENTIRE OPERATION CAIN A,"? JRST CORQUE ;? : PRINT BRIEF DIRECTIONS CAIN A,^L JRST REDISP ;^L : REDISPLAY EVERYTHING CAIGE A,"0 JRST .+3 CAIG A,"9 JRST CORN ;DIGIT : SUBSTITUTE INDICATED CHOICE CAIE A,"+ CAIN A,"- JRST COROPT ;+ OR + : SET OPTION CAIN A,40 JRST CORLO2 ;SPACE : ACCEPT THE WORD TRZ A,40 ;LOOKING FOR LETTERS NOW: CAIN A,"A ; CONVERT TO UPPER CASE JRST CORLO2 ;A : ACCEPT THE WORD CAIN A,"I JRST CORI ;I : INSERT IN DICTIONARY #1 CAIN A,"D JRST CORD ;D : INSERT IN INDICATED DICTIONARY CAIN A,"R JRST CORRE ;R : RETYPE THE WORD CAIN A,"W JRST CORX ;W : COPY REST OF THE FILE CORHUH: TYPE [[ASCIZ / HUH?? /]] JRST CORRED CORNCO: TYPE [[ASCIZ / Output not being written!! /]] JRST CORRED CORQUE: PUSHJ P,CLEARS TYPE LBLURB ;PRINT SHORT DIRECTIONS TYPE PRPLST ;AND LAST PART OF SAME PUSHJ P,PROPT ;PRINT CURRENT OPTIONS TYPE [[ASCIZ / Type any character to restore the display /]] PUSHJ P,TTYIN JRST REDISP CORLO2: PUSHJ P,PUTWD JRST CORLOP CORCG: PUSHJ P,CLEARS TYPE [[ASCIZ /Do you wish to end this correction right now? /]] PUSHJ P,TTYIN TRZ A,40 CAIN A,"Y JRST CORCLO ;YES, END IT JRST REDISP ;READ OPTION LETTER AND PROCESS IT, PUTTING RESULT BOTH IN "MODE" ; AND IN "FLAGS". COROPT: MOVEM A,C ;REMEMBER WHETHER IT WAS + OR - PUSHJ P,TTYIN ;GET OPTION NAME TRZ A,40 ;CONVERT TO UPPER CASE MOVNI B,MTABE-MTAB CAME A,MTABE-MTAB(B)+MTABE AOJL B,.-1 ;SEARCH JUMPGE B,CORHUH ;NOT THERE CAIE C,"+ JRST ROPT1 HLLZ MTABE(B) ;COMMAND WAS "+", GET BITS TO CLEAR ANDCAM MODE ;CLEAR ENTIRE FIELD (E.G. IF "+T", CLEAR ANDCAM FLAGS ;T, R, P, AND X HRLZ MTABE(B) ;NOW GET BIT TO SET IORM MODE IORM FLAGS JRST REDISP ;REDISPLAY, MAYBE DIFFERENTLY THIS TIME ROPT1: HRLZ MTABE(B) ;COMMAND WAS "-", GET BIT TO CLEAR ANDCAM MODE ANDCAM FLAGS JRST REDISP ;REDISPLAY, MAYBE DIFFERENTLY THIS TIME CORX: TRNE FLAGS,NOCORR JRST CORCLO ;DONE WITH CORRECTING TYPE [[ASCIZ / Copying .../]] PUSHJ P,PUTWD ;WRITE OUTPUT WORD PUSHJ P,GETWD ;READ INPUT WORD JUMPE W,CORCLO ;EOF HERE JRST .-3 ;ACCEPT WORD AND INSERT IN INDICATED DICTIONARY CORD: PUSHJ P,TTYIN ;READ DICTIONARY NUMBER CAIL A,"0 CAILE A,"9 JRST CORHUH ;NOT A DIGIT SUBI A,"0 ;GET ACTUAL NUMBER SKIPA CORI: MOVEI A,1 ;INSERT IN DICTIONARY 1 LSH A,1 ;CONVERT DICT NUM TO 2N+1 FORMAT SKIPE A AOS A ;UNLESS ZERO MOVEM A,IDNUM ;THIS IS THE FORMAT INSRTD WANTS PUSHJ P,HASHCP PUSHJ P,INSRTD JRST CORLO2 ;ACCEPT THE WORD CORRE: TRNE FLAGS,NOCORR JRST CORNCO ;NOT WRITING OUTPUT, THIS MAKES NO SENSE PUSHJ P,VPOS 3 ;GO TO LINE 3 PUSHJ P,CLEARF ;CLEAR REST OF SCREEN MOVEI Z,[ASCIZ /Type word -> /] PUSHJ P,TYPLIN JRST REDISP ;HE DIDN'T WANT TO RETYPE AFTER ALL SKIPN WORDIX JRST REDISP ;NULL LINE ;NOW WORDIX HAS NEW WORD, IN ASCII. IT MUST BE COPIED INTO WORDIN ; (TO BE RECHECKED) AND ITS CAPITALIZATION IN WORDIX MUST BE FORCED ; TO AGREE WITH THAT OF THE ORIGINAL WORD IF LWCASE IS OFF. ;TEMPF1 WILL BE SET IF THE COPYING INTO WORDIN FAILED AND HENCE THE ; WORD SHOULD NOT BE RECHECKED. MOVE B,[440700,,WORDIX] MOVE C,[440500,,WORDIN] TRZ FLAGS,TEMPF1 ;WILL BE SET IF THERE IS A NON-LETTER LOP2: ILDB B ;GET A LETTER JUMPE CORRE2 ;DONE CAIN "' MOVEI "Z+1 TRZ 740 ;IGNORE CASE ADDI 3 IDPB C ;PACK FIVEBIT INTO WORDIN (JUNK IF NOT LETTER) AOJA W,.+1 ;COUNT IT LDB B ;GET IT AGAIN SKIPN LWCASE CAIN "' JRST LOP2 ;DON'T FIX CAPITALIZATION TRZ 40 ;MAKE UPPER CAIG "Z ;IS IT REALLY A LETTER? CAIGE "A JRST LOP4 ;DON'T CHANGE CASE OF NON-LETTERS CAME B,[350700,,WORDIX] JRST .+4 TRNE FLAGS,LOW1 ;FIRST TIME TRO 40 ;CHANGE TO LOWER JRST LOP3 TRNE FLAGS,LOW2 TRO 40 LOP3: DPB B ;PUT IT BACK JRST LOP2 LOP4: TRO FLAGS,TEMPF1 ;THIS FLAG MEANS THAT THERE IS A NON-LETTER ; AND HENCE THAT WORDIN HAS GARBAGE JRST LOP2 CORRE2: TRNE FLAGS,TEMPF1 ;WAS THE RETYPED STUFF AN ACCEPTABLE WORD? JRST CORLO2 ;NO, JUST PUT IT INTO THE TEXT AND PROCEED TRZ FLAGS,CASERR ;YES, TEST IT AGAIN JRST CORLO7 CORCLO: PUSHJ P,CLEARS MOVE NWORDS PUSHJ P,DECPTR TYPE [[ASCIZ / words processed./]] TRNN FLAGS,NOCORR ;ARE WE WRITING OUTPUT? PUSHJ P,CLOSW ;YES, CLOSE IT JRST CLOR ;CLOSE INPUT ;DIGIT - SUBSTITUTE INDICATED WORD CORN: TRNE FLAGS,NOCORR JRST CORNCO ;NOT WRITING OUTPUT, THIS MAKES NO SENSE SUBI A,"0 ;GET ACTUAL NUMBER TLNE FLAGS,LMODE ;DISPLAYING CANDIDATES? CAML A,CANDS JRST CORHUH ;NO, OR NUMBER TOO BIG MOVE B,CNDPTL(A) ;GET ADDRESS OF CHOSEN CANDIDATE HRLI B,440500 ;BYTE POINTER TO CHOICE MOVE X,[440700,,WORDIX] ;NOW B POINTS TO NEW WORD IN 5BIT, ITS CASE MUST BE FIXED UP ; AND COPIED INTO WORDIX IN ASCII ILDB B ADDI 75 ;CONVERT TO ASCII (CAN'T BE APOSTROPHE) TRNE FLAGS,LOW1 TRO 40 ;MAKE LOWER CASE ALWNLP: IDPB X ILDB B JUMPE [IDPB X ? JRST CORLO2] ADDI 75 ;CONVERT TO ASCII CAIN "Z+1 MOVEI "' ;SUBSEQUENT "TRO 40" WON'T AFFECT THIS TRNE FLAGS,LOW2 TRO 40 JRST ALWNLP SUBTTL THE TRAINING ROUTINE ITSTRN: IFN %TNX,[ PUSHJ P,OPREXT ;OPEN INPUT FILE WITH APPROPRIATE DEFAULT ; EXTENSION HRROI [ASCIZ /EXC/] ;BUT USE "EXC" AS DEFAULT EXTENSION MOVEM GJBLK+.GJEXT ; INSTEAD OF WHAT IS RETURNED BY OPREXT MOVEI Z,[ASCIZ /to exceptions file/] ] IFN %ITS,[ PUSHJ P,OPENR ] PUSHJ P,OPENW PUSHJ P,CONFRM TYPE MSGWRK TRZ FLAGS,SPLOFF ;WILL GO ON IF SEE "SPELLOFF" SETZM NWORDS TRNLOP: TRO FLAGS,NOCORR+FWRITE ;OUTPUT TO FILE, BUT SUPPRESS IT WHILE CALLING GETWD ;SO GETWD WON'T COPY IT PUSHJ P,GETWD JUMPE W,TRNCLO ;END OF INPUT TRNE FLAGS,SPLOFF ;ARE WE CHECKING? JRST TRNLOP ;NO AOS NWORDS ;COUNT WORDS PUSHJ P,WTEST JRST TRNLOP ;FOUND IT JRST TRNLOP TRZ FLAGS,NOCORR ;TURN FILE OUTPUT BACK ON PUSHJ P,HASHCP PUSHJ P,INSRTD ;REMEMBER THE WORD MOVEI A,WORDIN ;POINTER TO THE 5BIT TEXT PUSHJ P,OUT5 ;WRITE IT PUSHJ P,OUTCR JRST TRNLOP TRNCLO: TRZ FLAGS,NOCORR+FWRITE ;SO THAT NUMBER GETS PRINTED MOVE NWORDS PUSHJ P,DECPTR TYPE [[ASCIZ / words processed./]] PUSHJ P,CLOSW ;CLOSE FILES CLOR: PUSHJ P,CLOSR JRST ENDCMD SUBTTL THE DICTIONARY LOADER. NLOAD: TRO FLAGS,RDICT+NOCORR ;TO NOTIFY GETWD IFN %TNX,[ MOVEI Z,[ASCIZ /dictionary file/] HRROI [ASCIZ /DCT/] MOVEM GJBLK+.GJEXT ] PUSHJ P,CFMFIL ;LOOK FOR INPUT FILE OR NOTHING JUMPE C,LODEND+1 ;NO FILE, JUST PRINT TOTALS MOVEI Z,[ASCIZ /to dictionary number/] PUSHJ P,NOISE PUSHJ P,CFMNUM ;LOOK FOR NUMBER OR END OF LINE JUMPE C,NLOAD0 ;NO NUMBER LSH B,1 ;CONVERT DICT NUM TO 2N+1 FORMAT SKIPE B AOS B ;UNLESS ZERO ;;; ***** SHOULD CHECK FOR NUMBER < 10 MOVEM B,IDNUM PUSHJ P,CONFRM NLOAD0: TYPE MSGWRK LOAD2: PUSHJ P,GETWD ;READ ONE WORD JUMPE W,LODEND ;END OF FILE MOVE [WORDIN,,SVWDWX] BLT SVWDWX+6 ;SAVE WORDIN IN CASE OF ERROR CAIGE W,2 JRST LOAD2 ;SINGLE LETTER (MAYBE FLAG LEFT AFTER ERROR) MOVE BRKCHR ;ARE THERE DICTIONARY FLAGS? CAIN "/ JRST LOAD3 ;YES, LOAD THE WORD DIRECTLY PUSHJ P,WTEST ;NO, TRY TO OPTIMIZE IT JRST LOAD2 ;ALREADY KNOWN JRST LOAD2 ;ALREADY KNOWN SKIPE IDNUM ;IF NOT GOING TO DICT ZERO, DON'T CALL TESTFX JRST LOAD3 ; SINCE TESTFX PUTS IT IN DICT ZERO PUSHJ P,TESTFX ;TRY TO SET FLAGS JRST LOAD3 ;NO LUCK, MUST CREATE AN ENTRY JRST LOAD2 ;DONE, WORD IS FLAGGED LOAD3: PUSHJ P,SEARCH JRST .+2 PUSHJ P,INSRTD LOAD4: MOVE BRKCHR CAIE "/ ;LOOK FOR FLAG LETTERS JRST LOAD2 ;NO PUSHJ P,GETWD ;YES, READ IT JUMPE W,LODEND ;END OF FILE MOVE WORDIX ;THIS "WORD" IS THE FLAG LETTER ROT -29. TRZ 40 ;CONVERT TO UPPER CASE HRLZI A,FVTAB-FNTAB CAMN FNTAB(A) ;LOOK IT UP JRST LODFFL ;FOUND THE FLAG AOBJN A,.-2 TYPE [[ASCIZ /BAD FLAG: "/]] JRST LODERR LODFFL: HRLZ B,FVTAB(A) ;GET PATTERN FOR DESIRED FLAG HLLZ (Z) ;GET EXISTING FLAGS FOR THIS WORD SKIPN PURE ;IS PROGRAM PURE? TLNE 1 ; OR DICTNUM BIT ON? JRST LODNF ;YES, CAN'T SET FLAGS AND FVTAB(A) ;CHECK AGAINST MASK FOR DESIRED FIELD JUMPN LODAMB ;ALREADY A PATTERN IN THIS FIELD IORM B,(Z) ;PUT IN THE NEW FLAG AOS FLAGNN ;COUNT IT JRST LOAD4 LODAMB: CAMN B ;SEE IF THE RIGHT FLAG IS ALREADY IN JRST LOAD4 ;OK, DO NOTHING TYPE [[ASCIZ /INCONSISTENT FLAG: "/]] LODERR: MOVEI A,WORDIN PUSHJ P,OUT5 TYPE [[ASCIZ /" FOR WORD "/]] MOVEI A,SVWDWX PUSHJ P,OUT5 TYPE [[ASCIZ /" /]] JRST LOAD2 ;THERE MAY BE MORE FLAGS FOR THIS WORD, ; THEY WILL BE IGNORED LODNF: TYPE [[ASCIZ /FLAG NOT ALLOWED: "/]] JRST LODERR LODEND: PUSHJ P,CLOSR ;CLOSE INPUT FILE JRST HLPEND ;PRINT DICTIONARY SIZE SUBTTL DUMP ROUTINE NDUMP: IFN %TNX,[ MOVEI Z,[ASCIZ /to dictionary file/] HRROI [ASCIZ /DCT/] MOVEM GJBLK+.GJEXT ] PUSHJ P,OPENW ;OUTPUT CHANNEL MOVEI Z,[ASCIZ /from dictionary number/] PUSHJ P,NOISE PUSHJ P,CFMNUM ;LOOK FOR NUMBER OR END OF LINE JUMPE C,NDUMP0 ;NO NUMBER GIVEN LSH B,1 ;CONVERT DICT NUM TO 2N+1 FORMAT SKIPE B AOS B ;UNLESS ZERO MOVEM B,IDNUM NDUMP1: PUSHJ P,CONFRM NDUMP0: TYPE MSGWRK TRO FLAGS,FWRITE ;DIRECT OUTPUT TO FILE TRZ FLAGS,NOCORR ;BE SURE OUTPUT GETS WRITTEN MOVEI Z,NHASH ;NUMBER OF CHAINS MOVE Y,[442200,,HASHTB] ;BYTE POINTER TO HEADER TABLE DODMP1: ILDB X,Y ;GET HEADER TO CHAIN CHASED: JUMPE X,DODMP2 ;END OF CHAIN MOVE K,X ;REMEMBER THE LINK AHEAD HLRZ A,(X) ;GET DICTNUM STUFF FOR ENTRY TRNN A,1 ;CHECK DICTNUM BIT SETZ A, ;IF OFF, SET TO ZERO CAME A,IDNUM JRST CHAS.2 ;SKIP THIS WORD CHAS.1: MOVE A,X ;*** FIX THIS (IS IT OPTIMAL?) AOS A ;POINT TO TEXT PART PUSHJ P,OUT5 ;WRITE IT HLRZ A,(X) TRNN A,1 ;DICTNUM BIT ON? PUSHJ P,WFLAGS ;WRITE THE FLAGS ONLY IF BIT OFF MOVEI 15 PUSHJ P,OUTC MOVEI 12 PUSHJ P,OUTC CHAS.2: HRRZ X,(K) ;LINK ONWARDS JRST CHASED DODMP2: SOJG Z,DODMP1 ;LOOP PUSHJ P,CLOSW JRST ENDCMD SUBTTL "A" AND "B" - ASK FOR SINGLE WORD EVALB: TROA FLAGS,TEMPF1 ;"B" - PUT RESULT IN FILE EVAL: TRZ FLAGS,TEMPF1 ;"A" - RESULT TO TERMINAL TRZ FLAGS,FWRITE+NOCORR ;OUTPUT TO TERMINAL MOVEI Z,[ASCIZ /for word/] PUSHJ P,NOISE PUSHJ P,WRDPRS TRNN FLAGS,TEMPF1 ;DOING A "B"? JRST EVLB7 ;NO IFN %TNX,[ MOVEI Z,[ASCIZ /to text file/] HRROI [ASCIZ /RPT/] MOVEM GJBLK+.GJEXT ] PUSHJ P,OPENW EVLB7: PUSHJ P,CONFRM JUMPE W,JME ;WORD IS EMPTY ;;;NOW WORD IS IN WORDIN, W MOVEM W,SVWDLN ;ISN'T THIS SORT OF A CROCK? MOVE [WORDIN,,SVWDWX] BLT SVWDWX+17. TRNE FLAGS,TEMPF1 ;DOING A "B"? JRST EVLB ;YES TRO FLAGS,TFORCE ;FORCE OUTPUT EVEN IF IN JCL STRING PUSHJ P,WTEST JRST QFOUND ;WORD EXISTS DIRECTLY JRST QINDIR ;WORD EXISTS INDIRECTLY PUSHJ P,TRFX1 ;LOOK FOR CLOSE WORDS SKIPN CANDS ;ANY SUGGESTIONS? JRST EVL3 ;NO TYPE [[ASCIZ /No, may i suggest: /]] SETZ C, EVLOP: CAML C,CANDS JRST ENDCMD ;DONE MOVE A,CNDPTL(C) ;POINTER TO WORD IN CANDBF PUSHJ P,OUT5 ;DISPLAY THE WORD TYPE [[ASCIZ / /]] AOJA C,EVLOP EVL3: TYPE [[ASCIZ /Couldn't find it/]] JRST ENDCMD QFOUND: TYPE [[ASCIZ /Found it/]] QEND: TYPE [[ASCIZ / /]] SKIPE K,Z PUSHJ P,WFLAGS ;PRINT ITS FLAGS IF ENTRY EXISTS JRST ENDCMD QINDIR: TYPE [[ASCIZ /Found it because of /]] HRRZ A,Z ;DICTIONARY ENTRY THAT WAS USED AOS A ;POINT TO TEXT PART PUSHJ P,OUT5 ;PRINT IT JRST QEND EVLB: TRO FLAGS,FWRITE ;OUTPUT TO FILE PUSHJ P,WTEST JRST EVLB1 ;WORD EXISTS DIRECTLY JRST EVLB2 ;WORD EXISTS INDIRECTLY PUSHJ P,TRFX1 ;LOOK FOR CLOSE WORDS SKIPN CANDS ;ANY SUGGESTIONS? JRST EVLB3 ;NO MOVEI "& PUSHJ P,OUTC SETZ C, EVLBOP: CAML C,CANDS JRST QENDZ ;DONE MOVE A,CNDPTL(C) ;POINTER TO WORD IN CANDBF PUSHJ P,OUT5 ;DISPLAY THE WORD PUSHJ P,OUTCR AOJA C,EVLBOP QENDB: SKIPE K,Z PUSHJ P,WFLAGS ;PRINT ITS FLAGS IF ENTRY EXISTS QENDZ: PUSHJ P,OUTCR ;IF "B", CLOSE THE OUTPUT FILE PUSHJ P,CLOSW JRST ENDCMD EVLB3: MOVEI "# PUSHJ P,OUTC JRST QENDZ EVLB1: MOVEI "* PUSHJ P,OUTC JRST QENDB ;WRITE FLAGS EVLB2: MOVEI "+ PUSHJ P,OUTC HRRZ A,Z ;DICTIONARY ENTRY THAT WAS USED AOS A ;POINT TO TEXT PART PUSHJ P,OUT5 ;PRINT IT JRST QENDB SUBTTL FIND ANAGRAMS JUMBLE: TRZ FLAGS,FWRITE+NOCORR ;OUTPUT TO TERMINAL MOVEI Z,[ASCIZ /word/] PUSHJ P,NOISE PUSHJ P,WRDPRS PUSHJ P,CONFRM TRO FLAGS,TFORCE ;FORCE OUTPUT EVEN IF IN JCL STRING ;;;NOW WORD IS IN WORDIN, W ;;;THIS USES 3W-2 STACK WORDS JUMPE W,JME ;WORD IS EMPTY CAILE W,8. JRST JME ;TOO LONG MOVE X,[440500,,WORDIN] MOVEM W,K JM1: PUSH P,X MOVE Y,X ILDB X SOSN L,K JRST JM2 JM4: ILDB Y LDB A,X DPB A,Y DPB X PUSH P,L PUSH P,Y JRST JM1 JM2: PUSHJ P,WTEST JFCL ;WORD EXISTS DIRECTLY SKIPA ;WORD EXISTS INDIRECTLY JRST JM3 MOVE A,[440500,,WORDIN] PUSHJ P,OUT5 TYPE [[ASCIZ / /]] JM3: POP P,X AOS K CAMN W,K JRST ENDCMD POP P,Y POP P,L LDB Y LDB A,X DPB A,Y DPB X SOJGE L,JM4 JRST JM3 JME: TYPE [[ASCIZ /???? /]] JRST ENDCMD KILL: PUSHJ P,CONFRM ;EXIT AND KILL SELF IFN %ITS,.BREAK 16,160000 IFN %TNX,[ IFN %20X,[ MOVE A,[440700,,[ASCIZ /RESET /]] RSCAN ;STUFF THE COMMAND INTO THE RESCAN BUFFER ; (20X ONLY) JRST .+4 ;HUH? MOVEI A,.RSINI RSCAN ;ACTIVATE IT JFCL ] HALTF ;10X OR 20X JRST .-1 ] QUIT: PUSHJ P,CONFRM ;EXIT, ALLOW RESTART IFN %ITS, .BREAK 16,100000 IFN %TNX, HALTF JRST BEGIN SUBTTL WTEST TEST A WORD, USING THE ENDINGS STUFF ; THE WORD IS IN WORDIN AND W ; NO SKIP IF WORD KNOWN DIRECTLY (INCLUDING SINGLE LETTER) ; SKIP ONCE IF KNOWN INDIRECTLY ; IN ABOVE CASES, ENTRY THAT IT USED IS IN RIGHT HALF OF Z ; OR Z=0 IF SINGLE LETTER ; SKIP TWICE IF UNKNOWN (CALLING TESTFX MIGHT SET BITS TO MAKE IT KNOWN) ; CLOBBERS 0, A, B, X, Y, Z WTEST: CAIGE W,2 ; 2 OR MORE LETTERS LONG? JRST [SETZ Z, ? POPJ P,] ; NO, ACCEPT IT IMMEDIATELY PUSHJ P,SEARCH POPJ P, ; OK SETZM TFFLG ; WILL BE NONZERO IF CAN FIX THE WORD CAIGE W,4 JRST CPOPJ2 ; DON'T CHECK ENDINGS UNLESS AT LEAST 4 LETTERS MOVEM W,TWWSV ; SAVE W, SINCE WILL CLOBBER IT A LOT MOVE [WORDIN,,TWRDX] BLT TWRDX+6 ; SAVE WORDIN ALSO PUSHJ P,GETLBP ; GET LAST LETTER CAIN "D-75 ; CHECK FOR "D" (ASCII-75 = 5BIT) JRST EDT.D ; FOR "CREATED", "IMPLIED", "CROSSED" CAIN "T-75 JRST EDT.T ; FOR "LATEST", "DIRTIEST", "BOLDEST" CAIN "R-75 JRST EDT.R ; FOR "LATER", "DIRTIER", "BOLDER" CAIN "G-75 JRST EDT.G ; FOR "CREATING", "FIXING" CAIN "H-75 JRST EDT.H ; FOR "HUNDREDTH", "TWENTIETH" CAIN "S-75 JRST EDT.S ; FOR ALL SORTS OF THINGS ENDING IN "S" CAIN "N-75 JRST EDT.N ; FOR "TIGHTEN", "CREATION", "MULIPLICATION" CAIN "E-75 JRST EDT.V ; FOR "CREATIVE", "PREVENTIVE" CAIN "Y-75 JRST EDT.Y ; FOR "QUICKLY" TFAIL: MOVE [TWRDX,,WORDIN] ; FAILED ; (BUT IF TFFLG IS SET MAY BE ABLE TO FIX IT) BLT WORDIN+6 ; RESTORE WORDIN MOVE W,TWWSV ; AND W JRST CPOPJ2 EDT.G: MOVE GFLAG MOVEM FLGTST QQG: PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "N-75 JRST TFAIL PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "I-75 JRST TFAIL MOVEI "E-75 ; CHANGE I TO E DPB X ; FOR "CREATING" PUSHJ P,SEARCH PUSHJ P,ENDSD PUSHJ P,KLAST ; DELETE THE E CAIGE W,2 JRST TFAIL ; GETTING TOO SHORT PUSHJ P,GETLBP CAIN "E-75 JRST TFAIL ; THIS STOPS "CREATEING" PUSHJ P,SEARCH PUSHJ P,ENDSD ; FOR "FIXING" JRST TFAIL EDT.D: MOVE DFLAG MOVEM FLGTST ; THIS CODE IS USED FOR D, Z, T, AND R FLAGS QQP: PUSHJ P,KLAST ; REMOVE THE D PUSHJ P,GETLBP CAIE "E-75 JRST TFAIL PUSHJ P,SEARCH PUSHJ P,ENDSD ; THIS GETS "CREATED" PUSHJ P,KLAST QQQ: PUSHJ P,GETLBP ; LOOK AT NEW LAST LETTER CAIN "E-75 JRST TFAIL ; THIS STOPS "CREATEED" ; ENTER HERE FROM "P" FLAG QQT: PUSHJ P,CKVOWL JUMPL A,QQS PUSHJ P,GETLBP ; RESTORE 0 AND X CAIN "Y-75 JRST TFAIL ; THIS STOPS "IMPLYED" PUSHJ P,SEARCH PUSHJ P,ENDSD ; THIS GETS "FIXED" OR "ALERTNESS" LDB X ; LOOK AT LAST LETTER AGAIN CAIE "I-75 JRST TFAIL MOVEI "Y-75 DPB X ; CHANGE I TO Y AND TRY IT AGAIN JRST QQS ; THIS GETS "IMPLIED" OR "CLOUDINESS" ; HAVE STRIPPED ENDING AND FOUND WORD IN DICTIONARY ; IF THE WORD HAS THE FLAG INDICATED IN FLGTST, WIN ; IF IT IS NOT IN DICTIONARY ZERO, RETURN, SINCE IT COULDN'T HAVE HAD THE FLAG ; IF IT IS IN DICTIONARY ZERO AND DOES NOT HAVE THE FLAG, FAIL ENDSD: HLLZ A,(Z) ; FLAGS HALFWORD OF THE ENTRY TLNE A,1 ; IS DICTNUM BIT ON? JRST CPOPJ ; YES, RETURN FOR MORE TESTING POP P, ; FLUSH STACK ITEM HRLZ FLGTST ; GET DESIRED FLAG INTO LEFT HALF AND A,FLGTST ; GET ACTUAL FLAG FIELD OF ENTRY JUMPN A,ENDSQ ; ENTRY HAS A FLAG IN THIS FIELD HRRZM Z,TFPTR ; NO, RECORD STUFF FOR TESTFX TO USE SKIPN PURE ; DON'T ALLOW FLAG SETTING IF PURE MOVEM TFFLG ; FLAG BITS TO SET JRST TFAIL ENDSQ: CAME A ; SEE IF FLAG IS THE RIGHT ONE JRST TFAIL ; NO MOVE [TWRDX,,WORDIN] ; YES, DESIRED FLAG IS ON BLT WORDIN+6 ; RESTORE WORDIN MOVE W,TWWSV ; AND W JRST CPOPJ1 ; WORD KNOWN INDIRECTLY EDT.R: MOVE RFLAG MOVEM FLGTST JRST QQP EDT.S: MOVE SFLAG MOVEM FLGTST PUSHJ P,KLAST PUSHJ P,GETLBP CAIN "S-75 JRST EDT.P ; CHECK FOR ...NESS CAIE "X-75 CAIN "H-75 JRST TFAIL ; OR ...XS OR ...HS CAIN "Z-75 JRST TFAIL ; OR ...ZS CAIN "Y-75 JRST EDT.YS ; CHECK FOR THINGS LIKE "CONVEYS" PUSHJ P,SEARCH PUSHJ P,ENDSD ; THIS GETS "BATS" UNDER RULE S LDB X ; LOOK AT LAST LETTER AGAIN CAIN "R-75 ; LOOK FOR ...RS JRST EDT.Z ; USE RULE Z CAIN "N-75 ; OR ...NS JRST EDT.X ; USE RULE X CAIN "G-75 ; OR ...GS JRST EDT.J ; USE RULE J CAIN 36 ; OR ...'S JRST EDT.M ; USE RULE M CAIE "E-75 JRST TFAIL PUSHJ P,KLAST ; BACK TO RULE S PUSHJ P,GETLBP MOVE A,[000100020500] ; BITS FOR H, S, X, Z ROT A,@0 JUMPL A,QQS ; JUMP IF "H", "S", "X", OR "Z" CAIE "I-75 JRST TFAIL MOVEI "Y-75 DPB X ; CHANGE I TO Y PUSHJ P,CKVOWL JUMPL A,TFAIL QQS: PUSHJ P,SEARCH PUSHJ P,ENDSD JRST TFAIL EDT.YS: PUSHJ P,CKVOWL JUMPL A,QQS JRST TFAIL EDT.P: MOVE PFLAG MOVEM FLGTST CAIGE W,5 JRST TFAIL PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "E-75 JRST TFAIL PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "N-75 JRST TFAIL PUSHJ P,KLAST ; WORD WAS ...NESS JRST QQT ; CHECK THE WORD, CHANGE I TO Y ; IF NECESSARY EDT.J: MOVE JFLAG MOVEM FLGTST CAIGE W,4 JRST TFAIL JRST QQG EDT.M: MOVE MFLAG MOVEM FLGTST PUSHJ P,KLAST JRST QQS EDT.Z: MOVE ZFLAG MOVEM FLGTST CAIGE W,4 JRST TFAIL ; NOT LONG ENOUGH JRST QQP EDT.X: MOVE XFLAG MOVEM FLGTST CAIGE W,4 JRST TFAIL JRST QQN EDT.T: MOVE TFLAG MOVEM FLGTST PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "S-75 JRST TFAIL PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "E-75 JRST TFAIL PUSHJ P,SEARCH PUSHJ P,ENDSD CAIGE W,3 JRST TFAIL ; WORD IS GETTING TOO SMALL PUSHJ P,KLAST JRST QQQ EDT.H: MOVE HFLAG MOVEM FLGTST PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "T-75 JRST TFAIL PUSHJ P,KLAST PUSHJ P,GETLBP CAIN "Y-75 JRST TFAIL ; THIS STOPS "TWENTYTH" PUSHJ P,SEARCH PUSHJ P,ENDSD PUSHJ P,GETLBP CAIE "E-75 JRST TFAIL PUSHJ P,KLAST CAIGE W,2 JRST TFAIL PUSHJ P,GETLBP CAIE "I-75 JRST TFAIL MOVEI "Y-75 DPB X PUSHJ P,SEARCH PUSHJ P,ENDSD JRST TFAIL EDT.N: MOVE NFLAG MOVEM FLGTST QQN: PUSHJ P,KLAST PUSHJ P,GETLBP CAIN "E-75 JRST EDT.EN CAIE "O-75 JRST TFAIL PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "I-75 JRST TFAIL MOVEI "E-75 DPB X ; CHANGE "I" TO "E" PUSHJ P,SEARCH PUSHJ P,ENDSD CAIGE W,6 JRST TFAIL ; WON'T MAKE IT THROUGH 4 DELETIONS PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "T-75 JRST TFAIL PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "A-75 JRST TFAIL PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "C-75 JRST TFAIL PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "I-75 JRST TFAIL MOVEI "Y-75 DPB X JRST QQS EDT.EN: PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "E-75 CAIN "Y-75 JRST TFAIL ; THIS STOPS "CREATEEN" OR "MULTIPLYEN" JRST QQS EDT.Y: MOVE YFLAG MOVEM FLGTST PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "L-75 JRST TFAIL PUSHJ P,KLAST JRST QQS EDT.V: MOVE VFLAG MOVEM FLGTST PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "V-75 JRST TFAIL PUSHJ P,KLAST PUSHJ P,GETLBP CAIE "I-75 JRST TFAIL MOVEI "E-75 DPB X ; CHANGE I TO E PUSHJ P,SEARCH PUSHJ P,ENDSD PUSHJ P,KLAST ; REMOVE THE E CAIGE W,2 JRST TFAIL ; TOO SHORT NOW PUSHJ P,GETLBP CAIN "E-75 JRST TFAIL ; THIS STOPS "CREATEIVE" JRST QQS ; ATTEMPT TO SET THE FLAG IN THE WORD THAT CAUSED A DOUBLE SKIP IN ; THE LAST CALL TO WTEST TESTFX: SKIPN A,TFFLG POPJ P, IORM A,@TFPTR ; SET THE BITS AOS FLAGNN JRST CPOPJ1 SUBTTL ROUTINES USED BY ENDTST ;SEE IF NEXT-TO-LAST LETTER IS A, E, I, O, OR U ;LEAVES A < 0 IF SO ;CLOBBERS 0, A, X, Y CKVOWL: SOS W ;FOOL GETLBP INTO GETTING EARLIER LETTER PUSHJ P,GETLBP AOS W ;REPAIR THINGS MOVE A,[021040404000] ;THIS HAS BITS ON IN RIGHT PLACES ROT A,@0 ;ROTATE A ONE INTO SIGN IF VOWEL POPJ P, ;GET BYTE PTR TO LAST LETTER IN X, THAT LETTER (IN 5BIT) IN 0 ;CLOBBERS 0, X, Y GETLBP: MOVE X,W ;LENGTH OF WORD SOS X IDIVI X,7 ;X = WORD NUMBER, Y = BYTE NUMBER ADD X,GETLBT(Y) LDB X ;GET THE LETTER ITSELF POPJ P, ;KILL LAST LETTER, REQUIRE X SET UP BY GETLBP ;CLOBBERS 0 KLAST: SETZ DPB X ;SET IT TO ZERO SOS W POPJ P, GETLBT: 370500,,WORDIN 320500,,WORDIN 250500,,WORDIN 200500,,WORDIN 130500,,WORDIN 060500,,WORDIN 010500,,WORDIN CPOPJ2: AOS (P) CPOPJ1: AOS (P) CPOPJ: POPJ P, ;NORMALLY A SKIP RETURN SUBTTL TRFX1 - FIND ALL "CLOSE" WORDS ;FIND ALL WORDS CLOSE TO (SVWDWX,SVWDLN), MAKE LIST IN CNDPTL, CANDBF ;SET CANDS = NUMBER FOUND ;CALLER SHOULD HAVE MOVED (WORDIN,W) TO (SVWDWX,SVWDLN) ;CLOBBERS WORDIN, W TRFX1: SETZM CANDS MOVEI CANDBF MOVEM CNDPTL ;INITIALIZE POINTER LIST PUSHJ P,X1SRCH ;TRY MAYBE ONE LETTER WRONG PUSHJ P,XTRNP ;TRY SIMPLE TRANSPOSITION PUSHJ P,X1EXL ;TRY MAYBE DELETE 1 EXTRA LETTER PUSHJ P,X1LMS ;ADD ONE LETTER POPJ P, ;LOAD (WORDIN, W) FROM (SVWDWX, SVWDLN) UNSVWD: MOVE [SVWDWX,,WORDIN] BLT WORDIN+6 MOVE W,SVWDLN POPJ P, ;X1SRCH - TRY TO CORRECT ONE MISSPELLED LETTER X1SRCH: MOVE SVWDLN MOVEM TLET.2 ;NUMBER OF POSITIONS TO ALTER MOVE [370500,,WORDIN] MOVEM X1BYPT X1SRC1: PUSHJ P,UNSVWD ;GET WORD BACK MOVEI A,33 ;TRY ALL LETTERS MOVEM A,TLET.1 X1SRC2: ADDI A,3 DPB A,X1BYPT PUSHJ P,WTEST JFCL PUSHJ P,CNSRT SOSLE A,TLET.1 JRST X1SRC2 IBP X1BYPT ;GO TO NEXT POSITION SOSLE TLET.2 JRST X1SRC1 POPJ P, ;XTRNP - ONE PAIR TRANSPOSITION XTRNP: MOVE W,SVWDLN MOVEM W,TLET.1 SOS TLET.1 XTRNP1: SETZM WORDIN MOVE [WORDIN,,WORDIN+1] BLT WORDIN+6 MOVE B,[440500,,WORDIN] MOVE C,[440500,,SVWDWX] MOVEI D,1 XTRNP2: ILDB C CAMN D,TLET.1 JRST [ILDB A,C IDPB A,B AOJA D,.+1] IDPB B CAMGE D,W AOJA D,XTRNP2 PUSHJ P,WTEST JFCL PUSHJ P,CNSRT ;IT IS A WORD, INSERT IT SOSLE TLET.1 JRST XTRNP1 POPJ P, ;X1EXL - MAYBE HE TYPED ONE EXTRA LETTER X1EXL: MOVE W,SVWDLN ;GET BACK W CAIGE W,3 POPJ P, ;CAN'T CORRECT A SHORT WORD SOS W MOVEM W,TLET.1 ;TLET.1 WILL SELECT THE LETTER TO ;SKIP X1EXL1: SETZM WORDIN ;READY FOR BLT MOVE [WORDIN,,WORDIN+1] BLT WORDIN+6 MOVE B,[440500,,WORDIN] MOVE C,[440500,,SVWDWX] SETZ D, ;COUNT THE CHARACTERS MOVED X1EXL2: ILDB C CAME D,TLET.1 IDPB B CAMGE D,W AOJA D,X1EXL2 PUSHJ P,WTEST JFCL PUSHJ P,CNSRT SOSL TLET.1 JRST X1EXL1 POPJ P, ;X1LMS - ONE LETTER MISSING X1LMS: SETZM WORDIN MOVE [WORDIN,,WORDIN+1] BLT WORDIN+6 MOVE B,[370500,,WORDIN] ;SKIP FIRST CHARACTER MOVEM B,X1BYPT MOVE C,[440500,,SVWDWX] MOVE W,SVWDLN MOVEI D,1 X1LMS3: ILDB C IDPB B CAMGE D,W AOJA D,X1LMS3 ADDI W,1 MOVEM W,TLET.2 X1LM3A: MOVEI A,33 MOVEM A,TLET.1 X1LMS4: ADDI A,3 DPB A,X1BYPT PUSHJ P,WTEST JFCL PUSHJ P,CNSRT SOSLE A,TLET.1 JRST X1LMS4 MOVE A,X1BYPT ILDB X1BYPT ;ADVANCE TO NEXT POSITION DPB A ;COPY LETTER BACK TO OLD POSITION SOSLE TLET.2 JRST X1LM3A POPJ P, ;INSERT (WORDIN,W) INTO CANDBF CNSRT: MOVE CANDS CAIL 10. POPJ P, ;ALREADY ENOUGH ;THE LIMIT IS 10 BECAUSE MORE WOULD JUST MESS UP THE SCREEN ; AND THEY COULDN'T BE SELECTED WITH A SINGLE DIGIT MOVE W IDIVI 7 AOS ;NUMBER OF WORDS FOR ITEM MOVEM Z SETZ K, ;COUNTS CANDBF ENTRIES SEARCHED CNSRT1: CAMN K,CANDS JRST CNSRT4 ;REACHED END, WORD NEEDS TO BE ADDED MOVN Y,Z HRLZS Y ;Y = -COUNT,,0 MOVE X,CNDPTL(K) ;BASE OF WORD TO COMPARE CNSRT2: MOVE (X) AOS X CAME WORDIN(Y) AOJA K,CNSRT1 ;DOESN'T MATCH, GO TO NEXT AOBJN Y,CNSRT2 POPJ P, ;WORD IS ALREADY IN CANDBF CNSRT4: MOVE CNDPTL(K) ;BASE OF ITEM TO CREATE MOVEM CNDPTL+1(K) ;WILL BECOME END HRLI WORDIN ADDB Z,CNDPTL+1(K) ;END OF ITEM TO CREATE CAILE Z,CANDBF+25. POPJ P, ;WOULD OVERFLOW CANDBF SOS Z BLT (Z) AOS CANDS POPJ P, SUBTTL THE HASH COMPUTATION. ;COMPUTE HASH CHAIN FOR WORD IN WORDIN, WHICH HAS W LETTERS ;LEAVES Y = BYTE POINTER TO HASH CHAIN HEADER ;LEAVES WWLEN = NUMBER OF MACHINE WORDS TO STORE WORD NAME ;CLOBBERS 0, A, Y HASHCP: HLRZ WORDIN ;LEFT HALF OF WORDIN IS FAIRLY RANDOM LSH 3 ;MAKE ROOM FOR ADD W ;MORE RANDOMNESS IMULI MHASH ;RANDOMIZE IDIVI NHASH ;MODULO NUMBER OF CHAINS (IN A) ROT A,-1 ;NOW SIZE OF TABLE IN WORDS, PLUS SIGN BIT TLZN A,400000 TLOA A,222200 ;MAKE BYTE POINTER FOR APPROPRIATE HALFWORD TLO A,002200 ADDI A,HASHTB ;ADD BASE OF HEADER TABLE MOVE Y,A MOVE W ADDI 6 ;TO ROUND UP TO FULL WORD IDIVI 7 ;7 CHARS/WORD IN FIVEBIT MOVEM WWLEN ;WORD LENGTH IN MACHINE WORDS POPJ P, SUBTTL SEARCH LOOK IN DICTIONARY FOR A WORD. ; THE SUBJECT OF THE SEARCH LIVES IN WORDIN. ; IT HAS W CHARACTERS, W SHOULD BE .GE. 2 ; SKIP RETURN IF NOT FOUND, NO SKIP IF FOUND ;LEAVES Y AND WWLEN AS SET UP BY HASHCP ;IF FOUND, LEAVES ENTRY IN RIGHT HALF OF Z (LEFT HALF IS JUNK) ;CLOBBERS 0, A, B, Y, Z SEARCH: PUSHJ P,HASHCP MOVE B,WWLEN LDB Z,Y ;GET HEADER TO CHAIN IMUL B,[-1,,0] AOSA B ;NOW B = -WWLEN,,1 SRCH1: HRRZ Z,(Z) ;GET NEXT ITEM IN CHAIN JUMPE Z,CPOPJ1 ;END OF CHAIN, WORD IS NOT THERE HRLI Z,A ;PUT IN INDEX FIELD, SO INDIRECTION WILL WORK MOVE A,B ;NOW A = -NUMBER OF COMPARES TO GO,,INDEX OF NEXT COMPARE MOVE WORDIN-1(A) ;A STARTS COUNTING AT 1 CAMN @Z ;TABLE ENTRY, INDEXED BY A ;SKIPS WITH A .LT. 0 IF COMPARISON FAILS AOBJN A,.-2 ;FALL THROUGH WITH A .GE. 0 IF MATCH FOUND JUMPL A,SRCH1 ;FAILED, GET NEXT ENTRY IN CHAIN MOVE @Z ;GET NEXT WORD FROM DICTIONARY ITEM TLNE 700000 ;SEE IF LEFTMOST 3 BITS ARE OFF JRST SRCH1 ;NO, MATCH IS NOT GOOD POPJ P, ;WORD FOUND, EXIT WITH NO SKIP SUBTTL INSRTD ;INSERT THE WORD AT WORDIN. MUST HAVE Y AND WWLEN SET UP BY HASHCP ;IDNUM = DICTIONARY NUMBER TO PUT IT IN, IN FOLLOWING FORMAT: ; IF WANT 0, IDNUM = 0 ; IF WANT N, N .NE. 0, IDNUM = 2*N+1 ;LISTFF CONTAINS THE ADDRESS OF THE ZERO AT THE END OF THE DICTIONARY ;LEAVES Z POINTING TO THE CREATED ENTRY ;CLOBBERS 0, Z INSRTD: MOVE Z,LISTFF ;BASE OF BLOCK TO CREATE MOVE WWLEN ;AMOUNT WE NEED ADDI 1 ;NEED WORD FOR CHAIN POINTER ADDB LISTFF CAMGE MEMTOP JRST INSE35 ;HAVE ENOUGH MEMORY MOVEI 2000 ;ANOTHER 1K ADDB MEMTOP IFN %ITS,.SUSET [.SMEMT,,] ;RAISE THE MEMORY BOUND INSE35: LDB Y ;GET CHAIN HEADER HRL IDNUM ;DICTIONARY NUMBER (2N+1 FORMAT) MOVEM (Z) DPB Z,Y ;STORE NEW HEADER MOVE Z ADD [WORDIN,,1] ;FROM ADDR,,TO ADDR BLT @LISTFF ;COPY DATA, INCLUDING WORD OF ZERO AT END AOS DICTNN POPJ P, SUBTTL SUBROUTINE GETWD - READ A REAL WORD ;;; If W ~= 0, word loaded ;;; 5bit in WORDIN, ascii in WORDIX, length in W. ;;; The delimiter that caused it to stop is in BRKCHR. ;;; The word may contain "hyphen" characters, they will be in WORDIX ;;; but not in WORDIN. They will not be counted in W: W always ;;; gives the size of WORDIN. Neither WORDIX no WORDIN will ;;; have more than 41 characters. ;;; (That is, once it gets fixed.) ;;; Also: CASERR on if illegal capitalization. ;;; If CASERR off: ;;; ALL LOWER CASE - LOW1 = 1 LOW2 = 1 ;;; INITIAL UPPER, REST LOWER - LOW1 = 0 LOW2 = 1 ;;; ALL UPPER CASE - LOW1 = 0 LOW2 = 0 ;;; (If CASERR on, LOW1 and LOW2 are random.) ;;; Manipulates SPLOFF flag when sees appropriate indicators. ;;; All text before the word (punctuation, formatter commands) ;;; has been copied into output. User must copy word (with ;;; corrected spelling) into output, followed by BRKCHR if ;;; BRKCHR >= 0. BRKCHR will be -1 if word was instantly ;;; followed by end of input file. ;;; ;;; If W = 0, no word: this can happen only if end of input file. ;;; Preceding text has been copied. Caller does not need to ;;; write anything. ;;; ;;; If called when BRKCHR < 0, returns instantly with BRKCHR < 0 ;;; and W = 0. This occurs at end of file. ;;; USER MUST PRESERVE BRKCHR BETWEEN CALLS ;;; OBSERVES FORMAT OF JUSTIFIERS ACCORDING TO OPTIONS SELECTED IN ;;; FLAGS - RETURNS ONLY "TRUE" WORDS, SKIPS AND COPIES ALL ELSE ;;; (IF SPLOFF ON, IT STILL RETURNS THE STUFF) ;;; COPIES EVERYTHING SKIPPED INTO OUTPUT FILE UNLESS NOCORR IS ON ;;; MUST HAVE SAVCHR=-1, BRKCHR=^J, AND LINENO=0 AT START OF FILE ;;; CLOBBERS 0, A, B, X, Y; SETS UP WORDIN, WORDIX, W, LOW1, LOW2, CASERR ;;; UPDATES SPLOFF ;;; LINENO CONTAINS LINE ON WHICH WORD APPEARED GETWD: TRZ FLAGS,LOW1+LOW2+CASERR ;INITIALIZE CASE FLAGS SETZB W,WORDIN ;SET UP POINTERS AND SUCH MOVE [WORDIN,,WORDIN+1] BLT WORDIX+10. MOVE X,[440700,,WORDIX] MOVE Y,[440500,,WORDIN] MOVEI ^J MOVEM TRMCHR ;COMMENT TERMINATOR IN ALL MODES BUT SCRIBE MOVE SAVCHR ;WAITING CHARACTER FROM LAST CALL? JUMPGE RDLOOQ ;YES, PROCESS IT ***** CHECK THIS FOR TEX "\" RDLOO1: MOVE BRKCHR ;CHECK LAST CHARACTER CAIGE 40 ;SEE IF CONTROL CHAR JRST RDLCTL ;YES, CHECK FOR VARIOUS SPECIAL THINGS TLNE FLAGS,SMODE+TMODE ;NOT CONTROL CHAR JRST CHKTEX ;IF NOT "TEX" OR "SCRIBE" MODE, NOTHING TO DO ;NOW BRKCHR = PRECEDING CHARACTER RDLOOP: PUSHJ P,READF ;READ INPUT CHAR JRST RDEOF ;EOF RETURN RDLOOQ: CAILE "z JRST WDELIM ;NOT A LETTER CAIGE "a JRST RDLO1 TRNN FLAGS,LOW2 ;LOWER CASE LETTER JRST RDLOW ;NEED TO FIX FLAGS SCHAR: IDPB X ;LETTER FOUND TRZ 740 ;CONVERT TO 5BIT ADDI 3 IDPB Y AOS W CAME X,[260700,,WORDIX+10] ;HAVE STORED 42ND CHARACTER? JRST RDLOOP ;OK, GET ANOTHER WOVF: MOVE X,[440700,,WORDIX] ;WORD TOO LONG *** COMPLAIN IF RDICT ON ILDB X ;UNPACK WHAT WE HAVE JUMPE GETWD ;DONE PUSHJ P,WRITF ;AND COPY IT TO OUTPUT JRST .-3 RDLO1: CAILE "Z ;CONTINUE CHECKING JRST BSL ;DELIMITER, BUT MIGHT BE BACKSLASH CAIL "A JRST RDUPP ;UPPERCASE LETTER CAIN ^Y JRST CTLY CAIN "' JRST APO CAIN ". ;LOOK FOR POINT AT LEFT MARGIN JRST POI ;DELIMITER FOUND WDELIM: SETOM SAVCHR ;TURN OFF SAVED CHARACTER FLAG WDEL1: MOVEM BRKCHR ;REMEMBER THIS CHARACTER JUMPN W,CPOPJ ;A WORD EXISTS, EXIT ;WE HAVE DELIMITER BUT NO WORD, SO COPY IT AND READ SOME MORE PUSHJ P,WRITF ;COPY CHARACTER JRST RDLOO1 ;CHECK FOR SPECIAL CHARS AND CONTINUE ;PREVIOUS CHARACTER WAS CONTROL CHARACTER RDLCTL: JUMPL RDEOF ;ALREADY SAW END OF FILE CAIN ^J AOS LINENO ;COUNT LINES TLNN FLAGS,JMODE+RMODE+PMODE JRST RDLOOP ;NO SPECIAL PROCESSING NEEDED CAIN ^F JRST RFONT ;PROCESS ^F IF IN J, P, OR R MODE TLNN FLAGS,RMODE ;OTHERS APPLY ONLY IF IN R MODE JRST RDLOOP MOVE B,[010700,,[ASCIZ / &&&SPELLO/]-1] CAIN ^K JRST CMN2 ;^K --> COMMENT CAIN ^X JRST SREG ;^X --> MACRO NAME CAIE ^S CAIN ^N JRST SREG ;^S OR ^N --> REGISTER NAME JRST RDLOOP ;CHECK FOR SPECIAL ACTION FOR "TEX" OR "SCRIBE", BASED ON PREVIOUS CHARACTER CHKTEX: TLNN FLAGS,TMODE JRST CHKSCR ;SCRIBE MODE, "$" AND "\" ARE INTERESTING CAIN "\ JRST TEXBSL ;READ NAME AND DON'T CHECK SPELLING CAIN "$ JRST CMNX ;COMMENT ENCLOSED IN DOLLARSIGNS MOVE B,[010700,,[ASCIZ / &&&SPELLO/]-1] CAIN "% JRST CMN2 ;DON'T CHECK SPELLING OF REST OF LINE JRST RDLOOP CHKSCR: CAIE "@ ;SCRIBE MODE, "@" IS INTERESTING JRST RDLOOP SETZ B, ;B WILL COLLECT THE KEYWORD JRST SREG ;IGNORE NEXT WORD ;FOUND LOWER CASE LETTER, BUT LOW2 WAS OFF RDLOW: JUMPE W,RDLOW1 ;IS FIRST LETTER OF WORD TRO FLAGS,LOW2 ;NOT FIRST, SET LOW2 CAIE W,1 ;SEE IF SECOND TRO FLAGS,CASERR ;THIRD OR MORE - BUT IF LOW2 WAS OFF, JRST SCHAR ; FIRST 2 LETTERS MUST BOTH HAVE BEEN CAPS RDLOW1: TRO FLAGS,LOW2+LOW1 ;WORD MUST BE ALL LOWER CASE JRST SCHAR ;FOUND UPPERCASE LETTER RDUPP: TRNE FLAGS,LOW2 TRO FLAGS,CASERR ;HAVE SEEN LOWERCASE, THIS IS AN ERROR JRST SCHAR ;FOUND APOSTROPHE (SINGLE QUOTE) APO: JUMPE W,APO2 ;APOSTROPHE, BUT NO LETTER BEFORE IT PUSHJ P,READF ;PEEK AT NEXT CHAR JRST RDEOF ;END OF FILE (RATHER ODD) CAILE "z ;SEE IF LETTER JRST APOOPS ;NO, HAVE READ TOO FAR CAIGE "a JRST APO3 TROE FLAGS,LOW2 ;LOWER CASE LETTER JRST APO1 ;ALREADY KNOW ABOUT IT CAIE W,1 TRO FLAGS,CASERR ;MUST HAVE HAD TWO UPPER CASE LETTERS BEFORE JRST APO1 APO3: CAIG "Z CAIGE "A JRST APOOPS ;DELIMITER TRNE FLAGS,LOW2 ;UPPER CASE LETTER TRO FLAGS,CASERR ;PREVIOUSLY HAD LOWER CASE APO1: MOVEI A,"' ;APOSTROPHE IS SURROUNDED BY LETTERS, IDPB A,X ;SO PACK IT, ALONG WITH FOLLOWING LETTER ; ***** CHECK FOR OVERFLOW MOVEI A,36 ;5BIT CODE FOR APOSTROPHE IDPB A,Y ;PACK IT IN 5BIT AOS W JRST SCHAR ;NOW PROCESS THE FOLLOWING LETTER APOOPS: MOVEM SAVCHR ;OOPS, SAVE IT FOR NEXT TIME MOVEI "' ;PUT BACK THE APOSTROPHE JRST WDEL1 ;PROCESS IT AS DELIMITER ;DELIMITER SEEN, CHECK FOR BACKSLASH BEFORE AN "R" COMMAND, OR TEX HYPHEN BSL: CAIE "\ JRST WDELIM ;NOT BACKSLASH JUMPN W,BSLT ;PRECEDED BY WORD, NOT INTERESTING MOVE A,BRKCHR TLNE FLAGS,RMODE CAIE A,^J JRST WDELIM ;NOT FIRST CHARACTER IN LINE, OR NOT "R" MODE BSL1: PUSHJ P,WRITF ;COPY HOWEVER MANY BACKSLASHES THERE ARE PUSHJ P,READF JRST RDEOF ;END IF INPUT??? CAIN "\ JRST BSL1 CAIE ". CAIN "' JRST STPCHK ;YES, IGNORE THE COMMAND LINE JRST RDLOOQ ;NO, TREAT AS ORDINARY CHARACTER BSLT: TLNN FLAGS,TMODE ;SEE IF BACKSLASH IN WORD IN TEX MODE JRST WDELIM PUSHJ P,READF ;PEEK AT NEXT CHAR JRST RDEOF ;END OF FILE (RATHER ODD) CAIE "- ;SEE IF "\-" JRST BSOOPS MOVEI A,"\ IDPB A,X ; ***** CHECK FOR OVERFLOW IDPB X ; ***** CHECK FOR OVERFLOW JRST RDLOOP BSOOPS: MOVEM SAVCHR ;OOPS, SAVE IT FOR NEXT TIME MOVEI "\ ;PUT BACK THE BACKSLASH JRST WDEL1 ;PROCESS IT AS DELIMITER CTLY: JUMPE W,WDELIM ;NO WORD YET? DON'T BOTHER TLNN FLAGS,RMODE ;CONTROL-Y, IS HYPHEN IN R MODE JRST WDELIM IDPB X ;STORE ASCII IN WORDIX CAME X,[260700,,WORDIX+10] JRST RDLOOP JRST WOVF ;POINT OR APOSTROPHE SEEN, IT MIGHT BEGIN A "COMMENT" APO2: TLNN FLAGS,RMODE ;APOSTROPHE PRECEDED BY DELIMITER JRST WDELIM ;NOT IN R MODE, TREAT NORMALLY POI: JUMPN W,WDELIM ;POINT SEEN, CHECK FOR PRECEDING DELIMITER TLNN FLAGS,JMODE+RMODE+PMODE JRST WDELIM ;NOT IN J, R, OR P MODE, TREAT NORMALLY MOVE A,BRKCHR ;GET LAST DELIMITER CAIE A,^J JRST WDELIM ;NO, NOT INTERESTING MOVE B,[010700,,[ASCIZ /<< &&&SPELLO/]-1] TLNN FLAGS,PMODE MOVE B,[010700,,[ASCIZ /C &&&SPELLO/]-1] TLNN FLAGS,JMODE+PMODE STPCHK: SETO B, ;DISABLE &&&SPELLON/OFF CHECKING ;;;READ THE CONTENTS OF A COMMENT -- CHECK FOR &&&SPELLON/OFF ;;; TRMCHR HAS ")" OR WHATEVER FOR SCRIBE, ^J FOR ALL OTHERS CHKC: PUSHJ P,WRITF ;COPY LAST CHARACTER CMN2: PUSHJ P,READF ;PROCESS COMMENT, B MAY BE LOADED IF LOOKING ; FOR INDICATOR TO ENABLE/DISABLE CHECKING JRST RDEOF CMN3: CAMN TRMCHR ;END OF COMMENT? JRST WDELIM ;YES CAIN ^J AOS LINENO ;COUNT LINES, IN CASE MULTI-LINE SCRIBE COMMENT SKIPL A,B ;SEE IF CHECKING FOR &&&SPELLON/OFF ILDB A,B ;YES JUMPE A,FOO ;JUMP IF REACHED END OF WORD BEING LOOKED FOR CAME A JRST STPCHK JRST CHKC FOO: SETO B, CAIN "N ;CHECK FOR "SPELLON" TRZ FLAGS,SPLOFF CAIE "F JRST STPCHK PUSHJ P,WRITF ;COPY THE "F" PUSHJ P,READF ;CHECK FOR ANOTHER JRST RDEOF CAIN "F TRO FLAGS,SPLOFF JRST CMN3 CMNX: PUSHJ P,READF ;LOOK FOR SECOND DOLLARSIGN JRST RDEOF CAIN ^J AOS LINENO ;COUNT LINES CAIN "$ JRST CMNX1 CMNX2: CAIN "\ ;LOOK FOR "\$" IN MATH MODE JRST TEXQDL PUSHJ P,WRITF PUSHJ P,READF JRST RDEOF CAIN ^J AOS LINENO ;COUNT LINES CAIE "$ JRST CMNX2 JRST CMNX9 TEXQDL: PUSHJ P,WRITF PUSHJ P,READF JRST RDEOF CAIN ^J AOS LINENO ;COUNT LINES JRST CMNX2 ;PROCESS NEXT CHAR EVEN IF IT IS "$" CMNX1: PUSHJ P,WRITF ;TWO CONSECUTIVE DOLLARSIGNS PUSHJ P,READF JRST RDEOF CAIN ^J AOS LINENO ;COUNT LINES CAIE "$ JRST CMNX1 PUSHJ P,WRITF PUSHJ P,READF JRST RDEOF CAIN ^J AOS LINENO ;COUNT LINES CAIE "$ JRST CMNX1 CMNX9: MOVEM BRKCHR PUSHJ P,WRITF JRST RDLOOP TEXBSL: PUSHJ P,READF ;BACKSLASH IN "TEX" MODE JRST RDEOF ;END OF FILE? CAIN "$ JRST CMNX9 ;QUOTED DOLLARSIGN CAIE ": ;LOOK FOR BACKSLASH-COLON JRST SREGX ;JUST FLUSH NAME PUSHJ P,WRITF ;FONT SELECT, COPY THE COLON RFONT: PUSHJ P,READF ;READ FONT NUMBER (OR LETTER) JRST RDEOF ;END OF FILE? CAIN ^J AOS LINENO ;STRANGE FONT, BUT OURS IS NOT TO REASON WHY JRST CMNX9 SREGU: TLNN FLAGS,RMODE ;UNDERSCORE, IT IS PART OF NAME IN "R" ONLY JRST SREND SREG0: MOVEM A ;SCRIBE MODE NEEDS TO KNOW THE WORD LSHC A,-5 ;SHIFT CHAR (LOW 5 BITS ARE ENOUGH) INTO B PUSHJ P,WRITF SREG: PUSHJ P,READF ;READ CHARACTER OF NAME JRST RDEOF ;END OF FILE? SREGX: CAIN "_ JRST SREGU CAIG "z CAIGE "A JRST SREND CAIGE "a CAIG "Z JRST SREG0 SREND: TLNN FLAGS,SMODE JRST WDELIM ;NOT SCRIBE, THAT'S ALL MOVEI A,") ;CHECK FOR SUITABLE TYPES OF PARENS CAIN "( JRST SCRWCH MOVEI A,"] CAIN "[ JRST SCRWCH MOVEI A,"} CAIN "{ JRST SCRWCH MOVEI A,"> CAIN "< JRST SCRWCH MOVEI A,"" CAIN "" JRST SCRWCH JRST WDELIM ;NO SCRWCH: MOVEM A,TRMCHR ;CHARACTER THAT WILL TERMINATE THE STUFF HRLZI A,SCRTAB-SCRTBE CAMN B,SCRTAB(A) ;SEARCH KEYWORD TABLE JRST .+3 AOBJN A,.-2 JRST WDELIM ;NOT A KEYWORD THAT REQUIRES SKIPPING STUFF SETO B, ;REMEMBER NOT TO LOOK FOR "&&&SPELLO" TRNN A,-1 ;CHECK FOR FIRST TABLE ITEM, WHICH IS "COMMENT" MOVE B,[010700,,[ASCIZ /&&&SPELLO/]-1] JRST CHKC SCRTAB: <.BYTE 5 ? "T ? "N ? "E ? "M ? "M ? "O ? "C> ;"COMMENT" <.BYTE 5 ? "N ? "I ? "G ? "E ? "B> ;"BEGIN" <.BYTE 5 ? "E ? "C ? "A ? "P ? "S ? "K ? "N> ;"BLANKSPACE" <.BYTE 5 ? "E ? "S ? "A ? "C> ;"CASE" <.BYTE 5 ? "E ? "T ? "I ? "C> ;"CITE" <.BYTE 5 ? "K ? "R ? "A ? "M ? "E ? "T ? "I> ;"CITEMARK" <.BYTE 5 ? "R ? "E ? "T ? "N ? "U ? "O ? "C> ;"COUNTER" <.BYTE 5 ? "E ? "N ? "I ? "F ? "E ? "D> ;"DEFINE" <.BYTE 5 ? "E ? "C ? "I ? "V ? "E ? "D> ;"DEVICE" <.BYTE 5 ? "D ? "N ? "E> ;"END" <.BYTE 5 ? "E ? "T ? "A ? "U ? "Q ? "E> ;"EQUATE" <.BYTE 5 ? "E ? "L ? "I ? "F> ;"FILE" <.BYTE 5 ? "T ? "N ? "O ? "F> ;"FONT" <.BYTE 5 ? "M ? "R ? "O ? "F> ;"FORM" <.BYTE 5 ? "P ? "S ? "H> ;"HSP" <.BYTE 5 ? "E ? "D ? "U ? "L ? "C ? "N ? "I> ;"INCLUDE" <.BYTE 5 ? "X ? "E ? "D ? "N ? "I> ;"INDEX" <.BYTE 5 ? "Y ? "R ? "T ? "N ? "E ? "X ? "E> ;"INDEXENTRY" <.BYTE 5 ? "G ? "A ? "T ? "I> ;"ITAG" <.BYTE 5 ? "L ? "E ? "B ? "A ? "L> ;"LABEL" <.BYTE 5 ? "E ? "K ? "A ? "M> ;"MAKE" <.BYTE 5 ? "Y ? "F ? "I ? "D ? "O ? "M> ;"MODIFY" <.BYTE 5 ? "F ? "E ? "R ? "E ? "G ? "A ? "P> ;"PAGEREF" <.BYTE 5 ? "T ? "R ? "A ? "P> ;"PART" <.BYTE 5 ? "E ? "R ? "U ? "T ? "C ? "I ? "P> ;"PICTURE" <.BYTE 5 ? "F ? "E ? "R> ;"REF" <.BYTE 5 ? "D ? "N ? "E ? "S> ;"SEND" <.BYTE 5 ? "T ? "E ? "S> ;"SET" <.BYTE 5 ? "T ? "N ? "O ? "F ? "L ? "A ? "I> ;"SPECIALFONT" <.BYTE 5 ? "G ? "N ? "I ? "R ? "T ? "S> ;"STRING" <.BYTE 5 ? "E ? "L ? "Y ? "T ? "S> ;"STYLE" <.BYTE 5 ? "T ? "E ? "S ? "B ? "A ? "T> ;"TABSET" <.BYTE 5 ? "G ? "A ? "T> ;"TAG" <.BYTE 5 ? "M ? "R ? "O ? "F ? "T ? "X ? "E>+1 ;"TEXTFORM" <.BYTE 5 ? "E ? "L ? "T ? "I ? "T> ;"TITLE" <.BYTE 5 ? "E ? "S ? "U> ;"USE" <.BYTE 5 ? "E ? "U ? "L ? "A ? "V> ;"VALUE" SCRTBE: RDEOF: SETOM BRKCHR POPJ P, SUBTTL MISCELLANEOUS ROUTINES AND TABLES ;PRINT CURRENT OPTIONS ;CLOBBERS 0, A, B PROPT: TLNN FLAGS,-1 POPJ P, ;NO OPTIONS TYPE [[ASCIZ / Options are: /]] TRZ FLAGS,PRPTFG ;WILL BE TURNED ON AFTER PRINT ANYTHING MOVNI B,MTABE-MTAB PROP1: HRLZ A,MTABE(B) ;GET OPTION BIT TDNN FLAGS,A ;IS IT CURRENTLY SET? JRST PROP2 ;NO TRON FLAGS,PRPTFG ;IS THIS FIRST TIME? JRST PROP3 ;YES TYPE [[ASCIZ /, /]] PROP3: MOVE MTABE-MTAB(B)+MTABQ ;GET NAME OF OPTION PUSHJ P,STTYO ;PRINT IT PROP2: AOJL B,PROP1 POPJ P, ;PRINT OR WRITE DICTIONARY FLAGS OF ENTRY POINTED TO BY K, ;DEPENDING ON FWRITE ;CLOBBERS 0, A, B WFLAGS: HRLZI A,FVTAB-FNTAB DDCVR3: HLLZ FVTAB(A) ;MASK INTO LEFT HALF TLO 1 ;MAKE IT CHECK LOW BIT (DICTNUM BIT) ; SO IT WILL FAIL IF BIT IS ON AND (K) ;PICK OUT FIELD FROM DICT ENTRY HRLZ B,FVTAB(A) ;BITS THAT IT SHOULD HAVE CAME B ;DO THEY MATCH? JRST DDCVR4 ;NO (OR DICTNUM BIT IS ON) MOVEI "/ ;YES, FLAG IS ON PUSHJ P,OUTC MOVE FNTAB(A) ;PICK UP FLAG NAME PUSHJ P,OUTC DDCVR4: AOBJN A,DDCVR3 ;SCAN THROUGH THE TABLE POPJ P, ;TABLE OF OPTION BITS ;LEFT HALF = BITS TO CLEAR BEFORE SETTING A BIT ; (SO THAT ONLY ONE OF "T", "R", "P", OR "X" WILL BE ON) ;RIGHT HALF = BIT FOR THIS SPECIFIC OPTION MTAB: JMBITS: RMODE+PMODE+TMODE+SMODE,,JMODE RMBITS: JMODE+PMODE+TMODE+SMODE,,RMODE PMBITS: JMODE+RMODE+TMODE+SMODE,,PMODE TMBITS: JMODE+RMODE+PMODE+SMODE,,TMODE SMBITS: JMODE+RMODE+PMODE+TMODE,,SMODE DMBITS: DMODE,,DMODE LMBITS: LMODE,,LMODE CMBITS: CMODE,,CMODE MTABE: "J ? "R ? "P ? "T ? "S ? "D ? "L ? "C MTABQ: JMNAME ? RMNAME ? PMNAME ? TMNAME SMNAME ? DMNAME ? LMNAME ? CMNAME JMNAME: ASCIZ /TJ6/ RMNAME: ASCIZ /R/ PMNAME: ASCIZ /PUB/ TMNAME: ASCIZ /TEX/ SMNAME: ASCIZ /SCRIBE/ DMNAME: ASCIZ /DISPLAY/ LMNAME: ASCIZ /LIST/ CMNAME: ASCIZ /CAPITALIZATION/ ;TABLE OF DICTIONARY FLAGS ;ENTRIES ARE MASK,,VALUE FVTAB: PFLAG: 60000,,40000 DFLAG: 10000,,10000 TFLAG: 05000,,04000 RFLAG: 02000,,02000 ZFLAG: 05000,,01000 MFLAG: 05000,,05000 GFLAG: 00400,,00400 HFLAG: 00200,,00200 NFLAG: 00100,,00100 XFLAG: 00040,,00040 VFLAG: 60000,,20000 YFLAG: 00010,,00010 JFLAG: 60000,,60000 SFLAG: 00002,,00002 ;NAME TABLE, MUST FOLLOW VALUE TABLE FNTAB: "P "D "T "R "Z "M "G "H "N "X "V "Y "J "S ;PROMPTING MESSAGES MSGWRK: ASCIZ /Workin / PRPLST: ASCIZ %+/-J - Turn TJ6 mode on/off +/-R - Turn R mode on/off +/-P - Turn PUB mode on/off +/-T - Turn TEX mode on/off +/-S - Turn SCRIBE mode on/off +/-D - Turn context display on/off +/-L - Turn list of close words on/off +/-C - Turn capitalization checking on/off (don't use this yet) % LBLURB: ASCIZ / ^G - Abort entire correction ^L - Restore the display or A - Accept the word, but do not remember it I - Accept word and put it in dictionary #1 0 to 9 - Substitute the numbered choice D1 to D9 - Accept the word and put it in indicated dictionary R - Replace the word manually W - Accept the word and copy the rest of the file without checking / SUBTTL MISCELLANEOUS IO ROUTINES ;PRINT OR WRITE CR AND LF ;WRITE ON OUTPUT FILE IF FWRITE ON, PRINT ON TERMINAL IF OFF ;FILE OUTPUT SUPPRESSED IF NOCORR ON ;CLOBBERS 0 OUTCR: HRRZI ^M PUSHJ P,OUTC HRRZI ^J ; FALL INTO OUTC ;PRINT OR WRITE CHARACTER IN AC0 ;WRITE ON OUTPUT FILE IF FWRITE ON, PRINT ON TERMINAL IF OFF ;FILE OUTPUT SUPPRESSED IF NOCORR ON ;CLOBBERS 0 OUTC: TRNN FLAGS,FWRITE JRST PRINC JRST WRITF ;PRINT OR WRITE WORD (IN 5BIT) POINTED TO BY A, NO FINAL CRLF ;WRITE ON OUTPUT FILE IF FWRITE ON, PRINT ON TERMINAL IF OFF ;FILE OUTPUT SUPPRESSED IF NOCORR ON ;CLOBBERS 0 OUT5: PUSH P,A HRLI A,440500 ;BYTE POINTER WRTW1: ILDB A ;GET ONE LETTER TRNN 34 ;CHECK FOR END JRST POPJA ;(COULD BE JUNK IN LOW 2 BITS) ADDI 75 ;CONVERT TO UPPER CASE ASCII CAIN "Z+1 MOVEI "' ;SPECIAL CODE FOR APOSTROPHE PUSHJ P,OUTC ;WRITE IT JRST WRTW1 ;DECIMAL PRINT OR WRITE AC0 ;WRITE ON OUTPUT FILE IF FWRITE ON, PRINT ON TERMINAL IF OFF ;FILE OUTPUT SUPPRESSED IF NOCORR ON ;CLOBBERS 0 DECPTR: PUSH P,A IDIVI 10. ;QUOTIENT TO 0, REMAINDER TO A SKIPE PUSHJ P,DECPTR ;PRINT MORE DIGITS MOVE A ADDI "0 PUSHJ P,OUTC POPJA: POP P,A POPJ P, ;WRITE OUT THE CONTENTS OF WORDIX ;PLUS THE CHARACTER IN BRKCHR, UNLESS IT IS < 0 PUTWD: MOVE X,[440700,,WORDIX] ILDB X JUMPE .+3 PUSHJ P,WRITF JRST .-3 SKIPGE BRKCHR POPJ P, HRRZ BRKCHR JRST WRITF SUBTTL READ FROM FILE ;READ CHARACTER FROM INPUT FILE, RETURNS IT IN AC0, SKIP IF NOT END OF FILE ; IF END OF FILE, MUST NOT CALL AGAIN ;THIS ALLOWS LAST WORD OF FILE TO BE PADDED WITH ^@, ^A, ^B, ^C READF: ILDB RDAPT CAILE ^C JRST CPOPJ1 ;OK HRRZ RDAPT ;GET WORD IT CAME FROM SKIPE RDEPT ;IS THIS A SHORT BUFFER? JRST READNF ;YES CAIGE RSVLOC ;NO, ARE WE AT THE MARK? JRST RETC ;NO, THE PAD MUST BE REAL MOVE RSVWD ;RESTORE THE SAVED WORD MOVEM RSVLOC MOVN [340000,,LRBUF+1] ADDM RDAPT ;MOVE RDAPT BACK MOVE [RDABF+LRBUF,,RDABF] BLT RBUFF-1 ;COPY STUFF DOWN TO START OF BUFFER MOVE [010700,,RDABF-1] EXCH RDLOP1 MOVEM RDLOP2 ;NOW RDLOP2 -> RBUFF-1 AFTER ;FIRST TRANSFER, RDABF-1 AFTER OTHERS PUSHJ P,RDISK ;READ BLOCK AT RBUFF JRST RDA7 ;BLOCK IS SHORT MOVE RSVLOC MOVEM RSVWD ;SAVE WORD FROM BUFFER SETZM RSVLOC ;CLOBBER IT TO ^@ (SO WILL NOTICE WHEN HIT IT) JRST READF RDA7: HRRZM RDEPT ;POINTS TO WORD AFTER END OF TRANSFER SETZM @RDEPT ;PUT ^@ AT END OF DATA SOS RDEPT ;NOW POINTS TO LAST WORD OF DATA JRST READF READNF: CAMGE RDEPT JRST RETC ;PAD NOT IN LAST WORD OF FILE - IT IS REAL CAMLE RDEPT POPJ P, ;PAST END, FILE HAS ENDED HLRZ RDAPT ;IN LAST WORD, GET POSITION CAIN 350700 ;LEFTMOST BYTE? JRST RETC ;YES, THIS CAN'T BE FILLING END OF FILE PUSH P,RDAPT ;MAKE A COPY OF THE POINTER RDA2: ILDB (P) ;PEEK AT REST OF WORD CAIG ^C ;SEE IF REST OF WORD IS ALL PADS JRST RDA4 ;YES POP P, ;NO, SO THIS IS NOT FILLING END OF FILE RETC: LDB RDAPT ;RELOAD THE PAD JRST CPOPJ1 RDA4: HRRZ (P) ;SEE WHERE WE ARE CAMN RDEPT ;STILL IN SAME WORD? JRST RDA2 ;YES, KEEP PEEKING ;WORD WAS PADDED TO THE END, SO THIS IS END OF FILE POP P, ;THROW AWAY TEMPORARY POINTER POPJ P, ;END OF FILE SUBTTL WRITE, CLOSE FILE ;WRITE AC0 TO OUTPUT FILE, UNLESS NOCORR IS ON ;CLOBBERS 0 WRITF: TRNE FLAGS,NOCORR POPJ P, ;OUTPUT IS SUPPRESSED IDPB WPTR1 MOVE WPTR1 CAME [010700,,WBUF1+177] POPJ P, SUBI 200 MOVEM WPTR1 MOVNI 200 PUSHJ P,WDISK ;WRITE 200 WORDS POPJ P, ;CLOSE OUTPUT FILE ;CLOBBERS 0, A CLOSW: SETZ A, ;COUNTS NUMBER OF PADS WRITTEN CLOSW1: MOVE WPTR1 TLNE 760000 ;ON A WORD BOUNDARY? JRST CLOC3 ;NO SUBI WBUF1-1 ;NOW 010700,,WORDS TO WRITE HRRZS 0 ;WORDS TO WRITE MOVNS 0 JUMPE .+2 PUSHJ P,WDISK ;WRITE LAST BUFFER MOVN WCOUNT ;NUMBER OF WORDS WRITTEN IMULI 5 ;NUMBER OF BYTES, INCLUDING PADS SUB A ;NUMBER OF BYTES OF ACTUAL FILE ;(BYTE COUNT IS USED ONLY ON TNX) PUSHJ P,CLZW ;CLOSE THE FILE POPJ P, CLOC3: MOVEI ^C*%ITS ;PAD REST OF WORD (^C on ITS, ^@ on TNX) TRZ FLAGS,NOCORR ;TO BE SURE IT GETS WRITTEN PUSHJ P,WRITF AOJA A,CLOSW1 ;COUNT NUMBER OF PADS SUBTTL DISPLAY CONTEXT ;DISPLAY CONTEXT AROUND WORD JUST READ. DISPLAYS 1, 2, OR 3 ;LINES, WITH CRLF AFTER EACH. ;MAY DISPLAY MORE, IF LINES ARE LONG AND OPERATING SYSTEM PUTS ;IN CONTINUATION LINES, OR IF FILE HAS CR'S WITHOUT LF'S. ;IF SO, PROMPTING ARROW MAY OVERWRITE STUFF, OR IT MAY HIT ;END OF SCREEN AND GO INTO A **MORE** WAIT. SORRY ABOUT THAT. ;CLOBBERS 0, X, Y, K DISLIN: MOVE RSVWD SKIPN RDEPT MOVEM RSVLOC ;TEMPORARILY RESTORE SAVED WORD ;SEARCH BACKWARD TO LINE FEED MOVE X,RDAPT MOVEI K,20 ;THIS COUNTS CHARACTERS DISL1: ADD X,[070000,,0] ;BACK UP X SKIPGE X SUB X,[430000,,1] CAMN X,RDLOP2 ;AT BEGINNING OF BUFFER? ;RDLOP2 NORMALLY = 010700,,RDABF-1 BUT IS MOVED UP ON FIRST ;BUFFER TO COMPENSATE FOR LACK OF OVERLAP JRST DISL2 ;YES, STOP NOW LDB X CAIE ^J ;SEARCH FOR LINE FEED SOJA K,DISL1 ;KEEP SEARCHING AND COUNTING ;FOUND BEGINNING OF LINE. IF PASSED 20 CHARS, THAT'S ENOUGH. ;IF NOT, DO ONE MORE LINE (BUT NO MORE THAN ONE). TLON K,600000 ;IF K NEGATIVE, ENOUGH JRST DISL1 ;NO, MAKE IT NEGATIVE SO WILL ONLY DO THIS ONCE ;NOW X POINTS JUST BEFORE FIRST CHARACTER TO DISPLAY ;SEARCH FORWARD TO SECOND LINE FEED DISL2: MOVE Y,RDAPT MOVEI K,15 ;COUNTS CHARACTERS ;REASON IT WAS 20 BEFORE AND 15 THIS TIME IS THAT POINTER IS AT END ;OF SUSPECT WORD, THIS SORT OF COMPENSATES FOR IT LDB Y JRST DISL6 DISL4: TLNE Y,760000 ;AT RIGHTMOST BYTE? JRST DISL5 ;NO, DON'T STOP HRRZ Y ;GET WORD BEING POINTED TO CAIGE RBUFF+LRBUF-1 ;END OF BUFFER? CAMN RDEPT ;OR END OF SHORT BUFFER? JRST DISLZ ;YES, STOP DISL5: ILDB Y DISL6: CAIE ^J ;SEARCH FOR LINE FEED SOJA K,DISL4 ;KEEP SEARCHING AND COUNTING ;FOUND END OF LINE. IF PASSED 15 CHARS, THAT'S ENOUGH. ;IF NOT, DO ONE MORE LINE (BUT NO MORE THAN ONE). TLON K,600000 ;IF K NEGATIVE, ENOUGH JRST DISL4 ;NO, MAKE IT NEGATIVE SO WILL ONLY DO THIS ONCE ;NOW Y POINTS TO LAST CHARACTER TO DISPLAY DISL7: CAMN X,Y JRST DISL8 ;DONE ILDB X PUSHJ P,PRINC JRST DISL7 DISL8: SKIPN RDEPT SETZM RSVLOC ;REPLACE ^@ MARKER IF NECESSARY POPJ P, ;HAD TO STOP FORWARD SCAN BECAUSE HIT END--MAY NEED TO FLUSH PADS ; AT END OF FILE TO AVOID UGLINESS DISLZ: LDB Y CAILE ^C JRST DISL7 ;IT'S OK ADD Y,[070000,,0] ;BACK UP Y TO STRIP OFF THE PAD SKIPGE Y SUB Y,[430000,,1] JRST DISLZ ;TRY AGAIN SUBTTL COMMAND PARSING ROUTINES FOR TWENEX IFN %TNX,[ GETCMD: SETZM GJBLK+.GJDEV ;RESET FILE DEFAULTS SETZM GJBLK+.GJNAM SETZM GJBLK+.GJEXT SETZM GJBLK+.GJDIR SETZM GJBLK+.GJPRO SETZM GJBLK+.GJACT SETZM GJBLK+.GJJFN SETOM INJFN ;MARK THE JFN'S UNUSED SETOM OUTJFN SKIPGE LINOPN JRST PARSE ;LINE IS ALREADY OPEN SKIPN LINOPN SETZM JCLFLG ;LAST LINE HAS BEEN CLOSED, NO MORE JCL SETZM COMMIT ;WILL ALLOW REPARSING UNTIL THIS IS SET SETOM LINOPN HRRZS STBLK ;CLEAR OLD ERROR FLAGS MOVE [.PRIIN,,.PRIOUT] SKIPE JCLFLG MOVE [.CTTRM,,.NULIO] MOVEM STBLK+.CMIOJ MOVEI 0 SKIPE JCLFLG MOVEI CMMBLK ;IF READING FROM JCL, ALLOW COMMA HRRM CFMBLK ; AS COMMAND TERMINATOR MOVEI A,STBLK MOVEI B,[.CMINI_27. ? 0 ? 0 ? 0] COMND ;INITIALIZE PARSE: MOVE P,[-LPDL,,PDL-1] ;RESTORE STACK SKIPL A,INJFN ;FLUSH ANY LEFTOVER JFNS RLJFN ; (THEY ARE NOT OPEN) JFCL SETOM INJFN SKIPL A,OUTJFN RLJFN JFCL SETOM OUTJFN SETZM NOPNFG ;WILL BE SET BY "SAVE" COMMAND PUSHJ P,CKPRSI ;READ FIRST COMMAND .CMKEY_27.+CM%HPP ? KTABLE ? -1,,[ASCIZ /command,/] ? 0 HRRZ D,(B) JRST (D) ;;GET HERE AT END OF ANY COMMAND ENDCMD: SETOM COMMIT ;UNTIL END OF LINE SEEN, CAN'T ALLOW JRST TBLURB ; ANY REPARSE, ELSE WOULD DO THE COMMAND OVER ;;; CHECK THAT THERE IS NOTHING FURTHER IN COMMAND ;;; THIS ALWAYS RETURNS WITH C=0 CONFRM: MOVEI B,CFMBLK ;CFMBLK IS IN VARIABLES AREA BECAUSE IT JRST CKPRSE ; GETS MODIFIED: WHEN READING FROM JCL ; IT ALLOWS A COMMA AS WELL AS A CR ;;; LOOK FOR LINE NUMBER, RETURN IT IN B WITH C~=0 ;;; PROMPT AS SHOWN NUMLIN: JSP B,CKPRSE .CMNUM_27.+CM%HPP+CM%SDH ? 10. ? -1,,[ASCIZ /starting line number/] ? 0 ;;; LOOK FOR NUMBER OR NOTHING ;;; C=0 IF NOTHING, C~=0 IF NUMBER, VALUE IN B ;;; PROMPT AS "DECIMAL NUMBER" CFMNUM: JSP B,CKPRSE ;LOOK FOR NUMBER OR RETURN .CMNUM_27.+CFMBLK ? 10. ? 0 ? 0 ;;; LOOK FOR SWITCH OR NOTHING ;;; C=0 IF NOTHING, C~=0 IF SWITCH CFSWIT: JSP B,CKPRSE ;LOOK FOR SWITCH OR RETURN CFSWTB: .CMSWI_27.+CM%HPP+CFMBLK ? STABLE ? -1,,[ASCIZ /switch,/] ? 0 ;;; LOOK FOR WORD, PACK IT WORDIX FOLLOWED BY NULL ;;; ALSO IN WORDIN (IN FIVEBIT) AND LENGTH IN W ;;; THIS ALWAYS RETURNS WITH C~=0 ;;; PROMPT AS SHOWN WRDPRS: MOVEI B,WDP1 PUSHJ P,CKPRSE ;LOOK FOR TEXT STRING MOVE [ABP,,WORDIX] BLT WORDIX+10. ;SAVE WORD IN WORDIX SETZB W,WORDIN MOVE [WORDIN,,WORDIN+1] BLT WORDIN+6 ;CLEAR WORDIN MOVE X,[440700,,WORDIX] MOVE Y,[440500,,WORDIN] JVL1: ILDB X ;PACK WORD INTO FIVEBIT JUMPE CPOPJ CAIN "' MOVEI "Z+1 TRZ 740 ;IGNORE CASE ADDI 3 IDPB Y AOJA W,JVL1 ;;; BREAK CHARACTER MASKS FOR WRDPRS ARE SET UP SO THAT ;;; ALL ARE BREAK EXCEPT LETTERS AND APOSTROPHE WDP1: .CMFLD_27.+CM%HPP+CM%BRK ? 0 ? -1,,[ASCIZ /word to check/] ? 0 ? .+1 777777,,777760 ? 775777,,777760 ? 400000,,000760 ? 400000,,000760 ;;; LOOK FOR OPTION NAME, RETURN WITH D=ADDRESS OF BITS WORD IN MTAB ;;; THIS ALWAYS RETURNS WITH C~=0 ;;; PROMPT AS SHOWN OPTPRS: PUSHJ P,CKPRSI .CMKEY_27.+CM%HPP ? OTABLE ? -1,,[ASCIZ /option,/] ? 0 HRRZ D,(B) POPJ P, ;;; LOOK FOR INPUT FILE OR NOTHING ;;; C=0 IF NOTHING, C~=0 IF FILE ;;; SEE COMMENTS AT OPENR CFMFIL: PUSHJ P,NOISE MOVSI A,(GJ%OLD+GJ%CFM+GJ%FNS) MOVEM A,GJBLK+.GJGEN JSP B,CKPRSE .CMFIL_27.+CFMBLK ? 0 ? 0 ? 0 ;;; LOOK FOR OUTPUT FILE, SWITCH, OR NOTHING ;;; IF GET FILE, NO SKIP, LEAVE C~=0 ;;; OTHERWISE, SKIP -- C=0 IF NOTHING, C~=0 IF SWITCH ;;; SEE COMMENTS AT OPENW CFFLSW: MOVSI A,(GJ%FOU+GJ%MSG+GJ%CFM+GJ%FNS) MOVEM A,GJBLK+.GJGEN PUSHJ P,CKPRSI .CMFIL_27.+CFSWTB ? 0 ? 0 ? 0 CAIE C,.CMFIL_9. ;GOT A FILE? AOS (P) POPJ P, ;; PRINT GUIDE WORD, POINTER TO TEXT IN Z NOISE: HRRM Z,NZBLK+1 MOVEI B,NZBLK JRST CKPRSE ;; CHECK RESULT OF PARSE, WILL ABORT AND START OVER IF NOT RIGHT ;; LEAVES C WITH ADDRESS OF COMMAND BLOCK THAT WAS USED, ;; OR ZERO IF COMMAND HAS BEEN FULLY PARSED (C.R. OR COMMA) ;; IF C=0, CALLER MUST GO AHEAD WITH THE COMMAND AND GO TO ENDCMD, ;; THE FILES WILL BE OPEN ;; C=0 WILL HAPPEN ONLY IF CALLER REQUESTED IT BY CALLING CONFRM OR ;; SOME FUNCTION INCLUDING CFMBLK CKPRSE: HRRZS B ;CLEAR JUNK IN LEFT HALF MOVEM B,BSAVE MOVEI A,STBLK COMND HRRZS C ;NOW C HAS FUNCTION BLOCK THAT IT USED TLNN A,(CM%RPT+CM%NOP) ;SEE IF IT FAILED OR GOT RUBBED OUT JRST PRSOK ;IT WORKED TLNE A,(CM%NOP) JRST PRSNOK ;IT FAILED SKIPN COMMIT ;IT GOT RUBBED OUT, JUST REPARSE IT JRST PARSE PLOSE: HRROI A,[ASCIZ /You can't reparse through this stuff!!!!!! /] PSOUT ;;IF READING FROM JCL AND END OF LINE HASN'T BEEN SEEN, FLUSH REST OF LINE FIXJCL: TLNN A,(CM%EOC) ;SKIP IF END OF LINE SEEN SKIPN JCLFLG JRST JCFE HRRZS STBLK ;CLEAR OLD ERROR FLAGS MOVEI B,[.CMTXT_27. ? 0 ? 0 ? 0] MOVEI A,STBLK COMND ;FLUSH THE LINE BY FORCING READ TO LINEFEED JCFE: SETZM JCLFLG SETZM LINOPN JRST TBLURB PRSOK: HLRZ C,(C) ;GET THE FUNCTION THAT WAS PERFORMED CAIE C,.CMFIL_9. ;SEE IF IT WAS A FILE NAME JRST PRSOQ ;NO MOVE GJBLK+.GJGEN ;SEE WHETHER READ OR WRITE TLNE (GJ%OLD) HRRZM B,INJFN ;READ TLNN (GJ%OLD) HRRZM B,OUTJFN ;WRITE PRSOQ: CAIN C,.CMCFM_9. SETZM LINOPN CAIE C,.CMCFM_9. CAIN C,.CMCMA_9. SKIPA POPJ P, ;NOT FINISHED READING COMMAND SKIPGE A,INJFN ;SEE WHETHER TO OPEN INPUT FILE JRST CKOPW ;NO MOVEI B,OF%RD+OF%PLN ;READ, FORGET ABOUT "LINE NUMBERS" OPENF JRST OPNFA3 SKIPE DCTVER ;AM I LOOKING FOR A DICTIONARY VERSION? JRST CKOPW ;NO, FINISHED HRROI A,DCTVER ;YES, GET VERSION OF THIS FILE MOVE B,INJFN MOVSI C,(JS%GEN/7*.JSAOF) ;GET GENERATION NUMBER JFNS CKOPW: SKIPL A,OUTJFN ;SEE WHETHER TO OPEN OUTPUT FILE SKIPE NOPNFG JRST CLRC ;NO MOVEI B,OF%WR+OF%PLN ;WRITE, FORGET ABOUT "LINE NUMBERS" OPENF JRST OPNFA4 CLRC: SETZ C, ;TELL CALLER COMMAND READING IS FINISHED POPJ P, OPNFA3: MOVE A,INJFN SKIPA OPNFA4: MOVE A,OUTJFN CLOSF ;FLUSH THE CREATED JFN JFCL JRST CMDERN ;;; PARSE FAILED, MAYBE JUST NEED BETTER FILENAME DEFAULTS ;;; WE FIRST TRY TO OPEN THE FILE WITH DEFAULT EXTENSION = WHAT ;;; THE FORMATTER MODE INDICATES (R, MSS, ...). IF A FILE EXISTS ;;; WITH CORRECT FIRST NAME BUT WRONG EXTENSION, THAT WILL FAIL. ;;; TRYING AGAIN WITH NO DEFAULT EXTENSION WILL WIN. PRSNOK: SKIPN GJBLK+.GJEXT ;SEE IF ALREADY USING NO DEFAULT JRST CMDERR ;YES (OR NOT DOING FILES AT ALL), TOO BAD MOVE GJBLK+.GJGEN ;SEE WHETHER READ OR WRITE TLNN (GJ%OLD) JRST CMDERR ;WRITE, TOO BAD SETZM GJBLK+.GJEXT ;USED A DEFAULT EXTENSION, TRY AGAIN WITH NONE MOVE B,BSAVE JRST CKPRSE CMDERR: TLNE A,(CM%EOC) SETZM LINOPN ;HE TYPED A CR, LINE IS CLOSED TLNE A,(CM%EOC) JRST CMDERN PUSH P,A ;*** CROCK HRROI A,[ASCIZ / /] PSOUT POP P,A ;*** CROCK CMDERN: PUSH P,A ;*** CROCK HRROI A,[ASCIZ /?/] PSOUT MOVEI A,.PRIOU MOVE B,[.FHSLF,,-1] SETZ C, ERSTR ;PRINT THE ERROR MESSAGE JFCL JFCL POP P,A ;*** CROCK SKIPE COMMIT JRST PLOSE JRST FIXJCL ;; CALL CKPRSE WITH NEXT 4 WORDS AS FUNCTION BLOCK CKPRSI: HRRZ B,(P) PUSHJ P,CKPRSE MOVEI 4 ADDM (P) POPJ P, KTABLE: KTABE-.-1,,KTABE-.-1 [ASCIZ /ASK/],,EVAL [CM%FW+CM%INV ? ASCIZ /BASK/],,EVALB [ASCIZ /CORRECT/],,ITSCOR [ASCIZ /DUMP/],,NDUMP [ASCIZ /EXIT/],,QUIT [ASCIZ /HELP/],,HELP [ASCIZ /JUMBLE/],,JUMBLE [ASCIZ /KILL/],,KILL [ASCIZ /LOAD/],,NLOAD [ASCIZ /NO/],,MODCLR [ASCIZ /QUIT/],,QUIT [ASCIZ /SET/],,MODSET [ASCIZ /TRAIN/],,ITSTRN [CM%FW+CM%INV ? ASCIZ /WRITE/],,SAVEME KTABE: STABLE: STABE-.-1,,STABE-.-1 [ASCIZ /LINE:/],,0 STABE: OTABLE: OTABE-.-1,,OTABE-.-1 CMNAME,,CMBITS DMNAME,,DMBITS LMNAME,,LMBITS PMNAME,,PMBITS RMNAME,,RMBITS SMNAME,,SMBITS TMNAME,,TMBITS JMNAME,,JMBITS OTABE: ] SUBTTL COMMAND PARSING ROUTINES FOR ITS IFN %ITS,[ GETCMD: MOVE P,[-LPDL,,PDL-1] ;RESTORE STACK MOVEI Z,[ASCIZ /SPELL --> /] PUSHJ P,TYPLIN ;GET LINE INTO CMDBUF ; (WRDPRS CLOBBERS WORDIX, AND WORDIX ; ISN'T LONG ENOUGH ANYWAY) JRST ICTLG ;TYPED CONTROL-G OR QUESTION MARK MOVE [440700,,CMDBUF] MOVEM TTIPTR ILDB A,TTIPTR ;IGNORE INITIAL SPACES OR CONTROL CHARS JUMPE A,TBLURB ;LINE WAS ESSENTIALLY EMPTY CAIG A,40 JRST .-3 SETZ B, ;B GETS SIXBIT CMD NAME, PADDED WITH BLANKS. SETO K, ;K GETS SIXBIT CMD NAME, PADDED WITH _'S. MOVE C,[440600,,B] MOVE M,[440600,,K] SKIPA ;ALREADY HAVE FIRST CHARACTER LP1: ILDB A,TTIPTR CAIL A,140 ;CONVERT LOWER CASE TO UPPER. SUBI A,40 CAIL A,"0 CAILE A,"9 CAIL A,"A CAILE A,"Z JRST LP2 ;THIS CHAR IS A DELIMITER. SUBI A,40 ;NO, CONVERT TO SIXBIT. TLNE C,770000 IDPB A,C TLNE M,770000 IDPB A,M JRST LP1 ;B HAS NAME OF CMD, IN SIXBIT, PADDED WITH SPACES, ;K HAS SIXBIT NAME PADDED WITH _'S. ANY KEYWORD THAT THE TYPED ;COMMAND IS AN ABBREVIATION FOR MUST LIE BETWEEN THOSE 2 VALUES. LP2: JUMPE B,CERR ;NULL COMMAND?? MOVSI L,-KEYTBL/2 ;AOBJN -> KEYWORD TABLE. CAMLE B,KEYTAB(L) ;MOVE UP TO 1ST KEYWD ABOVE BOTTOM OF RANGE AOBJN L,[AOJA L,.-1] CAMGE K,KEYTAB(L) JRST CERR ;IF THAT IS BEYOND THE RANGE, ILLEGAL CMD. CAMN B,KEYTAB(L) ;IF USER HAS GIVEN WHOLE NAME OF A COMMAND, JRST LP5 ;THAT'S GOOD, EVEN IF IT ABBREVIATES OTHERS CAML K,KEYTAB+2(L) JRST CERR ;IF THERE ARE 2 KEYWDS IN RANGE, AMBIGUOUS CMD. LP5: JRST @KEYTAB+1(L) ;;GET HERE AT END OF ANY COMMAND ENDCMD: JRST CBLURB KEYTAB: SIXBIT /ASK/ ? EVAL SIXBIT /BASK/ ? EVALB SIXBIT /CORREC/ ? ITSCOR SIXBIT /DUMP/ ? NDUMP SIXBIT /EXIT/ ? QUIT SIXBIT /HELP/ ? HELP SIXBIT /JUMBLE/ ? JUMBLE SIXBIT /KILL/ ? KILL SIXBIT /LOAD/ ? NLOAD SIXBIT /NO/ ? MODCLR SIXBIT /QUIT/ ? QUIT SIXBIT /SET/ ? MODSET SIXBIT /TRAIN/ ? ITSTRN SIXBIT /WRITE/ ? SAVEME 377777 ? 0 KEYTBL=.-KEYTAB CERR: TYPE [[ASCIZ /HUH?/]] ZERR: SETZM JCLFLG ;TURN OFF JCL READING JRST CBLURB ;READ INSTRUCTION AGAIN ICTLG: CAIN A,^G JRST CBLURB ;^G PUSHJ P,CLEARS ;QUESTION MARK TYPE XBLURB ;PRINT SHORT DIRECTIONS PUSHJ P,PROPT ;PRINT CURRENT OPTIONS CBLURB: TYPE [[ASCIZ / /]] JRST TBLURB ;;; START PARSING A FIELD SKIP WITH CHAR IN A IF THERE IS REAL TEXT STFLD: LDB A,TTIPTR SKIPA ILDB A,TTIPTR ;FLUSH BLANKS ETC. JUMPE A,CPOPJ ;END OF LINE CAIG A,40 JRST .-3 JRST CPOPJ1 ;THERE IS SOMETHING THERE ;;; CHECK THAT THERE IS NOTHING FURTHER IN COMMAND ;;; THIS ALWAYS RETURNS WITH C=0 CONFRM: PUSHJ P,STFLD JRST CZ ;OK, END OF LINE TYPE [[ASCIZ /?extra stuff in command?/]] JRST ZERR CZ: SETZ C, POPJ P, ;;; LOOK FOR LINE NUMBER, RETURN IT IN B WITH C~=0 NUMLIN: SETZ B, PUSHJ P,STFLD JRST CERR ;NOTHING? NUMLI2: SUBI A,60 JUMPL A,CERR CAIL A,12 JRST CERR ;NOT A DIGIT IMULI B,12 ADD B,A ILDB A,TTIPTR CAILE A,40 JRST NUMLI2 JRST CNZ ;;; LOOK FOR NUMBER OR NOTHING ;;; C=0 IF NOTHING, C~=0 IF NUMBER, VALUE IN B CFMNUM: LDB TTIPTR CFMNU1: JUMPE CZ ;NOTHING CAIN ", JRST .+3 CAILE 40 JRST NUMLIN ILDB TTIPTR ;FLUSH BLANKS ETC. JRST CFMNU1 ;;; LOOK FOR SWITCH OR NOTHING ;;; C=0 IF NOTHING, C~=0 IF SWITCH CFSWIT: PUSHJ P,STFLD JRST CZ ;NOTHING CFSWI2: CAIE A,"/ JRST CERR ;NOT A SWITCH ILDB A,TTIPTR ;START INTO NEXT FIELD CNZ: SETO C, ;RETURN WITH C NONZERO POPJ P, ;;; LOOK FOR WORD, PACK IT WORDIX FOLLOWED BY NULL ;;; ALSO IN WORDIN (IN FIVEBIT) AND LENGTH IN W ;;; THIS ALWAYS RETURNS WITH C~=0 WRDPRS: SETZB W,WORDIN MOVE [WORDIN,,WORDIN+1] BLT WORDIX+10. ;CLEAR WORDIN, WORDIX MOVE B,[440700,,WORDIX] MOVE Y,[440500,,WORDIN] PUSHJ P,STFLD JRST CERR ;NOTHING? FLDBL2: IDPB A,B ;PACK ASCII CAIN A,"' MOVEI A,"Z+1 TRZ A,740 ;IGNORE CASE ADDI A,3 IDPB A,Y ;PACK FIVEBIT ILDB A,TTIPTR ;GET NEXT CAIE A,", ;EXIT IF COMMA, SPACE, OR CONTROL CHAR CAIG A,40 AOJA W,CNZ AOJA W,FLDBL2 ;;; LOOK FOR OPTION NAME, RETURN WITH D=ADDRESS OF BITS WORD IN MTAB ;;; THIS ALWAYS RETURNS WITH C~=0 ;;; ON ITS, AN OPTION NAME IS ONE LETTER ONLY, WITH "J" MEANING TJ6 OPTPRS: PUSHJ P,WRDPRS LDB A,[350700,,WORDIX] ;EXAMINE FIRST LETTER **** WHAT A CROCK TRZ A,40 ;CONVERT TO UPPER CASE MOVNI C,MTABE-MTAB CAME A,MTABE-MTAB(C)+MTABE AOJL C,.-1 ;SEARCH JUMPGE C,CERR ;NOT THERE MOVEI D,MTABE(C) JRST CNZ ;;; LOOK FOR INPUT FILE OR NOTHING ;;; C=0 IF NOTHING, C~=0 IF FILE ;;; SEE COMMENTS AT OPENR CFMFIL: SETZM RWSWT SETOM FLSWSW ;FLSWSW = -1 JRST OPP2 ;;; LOOK FOR OUTPUT FILE, SWITCH, OR NOTHING ;;; IF GET FILE, NO SKIP, LEAVE C~=0 ;;; OTHERWISE, SKIP -- C=0 IF NOTHING, C~=0 IF SWITCH ;;; SEE COMMENTS AT OPENW CFFLSW: SETOB RWSWT HRRZM FLSWSW ;SET FLSWSW NONZERO BUT POSITIVE JRST OPP2 NOISE: POPJ P, ] SUBTTL BASIC TERMINAL IO ROUTINES FOR ITS IFN %ITS,[ ;PRINT CHARACTER IN 0, FORMATS CONTROL CHARACTERS FOR NICE DISPLAY ;DON'T PRINT IF JCL IS WAITING ;CLOBBERS 0 PRINC: TRNE FLAGS,TFORCE JRST .+3 SKIPE JCLFLG POPJ P, ;JCL IS WAITING, SUPPRESS OUTPUT SKIPN TOPEND PUSHJ P,TTYOPN ;OPEN TTY IF NECESSARY CAIN 177 POPJ P, ;DON'T PRINT RUBOUT CAIE ^M CAIN ^J JRST PRINC1 ;PRINT CR OR LF CORRECTLY CAIE ^I ;OR TAB CAIL 40 ;BUT NO OTHER CONTROL CHARS JRST PRINC1 .IOT TTYO,["^] ;DO CONTROL CHARACTER CAREFULLY ADDI 100 PRINC1: .IOT TTYO,0 POPJ P, ;PRINT ASCIZ STRING POINTED TO BY 0, RECOGNIZE CONTROL-P CODES ;DON'T PRINT IF JCL IS WAITING ;CLOBBERS 0 STTYO: PUSH P,A TRNE FLAGS,TFORCE JRST .+3 SKIPE JCLFLG JRST POPJA ;JCL IS WAITING, SUPPRESS OUTPUT SKIPN TOPEND PUSHJ P,TTYOPN ;OPEN TTY IF NECESSARY PUSH P,B HRLI 440700 ;MAKE A BYTE POINTER MOVEM STTYA SETZ B, ;TO COUNT CHARACTERS ILDB A, JUMPE A,.+2 ;REACHED END AOJA B,.-2 .CALL [SETZ SIXBIT /SIOT/ SUBI %TJDIS ;RECOGNIZE ^P CODES ADDI TTYO ;CHANNEL STTYA ;STRING TO PRINT SETZ B] ;COUNT .LOSE 1000 POP P,B JRST POPJA ;CLEAR SCREEN CLEARS: TRNE FLAGS,TFORCE JRST .+3 SKIPE JCLFLG POPJ P, ;JCL IS WAITING, SUPPRESS OUTPUT SKIPN TOPEND PUSHJ P,TTYOPN ;OPEN TTY IF NECESSARY SKIPN DSPTTY JRST OUTCR ;IF NOT A DISPLAY, PRINT CR TYPE [[ASCIZ /C/]] POPJ P, ;CLEAR REST OF SCREEN, CURSOR SHOULD BE AT LEFT EDGE ;CLOBBERS 0 CLEARF: TRNE FLAGS,TFORCE JRST .+3 SKIPE JCLFLG POPJ P, ;JCL IS WAITING, SUPPRESS OUTPUT SKIPN TOPEND PUSHJ P,TTYOPN ;OPEN TTY IF NECESSARY SKIPN DSPTTY POPJ P, ;DO NOTHING IF NOT A DISPLAY TYPE [[ASCIZ /HE/]] POPJ P, ;CLEAR LINE, CURSOR SHOULD BE AT LEFT EDGE ;CLOBBERS 0 CLEARL: TRNE FLAGS,TFORCE JRST .+3 SKIPE JCLFLG POPJ P, ;JCL IS WAITING, SUPPRESS OUTPUT SKIPN TOPEND PUSHJ P,TTYOPN ;OPEN TTY IF NECESSARY SKIPN DSPTTY POPJ P, ;DO NOTHING IF NOT A DISPLAY TYPE [[ASCIZ /L/]] POPJ P, ;SET VERTICAL CURSOR POSITION TO POSITION GIVEN IN FOLLOWING WORD ;AND MOVE TO LEFT EDGE OF SCREEN ;CLOBBERS 0 VPOS: TRNE FLAGS,TFORCE JRST .+3 SKIPE JCLFLG JRST CPOPJ1 ;JCL IS WAITING, SUPPRESS OUTPUT SKIPN TOPEND PUSHJ P,TTYOPN ;OPEN TTY IF NECESSARY SKIPN DSPTTY JRST CPOPJ1 ;DO NOTHING IF NOT A DISPLAY MOVE @(P) ;GET POSITION TO USE ADDI 10 ;ITS SUPERVISOR REQUIRES THIS DPB [170700,,VPSTF] ;INSERT IT INTO "^PV" SEQUENCE TYPE VPSTF JRST CPOPJ1 ;READ CHARACTER FROM TERMINAL (OR FROM JCL STRING), RESULT TO A ;CLOBBERS 0, A TTYIN: TRNN FLAGS,TFORCE SKIPN JCLFLG ;SEE IF JCL CHAR IS WAITING JRST TTYI2 ;NO, GET CHARACTER FROM TERMINAL ILDB A,JCLFLG ;YES, GET FOLLOWING CHAR CAIN A,^M SETZM JCLFLG ;JCL RAN OUT POPJ P, TTYI2: SKIPN TOPEND PUSHJ P,TTYOPN ;OPEN TTY IF NECESSARY .IOT TTYI,A POPJ P, ;OPEN TTY FOR INPUT AND OUTPUT ;CLOBBERS NOTHING TTYOPN: PUSH P,A PUSH P,0 .OPEN TTYI,[.UAI,,'TTY] .VALUE [ASCIZ /:OPEN FAILED/] .OPEN TTYO,[.UAO,,'TTY] .VALUE [ASCIZ /:OPEN FAILED/] .CALL [SETZ SIXBIT /CNSGET/ ADDI TTYO ADDM ADDM ADDM ADDM SETZM A] .VALUE [ASCIZ /:CNSGET FAILED/] TLNE A,%TOMVU ;IS THIS A DISPLAY? SETOM DSPTTY SETOM TOPEND ;SO I DON'T DO IT AGAIN POP P,0 JRST POPJA SUBTTL OPEN DISK FILE ;OPEN INPUT OR OUTPUT FILE, Z HAS PROMPTING MESSAGE ;IF DCTVER IS ZERO (I.E. THIS IS THE FIRST FILE WE HAVE ; EVER READ ANYTHING), PUT VERSION NUMBER INTO DCTVER FOR ; PRINTING NEXT TIME PROGRAM IS STARTED ;DIRECTS OUTPUT TO TERMINAL BY CLEARING FWRITE ;CLOBBERS 0, A, B, C, D, W, X, WORDIN, WORDIX, FWRITE OPENR: SETZM RWSWT ;REMEMBER WHAT WE ARE DOING SKIPA OPENW: SETOM RWSWT ;REMEMBER WHAT WE ARE DOING SETZM FLSWSW OPP2: TRZ FLAGS,FWRITE ;DIRECT OUTPUT TO TERMINAL MOVSI 'DSK MOVEM DEVICE ;DEFAULT DEVICE MOVEI B,FNML-1 ;POINTER TO LIST OF NAMES LDB A,TTIPTR TLOA C,-1 ;SKIP WHILE SETTING C .LT. 0 FOR FNEND GETF0: ILDB A,TTIPTR ;FLUSH BLANKS ETC. JUMPE A,FNEND ;NOTHING CAIN A,"/ JRST FNEND CAIE A,", CAIG A,40 JRST GETF0 GETF1: SETZM D ;NAME WILL BE PACKED HERE MOVE C,[440600,,D] ;PACKING POINTER GETF2: CAIN A,": JRST COLON CAIN A,"; JRST SEMI CAIN A,40 JRST SPACE CAIN A,"/ ;CHECK FOR FILENAME TERMINATORS JRST FNEND ;SLASH CAIE A,33 CAIN A,", JRST FNEND ;ALTMODE OR COMMA CAIN A,^Q ILDB A,TTIPTR ;GET NEXT CHARACTER AND QUOTE IT JUMPE A,FNEND ;END OF LINE (YES, EVEN IF QUOTED) SUBI A,40 ;CONVERT TO SIXBIT CAIL A,100 SUBI A,40 JUMPL A,ILF ;ILLEGAL CHARACTER TLNE C,770000 IDPB A,C ;STORE UNLESS ALREADY FULL ILDB A,TTIPTR ;GET NEXT CHARACTER JRST GETF2 COLON: PUSHJ P,FNPK CAIN B,FNML-1 JRST ILF ;NO DEVICE GIVEN POP B,DEVICE JRST GETF9 SEMI: PUSHJ P,FNPK CAIN B,FNML-1 JRST ILF ;NO SNAME GIVEN POP B,SNAME JRST GETF9 SPACE: PUSHJ P,FNPK GETF9: ILDB A,TTIPTR ;GET NEXT CHARACTER JRST GETF1 FNEND: PUSHJ P,FNPK ;PACK FINAL NAME IF ANY CAIE B,FNML-1 ;SEE IF ANY FILENAMES AT ALL JRST FNEN3 ;YES MOVSI 'DSK CAMN DEVICE JRST NOFLNM ;NO DEVICE OR FILENAME PUSH B,[SIXBIT /(NIL)/] FNEN3: CAMN B,[1,,FNML] ;SEE IF ONLY ONE NAME PUSH B,[SIXBIT />/] ;YES, SET DEFAULT SECOND NAME CAME B,[2,,FNML+1] JRST ILF ;TOO MANY NAMES SKIPE RWSWT JRST OPNWW ;WRITING .CALL [SETZ ;READING SIXBIT /OPEN/ [.BII,,DKIN] DEVICE FNML ;FIRST FILENAME FNML+1 ;SECOND FILENAME SETZ SNAME] JRST TRYAGN ;FAILED SKIPE DCTVER ;AM I LOOKING FOR A DICTIONARY VERSION? JRST CNZ ;NO, FINISHED .CALL [SETZ ;YES, GET VERSION OF THIS FILE SIXBIT /RFNAME/ ADDI DKIN ;CHANNEL ADDM ADDM SETZM DCTVER] .LOSE 1000 JRST CNZ OPNWW: .CALL [SETZ SIXBIT /OPEN/ [.BIO,,DKO1] DEVICE [SIXBIT /_SPELL/] [SIXBIT /OUTPUT/] SETZ SNAME] JRST TRYAGN ;FAILED JRST CNZ NOFLNM: SKIPN A,FLSWSW ;NO FILENAME GIVEN JRST CERR ;ERROR UNLESS CALL WAS TO CFFLSW OR CFMFIL JUMPL A,CZ ;CFMFIL: RETURN WITH C=0 AOS (P) ;CFFLSW: SWITCH OR NOTHING, MUST SKIP LDB TTIPTR CAIE "/ JRST CONFRM ;NOT SWITCH, MUST BE NOTHING JRST CNZ ;****** CROCK!!!! SHOULD ACTUALLY LOOK AT IT ILF: TYPE [[ASCIZ /?Bad file name?/]] JRST ZERR ;FILE OPEN FAILED, PRINT ERROR MESSAGE TRYAGN: SETZM JCLFLG ;FLUSH JCL READING .CALL [SETZ ;GET ERROR MESSAGE FROM SYSTEM SIXBIT /OPEN/ [.UAI,,ERCHN] [SIXBIT /ERR/] SETZI 1] ;CODE FOR LAST ERROR JRST ZERR ;FAILED ?? .IOT ERCHN,0 ;READ CHARACTER OF ERROR MESSAGE CAIGE 40 JRST ZERR ;END OF STRING PUSHJ P,OUTC ;PRINT IT JRST .-4 ;PUT AWAY FILE NAME, IF ANY FNPK: JUMPL C,CPOPJ CAME B,[3,,FNML+2] PUSH B,D ;STORE NAME UNLESS TOO MANY ALREADY POPJ P, ;READ BLOCK OF INPUT FILE INTO RBUFF. LENGTH IS LRBUF. ;SKIP IF FULL LENGTH BLOCK, OTHERWISE RH OF 0 HAS ADDRESS PAST LAST WORD ;CLOBBERS 0 RDISK: MOVE [-LRBUF,,RBUFF] .IOT DKIN,0 CAIN RBUFF+LRBUF AOS (P) POPJ P, ;WRITE BLOCK OF OUTPUT FILE FROM WBUF1. LENGTH (NONZERO) IS NEGATED IN 0. ;MAINTAINS NEGATIVE OF NUMBER OF WORDS WRITTEN IN WCOUNT ;CLOBBERS 0, WCOUNT WDISK: ADDM WCOUNT HRLZS 0 ;-COUNT,,0 ADDI WBUF1 ;-COUNT,,ADDR .IOT DKO1,0 POPJ P, ;CLOSE INPUT FILE CLOSR: .CLOSE DKIN, POPJ P, ;CLOSE OUTPUT FILE, 0 HAS COUNT OF REAL CHARACTERS ; (NOT INCLUDING PADS) CLZW: .CALL [SETZ SIXBIT /RENMWO/ ADDI DKO1 FNML SETZ FNML+1] JFCL .CLOSE DKO1, POPJ P, ] SUBTTL BASIC TERMINAL IO ROUTINES FOR TWENEX ;THESE ROUTINES ALL BEHAVE EXACTLY AS THEIR ITS COUNTERPARTS DO IFN %TNX,[ PRINC: TRNE FLAGS,TFORCE JRST .+3 SKIPE JCLFLG POPJ P, ;JCL IS WAITING, SUPPRESS OUTPUT PUSH P,A CAIN 177 JRST POPJA ;DON'T PRINT RUBOUT CAIE ^M CAIN ^J JRST PRINC1 ;PRINT CR OR LF CORRECTLY CAIE ^I ;OR TAB CAIL 40 ;BUT NO OTHER CONTROL CHARS JRST PRINC1 MOVEI A,"^ ;DO CONTROL CHARACTER CAREFULLY PBOUT ADDI 100 PRINC1: MOVE A,0 PBOUT JRST POPJA STTYO: TRNE FLAGS,TFORCE JRST .+3 SKIPE JCLFLG POPJ P, ;JCL IS WAITING, SUPPRESS OUTPUT PUSH P,A HRRO A,0 PSOUT JRST POPJA ;SET VERTICAL CURSOR POSITION TO POSITION GIVEN IN FOLLOWING WORD ;AND MOVE TO LEFT EDGE OF SCREEN ;CLOBBERS 0, B, C VPOS: PUSH P,A HRLZ C,@-1(P) ;GET POSITION TO USE, IN LEFT HALF AOS -1(P) JSP A,PRTPRT IFN %VTS,[ TC%MOV ;WHAT BIT WE NEED IN TCHAR DP%AG1+DP%AG2+.VTMOV ;WHAT KIND OF VTSOP TO DO IF BIT IS ON ] .ELSE [0 ? 0] 0 ;WHAT CODE TO USE IN CPTAB IF BIT IS OFF ;CLEAR SCREEN ;;; CLOBBERS B, C CLEARS: PUSH P,A JSP A,PRTPRT IFN %VTS,[ TC%CLR ;WHAT BIT WE NEED IN TCHAR .VTCLR ;WHAT KIND OF VTSOP TO DO IF BIT IS ON ] .ELSE [0 ? 0] 1 ;WHAT CODE TO USE IN CPTAB IF BIT IS OFF ;CLEAR REST OF SCREEN, CURSOR SHOULD BE AT LEFT EDGE ;;; CLOBBERS B, C CLEARF: PUSH P,A JSP A,PRTPRT IFN %VTS,[ TC%SCL .VTCEW ] .ELSE [0 ? 0] 2 ;CLEAR LINE, CURSOR SHOULD BE AT LEFT EDGE ;;; CLOBBERS B, C CLEARL: PUSH P,A JSP A,PRTPRT IFN %VTS,[ TC%SCL .VTCEL ] .ELSE [0 ? 0] 3 PRTPRT: TRNE FLAGS,TFORCE JRST .+3 SKIPE JCLFLG JRST POPJA ;JCL IS WAITING, SUPPRESS OUTPUT ;;;EXAMINE TERMINAL CHARACTERISTICS WORD AND SEE IF THE TERMINAL ;;;KNOWS HOW TO DO THIS DIRECTLY. MOVE B,TCHAR TDNN B,(A) JRST CRUD ;TOO BAD IFN %VTS,[ MOVE B,1(A) ;OPERATION TO DO (IF CURSOR POSITIONING, MOVEI A,.PRIIN ; DESIRED POSITION IS IN C LEFT) VTSOP JRST POPJA ] ;;;MUST DO IT THE HARD WAY, FIND OUT WHICH BLOCK OF CPTAB TO USE ;;; 2(A) HAS WORD TO USE IN THAT BLOCK: 0=VPOS, 1=CLEARS, 2=CLEARF, 3=CLEARL CRUD: HLRZ C ;LINE NUMBER, IF DOING VPOS MOVE C,LTCTYP ;BLOCK DEPENDS ON TERMINAL, 0 IF PRINTING ASH C,2 ;BLOCK SIZE IS 4 ADD C,2(A) ;INDEX OF DESIRED WORD IN DESIRED BLOCK SKIPN 2(A) JRST CPTAB(C) ;DOING A VPOS, WORD HAS A JRST TO THE ROUTINE MOVE C,CPTAB(C) ;OTHERS, WORD HAS ASCIZ STRING ;;;PRINT ASCIZ STRING IN C IN DIRECT ACCESS MODE PRTDAM: MOVEI A,.PRIIN MOVE B,OLDMOD TRZ B,TT%DAM SFMOD ;ENABLE "DIRECT ACCESS": ESCAPE CODES ETC. HRRO A,C PSOUT ;DO IT MOVEI A,.PRIIN MOVE B,OLDMOD SFMOD ;RESTORE TERMINAL MODE JRST POPJA ;;; TABLE OF TERMINAL-SPECIFIC ACTIONS: ONE BLOCK PER TERMINAL TYPE. ;;; EACH BLOCK HAS 4 WORDS FOR FOR CURSOR POSITIONING, ;;; CLEAR SCREEN, CLEAR REST OF SCREEN, AND CLEAR LINE, RESPECTIVELY ;;; THE CURSOR POSITIONING IS AN ADDRESS TO GO TO WITH POSITION IN AC0, ;;; OTHERS ARE STRING TO PRINT IN DIRECT ACCESS MODE CPTAB: JRST POPJA ;NON-DISPLAY (VERTICAL POSITION) [ASCIZ / ;(CLEAR SCREEN) /] [0] ;(CLEAR REST OF SCREEN) [0] ;(CLEAR LINE) JRST VPHP ;HP [ASCIZ /HJ/] ;(CLEAR SCREEN) [ASCIZ /J/] ;(CLEAR REST OF SCREEN) [ASCIZ /K/] ;(CLEAR LINE) JRST VPVT52 ;VT52 [ASCIZ /HJ/] [ASCIZ /J/] [ASCIZ /K/] JRST VPVTC ;VT100 [ASCIZ //] [ASCIZ //] [ASCIZ //] ;BALANCE ]]]] JRST VPIML ;IMLAC [ASCIZ /’/] [ASCIZ /„/] [ASCIZ /…/] JRST VPVTC ;ANN-ARBOR [ASCIZ //] [ASCIZ //] [ASCIZ //] ;BALANCE ]]]] ;*** NOTE -- THIS MAY NOT MOVE TO LEFT EDGE YET FOR HP OR VT100 OR IMLAC ;*** FIX IT (MAYBE SHOULD REQUIRE ALREADY AT LEFT EDGE) VPHP: IDIVI 10. ;HP SEQUENCE ADDI "0 ;ESC & a {y} r {x} C DPB [100700,,HPVP] ;REPLACE 4RD BYTE ADDI A,"0 DPB A,[010700,,HPVP] ;REPLACE 5TH BYTE MOVEI C,HPVP JRST PRTDAM VPVT52: ADDI 40 ;VT52 SEQUENCE DPB [170700,,VT52VP] ;ESC Y MOVEI C,VT52VP JRST PRTDAM VPVTC: ADDI 1 ;VT100/ANN-ARBOR SEQUENCE IDIVI 10. ;ESC LBKT {y+1} ; {x+1} H ADDI "0 DPB [170700,,VTCVP] ;REPLACE 3RD BYTE ADDI A,"0 DPB A,[100700,,VTCVP] ;REPLACE 4TH BYTE MOVEI C,VTCVP JRST PRTDAM VPIML: ADDI 1 ;IMLAC SEQUENCE DPB [170700,,IMLVP] ;DEL ^Q MOVEI C,IMLVP JRST PRTDAM ;TABLE OF TERMINAL TYPES (NUMBERS RETURNED BY "GTTYP") TTYS: 999. ;LTCTYP=0 FOR NON-DISPLAY .TTHP ;HP .TTV52 ;VT52 OR TERMINAL EMULATING SAME ; (SUCH AS VT100, HEATH, OR TELERAY) .TTV10 ;VT100 IN REAL ANSI MODE .TTIMX ;IMLAC 34 ;ANN-ARBOR TTYSE: ;;;READ CHARACTER FROM TERMINAL, RESULT TO A ;;;CLOBBERS A ;;;WE KNOW JCL HAS ENDED TTYIN: PBIN ANDI A,177 ;REMOVE THE %$&@!#$* PARITY BIT POPJ P, SUBTTL OPEN DISK FILE ;;; OPEN INPUT OR OUTPUT FILE, Z HAS PROMPTING MESSAGE ;;; GJBLK+.GJEXT MUST HAVE DEFAULT EXTENSION TO USE ;;; GJBLK+.GJNAM MUST HAVE DEFAULT FILENAME, THIS IS NORMALLY CLEARED AT ;;; START OF COMMAND BY GETCMD, BUT OPREXT SETS IT UP PROPERLY FOR WRITING ;;; SAME FILE NAME AS INPUT ;;; IF DCTVER IS ZERO (I.E. THIS IS THE FIRST FILE WE HAVE ;;; EVER READ), PUT VERSION NUMBER INTO DCTVER FOR ;;; PRINTING NEXT TIME PROGRAM IS STARTED ;;; CLOBBERS 0, A, B, C, D, W, X, WORDIN, WORDIX OPENR: PUSHJ P,NOISE MOVSI A,(GJ%OLD+GJ%CFM+GJ%FNS) JRST FILPRS OPENW: PUSHJ P,NOISE MOVSI A,(GJ%FOU+GJ%MSG+GJ%CFM+GJ%FNS) FILPRS: MOVEM A,GJBLK+.GJGEN JSP B,CKPRSE .CMFIL_27. ? 0 ? 0 ? 0 ;;; OPEN INPUT TEXT FILE, USE APPROPRIATE DEFAULT EXTENSION FROM MODE ;;; THEN GET ACTUAL NAME AND EXTENSION (LEAVING THEM IN WORDIN AND WORDIX) ;;; AND SET THEM UP AS THE DEFAULTS FOR OPENING OUTPUT ;;; WORDIN AND WORDIX MUST NOT BE CLOBBERED UNTIL OUTPUT FILE IS OPENED OPREXT: SETZ ;TRY TO GET DEFAULT EXTENSION FROM MODE TLNE FLAGS,RMODE HRROI [ASCIZ /R/] TLNE FLAGS,SMODE HRROI [ASCIZ /MSS/] TLNE FLAGS,TMODE HRROI [ASCIZ /TEX/] TLNE FLAGS,PMODE HRROI [ASCIZ /TXT/] MOVEM GJBLK+.GJEXT MOVEI Z,[ASCIZ /input text file/] PUSHJ P,OPENR HRROI A,WORDIN ;GET DEFAULT EXTENSION FROM INPUT FILENAME MOVEM A,GJBLK+.GJEXT MOVE B,INJFN MOVSI C,(JS%TYP/7*.JSAOF) JFNS ;FOLLOWING LINES USED TO SET DEFAULT FILENAME FOR OUTPUT SAME AS FILE ;USED FOR INPUT. UNFORTUNATELY, THIS MADE IT IMPOSSIBLE TO SUPPRESS ;OUTPUT (IF YOU JUST TYPED THE INPUT FILENAME FOLLOWED BY C.R., IT WOULD ;FILL IN OUTPUT FILENAME ANYWAY) ; HRROI A,WORDIX ;AND DEFAULT NAME ; MOVEM A,GJBLK+.GJNAM ; MOVE B,INJFN ; MOVSI C,(JS%NAM/7*.JSAOF) ; JFNS POPJ P, ;READ BLOCK OF INPUT FILE INTO RBUFF. LENGTH IS LRBUF. ;SKIP IF FULL LENGTH BLOCK, OTHERWISE RH OF 0 HAS ADDRESS PAST LAST WORD ;CLOBBERS 0 RDISK: PUSH P,A PUSH P,B PUSH P,C MOVE A,INJFN MOVE B,[444400,,RBUFF] MOVNI C,LRBUF SIN HRRZ B ;GET ADDRESS OF LAST WORD TRANSFERRED CAIN RBUFF+LRBUF-1 AOSA -3(P) ;WAS A FULL BLOCK AOS 0 ;NO, POINT 0 PAST LAST WORD POPCBA: POP P,C POP P,B POP P,A POPJ P, ;WRITE BLOCK OF OUTPUT FILE FROM WBUF1. LENGTH (NONZERO) IS NEGATED IN 0. ;MAINTAINS NEGATIVE OF NUMBER OF WORDS WRITTEN IN WCOUNT ;CLOBBERS 0, WCOUNT WDISK: ADDM WCOUNT PUSH P,A PUSH P,B PUSH P,C MOVE A,OUTJFN MOVE B,[444400,,WBUF1] MOVE C,0 ;-COUNT SOUT JRST POPCBA ;CLOSE INPUT FILE CLOSR: MOVE A,INJFN CLOSF JFCL POPJ P, ;CLOSE OUTPUT FILE, 0 HAS COUNT OF REAL CHARACTERS ; (NOT INCLUDING PADS) CLZW: MOVE A,OUTJFN HRLI A,(CO%NRJ) ;DO NOT RELEASE THE JFN CLOSF ;CLOSE THE FILE JFCL MOVE A,OUTJFN HRLI A,.FBBYV+(CF%NUD) HRLZI B,(FB%BSZ) ;CHANGE BYTE SIZE HRLZI C,000700 ;TO 7 BITS CHFDB ;DO IT, DON'T UPDATE ON DISK ERJMP CLZW9 ;MIGHT BE DEVICE NUL: MOVE A,OUTJFN HRLI A,.FBSIZ ;CHANGE BYTE COUNT SETO B, MOVE C,0 CHFDB ;DO IT, UPDATE ON DISK ERJMP CLZW9 ;MIGHT BE DEVICE NUL: CLZW9: MOVE A,OUTJFN RLJFN ;RELEASE JFN JFCL POPJ P, ] SUBTTL INITIALIZE FOR ITS IFN %ITS,[ SETUP: SETZM TOPEND ;INDICATE TTY NOT OPENED YET SETZM LWCASE ;**** UNTIL DO THE RIGHT THING TO GET INFO SETZM DSPTTY ;WILL BECOME NONZERO IF TTY IS A DISPLAY ;(MUST DO THIS BECAUSE PROGRAM MIGHT HAVE BEEN DUMPED WITH TOPEND NONZERO) .SUSET [.RSNAM,,SNAME] ;READ INITIAL SNAME SETZM JCLBUF ;CLEAR JCL BUFFER MOVE [JCLBUF,,JCLBUF+1] BLT JCLBFE HLLOS JCLBFE ;MAKE SURE WE DON'T GET OVERRUN .SUSET [.ROPTI,,] TLNN %OPCMD JRST NOJCL .BREAK 12,[..RJCL,,JCLBUF] SKIPN JCLBUF JRST NOJCL SKIPE JCLBFE-1 .VALUE [ASCIZ /:JCL LINE TOO LONGKILL /] MOVE A,[440700,,JCLBUF] MOVEM A,JCLFLG ILDB A ;READ FIRST JCL CHARACTER CAIN ^M ;SEE IF JCL LINE IS EMPTY NOJCL: SETZM JCLFLG YESJCL: .SUSET [.RMEMT,,B] ;READ MEMORY TOP INTO B TRZ B,1777 ;BE SURE IT'S A MULTIPLE OF 2000 MOVEM B,MEMTOP CAMG B,LISTFF .VALUE [ASCIZ /:PROGRAM IMPROPERLY LOADED/] ;LOOK FOR "NEWS" FILE, PRINT SAME (UNLESS HAVE JCL) .CALL [SETZ SIXBIT /OPEN/ [.UAI,,DKIN] [SIXBIT /DSK/] [SIXBIT /SPELL/] [SIXBIT /NEWS/] SETZ [SIXBIT /INFO/]] JRST BEG7 ;FAILED .IOT DKIN,0 ;READ CHARACTER CAIE ^_ ;STOP READING AT ^_ CAIG ^C JRST .+3 ;END OF STRING PUSHJ P,OUTC ;PRINT IT JRST .-5 .CLOSE DKIN, BEG7: TYPE [[ASCIZ /Spell./]] MOVE A,[.FNAM2] PUSHJ P,SIXPRN SKIPN A,DCTVER ;SEE IF I HAVE A DICTIONARY VERSION JRST BEG2 ;NO TYPE [[ASCIZ / Dict./]] PUSHJ P,SIXPRN ;PRINT IT BEG2: TYPE [[ASCIZ / /]] POPJ P, ;PRINT WORD IN A IN SIXBIT (FOR PRINTING VERSION NUMBERS) ;ITS ONLY ;CLOBBERS 0, A SIXPRN: SETZ LSHC 6 ;GET SIX BITS OF A INTO 0 ADDI 40 PUSHJ P,PRINC JUMPN A,SIXPRN ;GO BACK FOR MORE POPJ P, ] SUBTTL INITIALIZE FOR TWENEX IFN %TNX,[ SETUP: RESET MOVEI 1 MOVEM LINOPN MOVEI A,.PRIIN RFMOD ;GET TERMINAL MODE WORD MOVEM B,OLDMOD ;SAVE IT SO CAN TEMPORARILY CHANGE IT FOR ; DIRECT ACCESS STUFF (CURSOR POSITIONING ETC) AND B,[TT%LCA] ;THIS BIT TELLS WHETHER THE TERMINAL MOVEM B,LWCASE ; HAS LOWERCASE IFN %VTS,[ MOVEI A,.PRIIN ;GET TERMINAL CHARACTERISTICS WORD, RTCHR ; WHICH TELLS WHAT THE SYSTEM KNOWS MOVEM B,TCHAR ; HOW TO DO FOR THIS TERMINAL ] .ELSE [SETZM TCHAR] ;FIND TERMINAL TYPE, SET LTCTYP ACCORDINGLY, OR LTCTYP = 0 IF UNKNOWN MOVEI A,.PRIIN ;GET TERMINAL TYPE GTTYP ;INTO B MOVE K,B ;TEMPORARY TYPEOUT CAIE B,18. ;**** WHAT A CROCK!!! FOR VT100 TERMINALS CAIN B,20. ;**** WHAT A CROCK!!! FOR HEATH TERMINALS MOVEI B,15. CAIN B,19. ;**** WHAT A CROCK!!! FOR TELERAY TERMINALS MOVEI B,15. MOVSI A,TTYS-TTYSE ;INITIALIZE TABLE SEARCH CAMN B,TTYS(A) ;LOOK FOR IT JRST FNDTTY ;FOUND IT AOBJN A,.-2 SETZM LTCTYP ;UNKNOWN TTY TYPE JRST STPCNT FNDTTY: HRRZM A,LTCTYP ;KNOWN TTY TYPE STPCNT: SETOM JCLFLG ;NONZERO IF CURRENTLY READING OUT OF RESCAN ;;; READ JCL FOR 20X ONLY IFN %20X,[ MOVEI A,.RSINI RSCAN ;ACTIVATE RESCAN BUFFER FOR READING JCL JRST NOJCL ;HUH?? JUMPE A,NOJCL ;ZERO CHARACTERS? MOVEI A,.CTTRM BIN ;READ JCL CHARACTER TO SCAN OVER PROGRAM NAME CAIN B,^J JRST NOJCL ;RAN OUT, MUST NOT BE ANY REAL JCL CAIE B,40 ;LOOK FOR BLANK JRST .-4 JRST YESJCL ] ;;; READ JCL FOR 10X ONLY IFE %20X,[ MOVEI A,.PRIIN BKJFN JRST NOJCL ;HUH?? PBIN CAIN A,^_ ;10X NEWLINE CHARACTER? JRST NOJCL ;YES, MUST NOT BE ANY REAL JCL JRST YESJCL ] NOJCL: SETZM JCLFLG YESJCL: MOVE LISTFF TRO 1777 AOS ;SET TO NEXT HIGHER MULTIPLE OF 2000 MOVEM MEMTOP ;MEMTOP .GT. LISTFF AND MULTIPLE OF 2000 ;LOOK FOR "NEWS" FILE, PRINT SAME (UNLESS HAVE JCL) MOVSI A,(GJ%OLD+GJ%SHT) HRROI B,[ASCIZ /ISPELL.NEWS/] GTJFN ERJMP BEG7 ;FAILED HRRZS A MOVE B,[070000,,OF%RD+OF%PLN] OPENF JRST BEG7 ;FAILED BIN ;READ A CHARACTER ERJMP .+6 ;END OF FILE CAIN B,^_ ;STOP READING AT ^_ JRST .+4 MOVE B PUSHJ P,PRINC JRST .-6 CLOSF JFCL BEG7: TYPE [[ASCIZ /Spell./]] MOVEI .FVERS PUSHJ P,DECPTR SKIPN DCTVER ;SEE IF I HAVE A DICTIONARY VERSION JRST BEG2 ;NO TYPE [[ASCIZ / Dict./]] TYPE DCTVER BEG2: TYPE [[ASCIZ / Term./]] MOVE K PUSHJ P,DECPTR TYPE [[ASCIZ / /]] POPJ P, ] HELP: PUSHJ P,CONFRM TYPE XBLURB ;PRINT SHORT DIRECTIONS PUSHJ P,PROPT ;PRINT CURRENT OPTIONS HLPEND: TYPE [[ASCIZ / There are /]] MOVE DICTNN PUSHJ P,DECPTR TYPE [[ASCIZ / entries for /]] MOVE DICTNN ADD FLAGNN PUSHJ P,DECPTR TYPE [[ASCIZ / words in /]] MOVE MEMTOP LSH -10. PUSHJ P,DECPTR TYPE [[ASCIZ / K of core./]] JRST ENDCMD IFN %ITS,[ XBLURB: ASCIZ % CORRECT ,/ - Correct a file (normal mode for program) LOAD , - Load incremental dictionary #N (1 to 9, default=1) DUMP , - Dump incremental dictionary #N (1 to 9, default=1) TRAIN , - Train ASK - Ask about a single word SET