.TITLE GCIN .IDENT /V01/ .PSECT $TEMP,RW,D,OVR,GBL .BLKB 1 TBUFF: .BLKB 12. .PSECT GCTABL,RW,D ; ; INPUT CHARACTER PARSING TABLES ; TO ADD MORE FLAGS THESE TABLES MUST BE CHANGED ; THE FLAG DEFINITIONS COORESPOND TO THE FLAG SWITCHES ; GC.UC==0 ; Upper case letters GC.LC==2 ; Lower case letters GC.AFL==4 ; Accept flag GC.CFL==6 ; Capitalize flag GC.UFL==10 ; Underline flag GC.LFL==12 ; Lowercase flag GC.SFL==14 ; Uppercase flag GC.QFL==16 ; Quoted space flag GC.OFL==20 ; Overstrike flag GC.IFL==22 ; Index flag GC.HFL==24 ; Hyphenation flag GC.EFL==26 ; Escape flag GC.SUB==30 ; substitute flag GC.BRK==32 ; break flag GC.NFL==34 ; COMMAND FLAG GC.CR==36 ; CARRIAGE RETURN GC.TAB==40 ; tab input char GC.LF==42 ; lin feed input GC.DIG==44 ; digit (0-9) GC.SPC==46 ; space GC.MSC==50 ; MISCELLANEOUS CHARS GC.SPF==52 ; Special flag GC.EQ1==54 ; Equation flags GC.EQ2==56 ; Equation flags GO.UNL==-2 ; underline 1 char GO.ESC==-12 ; begin escape sequence GO.QTS==-14 ; quoted space output GO.BS==-16 ; backspace output GO.TAB=-20 ; Tab count byte follows GO.ELP=-22 ; Ellipses count follows this GC.ILL=-24 ; illegal character GO.REP=-26 ; Repeat characters GO.INX=-30 ; Index entry ; ; THE FOLLOWING CORRESPOND TO THE ASCII CHARACTERS ; GCTABL:: .BYTE GC.ILL,GC.ILL,GC.ILL,GC.ILL,GC.ILL,GC.ILL ; NUL-ENQ .BYTE GC.ILL,GC.ILL,GO.BS ; ACK-BS .BYTE GC.TAB,GC.LF,GC.ILL,GC.ILL ; TAB,LF,VT,FF .BYTE GC.CR,GC.ILL,GC.ILL,GC.ILL ; CR,SO,SI,DLE .BYTE GC.ILL,GC.ILL,GC.ILL,GC.ILL,GC.ILL ; DC1-nak .BYTE GO.INX,GO.REP,GO.TAB,GO.ELP,GC.ILL ; SYN-SUB .BYTE GO.ESC,GO.UNL,GC.ILL,GC.ILL,GC.ILL ; ESC-US .BYTE GC.SPC ; SPACE .BYTE GC.MSC,GC.MSC,GC.MSC,GC.MSC,GC.MSC,GC.MSC ; - & .BYTE GC.MSC,GC.MSC,GC.MSC,GC.MSC,GC.MSC,GC.MSC ; ' - , .BYTE GC.MSC,GC.MSC,GC.MSC ; - . / .BYTE GC.DIG,GC.DIG,GC.DIG,GC.DIG,GC.DIG ; 0 - 4 .BYTE GC.DIG,GC.DIG,GC.DIG,GC.DIG,GC.DIG ; 5 - 9 .BYTE GC.MSC,GC.MSC,GC.MSC,GC.MSC,GC.MSC,GC.MSC,GC.MSC ; : - @ .BYTE GC.UC,GC.UC,GC.UC,GC.UC,GC.UC,GC.UC ; UPPER CASE .BYTE GC.UC,GC.UC,GC.UC,GC.UC,GC.UC,GC.UC ; UPPER CASE .BYTE GC.UC,GC.UC,GC.UC,GC.UC,GC.UC,GC.UC ; UPPER CASE .BYTE GC.UC,GC.UC,GC.UC,GC.UC,GC.UC,GC.UC,GC.UC,GC.UC ; UPPER CASE .BYTE GC.MSC,GC.MSC,GC.MSC,GC.MSC,GC.MSC,GC.MSC ; [ - ` .BYTE GC.LC,GC.LC,GC.LC,GC.LC,GC.LC,GC.LC ; LOWER CASE .BYTE GC.LC,GC.LC,GC.LC,GC.LC,GC.LC,GC.LC ; LOWER CASE .BYTE GC.LC,GC.LC,GC.LC,GC.LC,GC.LC,GC.LC ; LOWER CASE .BYTE GC.LC,GC.LC,GC.LC,GC.LC,GC.LC,GC.LC,GC.LC,GC.LC ; LOWER CASE .BYTE GC.MSC,GC.MSC,GC.MSC,GC.MSC ; { - ~ .BYTE GO.QTS ; DEL ; ; CHARACTER DEFINITION TABLE ; CH.BRK==1 ; Char is followed by break CH.ES2==2 ; Char is second char in escape seq. CH.FLC==4 ; CHAR MAY BE FLAG CHAR CH.FLG==10 ; CHAR IS CURRENTLY FLAG CHAR CH.PER==20 ; CHAR IS PUNCTUATION CH.VOW==40 ; character is a vowel CH.PNC==100 ; char is punctuation (for routine HYPHEN) CH.UNL==200 ; char is not underlinable CHTABL:: .BLKB 32. ; NUL-US .BYTE CH.PNC!CH.UNL ; "space" .BYTE CH.FLC!CH.PNC!CH.PER ; ! .BYTE CH.FLC!CH.PNC ; " .BYTE CH.FLC ; # .BYTE CH.FLC ; $ .BYTE CH.FLC ; % .BYTE CH.FLC ; & .BYTE CH.FLC ; ' .BYTE CH.FLC!CH.PNC ; ( .BYTE CH.FLC!CH.PNC ; ) .BYTE CH.FLC ; * .BYTE CH.FLC ; + .BYTE CH.FLC!CH.PNC ; , .BYTE CH.FLC ; - .BYTE CH.FLC!CH.PER!CH.PNC ; . .BYTE CH.FLC!CH.PNC ; / .BLKB 10. ; 0 - 9 .BYTE CH.FLC!CH.PER,CH.FLC!CH.PER ; : ; .BYTE CH.FLC,CH.FLC,CH.FLC ; < = > .BYTE CH.FLC!CH.PER,CH.FLC!CH.PNC ; ? @ .BYTE CH.VOW,0,0,0,CH.VOW,0,0,0 ; A-H .BYTE CH.VOW,0,0,0,0,0,CH.VOW,0 ; I-P .BYTE 0,0,0,0,CH.VOW,0,0,0 ; Q-X .BYTE CH.VOW,0 ; Y-Z .BYTE CH.FLC ; [ .BYTE CH.FLC!CH.PNC ; \ .BYTE CH.FLC ; ] .BYTE CH.FLC ; ^ .BYTE CH.FLC ; _ underscore .BYTE CH.FLC ; ` .BYTE CH.VOW,0,0,0,CH.VOW,0,0,0 ; A-H .BYTE CH.VOW,0,0,0,0,0,CH.VOW,0 ; I-P .BYTE 0,0,0,0,CH.VOW,0,0,0 ; Q-X .BYTE CH.VOW,0 ; Y-Z .BYTE CH.FLC,CH.FLC,CH.FLC,CH.FLC ; { - ~ .BYTE CH.PNC ; DEL .even .psect $TABL,RO,D,LCL,CON BITABL:: .WORD 1,2,4,10,20,40,100,200,400 .WORD 1000,2000,4000,10000,20000,40000,100000 .PSECT TEXT,RO,D,LCL,CON ILSBCM: .ASCIZ /RNO -- Unrecognized command/ ILSBST: .ASCIZ /RNO -- Too many nested substitutions/ ILSBND: .ASCIZ /RNO -- Undefined substitution/ ILUNES: .ASCIZ /RNO -- Undefined escape seq./ .PSECT $CODE,I,RO,LCL,CON ; ; THE JUMP TABLE TO PARSE CHARS ; ; NOTE: HOOK FOR AUTOINDEXING EXISTS BUT NO AUTO INDEX ROUTINE YET .WORD HLTER,GOINX,GOREP,HLTER,GOELP,GOTAB .WORD GOBS,GOQTS,GOESC,HLTER,HLTER,HLTER,GOUNL GCJMP: .WORD GCDN,GCUP .WORD GCACC,GCCAP,GCUNL,SHFDN,SHFUP,GCQTS,GCOVR,GCIFL,GCHYP .WORD GCESC,GCSUB,GCBRK,GCINR .WORD GCCR,GCTAB,GCLF,GCINR,GCSPC,GCINR,GCSPF .WORD GCEQN1,GCEQN2 ; ; GET INPUT CHARACTER FROM SOURCE FILE AND INTERPRET IT ; GCIN:: CALL CCIN ; GET CHARACTER FROM FILE. GCIN1: MOVB GCTABL(R1),R0 ; GET CHARACTER TYPE DSPTCH: JMP @GCJMP(R0) ; DISPATCH ACCORDING TO TABLE ; ; HERE ARE SPECIAL CHARACTER CASES ; ; UPPER CASE GCDN: TSTB CASE ; CONVERSION NECESSARY BGE GCINR ; NO GCDN1: ADD #40,R1 ; CONVERT CASE IF NECESSARY BR GCINR ; ; LOWER CASE LETTERS GCUP: TSTB CASE ; CONVERSION NECESSARY BLE GCINR ; NO GCUP1: SUB #40,R1 ; CONVERT TO UPPER CASE BR GCINR ; ; CAPITALIZE FLAG GCCAP: TSTNEB $CFLSW+1,GCINR ; Flag temporarily disabled ? MOVB #1,CASE ; SET WORD CAPITALIZE CONVERSION VALUE BR GCIN ; ; ACCEPT FLAG GCACC: TSTNEB $AFLSW+1,GCINR ; Flag temporarily disabled ? CALL CCIN ; READ CHARACTER NO TRANSLATION CMPB R1,#SPC ; Compare with space BGT GCINR ; Not space or less ? BEQ GCQTS1 ; Space ? Make it quoted space BR GCIN1 ; Less than space ? ; UNDERLINE FLAG GCUNL: TSTNEB $UFLSW+1,GCINR ; Flag temporarily disabled ? BITB #^C,$UNLSW ; CHECK UNDERLINING SWITCH BNE GCIN ; Permanently disabled ? MOV #ULCHS,R1 ; SET TO UNDERLINE CHARACTER JMP GCINO ; ; OVERSTRIKE FLAG GCOVR: TSTNEB $OFLSW+1,GCINR ; Flag temporarily disabled ? BISB #SW.TDS,$AUHYP ; Temporary disable hyphenation TSTEQB $OVRSW,10$ ; OVERSTRIKE ENABLED? INC OVRCT ; YES, COUNT ABORTED CHARS. BR GCIN ; MORE INPUT 10$: MOV #BS,R1 ; MAKE IT BACK SPACE ADD PHSP,LINBK ; Add to remaining chars SUB PHSP,SPCH ; Subtract from spacing characters BR GCINO ; ; HYPHENATE FLAG GCHYP: TSTNEB RETSW,GCLF ; Return ? TSTNEB $HFLSW+1,GCINR ; Flag temporarily disabled ? BISB #SW.TDS,$AUHYP ; Set temporary no auto hyphenation TST LINBK ; Check room on page BLE GCIN ; No room for hyphenation ? CMPEQB LCH,#SPC,GCIN ; Last char space ? CMPEQB LCH,#TAB,GCIN ; or tab ? CMPEQB LCH,#NXS,GCIN ; or non expandable space ? MOV SPCH,HYPSP ; Hyphenation spacing chars. BR GCIN ; QUOTED SPACE FLAG GCQTS: TSTNEB $QFLSW+1,GCINR ; Flag temporarily disabled ? TSTNEB RETSW,GCLF ; Return ? MOVB ULOCK,CASE ; RESET CASE GCQTS1: MOV #NXS,R1 ; SET NON EXPANDABLE SPACE BISB #SW.TDS,$AUHYP ; Set temporary no auto hyphenation BR GCINR1 ; AND SAVE IT GCINR:: BIC #1002,CASE ; Reset temporary upper case conversion GCINR1: TSTEQ OVRCT,10$ ; NO BACKSPACE ABORTS DEC OVRCT ; DECREMENT ABORTS BR GCIN ; NEXT CHAR 10$: ADD PHSP,SPCH ; Add to spacing char count MOVB R1,LCH ; SAVE LAST CHARACTER CALL PUBYT ; OUTPUT CHAR MOV TESMSK,R4 ; Cancel escapes ? BEQ 12$ ; No ? CALL ESCEND ; Cancel them 12$: MOVB LCH,R1 BITEQB #CH.BRK,CHTABL(R1),16$ ; No AutoBreak ? TSTNEB $AUBRK,16$ ; No break ? TST LINBK ; Past end of line ? BLE 16$ ; Yes ? BISB #SW.TDS,$AUHYP ; set temporary no hyphenation TSTEQB $TABPD,14$ ; No right tabs ? CALL BRKTS ; Set them up BR 16$ ; done 14$: CALL BRKSV ; Set up break here 16$: SUB PHSP,LINBK ; Subtract from char count remaining BEQ 20$ BCC 70$ ; NO CMPEQ PHSP,#1,70$ ; Single decrement ? 20$: MOV SPCH,LNINS ; Char count at last character TSTNE BRCNT,30$ ; NO breaks this line? CALL BRKSV ; Save break here 30$: TSTNEB $GCEND,GCLF ; Immediate end requested? 70$: JMP GCIN ; Continue GCLF: RETURN GCINO: CALL PBYT ; OUTPUT CHAR JMP GCIN ; CONTINUE PARSING INPUT ; ;ROUTINE TO READ INPUT FROM FILE AND REMOVE BAD INPUT ; R1= CHARACTER READ ; CCIN:: MOVB SUBSTK,R1 ; substitution? BEQ 10$ ; no MOV BUFADD(R1),R1 ; input buffer header CALL GBYT1 ; get input BNE 20$ ; is it ok? DECB SUBSTK ; pop stack DECB SUBSTK ; pop stack BR CCIN ; try again 10$: CALL FIN ; NO. READ FROM FILE BIC #^C<177>,R1 ; CLEAR EXCESS BITS TSTB GCTABL(R1) ; LEGAL CHARACTER? BLT CCIN ; NO GET ANOTHER 20$: RETURN ; ; routine to parse substitution - SUBSTITUTE FLAG ; GCSUB: TSTEQB $SBFSW+1,1$ ; Flag not disabled ? JMP GCINR 1$: MOV R3,-(SP) ; save MOVB SUBSTK,R3 ; substitution stack pointer MOV BUFADD(R3),R3 ; get buffer header for input MOV #TBUFF-1,R2 ; temporary buffer MOVB R1,(R2)+ ; Save flag MOV BF.FUL(R3),-(SP) ; save current location MOV #10.,R4 ; max number of char/label 50$: CALL GBYT ; get input CMP R1,#SPC ; non printable? BLE 60$ ; yes, done CMPNEB GCTABL(R1),#GC.LC,55$ ; Not lower case ? CMPEQ R2,#TBUFF,55$ ; Not first char ? SUB #40,R1 ; Make it lower case 55$: MOVB R1,(R2)+ ; Save char SOB R4,50$ ; no, continue 60$: CLRB (R2)+ ; Chock end of string MOV #TBUFF,R2 ; Start of buffer CMPNEB (R2),$SBFSW,65$ ; First char not substitute flag ? MOVB #'$,(R2) ; Make first char $ 65$: MOV (SP)+,R1 ; current location CALL FNDBF ; go back to it CALL FNDSB ; Find substitution MOV (SP)+,R3 ; restore JMP GCIN ; ; Find substitutions All registers destroyed ; FNDSB:: MOVB SUBSTK,R3 ; substitution stack pointer CMPB R3,SUBSTK+1 ; max stack reached? BLO 40$ ; no MOV #ILSBST,R0 ; Too many nestings error BR 20$ 10$: MOV #ILSBND,R0 ; Undefined substitution error TSTB TBUFF BGT 20$ ; Not command ? MOV #ILSBCM,R0 ; Undefined command 20$: CALL EROUT MOV #TBUFF-1,R0 ; Print substitution CALL EROUT CALL ONLIN ; Print line number 30$: SEC return 40$: MOV BUFADD+2(R3),R3 ; next stack header CALL BEGBF ; set to beginning of buffer CALL GWRD ; First index BCS 10$ ; None? 70$: TSTEQ R1,10$ ; None ? CALL FNDBF ; Find next entry CALL GWRD ; get next index BCS 10$ ; end, no escape found MOV R1,R4 ; save MOV #TBUFF,R2 ; temporary buffer MOV BF.FUL(R3),BF.SPC(R3) ; Save index for traceback 80$: CALL GBYT ; search for key word BCS 10$ ; None? TSTEQ R1,90$ ; end of search? CMPEQB R1,(R2)+,80$ ; match? MOV R4,R1 ; Next entry index BR 70$ ; search again 90$: MOV R2,R1 ; end of string SUB #TBUFF,R1 ; find string length MOVB SUBSTK,R3 ; current input ADD #2,R3 ; next entry TSTB TBUFF BLT 95$ ; Command ? TSTNEB $SUBSW,100$ ; substitution suppressed? 95$: MOVB R3,SUBSTK ; into stack 100$: MOV BUFADD-2(R3),R3 ; input buffer header ADD BF.FUL(R3),R1 ; add word size to current index CALL FNDBF ; skip over $ and key word CLC RETURN ; done, continue with normal sequence ; ; TAB character handled here. It is expanded. ; GCTAB: TSTNEB $TABSW,GCSPC ; NO TABS ALLOWED? BISB #SW.TDS,$AUHYP ; No autohyphenation now MOVB ULOCK,CASE ; RESTORE CASE CALL BRKTS ; Test + execute right tabs CLR R2 CALL TABB ; FIND WHERE NEXT TAB STOP IS CMP R2,LINBK ; Does this exceed line size? BLE 20$ ; It is OK ? TST LINBK ; Currently too long ? BLT 10$ ; Yes CALL BRKSV ; No, put break here 10$: MOV #-1,LINBK ; Set line too long MOVB #TAB,R1 ; Current char RETURN 20$: TSTEQB $TABLF,30$ ; Left justify tabs ? MOV #1,R2 ; Only 1 space for right justify MOVB R2,$TABPD ; Now set 1 tab pending 30$: CMPNEB LCH,#TAB,25$ ; Was last char not tab ? TSTEQ LTAB,25$ ; No tab pending SUB R2,LINBK ; AND DECREMENT LINBK COUNT BY THAT AMOUNT ADD R2,SPCH ; Add to spacing characters CALL ADDTAB ; Add r2 to previous tab BR TABXIT ; 25$: CALL BRKSV ; Set break here SUB R2,LINBK ; AND DECREMENT LINBK COUNT BY THAT AMOUNT ADD R2,SPCH ; Add to spacing characters MOVB #TAB,LCH ; LAST CHAR MOVB #TABO,R1 ; Set to output tab TSTEQB $ELIPS,40$ ; No ellipses? MOVB #ELIP,R1 ; Yes, set to output ellipses 40$: CALL PBYT ; Into buffer MOV R2,R1 ; Number of spaces CALL PBYT ; Into buffer MOV BF.ADD(R3),LTAB ; Address of last tab char TABXIT: JMP GCIN ; Next char ; ; End of line action, space if fill disabled ; GCCR: TSTNEB $CENSW,10$ ; Centering enabled ? TSTNEB $RIGSW,10$ ; Right justify enabled BITNE #FILLF,F.1,GCSPC ; Fill enabled ? 10$: CALL BRKTS ; Test tab + break TST LINBK ; Past end of line ? BGE TABXIT ; No ? RETURN ; Yes ! ; ; Handle spaces in input stream ; GCSPC:: TSTNEB RETSW,SPCRET ; Return ? MOVB ULOCK,CASE ; RESTORE CASE TST LINBK ; Line full ? BGE 10$ ; NO ? TSTNE @EQSTK,10$ ; Equation being formatted ? RETURN ; Yes, break for full line 10$: CALL BRKTS ; Test and set up right tabs BITEQ #FILLF,F.1,30$ ; FILL disabled ? MOVB LCH,R1 ; GET PREVIOUS CHARACTER WHAT WAS IT? BEQ TABXIT ; Start of new line ? CMPEQ R1,#SPC,TABXIT ; Space before space ? CMPEQ R1,#TAB,TABXIT ; Tab before space ? CMPEQ R1,#NXS,TABXIT ; Non expandable space before space ? TSTEQB $PERSW,30$ ; Automatic punctuation spacing disabled ? BITEQB #CH.PER,CHTABL(R1),30$ ; Not Punctuation before space ? CMP LINBK,#1 ; Space left ? BLE 30$ ; No 20$: CALL 50$ ; Set up for space CALL PUBYT ; Save space ADD PHSP,SPCH ; Add to spacing chars SUB PHSP,LINBK ; And subtract from char left MOV #NXS,R1 ; Next output non expandable space BR 40$ ; 30$: CALL 50$ ; 40$: BICB #SW.TDS,$HYPSW ; Allow hyphenation BICB #SW.TDS,$AUHYP ; Allow auto hyphenation CLR HYPSP JMP GCINR1 ; RETURN CHAR. 50$: TSTNE @EQSTK,70$ ; Equation in progress CALL BRKSV ; Set up for break here TSTNEB $NOSPC,70$ ; No expandable spaces allowed ? INC SPCNT ; COUNT THIS SPACE MOV #SPC,R1 ; SPACE CHARACTER (EXPANDABLE) 60$: RETURN ; 70$: MOV #NXS,R1 ; Make it non expandable SPCRET: RETURN ; ; break flag here ; GCBRK: TSTNEB RETSW,SPCRET ; Return ? TSTEQB $BRFSW+1,1$ ; Flag not disabled ? JMP GCINR 1$: BISB #SW.TDS,$AUHYP ; set temporary no hyphenation TST LINBK ; Past end of line BGE 10$ ; Not yet RETURN 10$: TSTEQB $TABPD,20$ ; No right tabs ? CALL BRKTS ; Set them up JMP GCIN ; done 20$: CALL BRKSV ; Set up break here JMP GCIN ; next char ; ; Test and set up right tab ; .ENABL LSB BRKTS: TSTEQB $TABPD,10$ ; No tab pending? TSTEQ LTAB,10$ ; No tab address ? CLRB $TABPD ; No more tabs pending MOV #-1,R2 ; Initial tab CALL TABB ; Find next tab stop DEC R2 ; CMP R2,LINBK ; Too many for line ? BGT 10$ ; YES. TREAT AS SPACE, NOT TAB ADD R2,SPCH ; Spacing chars SUB R2,LINBK ; Current length this line ADDTAB: MOVB @LTAB,R1 ; Get last tab ADD R2,R1 ; Add on more MOVB R1,@LTAB ; Increment old tab 10$: RETURN .DSABL LSB ; ; Set up break (save current character status) ; BRKSV:: CALL LSINSV ; save input addresses CLRB HYPSP INC BRCNT ; count breaks this line MOV PHSP,LPHSP ; Spacing at break MOV CASE,CASSAV ; SAVE CURRENT CASE MOV BF.FUL(R3),LSTSP ; POSITION IN BUFFER MOV SPCH,LSPCH ; Save current spacing char count MOV ESMSK,LESMSK ; Save current escape mask MOVB $UNLSW,LUNLSW ; And underline status MOVB LCH,LSCH ; SAVE CHAR BEFORE SPACE MOV SPCNT,SPCNSV ; Save old space count RETURN ; ; Here we handle Index flag ; GCIFL:: TSTEQB $IFLSW+1,10$ ; Autoindex flag on ? JMP GCINR ; No, ouput char 10$: CALL AINDEX ; Do autoindex JMP GCIN ; Continue ; ; HERE WE HANDLE SEPARATE ESCAPE SEQUENCES ; GCESC: TSTEQB $EFLSW+1,1$ ; Flag not disabled ? JMP GCINR 1$: MOV R1,R5 ; First character CALL CCIN ; GET NEXT CHAR GCES1: CALL ESCSEQ ; ESCAPE SEQUENCE? BCC 10$ ; No ? MOV #ILUNES,R0 ; Message undefined escape CALL EROUT ; Print message CALL ONLIN ; Print line number 10$: JMP GCIN ; NEXT CHAR ; ; Special Flag character detected ; GCSPF: TSTEQB $SPFSW+1,1$ ; Flag not disabled ? JMP GCINR 1$: MOV #'^+100000,R5 ; Move in shift up operator+ temp flag CALL ESCSEQ ; Execute sequence BCC 10$ ; Not executed ? MOV #ILUNES,R0 ; Message undefined escape CALL EROUT ; Print message CALL ONLIN ; Print line number 10$: JMP GCIN ; Continue ; ; SUBROUTINE TO FIND ESCAPE SEQUENCE FROM TABLE ; ; R4=Escape sequence mask ; R3 is preserved/ all other registers changed .enabl LSB ESCBEG:: CLR R5 ; Look for begin sequence BR 1$ ESCEND:: MOV #177,R5 ; Look for end sequence 1$: TSTEQ R4,7$ ; No escapes ? TSTNEB $ESCSW,7$ ; Escapes disabled ? MOV R3,-(SP) ; Save current buffer MOV #ESCBF,R3 ; Escape buffer CALL BEGBF ; Start at beginning MOV (SP)+,R3 ; Restore 2$: TSTEQ R4,7$ ; Done ? CALL 11$ ; Do next sequence BCC 2$ ; Ok ? 7$: RETURN 11$: MOV R3,-(SP) ; Save current buffer MOV #ESCBF,R3 ; Escape buffer 12$: CALL GBYT ; Get count BCS 17$ ; Done ? MOV BF.FUL(R3),-(SP) ; And current index MOV R1,R2 ; Character count CALL GBYT ; Skip 1 byte CALL GBYT ; Skip 1 byte CALL GBYT ; Skip 1 byte MOV R1,-(SP) ; Save status BITNEB #ES.LCK,R1,4$ ; Is this lock status ? 3$: TST (SP)+ ; Pop status MOV R2,R1 ; number of bytes to skip ADD (SP)+,R1 ; New index CALL FNDBF ; skip them BR 12$ ; Try again 4$: CALL GBYT ; Get lock byte BLT 5$ ; Unlock ? TSTNEB R5,3$ ; Lock desired ? ADD #BITABL,R1 ; Now points to table BITEQ (R1),R4,3$ ; Not requested escape ? BIC (R1),R4 ; Clear 1 bit BR 31$ ; Ok! 5$: TSTEQB R5,3$ ; Unlock desired ? ADD #BITABL-177600,R1 ; Compensate for hi bits BITEQ (R1),R4,3$ ; Not requested escape ? BIC (R1),R4 ; Clear 1 bit BITNE (R1),TESMSK,32$ ; Clearing temporary bit? BR 31$ ; ; R5 = first char ; R1 = second char ; R3,R5 are preserved ; C = set if sequence not found ; ESCSEQ: BITEQB #CH.ES2,CHTABL(R1),15$ ; Not escape character ? MOV R3,-(SP) ; save current buffer MOV #ESCBF,R3 ; escape buffer MOV R1,R4 ; SAVE CHAR CALL BEGBF ; Start at beginning 10$: CALL GBYT ; get beginning of sequence BCC 20$ ; not end of table? MOVB R4,R1 ; GET CHAR BACK 17$: MOV (SP)+,R3 ; restore 15$: SEC ; NO SEQ FOUND RETURN 20$: MOV BF.FUL(R3),-(SP) ; And save current index MOV R1,R2 ; number of bytes in sequence CALL GBYT ; get next bytes CMPNEB R5,R1,25$ ; MATCH WITH CHAR? CALL GBYT ; get next bytes CMPEQB R4,R1,30$ ; MATCH WITH CHAR? 25$: MOV R2,R1 ; number of bytes to skip ADD (SP)+,R1 ; add on current index CALL FNDBF ; skip them BR 10$ 30$: TSTEQB $ESCSW,27$ ; ESCAPE SEQUENCES not DISABLED? JMP 55$ ; Disabled 27$: BISB #SW.TDS,$AUHYP ; set temporary no hyphenation CALL GBYT ; Get flag byte BEQ 40$ ; No flag byte ? MOVB R1,-(SP) ; Save bit mask BITEQB #ES.LCK,(SP),31$ ; Not lock/Unlock ? CALL GBYT ; Get lock word BLT 21$ ; Unlock ? ADD #BITABL,R1 ; Points to bit table BITNE (R1),ESMSK,54$ ; Is it currently locked on ? BIS (R1),ESMSK ; Lock it on TST R5 ; Do we do temporary lock BGT 31$ ; No BITEQB #ES.CHR,(SP),31$ ; Not temporary sequence BIS (R1),TESMSK ; Set temporary mask BR 31$ 21$: ADD #BITABL-177600,R1 ; Compensate for hi bits BITEQ (R1),ESMSK,54$ ; Currently locked off ? 32$: BIC (R1),ESMSK ; Lock it off BIC (R1),TESMSK ; Clear temporary mask also 31$: BITEQB #ES.VSP,(SP),33$ ; No vertical spacing CALL GBYT ; Get vertical spacing SUB R1,LINEC3 ; Decrement lines left ADD CURVS,R1 ; Add on current VS MOV R1,CURVS ; Save current CMP R1,MINVS ; Compare with min BGT 311$ ; Bigger ? MOV R1,MINVS ; New min 311$: CMP R1,MAXVS ; Compare with max BLT 312$ ; Smaller ? MOV R1,MAXVS ; New max 312$: ADD R1,BF.VSP(R3) ; Count deferred text line 33$: BITEQB #ES.HSP,(SP),37$ ; No Horizontal spacing CALL GBYT ; Get horizontal spacing BITNEB #ES.PSP,(SP),35$ ; Permanent spacing ? MOVB R4,LCH ; Set last char ADD R1,SPCH ; Count spacing chars SUB R1,LINBK ; And remove from available spaces BR 37$ 35$: BICB #40,$NOSPC ; Set for expandable spaces ok BICB #40,$TABSW ; Enable tabs MOV R1,PHSP ; Set permanent horiz spacing BICB #SW.TD2,$AUHYP ; Temporary hyphenation off CMPEQ R1,#1,37$ ; Spacing 1 ? BISB #SW.TD2,$AUHYP ; set temporary no hyphenation BISB #40,$NOSPC ; Set no expandable spaces BISB #40,$TABSW ; Set no tabs 37$: TST (SP)+ ; Pop saved flags 40$: MOV (SP)+,R1 ; Index for transfer ADD #2,R1 ; Points to status now SUB #2,R2 ; Number of bytest to transfer CALL FNDBF ; Go back to start of sequence MOV (SP)+,R3 ; Output buffer MOV #ESC,R1 ; Mark escape sequence in output buffer 45$: CALL PUBYT ; OUTPUT IT 50$: MOV #ESCBF,R1 ; escape buffer CALL GBYT1 ; get next bytes CALL PBYT ; OUTPUT CHAR SOB R2,50$ CLR R1 ; Mark end of sequence CALL PBYT ; Into buffer BR 60$ 54$: TST (SP)+ ; Pop stack 55$: TST (SP)+ ; Pop stack MOV (SP)+,R3 ; Restore buffer address 60$: CLC ; SUCCESS RETURN ; .DSABL LSB ; ; ROUTINE TO FIND NEXT TABSTOP FOR OUTLIN ROUTINE. ; OUTPUT R2= DISTANCE TO NEXT STOP ; R0,R1 are destroyed ; TABB: CLR R0 ; START AT FIRST TABSTOP ADD SPCH,R2 ; NUMBER OF SPACING CHARS ADD LMARG,R2 ; ADD ON LEFT MARGIN ADD INDCT,R2 ; PLUS INDENTATION BR 20$ ; PRE-ENDCHECK, IN CASE NONE. 10$: MOVB TABTAB-1(R0),R1 ; GET CURRENT TAB STOP BIC #177400,R1 ; Clear extra bits CMP R2,R1 ; THIS STOP BEYOND CURRENT POS? BLO 40$ ; YES. GET DIFFERENCE 20$: CMP R0,NTABS ; LOOKED AT ALL TAB STOPS? BHIS 30$ ; Yes INC R0 ; ADVANCE TO NEXT ENTRY BR 10$ 30$: MOV RMARG,R1 ; YES. ASSUME A TABSTOP AT RIGHT END 40$: SUB R2,R1 ; GET DISTANCE TO TABSTOP MOV R1,R2 ; ANSWER IN A BGT 50$ ; At least 1 space? MOV #1,R2 ; No make it 1 50$: CLR OVRCT ; NO ABORTS RETURN ; ; ; UPPER CASE FLAG ; .ENABL LSB SHFUP: TSTEQB $SFLSW+1,1$ ; Flag not disabled ? JMP GCINR 1$: CALL CCIN ; READ A CHARACTER BITEQB CHTABL(R1),#CH.FLG,40$ ; Not flag character ? CMPNE R1,$UFLSW,10$ ; LOCK ON UNDERLINE? BICB #SW.TDS,$UNLSW ; UNDERLINING POSSIBLY ON BR 30$ 10$: CMPNE R1,$CFLSW,20$ ; NOT LOCK UPPER CASE? MOV #401,CASE ; SET UPPER CASE + LOCK BR 30$ ; READ ONOTHER CHAR 20$: CMPNE R1,$SFLSW,40$ ; NOT UNLOCK ALL? CALL UPCAS ; SET TO UPPER CASE 30$: JMP GCIN ; AND GO READ ANOTHER CHARACTER 40$: MOVB $SFLSW,R5 ; MATCH CHAR CALL ESCSEQ ; SEARCH FOR ESCAPE SEQUENCE BCC 30$ ; FOUND ONE! MOVB GCTABL(R1),R0 ; CHAR TYPE? CMPNE R0,#GC.LC,50$ ; NOT LOWER CASE? JMP GCUP1 ; LOWER CASE, SHIFT IT. 50$: CMP R0,#GC.LC ; ALPHABETIC CHAR? BLE 60$ ; YES, DO NOT EXECUTE IT JMP @GCJMP(R0) ; DISPATCH IT 60$: JMP GCINR ; ; LOWER CASE FLAG DETECTED ; SHFDN: TSTEQB $LFLSW+1,2$ ; Flag not disabled ? JMP GCINR 2$: CALL CCIN ; GET ANOTHER CHARACTER BITEQB CHTABL(R1),#CH.FLG,80$ ; Not flag character ? CMPNE R1,$UFLSW,70$ ; UNLOCK UNDERLINE? BISB #SW.TDS,$UNLSW ; UNDERLINING OFF BR 30$ ; 70$: CMPNE R1,$LFLSW,80$ ; NOT LOWERCASE LOCK? CALL LWCAS ; SET LOWER CASE SHIFT BR 30$ ; 80$: MOVB $LFLSW,R5 ; MATCH CHAR CALL ESCSEQ ; HANDLE ESCAPE SEQUENCES BCC 30$ ; FOUND ESC SEQ MOVB GCTABL(R1),R0 ; CHAR TYPE? CMPNE R0,#GC.UC,50$ ; NOT UPPER CASE? BITNE #UPCSW,$SWTCH,60$ ; IS UP SHIFT MANDATED? JMP GCDN1 ; SHIFT TO LOWER CASE .DSABL LSB ; ; CASE SELECTION COMMANDS ; .ENABL LSB LWCAS:: MOV #-1,R1 ; SET FOR CONVERSION TO LOWER CASE BR 10$ ; UPCAS:: CLR R1 ; SET FOR NO CASE CONVERSION 10$: BITEQ #UPCSW,$SWTCH,20$ ; Not Upper case only? MOV #401,R1 ; FORCE TO UPPER CASE 20$: MOV R1,CASE ; SET CASE CONVERSION RETURN ; .DSABL LSB ; ; COROUTINE TO SHIFT TO UPPER CASE TEMPORARILY ; SHFUC:: MOV (SP),-(SP) ; COPY RETURN ADDRESS MOV CASE,2(SP) ; SAVE CURRENT CASE MOV #401,CASE ; UPPER CASE ONLY CALL @(SP)+ ; CALL THE CALLER BACK MOV (SP)+,CASE ; RESTORE PREVIOUS CASE SHXIT: RETURN ; ; ; PUT STRING ENDED BY ZERO BYTE TO BUFFER ; R0= STRING ADDRESS ; PSTRZB:: MOVB (R0)+,R1 ; GET FIRST CHAR BEQ SHXIT ; DONE MOV R0,-(SP) CALL PBYT ; PUT IT INC BF.SPC(R3) ; Count chars MOV (SP)+,R0 INC R2 ; COUNTS CHARS. BR PSTRZB ; CONTINUE .DSABL LSB ; ; ROUTINES TO OUTPUT A STRING TO THE OUTPUT FILE ; R3=BUFFER ADDRESS FOR STRING ; Output terminates at either null or end of input buffer ; Z or C tell user what form of termination occurred. ; ; This one starts at top of buffer PSTRPA::CALL BEGBF ; SET TO TOP OF BUFFER CLRB EXSP1 ; No multiple spaces CLRB EXSTAT ; No status CLRB EXMSP ; No multiple micro spaces ; ; This one starts anywhere in buffer ; CCOUT:: CLRB $ULOSW ; No underlining at first CCOUT1: CLRB $ULOSW ; Reset underlining CCOUT2: CALL GBYT ; Get 1 byte BCS GOEND BGT 10$ ; No extra bits BEQ GOEND ; End of input buffer ? INCB $ULOSW ; Set underline BIC #^C<177>,R1 ; Clear extra bits 10$: .ifdf $DEBUG CALL CHROUT .endc CMPEQB R1,#SPC,GOSPC ; Is it space ? MOVB GCTABL(R1),R0 ; GET CHAR TYPE BGE GOPRN ; PRINTABLE JMP @GCJMP(R0) ; EXECUTE FUNCTION ; Handle single underline GOUNL: INCB $ULOSW BR CCOUT2 ; Printable char GOPRN: CALL CCPRN ; Print 1 char BR CCOUT1 GOSPC: MOVB EXSP1,-(SP) ; YES. HOW MANY MULTIPLE SPACES? MOVB EXMSP,1(SP) ; Micro spaces DECB EXSP2 ; TO EXTRA BLANKS YET? BGE 70$ ; NO. TSTEQB EXSP3,80$ ; EXTRA SPACES TO RIGHT? BR 90$ ; LEFT. NO MORE EXTRAS, JUST LOOP 70$: TSTEQB EXSP3,90$ ; NO EXTRA SPACES LEFT OR RIGHT? 80$: BITEQB #HD.VAR,EXSTAT,85$ ; No micro spacing ? INCB 1(SP) ; Micro spacing count BR 90$ 85$: INCB (SP) ; Extra space to output 90$: BITEQB #HD.VAR,EXSTAT,110$ ; No micro spacing ? MOVB 1(SP),R1 ; count BLE 110$ ; micro count too small ? TSTNEB $ULMSW,94$ ; Underline by BS MOV CPOS,R0 ; Current position CMP R0,#ULNSZ ; check with max BHI 95$ ; Too big ? BIS #200,R1 ; Now is count for underline buffer MOVB R1,UBUFF-1(R0) ; Into buffer MOVB #-1,$UNLRS INC CPOS ; Next position BR 95$ 94$: TSTEQB $ULOSW,95$ ; No underlining ? MOV #1,R2 ; Number of chars to underline CALL CCUNL 95$: DECB 1(SP) ; Count micro spaces BLT 110$ ; None ? MOV #VARESC+1,R2 ; Address of escape sequence buffer 100$: MOVB (R2)+,R1 ; Data to output BEQ 95$ ; Another to output CALL FOUT ; Output it BR 100$ ; And try again 110$: CALL CCSPC ; OUTPUT SPACES DECB (SP) ; Decrement counter BGT 110$ ; Not done ? TST (SP)+ ; Pop counter JMP CCOUT1 GOQTS: CALL CCSPC ; Turn quoted space to single space JMP CCOUT1 GOEND: RETURN GOESC: CALL GBYT ; Get flag byte BEQ 90$ ; No flag byte ? MOVB R1,-(SP) ; Save bit mask BITEQB #ES.LCK,(SP),10$ ; Not lock/Unlock ? CALL GBYT ; Get lock word 10$: BITEQB #ES.VSP,(SP),20$ ; No vertical spacing CALL GBYT ; Get vertical spacing SUB R1,LINEC1 ; Decrement lines left SUB R1,LINEC2 ; Decrement lines left 20$: BITEQB #ES.HSP,(SP),80$ ; No Horizontal spacing CALL GBYT ; Get horizontal spacing BLE 80$ ; Too small ? BITNEB #ES.PSP,(SP),40$ ; Permanent spacing ? TSTNEB $ULOSW,30$ ; Underline ? ADD R1,CPOS ; No BR 80$ 30$: MOV R1,R2 ; Number of undelines CALL CCUNL ; Perform underlining BR 80$ 40$: MOV R1,PHSPOU ; Set permanent horiz spacing ; ; Now output escape sequence ; 80$: TST (SP)+ 90$: CALL GBYT ; Get escape sequence chars BEQ 100$ ; Done ? CALL FOUT ; Output char with no interpretation BR 90$ ; More ? 100$: JMP CCOUT1 ; End of escape seq buffer ? ; Handle backspaces GOBS: SUB PHSPOU,CPOS ; New position BGT 10$ ; OK ? MOV #1,CPOS ; No, make it 1 10$: CALL FOUT ; Output backspace JMP CCOUT1 ; Handle tabs GOTAB: CALL GBYT ; Get next input byte MOVB R1,-(SP) ; Save it 10$: BGT 20$ ; Not done yet 15$: TST (SP)+ ; Pop stack JMP CCOUT1 20$: CALL CCSPC ; Output a space DECB (SP) ; Done? BR 10$ ; Check it ; Handle tabs with ellipses GOELP: CALL GBYT ; Get 1 byte CLR -(SP) ; Clear counter on stack MOVB R1,(SP) ; Save count 10$: BGT 20$ ; Spaces to output ? 15$: TST (SP)+ ; Done so pop stack JMP CCOUT1 20$: CALL CCSPC ; Output 1 space 30$: DEC (SP) ; Done yet? BLE 15$ ; Not yet BITNEB #1,CPOS,20$ ; Output space? CMPB (SP),#1 ; Output space? BLE 20$ ; Yes MOVB #'.,R1 ; No, do period CALL CCPRN ; Output printable char BR 30$ ; Handle repeated output GOREP: CALL GBYT ; Get repeat count BEQ 50$ ; Repeat zero ? .ifdf $DEBUG CALL CHROUT .endc CLR -(SP) ; Clear count on stack MOVB R1,(SP) ; Save count MOV BF.FUL(R3),-(SP) ; Save input index 10$: CALL CCOUT1 ; Now output string DEC 2(SP) ; Done ? BLE 20$ ; Yes ? MOV (SP),R1 ; Rewind input buffer CALL FNDBF ; Back over string BR 10$ ; Repeat 20$: ADD #4,SP ; Pop stack JMP CCOUT1 ; And continue 50$: CALL 55$ ; Stack up reequest to kill repeat JMP CCOUT1 ; And continue 55$: CALL GBYT ; Get char BNE 60$ ; Not done ? RETURN 60$: CMPEQB R1,#ESC,70$ ; Escape sequence ? CMPNEB R1,#REPO,55$ ; No repeat ? CALL GBYT ; Skip count CALL 55$ ; Stack another skip BR 55$ ; Done with imbedded repeat 70$: CALL GBYT ; Skip status 80$: CALL GBYT ; Get sequence BNE 80$ ; Not terminator ? BR 55$ ; ; section to fill in index entries ; GOINX: CALL GWRD ; Get address inside index buffer MOV R3,-(SP) ; Save MOV #INXBF,R3 ; Get index buffer address CALL FNDBF ; Get the index entry address MOV PAGENO,R1 ; Get page number BIS PAGDSP,R1 ; With the display bits CALL PWRD ; Save in index buffer MOVB SUBPGE,R1 ; Get subpage BEQ 10$ ; None ? CALL PBYT ; Save it too 10$: MOV (SP)+,R3 ; Restore JMP CCOUT1 ; ; Subroutine to output printable chars ; CCSPC:: MOV #SPC,R1 ; GET SPACE CCPRN:: TSTEQB $ULOSW,NOUNL ; No underlining ? MOV PHSPOU,R2 ; Number of underlines CALL CCUNL ; YES, DO IT JMP FOUT ; output character NOUNL: ADD PHSPOU,CPOS ; INCREMENT POSITION COUNTER JMP FOUT ; OUTPUT CHAR ; ; Do underlining ; CCUNL: MOV R1,-(SP) ; SAVE CHAR 80$: TSTEQB $ULMSW,90$ ; UNDERLINE BY LINE? MOV R2,-(SP) ; Save count ADD R2,CPOS ; New position 82$: MOV #LPUS,R1 ; GET UNDERLINE CALL FOUT ; OUTPUT IT SUB PHSPOU,R2 ; Remaining count BGT 82$ ; More to do ? MOV (SP)+,R2 ; Get count again 84$: MOV #BS,R1 ; GET BACKSPACE CALL FOUT ; OUTPUT IT SUB PHSPOU,R2 ; Remaining count BGT 84$ ; More to do ? BR 100$ 90$: MOV CPOS,R0 ; POSITION CMP R0,#ULNSZ ; TOO BIG? BHI 95$ ; YES MOVB $ULCH,UBUFF-1(R0) ; PUT IT INTO BUFFER CMP R0,ULNMAX ; SMALLER DUE TO BS BLOS 100$ ; YES, KEEP MAX MOV R0,ULNMAX ; AND SAVE LAST ADDRESS 95$: INC CPOS SOB R2,90$ ; Do it for each char 100$: MOV (SP)+,R1 ; GET SAVED CHAR RETURN ; ; Service equation flags ; GCEQN1: TSTNE $EQFSW,NOEQN ; No equations ? JMP GCEQ1 ; Process left brace GCEQN2: TSTNE $EQFSW,NOEQN ; No equations ? JMP GCEQ2 ; Process right brace NOEQN: JMP GCINR ; Output the char ; ; Output byte underlined ; PUBYT:: TSTNEB $UNLSW,11$ ; No underline this char ? BIC #^C<177>,R1 ; Set to proper range BITNEB #CH.UNL,CHTABL(R1),11$ ; Underlining not allowed ? BIS #200,R1 ; Mark it as underlined 11$: JMP PBYT ; OUTPUT CHAR .END