|
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: 67282 (0x106d2)
Notes: pts_type(SC)
Names: »DRDC15.SC«
└─⟦9af60a727⟧ Bits:30009707 Philips computer tape "M_173"
└─⟦this⟧ »M:173/DRDC15.SC«
└─⟦this⟧ »M:173/DRDC15.SC«
└─⟦a25d6defe⟧ Bits:30009676 Philips computer tape "600210"
└─⟦this⟧ »M:92NA/DRDC15.SC«
└─⟦this⟧ »M:92SP/DRDC15.SC«
IDENT DRDC15 9.2DK 7 83-10-12 870105040924 DK7,READ-MODIFIED, MODIFIED 82-10-02 DK6, READ MODIFIED DK5, LP, DWTINF, ST.PR.BIT, 81-11-05 DK3, RBUFNR=1 ALLOWED DK2, TBUFL 80-03-11 DK, COND.ASM., TIMPRO, TIMNAK, READ BUF. 80-03-11 REL 9.1 79-08-16 =8, ASCII-MODE FOR SALCUZ REL 9.1 79-07-19 =7, ACK IN CONVERSATIONAL MODE REL 9.1 79-07-19 =6, DCTASK BUFFER ADDRESS DESTROYED REL 9.1 79-05-23 =5, INCOMPLETE POLL SEQUENCE REL 9.1 79-05-23 =3, TRANSFER PARAMETER PRR 9.1 79-04-06 =4, ANY MESSAGE ORDER PRR 9.1 79-04-06 =2, ABORT HANDLING PRR 9.1 78-11-29 =1, MSR-INSTRUCTION PRR 9.1 78-11-14 REL 8.2 78-11-14 * * ********************************************* * * PHILIPS TERMINAL SYSTEM PTS * * DRDC15: DRIVER DATA COMMUNICATION * BSC MULTIPOINT LINE PROCEDURE * OR SIEMENS MSV1 * * * * * **************************************************** * * * ENTRY POINTS * ENTRY DC15AD ADDRESS BLOCK TERMINAL REQUESTS ENTRY IH1501 INPUT INTERRUPT ENTRY IH1502 OUTPUT INTERRUPT ENTRY DC15ON POWER ON ROUTINE ENTRY DW1500 DWT FOR DC TASK * * * EXTERNAL REFERENCES * * EXTRN TDISP DISPATCHER ENTRY EXTRN SAVE8 SAVE A1-A8 ON A15 STACK EXTRN TENDIO COMPLETE I/O EVENT EXTRN DISIOE REQUEST ERROR EXTRN SETIME SET TIMER EXTRN DWTST DWT STATUS EXTRN DWTOR DWT ORDER EXTRN DWTECB DWT ECB EXTRN INTSAV SAVE AREA LAST INTERRUPT EXTRN TEBCDIC ASCII TO EBCDIC TABLE EXTRN TASCII EBCDIC TO ASCII TABLE EXTRN ECBBA ECB BUFFER ADDRESS EXTRN ECBRL ECB REQUESTED LENGTH EXTRN ECBEL ECB EFFECTIVE LENGTH EXTRN ECBRC ECB RETURN CODE EXTRN ECBCW ECB CONTROL WORD EXTRN DC:MIN MOVE DATA TO USER BUFFER EXTRN DC:MOT MOVE DATA FROM USER BUFFER EXTRN DISEND COMPLETE REQUEST AND DISPATCH * * * * * STANDARD INTERFACE PART FOR DATA COMMUNICATION * * * * * DWT CONTENTS * * DWTCHP TERMINAL ADDRESS AS GIVEN AT PARAMETER TRANSFER (BIT #08-#15) * ******************************************************* * * PARAMETERS FOR CONDITIONAL ASSEMBLY * XRVI EQU /5C STANDARD:/40, DK:/5C DK X:D EQU 0 BASE FOR RBUFL AND TBUFL DK X:X EQU 500 VALUE FOR BASE DK X:A EQU 2000 RECEIVE BUFFER LENGTH RBUFL EQU 650+X:X DK X:B EQU /60 DCTASK FILE CODE DC15FC EQU /60 X:C EQU 1 IF 1 INTERRUPT LOGGING LOGG EQU 0 * TIMPOL EQU 600 POLL TIMEOUT VALUE DK X:E EQU 1 STATUS AND RVI HANDLING IF=1 STAT EQU X:E X:F EQU 1 READ COMMAND HANDLING IF=1 RCOM EQU X:F X:G EQU 252 TRANSMIT BLOCK LENGTH TBLEN EQU X:G X:H EQU 1 CODE , 0=ASCII , 1=EBCDIC CODE EQU X:H X:I EQU 0 IF 1 SPECIFIC POLL HANDLING SPECP EQU X:I X:J EQU 1 IF = 1 LINE SPEED SET TO HIGH IF = 0 LINE SPEED IS SET TO LOW SPEED EQU X:J X:K EQU 0 IF 1 SIEMENS MSV1 PROCEDURE MSV1 EQU X:K X:L EQU 2 NUMBER OF RECEIVE BUFFERS (2-5) RBUFNR EQU 2 X:M EQU 0 IF = 1 PTS 6805 ADAPTION P6805 EQU X:M X:N EQU /02 IFT P6805=0 LCUIN EQU X:N DEVICE ADDRESS OF RECEIVER XIF IFT P6805=1 LCUIN EQU /0A DEVICE ADDRESS OF RECEIVER XIF X:O EQU 0 IBMCHR EQU X:O IF 1 IBM CHARACTER HANDLING X:P EQU 0 IF 1 MESSAGE PASSING TO DC TASK MESPAS EQU X:P X:Q EQU 1 IBM-3270 EMULATION PACKAGE, IF NOT = 0 EM3270 EQU X:Q X:R EQU 1000 DK2 BINTRM EQU 0 IF 1 BINARY TRANSMISSION TSTREQ EQU X:I IF 1 TEST REQUEST HANDLING DMRK EQU 1 SPECIAL CONDITION FOR DENMARK NOWACK EQU 0 WHEN WORKING WITH A MAIN-FRAME THAT DOESN'T ACCEPT WACK RESPONSE TO A SELECT SEQUENCE, NOWACK SHOULD BE SET TO "ONE". ONLY WORKING IF STAT IS SET TO "ONE". IFT P6805=0 LCUUT EQU LCUIN+/10 DEVICE ADDRESS OF TRANSMITTER XIF IFT P6805=1 LCUUT EQU LCUIN+/01 DEVICE ADDRESS OF TRANSMITTER XIF * * * ***************************************** * * CONDITIONAL ASSEMBLY * ***************************************** * * A PROGRAM VERSION USING TOSS MMU PAGING * IS OBTAINED BY SETTING MMUPAG EQU 1. * MMUPAG EQU 1 * DB IFT MMUPAG=0 DK2 TBUFL EQU 0 DK2 XIF DK2 * IFT MMUPAG=1 DK2 TBUFL EQU 650+X:X MMU BUFFER LENGTH DK XIF DK2 DE * * A PROGRAM VERSION USING THE EXTENDED INSTRUCTION * SET IS OBTAINED BY SETTING CPU852 EQU 0. * CPU852 EQU 0 * DEVIND EQU -2 DEVICE INDEX DATA COMMUNICATION BUFLEN EQU TBUFL+TBUFL MMU BUFFER SIZE * * * DWT DISPLACEMENTS * DWTDRD EQU /10 START OF DRIVER DEFINED PART * IFT MMUPAG=0 START EQU DWTDRD XIF * IFT MMUPAG=1 START EQU DWTDRD+4 XIF * DWTTP EQU START+/00 TIMER POINTER ORDER PROCESS DWTWQ EQU START+/02 WRITE/GET BUFFER QUEUE DWTSQ EQU START+/04 STATUS QUEUE DWTRQ EQU START+/06 RECEIVE QUEUE DWTBUF EQU START+/08 DEVICE BUFFER ADDRESS DWTCUR EQU START+/0A CURSOR ADDRESS DWTTIM EQU START+/0C REQUEST TIMER VALUE DWTINF EQU START+/0E DEVICE INFO, 1=LP DK5 * * * REQUEST HANDLING * * * * A7=ORDER * * /02: READ * /06: WRITE * /31: TRANSFER DWTINF DK5 * /33: READ MODIFIED RESPONSE * /37: TRANSFER PARAMETERS * /38: SET STATUS * /39: SET REQUEST TIMEOUT VALUE * * * CONSTANTS AND WORK AREAS * * DCONOF DATA 0 ON- / OFFLINESWITCH DCSTOL DATA 0 OLD DC EQUIPMENT STATUS DCSTCU DATA 0 CURRENT STATUS DCWRQ DATA 0 WRITE REQUEST QUEUE DCTPGP DATA 0 TIMER POINTER GENERAL POLL * * DC TASK ADDRESS BLOCK * DATA 0 INDICATES NO MMU BUFFER DATA DEVIND DEVICE INDEX DC15DC DATA DCACTD ACTIVATION ADDRESS DATA ABORT ABORT ROUTINE ADDRESS DATA DCRBUF REC. BUFFER ANCHOR * * DRIVER ADDRESS BLOCK * DATA BUFLEN MMU BUFFER SIZE DATA DEVIND DEVICE INDEX DC15AD DATA DCACT ACTIVATION ADDRESS DATA ABORT ABORT ROUTINE ABORT ROUTINE ADDRESS DATA DCRBUF REC. BUFFER ANCHOR * RES 15 SUBROUTINE STACK FOR INTERRUPTS STB RES 1 RES 1 AND FOR TRANSFER PARAM STB2 RES 1 IFT SPEED=1 LSPEED EQU /0200 XIF IFT SPEED=0 LSPEED EQU 0 XIF * * * ACTIVATION FROM TERMINAL TASKS * DCACT EQU * LDK A1,0 PRESET RETURN CODE IFT EM3270=1 =4 LDR A7,A7 =4 RF(Z) ANYMSG ANY MESSAGE ORDER =4 XIF SUK A7,/02 ABL(Z) DCRD READ SPECIFIC SUK A7,/06-/02 RF(Z) DCWR SUK A7,/31-/06 DK5 RF(Z) TRINF TRANSFER DWTINF DK5 SUK A7,/33-/31 DK7 RF(E) RESTRM RESPONSE TO READ MODIFIED SUK A7,/37-/33 DK5 RF(Z) DCTP TRANSFER PARAMETERS IFF STAT=0 SUK A7,/38-/37 ABL(Z) DCSS SET STATUS DK4 SUK A7,/39-/38 ABL(Z) REQTIM SET REQUEST TIMER XIF IFT STAT=0 SUK A7,/39-/37 RF(Z) REQTIM SET REQUEST TIMER XIF RF DCA100 * * * ACTIVATION FROM DCTASK * * DCACTD EQU * SUR A1,A1 PRESET RETURN CODE =4 IFT EM3270=1 =4 LDR A7,A7 =4 RF(Z) ANYMSG ANY MESSAGE ORDER =4 XIF SUK A7,/02 RF(E) DCRDDC READ SUK A7,/37-/02 RF(E) DCTP TRANSFER PARAMETERS DCA100 EQU * REQUEST ERROR ABL DISIOE INVALID ORDER * * * READ FROM DCTASK * * * REQUEST FROM DC-TASK * COMPLETE WHEN: * STATUS CHANGE ON DC EQUIPMENT * SPONTANOUS MESSAGE RECEPTION * DCRDDC EQU * CF A15,CKMESS CHECK IF MESSAGE RECEIVED DCRTN EQU * ABL TDISP GO TO DISPATCHER IFT EM3270=1 =4 ***************************************** * * ANY MESSAGE ORDER * ***************************** ANYMSG LD A4,DWTRQ,A6 ANY QUEUED MESSAGE ?? =4 RF(Z) DCRD10 NO!! =4 RF ENDIO YES!! COMPLETE REQUEST =4 XIF * * TRANSFER DWTINF DK5 * DK5 TRINF EQU * DK5 LD A2,ECBCW,A8 GET INFO DK5 ORS A2,DWTINF,A6 OR AND STORE DK5 RF ENDIO COMPLETE REQUEST DK5 * * RESPONSE TO READ MODIFIED * RESTRM EQU * DK7 LD A1,DWTINF,A6 WAS READ MODIFIED RECEIVED? DK7 ANKL A1,/0002 DK7 ABL(Z) DISIOE NO, REQUEST ERROR DK7 RF DCWR TREAT ALMOST AS WRITE REQUEST EJECT * DK5 * * TRANSFER PARAMETERS * * * REQUEST FROM DC-TASK: TRANSFER TERMINAL COMPUTER ADDRESS * FROM TERMINALS: TRANSFER TERMINAL ADDRESSES * * IFF CODE=1 DCTP LD A2,ECBCW,A8 GET PARAMETER XIF IFT CODE=1 DCTP LC A2,ECBCW,A8 GET TCS IF ANY ANK A2,/FF RF(Z) DCTP10 LC A2,TASCII,A2 TRANSLATE TO ASCII SLL A2,8 DCTP10 EQU * LC A3,ECBCW+1,A8 GET TCP OR DV ANK A3,/FF LC A2,TASCII,A3 TRANSLATE TO ASCII XIF ST A2,DWTBUF,A6 SAVE TERM. ADDR. DK4 DCTP12 EQU * LD A1,DCSTQ CHECK IF THIS DWT IS IN QUEUE DK4 DCTP14 EQU * RF(Z) DCTP18 NO, END OF/OR NO QUEUE DK4 LDR A3,A6 ADJUST ADDR. VALUE DK4 ADKL A3,DWTSQ DK4 CWR A1,A3 SOMETHING QUEUED OUR DWT? DK4 RF(E) DCTP16 YES, WAIT BEFORE TRANS. PARAM. DK4 LDR* A1,A1 NOT OURS, GET NEXT DK4 RB DCTP14 DK4 DCTP16 EQU * 831012 DK4 B LD A1,DCONOF POLL TIMEOUT? DK4 ANK A1,/40 DK4 RF(Z) DCTP17 NO POLL TIMEOUT DK4 * POLL TIMEOUT, REMOVE FROM STATUS QUEUE CF A15,REMOVS DK4 DCTP17 EQU * 831012 DK4 E LDR A1,A6 SAVE DWT AS PARAMETER DK4 CF A15,SETIME WAIT UNTIL STATUS IS SENT DK4 DATA TPTOUT,20 DELAY= 2 SECONDS DK4 RB DCRTN DK4 TPTOUT EQU * LDR A6,A1 RESTORE DWT DK4 RB DCTP12 LOOK IN THE QUEUE AGAIN DK4 DCTP18 EQU * LD A2,DWTBUF,A6 RESTORE TERM ADDR. DK4 STR A2,A6 SAVE IN FIRST WORD OF DWT IFT RCOM=1 ST A8,DWTBUF,A6 SAVE ECB FOR RD. MODIFIED DK6 XIF CWK A6,DW1500 DCTASK DWT ??? RF(E) DCTP30 YES!!! SHOULD NOT BE IN DC:TAB LD A1,DC:IN GET DC:TAB INPUT POINTER CWK A1,DC:END TABLE ALREADY FULL ???? ABL(E) DISIOE YES!! REQUEST ERROR DCTP20 EQU * LD A4,DCTAB DC:TAB ADDRESS =3 AD* A4,DCTAB LAST TABLE POS. =3 DCTP22 SUK A4,2 ADDR. TO NEXT ENTRY =3 CW A4,DCTAB ALL ENTRIES CHECKED?? =3 RF(E) DCTP25 YES.DWT NOT IN TABLE =3 CWR* A6,A4 IN TABLE ?? =3 RF(E) DCTP30 YES!! =3 RB DCTP22 CHECK NEXT ENTRY =3 DCTP25 EQU * =3 STR A6,A1 INSERT DWT IN DC:TAB LDK A1,2 ADS A1,DC:IN UPDATE DC:TAB IN POINTER ADS A1,DC:TAB INCREMENT DC:TAB LENGTH IFT STAT=1 LDK A1,4 DEVICE END ORS A1,DWTST,A6 CF A15,INSSQ INSERT IN STATUS QUEUE XIF DCTP30 EQU * SUR A1,A1 RETURN CODE ::= 0 ENDIO EQU * CF A15,TENDIO COMPLETE REQUEST RB DCRTN * * * WRITE * * * COMPLETE WHEN: * SUCCESFUL TRANSMISSION * TIME OUT * * DCWR EQU * IFT MMUPAG=1 LD A1,ECBRL,A8 REQUESTED LENGTH CWK A1,BUFLEN ILLEGAL LENGTH? RF(G) IL:LEN YES!! XIF CF A15,TIMEWR SET TIMER CF A15,INSWQ QUEUE REQUEST LD A1,DWTOR,A6 RESPONSE TO READ MODIFIED? DK7 ANK A1,/FF MASK ORDER DK7 CWK A1,/0033 READ-MOD. RESPONSE? DK7 ABL(E) SPOLLX YES TREAT AS SPECIFIC POLL DK7 RB DCRTN * * * * READ * * * COMPLETE WHEN: * MESSAGE RECEIVED * TIME OUT * * DCRD EQU * LD A8,DWTECB,A6 GET ECB LD A4,DWTRQ,A6 AND RECEIVE MESSAGE QUEUE RF(Z) DCRD10 NOTHING IN QUEUE LDR* A2,A4 TAKE THE FIRST IN QUEUE ST A2,DWTRQ,A6 ADK A4,6 LD A3,-4,A4 EFFECTIVE LENGTH ST A3,ECBEL,A8 LDK A1,0 RESET RETURN CODE CF A15,DC:MIN MOV DATA TO USER BUFFER ABL DCRTN DCRD10 CF A15,TIMERE START TIMER ABL DCRTN * * * SET STATUS * * IFF STAT=0 DCSS EQU * LD A1,ECBCW,A8 GET STATUS INFORMATION ANK A1,3 MASK DB,IR RF(Z) DCSS20 DEVICE END DCSS10 EQU * ST A1,DWTST,A6 RB DCTP30 COMPLETE REQUEST DCSS20 EQU * LD A1,DWTST,A6 ANK A1,9 RB(Z) DCSS10 WACK HAS NOT BEEN SENT DCSS30 EQU * CF A15,INSSQ INSERT DWT IN STATUS QUEUE LDK A1,4 SET DE RB DCSS10 XIF * * SET REQUEST TIMEOUT VALUE * * REQTIM EQU * LD A2,ECBCW,A8 TIMEOUT VALUE ST A2,DWTTIM,A6 SAVE IT IN DWT RB DCTP30 TENDIO & DISPATCH * * ILLEGAL APPLICATION BUFFER SIZE * IL:LEN LDKL A1,/8008 REQUEST ERROR + ILLEGAL LENGTH ABL DISEND COMPLETE REQUEST * * * * TIMER HANDLING PART * * * * READ TIMER=TIMERR * TIMERE EQU * LDR A1,A6 LD A2,DWTTIM,A6 GET REQUEST TIMEOUT VALUE RF(Z) TIME10 NO TIMING ST A2,TIMERR CF A15,SETIME DATA TOUTRE TIMERR DATA 0 ST A4,DWTTP,A6 STORE TIMER POINTER TIME10 EQU * RF GBUF10 RETURN * * TIMEOUT READ TIMER * TOUTRE EQU * LDR A6,A1 FETCH DWT CM DWTTP,A6 TOUTR1 EQU * LDK A1,/40 INDICATE TIME OUT TOUTR2 RB ENDIO COMPLETE REQUEST * * WRITE TIMER=TIMWR * TIMEWR LDR A1,A6 LD A2,DWTTIM,A6 GET REQUEST TIMEOUT VALUE RB(Z) TIME10 NO TIMING ST A2,TIMWR CF A15,SETIME DATA TOUTWR TIMWR DATA 0 ST A4,DWTTP,A6 RB TIME10 * * TIMEOUT WRITE TIMER * TOUTWR EQU * LDR A6,A1 FETCH DWT CM DWTTP,A6 CF A15,REMOVW REMOVE FROM WRITE QUEUE * * THIS INSTRUCTION DOES NOT BELONG * TO THE STANDARD INTERFACE LD A2,FDWTUT CWR A2,A6 RB(NE) TOUTR1 THIS DWT IS NOT WRITING CM XACK INDICATE 'ACK NOT EXPECTED' CM FDWTUT * * RB TOUTR1 * * * STOP REQUEST TIMING * * REMAINING TIME IS RETURNED IN A2 * * CTIME EQU * LD A2,DWTTP,A6 GET TIMER POINTER RF(Z) CTIM10 NOT RUNNING LDR* A2,A2 NGR A2,A2 GET REMAINING TIME CM* DWTTP,A6 STOP TIMER CM DWTTP,A6 CTIM10 EQU * RF GBUF10 * * GET RECEIVE BUFFER * * CALLING SEQUENCE: CF A15,GRBUF * A4=0 IF NO BUFFER IS FREE * ELSE A4 CONTAINS BUFFER ADDRESS * A2 AND A3 ARE DESTROYED * * GRBUF LDKL A2,DCRBUF RECEIVE BUFFERS GBUF INH LDR* A4,A2 RF(Z) GBUF10 NO BUFFER FREE LDR* A3,A4 REMOVE BUFFER FROM FREE CHAIN STR A3,A2 GBUF10 ADKL A15,4 ADJUST STACK POINTER ABR* A15 RETURN TO CALLER * * * INSERT DWT IN WRITE REQUEST QUEUE * * A2,A3,A4 DESTROYED * A6=DWT * INSWQ LDKL A2,DCWRQ GET QUEUE ANCHOR INSWQ1 LDK A4,DWTWQ INSWQ2 LDR* A3,A2 RF(Z) INSWQ3 END OF QUEUE FOUND LDR A2,A3 RB INSWQ2 INSWQ3 ADR A4,A6 STR A4,A2 INSERT IN QUEUE CMR A4 INDICATE END OF QUEUE RB GBUF10 RETURN * * * REMOVE DWT FROM WRITE REQUEST QUEUE * * A2,A3,A4 DESTROYED * A6=DWT * REMOVW LDKL A2,DCWRQ GET QUEUE ANCHOR REM05 LDK A4,DWTWQ GET DWT-LINK TO BE REMOVED REM06 EQU * ADR A4,A6 REM10 LDR* A3,A2 RB(Z) GBUF10 NOT ON QUEUE: RETURN CWR A3,A4 RF(E) REM15 LDR A2,A3 GET NEXT RB REM10 REM15 LDR* A3,A4 REMOVE STR A3,A2 RB GBUF10 RETURN * * * INSERT DWT IN STATUS QUEUE * IFF STAT=0 * A2,A3,A4 DESTROYED * A6=DWT * INSSQ EQU * LD A2,0,A6 GET TERMINAL ADDRESS DK4 ANK A2,/FF IF ADDRESS = 00 OR /7F DK4 RB(Z) GBUF10 DONT PUT IN STATUS DK4 LDR A4,A2 SET A4=A2 DK4 * EBCDIC /7F = ASCII /22 DK4 SUK A2,/22 QUEUE, TERMINAL HAS BEEN DK4 RB(Z) GBUF10 MADE INACTIVE DK4 SUK A4,/7F DK4 RB(Z) GBUF10 DK4 LDKL A2,DCSTQ GET QUEUE ANCHOR LDK A4,DWTSQ RB INSWQ2 * * * REMOVE DWT FROM STATUS QUEUE * * A2,A3,A4 DESTROYED * A6=DWT * REMOVS LDKL A2,DCSTQ GET QUEUE ANCHOR LDK A4,DWTSQ RB REM06 XIF * * * QUEUE ALLOCATED RECEIVE BUFFER * * A4=BUFFER ADDR * A2,A3 DESTROYED * QRBUF EQU * IFT MESPAS=1 LDKL A2,DW1500 QUEUE ON DC-TASK DWT XIF IFT MESPAS=0 LDR A2,A6 QUEUE ON TERMINAL DWT XIF ADK A2,DWTRQ BEGINNING OF RECEIVE QUEUE QR100 EQU * LDR* A3,A2 RF(Z) QR200 END OF QUEUE FOUND LDR A2,A3 RB QR100 QR200 STR A4,A2 INSERT INTO QUEUE CMR A4 INDICATE END OF QUEUE RTN A5 * * * CHECK IF UNEXPECTED MESSAGE OR STATUS CHANGE * * REGISTERS A1,A2,A3,A4,A6 AND A8 ARE DESTROYED * CKMESS LDKL A6,DW1500 LD A1,DWTST,A6 RF(N) CKM110 NO REQUEST LDK A1,2 READ REQUEST ? CW A1,DWTOR,A6 RF(NE) CKM110 NO LD A8,DWTECB,A6 ECB ADDR TO A8 LD A3,DWTRQ,A6 A3=ADDR TO READ QUEUE RF(Z) CKM200 NO READ IN QUEUE LDR* A2,A3 A2=ADDR TO NEXT READ BUFFER ST A2,DWTRQ,A6 STORE THIS ADDR INTO QUEUE ADK A3,6 MOVE POINTER TO TEXT DONT DESTROY BUFFER ADDRESS =6 LD A4,-4,A3 ST A4,ECBEL,A8 STORE NUMBERS OF CHARACTERS LD A4,-2,A3 ST A4,ECBCW,A8 STORE LINE DEVICE ADDRESS LDK A1,0 RESET RETURN CODE LDR A4,A3 RECEIVE BUFFER ADDRESS CF A15,DC:MIN MOVE DATA TO USER BUFFER CKM110 ADKL A15,4 ADJUST STACK POINTER ABR* A15 RETURN CKM200 LD A1,DCSTCU NO MESSAGE RECEIVED,CHECK STATUS OR A1,DCONOF TAKE CARE OF POLL TIME OUT CW A1,DCSTOL ST A1,DCSTOL RB(E) CKM110 NO CHANGE OF STATUS ORKL A1,/2000 INDICATE STATUS CHANGE CF A15,TENDIO COMPLETE READ GENERAL REQUEST RB CKM110 ************************************************************ * * ABORT ROUTINE * ************************ ABORT LD A1,DWTTP,A6 TIMER POINTER RF(Z) AB:10 NO TIMER RUNNING CM* DWTTP,A6 KILL TIMER CM DWTTP,A6 AB:10 LD A1,DWTOR,A6 ORDER CODE SUK A1,2 RF(Z) AB:RTN READ REQUEST. NO ACTION SUK A1,4 RF(NZ) AB:RTN NO ACTION IF NOT READ/WRITE CF A15,REMOVW REMOVE DWT FROM WRITE QUEUE LD A2,FDWTUT WRITING DWT ADDRESS CWR A2,A6 RF(NE) AB:RTN NOT THIS DWT CM XACK RESET ACK EXPECTED CM FDWTUT RESET WRITING DWT AB:RTN EQU * IFT CPU852=1 ADKL A15,4 ABR* A15 RETURN IN INHIBIT MODE XIF IFF CPU852=1 RTN A15 XIF * * * STORE REGISTER A3-A8 * CALLING SEQUENSE: CF A15,STREG * * RESTORE * CALLING SEQUENCE: CF A15,LDREG * * STREG ST A3,LCA3 ST A4,LCA4 ST A5,LCA5 ST A6,LCA6 ST A7,LCA7 ST A8,LCA8 RF RTNA15 RETURN LDREG LDKL A3,0 LCA3 EQU *-2 LDKL A4,0 LCA4 EQU *-2 LDKL A5,0 LCA5 EQU *-2 LDKL A6,0 LCA6 EQU *-2 LDKL A7,0 LCA7 EQU *-2 LDKL A8,0 LCA8 EQU *-2 RTNA15 EQU * ADKL A15,4 ABR* A15 * * * TIMER VALUES * * TIMPRO EQU 90 PROCEDURE TIMER 9 SEC DK TIMNAK EQU 3 DELAY FOR NAK DK * * * CHARACTER EQUATES * SF EQU X'1D' START FIELD CHARACTER SYN EQU /16 STX EQU /02 ETX EQU /03 ETB EQU /17 ITB EQU /1F SOH EQU /01 ENQ EQU /05 DLE EQU /10 EOT EQU /04 NAK EQU /15 ESC EQU /1B SBA EQU /11 GP EQU /22 RDBCOM EQU /32 RDMCOM EQU /36 IFT CODE=0 PAR EQU /80 RVI EQU /3C ACK0 EQU /30 ACK1 EQU /31 DC1 EQU /11 IFT MSV1=0 WACK EQU /3B XIF IFT CODE=0 IFT MSV1=1 WACK EQU /BF =WABT - SIEMENS MSV1 PROCEDURE XIF IFT CODE=1 PAR EQU /00 WACK EQU /2C RVI EQU XRVI DK ACK0 EQU /18 ACK1 EQU /2F SYNEBC EQU /32 XIF * * * PROCEDURE WORK AREAS * * FDWTIN RES 1 CURRENT DWT FOR RECEPTION FDWTUT RES 1 CURRENT DWT FOR TRANSMISSION XACK DATA 0 ACK EXPECTED XSEL DATA 0 SELECTED XETX DATA 0 ETX SENT XSTA DATA 0 STATUS SENT / MESSAGE INPUT RESULT XRB DATA 0 READ BUFFER SWITCH CACK DATA 0 ACK COUNTER SYNSW DATA 0 0=SKIP SYNS, 1=DON'T SKIP * FECB RES 1 WRITING ECB FECBBA RES 1 WRITING BUFFER ADDRESS FECBRL RES 1 WRITING BUFFER LENGTH FBAX DATA 0 BUFFER INDEX FBLST DATA 0 START OF LAST TRANSMITTED BLOCK DCSTQ DATA 0 STATUS QUEUE ANCHOR DCTPP DATA 0 POINTER FOR PROCEDURE TIMING RESEND DATA 0 CONTROL SEQUENCE SAVE AREA CRDBUF DATA 0 READ BUFFER COUNTER DK * * * 3270 SENSE/STATUS INFORMATION * * IFF STAT=0 SSTAB EQU * S/S 0 : NO STATUS,DB,DE,DB+DE * * DATA /4248 DATA /4242 * NOIR EQU /20 S/S 1 : NO INTERVENTION REQUIRED IR EQU /26 S/S 1 : INTERVENTION REQUIRED XIF * * * BASIC RECEIVE MODE * * ENTERED EVERY TIME A MESSAGE * IS EXPECTED FROM THE MASTER SIDE * * IFT P6805=1 BRMHLT CF A5,HALTIN HALT RECEIVER XIF BRM EQU * LDKL A5,STB LOAD STACKBASE IFT P6805=0 CF A5,HALTIN HALT RECEIVER AND UPDATE STATUS XIF IFT P6805=1 CF A15,CKMESS CHECK IF STATUS CHANGE XIF BRM010 EQU * IFT CODE+P6805=0 LDKL A2,/100+LSPEED+SYN SPECIFY SYN PATTERN XIF IFT P6805=0 IFT CODE=1 LDKL A2,/100+LSPEED+SYNEBC SPECIFY SYN PATTERN XIF IFT P6805=0 CIO A2,1,LCUIN START RECEIVER XIF IFT P6805=1 IFF CODE=1 LDK A2,/0C CIO A2,1,LCUIN START RECEIVER LDK A2,SYN OTR A2,1,LCUIN SPECIFY SYNC CHARACTER RB(NA) BRMHLT XIF IFT CODE+P6805=2 LDK A2,0 CIO A2,1,LCUIN START RECEIVER LDK A2,SYNEBC OTR A2,1,LCUIN SPECIFY SYNC CHARACTER RB(NA) BRMHLT XIF BRM100 EQU * CF A5,READP READ ONE CHARACTER RF(NZ) BRM150 PARITY ERROR LDR A1,A2 SUK A1,STX RF(Z) BRM300 STX RECEIVED SUK A1,EOT-STX RF(Z) BRM200 EOT RECEIVED SUK A1,ENQ-EOT ABL(Z) BRM400 ENQ RECEIVED SUK A1,DLE-ENQ ABL(Z) BRM600 DLE RECEIVED SUK A1,NAK-DLE ABL(Z) BRM500 NAK RECEIVED IFT MSV1=0 LDR A8,A2 CF A5,READP READ ONE CHARACTER RF(NZ) BRM150 PARITY ERROR CWR A2,A8 RF(NE) BRM150 INVALID ADDRESSING XIF LDK A3,0 CC A2,DW1500+1 RF(E) BRM110 POLLING LDK A3,2 CC A2,DW1500 RF(NE) BRM150 NOT THIS TCU BRM110 EQU * CF A5,READP READ 1:ST STA RF(NZ) BRM150 PARITY ERROR LDR A8,A2 IFT MSV1=0 CF A5,READP READ 2:ND STA RF(NZ) BRM150 PARITY ERROR CWR A2,A8 RF(NE) BRM150 INVALID ADDRESS SEQUENCE XIF CF A5,READ READ ONE CHARACTER IFT P6805=0 SUK A2,ENQ+PAR XIF IFT P6805=1 SUK A2,ENQ XIF RF(NZ) BRM150 NOT ENQ IFT P6805=0 CF A5,READ READ LAST CHARACTER * TRAILING PAD CAN BE CHECKED CIO A1,0,LCUIN HALT INPUT SST A1,LCUIN XIF IFT P6805=1 CF A5,HALTIN HALT INPUT RB(NZ) BRM010 PARITY ERROR XIF LDK A1,1 ST A1,CACK LOAD ACK COUNTER LDR A2,A8 SUK A3,2 RF(Z) BRM120 SELECTING CWK A8,GP ABL(E) GPOLL GENERAL POLL IFT MSV1=1 CF A5,FINTEP CHECK IF STA PRESENT (POLL ADDRESS) XIF IFT MSV1=0 CF A5,FINTER CHECK IF STA PRESENT XIF LDR A6,A3 LOAD DWT TO A6 ABL(NZ) SPOLL SPECIFIC POLL RB BRM INVALID POLL BRM120 EQU * CF A5,FINTER CHECK IF STA PRESENT LDR A6,A3 LOAD DWT TO A6 RF(NZ) BRM130 STA FOUND IFT MSV1=0 LDKL A6,DW1500 SELECT TO DCTASK BRM130 EQU * ABL SELECT XIF IFT MSV1=1 ABL BRM INVALID ADDRESS XIF * * WAIT FOR MARK HOLD TO RESYNCHRONIZE * BRM150 EQU * ANK A2,/7F SUK A2,/7F RB(Z) BRM RESYNCHRONIZE CF A5,READ READ ANOTHER CHARACTER RB BRM150 * * * EOT HAS BEEN RECEIVED * * BRM200 EQU * CF A5,HPTIM STOP PROCEDURE TIMER IFT RCOM=1 CM XRB RESET READ BUFFER XIF LD A1,XACK RF(Z) BRM220 ACK IS NOT EXPECTED LD A6,FDWTUT GET WRITING DWT RF(Z) BRM210 NO ONE WRITING LDK A1,2 SET RC=2 CF A5,CWRITE COMPLETE WRITE REQUEST BRM210 EQU * CM XACK RESET 'ACK EXPECTED' BRM220 EQU * CM XSEL RESET 'SELECTED' RB BRM * * * STX HAS BEEN RECEIVED * * BRM300 EQU * CF A5,HPTIM LD A1,XSEL RF(Z) BRM315 NOT SELECTED LD A1,DCRBUF RB(Z) BRM150 NO BUFFER AVAILABLE BRM305 EQU * CF A5,RDMESS READ MESSAGE SUK A7,1 RF(NZ) BRM320 MESSAGE OK BRM310 EQU * CM XSTA INDICATE 'INVALID MESSAGE' BRM312 EQU * CF A5,TRNAK SEND NAK ABL BRM BRM315 EQU * IFT RCOM=1 LD A1,XACK RF(Z) BRM316 ACK IS NOT EXPECTED LD A1,DCRBUF RF(Z) BRM316 NO BUFFER AVAILABLE LD A6,FDWTUT GET WRITING DWT ABL(Z) BRM150 NO ONE WRITING. RESYNCHRONIZE LDR* A2,A6 GET STA XIF IFT RCOM=1 CF A5,PRREC PREPARE FOR TEXT RECEPTION LD A1,DWTECB,A6 SAVE CURRENT ECB DK6 ST A1,DWTCUR,A6 DK6 LDK A1,0 SET RC=0 CF A5,CWRITE COMPLETE WRITE REQUEST CM CACK PRESET ACK-1 =7 RB BRM305 READ THE MESSAGE XIF BRM316 CF A5,READ READ ONE CHARACTER IFF P6805=1 =8 SUK A2,ENQ+PAR XIF =8 IFT P6805=1 =8 SUK A2,ENQ =8 XIF =8 RB(Z) BRM312 FORWARD ABORT SEQUENCE RB BRM220 BRM320 EQU * IM XSTA INDICATE MESSAGE OK LD A4,DCRBUF GET BUFFER ADDRESS ADK A4,6 CW A4,FBLST RF(NE) BRM325 NOT FIRST BLOCK IFF RCOM=0 LDK A1,ESC CCR A1,A4 RB(NE) BRM310 ESC NOT FOUND ADK A4,1 LCR A1,A4 GET COMMAND CODE SUK A4,1 SUK A1,RDBCOM RF(Z) RDBUF READ MODIFIED RECEIVED SUK A1,RDMCOM-RDBCOM RF(Z) RDMOD READ BUFFER RECEIVED XIF BRM325 EQU * SUK A7,1 RF(Z) BRM340 MESSAGE ENDED BY ETB CM FBAX CF A15,GRBUF ALLOCATE RECEIVE BUFFER ADK A4,6 LD A6,FDWTIN GET INPUT DWT * * PREPARE FOR CHAINED COMMAND * IFT RCOM=1 LDR* A2,A6 LC A2,TEBCDIC,A2 LD A1,DCRBUF RF(Z) BRM326 ST A2,+4,A1 XIF BRM326 EQU * CWK A6,DW1500 RF(E) BRM330 MESSAGE IS MENT FOR DCTASK LD A2,DWTST,A6 GET STATUS RF(N) BRM330 NO REQUEST IFT EM3270=1 =4 LD A2,DWTOR,A6 ORDER =4 RF(Z) BRM327 ANY MESSAGE ORDER =4 XIF =4 LDK A2,2 CW A2,DWTOR,A6 RF(NE) BRM330 NO READ REQUEST BRM327 EQU * LDK A1,0 SET RC=0 LD A8,DWTECB,A6 GET ECB ADDRESS LD A3,-4,A4 GET LENGTH ST A3,ECBEL,A8 STORE EFFECTIVE LENGTH CF A15,CTIME STOP REQUEST TIMING ST A2,ECBCW,A8 STORE REMAINING TIME * * * CHECK IF START PRINTER BIT SET IN CCC/WCC * * IFT STAT=1 LC A2,+2,A4 GET WCC/CCC ANK A2,/FF LC A2,TEBCDI,A2 TRANSLATE LD A3,DWTINF,A6 GET DWT INFO DK5 ANK A3,1 GET LPBIT DK5 RF(Z) BRM328 NOT LP DK5 ANK A2,8 RF(Z) BRM328 LD A2,DWTST,A6 GET STATUS ORK A2,/A SET WACK INDICATION ST A2,DWTST,A6 BRM328 EQU * XIF IFT EM3270=1 =4 LD A2,DWTOR,A6 ORDER =4 RF(NZ) BRM329 NOT ANY MESSAGE ORDER =4 SUK A4,6 ADJUST BUFFER ADDRESS =4 CF A5,QRBUF QUEUE MESSAGE ON DWT =4 RF BRM32A =4 XIF =4 BRM329 EQU * =4 LDK A1,0 RESET RETURN CODE CF A15,DC:MIN MOVE TO USER BUFFER RF BRM345 BRM32A EQU * =4 CF A15,TENDIO COMPLETE REQUEST RF BRM345 BRM330 EQU * IFT EM3270=1 =4 LD A1,DWTST,A6 STATUS =4 RF(N) BRM335 NO REQUEST =4 LD A1,DWTOR,A6 ORDER =4 RF(NZ) BRM335 NOT ANY MESSAGE ORDER =4 CF A15,TENDIO COMPLETE REQUEST =4 BRM335 EQU * =4 XIF =4 SUK A4,6 GET BUFFER BASE CF A5,QRBUF QUEUE BUFFER FOR DCTASK CF A15,CKMESS COMPLETE DCTASK READ IF ANY BRM340 EQU * CF A5,TRACK SEND ACK 0/1 ABL BRM BRM345 EQU * IFT STAT=1 LD A1,DWTINF,A6 READ-MOD. RECEIVED? DK7 ANKL A1,/0002 DK7 RF(NZ) BRM410 WAIT FOR RESPONSE FROM APPL. DK7 LD A1,DWTST,A6 ANK A1,8 RB(Z) BRM340 ACK SHOULD BE SENT CF A5,TRWACK SEND WACK RF BRM410 XIF IFF STAT=1 RB BRM340 XIF * * * READ MODIFIED OR READ BUFFER RECEIVED * * IFF RCOM=0 RDBUF EQU * READ BUFFER COMMAND RDMOD EQU * CM XSEL RESET SELECT EXPECTED LD A6,FDWTIN DWT-ADDRESS FOR ADDRESSED TERMINAL LDK A1,1 XRS A1,CACK INCREMENT ACK COUNTER DB LDK A1,/02 INDICATE READ-MOD. RECEIVED DK7 ORS A1,DWTINF,A6 DK7 LDKL A1,/4000 SET RETURN CODE =READ-MOD. DK7 RB BRM32A COMPLETE THE REQUEST DK7 XIF * * * ENQ HAS BEEN RECEIVED * * BRM400 EQU * CF A5,HPTIM STOP PROCEDURE TIMER LD A1,XACK RF(NZ) BRM510 RETRANSMISSION OF MESSAGE OR A1,XSEL RF(Z) BRM410 IN CONTROL STATE CF A5,TRREP REPEAT LAST CONTROL SEQUENCE BRM410 EQU * ABL BRM * * * NAK HAS BEEN RECEIVED * * BRM500 EQU * CF A5,HPTIM STOP PROCEDURE TIMER LD A1,XACK RF(NZ) BRM510 ACK EXPECTED OR A1,XSEL RB(Z) BRM410 IN CONTROL STATE RF BRM636 BRM510 EQU * DB LDK A1,0 CIO A1,0,LCUIN DK SST A1,LCUIN DK CF A15,STREG DK CF A15,SETIME DK DATA BRM520,TIMNAK DK ABL TDISP DK BRM520 EQU * DK CF A15,LDREG DK DE LD A6,FDWTUT GET WRITING DWT IFF STAT=0 LD A1,XSTA ABL(NZ) POL050 STATUS HAS BEEN TRANSMITTED XIF LD A1,FBLST GET START POINT FOR LAST BLOCK SU A1,FECBBA COMPUTE BUFFER INDEX ST A1,FBAX ABL POL130 * * * DLE HAS BEEN RECEIVED * * BRM600 EQU * CF A5,HPTIM STOP PROCEDURE TIMER LD A1,XACK RB(Z) BRM410 ACK NOT EXPECTED CF A5,READ READ SECOND CHARACTER IFF P6805=1 =8 CWK A2,ACK0+PAR XIF =8 IFT P6805=1 =8 CWK A2,ACK0 =8 XIF =8 RF(NE) BRM620 * * ACK , 0 RECEIVED * LD A1,CACK GET ACKCOUNTER RF(Z) BRM630 ACK,0 EXPECTED BRM610 EQU * CF A5,TRENQ SEND ENQ CF A5,SPTIM START PROCEDURE TIMER RB BRM410 BRM620 EQU * CWK A2,ACK1 RF(NE) BRM650 * * ACK , 1 RECEIVED * LD A1,CACK GET ACK COUNTER RB(Z) BRM610 ACK,1 NOT EXPECTED BRM630 EQU * LD A1,XETX RF(Z) BRM640 ETX NOT SENT * * ACK HAS BEEN RECEIVED TO AN ETX BLOCK * LDK A1,0 SET RC=0 BRM635 EQU * IFF STAT=0 LD A2,XSTA RF(NZ) BRM670 STATUS HAS BEEN TRANSMITTED XIF CF A5,CWRITE COMPLETE WRITE REQUEST BRM636 EQU * CF A5,TREOT SEND EOT IFT RCOM=1 CM XRB RESET READ BUFFER XIF RB BRM410 BRM640 EQU * LDK A1,1 XRS A1,CACK INCREMENT ACK COUNTER ABL POL130 BRM650 EQU * IFF P6805=1 =8 CWK A2,RVI+PAR XIF =8 IFT P6805=1 =8 CWK A2,RVI =8 XIF =8 RB(NE) BRM610 INVALID DLE SEQUENCE CM XACK RESET 'EXPECTING ACK' LD A1,XETX RF(NZ) BRM660 ETX HAS BEEN SENT LDK A1,2 SET RC=2 RB BRM635 BRM660 EQU * LDK A1,0 SET RC=0 RB BRM635 IFF STAT=0 * * * STATUS HAS BEEN TRANSMITTED * * BRM670 EQU * LD A6,FDWTUT GET DWT ADDRESS CF A15,REMOVS REMOVE FROM STATUS QUEUE CM XSTA CLEAR 'STATUS SENT' CM XACK CLEAR 'ACK EXPECTED' LD A1,DWTST,A6 GET STATUS ANK A1,4 RB(Z) BRM636 NOT DE LDKL A1,/8000 ANS A1,DWTST,A6 CLEAR STATUS RB BRM636 XIF * * * SELECT HAS BEEN RECEIVED * * SELECT EQU * LD A1,XACK =5 RF(NZ) POL010 ERROR. ACK EXPECTED =5 IFF STAT=0 LD A1,DWTST,A6 GET STATUS LDR A3,A1 ANK A1,1 RF(Z) SEL110 NO PENDING STATUS CF A5,TRRVI SEND RVI XIF IFF STAT=1 RF SEL110 XIF SEL100 EQU * ABL BRM SEL110 EQU * IFT STAT+NOWACK=1 ANK A3,8 RF(NZ) SEL115 BUSY XIF IFT STAT+NOWACK=2 ANK A3,8 RF(Z) SEL111 DEVICE NOT BUSY CF A5,TRWACK TRANSMIT WACK ABL BRM SEL111 EQU * XIF LD A1,DCRBUF RF(NZ) SEL120 BUFFER AVAILABLE SEL115 EQU * IFF STAT+NOWACK=2 CF A5,TRWACK SEND WACK XIF RB SEL100 SEL120 EQU * CF A5,PRREC PREPARE FOR TEXT RECEPTION CF A5,TRACK SEND ACK,0 RB SEL100 * * * PREPARE FOR TEXT RECEPTION * * PRREC EQU * IM XSEL SET 'SELECTED' CM FBAX RESET BUFFER INDEX IFT CODE=1 LC A2,TEBCDIC,A2 TRANSLATE STA TO EBCDIC XIF ST A2,+4,A1 SAVE STA IN BUFFER IM XSTA ST A6,FDWTIN STORE INPUT DWT RTN A5 * * * GENERAL POLL HAS BEEN RECEIVED * * GPOLL EQU * LD A1,XACK =5 RF(Z) POL020 ACK NOT EXPECTED =5 POL010 CF A5,TRENQ SEND ENQ =5 CF A5,SPTIM START PROCEDURE TIMER =5 ABL BRM WAIT FOR RESPONSE =5 POL020 EQU * =5 CF A5,CPTIM CHECK POLL TIMER IFF STAT=0 LD A6,DCSTQ RF(Z) POL110 NO STATUS TO BE SENT SUK A6,DWTSQ GET DWT ADDRESS POL050 EQU * CF A5,TRSTA SEND STATUS CF A5,SPTIM START PROCEDURE TIMER IM XACK SET 'ACK EXPECTED' XIF IFF STAT=1 RF POL110 XIF POL100 EQU * ABL BRM POL110 EQU * LD A6,DCWRQ RF(NZ) POL120 WRITE ON QUEUE POL115 EQU * CF A5,TREOT SEND EOT RB POL100 POL120 EQU * SUK A6,DWTWQ GET DWT ADDRESS POL125 EQU * LD A8,DWTECB,A6 GET ECB ADDRESS RF(NZ) POL126 CF A15,REMOVW RB POL115 POL126 EQU * ST A8,FECB SAVE ECB ADDRESS ST A6,FDWTUT SAVE A6 IFF MMUPAG=0 LDKL A4,MMUBUF MMU WORK BUFFER ST A4,ECBBA,A8 CF A15,DC:MOT MOVE DATA FROM USER BUFFER XIF LD A4,ECBBA,A8 GET BUFFER ADDRESS LD A3,ECBRL,A8 GET LENGTH POL127 EQU * ST A4,FECBBA SAVE BUFFER ADDRESS SUK A3,2 SKIP FIRST WORD OF BUFFER ST A3,FECBRL SAVE LENGTH CM FBAX RESET BUFFER INDEX POL130 EQU * CM XETX RESET 'ETX SENT' CM XSTA CF A5,TRTEXT SEND ONE BLOCK CF A5,SPTIM START PROCEDURE TIMER IM XACK SET 'ACK EXPECTED' RB POL100 EJECT * * PROCESS RESPONSE TO READ MODIFIED * SPOLLX EQU * DK7 LDK A1,/06 FAKE A WRITE REQUEST ST A1,DWTOR,A6 DK7 LDKL A1,/FFFF-/0002 CLEAR READ MODIFIED FLAG DK7 ANS A1,DWTINF,A6 LDKL A5,STB SET STACK BASE DK7 RF SPOLL PROCESS AS SPECIFIC POLL DK7 * * * SPECIFIC POLL HAS BEEN RECEIVED * * SPOLL EQU * IFF STAT+SPECP=0 LD A1,XACK =5 RB(NZ) POL010 ACK EXPECTED =5 LDR A7,A6 SAVE A6 CF A5,CPTIM CHECK POLLTIMER LDR A6,A7 RESTORE A6 IFT STAT=1 LD A1,DWTST,A6 GET STATUS ANK A1,7 RB(NZ) POL050 PENDING STATUS XIF IFF STAT+SPECP=0 LD A1,DWTST,A6 RB(N) POL115 NO REQUEST LD A1,DWTOR,A6 GET ORDER SUK A1,6 RB(Z) POL125 WRITE REQUEST SUK A1,2 RB(Z) POL125 EXCHANGE REQUEST XIF RB POL115 SEND EOT * * * CHECK IF THERE IS A WRITE REQUEST TO BE COMPLETED * * A1 CONTAINS RETURN CODE * * CWRITE LD A6,FDWTUT RF(Z) CWR900 NO WRITE GOING ON IFT RCOM=1 LD A2,XRB IF RCOM, SKIP IT DK6 RF(NZ) CWR900 DK6 XIF LD A2,DWTST,A6 RF(N) CWR900 NO REQUEST LD A2,DWTOR,A6 GET ORDER SUK A2,6 RF(Z) CWR100 WRITE REQUEST SUK A2,2 RF(NZ) CWR900 NOT EXCHANGE REQUEST LDR A1,A1 RF(NZ) CWR100 TRANSMISSION ERROR, RC NOT ZERO LDK A2,2 TRANMISSION OK ST A2,DWTOR,A6 INDICATE READ ORDER RF CWR150 CWR100 LD A8,FECB GET ECB ADDRESS CF A15,CTIME STOP TIMING LDR A8,A8 RF(Z) CWR150 ST A2,ECBCW,A8 CF A15,TENDIO COMPLETE REQUEST CWR150 EQU * CF A15,REMOVW REMOVE FROM WRITE QUEUE CWR200 EQU * CWR900 EQU * CM XACK RESET 'ACK EXPECTED' CM FDWTUT IFT RCOM=1 LD A2,XRB READ MODIFIED ? DK6 RF(Z) CWR910 DK6 LD A2,DWTCUR,A6 RESTORE ECB DK6 ST A2,DWTECB,A6 DK6 CWR910 EQU * DK6 XIF RTN A5 * * * READ ONE TEXT BLOCK * * ON EXIT A3 CONTAINS : * 0 : IF CORRECT ETX BLOCK RECEIVED * 1 : IF LRC OR PARITY ERROR , BUFFER OVERFLOW * 2 : IF CORRECT ETB BLOCK RECEIVED * RDMESS EQU * LD A4,DCRBUF GET BUFFER ADDRESS ADK A4,6 RESERVE HEADER LDK A3,0 LD A1,XSTA RF(NZ) RDM050 LAST INPUT WAS OK LD A1,FBLST COMPUTE NEW INDEX SUR A1,A4 ST A1,FBAX RDM050 EQU * AD A4,FBAX ADD BUFFER INDEX ST A4,FBLST REMEMBER START OF BLOCK RDM075 EQU * CM XSTA LDK A7,0 RESET LRC IFT IBMCHR=1 LD A1,FBAX RF(NZ) RDM100 NOT FIRST BLOCK CF A5,READP RF(NZ) RDM120 PARITY ERROR CWK A2,ESC RF(NE) RDM110 CF A5,READP SKIP NEXT TWO CHARACTERS CF A5,READP XIF RDM100 EQU * CF A5,READP READ ONE CHARACTER RF(NZ) RDM120 PARITY ERROR RDM110 EQU * CWK A2,ETX RF(E) RDM130 ETX RECEIVED CWK A2,ETB RF(E) RDM160 ETB RECEIVED CWK A2,ITB RF(E) RDM170 ITB RECEIVED CWK A2,ENQ RF(E) RDM120 SKIP IF ENQ EMBEDDED IN MESSAGE CWK A2,/FF RF(E) RDM140 MARK HOLD RECEIVED IFT CODE=0 IFT BINTRM=1 LDR A1,A2 SUK A1,DC1+3 RF(P) RDM115 NOT DC1-DC3 ADK A1,3 RF(N) RDM115 NOT DC1-DC3 SLL A1,6 LDR A8,A1 CF A5,READP 8-BIT CHAR GET NEXT PART RF(NZ) RDM120 PARITY ERROR SUK A2,/20 ASSEMBLE TO ONE CHARACTER ORR A2,A8 RDM115 EQU * XIF SCR A2,A4 STORE CHARACTER ADK A4,1 INCREMENT POINTER IM FBAX INCREMENT BUFFER INDEX LD A1,FBAX CWK A1,RBUFL+RBUFL RB(NG) RDM100 NOT OVERFLOW * * BUFFER OVERFLOW * RF RDM140 ABORT INPUT RDM120 EQU * LDK A3,1 INDICATE INVALID MESSAGE SUK A2,/7F RF(Z) RDM150 MARK HOLD RECEIVED RB RDM100 * * ETX RECEIVED * RDM130 EQU * LD A1,DCRBUF GET BUFFER ADDRESS LD A2,FBAX GET BUFFER INDEX ST A2,+2,A1 STORE EFFECTIVE LENGTH IN HEADER IFF CODE=1 CF A5,RDLRC RF(Z) RDM150 LRC WAS OK XIF IFT CODE=1 CF A5,RDCRC READ CRC AND CHECK IT RF(E) RDM150 CRC WAS OK XIF RDM140 EQU * LDK A3,1 INDICATE INVALID MESSAGE RDM150 EQU * LDR A7,A3 SAVE RESULT REGISTER CF A5,HALTIN HALT INPUT IFT P6805=1 ORR A7,A1 PARITY ERROR XIF RTN A5 * * ETB RECEIVED * RDM160 EQU * LDR A3,A3 RB(NZ) RDM130 ALREADY INVALID LDK A3,2 INDICATE CORRECT ETB RB RDM130 * * ITB RECEIVED * RDM170 EQU * IFF CODE=1 CF A5,RDLRC RB(NZ) RDM120 LRC WAS NOT OK XIF IFT CODE=1 CF A5,RDCRC READ CRC AND CHECK IT RB(NE) RDM120 CRC WAS NOT OK XIF RB RDM100 * * TRANSMIT ACK 0 OR 1 * TRACK LDK A2,1 LDK A3,ACK1 PRELOAD ACK1 XRS A2,CACK INCREMENT ACK COUNTER RF(NZ) TRDLE LDK A3,ACK0 LOAD ACK0 RF TRDLE * * TRANSMIT WACK * TRWACK LDK A3,WACK LOAD WACK RF TRDLE * * TRANSMIT RVI * IFF STAT=0 TRRVI LDK A3,RVI LOAD RVI XIF * * TRANSMIT DLE * TRDLE LDK A2,DLE LOAD DLE SC A2,RESEND PUT INSAVE AREA SC A3,RESEND+1 RF TRREP * * TRANSMIT NAK * TRNAK LDK A3,NAK LOAD NAK RF TREN10 * * TRANSMIT EOT * TREOT LDK A3,EOT LOAD EOT RF TREN10 * * TRANSMIT ENQ * TRENQ LDK A3,ENQ LOAD ENQ * TREN10 SC A3,RESEND PUT IN SAVE AREA LDK A2,/FF SC A2,RESEND+1 TRREP CF A5,TRSYNC START OUTPUT LC A2,RESEND GET FIRST CHARACTER CF A5,WRITEP SEND IT LC A2,RESEND+1 GET NEXT CHARACTER CF A5,WRITEP SEND IT TRRE10 LDK A2,/FF CF A5,WRIT05 SEND PAD LDK A2,/FF CF A5,WRIT05 LDK A2,0 CIO A2,0,LCUUT STOP TRANSMITTER IFT P6805=1 CF A5,READ WAIT FOR END XIF SST A2,LCUUT PERFORM SST AT ONCE IFF LOGG=0 CF A5,LOGSST LOG TRANSMITTER STATUS XIF RTN A5 * * * TRANSMIT ONE TEXT BLOCK * * TRTEXT EQU * CF A5,TRSYNC START OUTPUT IFT TSTREQ=1 * * * TEST REQUEST HANDLING * * LD A4,FBAX RF(NZ) TRT050 NOT START OF MESSAGE LD A1,XRB READ BUFFER COMMAND IN PROCESS ??? RF(NZ) TRT050 YES !! LD A4,FECBBA LC A3,+2,A4 GET AID CHARACTER SUK A3,/30 RF(NZ) TRT050 NOT TEST REQUEST LDK A2,SOH CF A5,WRITE SEND SOH LDK A7,0 RESET BCC LDK A2,'%' CF A5,WRITE SEND % LDK A2,'/' CF A5,WRITE SEND / LDK A2,STX CF A5,WRITE SEND STX ST A4,FBLST REMEMBER START OF BLOCK ADK A4,5 SKIP AID + CURSOR ADDRESS LDK A3,5 ADJUST LENGTH LDK A2,3 ST A2,FBAX RF TRT100 TRT050 EQU * * * * XIF LDK A2,STX CF A5,WRITE SEND STX LDK A7,0 RESET LRC LD A4,FECBBA GET BUFFER ADDRESS AD A4,FBAX ADD BUFFER INDEX ST A4,FBLST REMEMBER START OF BLOCK ADK A4,2 SKIP FIRST WORD OF BUFFER LDK A3,0 RESET CHARACTER COUNTER LD A1,FBAX GET BUFFER INDEX RF(NZ) TRT100 NOT FIRST BLOCK LC A2,DW1500+1 GET TCA CF A5,WRITEP SEND TCA LDR* A2,A6 GET STA CF A5,WRITEP SEND STA IFT IBMCHR=1 IFF RCOM=1 LDK A2,/27 SEND ENTER AS AID CF A5,WRITEP LDK A2,/20 AND CURSOR ADDRESS CF A5,WRITEP LDK A2,/20 CF A5,WRITEP XIF IFT RCOM=1 RF TRT070 DK6 ******************** LDK A2,X'2D' AID FOR DISPLAY TRT060 CF A5,WRITEP SEND AID LD* A3,DWTCUR,A6 CURSOR ADDRESS CF A5,LINCOL SEND LINE AND COLUMN NUMBER LDK A3,5 SET BLOCK COUNT RF TRT100 TRT070 EQU * XIF LDK A3,2 TRT100 EQU * LCR A2,A4 GET ONE CHARACTER ADK A4,1 INCREMENT POINTER ANK A2,/7F IFT RCOM=1 RF TRT105 DK6 ************************************************************ * * CHECK IF ATTRIBUTE CHARACTER OR NULL * *********************************************** CWK A2,X'20' ATTRIBUTE CHARACTER RF(L) TRT101 YES!!! XIF IFT DMRK=1 CWK A2,/7E LINE FEED ? RF(NE) TRT102 NO,GO TO TRT102 LDK A2,/0A TRT102 EQU * CWK A2,/7D END OF MESSAGE ? RF(NE) TRT103 NO,GO TO TRT103 LDK A2,/19 TRT103 EQU * CWK A2,X'7F' NULL ?? RF(NE) TRT105 SUK A2,1 XIF IFT RCOM=1 RF TRT105 TRT101 EQU * LDK A2,SF CF A5,WRITEP SEND START FIELD LC A2,-1,A4 GET ATTRIBUTE CHARACTER ANK A2,X'7F' LDR A1,A2 CONVERT TO IBM ATTRIBUTE ANK A1,1 ANK A2,/1E MASK SLL A2,1 ORR A2,A1 IBM ATTRIBUTE COMPOSED ORK A2,/40 BIT ALWAYS SET ONE LC A2,TASCII,A2 CWK A2,/18 CHECK SPECIAL ATTRIBUT RF(NE) TRT104 LDK A2,/30 TRT104 EQU * CF A5,WRITEP SEND ATTRIBUTE ADK A3,1 RF TRT110 TRT105 EQU * XIF CWK A2,/07 RF(L) TRT110 ILLEGAL CODE : SKIP IT CF A5,WRITEP SEND CHARACTER TRT110 EQU * IM FBAX INCREMENT BUFFER INDEX LD A1,FECBRL GET REQUESTED LENGTH CW A1,FBAX RF(NG) TRT130 END OF MESSAGE ADK A3,1 INCREMENT CHARACTER COUNTER CWK A3,TBLEN RB(L) TRT100 NOT FULL BLOCK IFT RCOM=1 LDK A1,SBA CHECK IF SBA AT END OF BLOCK CC A1,-2,A4 RF(E) TRT115 YES CC A1,-1,A4 RF(NE) TRT116 NO SEND ETB LCR A2,A4 GET FIRST BYTE AFTER SBA ADK A4,1 INREMENT POINTER CF A5,WRITEP SEND IT IM FBAX INCREMENT INDEX TRT115 LCR A2,A4 GET SECOND BYTE AFTER SBA CF A5,WRITEP SEND IT IM FBAX INCREMENT INDEX XIF TRT116 EQU * LDK A2,ETB LOAD ETB TRT120 EQU * CF A5,WRITEP SEND IT IFF CODE=1 LDR A2,A7 GET LRC CF A5,WRITEP SEND LRC XIF IFT CODE=1 LDR A8,A7 SAVE CURRENT CRC LDR A2,A7 ANK A2,/FF CF A5,WRIT05 SEND CRC BYTE 1 ECR A2,A8 ANK A2,/FF CF A5,WRIT05 SEND CRC BYTE 2 XIF ABL TRRE10 HALT OUTPUT TRT130 EQU * IM XETX INDICATE 'ETX SENT' TRT140 EQU * LDK A2,ETX LOAD ETX RB TRT120 SEND ETX AND LRC * * * TRANSMIT STATUS MESSAGE * * IFF STAT=0 TRSTA EQU * IM XSTA INDICATE 'STATUS SENT' ST A6,FDWTUT SAVE A6 CF A5,TRSYNC START OUTPUT LDK A2,SOH CF A5,WRITE SEND SOH LDK A7,0 REST LRC LDK A2,'%' CF A5,WRITEP SEND '%' LDK A2,'R' CF A5,WRITEP SEND 'R' LDK A2,STX CF A5,WRITE SEND STX LC A2,DW1500+1 CF A5,WRITEP SEND TCA LDR* A2,A6 CF A5,WRITEP SEND STA LD A1,DWTST,A6 GET STATUS ANK A1,/06 MASK FOR S/S 0 SRL A1,1 LC A2,SSTAB,A1 GET STATUS BYTE CF A5,WRITEP SEND S/S 0 LDK A2,NOIR PRELOAD S/S 1 LD A1,DWTST,A6 GET STATUS ANK A1,5 RF(Z) TRST10 NOT 'IR' ANK A1,4 RF(NZ) TRST10 NO IR IF DE LDK A2,IR TRST10 EQU * CF A5,WRITEP SEND S/S 1 RB TRT130 SEND ETX AND LRC XIF * * * TRANSMIT SYNC SEQUENCE * * TRSYNC EQU * LDK A2,0 CIO A2,0,LCUIN HALT INPUT IF NOT DONE SST A2,LCUIN PERFORM SST IFT P6805=0 CIO A2,1,LCUUT START TRANSMITTER XIF IFT P6805=1 IFT CODE=1 LDK A2,0 CIO A2,1,LCUUT START TRANSMITTER RF(A) TRS010 SST A1,LCUUT RF(A) TRS005 ABL BRM TRS005 CIO A2,1,LCUUT TRS010 EQU * LDK A2,SYNEBC OTR A2,1,LCUUT SPECIFY SYNC CHARACTER XIF IFT P6805=1 IFT CODE=0 LDK A2,/0C CIO A2,1,LCUUT RF(A) TRS010 SST A1,LCUUT RF(A) TRS005 ABL BRM TRS005 CIO A2,1,LCUUT TRS010 EQU * LDK A2,SYN OTR A2,1,LCUUT SPECIFY SYNC CHARACTER XIF CF A5,READ WAIT FOR OUTPUT INTERRUPT LDK A3,4 4 SYNS TRS100 LDK A2,SYN CF A5,WRITE SEND SYN SUK A3,1 RB(NZ) TRS100 RTN A5 * * * RECEIVER INTERRUPT * * IH1501 EQU * ST P,INTSAV IFT CPU852=1 CF A15,SAVE8 SAVE A1-A8 XIF IFF CPU852=1 MSR 8,A15 SAVE A1-A8 =1 XIF CF A15,LDREG RESTORE DC REGS A3 - A8 INR A2,0,LCUIN READ CHAR RF(NA) IHIN20 NOT ACCEPTED,CHECK STATUS IFF LOGG=0 CF A5,LOGIN LOG RECEIVED CHARACTER XIF IFF CODE=1 C2 SYNSW RF(NZ) IHLCI2 CWK A2,SYN SKIP SYNS RF(E) READ IHLCI2 XRR A7,A2 CALCULATE LRC XIF IFT CODE=1 C2 SYNSW RF(NZ) IHLCI1 DO NOT SKIP SYNCS IN BCC FRAME CWK A2,SYNEBC RF(E) READ SKIP EBCDIC SYN IHLCI1 EQU * CF A5,CRCCAL CALCULATE CRC LC A2,TASCII,A2 TRANSLATE TO ASCII XIF IHIN10 RTN A5 IFT P6805=0 IHIN20 CF A5,SST PERFORM SST ABL BRM XIF IFT P6805=1 IHIN20 RF SST PERFORM SST XIF * * * TRANSMITTER INTERRUPT * * IH1502 EQU * ST P,INTSAV IFT CPU852=1 CF A15,SAVE8 SAVE A1 - A8 XIF IFF CPU852=1 MSR 8,A15 SAVE A1-A8 =1 XIF CF A15,LDREG RESTORE DC REGS A3 - A8 RB IHIN10 * * * SST INSTRUCTION AND STATUS CHECK * * LCU STATUS : BIT 10=CARRIER OFF * BIT 13=PARITY ERROR (6805 ONLY) * BIT 14=THROUGHPUT ERROR * BIT 15=MODEM NOT READY * SST SST A1,LCUIN IFT P6805=1 RF(NA) SST200 ALREADY INACTIVE XIF LDR A2,A1 IFF LOGG=0 CF A5,LOGSST LOG SST INFORMATION XIF IFT P6805=0 ANK A2,2 RF(Z) SST100 XIF IFT P6805=1 ANK A2,6 RF(Z) SST100 ANK A2,2 RF(NZ) SST050 THROUGH PUT LDK A1,1 SET PARITY ERROR RF SSTRET XIF SST050 EQU * CM XSTA TROUHHPUT ERROR LDKL A5,STB ABL BRM010 SST100 EQU * ST A1,DCSTCU IFT P6805=0 CF A15,CKMESS CHECK IF STATUS CHANGE RTN A5 XIF IFT P6805=1 ANK A1,/21 RF(Z) SST200 LSALCUZ CF A15,SETIME LINE ERROR, WAIT 0.2 SECONDS DATA BRM RESTART DATA 2 WAIT TIME RF READ * SST200 LDK A1,0 SSTRET ADK A5,4 LDR A1,A1 SET CR ABR* A5 RETURN XIF * * * HALT INPUT * * HALTIN LDK A1,0 CIO A1,0,LCUIN IFT P6805=0 RB SST PERFORM SST INSTRUCTION AND STATUS CHECK XIF IFT P6805=1 RF READ WAIT FOR SST INTERRUPT XIF * * * WRITE FROM OR READ ONE CHARACTER TO A2 * * WRITE EQU * IFT CODE=1 ANK A2,/FF CWK A2,/FF RF(E) WRIT05 NO TRANSLATION OF TRAILING PAD LC A2,TEBCDIC,A2 TRANSLATE TO EBCDIC XIF WRIT05 EQU * OTR A2,0,LCUUT SEND CHARACTER RF(A) WRIT10 RF READ THROUGHPUT ERROR IFF CODE=1 WRIT10 XRR A7,A2 ACCUMULATE BCC XIF IFT CODE=1 WRIT10 CF A5,CRCCAL CALCULATE CRC XIF IFF LOGG=0 CF A5,LOGOUT LOG OUTPUT CHARACTER XIF * READ CF A15,STREG ABL TDISP * * *** WRITEP * * WRITE A2 WITH PARITY * * IFT CODE+P6805=0 WRITEP ANK A2,/FF ECR A1,A2 ORK A2,/80 WRI100 SLL A1,1 RB(P) WRI100 RB(Z) WRITE WRITE XRK A2,/80 RB WRI100 XIF IFF CODE+P6805=0 WRITEP RB WRITE XIF * * * *** READP * * READ CHARACTER TO A2 AND CHECK PARITY * * READP CF A5,READ IFT CODE+P6805=0 ECR A1,A2 RE100 SLL A1,1 RF(Z) RE110 RB(NN) RE100 XRK A2,/80 RB RE100 RE110 LDR A1,A2 ANK A2,/7F XIF IFF CODE+P6805=0 LDK A1,/80 XIF ADK A5,4 ANK A1,/80 XRK A1,/80 ABR* A5 * * * * FIND DWT CONTAINING SUBTERMINAL ADDRESS AS GIVEN IN A2 * * CALLING SEQUENCE: CF A5,FINTER * A2=SUBTERMINAL ADDRESS * A4 DESTROYED * A3#0: DWT TO FOUND TERMINAL * * NOTE: FOR SIEMENS MSV1 - SEPARATE SELECT AND POLL ADDRESSES * ENTRY: FINTER - CHECK SELECT ADDRESS * FINTEP - CHECK SPECIFIC POLL ADDRESS * RBYTE DATA 0 IF 1 COMPARE WITH RIGTH BYTE * * FINTEP EQU * IFT MSV1=0 FINTER EQU * XIF IM RBYTE IFT MSV1=1 FINTER EQU * XIF LD A4,DCTAB GET ADDRESS TO DC:TAB AD* A4,DCTAB ADDRESS TO END OF DC:TAB FINT10 SUK A4,2 LDK A3,0 DEFAULT VALUE CW A4,DCTAB END OF TABLE RF(E) FINT20 SUBTERMINAL NOT FOUND LDR* A3,A4 LOAD DWT ADDRESS IFT MSV1=1 AD A3,RBYTE CHOOSE ADDRESS TYPE CCR A2,A3 COMPARE SUBTERMINAL ADDRESS XIF IFT MSV1=0 CC A2,1,A3 COMPARE TO SUBTERMINAL ADDRESS XIF RB(NE) FINT10 TAKE NEXT TERMINAL FINT20 CM RBYTE ANKL A3,/FFFE RTN A5 * * * POWER ON FUNCTIONS * * DC15ON EQU * IFT CPU852=1 CF A15,SAVE8 SAVE A1-A8 XIF IFF CPU852=1 MSR 8,A15 SAVE A1-A8 =1 XIF IFT STAT=1 LDK A5,4 SET DEVICE END LD A1,DCTAB AD* A1,DCTAB GET ADDRESS TO END OF TABLE DRDC05 SUK A1,2 CW A1,DCTAB RF(E) DRDC06 END OF TABLE LDR* A6,A1 GET DWT ADDRESS ORS A5,DWTST,A6 STORE DEVICE END FOR DEVICE CF A15,INSSQ INSERT IN STATUS QUEUE RB DRDC05 DRDC06 EQU * XIF LDK A2,/40 ORS A2,DCONOF CF A15,CKMESS LD A2,DCTPGP GET POLL TIMER POINTER RF(NZ) DRDC20 ALREADY STARTED DRDC10 CF A15,SPOTIM START POLL TIMER DRDC20 ABL BRM * * POLL TIME OUT * PTOUT LDKL A5,STB LOAD A5 STACK BASE LDK A2,/40 ST A2,DCONOF INDICATE POLL TIME OUT CF A15,CKMESS CHECK IF STATUS CHANGE CF A15,SPOTIM START POLL TIMER ABL TDISP * * RESTART POLL TIMER WHEN POLL HAS BEEN RECEIVED * CPTIM CM DCONOF INDICATE POLLING LDKL A2,-TIMPOL ST* A2,DCTPGP RESTART TIMER CF A15,CKMESS CHECK IF STATUS CHANGE RTN A5 * * START POLL TIMER * SPOTIM CF A15,SETIME START TIMER DATA PTOUT,TIMPOL ST A4,DCTPGP STORE TIMER POINTER ADKL A15,4 ABR* A15 * * START PROCEDURE TIMER * SPTIM EQU * LDR A1,A6 LOAD DWT AS PARAMETER CF A15,SETIME DATA PRTOUT,TIMPRO ST A4,DCTPP SAVE TIMER POINTER RTN A5 * * PROCEDURE TIMEOUT * PRTOUT CM DCTPP LDR A6,A1 RELOAD A6 LDKL A5,STB LOAD STACK BASE CF A5,HALTIN HALT INPUT IF OPEN LD A1,XACK RF(Z) PRT10 ACK NOT EXPECTED CF A5,TRENQ SEND ENQ CF A5,SPTIM START PROCEDURE TIMER PRT10 ABL BRM * * STOP PROCEDURE TIMER * HPTIM LD A1,DCTPP GET TIMER POINTER RF(Z) HPT10 NOT RUNNING CM* DCTPP STOP TIMER CM DCTPP HPT10 RTN A5 IFT CODE=1 * * * CALCULATION OF CRC * * A2 = CHARACTER * A7 = ACCUMULATED CRC * * CRCCAL EQU * ST A1,CRCSAV ST A2,CRCSAV+2 ST A3,CRCSAV+4 LDK A1,8 CRC100 LDR A3,A7 SRL A7,1 XRR A3,A2 SRL A2,1 ANK A3,1 RF(Z) CRC110 XRKL A7,/A001 CRC110 SUK A1,1 RB(NZ) CRC100 LD A1,CRCSAV LD A2,CRCSAV+2 LD A3,CRCSAV+4 RTN A5 CRCSAV RES 3 * * * READ CRC CHARACTERS AND CHECK THEM * CR = (E) IF CRC WAS OK * * RDCRC LDR A6,A7 SAVE CURRENT CRC IM SYNSW DO NOT SKIP SYNCS NOW CF A5,READ READ BYTE 1 LD A8,CRCSAV+2 SAVE IT CF A5,READ READ BYTE 2 CM SYNSW SYNCS CAN BE SKIPPED AGAIN LD A2,CRCSAV+2 SAVE IT SLL A2,8 XRR A2,A8 ADK A5,4 CWR A2,A6 COMPARE RECEIVED WITH COMPUTED ABR* A5 XIF IFT CODE=0 * * RDLRC READ LRC CHARACTER * CR=0 IF LRC OK * RDLRC IM SYNSW CF A5,READP ADK A5,4 LDR A1,A1 RF(NZ) LRCEND ANK A7,/7F LRCEND EQU * CM SYNSW ABR* A5 XIF * * * DEVICE WORK TABLE FOR DCTASK * * DW1500 EQU * TABLE ENTRY DATA 0 CU LINE ADDRESS DATA /8000 STATUS DATA 0 ECB ADDRESS DATA 0 ORDER DATA DC15DC POINTER TO ADDRESS BLOCK DATA 0 TTAB ADDRESS DATA 0 WAIT/ACTIVATE INDICATOR DATA 0 TASK QUEUE * IFT MMUPAG=1 DATA 0 USER ECB ADDRESS DATA DC:ECB MMU ECB ADDRESS XIF * DATA 0 TIMER POINTER DATA 0 WRITE QUEUE OR BUFFER QUEUE DATA 0 STATUS QUEUE (NOT USED BY DC-TASK) DATA 0 RECEIVE MESSAGE QUEUE DATA 0 SIMULATED DEVICE BUFFER ADDRESS DATA 0 CURSOR ADDRESS DATA 0 REQUEST TIMEOUT VALUE DATA 0 EXTRA DEVICE INFO DK5 * IFT MMUPAG=1 DC:ECB EQU * MMU ECB DATA 0,0,0,0,0,0 XIF * * * * DC RECEIVE BUFFER POOL * RLINK EQU RBUFL+RBUFL+8 * DCRBUF EQU * DATA *+2 FREE BUFFER ANCHOR IFF RBUFNR=1 DK3 IFF RBUFNR=2 DATA *+RLINK RES RBUFL+3 IFF RBUFNR=3 DATA *+RLINK RES RBUFL+3 IFF RBUFNR=4 DATA *+RLINK RES RBUFL+3 XIF IFF RBUFNR=1 DK3 DATA *+RLINK RES RBUFL+3 XIF DK3 DATA 0 END OF CHAIN RES RBUFL+3 IFF MMUPAG=0 MMUBUF RES TBUFL+1 MMU WORK BUFFER XIF * * * INTERRUPT LOGGING ROUTINE * * IFF LOGG=0 LOGSST ST A2,SAVE2 ORKL A2,/F000 RF LOG10 LOGOUT ST A2,SAVE2 ORKL A2,/0F00 RF LOG10 LOGIN CWK A2,/FF RF(E) LOGE10 ST A2,SAVE2 LOG10 ST A3,SAVE3 LD A3,LOGPNT STR A2,A3 ADK A3,2 CWK A3,LOGEND RF(L) LOGEXI LDKL A3,LOGSTA LOGEXI ST A3,LOGPNT LD A2,SAVE2 LD A3,SAVE3 LOGE10 RTN A5 * * LOGPNT DATA LOGSTA LOGSTA EQU * RES 300 LOGEND EQU *-4 SAVE2 DATA 0 SAVE3 DATA 0 XIF * * * IFT RCOM=1 ******************************************************* * * L I N C O L * * CONVERT CURSOR ADDRESS TO LINE AND COLUMN NUMBER * ********************************************************** LINCOL EQU * LDR A2,A3 COPY CURSOR ADDRESS SRL A2,6 ANK A2,X'3F' LC A2,LICO:T,A2 ASCII LINE NUMBER CF A5,WRITEP SEND LINE NUMBER LDR A2,A3 ANK A2,X'3F' LC A2,LICO:T,A2 ASCII COLUMN NUMBER CF A5,WRITEP SEND COLUMN NUMBER RTN A5 RETURN * * * * SCANDINAVIAN ALPHABET DB LICO:T EQU * DATA /2041,/4243,/4445,/4647 /00-/07 DATA /4849,/232E,/3C28,/2B21 /08-/0F DATA /264A,/4B4C,/4D4E,/4F50 /10-/17 DATA /5152,/245D,/2A29,/3B5E /18-/1F DATA /2D2F,/5354,/5556,/5758 /20-/27 DATA /595A,/402C,/255F,/3E3F /28-/2F DATA /3031,/3233,/3435,/3637 /30-37 DATA /3839,/3A5B,/5C27,/3D22 /38-3F DE XIF DC:IN DATA DC:TAB+2 DCTAB DATA DC:TAB DC:TAB DATA 2 LENGTH OF DC:TAB DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 DC:END EQU * * * END