Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/ispell.mid
There is 1 other file named ispell.mid in the archive. Click here to see a list.
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
%ITS==0 ? %TNX==1 ? %20X==1
IFE .OSMIDAS-SIXBIT /ITS/,[%ITS==1 ? %TNX==0 ? %20X==0]
IFE .OSMIDAS-SIXBIT /TENEX/,%20X==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"
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
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
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
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
129. ;CMCNT
0 ;CMINC
-1,,ABP ;CMABP
49. ;CMABC
GJBLK ;CMGJB
GJBLK: BLOCK 16 ;AUXILIARY FUNCTION BLOCK FOR GTJFN
; WHEN PARSING FILE NAMES
BFR: BLOCK 26.
ABP: BLOCK 10.
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 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)
SUBTTL INITIALIZATION
;*** SHOULD CLEAR LOTS OF VARIABLES (BUT NOT "MODE")
BEGIN: MOVE P,[-LPDL,,PDL-1]
TRZ FLAGS,FWRITE ;SEND OUTPUT TO TERMINAL
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 ;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 .+2 ;GOT A FILE
TROA FLAGS,NOCORR ;GOT SWITCH OR NOTHING, DISABLE WRITING
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
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
;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: SKIPN CANDS
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
TYPE [[ASCIZ /
/]]
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 (OUTPUT TO TERMINAL)
;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 ;CONVERT TO UPPER CASE
CAIN A,"A
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
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
COROPT: PUSHJ P,ROPT ;READ AND PROCESS OPTION LETTER
JRST CORHUH ;ERROR
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: 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, ITS CASE MUST BE FIXED UP
;AND THE WORD REPLACED IN WORDIX
MOVE B,[440700,,WORDIX]
ILDB B ;GET FIRST LETTER
TRZ 40 ;MAKE UPPER
CAIG "Z ;IS IT REALLY A LETTER?
CAIGE "A
JRST LOP4 ;DON'T CHANGE CASE OF NON-LETTERS
TRNE FLAGS,LOW1
TRO 40 ;CHANGE TO LOWER
LOP3: DPB B ;PUT IT BACK
LOP4: ILDB B ;GET NEXT
JUMPE CORLO2 ;DONE
TRZ 40
CAIG "Z ;IS IT REALLY A LETTER?
CAIGE "A
JRST LOP4 ;DON'T CHANGE CASE OF NON-LETTERS
TRNE FLAGS,LOW2
TRO 40 ;CHANGE TO LOWER
JRST LOP3
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: SUBI A,"0 ;GET ACTUAL NUMBER
CAML A,CANDS
JRST CORHUH ;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 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 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
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
JRST ENDCMD
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
;;;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 MISCELLANEOUS ROUTINES AND TABLES
;READ OPTION LETTER AND PROCESS IT, PUTTING RESULT BOTH IN "MODE"
; AND IN "FLAGS". THE + OR - SIGN HAS ALREADY BEEN READ AND IS IN A.
;SKIP IF LEGAL OPTION LETTER IS TYPED
;CLOBBERS 0, A, B, C
ROPT: 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,CPOPJ ;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 CPOPJ1
ROPT1: HRLZ MTABE(B) ;COMMAND WAS "-", GET BIT TO CLEAR
ANDCAM MODE
ANDCAM FLAGS
JRST CPOPJ1
;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
<space> 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 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 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.
;;; 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. User does not need to
;;; write anything.
;;;
;;; If called when BRKCHR < 0, returns instantly with BRKCHR < 0
;;; and W = 0.
;;; 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 WDELIM ;YES, PROCESS IT (IT IS A DELIMITER)
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
CAIGE W,40 ;MAINTAIN A COUNT
JRST RDLOOP ;OK, GET ANOTHER
MOVE X,[440700,,WORDIX] ;WORD TOO LONG *** COMPLAIN IF RDICT ON
MOVE Y,W ;NUMBER OF CHARS TO COPY
WRTLOP: ILDB X ;UNPACK WHAT WE HAVE
PUSHJ P,WRITF ;AND COPY IT TO OUTPUT
SOJN Y,WRTLOP
JRST GETWD ;CROCK ** SHOULD FLUSH ENTIRE THING **
RDLO1: CAILE "Z ;CONTINUE CHECKING
JRST BSL ;DELIMITER, BUT MIGHT BE BACKSLASH
CAIL "A
JRST RDUPP ;UPPERCASE LETTER
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
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, ATSIGN 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
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
BSL: CAIE "\
JRST WDELIM ;NOT BACKSLASH
JUMPN W,WDELIM ;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
;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
SKIPL A,B ;SEE IF CHECKING
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 "$
JRST CMNX1
CMNX2: PUSHJ P,WRITF
PUSHJ P,READF
JRST RDEOF
CAIE "$
JRST CMNX2
JRST CMNX9
CMNX1: PUSHJ P,WRITF ;TWO CONSECUTIVE DOLLARSIGNS
PUSHJ P,READF
JRST RDEOF
CAIE "$
JRST CMNX1
PUSHJ P,WRITF
PUSHJ P,READF
JRST RDEOF
CAIE "$
JRST CMNX1
CMNX9: MOVEM BRKCHR
PUSHJ P,WRITF
JRST RDLOOP
TEXBSL: PUSHJ P,READF ;BACKSLASH IN "TEX" MODE
JRST RDEOF ;END OF FILE?
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
MOVEM BRKCHR
PUSHJ P,WRITF ;COPY IT
JRST RDLOOP
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 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+.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: PUSHJ P,CKPRSI ;LOOK FOR TEXT STRING
.CMFLD_27.+CM%HPP ? 0 ? -1,,[ASCIZ /word to check/] ? 0
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
;;; 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
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
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
MOVEI A,STBLK
COMND
HRRZS C ;NOW C HAS FUNCTION BLOCK THAT IT USED
TLNN A,(CM%RPT+CM%NOP)
JRST PRSOK
TLNE A,(CM%NOP)
JRST CMDERR
SKIPN COMMIT ;JUST NEEDS A REPARSE
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
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 /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 /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 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
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
CFFLSW: SETOB RWSWT
HRRZM FLSWSW ;FLSWSW = 0,,-1
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: 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
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: 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 /C/]]
POPJ P,
;CLEAR REST OF SCREEN, CURSOR SHOULD BE AT LEFT EDGE
;CLOBBERS 0
CLEARF: 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,
; -- JDBROCK
;CLEAR LINE, CURSOR SHOULD BE AT LEFT EDGE
;CLOBBERS 0
CLEARL: 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: 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: 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: 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: SKIPE JCLFLG
POPJ P, ;JCL IS WAITING, SUPPRESS OUTPUT
PUSH P,A
HRRO A,0
PSOUT
JRST POPJA
;CLEAR SCREEN
;;; CLOBBERS B, C
CLEARS: PUSH P,A
JSP A,PRTPRT
[ASCIZ /HJ/] ;HP
[ASCIZ /HJ/] ;VT52
[ASCIZ /[;H[J/] ;VT100 BALANCE ]]
[ASCIZ //] ;IMLAC
;CLEAR FILE, CURSOR SHOULD BE AT LEFT EDGE
;;; CLOBBERS B, C
CLEARF: PUSH P,A
JSP A,PRTPRT
[ASCIZ /J/] ;HP
[ASCIZ /J/] ;VT52
[ASCIZ /[J/] ;VT100 BALANCE ]
[ASCIZ //] ;IMLAC
;CLEAR LINE, CURSOR SHOULD BE AT LEFT EDGE
;;; CLOBBERS B, C
CLEARL: PUSH P,A
JSP A,PRTPRT
[ASCIZ /K/] ;HP
[ASCIZ /K/] ;VT52
[ASCIZ /[K/] ;VT100 BALANCE ]
[ASCIZ //] ;IMLAC
PRTPRT: SKIPE JCLFLG
JRST POPJA ;JCL IS WAITING, SUPPRESS OUTPUT
MOVE C,LTCTYP ;WHAT KIND OF TERMINAL?
JUMPL C,POPJA ;NOT A DISPLAY, DO NOTHING
ADD C,A ;POINT C AT APPROPRIATE TABLE ENTRY
MOVE C,(C) ;POINT IT AT ASCIZ STRING
;;;PRINT ASCIZ STRING IN C IN DIRECT ACCESS MODE
PRTDAM: MOVEI A,.PRIIN
MOVE B,OLDMOD
TRZ B,TT%DAM
SFMOD ;ENABLE CURSOR POSITIONING ETC.
HRRO A,C
PSOUT ;DO IT
MOVEI A,.PRIIN
MOVE B,OLDMOD
SFMOD ;RESTORE TERMINAL MODE
JRST POPJA
;TABLE OF TERMINAL TYPES (NUMBERS RETURNED BY "GTTYP")
TTYS: 6 ;HP
15. ;VT52 OR TERMINAL EMULATING SAME
; (SUCH AS VT100, HEATH, OR TELERAY)
18. ;VT100 IN REAL ANSI MODE
4 ;IMLAC
TTYSE:
;SET VERTICAL CURSOR POSITION TO POSITION GIVEN IN FOLLOWING WORD
;AND MOVE TO LEFT EDGE OF SCREEN
;CLOBBERS 0, A, B
;*** NOTE -- THIS MAY NOT MOVE TO LEFT EDGE YET FOR HP OR VT100 OR IMLAC
;*** FIX IT
VPOS: SKIPE JCLFLG
JRST CPOPJ1 ;JCL IS WAITING, SUPPRESS OUTPUT
PUSH P,A
MOVE @-1(P) ;GET POSITION TO USE
AOS -1(P)
MOVE A,LTCTYP ;WHAT KIND OF TERMINAL?
JRST .+2(A) ;BRANCH TO PROPER ROUTINE
JRST POPJA ;NOT A DISPLAY, DO NOTHING
JRST VPHP
JRST VPVT52
JRST VPVTC
JRST VPIML
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 <y+40> <x+40>
MOVEI C,VT52VP
JRST PRTDAM
VPVTC: ADDI 1 ;VT100 SEQUENCE
IDIVI 10. ;ESC LBKT {y+1} ; {x+1} H
ADDI "0
DPB [170700,,VTCVP] ;REPLACE 3RD BYTE
ADDI A,"0
DPB [100700,,VTCVP] ;REPLACE 4TH BYTE
MOVEI C,VTCVP
JRST PRTDAM
VPIML: ADDI 1 ;IMLAC SEQUENCE
DPB [170700,,IMLVP] ;DEL ^Q <y+1> <x+1>
MOVEI C,IMLVP
JRST PRTDAM
;;;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
;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
;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 SET UP DEFAULT EXTENSION FOR OPENING OUTPUT
OPREXT: SETZ ;TRY TO GET DEFAULT EXTENSION FROM MODE
TLNE FLAGS,RMODE
HRROI [ASCIZ /R/]
TLNE FLAGS,SMODE
HRROI [ASCIZ /MSS/]
TLNE FLAGS,PMODE
HRROI [ASCIZ /TXT/]
MOVEM GJBLK+.GJEXT
MOVEI Z,[ASCIZ /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
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 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
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
MOVEM B,OLDMOD ;SAVE OLD TERMINAL MODE
;FIND TERMINAL TYPE, SET LTCTYP ACCORDINGLY, OR LTCTYP = -1 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
IFE STANSW,[
CAIN B,20. ;**** WHAT A CROCK!!! FOR HEATH TERMINALS
MOVEI B,15.
CAIN B,19. ;**** WHAT A CROCK!!! FOR TELERAY TERMINALS
MOVEI B,15.
];IFE STANSW
IFN STANSW,[
CAIN B,.TTH19 ;**** WHAT A CROCK!!! FOR HEATH TERMINALS
MOVEI B,.TTV52
CAIN B,.TTTEL ;**** WHAT A CROCK!!! FOR TELERAY TERMINALS
MOVEI B,.TTV52
];IFE STANSW
MOVSI A,TTYS-TTYSE ;INITIALIZE TABLE SEARCH
CAMN B,TTYS(A) ;LOOK FOR IT
JRST FNDTTY ;FOUND IT
AOBJN A,.-2
SETOM 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 /<INFO>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 <input file>,<output file>/<starting line> -
Correct a file (normal mode for program)
LOAD <file>,<num> - Load incremental dictionary #N (1 to 9, default=1)
DUMP <file>,<num> - Dump incremental dictionary #N (1 to 9, default=1)
TRAIN <file>,<exceptions file> - Train
ASK <word> - Ask about a single word
SET <option> / NO <option> - turn option on or off; options are:
J(TJ6), R, P(PUB), T(TEX), S(SCRIBE) - text formatter mode
D - Display context around misspelled word
L - Show list of close words
C - Check capitalization (don't use this yet)
QUIT - Quit and allow program to be restarted
KILL - Quit and kill the program
%
]
IFN %TNX,[
XBLURB: ASCIZ %
CORRECT <input file> <output file> /LINE:<starting line> -
Correct a file (normal mode for program)
LOAD <file> <num> - Load incremental dictionary #N (1 to 9, default=1)
DUMP <file> <num> - Dump incremental dictionary #N (1 to 9, default=1)
TRAIN <file> <exceptions file> - Train
ASK <word> - Ask about a single word
SET <option> / NO <option> - turn option on or off; options are:
TJ6, R, PUB, TEX, SCRIBE - text formatter mode
DISPLAY - Display context around misspelled word
LIST - Show list of close words
CAPITALIZATION - Check capitalization (don't use this yet)
QUIT - Quit and allow program to be restarted
KILL - Quit and kill the program
%
]
SUBTTL TYPLIN (READ LINE FROM TTY) FOR ITS
IFN %ITS,[
;READ LINE FROM TTY, CURSOR SHOULD BE AT LEFT EDGE TO START
;PROMPT IS IN Z, Z MUST POINT TO WORD OF ZERO FOR NO PROMPT
;NO SKIP IF USER TYPES CONTROL G OR QUESTION MARK, THAT CHARACTER IS IN A
;SKIP OTHERWISE, WITH DATA IN WORDIX, W AND WORDIN CLEAR
;CLOBBERS 0, A, B, C, X, WORDIN, WORDIX, W
;WORDIX DOES NOT HAVE MORE THAN 40 CHARACTERS
;;; ON ITS ONLY --> TEXT IS ALSO IN CMDBUF, AND IS NOT TRUNCATED
;;; TO 40 CHARACTERS. THIS IS BECAUSE ITS USES THIS TO READ THE
;;; ENTIRE COMMAND LINE, WHILE TNX DOES NOT.
TYPLIN: SETZB W,WORDIN
MOVE [WORDIN,,WORDIN+1]
BLT WORDIX+10. ;CLEAR WORDIN, WORDIX
SETZM CMDBUF
MOVE [CMDBUF,,CMDBUF+1]
BLT CMDBUF+CMDBFL-1 ;CLEAR CMDBUF
MOVE X,[010700,,CMDBUF-1]
TYPE @Z ;PRINT PROMPTING MESSAGE
TYPW1: PUSHJ P,TTYIN
CAIN A,^[ ;]
JRST TYPWA ;COMMA OR ALTMODE, DONE
CAIN A,^M
JRST TYPWB ;CR, DONE
CAIN A,177
JRST RUBOUT
CAIN A,^U
JRST CTLU ;CONTROL U, START OVER
CAIN A,^R
JRST CTLR ;CONTROL R, RETYPE THE LINE
CAIE A,"?
CAIN A,^G
POPJ P, ;CONTROL G OR QUESTION MARK, EXIT
CAIN A,^Q
PUSHJ P,TTYIN ;CONTROL Q, QUOTE NEXT CHAR
CAME X,[010700,,CMDBUF+CMDBFL-1] ;DON'T PACK IF ALREADY FULL
IDPB A,X
JRST TYPW1
RUBOUT: CAMN X,[010700,,CMDBUF-1]
JRST TYPW1 ;ALREADY AT LEFT EDGE
SETZ
DPB X ;ERASE FROM BUFFER
ADD X,[070000,,0] ;BACK UP X
SKIPGE X
SUB X,[430000,,1]
TYPE [[ASCIZ /X/]] ;ERASE FROM SCREEN AND BACK UP CURSOR
JRST TYPW1
CTLU: TYPE [[ASCIZ /HL/]] ;MOVE TO LEFT EDGE AND ERASE LINE
JRST TYPLIN
CTLR: TYPE [[ASCIZ /HL/]]
TYPE @Z ;TYPE PROMPT AGAIN
MOVE A,[010700,,CMDBUF-1]
CTLR1: CAMN A,X
JRST TYPW1 ;DONE
ILDB A
PUSHJ P,PRINC ;DISPLAY IT
JRST CTLR1
TYPWA: TYPE [[ASCIZ /
/]]
TYPWB:
MOVE [CMDBUF,,WORDIX]
BLT WORDIX+7 ;COPY ONLY 40 CHARACTERS
JRST CPOPJ1
]
SUBTTL TYPLIN (READ LINE FROM TTY) FOR TWENEX
.ELSE [
TYPLIN: SETZB W,WORDIN
MOVE [WORDIN,,WORDIN+1]
BLT WORDIX+10. ;CLEAR WORDIN, WORDIX
TYPE @Z ;PRINT THE PROMPT THE FIRST TIME (SIGH)
MOVEI A,TTLARG ;IF READING FROM TTY
HRLI Z,440700 ;MAKE A BYTE POINTER OUT OF Z
MOVEM Z,.RDRTY(A) ;TO PRINT THE PROMPT AFTER ^R
HRROI WORDIX ;INITIAL PACKING ADDRESS
MOVEM .RDDBP(A)
MOVEI 41. ;MAX CHARACTER COUNT
MOVEM .RDDBC(A)
TEXTI
POPJ P, ;HOW THE HECK CAN THIS HAPPEN?
SETZ B,
LDB A,TTLARG+.RDDBP ;GET THE BREAK CHARACTER
DPB B,TTLARG+.RDDBP ;ERASE IT FROM THE BUFFER
CAIE A,"?
CAIN A,^G
POPJ P, ;ENDED WITH ? OR ^G, GIVE ABORT EXIT
JRST CPOPJ1
]
SUBTTL SAVEME FOR ITS
IFN %ITS,[
SAVEME: SETZM DUMPBF ;INITIALIZE DUMPBF WITH ":PDUMP"
MOVE A,[DUMPBF,,DUMPBF +1]
BLT A,DUMPBF+7
MOVE M,[440700,,DUMPBF]
MOVE C,[440700,,[ASCIZ /:PDUMP/]]
ILDB A,C
JUMPE A,.+3
IDPB A,M
JRST .-3
MOVEI Z,2 ;COUNT TWO FILE NAMES
SAV2: PUSHJ P,WRDPRS ;PARSE A FILE NAME
MOVE C,[440700,,WORDIX]
MOVEI A,40 ;PACK A SPACE
IDPB A,M
ILDB A,C
JUMPN A,.-2
SOJG Z,SAV2 ;DO ANOTHER NAME
MOVE C,[440700,,[ASCIZ /
:CONTINUE
/]]
ILDB A,C
JUMPE A,.+3
IDPB A,M
JRST .-3
PUSHJ P,CONFRM
TYPE [[ASCIZ /
Ya want it like drivn snow? /]]
PUSHJ P,TTYIN
TRZ A,40
CAIN A,"Y
PUSHJ P,PURIFY
TYPE [[ASCIZ /
Getcher paws off the keys!!!
/]]
.VALUE DUMPBF
JRST ENDCMD
SUBTTL THE PURIFY CODE
PURIFY: .SUSET [.RUIND,,JNUM]
.SUSET [.RJNAM,,JNAME]
HRRZI A,400000
IORM A,JNUM ;THATS WHAT COREBLK WANTS
HRRZI A,1
; HRRZI B,BPTT ;BINARY PROGRAM TOP
;"BPTT" WAS START OF VARIABLES AREA
LSH B,-12
PTEST: CAML A,B
JRST .+4 ;WE AT TOP!
.CALL CORCAL
.VALUE [ASCIZ /: CORBLK FAILED
/]
AOJA A,PTEST ;LOOP
;NOW WE SKIP THE RANDOM STORAGE, AND DO THE LIST SPACE
;DON'T FORGET TO MOVE LISTFF UP TO THE TOP
MOVE B,MEMTOP
; AOS MEMTOP ;*** LOOK AT THIS
MOVEM B,LISTFF
LSH B,-12
; HRRZI A,LISTB ;START OF LIST SPACE
;"LISTB" WAS END OF VARIABLES AREA
LSH A,-12
AOJ A, ;REMEMBER THAT THIS BLOCK IS IMP
PTEST2: CAML A,B
JRST .+4
.CALL CORCAL
.VALUE [ASCIZ /: CORBLK FAILED
/]
AOJA A,PTEST2
POPJ P,
CORCAL: SETZ
SIXBIT/CORBLK/
1000,,040000
JNUM
SETZ A ;PUT PAGE NUM IN A
PGCOPY: SETZ ;COPY PAGE FROM B TO A
SIXBIT/CORBLK/
1000,,330000
JNUM
A
JNUM
SETZ B ;AOBJN POINTER IN A
]
SUBTTL SAVEME FOR TWENEX
IFN %TNX,[
SAVEME: SETOM NOPNFG ;SO IT WON'T OPEN THE FILE
MOVEI Z,[ASCIZ /to EXE file/]
HRROI [ASCIZ /EXE/]
MOVEM GJBLK+.GJEXT
PUSHJ P,OPENW
PUSHJ P,CONFRM
MOVE A,OUTJFN ;THIS JFN IS NOT OPENED!
HRLI A,.FHSLF
MOVE B,MEMTOP
LSH B,-9. ;NUMBER OF PAGES
MOVNS B
HRLZS B ;TO LEFT HALF
HRRI B,SS%CPY+SS%RD+SS%EXE
SETZ C,
SSAVE
SETOM OUTJFN ;SSAVE CLOSED AND RELEASED THE JFN!
JRST ENDCMD
]
CONSTANTS
DICTIO: 0
END BEGIN