github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-23 10:59:24 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/syseng/spell.741
Eric Swenson 65a92f9a9f Added SPELL/ESPELL, spellchecker.
2016-12-05 19:47:22 +01:00

4013 lines
98 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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 /<2F>_/ ;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
<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 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 /<2F>/]
[ASCIZ /<2F>/]
[ASCIZ /<2F>/]
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 <y+40> <x+40>
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 <y+1> <x+1>
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 /<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)
EXIT or QUIT - Exit and allow program to be restarted
KILL - Exit 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)
EXIT or QUIT - Exit and allow program to be restarted
KILL - Exit 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
CAIE A,^L
CAIN A,^R
JRST CTLR ;CONTROL L OR 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: SETOM PURE ;IT'S PURE FROM NOW ON
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
;PURIFY STUFF FROM PURBEG (INCL) TO LISTFF (EXCL)
HRRZI A,PURBEG
ADDI A,1777
LSH A,-10.
HRRZ B,LISTFF
LSH B,-10.
PTEST: CAML A,B
JRST .+4
.CALL CORCAL
.VALUE [ASCIZ /: CORBLK FAILED 
/]
AOJA A,PTEST ;LOOP
POPJ P,
CORCAL: SETZ
SIXBIT/CORBLK/
1000,,040000
JNUM
SETZ A ;PUT PAGE NUM IN A
]
SUBTTL SAVEME FOR TWENEX
IFN %TNX,[
SAVEME: SETOM PURE ;IT'S PURE FROM NOW ON
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
Reference in New Issue View Git Blame Copy Permalink