.TITLE GCIN .IDENT /V01/ .PSECT $TEMP,RW,D,OVR,GBL 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 GC.LC==2 GC.AFL==4 ; THESE REFLECT THE ORDER OF THE FLAG WORD SWITCHES GC.CFL==6 GC.UFL==10 GC.LFL==12 GC.SFL==14 GC.QFL==16 GC.OFL==20 GC.IFL==22 GC.HFL==24 GC.EFL==26 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.BUL==-4 ; begin underlining GO.SUL==-6 ; begin underlining spaces GO.EUL==-10 ; end underlining 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,GO.BUL,GO.SUL,GO.EUL ; 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.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) CHTABL:: .BLKB 33. ; NUL-SPC .BYTE CH.FLC!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 .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 ILSBST: .ASCIZ /RNO -- Too many nested substitutions/ ILSBND: .ASCIZ /RNO -- Undefined substitution/ .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,GOEUL,GOSUL,GOBUL,GOUNL GCJMP: .WORD GCDN,GCUP .WORD GCACC,GCCAP,GCUNL,SHFDN,SHFUP,GCQTS,GCOVR,GCINR,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: MOVB #1,CASE ; SET WORD CAPITALIZE CONVERSION VALUE BR GCIN ; ; ACCEPT FLAG GCACC: CALL CCIN ; READ CHARACTER NO TRANSLATION CMPB R1,#SPC ; Is it space or less? BLE GCQTS1 ; Yes ? Make it quoted space BR GCINR ; AND RETURN IT. MAYBE UNDERLINED ; UNDERLINE FLAG GCUNL: BITB #277,$UNLSW ; CHECK UNDERLINING SWITCH BNE GCIN ; IT IS DISABLED MOV #ULCHS,R1 ; SET TO UNDERLINE CHARACTER BR GCINO ; ; OVERSTRIKE FLAG GCOVR: BISB #100,$HYPSW ; TEMPORARILY 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: CALL CCIN ; GET NEXT CHAR MOVB GCTABL(R1),R0 ; GET TYPE CMP R0,#GC.LC ; IS IT UPPER OR LOWER CASE BGT DSPTCH ; NO BIS #200,R1 ; SET FOR HYPHENATION BISB #1,$AUHYP ; Set temporary no auto hyphenation BR DSPTCH ; AND DISPATCH IT ; QUOTED SPACE FLAG GCQTS: MOVB ULOCK,CASE ; RESET CASE GCQTS1: MOV #NXS,R1 ; SET NON EXPANDABLE SPACE 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 PBYT ; OUTPUT CHAR MOV TESMSK,R4 ; Cancel escapes ? BEQ 15$ ; No ? CALL ESCEND ; Cancel them 15$: SUB PHSP,LINBK ; Subtract from char count remaining BEQ 20$ BCC GCIN ; NO CMPEQ PHSP,#1,GCIN ; Single decrement ? 20$: MOV BF.FUL(R3),LNINS ; LAST CHAR IN LINE TSTNE BRCNT,30$ ; NO breaks this line? CALL BRKSV ; Save break here 30$: TSTEQB $GCEND,GCIN ; Immediate end not requested? GCLF: RETURN GCINO: CALL PBYT ; OUTPUT CHAR BR 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 TSTNE R1,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 suubstitution ; GCSUB: MOV R3,-(SP) ; save 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 CALL EROUT MOV #TBUFF,R0 ; Print substitution 20$: CALL EROUT CALL ONLIN ; Print line number 30$: MOV (SP)+,R3 ; restore JMP GCIN ; try again 40$: MOV BUFADD(R3),R3 ; get buffer header for input MOV #TBUFF,R2 ; temporary buffer 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 MOVB SUBSTK,R3 ; current stack 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 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 TSTNEB $SUBSW,100$ ; substitution suppressed? 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 BR 30$ ; done, continue with normal sequence ; ; TAB character handled here. It is expanded. ; GCTAB: TSTNEB $TABSW,GCSPC ; NO TABS ALLOWED? 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$: SUB R2,LINBK ; AND DECREMENT LINBK COUNT BY THAT AMOUNT ADD R2,SPCH ; Add to spacing characters CMPNEB LCH,#TAB,25$ ; Was last char not tab ? TSTEQ LTAB,25$ ; No tab pending CALL ADDTAB ; Add r2 to previous tab BR TABXIT ; 25$: CALL BRKSV ; Set break here 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:: MOVB ULOCK,CASE ; RESTORE CASE TST LINBK ; Line full ? BGE 10$ ; NO ? 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 PBYT ; 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 #100,$HYPSW ; Allow hyphenation BICB #1,$AUHYP ; Allow auto hyphenation JMP GCINR1 ; RETURN CHAR. 50$: 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 RETURN ; ; break flag here ; GCBRK: BISB #1,$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 INC BRCNT ; count breaks this line 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 SEPARATE ESCAPE SEQUENCES ; GCESC: MOV R1,R5 ; First character CALL CCIN ; GET NEXT CHAR GCES1: CALL ESCSEQ ; ESCAPE SEQUENCE? BCC 10$ ; YES ? JMP GCIN1 ; NO 10$: JMP GCIN ; NEXT CHAR ; ; Special Flag character detected ; GCSPF: MOV #'^+100000,R5 ; Move in shift up operator+ temp flag TSTNE $SPFSW,10$ ; Special flags disabled ? CALL ESCSEQ ; Execute sequence BCS 10$ ; Not executed ? JMP GCIN ; Continue 10$: JMP GCINR ; ; 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 $EFLSW+1,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 R1,R2 ; Character count SUB #3,R2 ; Skip 3 chars 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$: MOV R2,R1 ; number of bytes to skip TST (SP)+ ; Pop status ADD BF.FUL(R3),R1 ; add on current index CALL FNDBF ; skip them BR 12$ ; Try again 4$: DEC R2 ; Account for lock byte 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: TSTNEB $EFLSW+1,15$ ; ESCAPE FLAG DISABLED? 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 R1,R2 ; number of bytes in sequence DEC R2 ; DECREMENT COUNTER CALL GBYT ; get next bytes CMPNEB R5,R1,25$ ; MATCH WITH CHAR? DEC R2 ; Account for both chars CALL GBYT ; get next bytes CMPEQB R4,R1,30$ ; MATCH WITH CHAR? 25$: MOV R2,R1 ; number of bytes to skip ADD BF.FUL(R3),R1 ; add on current index CALL FNDBF ; skip them BR 10$ 30$: TSTNEB $ESCSW,50$ ; ESCAPE SEQUENCES DISABLED? BISB #1,$AUHYP ; set temporary no hyphenation DEC R2 ; Count flag byte CALL GBYT ; Get flag byte BEQ 38$ ; No flag byte ? MOVB R1,-(SP) ; Save bit mask BITEQB #ES.LCK,(SP),31$ ; Not lock/Unlock ? DEC R2 ; One less escape char CALL GBYT ; Get lock word BLT 21$ ; Unlock ? ADD #BITABL,R1 ; Points to bit table BITNE (R1),ESMSK,45$ ; 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,45$ ; 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 DEC R2 ; One less escape char CALL GBYT ; Get vertical spacing SUB R1,LINEC3 ; Decrement lines left SUB R1,LINEC2 SUB R1,LINEC1 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$: BITEQ #FOTF,F.1,33$ ; No deferred text ? ADD R1,TEXLN ; Count deferred text line 33$: BITEQB #ES.HSP,(SP),37$ ; No Horizontal spacing DEC R2 ; One less escape char CALL GBYT ; Get horizontal spacing BITNEB #ES.PSP,(SP),35$ ; Permanent spacing ? 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 CMPEQ R1,#1,37$ ; Spacing 1 ? BISB #40,$NOSPC ; Set no expandable spaces BISB #40,$TABSW ; Set no tabs 37$: TST (SP)+ ; Pop saved flags 38$: MOV (SP)+,R3 ; restore output buffer MOV #ESC,R1 ; Mark escape sequence in output buffer CALL PBYT ; OUTPUT IT MOV R2,R1 ; escape count CALL PBYT ; OUTPUT IT 40$: MOV #ESCBF,R1 ; escape buffer CALL GBYT1 ; get next bytes CALL PBYT ; OUTPUT CHAR SOB R2,40$ ; CONTINUE TILL DONE BR 60$ 45$: TST (SP)+ ; Pop stack 50$: MOV (SP)+,R3 ; restore output buffer 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: CALL CCIN ; READ A CHARACTER BITEQB CHTABL(R1),#CH.FLG,40$ ; Not flag character ? CMPNE R1,$UFLSW,10$ ; LOCK ON UNDERLINE? BICB #100,$UNLSW ; UNDERLINING POSSIBLY ON TSTNEB $UNLSW,30$ ; NOT ON? MOV #ULBEG,R1 ; START IT TSTEQB $UNLSP,5$ ; underline no spaces? MOV #ULSBG,R1 ; underline spaces 5$: JMP GCINO 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: CALL CCIN ; GET ANOTHER CHARACTER BITEQB CHTABL(R1),#CH.FLG,80$ ; Not flag character ? CMPNE R1,$UFLSW,70$ ; UNLOCK UNDERLINE? BISB #100,$UNLSW ; UNDERLINING OFF MOV #ULEND,R1 ; UNDERLINE OFF CHAR JMP GCINO ; 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 ; ; This one starts anywhere in buffer ; CCOUT:: CLRB $ULOSW ; No underlining at first CCOUT1: CALL GBYT ; Get 1 byte BLOS GOEND ; End of input buffer ? .ifdf $DEBUG CALL CHROUT .endc BIC #^C<177>,R1 ; CLEAR OUT HYPHENATION BITS CMPEQB R1,#SPC,GOSPC ; Is it space ? MOVB GCTABL(R1),R0 ; GET CHAR TYPE BGE GOPRN ; PRINTABLE JMP @GCJMP(R0) ; EXECUTE FUNCTION GOPRN: CALL CCPRN ; Print 1 char BR CCOUT1 GOSPC: MOVB EXSP1,-(SP) ; YES. HOW MANY MULTIPLE 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$: INCB (SP) ; Extra space to output 90$: CALL CCSPC ; OUTPUT SPACES DECB (SP) ; Decrement counter BGT 90$ ; Not done ? TST (SP)+ ; Pop counter BR CCOUT1 GOQTS: CALL CCSPC ; Turn quoted space to single space BR CCOUT1 GOESC: CALL GBYT ; Get escape count BLOS GOEND ; End of input buffer ? 10$: MOVB R1,ESCCNT ; Escape sequence count 20$: CALL GBYT ; Get escape sequence chars BLOS GOEND ; End of input buffer ? CALL FOUT ; Output char with no interpretation DECB ESCCNT ; Decrease count BNE 20$ ; More ? BR CCOUT1 ; No more GOBUL: MOVB #-1,$ULOSW ; SET UNDERLINE ON BR CCOUT1 GOSUL: MOVB #1,$ULOSW ; set to underline spaces BR CCOUT1 GOEUL: CLRB $ULOSW ; SET NO UNDERLINE BR CCOUT1 GOBS: DEC CPOS ; New position BGT 10$ ; OK ? MOV #1,CPOS ; No, make it 1 10$: CALL FOUT ; Output backspace BR CCOUT1 GOTAB: CALL GBYT ; Get next input byte MOVB R1,-(SP) ; Save it 10$: BGT 20$ ; Not done yet 15$: TST (SP)+ ; Pop stack BR CCOUT1 20$: CALL CCSPC ; Output a space DECB (SP) ; Done? BR 10$ ; Check it 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 BR 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$ GOUNL: CALL CCUNL ; Underline 1 char BR CCOUT1 GOEND: RETURN 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 GBYT ; Get char BNE 50$ ; Non zero ? JMP CCOUT1 ; And continue ; ; 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 TSTB $ULOSW ; No underline spaces BLE NOUNL ; No ? CCPRN:: TSTEQB $ULOSW,NOUNL ; NO UNDERLINING CALL CCUNL ; YES, DO IT NOUNL: INC CPOS ; INCREMENT POSITION COUNTER JMP FOUT ; OUTPUT CHAR ; ; Do underlining ; CCUNL: MOV R1,-(SP) ; SAVE CHAR 80$: TSTEQB $ULMSW,90$ ; UNDERLINE BY LINE? MOV #LPUS,R1 ; GET UNDERLINE CALL FOUT ; OUTPUT IT MOV #BS,R1 ; GET BACKSPACE CALL FOUT ; OUTPUT IT BR 100$ 90$: MOV CPOS,R0 ; POSITION CMP R0,#ULNSZ ; TOO BIG? BHI 100$ ; 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 100$: MOV (SP)+,R1 ; GET SAVED CHAR RETURN 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 .END