.TITLE WNDIOT .IDENT /050183/ ; ; ; ; ; WRITTEN BY RAY DI MARCO ; 25-SEP-80. ; ; ; VERSION 250980/05. ; ; ; ;------------------------------------------------------------------------ ; ; ; THIS MODULE CONTAINS WND I/O SUPPORT ROUTINES WHICH ARE REQUIRED BY THE ; 'WNDIO' MODULE. THE 'WNDIO' AND 'WNDIOT' MODULES WORK TOGETHER TO ALLOW ; FORMS ORIENTED I/O OPERATIONS TO BE CARRIED OUT. THE FUNCTIONS PROVIEDED ; BY THE ROUTINES IN THIS MODULE ARE - ; ; INSERTION OF A NEW CHARACTER IN A FIELD ; ; DELETION OF A CHARACTER FROM A FIELD ; ; ERASURE OF A FIELD ; ; THE ENTRY INTO THIS MODULE IS VIA THE 'WNDIOT' TABLE, WHICH IS INDEXED ; INTO VIA THE FIELD TYPE NUMBER MULTIPLIED BY TWO, THEREBY GIVING THE ; ADDRESS OF A TABLE WHICH CONTAINS THE ROUTINES WHICH SUPPORT I/O FOR ; THE FIELD BEING WORKED ON. IE- ; ; WNDIOT+(2*TYPE) --> ADDRESS --> A TABLE OF 4 WORDS ; ; ; .SBTTL MODIFICATIONS ; ; ; 27-OCT-80 ZEROED DATE SETS DATE TO 0-0-0 (NOT 1-1-1) ; 22-APR-81 ALLOW LC IN ASCII/ALPHA FIELDS ; 05-Jan-83 make INSERT set byte WND.FL+2 if overflow field .SBTTL DECLARATIONS ; ; .MCALL .PUSH,.POP ; STACKING MACROS ; ; .GLOBL WNDIOT ; ENTRY .GLOBL WND.BL ; WND PARAMETER TABLE .GLOBL WND.FL ; FLAGS ; ; ; .PSECT CODE ; OPEN CODE SECTION ; ; .SBTTL DEFINITION - MACRO '.OUT' ; ; ; .MACRO .OUT CHAR .GLOBL CON.CO .IF B, CALL CON.CO .MEXIT .ENDC MOV R0,-(SP) .IRP X, MOVB X,R0 CALL CON.CO .ENDR MOV (SP)+,R0 .ENDM .OUT ; ; ; .SBTTL DEFINITIONS ; ; ; ..XPOS = 0 ; X COORDINATE ..YPOS = 2 ; Y COORDINATE ..XBAS = 4 ; X BASE ..YBAS = 6 ; Y BASE ..XMAX = 10 ; X MAX ..YMAX = 12 ; Y MAX ..BUFA = 14 ; BUFFER ADDRESS ..INSE = 16 ; INSERTER ..CLEA = 20 ; CLEARER ..DELL = 22 ; DELETE LEFT ..DELR = 24 ; DELETE RIGHT BELL = 7 ; ASCII CODE FOR BELL ; ; .SBTTL INDEX TABLE - 'WNDIOT' ; ; ; ; THIS TABLE IS INDEXED INTO TO FIND THE ADDRESS OF THE ROUTINES ; TO BE USED IN CONJUNCTION WITH THE 'WNDIO' MODULE WHEN EDITTING ; THE ACTIVATED RECORD. THE TABLE CONSISTS OF A 1 WORD ENTRY PER ; TYPE. ; ; ; WNDIOT: .WORD IOTY.1 ; DEFAULT I/O ROUTINES .WORD IOTY.1 ; TYPE 1 .WORD IOTY.2 ; TYPE 2 .WORD IOTY.3 ; TYPE 3 .WORD IOTY.4 ; TYPE 4 ; ; ; .SBTTL DEFINITION - 'TABLE' MACRO ; ; ; THIS MACRO IS USED TO GENERATE THE 'TYPE TABLE' FOR THE DIFFERENT ; RECORD TYPES. EACH TYPE OF RECORD HAS A ENTRY IN THE TABLE WHICH ; SPECIFIES WHICH ROUTINES ARE TO BE USED TO ; ; INSERT A CHARACTER INTO THE RECORD ; ERASE THE RECORD ; DELETE THE CHARACTER THE THE LEFT OF THE CUSOR ; DELETE THE CHARACTER TO THE RIGHT OF THE CUSOR ; ; THESE ROUTINES ARE CALLED BY THE 'WNDIO' MODULE WHEN THE APPROPRIATE ; CODE IS ENTERED WHEN THE RECORD IS BEING EDITED. ; ; ; THIS MACRO SETS UP THE TABLE ENTRIES (4 WORDS). THE USER MUST THEN ; WRITE THE FOUR ROUTINES NEEDED TO DO THE FUCTION. (THESE ROUTINES ; CAN USE THE PRIMITIVES PROVIDED TO SIMPLIFY THE CODING.) THE ; USER ROUTINES ARE- ; ; 1000$ INSERTER ; 2000$ CLEARER ; 3000$ DELETE LEFT ; 4000$ DELETE UNDER CUSOR ; ; ; ; ; .MACRO TABLE TYPE TYPE: .WORD 1000$,2000$,3000$,4000$ .ENDM TABLE ; ; ; .SBTTL ROUTINES - 'IOTY.1' ... TYPE 1 RECORD ROUTINES ; ; ; THESE ROUTINES PROVIDE SUPPORT FOR TYPE 1 RECORDS, WHICH ALLOW ; ANY CHARACTER TO OCCUPY ANY FIELD. ; ; TABLE IOTY.1 ; I/O ROUTINES FOR TYPE 1 RECORD ; ; 1000$: TSTB WND.FL+1 ; SPECIAL INSERT MODE? BEQ 1010$ ; YES -> SKIP CALL MOVRHT ; MOVE CHARACTERS TO RIGHT 1010$: CALL INSERT ; INSERT THE NEW CHARACTER INTO FIELD CLC ; CLEAR FAIL FLAG RETURN ; HOME ; ; ; 2000$: MOV #40,R0 ; SPACE CODE -> R0 CALL FILLIT ; FILL FIELD WITH SPACES CLC ; CLEAR FAIL FLAG RETURN ; HOME ; ; ; 3000$: MOV #40,R0 ; SPACE -> R0 CALL DELLFT ; DELEFT CHAR TO CUSOR LEFT CLC ; CLEAR FAIL FLAG RETURN ; HOME ; ; ; 4000$: MOV #40,R0 ; SPACE -> R0 CALL DELRHT ; DELETE CHARACTER UNDER CUSOR CLC ; CLEAR FAIL FLAG RETURN ; HOME ; ; ; .SBTTL ROUTINES - 'IOTY.2' ... TYPE 2 RECORD ROUTINES ; ; ; THESE ROUTINES SUPPORT TYPE TWO RECORDS, WHICH CAN BE MADE UP ; OF SPACES AND THE CHARACTERS 'A'-'Z' INCLUSIVE. ; ; ; ; TABLE IOTY.2 ; I/O ROUTINES FOR TYPE 2 RECORD ; ; 1000$: CALL C.ALPA ; AN 'ALPA' CHARACTER? BCS 1100$ ; NO -> NOT ACCEPTABLE TSTB WND.FL+1 ; SPECIAL INSERT MODE? BEQ 1010$ ; YES -> SKIP CALL MOVRHT ; MAKE ROOM FOR CHARACTER 1010$: CALL INSERT ; INSERT CHARACTER CLC ; CLEAR CARRY RETURN ; HOME 1100$: .OUT #BELL ; RING-RING CLC ; CLEAR FAIL FLAG RETURN ; HOME ; ; 2000$: MOV #40,R0 ; SPACE -> R0 CALL FILLIT ; CLEAR FIELD CLC ; CLEAR FAIL FLAG RETURN ; HOME ; ; 3000$: MOV #40,R0 ; SPACE -> R0 CALL DELLFT ; DELEFT CHAR TO CUSOR LEFT CLC ; CLEAR FAIL FLAG RETURN ; HOME ; ; ; 4000$: MOV #40,R0 ; SPACE -> R0 CALL DELRHT ; DELETE CHARACTER UNDER CUSOR CLC ; CLEAR FAIL FLAG RETURN ; HOME ; ; ; .SBTTL ROUTINES - 'IOTY.3' ... TYPE 3 RECORD SUPPORT ; ; ; ; THESE ROUTINES SUPPORT TYPE 3 RECORDS, WHICH CAN ONLY BE MADE ; UP OF DIGITS. ; ; TABLE IOTY.3 ; I/O ROUTINES FOR TYPE 3 RECORD ; ; 1000$: CALL C.DIGI ; DIGIT? BCS 1100$ ; NO -> FAIL TSTB WND.FL+1 ; SPECIAL INSERT MODE? BEQ 1010$ ; YES -> SKIP CALL MOVRHT ; MAKE ROOM FOR CHARACTER 1010$: CALL INSERT ; INSERT CHARACTER CLC ; CLEAR FAIL FLAG RETURN ; HOME ; 1100$: .OUT #BELL ; RING BELL CLC ; CLEAR FAIL FLAG RETURN ; HOME ; ; ; 2000$: MOV #'0,R0 ; '0' CODE -> R0 CALL FILLIT ; FILL FIELD CLC ; CLEAR FAIL FLAG RETURN ; HOME ; ; ; 3000$: MOV #'0,R0 ; ZERO -> R0 CALL DELLFT ; DELEFT CHAR TO CUSOR LEFT CLC ; CLEAR FAIL FLAG RETURN ; HOME ; ; ; 4000$: MOV #'0,R0 ; ZERO -> R0 CALL DELRHT ; DELETE CHARACTER UNDER CUSOR CLC ; CLEAR FAIL FLAG RETURN ; HOME ; ; ; .SBTTL ROUTINES - 'IOTY.4' ... TYPE 4 RECORD SUPPORTERS ; ; ; THESE ROUTINES SUPPORT TYPE 4 RECORDS, WHICH SPECIFY A DATE. THE ; RECORD FORMAT IS- ; ; DD-MM-YY ; ; WHERE DD ARE DIGITS SPECIFYING THE DAY OF THE MONTH ; MM ARE DIGITS SPECIFYING THE MONTH ; YY ARE DIGITS SPECIFYING THE YEAR ; ; ; TABLE IOTY.4 ; I/O ROUTINES FOR TYPE 4 RECORD ; ; ; 1000$: .PUSH ; SAVE REGISTERS MOV #9001$,R1 ; STRING 1 -> R1 MOV #9002$,R2 ; STRING 2 -> R2 CALL C.RANG ; IN RANGE? BCS 1100$ ; NO -> 1100$ CALL INSERT ; INSERT CHARACTER MOV WND.BL+..BUFA,R1 ; STRING ADDRESS -> R1 ADD WND.BL+..XPOS,R1 ; ADDRESS OF CHAR UNDER CUSOR CMPB (R1),#'- ; AT DELIMITER? BNE 1040$ ; NO -> SKIP INC WND.BL+..XPOS ; SKIP IT 1040$: .POP ; RESTORE CLC ; CLEAR ERROR FLAG RETURN ; HOME 1100$: .OUT #BELL ; RING-RING .POP ; RESTORE RETURN ; HOME ; ; 2000$: .PUSH ; SAVE MOV #9003$,R0 ; SOURCE MOV WND.BL+..BUFA,R1 ; DESTINATION CALL COPY ; COPY .POP ; RESTORE RETURN ; HOME RETURN ; NO CLEAR ALLOWED ; 3000$: 4000$: RETURN ; NO DELETE ALLOWED ; 9001$: .ASCII /00-00-70 / ; LOWER RANGE 9002$: .ASCII /39-19-99 / ; UPPER RANGE 9003$: .ASCIZ /00-00-72/ ; LOWEST DATE .EVEN .SBTTL PRIMITIVE - 'INSERT' ... CHAR (R0) --> RECORD ; ; ; AT ENTRY 'R0' HOLDS A CHARACTER TO BE INSERTED IN THE FIELD. THIS ; ROUTINE CAUSES THE CHARACTER TO BE INSERTED INTO THE RECORD AT ; THE CURRENT CUSOR ADDRESS. ; ; ; THIS ROUTINE PRESERVES ALL REGISTERS. ; ; INSERT: CALL CON.CO ; ECHO CHARACTER .PUSH R1 ; SAVE MOV WND.BL+..XPOS,R1 ; OFFSET -> R1 ADD WND.BL+..BUFA,R1 ; R1 --> INSERT POSITION MOVB R0,(R1) ; INSERT CHARACTER INC WND.BL+..XPOS ; BUMP UP CUSOR POSITION CMP WND.BL+..XPOS,WND.BL+..XMAX ; OVERFLOWED BUFFER? BLO 10$ ; NO -> SKIP DEC WND.BL+..XPOS ; FIX OVERFLOW INCB WND.FL+2 ; indicate overflowed 10$: .POP R1 ; RESTORE RETURN ; HOME ; ; ; .SBTTL PRIMITIVE - 'FILLIT' ... CHAR (R0) FILLS FIELD ; ; ; ; THIS ROUTINE CAUSES THE RECORD TO BE FILLED WITH THE CHARACTER ; IN R0. IT IS USED TO ADD IN ZEROING/CLEARING THE RECORD. ; ; ALL REGISTERS ARE PRESERVED THROUGH THE ROUTINE. ; ; ; ; FILLIT: MOVB #1,WND.FL ; SET 'REFRESH' FLAG .PUSH ; SAVE MOV WND.BL+..BUFA,R1 ; POINT START OF BUFFER MOV WND.BL+..XMAX,R2 ; COUNTER 10$: MOVB R0,(R1)+ ; FILL SOB R2,10$ ; LOOP CLR WND.BL+..XPOS ; CUSOR TO LEFT MARGIN .POP ; RESTORE RETURN ; HOME ; ; ; .SBTTL PRIMITIVE - 'DELLFT' ... DELETE LEFT OF CUSOR ; ; ; THIS ROUTINE CAUSES THE CHARACTER TO THE LEFT OF THE CUSOR TO BE ; DELETED. THE CHARACTERS UNDER AND TO THE RIGHT OF THE CUSOR ARE ; MOVED LEFT ON PLACE, AND THE LAST CHARACTER POSITION IN THE ; RECORD IS FILLED WITH THE CHARACTER IN R0. ; ; ; ; DELLFT: TST WND.BL+..XPOS ; AT LEFT MARGIN? BEQ 100$ ; YES -> SKIP MOVB #1,WND.FL ; SET 'REFRESH' FLAG DEC WND.BL+..XPOS ; MOVE CUSOR BACK A BIT CALL MOVLFT ; MOVE REST OF FIELD LEFT .PUSH R1 ; SAVE WORK REGISTER MOV WND.BL+..XMAX,R1 ; OFFSET TO END OF FIELD ADD WND.BL+..BUFA,R1 ; R1 --> END OF FIELD MOVB R0,-(R1) ; FILL IN FIELD .POP R1 ; RESTORE 100$: RETURN ; HOME ; ; ; .SBTTL PRIMITIVE - 'DELRHT' ... DELETE RIGHT OF CUSOR ; ; ; THIS ROUTINES DELETES THE CHARACTER UNDER THE CUSOR, AND MOVES ; SUBSEQUENT CHARACTERS LEFT. THE CHACTER POSITION AT THE END OF ; THE RECORD IS FILLED WITH THE CHARACTER IN R0. ; ; THIS ROUTINE PRESERVES ALL REGISTERS. ; ; DELRHT: MOVB #1,WND.FL ; SET 'REFRESH' FLAG CALL MOVLFT ; MOVE REST OF FIELD LEFT MOV WND.BL+..XMAX,R1 ; OFFSET TO END OF FIELD ADD WND.BL+..BUFA,R1 ; R1 --> END OF FIELD MOVB R0,-(R1) ; FILL IN FIELD .POP R1 ; RESTORE RETURN ; HOME ; ; ; .SBTTL ROUTINE - 'MOVLFT' ... MOVE CHARACTERS TO LEFT ; ; ; THIS ROUTINE MOVES THE CHARACTERS TO RIGHT ONE PLACE TO ; THE LEFT. THE CHARACTER UNDER THE CUSOR IS DESTROYED. ; ALL REGISTERS ARE PRESERVED. ; ; MOVLFT: MOVB #1,WND.FL ; SET 'REFRESH' FLAG .PUSH ; SAVE REGISTERS MOV WND.BL+..XPOS,R1 ; OFFSET TO LEFT BOUNDARY ADD WND.BL+..BUFA,R1 ; R1 --> LEFT BOUNDARY MOV R1,R2 ; R2 --> LEFT BOUNDARY INC R2 ; R2 --> FIRST CHARACTER TO MOVE MOV WND.BL+..XMAX,R3 ; OFFSET TO RIGHT MARGIN SUB WND.BL+..XPOS,R3 ; NUMBER OF CHARS TO MOVE +1 DEC R3 ; NUMBER OF CHARACTERS TO MOVE BEQ 100$ ; NO CHARS TO MOVE -> 100$ 10$: MOVB (R2)+,(R1)+ ; MOVE SOB R3,10$ ; LOOP 100$: .POP ; RESTORE RETURN ; DONE ; ; ; .SBTTL ROUTINE - 'MOVRHT' ... MOVE CHARACTERS RIGHT ; ; ; ; THIS ROUTINE MOVES ALL CHARACTERS UNDER AND TO THE RIGHT OF ; THE CUSOR ONE PLACE RIGHT. THE LAST CHARACTER IN THE RECORD ; IS LOST. THE ROUTINE PRESERVES ALL REGISTERS. ; ; MOVRHT: MOVB #1,WND.FL ; SET 'REFRESH' FLAG .PUSH ; SAVE REGISTERS MOV WND.BL+..XMAX,R1 ; NUM CHARS IN BUF -> R1 MOV R1,R2 ; NUM CHARS IN R1 -> R2 ADD WND.BL+..BUFA,R2 ; R2 --> LAST CHAR IN BUFFER MOV R2,R3 ; R3 --> LAST CHAR DEC R3 ; R3 --> SECOND LAST CHARACTER DEC R1 ; OFFSET TO LAST CHAR -> R1 SUB WND.BL+..XPOS,R1 ; NUMBER OF CHARACTERS TO MOVE BEQ 100$ ; NONE TO MOVE -> 100$ 10$: MOVB -(R3),-(R2) ; SHIFT CHARACTERS ... SOB R1,10$ ; ... RIGHT 100$: .POP ; RESTORE RETURN ; HOME ; ; ; .SBTTL PRIMITIVE - 'C.ALPA' ... IS CHAR R0 AN ALPA ; ; ; ; THIS ROUTINE RETURNS WITH THE 'C' FLAG CLEAR IFF THE CHARACTER IN ; R0 IS IN THE RANGE 'A'-'Z' OR IS A SPACE. ALL REGISTERS ARE ; PRESERVED. ; ; ; ; ; C.ALPA: CMP R0,#40 ; SPACE? BEQ 10$ ; YES -> 10$ CMP R0,'. ; '.' ? BEQ 10$ ; YES -> SKIP ; CMP R0,#'A ; < A ? BLO 100$ ; YES -> 100$ CMP R0,#'Z ; > Z ? BHI 100$ ; YES -> 100$ 10$: CLC ; CLEAR ERROR FLAG RETURN ; HOME ; 100$: CMPB R0,#<'A+40> ; LC 'A? BLO 200$ ; NO GO -> EXIT CMPB R0,#<'Z+40> ; LC Z? BHI 200$ ; NO GO -> EXIT CLC ; CLEAR FAIL RETURN ; ALL DONE ; 200$: SEC ; SET FAIL FLAG RETURN ; ; ; .SBTTL PRIMITIVE - 'C.DIGI' ... IS CHARACTER R0 A DIGIT ; ; ; ; THIS ROUTINE RETURNS WITH 'C' FLAG CLEAR IFF THE CHARACTER IN ; R0 IS A DIGIT. ALL REGISTERS ARE PRESERVED. ; ; ; C.DIGI: CMP R0,#'0 ; < 0 ? BLO 100$ ; YES -> 100$ CMP R0,#'9 ; > 9 ? BHI 100$ ; YES -> 100$ CLC ; CLEAR FAIL FLAG RETURN ; HOME 100$: SEC ; SET FAIL FLAG RETURN ; HOME ; ; ; .SBTTL PRIMITIVE - 'C.RANG' ... IS CHAR R0 IN RANGE ; ; ; THIS ROUTINE IS A SPECIAL. THE RECORD TO BE CHECKED CONSISTS ; OF A SERIES OF CHARACTERS, WHERE EACH CHARACTER MUST BE ; BETWEEN A UNIQUE RANGE. THE RANGE OF THE CHARACTERS CAN BE ; SPECIFIED BY TWO BOUNDING STRINGS, SUCH THAT ; ; L(I) <= R(I) <= U(I) ; ; WHERE L IS THE LOWER BOUNDING STRING ; R IS THE RECORD STRING ; U IS THE UPPER BOUNDING STRING ; I IS THE INDEX (XPOS) ; ; THE ROUTINE RETURNS WITH 'C' CLEAR IFF THE CHARACTER IN 'R' ; IS WITHIN THE SPECIFIED RANGE. THE CHARACTER TO CHECK IS PASSED ; IN R0, AND THE LOWER AND UPPER BOUND STRINGS ARE PASSED IN ; R1 AND R2 RESPECTIVELY. ALL REGISTERS ARE PRESERVED. ; ; C.RANG: ADD WND.BL+..XPOS,R1 ; INDEX INTO STRING 1 ADD WND.BL+..XPOS,R2 ; INDEX INTO STRING 2 CMPB R0,(R1) ; < LOWER LIMIT BLO 100$ ; YES -> ERROR CMPB R0,(R2) ; > UPPER LIMIT BHI 100$ ; YES -> ERROR CLC ; CLEAR FAIL FLAG RETURN ; HOME 100$: SEC ; SET FAIL FLAG RETURN ; HOME ; ; .SBTTL PRIMITIVE - 'COPY' ... (R0) --> (R1) ; ; COPY: TSTB (R0) ; EOS? BEQ 100$ ; YES -> 100$ MOVB (R0)+,(R1)+ ; COPY BR COPY ; LOOP 100$: RETURN ; HOME ; ; .END