|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 36380 (0x8e1c)
Notes: pts_type(SC)
Names: »VDUPRT.SC«
└─⟦38a30a456⟧ Bits:30009662 Philips computer tape "600104"
└─⟦this⟧ »OD-KOM/VDUPRT.SC«
└─⟦d2cdd233a⟧ Bits:30009674 Philips computer tape "600204"
└─⟦this⟧ »OD-KOM/VDUPRT.SC«
IDENT VDUPRT 2.1DK 2 79-10-20 870150540210 =1,ODD BUFFER ADDRESS REL 2.1 79-05-23 =2,KEYBOARD LAMPS REL 2.1 79-05-23 =3, TRANSMIT BUFFER LENGTH REL 2.1 79-05-23 ****************************************************************** * * V D U P R T : MODULE HANDLING MESSAGES COMING FROM * MAIN FRAME, AND DISPLAYING THEM ON * THE VDU ( PTS 6344 ) . * ******************************************************************** * * EJECT * * * ENTRIES * * ENTRY TRPF TRANSMIT, PROGRAM FUNCTION ENTRY TRPA TRANSMIT, PROGRAM ATTENTION ENTRY ERASE ERASE ENTIRE SCREEN ENTRY SETCUR CURSOR POSITIONING ENTRY ERASUP ERASE ALL UNPROTECTED ENTRY DISPL DISPLAY MODIFIED DATA ENTRY ERASUA ERASE UNPROTECTED TO ADDRESS ENTRY WCHAR WRITE ONE CHAR IN CURSOR POS ENTRY UPDATE ENTRY RFMDUP REPLACE FM & DUP ENTRY DCINP ENTRY RLRBUF ENTRY DCGETM ENTRY GTRBUF * * * EXTERNALS * * EXTRN LINHON,LINHOF START EXTRN LSAVON,LSAVOF START EXTRN ATMASB EXTRN EMULA EXTRN REQTIM EXTRN ICWRTE * EXTRN SNBUSY PRT * EXTRN I:EVA0 CREDIT EVALUATION TABLE * EXTRN TASCII,TEBCDI TB3270 EJECT * **************************************************************** * * CONDITIONAL ASSEMBLY PARAMETERS * ********************************************** OFLIN EQU 1 OFFLINE HANDLING POSSIBLE IF ::= 1 DCLIN EQU 1 NUMBER OF MAIN FRAMES (1-2) RBUFL EQU 1150 RECEIVE BUFFER LENGTH IN WORDS RBUFNR EQU 2 NUMBER OF RECEIVE BUFFERS (1-5) TBUFL EQU 1150 TRANSMIT BUFFER LENGTH IN WORDS TBUFNR EQU 2 NUMBER OF TRANSMIT BUFFERS (1-5) COPCMD EQU 1 COPY COMMAND (ONLY TO PRINTER) IF := 1 EBCDIC EQU 1 ASCII = 0,EBCDIC = 1 * * EQUATES * * TIMDC EQU 600 DC TIME OUT VALUE: 60 S DK2 ESC EQU /1B SBA EQU /11 NULL EQU /7F NULL CHARACTER NEWLIN EQU /7E NEW LINE CHARACTER ENDMES EQU /7D END MESSAGE CHAR FORMFD EQU /7C FORM FEED CHAR DUPCH EQU /7B FMCH EQU /60 EJECT * * * EQUATES * * COMMON EQU FOR ECB HANDLING * ECBBA EQU 2 ECBRL EQU 4 ECBEL EQU 6 ECBRC EQU 8 ECBCW EQU 10 * * * CREDIT USED EQU * * * ECB REL. ADDRESSES * * DIS EQU 20 * ECBDC EQU -DIS-14 IFT DCLIN=2 IFT COPCMD=1 ECBDC2 EQU ECBDC-DIS ECBICR EQU ECBDC2-DIS ECBICW EQU ECBICR-DIS XIF IFT DCLIN=2 IFF COPCMD=1 ECBDC2 EQU ECBDC-DIS ECBICW EQU ECBDC2-DIS XIF IFF DCLIN=2 IFT COPCMD=1 ECBICR EQU ECBDC-DIS ECBICW EQU ECBICR-DIS XIF IFF DCLIN=2 IFF COPCMD=1 ECBICW EQU ECBDC-DIS XIF ECBVDU EQU ECBICW-DIS ECBKB EQU ECBVDU-DIS ECBSD EQU ECBKB-DIS EJECT * * * BASE ADDRESS FOR TCA AND ECB * TCABAS EQU A11 CREBAS EQU A13 ECB * * * TCA REL. ADDRESSES * TCT01 EQU 0 PRINTER EQU TCT01+2 BVDU EQU PRINTER+2 VDU SCREEN BUFFER PCURS EQU BVDU+1920 CURSOR ADDRESS , BINARY ATTRIB EQU PCURS+2 LAST ATTRIBUTE CHAR CURATT EQU ATTRIB+2 WCC EQU CURATT+2 WCC/CCC CHARACTER KBINH EQU WCC+2 KEYBOARD INHIBIT INDICATOR LINCNT EQU KBINH+2 LINE COUNTER DCLENG EQU LINCNT+2 DC READ EFFECTIVE LENGTH ICWORK EQU DCLENG+2 WORK FIELD INTERTASK COMM INTATT EQU ICWORK+2 INTENSITY ATTRIBUTE OFFFLG EQU INTATT+2 OFFLINE FLAG COPNO EQU OFFFLG+2 HARDCOPY TASK ID CCC EQU COPNO+2 COPY COMMAND CHARACTER MAIN EQU CCC+2 MAIN FRAME MODE EQU MAIN+2 INSERT MODE SWITCH KEYS EQU MODE+2 KEY LOCK STATUS ECBDCC EQU KEYS+2 ECB ADDRESS LAST READ DC ECBBLK EQU ECBDCC+2 ECBS FOR MULTIPLE WAIT &C RDMORE EQU ECBBLK+10 BRANCH ADDRESS NEXT READ KB EJECT * * LBVDU EQU 1920 1920 CHARACTER DISPLAY LPAGE EQU 48 LINES ON ONE PAGE LLINE EQU 80 80 CHAR PER DISPLAY LINE TID EQU -4 TASK IDENTITY T:A DISPLACEMENT * * CONFIG DATA 'CB1' REL ADDRESSES * NBRKBV EQU 0 NUMBER OF KB/VDUS NBRGTP EQU NBRKBV+2 NUMBER OF GTPS * MF1KBV EQU NBRGTP+2 DV ADDRESSES KB/VDU MF #1 MF1GTP EQU MF1KBV+16 DV ADDRESSES GTPS MF # 1 IFT DCLIN=2 MF2KBV EQU MF1GTP+16 MF2GTP EQU MF2KBV+16 XIF * EJECT **************************************************************** * * INPUT FROM DC * **************************************************** * * RELATIVE POS IN ECBBLK KB EQU 2 DC1 EQU 4 DC2 EQU 6 * DCINP EQU * CF A14,GTRBUF GET RECEIVE BUFFER LD A8,ECBDCC,TCABAS CF A14,DCGETM READ MESSAGE IFF DCLIN=2 CM ECBBLK+DC1,TCABAS XIF IFT DCLIN=2 LD A1,MAIN,TCABAS CW A8,ECBBLK+DC2,TCABAS RF(E) DCIN20 MF # 2 CM ECBBLK+DC1,TCABAS LDR A1,A1 RF(NZ) DCIN90 WRONG MF RF DCIN30 DCIN20 EQU * CM ECBBLK+DC2,TCABAS LDR A1,A1 RF(Z) DCIN90 WRONG MF XIF DCIN30 EQU * IFT OFLIN=1 LD A1,OFFFLG,TCABAS RF(NZ) DCIN90 XIF LD A1,ECBEL,A8 EFFECTIVE DC-LENGTH ST A1,DCLENG,TCABAS LD A5,KBINH,TCABAS ORK A5,3 BIT 14,15:= 1. TOTALLY DISABLED * KEYBOARD. BIT 15 = 0 AFTER DISPLAYING. ST A5,KBINH,TCABAS CF A14,LINHON TURN ON 'KEYBOARD INHIBIT' CF A14,LSAVON TURN ON "SYSTEM AVAILABLE" CF A14,UPDATE CF A14,DISPL LD A2,PCURS,TCABAS CF A14,ATMASB * LD A2,KBINH,TCABAS ANK A2,1 BIT 15 = 0? RF(Z) DCIN60 LD A2,KBINH,TCABAS ANK A2,/E BIT 15:=0 KEYBOARD NOT TOTALLY * INHIBITED ANY LONGER ST A2,KBINH,TCABAS LD A2,WCC,TCABAS ANK A2,2 RF(Z) DCIN95 DCIN60 EQU * CF A14,LINHOF TURN OFF 'KEYBOARD INHIBIT' LD A2,KBINH,TCABAS ANK A2,4 BITS 14,15:=0 RESTORE KEYBOARD ST A2,KBINH,TCABAS RF DCIN95 DCIN90 EQU * LD A8,ECBDCC,TCABAS LD A4,ECBBA,A8 CF A14,RLRBUF DCIN95 EQU * CF A14,SNBUSY RTN A14 EJECT * * READ DC * DCGETM EQU * LDK A1,0 CF A14,REQTIM LDK A7,/82 READ, WAIT CM ECBCW,A8 NO TIME OUT SUPERVISION LDKL A1,RBUFL+RBUFL ST A1,ECBRL,A8 REQ LENGTH ST A4,ECBBA,A8 LKM DATA 1 RTN A14 EJECT ********************************************************** * * BUFFER HANDLING * ********************************************************** * RLINK EQU RBUFL+RBUFL+2 * RBUF EQU * DATA *+2 POINTER FIRST FREE IFF RBUFNR=1 DATA *+RLINK RES RBUFL IFF RBUFNR=2 DATA *+RLINK RES RBUFL IFF RBUFNR=3 DATA *+RLINK RES RBUFL IFF RBUFNR=4 DATA *+RLINK RES RBUFL XIF DATA 0 END OF CHAIN RES RBUFL * * TLINK EQU TBUFL+TBUFL+2 * TBUF EQU * DATA *+2 POINTER FIRST FREE IFF TBUFNR=1 DATA *+TLINK RES TBUFL IFF TBUFNR=2 DATA *+TLINK RES TBUFL IFF TBUFNR=3 DATA *+TLINK RES TBUFL IFF TBUFNR=4 DATA *+TLINK RES TBUFL XIF DATA 0 END OF CHAIN RES TBUFL * * * GET WRITE BUFFER * GTWBUF EQU * LDKL A5,TBUF CF A14,GETBUF LDR A7,A4 LDR A12,A4 ADK A7,2 SKIP LDKL A9,2 FOR DV ADDRESS RTN A14 * * GET RECEIVE BUFFER * GTRBUF EQU * LDKL A5,RBUF * * GETBUF EQU * LDR* A4,A5 RF(Z) GETB50 NO BUFFER FREE LDR* A3,A4 STR A3,A5 ADK A4,2 SKIP LINK RTN A14 GETB50 EQU * LKM DATA 0 SWITCH TASK RB GETBUF * * RELEASE BUFFER * RLRBUF EQU * LDKL A2,RBUF RELB05 EQU * SUK A4,2 POINT TO LINK RELB10 EQU * LDR* A3,A2 RF(Z) RELB20 LDR A2,A3 RB RELB10 RELB20 EQU * STR A4,A2 CMR A4 RTN A14 * RLWBUF EQU * LDKL A2,TBUF RB RELB05 EJECT * * * STORE CHARACTER IN DC BUFFER * * A2=CHAR * A7=BUFFER POINTER * A9=BUFFER CHARACTER COUNTER * * PDCCH EQU * CWK A9,TBUFL+TBUFL =3 RF(G) PDCCHR OVERFLOW SCR A2,A7 PDCCH1 EQU * ADK A7,1 ADKL A9,1 PDCCHR RTN A14 * * * STORE ATTENTION ID FROM A2 * * PAID CF A14,PDCCH RTN A14 * * * GET CHARACTER FROM DC BUFFER TO A2 * * GDCCH LCR A2,A7 ANK A2,/FF RF(NZ) GDCC:1 NOT NULL CHARACTER LDK A2,/7F LOAD NULL CHARACTER GDCC:1 EQU * RB PDCCH1 EJECT * * * GET BUFFER ADDRESS TO A1 FROM DC BUFFER * * GETADR CF A14,GDCCH LC A1,TEBCDI,A2 ANK A1,/3F SLL A1,6 CF A14,GDCCH LC A2,TEBCDI,A2 ANK A2,/3F ORR A1,A2 RTN A14 EJECT * * * WRITE MESSAGE TO MAIN FRAME * * ON EXIT A1 CONTAINS RETURN CODE * * DCWRTE EQU * LDKL A8,ECBDC IFT DCLIN=2 LD A7,MAIN,TCABAS RF(Z) DC050 LDKL A8,ECBDC2 XIF DC050 EQU * ADR A8,CREBAS LDKL A1,TIMDC CF A14,REQTIM ST A9,ECBRL,A8 REQ LENGTH ST A12,ECBBA,A8 BUFFER ADDRESS LD A7,KBINH,TCABAS ORK A7,2 BIT 14 :=1 DISABLE KEYBOARD.RESET ALLOWED ST A7,KBINH,TCABAS LDK A7,/86 DC100 EQU * LKM DATA 1 DC200 EQU * LDR A4,A12 CF A14,RLWBUF LD A1,ECBRC,A8 GET RETURN CODE RF(Z) DC300 LD A7,KBINH,TCABAS ANK A7,/D BIT 14:=0 ALLIWE KEYBOARD ST A7,KBINH,TCABAS CF A14,LINHOF TURN OFF "KEYBOARD INHIBIT CF A14,LSAVOF TURN OFF "SYSTEM AVAILABLE" * LDK A7,/04 RESET KEYBOARD ECB BUFFER LDKL A8,ECBKB ADR A8,CREBAS LKM DATA 1 * RTN A14 DC300 EQU * CF A14,LSAVON TURN ON 'SYSTEM AVAILABLE' RTN A14 EJECT * * * STORE CURSOR ADDRESS IN DC BUFFER * * CURSA LD A1,PCURS,TCABAS RF BUFADR * * * STORE BUFFER ADDRESS IN DC BUFFER * * A1=BINARY BUFFER ADDRESS * * BUFADR LDR A2,A1 SRL A2,6 ANK A2,/3F LC A2,TASCII,A2 CONVERT TO ASCII CF A14,PDCCH LDR A2,A1 ANK A2,/3F LC A2,TASCII,A2 CF A14,PDCCH RTN A14 EJECT * * * GET MODIFIED DATA FROM DISPLAY IMAGE BUFFER * * A3=BUFFER POSITION BINARY * A4=BUFFER POINTER * * RDMOD LDK A3,0 RESET POSITION LDKL A4,BVDU ADR A4,TCABAS BUFFER POINTER ************************************************************ ADKL A4,1919 LAST SCREEN POSITION LCR A2,A4 GET CHARACTER LDKL A4,BVDU RELOAD FIRST BUFFER POSITION ADR A4,TCABAS LDR A1,A2 ANK A1,/60 ATTRIBUTE ??? RF(Z) RD200 YES!!! ************************************************************ RD100 CWK A3,LBVDU RF(NL) RDMODE ALL EXAMINED LCR A2,A4 GET CHAR ADK A3,1 ADK A4,1 ************************************************************ RD105 EQU * ************************************************************ LDR A1,A2 ANK A1,/60 RF(Z) RD200 ATTRIBUTE CHAR RD110 CWK A2,NULL RB(E) RD100 DON'T STORE NULL CF A14,PDCCH STORE CHAR IN DC BUFFER RB RD100 RD200 ANK A2,1 CHECK MDT BIT RF(NZ) RD300 MODIFIED FIELD RD210 CWK A3,LBVDU RF(NL) RDMODE ALL EXAMINED LCR A2,A4 ADK A3,1 ADK A4,1 LDR A1,A2 ANK A1,/60 RB(NZ) RD210 NO ATTRIBUTE CHAR ******************************************************** 78-05-11 CWK A3,LBVDU ALL BUFFER EXAMINED ??? RF(NL) RDMODE YES!! ******************************************************** 78-05-11 RB RD200 ATTRIBUTE FOUND RD300 LDK A2,SBA CF A14,PDCCH SBA TO DC BUFFER LDR A1,A3 BUFFER POSITION CF A14,BUFADR TO DC BUFFER RB RD100 RDMODE RTN A14 EJECT * * * UPDATE VIDEO DISPLAY BUFFER IMAGE BY THE DATA * * RECEIVED FROM THE DC LINE * * * A7=DC RECEIVE BUFFER POINTER * A8=DC ECB ADDRESS * A9=DC BUFFER INDEX, INITIALLY ZERO * * A3=DISPLAY BUFFER POSITION * A4=DISPLAY BUFFER POINTER * * UPDATE EQU * CM ICWORK,TCABAS LD A8,ECBDCC,TCABAS LD A7,ECBBA,A8 DC BUFFER ADDRESS SUR A9,A9 RESET DC BUFFER INDEX CF A14,GDCCH GET FIRST CHAR FROM DC BUFFER CWK A2,ESC SHOULD BE ESCAPE RF(NE) UPDEND NOT ESCAPE CF A14,GDCCH GET COMMAND CODE CWK A2,/31 RF(E) UPD100 WRITE CWK A2,/35 RF(E) UPD120 ERASE/WRITE CWK A2,/3F RF(E) UPD140 ERASE ALL UNPROTECTED IFT COPCMD=1 CWK A2,/37 ABL(E) UPD600 COPY COMMAND XIF RF UPDEND INVALID COMMAND CODE EJECT * * WRITE COMMAND * UPD100 EQU * CF A14,PWCC PROCESS WCC FOR MDT BIT LD A3,PCURS,TCABAS LDR A4,A3 START IN CURSOR POSITION ADKL A4,BVDU ADR A4,TCABAS LDK A5,1 INDICATE WCC, IC OR RA RF UPD220 * * ERASE/WRITE COMMAND * UPD120 EQU * CF A14,ERASE ERASE SCREEN RF UPD200 * * ERASE ALL UNPROTECTED * UPD140 EQU * CF A14,ERASUP ERASE ALL UNPROTECTED RF UPDEND NO TEXT WITH THIS COMMAND * * TAKE CARE OF WRITE CONTROL CHARACTER WCC * UPD200 CF A14,PWCC PROCESS WCC LDK A5,1 INDICATE WCC, IC OR RA EJECT * * * PROCESS DATA FROM DC BUFFER * * UPD210 LDK A3,0 START FROM POSITION ZERO LDKL A4,BVDU ADR A4,TCABAS UPD220 CW A9,DCLENG,TCABAS RF(NL) UPDEND ALL RECEIVED CHARS PROCESSED CF A14,GDCCH GET CHAR FROM DC BUFFER CWK A2,/20 RF(L) UPD300 ORDER UPD230 EQU * ORK A2,/80 SET DISPLAY BIT UPD240 EQU * LDK A5,0 INDICATE NOT WCC, IC OR RA CWK A3,LBVDU RF(E) UPD260 END OF VIDEO BUFFER UPD250 EQU * SCR A2,A4 STORE IN VIDEO BUFFER ADK A3,1 ADK A4,1 RB UPD220 UPD260 LDK A3,0 LDKL A4,BVDU ADR A4,TCABAS RB UPD250 UPD300 EQU * ******************************************* 78-08-15 CWK A3,LBVDU END OF DISPLAY BUFFER ??? RF(NE) UPD302 NO!!! SUR A3,A3 FIRST SCREEN POSITION LDKL A4,BVDU ADR A4,TCABAS BUFFER POSITION UPD302 EQU * ******************************************* 78-08-15 CWK A2,/1D RF(E) UPD320 START FIELD CWK A2,/11 RF(E) UPD340 SET BUFFER ADDRESS CWK A2,/13 RF(E) UPD360 INSERT CURSOR CWK A2,/09 RF(E) UPD400 PROGRAM TAB CWK A2,/14 RF(E) UPD500 REPEAT TO ADDRESS CWK A2,/12 RF(E) UPD540 ERASE UNPROTECTED TO ADDRESS CWK A2,/0C RF(NE) UPD305 LDK A2,FORMFD FORM FEED RB UPD230 UPD305 CWK A2,/19 RF(NE) UPD310 LDK A2,ENDMES END MESSAGE RB UPD230 UPD310 EQU * CWK A2,/0A RF(NE) UPD315 LDK A2,NEWLIN NEW LINE RB UPD230 UPD315 EQU * CWK A2,/18 RF(NE) UPD318 ILLEGAL ORDER LDK A2,/30 RB UPD230 EJECT UPD318 EQU * CWK A2,/00 NULL CHARACTER ??? RF(NE) UPDEND NO!! ILLEGAL ORDER LDK A2,/7F PTS NULL CHARACTER RB UPD230 ************************************************************ * * RELEASE RECEIVE BUFFER * ************************************* UPDEND EQU * LD A8,ECBDCC,TCABAS LD A4,ECBBA,A8 CF A14,RLRBUF RTN A14 EJECT * * * START FIELD ORDER * UPD320 CF A14,GDCCH GET ATTRIBUTE CHAR LC A2,TEBCDI,A2 LDR A1,A2 COMPOSE PTS ATTRIBUTE CHAR ANK A1,1 SRL A2,1 ANK A2,/1E ORR A2,A1 RB UPD240 * * SET BUFFER ADDRESS * UPD340 CF A14,GETADR GET ADDRESS CWK A1,LBVDU RB(NL) UPDEND INVALID ADDRESS LDR A3,A1 LDR A4,A3 ADKL A4,BVDU ADR A4,TCABAS RB UPD220 * * INSERT CURSOR * UPD360 ST A3,PCURS,TCABAS SET NEW CURSOR POS LDK A5,1 INDICATE WCC, IC OR RA RB UPD220 EJECT * * PROGRAM TAB * UPD400 LDR A5,A5 RF(NZ) UPD430 PT AFTER WCC, IC OR RA LDK A1,NULL+/80 FILL CURRENT FIELD BY NULLS UPD410 EQU * LDK A5,0 CWK A3,LBVDU RB(NL) UPD210 END OF BUFFER LCR A2,A4 ADK A3,1 ANK A2,/7F CWK A2,/20 RF(L) UPD415 SCR A1,A4 STORE NULL ADK A4,1 RB UPD410 UPD415 EQU * ADK A4,1 UPD420 ANK A2,/10 RB(Z) UPD220 UNPROTECTED FIELD UPD430 EQU * LDK A5,0 CWK A3,LBVDU ABL(NL) UPD210 END OF DISPLAY BUFFER LCR A2,A4 ADK A3,1 ADK A4,1 ANK A2,/7F CWK A2,/20 RB(L) UPD420 RB UPD430 EJECT * * REPEAT TO ADDRESS * UPD500 CF A14,GETADR GET END ADDRESS CWK A1,LBVDU RB(NL) UPDEND INVALID ADDRESS CF A14,GDCCH GET CHAR TO BE REPEATED LDK A5,1 INDICATE WCC, IC OR RA ORK A2,/80 INDICATE MODIFIED **************************************************** 78-07-02 CWR A3,A1 NULLS TO ALL SCREEN POSITIONS ???? RF(E) UPD530 YES!!! ***************************************************** 78-07-02 UPD510 CWK A3,LBVDU RF(L) UPD520 NOT END OF SCREEN LDK A3,0 LDKL A4,BVDU WRAP AROUND ADR A4,TCABAS UPD520 CWR A3,A1 ABL(E) UPD220 ALL CHAR REPEATED ******************************************************* 78-07-02 UPD530 EQU * ***************************************************** 78-07-02 SCR A2,A4 ADK A3,1 ADK A4,1 RB UPD510 NEXT POSITION * * ERASE UNPROTECTED TO ADDRESS * UPD540 CF A14,GETADR GET END ADDRESS CWK A3,LBVDU RB(NL) UPDEND INVALID ADDRESS CF A14,ERASUA ERASE UNPROTECTED TO ADDRESS ABL UPD220 IFT COPCMD=1 EJECT * * COPY COMMAND * UPD600 EQU * LD A1,PRINTER,TCABAS ABL(Z) UPDEND COPYCOMMAND NOT SUPPORTED FOR VDU ADK A7,1 BYPASS CCC CF A14,GDCCH GET FROM DEVICE IFT EBCDIC=1 LC A2,TEBCDI,A2 CONVERT TO EBCDIC XIF IFT COPCMD=1 LD A3,6,CREBAS 'CB1' ADDRESS LDK A4,MF1KBV-1 IFT DCLIN=2 LD A1,ECBBLK+DC2,TCABAS RF(NZ) UPD602 LDK A4,MF2KBV-1 MF # 2 READ XIF IFT COPCMD=1 UPD602 EQU * ADR A4,A3 CONFIG TABLE -1 LD A5,NBRKBV,A3 NUMBER OF KB/VDUS ADR A4,A5 LAST KB/VDU CONFIGURATED UPD604 EQU * CCR A2,A4 DV-ADDRESS MATCHES ? RF(E) UPD610 YES SUK A4,1 SUK A5,1 RB(P) UPD604 TRY NEXT ABL UPDEND NO MATCH * UPD610 EQU * LDKL A8,ECBICW ADR A8,CREBAS LKM DATA 10 ABORT LAST REQUEST IF NOT COMPLETED ADKL A5,/4B40 TASKID FROM DEVICE LD A2,-4,CREBAS GET OWN TASKID ST A2,ICWORK,TCABAS PUT IN BUFFER LDK A4,/0B WRITE ADDRESSED , NO WAIT LDK A6,2 REQ LENGTH LDKL A3,ICWORK ADR A3,TCABAS BUFFER ADDRESS CF A14,ICWRTE WRITE INTERTASK ABL UPDEND XIF EJECT * * * PROCESS WRITE CONTROL CHARACTER * * ONLY RESET MDT BIT IS TAKEN CARE OF * * PWCC CF A14,GDCCH GET WCC LC A2,TEBCDI,A2 IN EBCDIC ST A2,WCC,TCABAS SAVE IT ANK A2,/04 RF(Z) PWCC1 LD A2,PRINTER,TCABAS RF(NZ) PWCC1 LDR A10,A7 LDKL A8,ECBVDU ADR A8,CREBAS LD A2,ECBBA,A8 LDK A7,/2B SC A7,1,A2 =1 LDK A7,/07 BELL =1 SC A7,2,A2 =1 SC A7,3,A2 =1 LDK A7,4 ST A7,ECBRL,A8 LDK A7,/86 LKM DATA 1 LD A8,ECBDCC,TCABAS LDR A7,A10 PWCC1 EQU * LD A2,WCC,TCABAS ANK A2,1 RF(NZ) RESMDT RESET ALL MDT PWCC10 RTN A14 NO ACTION * * * RESET ALL MDT BITS * * RESMDT LDK A3,0 LDKL A4,BVDU ADR A4,TCABAS RESM10 CWK A3,LBVDU RB(NL) PWCC10 ALL DONE LCR A2,A4 GET CHAR ANK A2,/60 RF(NZ) RESM20 NO ATTRIBUTE LCR A2,A4 ANK A2,/FE RESET MDT SCR A2,A4 RESM20 ADK A3,1 ADK A4,1 RB RESM10 EJECT * * * ERASE ENTIRE SCREEN * * ERASE LDK A3,0 LDKL A4,BVDU ADR A4,TCABAS LDK A2,NULL ERAS20 CWK A3,LBVDU RF(NL) ERAS25 ALL ERASED SCR A2,A4 ADK A3,1 ADK A4,1 RB ERAS20 ERAS25 CM PCURS,TCABAS RESET CURSOR POS LDKL A1,LBVDU+1 ST A1,CURATT,TCABAS INDICATE UNFORM. SCREEN CM ATTRIB,TCABAS LD A1,PRINTER,TCABAS CHECK DEVISE TYPE RF(NZ) ERAEND PRINTER, NOT DISPLAY STR A7,A14 SAVE A7 AND A8 ON STACK ST A8,-2,A14 LDKL A8,ECBVDU ADR A8,CREBAS VDUECB LDK A7,'1' ERASE CONTROL CHAR LD A1,ECBBA,A8 =1 SC A7,1,A1 =1 LDK A7,2 ST A7,ECBRL,A8 REQ LENGTH = 2 LDK A7,/86 WRITE LKM DATA 1 LD A8,-2,A14 LDR* A7,A14 RESTORE A7 AND A8 ERAEND RTN A14 EJECT * * * ERASE ALL UNPROTECTED * * ERASUP LDK A2,2 ST A2,WCC,TCABAS SET KEYBOARD RESTORE BIT SUR A1,A1 INDICATE ATT IN LAST SCREEN POS DK LDK A3,0 LDKL A4,BVDU ADR A4,TCABAS CM PCURS,TCABAS FIND FIRST UNPROTECTED POS ******************************************************************** LC A2,1919,A4 GET LAST SCREEN CHARACTER ANK A2,/7F CWK A2,/20 ATTRIBUTE ??? RF(L) ERU:01 YES!! WE GOT IT!! LDK A1,1 ATTRIBUTE NOT IN LAST SCREEN POS. ******************************************************** ERASU1 CWK A3,LBVDU RF(NL) ERASU2 LCR A2,A4 GET CHAR ANK A2,/7F ADK A3,1 ADK A4,1 CWK A2,/20 RB(NL) ERASU1 NO ATTRIBUTE ERU:01 EQU * ANK A2,/10 RB(NZ) ERASU1 PROTECTED ST A3,PCURS,TCABAS SET NEW CURSOR POS LDR A1,A1 RF(Z) ERASU3 ATTRIBUTE IN LAST SCREEN POS. ERASU2 LDK A3,0 LDKL A4,BVDU ADR A4,TCABAS RF ERASU4 ERASU3 EQU * LDR A3,A3 RF(Z) ERASU4 UNPROTECTED ATT. IN LAST SCREEN POS. SUK A3,1 GET BACK TO ATTRIBUTE SUK A4,1 - " - ERASU4 EQU * LDK A1,0 LDK A6,NULL+/80 ERASE CHAR RF ERAS35 EJECT * * * ERASE UNPROTECTED TO ADDRESS GIVEN IN A1 * * ERASUA LDK A6,NULL+/80 ERASE CHARACTER ******************* 78-09-11 CWK A3,LBVDU WRAP AROUND ??? RF(L) ERAS:1 NO!! LDK A3,0 BUFFERINDEX LDKL A4,BVDU ADR A4,TCABAS ABSOLUTE BUFFER ADDRESS ERAS:1 LDR A3,A3 START IN FIRST SCREEN POSITION ??? RF(NZ) ERAS35 NO!! LC A2,1919,A4 LAST BUFFER CHARACTER ANK A2,/7F CWK A2,/20 ATTRIBUTE CHARACTER ??? RF(NL) ERAS35 NO!!! ANK A2,/10 RF(NZ) ERAS70 PROTECTED FIELD LC A2,1919,A4 ANK A2,/FE SC A2,1919,A4 RESET MDT BIT RF ERAS35 ******************** 78-09-11 ERAS30 CWK A3,LBVDU RF(L) ERAS33 NOT END OF SCREEN LDK A3,0 LDKL A4,BVDU WRAP AROUND ADR A4,TCABAS ERAS33 EQU * CWR A3,A1 RB(E) ERAEND ALL UNPROTECTED ERASED ERAS35 LCR A2,A4 GET CHAR FROM VDU BUFFER ANK A2,/7F CWK A2,/20 RF(L) ERAS50 ATTRIBUTE CHAR XRK A2,NULL RF(Z) ERAS40 ALREADY NULL SCR A6,A4 STORE MODIFIED NULL ERAS40 ADK A3,1 ADK A4,1 RB ERAS30 ERAS50 ADK A3,1 ADK A4,1 ANK A2,/10 RF(NZ) ERAS60 PROTECTED FIELD LC A2,-1,A4 ANK A2,/FE RESET MDT BIT SC A2,-1,A4 RB ERAS30 ERAS60 CWK A3,LBVDU RF(L) ERAS65 LDK A3,0 LDKL A4,BVDU WRAP AROUND ADR A4,TCABAS ERAS65 CWR A3,A1 RB(E) ERAEND ALL UNPROTECTED ERASED ERAS70 EQU * LCR A2,A4 ANK A2,/7F CWK A2,/20 RB(L) ERAS50 ATTRIBUTE FOUND ADK A3,1 ADK A4,1 RB ERAS60 EJECT * * * TRANSMIT PROGRAM ATTENTION * * A2=AID * * TRPA CF A14,GTWBUF GET TRANSMIT BUFFER TRPA10 CF A14,PAID STORE AID TRANS EQU * CF A14,DCWRTE WRITE MESSAGE TR050 EQU * RTN A14 TRANSMISSION TROUBLE TRRTN RTN A14 EJECT * * * TRANSMIT PROGRAM FUNCTION * * A2=AID * * TRPF CF A14,GTWBUF GET TRANSMIT BUFFER TRPF10 CF A14,PAID STORE AID CF A14,CURSA STORE CURSOR ADDRESS CF A14,RDMOD READ MODIFIED RB TRANS SEND MODIFIED FIELDS EJECT * * * DISPLAY MODIFIED FIELDS ON VDU * * * A3=VDU POSITION * A4=VDU IMAGE POINTER * A5=MODIFIED INDICATOR * A7=VDU LINE OUTPUT POINTER * A8=VDU ECB * A9=VDU OUTPUT CHAR COUNTER * * DISPL LDKL A8,ECBVDU ADR A8,CREBAS LDKL A1,/101 START FROM LINE 1 POS 1 ST A1,ECBCW,A8 SUR A10,A10 RESET COUNT FOR INTENSIFIED DISPLAYING LDK A3,0 LDKL A4,BVDU ADR A4,TCABAS CF A14,SPACES PUT SPACES IN LINE BUFFER **************************************************************** LC A2,1919,A4 CHECK IF ATTRIBUTE IN LAST POSITION ANK A2,/7F CWK A2,/1F ATTRIBUTE ??? RF(G) DIS100 NO!!! ANK A2,6 XRK A2,6 ST A2,INTATT,TCABAS CHECK DISPLAY/NONDISPLAY INFORMATION RF(Z) DIS210 NON DISPLAY CF A14,INTCHK INSERT HIGH/LOW INTENS. IN BUFFER ******************************************************************* DIS100 EQU * CWK A9,LLINE RF(L) DIS110 NOT END OF LINE CF A14,DISLIN DISPLAY THIS LINE CF A14,INTCHK CHECK IF LOW/HIGH INTENSITY DIS110 EQU * CWK A3,LBVDU RF(NL) DIS900 ALL SCANNED LCR A2,A4 GET CHAR ************************************************ 78-08-15 CF A14,SET:M SET MODIFIED BIT ************************************************ 78-08-15 DIS115 EQU * ANK A2,/7F RESET DISPLAY BIT SCR A2,A4 ADK A3,1 ADK A4,1 ADK A7,1 ADKL A9,1 CWK A2,/20 RF(L) DIS200 ATTRIBUTE CHAR CWK A2,NULL RB(E) DIS100 NULL EQUALS SPACE AT DISPLAY CWK A2,/7D RF(NE) DIS120 LDK A2,/39 DIS120 CWK A2,/7E RF(NE) DIS121 LDK A2,/35 DIS121 CWK A2,/7C RF(NE) DIS122 LDK A2,/3C DIS122 EQU * SC A2,-1,A7 STORE CHAR IN DISPLAY OUTPUT BUFFER RB DIS100 DIS200 ANK A2,6 XRK A2,6 CHECK IF NONDISPLAY ST A2,INTATT,TCABAS SAVE ATTRIBUTE CHARACTER RF(Z) DIS210 NON DISPLAY ANK A2,4 RF(Z) DIS205 HIGH INTENSITY LDK A2,/1E LOW INTENSITY RF DIS206 DIS205 EQU * LDK A2,/1F HIGH DIS206 EQU * SC A2,-1,A7 STORE INTENSITY CHARACTER ADKL A10,1 INCREMENT COUNTER ADK A7,1 RB DIS100 DIS210 EQU * CWK A9,LLINE RF(L) DIS220 CF A14,DISLIN DISPLAY THIS LINE DIS220 EQU * CWK A3,LBVDU RF(NL) DIS900 ALL DISPLAYED LCR A2,A4 ************************************************* 78-08-15 CF A14,SET:M SET MODIFIED BIT ************************************************ 78-08-15 DIS225 EQU * ANK A2,/7F RESET DISPLAY BIT SCR A2,A4 ADK A3,1 ADK A4,1 ADK A7,1 ADKL A9,1 CWK A2,/20 RB(L) DIS200 ATTRIBUTE FOUND RB DIS210 EJECT * * * POSITION THE CURSOR * * SETCUR EQU * DIS900 LDK A1,2 REQ LENGTH DIS905 ST A1,ECBRL,A8 LD A1,PCURS,TCABAS GET CURSOR POS LDKL A2,/101 START ON LIN 1 POS 1 ST A2,ECBCW,A8 LDKL A2,/100 DIS910 CWK A1,LLINE RF(L) DIS920 ADS A2,ECBCW,A8 SUKL A1,LLINE RB DIS910 DIS920 ADS A1,ECBCW,A8 LDK A7,/8B SET CURSOR AND WRITE LKM DATA 1 CM INTATT,TCABAS CLEAR INTENSITY ATTRIBUTE RTN A14 EJECT * * * WRITE ONE CHAR FROM A2 IN CURSOR POSITION * * WCHAR LD A1,ECBBA,A8 CF A14,RFMDUP SC A2,3,A1 STORE CHAR IN VDU OUTPUT BUFFER LDK A1,4 RB DIS905 REQ LENGTH = 3 * ********************************************************************* * * REPLACE FM & DUP WITH '*' RESP. ';', IF PRESENT * CHARACTER IN A2 * ********************************************************************* * RFMDUP EQU * CWK A2,DUPCH RF(NE) RFMD10 LDK A2,/2A DUP RFMD10 EQU * CWK A2,FMCH RF(NE) RFMD20 LDK A2,/3B RFMD20 EQU * RTN A14 EJECT * * * PUT SPACES TO DISPLAY LINE BUFFER * * SPACES LD A7,ECBBA,A8 ADK A7,2 BUFFER ADDRESS LDKL A9,LLINE LINE LENGTH ADR A9,A9 DOUBLE IT LDKL A2,' ' SPACES SPAC10 SCR A2,A7 =1 SC A2,1,A7 =1 ADK A7,2 SUKL A9,2 RB(P) SPAC10 LDK A2,0 CLEAR A2=CHAR REGISTER LDK A5,0 RESET MODIFIED INDICATOR LD A7,ECBBA,A8 ADK A7,2 BUFFER ADDRESS SUR A9,A9 RESET LINE CHAR COUNTER RTN A14 EJECT * * * DISPLAY LINE IF ANY MODIFICATIONS * * ************************************************* 78-08-15 DISLIN EQU * LDR A7,A5 ANK A5,/80 ANY MODIFICATIONS ?? RF(Z) DISL10 NO MODIFICATIONS LDK A1,2 XRK A7,/A0 ONLY SPACES IN BUFFER ?? RF(Z) DIS:10 YES!! LDKL A1,LLINE+2 ADR A1,A10 ADD NR OF INTENSITY CHARACTERS DIS:10 EQU * *********************************************** 78-08-15 ST A1,ECBRL,A8 SET REQ LENGTH LDK A7,/8B SET CURSOR AND WRITE LKM DATA 1 EJECT ******************************************************************** * * EXECUTE FAST OUTPUT TO BLANK REMAINIG PART * OF THE LINE * ******************************************************************* LD A1,ECBCW,A8 CURSOR POSITION ANK A1,X'FF' COLUMN NUMBER * SUK A1,81 LAST POSITION ??? DK SUK A1,80 LAST POSITION ? DK * RF(Z) DISL10 YES!! NO FAST OUTPUT THIS LINE DK RF(NL) DISL10 YES, NO FAST OUTPUT THIS LINE DK LD A1,ECBBA,A8 BUFFER ADRESS LDK A2,X'2B' DONT MOVE CURSOR ONE LINE SC A2,1,A1 =1 LDKL A2,X'1420' FAST OUTPUT OF SPACES SC A2,3,A1 =1 SRL A2,8 =1 SC A2,2,A1 =1 LDK A2,84 REQUESTED LENGTH ST A2,ECBRL,A8 LDK A7,X'86' WRITE ORDER LKM DATA 1 DISL10 EQU * LDK A2,1 SC A2,ECBCW+1,A8 POS 1 ON NEXT LINE LDKL A2,/100 ADS A2,ECBCW,A8 INCREMENT LINE NUMBER RB SPACES PUT SPACES TO BUFFER EJECT **************************************************************** * * I N T C H K CHECK IF LINE SHOULD BE PRINTED WITH * HIGH OR LOW INTENSITY * ********************************************************************** INTCHK SUR A10,A10 RESET INTENSITY COUNT LD A2,INTATT,TCABAS GET INTENSITY ATTRIBUTE RF(Z) INTRTN NON DISPLAY ANK A2,X'4' HIGH INTENSITY ??? RF(Z) INT:10 YES LDK A2,X'1E' LOW INTENSITY RF INT:20 HIGH INTENSITY INT:10 LDK A2,X'1F' HIGH INTENSITY INT:20 SCR A2,A7 SAVE INTENSITY CHARACTER IN BUFFER ADK A7,1 INCREMENT BUFFER POINTER ADKL A10,1 INTENSITY COUNT INTRTN RTN A14 RETURN * EJECT **************************************************************** * * SET:M SET MODIFIED BIT IF CHARACTER HAS BEEN MODIFIED * ****************************************************************** SET:M CWK A2,/20 RF(L) SET:M2 ATTRIBUTE CHARACTER CWK A2,/7F RF(E) SET:M2 UNMODIFIED ATTRIBUTE CWK A2,/FF RF(NE) SET:M1 NOT NULL OR ATTRIBUTE ORK A5,/A0 MODIFIED NULL CHARACTER RTN A14 SET:M1 ORR A5,A2 SET MODIFIED BIT SET:M2 RTN A14 END