.title ESCAPE .ident /BL1.0/ .list meb ; ; Programs to define escapes and substitutions ; .vars .WORDA 0 ; Chock list SAV1: ; Current name address in buffer (SUBS) LITCNT: .WORDA 0 SAV2: ; previous name address in buffer (SUBS) LITADD: .WORDA 0 SAV3: .WORDA 0 SAV4: .WORDA 0 SAV5: .WORDA 0 CHAR1: .BLKB 1 CHAR2: .BLKB 1 CHAR3: .BLKB SUBMAX-1 WARN: .BLKB 1 .even .const MODTAB: .RAD50 \LCK\ .BYTE ES.LCK,1 .RAD50 \VSP\ .BYTE ES.VSP,2 .RAD50 \HSP\ .BYTE ES.HSP,3 .RAD50 \PSP\ .BYTE ES.PSP,0 .RAD50 \CHR\ .BYTE ES.CHR,0 .WORDA 0 ; End of table ; ; display table of formats ; DSPTAB: .RAD50 / D/ .WORDA NM.DEC LU: .RAD50 / LU/ .WORDA NM.ALP+NM.UC .RAD50 / LL/ .WORDA NM.ALP .RAD50 / LM/ .WORDA NM.ALP+NM.MC .RAD50 / RU/ .WORDA NM.ALP+NM.ROM+NM.UC .RAD50 / RL/ .WORDA NM.ALP+NM.ROM .RAD50 / RM/ .WORDA NM.ALP+NM.ROM+NM.MC .WORDA 0 ; end of table .code SAVLAB: CLR R5 ; Normal subs. SAVLB1: CALL FNDSBS ; Find substitution BCC 10$ ; Ok, not already defined ? TST (SP)+ ; Pop stack MOV #3,R0 JMP ILCMD ; Already defined label 10$: CALL ENDBF ; START AT END OF BUFFER READY FOR PUT MOV BF.FUL(R3),SAV5 ; Save current end of buffer MOV #CHAR1,R2 ; Temporary buffer CALL CBYT ; Will be address later 20$: CALL PBYT ; null will be count later MOVB (R2)+,R1 ; Next byte to save BNE 20$ ; Save it CALL PBYT ; Save null to chock label 30$: CLC RETURN ; ; DEFINE NUMBER ITEM ; DFNIT:: CALL FNDITM ; Get item CALL GWRD ; Get number MOV R1,-(SP) ; Save number CALL SAVLAB ; Get label MOV (SP)+,R1 ; Restore SAVNM: MOVB #1,@BF.ADD(R3) ; Set for number conversion CALL PWRD ; Save number in buffer JMP SBEND ; And set up rest of links ; ; DEFINE NUMBER LEVEL ; DFNHL:: CALL SAVLAB ; Save label CALL PASEND CLR -(SP) ; end of numbers MOV #CHPTN,R2 ; POINT TO CHAPTER/LEVEL TABLE MOVB LEVEL,R4 ; Level number CMPB R4,UNILV ; Unitary level number BLE 10$ ; Not unitary ?? INDXA R4 ; Set index ADD R4,R2 ; Now points to correct one BR 50$ 10$: MOV APNDN,R1 ; Current appendix number BEQ 20$ ; IF EQ NONE BIS APNDSP,R1 ; format MOV R1,-(SP) ; appendix to convert BR 30$ ; Continue with rest of levels 20$: TSTNEB (R2),50$ ; Chapter oriented document? 30$: TST (R2)+ ; Skip chapter number 50$: MOV (R2)+,R1 ; Current chapter or level number BEQ 60$ ; Last one? BIS CHPDSP-CHPTN-$WORDL(R2),R1 ; set display format MOV R1,-(SP) ; save for conversion BR 50$ ; more 60$: CMPNEB LEVEL,#1,65$ ; Not first level? CMPB LEVEL,UNILV ; Unitary level number BGT 65$ ; Unitary ?? TSTNE APNDN,65$ ; Chapter oriented? TSTNE CHPTN,65$ ; Chapter oriented? TSTNEB $TRZER,65$ ; No trailing zeroes ? MOV #NM.DEC,-(SP) ; Last digit is 0 65$: MOVB #PD,$SEPR ; digit separator CALL PAGCV ; convert numbers JMP SBEND ; ; DEFINE NUMBER PAGE ; DFNPG:: CALL GETLAB ; Get or define label MOVB #3,@BF.ADD(R3) ; Set for number conversion MOV BF.FUL(R3),-(SP); Get index CALL GETPAG ; Stash page number ; JMP SBEND CALL LINFAK MOV #PAGCHR,R1 ; Set up to fill in later CALL PBYT MOV (SP)+,R1 ; Link back CALL PWRD ; Save link TSTNE BF.HED(R3),10$ ; Header exists ? CALL CBYT ; Chock it CALL OUTLIN ; And output it 10$: JMP SBEND ; ; DEFINE NUMBER LIST ; DFNLS:: CALL SAVLAB ; Save label CALL PASEND ; Exit if second pass MOV LSTKP,R0 ; Get stack pointer MOV (R0),-(SP) ; GET CURRENT ELEMENT NUMBER BEQ 10$ ; none ? BISB LS.FMT(R0),1(SP); Set the format bits 10$: MOV (SP)+,R1 ; Get number JMP SAVNM ; ; DEFINE NUMBER CHAPTER ; DFNCH:: DFNAP:: CALL SAVLAB ; Save label CALL PASEND ; Exit if second pass MOV APNDN,R1 ; Current appendix number BEQ 40$ ; IF EQ NONE BIS APNDSP,R1 ; format BR 50$ ; Continue with rest of levels 40$: MOV CHPTN,R1 BEQ 50$ ; none ? BIS CHPDSP,R1 ; set display format 50$: JMP SAVNM ; Convert number ; ; Define subscripts ; DFSUP:: MOV #UPMOV,SAV3 ; Subscript buffer BR DFSUP1 DFSUB:: MOV #DNMOV,SAV3 ; Superscript buffer DFSUP1: MOV #SUPSIZ,SAV4 ; Maximum number of chars DFSUP2: CLR LITCNT CLR LITADD ; Set up no literal yet 1$: CALL LITNO ; Get literal BCS 10$ ; Done ? MOVB R1,@SAV3 ; Save char INC SAV3 ; Next address DEC SAV4 ; Count data trans. BGT 1$ ; Continue ? MOV #50.,R0 ; Definition too long JMP ILCMA 10$: CLRB @SAV3 RETURN ; ; Set units ; DFUNI:: CALL (R4) ; Get units BCC 10$ ; Number ? MOV #1,R3 ; Default 10$: MOV R3,HUNIT ; Save the units CALL (R4) ; Get units BCC 20$ ; Number ? MOV #1,R3 ; Default 20$: MOV R3,VUNIT ; Save the units RETURN ; ; Define character width ; DFCHW:: CALL RCNO ; Get font number BCC 1$ ; Number ? CLR R3 ; Default font 1$: CMP R3,#FNTSIZ ; Check if too big BLO 2$ ; OK ? MOV #8.,R0 ; Param too big or negative JMP ILCMA ; Illegal 2$: MOV R3,R4 ASH #7,R4 ; Shift to left ADD CHWTAB,R4 ; Add on table base 5$: CALL RCNO ; Get width BCC 6$ ; Number ? RETURN 6$: CALL GETLIT BCS 30$ ; None ? TSTEQ R1,30$ ; Zero count ? MOV R0,R2 ; Literal address into R2 10$: MOVB (r2)+,R0 ; Get character CMP R0,#SPC ; Check if space BLT 15$ ; non printable ? BGT 14$ ; Not space ? MOVB R3,NXS(R4) ; Set NXS also MOVB R3,BS(R4) ; And backspace 14$: ADD R4,R0 MOVB R3,(R0) ; Save size 15$: SOB R1,5$ ; Till done BR DFCHW ; Try again 30$: MOV #7.,R0 ; Missing params JMP ILCMA ; Illegal command error ; ; Define variable spacing ; DFVSP:: MOV #VARESC,SAV3 ; Buffer to fill MOV #VARSIZ,SAV4 ; Size of buffer BR DFSUP2 ; Now fill buffer ; ; Variable spacing command ; VARSP:: BISB #SW.TDS,$VARSP ; Enable variable spacing RETURN NVSP:: BICB #SW.TDS,$VARSP ; Disable variable spacing RETURN ; ; RESET ESCAPE COMMAND ; RSESC:: MOV #ESCTAB,R0 ; Table to clear MOV #16.,R1 ; Number of entries 10$: CLRB (R0)+ ; Clear 1 entry SOB R1,10$ ; Till done ? CLR ESMSK ; Clear current escape mask MOV #ESCBF,R3 ; ESCAPE TABLE JMP CLRBF ; CLEAR IT OUT ; ; DEFINE ESCAPE COMMANDS ; ILSAD: MOV #3,R0 ; Symbol already defined error JMP ILCMA ESCERR: MOV #7.,R0 ; Missing params JMP ILCMA ; Illegal command error DFESC:: CLR LITCNT ; Initialize variables CLR LITADD ; CLEAR POINTERS CALL LITNO ; GET INPUT first escape char BCS ESCERR ; ERROR/NO INPUT ? MOVB R1,CHAR1 ; Save first char CALL LITNO ; GET CHAR TO COMPARE second escape char BCS ESCERR ; ERROR/NO INPUT ? MOVB R1,CHAR2 ; Save second char MOV #ESCBF,R3 ; ESCAPE BUFFER CALL BEGBF ; Start at beginning of buffer 10$: CALL GBYT ; Get first char BCS 15$ ; Done at end of table? MOV R1,R2 ; Save count DEC R2 CALL GBYT ; First escape char CMPNEB R1,CHAR1,12$ ; Not the same ? DEC R2 CALL GBYT ; Second escape char CMPEQB R1,CHAR2,ILSAD ; Second char the same ? 12$: MOV BF.FUL(R3),R1 ; Get current location ADD R2,R1 ; Next location CALL FNDBF ; Find it BR 10$ ; And try again 15$: CALL ENDBF ; Go to end of buffer MOV BF.FUL(R3),-(SP) ; CURRENT TABLE SIZE CALL CBYT ; null will be count later MOVB CHAR1,R1 ; First char CALL ESCCHR ; SAVE IT MOVB CHAR2,R1 ; Second char CALL ESCCHR ; SAVE IT ; ; Here parse auxiliary commands ; MOV #CHAR3,R0 ; Clear temporary buffer CLR (R0)+ CLR (R0)+ CLR (R0)+ ESCOMD: CLR R3 ; No default CALL ALPGT ; get 3 char sequence BCC 5$ ; Got sequence ? JMP 70$ ; Now get sequence 5$: MOV #MODTAB,R0 ; table to search 10$: TSTNE (R0),11$ ; Ok ? JMP ERR2 ; At end of table? 11$: CMPEQ R3,(R0)+,20$ ; match? TST (R0)+ ; NO BR 10$ ; continue 20$: MOVB (R0)+,R3 ; get code MOVB (R0),R2 ; Get byte number BITEQB R3,CHAR3,21$ ; Ok ? JMP ERR2 ; Bit already set ? 21$: BISB R3,CHAR3 ; Set flag byte TSTEQ R2,ESCOMD ; No extra bytes to get ? CMPEQ R3,#ES.LCK,40$ ; Lock function ? CALL RCNO ; Get number BCC 30$ ; Number ? JMP ERR2 ; None is error 30$: CMP R3,#127. ; Check upper bound ? BLE 31$ ; Ok ? JMP ERR2 ; Too big ? 31$: CMP R3,#-128. ; Now check low bound BGE 32$ ; Ok ? JMP ERR2 ; Too small ? 32$: MOVB R3,CHAR3(R2) ; Save it BR ESCOMD ; Next command 40$: MOV #ESCTAB,R3 ; Table to search 41$: TSTEQB (R3),45$ ; End of table ? CMPNEB (R3)+,CHAR2,41$ ; No match ? DEC R3 ; Point to char match 45$: CMP R3,#ESCTAB+16. ; Past end of table ? BLO 50$ ; Ok ? JMP ERR2 50$: MOVB CHAR2,(R3) ; Save char SUB #ESCTAB,R3 ; Now is index CMPNEB CHAR1,#BCKSL,60$ ; Not end sequence ? BIS #^o200,R3 ; Mark it as end sequence 60$: MOVB R3,CHAR3(R2) ; Save byte BR ESCOMD ; Next command 70$: MOV #CHAR3,R2 ; Save commands MOVB (R2)+,R1 ; Get first byte MOVB R1,R4 ; Save for later CALL ESCSAV ; Save it MOVB (R2)+,R1 ; Next byte BITEQB #ES.LCK,R4,81$ ; No lock ? CALL ESCSAV ; Save it 81$: MOVB (R2)+,R1 ; Next byte BITEQB #ES.VSP,R4,82$ ; No vert. space ? CALL ESCSAV ; Save it 82$: MOVB (R2)+,R1 ; Next byte BITEQB #ES.HSP,R4,83$ ; No horiz space ? CALL ESCSAV ; Save it 83$: ; ; Here parse for escape sequence definition ; SEQENC: CALL LITNO ; GET NEXT CHAR BCS 30$ ; NO MORE CALL ESCSAV ; SAVE IT BR SEQENC ; GET MORE 30$: MOV (SP)+,R1 ; point to start of sequence MOV #ESCBF,R3 MOV BF.FUL(R3),R2 ; Current location SUB R1,R2 ; Minus previous one DEC R2 ; Now is number of bytes CMP R2,#^o377 ; too big? BHI ERR3 ; yes CALL FNDBF ; find this location MOV R2,R1 ; escape count CALL PBYT ; fill it in RETURN ; ; Saves characters in escape table ; ESCCHR: CMP R1,#^o40 ; Not a character? BLE ERR1 ; Yes CMP R1,#^o177 ; Not a character? BGE ERR1 ; Yes ESCSAV: MOV #ESCBF,R3 ; BUFFER CALL PBYT ; PUT CHAR INTO BUFFER BCS ERR1 ; ERROR RETURN ERR1: TST (SP)+ ERR2: MOV (SP)+,R1 ; INDEX TO LAST LOCATION ERR3: MOV #ESCBF,R3 CALL RSTBF ; RESTORE TOP OF TABLE JMP ILCM ; ILLEGAL COMMAND ; ; Gets characters entered as literals or numbers ; LITNO: MOV R3,-(SP) ; Save R3 1$: TSTNE LITCNT,10$ ; LITERAL ALREADY FOUND? CALL GETLIT ; TRY FIRST TO FIND LITERAL BCS 30$ ; NONE MOV R0,LITADD ; ADDRESS OF LITERAL MOV R1,LITCNT ; SIZE BR 1$ ; Now check size 10$: MOVB @LITADD,R1 ; GET CHAR INC LITADD ; POINTS TO NEXT VALUE DEC LITCNT ; DECREMENT # CHAR REMAINING 20$: MOV (SP)+,R3 ; Restore TST R1 ; Set status C=0 RETURN ; 30$: CALL RCNO ; TRY FOR NUMBER BCS 40$ ; NONE ? MOV R3,R1 ; NUMBER FOUND BR 20$ ; RETURN WITH SUCCESS 40$: MOV (SP)+,R3 ; Restore CLR R1 ; Set none SEC ; FAILURE RETURN ; ; ; reset substitute ; RSSUB:: BITNE #PASSW,$SWTCH,SUBERR; 2 pass ? MOV #SUBF0,R3 ; first header address is herer CALL CLRBF ; clear it JMP CWRD ; Clear first word ; ; Error exits ; SUBERR: MOV #4,R0 ; Bad params JMP ILCMD SUBER1: MOV #7,R0 ; Missing params JMP ILCMD SUBER2: MOV #51.,R0 ; Label or literal too long JMP ILCMD ; ; parse substitution/command label ; FNDSBS: MOV #6.,R1 ; Number of words to clear MOV #SAV1,R0 ; First address to clear 5$: CLR (R0)+ ; Clear SOB R1,5$ ; Till done CLRB WARN ; No warning initially MOV #CHAR1,R2 ; Start of temporary buffer MOV #SUBMAX+1,R4 ; Max number of char 10$: CALL CCIN ; get input data CMPEQB R1,#TAB,10$ ; skip tabs CMPEQB R1,#SPC,10$ ; skip spaces BLT SUBER1 ; no label MOV R1,-(SP) ; save delimiter 20$: CALL CCIN ; get next char CMPEQ R1,(SP),30$ ; done? TSTNE R5,22$ ; commands ? CMP R1,#SPC ; Check for spaces BLE SUBERR ; Space or Tab error ? CMPEQ R2,#CHAR1,25$ ; First char? 22$: CMPNEB #GC.LC,GCTABL(R1),25$ ; Not lower case ? SUB #^o40,R1 ; Make it upper 25$: TSTEQ R5,29$ ; Not commands ? CMPEQ R2,#CHAR1,26$ ; First char? CMPNEB R1,#SPC,26$ ; printable character? CMPEQB R1,-1(R2),20$ ; 2 spaces in row ? BR 29$ ; Include space 26$: CMPEQB #GC.UC,GCTABL(R1),29$ ; Letter ? JMP SUBERR ; Not letter ? 29$: MOVB R1,(R2)+ ; Save in temporary buffer SOB R4,20$ ; Continue till done, or overflow JMP SUBER2 ; Too many chars! 30$: TST (SP)+ ; pop delimiter CMPNE R4,#SUBMAX+1,40$ ; Characters ? JMP SUBER1 ; No characters ? 40$: BISB R5,CHAR1 CLRB (R2)+ ; Clear next byte MOV #SUBF0,R3 ; SUBSTITUTE BUFFER CALL BEGBF ; Start at beginning of buffer CALL GWRD ; Get starting address BNE 50$ ; Got it ? CLC ; No ? RETURN 50$: CALL FNDBF ; Find it MOV SAV1,SAV2 ; Stash previous one MOV BF.FUL(R3),SAV1 ; Save current pointer address CALL GWRD ; Next index MOV R1,R4 ; Save it MOV #CHAR1,R2 ; Input char buffer 60$: CALL GBYT ; Get 1 char of name CMPEQB R1,#SPC,60$ ; Is it space ? BITNE R1,#^o340,115$ ; Printable ? TSTNEB (R2),100$ ; Only partially identical? SEC ; Symbol defined already RETURN 100$: TSTNE R5,110$ ; Command ? INCB WARN ; Warn the user 110$: TSTNE SAV3,116$ ; Already found partial? MOV SAV1,SAV3 MOV SAV2,SAV4 115$: CMPEQB R1,(R2)+,60$ ; Match ? CMPEQB -1(R2),#SPC,115$ ; Is it space ? TSTNEB -1(R2),116$ ; Not partially identical ? TSTNE R5,116$ ; Command ? INCB WARN ; Set up warning message 116$: MOV R4,R1 BEQ 120$ ; End of buffer? JMP 50$ ; Not end of buffer 120$: CLC ; Ok not already defined RETURN ; ; DEFINE ITEM ; DFITM:: CALL GETLAB ; Get or define label MOV #NM.DEC,-(SP) ; And get initial number CALL ALPGT ; get 2 char sequence BCS 40$ ; None ? MOV #DSPTAB,R2 ; table to search 10$: TSTNE (R2),20$ ; Not at end of table? MOV #4,R0 JMP ILCMD ; Bad params 20$: CMPEQ R3,(R2)+,30$ ; match? TST (R2)+ ; NO BR 10$ ; continue 30$: MOV (R2),(SP) ; Add in extra bits 40$: CALL RCNO ; Get initial number BCC 45$ ; Default ? CALL ALPGT2 ; Get alpha param BCC 45$ ; Got one ? MOV #1,R3 ; Default is 1 45$: CMP R3,#4000. ; Too big ? BLO 60$ ; No ? 50$: MOV #8.,R0 ; Param too big or negative JMP ILCMD ; Yes 60$: ADD R3,(SP) ; And save it MOV (SP)+,R1 ; Save it MOV #SUBF0,R3 ; In substitute buffer JMP SAVNM ; ; Create label in first pass ; get label in second pass ; GETLAB: .if df $PASS BITEQ #PASSW,$SWTCH,5$; Not 2 pass ? BITNEB #SW.DIS,$OUTSW,5$; First pass ? JMP FNDITM .endc 5$: JMP SAVLAB ; Find substitute ; ; NUMBER ITEM ; FNDITM: CLR R5 CALL FNDSBS BCC NOSUBS ; No substitute found CMPNEB R1,#1,NOSUBS ; Not item RETURN NOSUBS: MOV #49.,R0 ; Undefined substitute error JMP ILCMD NMITM:: CALL FNDITM ; Get substitute CALL GWRD ; Get number MOV R1,R3 ; Save it BIC #^c,R3 ; Clear format bits BIC #NM.MSK,R1 ; Clear data bits MOV R1,-(SP) ; Save format CALL RCNR ; Get increment or dec BCC 30$ ; Found number ? CALL ALPGT2 ; Get alpha param BCC 30$ ; Got one ? MOV #1,R3 ; Default is 1 30$: CMP R3,#4000. ; Check if too big BLO 40$ ; Ok ? 35$: MOV #8.,R0 ; Param too big or negative JMP ILCMD 40$: ADD R3,(SP) MOV #SUBF0,R3 ; Get buffer MOV BF.FUL(R3),R1 ; Save current address SUB #2,R1 CALL FNDBF ; Go back to number MOV (SP)+,R1 ; Number JMP PWRD ; Save it ; ; DEFINE COMMAND ; DFCOM:: MOV #^o200,R5 ; Command flag BR DFMAC1 ; Save command label ; ; DEFINE SUBSTITUTE COMMANDS ; DFMAC:: CLR R5 DFMAC1: CALL SKPLIN CALL SAVLB1 ; Save label TSTEQ R5,20$ ; Not command ? 5$: CALL CCIN ; Get first char CMPEQ R1,$NFLSW,20$ ; Is it command flag ? CMPEQ R1,#SPC,5$ ; Or space CMPEQ R1,#TAB,5$ ; Or tab BR 30$ ; Now check if end 10$: CALL PBYT ; save 1 char 20$: CALL CCIN ; char for macro 30$: CMPNEB R1,#CR,10$ ; not done? SBEND: CALL PASEND ; Exit if second pass CALL ENDBF ; End of buffer CALL CBYT ; into buffer TSTEQ SAV3,10$ ; No partial identical buffer? MOV SAV4,R1 ; Buffer before partial ident one CALL FNDBF MOV SAV5,R1 ; Current buffer address goes into it CALL PWRD MOV SAV5,R1 ; Current buffer address CALL FNDBF MOV SAV3,R1 ; Points to partial ident BR 20$ 10$: MOV SAV1,R1 ; Pointer address CALL FNDBF ; find it MOV SAV5,R1 ; Beginning of current entry 20$: CALL PWRD ; Save pointer address TSTEQB WARN,50$ ; No Warning ? BITNE #WARSW,$SWTCH,50$; No warning by switch ? MOV #44.,R0 ; Message number JMP ILCMD ; Give error message 50$: RETURN ; ; Routines to handle multiple passes ; PASEND - exits on pass 2 ; SKPLIN - skips input on pass 2 ; PASEND: MOV #SUBF0,R3 ; Buffer header .if df $PASS BITEQ #PASSW,$SWTCH,5$; Not 2 pass ? BITNEB #SW.DIS,$OUTSW,5$; First pass ? TST (SP)+ ; Pop stack .endc 5$: RETURN ; None SKPLIN: .if df $PASS BITEQ #PASSW,$SWTCH,5$; Not 2 pass ? BITNEB #SW.DIS,$OUTSW,5$; First pass ? 1$: CALL CCIN ; Get char CMPNE R1,#CR,1$ ; Not CR ? TST (SP)+ ; Pop stack .endc 5$: RETURN ; ; DELETE command ; DELCOM::MOV #^o200,R5 ; Set up for command BR DELSB1 ; ; DELETE substitution ; DELSUB::CLR R5 ; Set up for substitution DELSB1: BITNE #PASSW,$SWTCH,70$; 2 pass ? CALL FNDSBS ; Find the substitution BCC 50$ ; None ? MOV SAV1,R1 ; Address of last label CALL FNDBF ; Get it CALL GWRD ; Get size MOV R1,R2 ; Kill label MOV SAV2,R1 ; get previous one CALL FNDBF MOV R2,R1 ; Now zap substitution CALL PWRD ; By bypassing it !!! 50$: RETURN 70$: JMP ILCM ILCMD: .if df $PASS BITEQ #PASSW,$SWTCH,10$ ; 1 Pass only ? BITNEB #SW.DIS,$OUTSW,10$ ; First of 2 passes ? JMP KILCM ; Kill this command .endc 10$: JMP ILCMB ; Output error .END