|
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: 42932 (0xa7b4)
Notes: pts_type(SC)
Names: »PRINT2.SC«
└─⟦7a1dcd5a9⟧ Bits:30009673 Philips computer tape "600134"
└─⟦this⟧ »PT3272/PRINT2.SC«
IDENT PRINT2 REL 11.1 84-01-05 DK 870150541110 DK43, DANISH CHARS. FOR 6883 PRINTER DK42, INTERVENTION REQUIRED STATUS DK41, TIME-OUT IN PRLINE EXTENDED DK40, LP100 OR LINE PRINTER DK39,MAIN NOT CLEARED...2 LINES =DK38,LF ON END MESS. =37 DUP OR FM CHAR ON PRINTER =36 IMPROVEMENT OF =24 82-06-28 =35 IMPROVEMENT OF =24 =32 MISSING PRINTING AFTER PRINTER ERROR =31 PAPER OUT ON COPY80 (SUM) 82-06-21 =30 IMPROVEMENT OF =5 =27 NO STATUS CHECK AFTER ABORT =26 LONG SNA CH STRING =25 LEFT MARGIN FOR PRINTER 82-05-12 =24 BASIC WRITE ON PRINTER 82-04-28 =23 PRINTER RETURN CODE =19 ERRONEOUS PRINTER STATUS =18 DOUBLE SETTIM ENTRIES =17 TWO DC LINES 82-04-16 =15 CORRECTION OF =7 FOR SNA 82-02-12 =7 TEST PRINTER BEFORE CONNECT =6 SET PRINTER STATUS =5 DIFFERENT FF CH FOR GP74 82-01-26 =4 NATIONAL CHAR 81-11-20 =3 SPACE SUPRESSION 81-05-12 =2 NEW LABEL 81-04-08 =1, EOC ON FIRST READ 81-01-26 ******************************************************************* * * * MODULE PRINT : * MODULE HANDLING THE PRINTOUTS BOTH FROM * * DISPLAY AND MAIN-FRAME * * (EMULATION 3270 SNA/SDLC, BSC * * * ******************************************************************* EJECT ******************************************************** * * LIST OF ROUTINES * * PRINT MAIN ROUTINE * IOACT ACTIVATE IN CURRENT MODE * IOCPL COMPLETE IN CURRENT MODE * DCPINP DC PRINTER INPUT * ICPINP INTERTASK INPUT * ICPRED INTERTASK READ * ICPWRT INTERTASK WRITE * ICABOR INTERTASK ABORT * COPP COPY SCREEN BUFFER TO PRINTER * TABLE OF PRINTERORDERS * NL NEW LINE * FFDUM SIMULATED FORM FEED * FFVAL FORM FEED * CR CARRIAGE RETURN * EM END MESSAGE * INVAL INVALID PRINTER ORDER * FFCHK CHECK IF FF IS VALID * PRLINE PRINT LINE * INIT INIT ROUTINE * TSTPRT TEST HARDWARE * GETTAB GET ORDER INDEX * *********************************************************** EJECT ******************************************************************* * * * ENTRY POINTS * * * ******************************************************************* ENTRY PRINT START LABEL FROM DATA DIVISION (CREDIT) ENTRY COPP COPY SCREEN BUFFER TO PRINTER =2 ******************************************************************* * * * EXTERNAL REFERENCES * * * ******************************************************************* EXTRN COMINI COMMON INITIATE ROUTINE (DSPSNA) EXTRN OPINIT OPEN CONNECTION INITIATE (DCSNA9 EXTRN OPSYS OPEN SYSTEM (DCSNA) EXTRN OPEN OPEN (DCBSC) EXTRN CONCT CONNECT PASSIVE (DCBSC) EXTRN SETTYM SET REQUEST TIMER (DCBSC) =18 EXTRN ATMASB SEARCH ATTRIBUTE BACKWARDS EXTRN TSTMES TEST MESSAGE (DCSNA) EXTRN READW READ WITH WAIT (DCSNA) EXTRN READNW READ WITH NO WAIT (DCSNA) EXTRN GETBUF GET BUFFER (PAD) EXTRN RELBUF RELEASE BUFFER (PAD) EXTRN UNPACK UNPACK DC BUFFER (PAD) EXTRN ECBINI INIT IF ECB:S (DSPSNA) EXTRN ICSET SET INTERTASK TIMEOUT (KEYB) EXTRN ICWRT INTERTASK WRITE (KEYB) EXTRN ICREAD INTERTASK READ (KEYB) EXTRN SETSTA SET STATUS (DCBSC) EXTRN CONNAT TRANSFORM OF NAT CHAR =4 EXTRN RFMDUP REPLACE FM OR DUP CHAR =37 EJECT *************************************************************** * * * CONDITIONAL ASSEMBLY * * * *************************************************************** X:A EQU 0 SNA HANDLING IF:=1 SNA EQU X:A X:D EQU 1 NUMBER OF DC LINES (1-2) NBRLIN EQU 2 X:O EQU 0 TEST MODE IF:=1 TEST EQU X:O X:R EQU 0 TRANSFORM OF NAT.CHAR IF:=1 =4 TRANAT EQU X:R . =4 * BASWRI EQU 1 BASIC WRITE ON PRINTER =24 SCS EQU 0 SIMPLE SNA CH STRING HANDLING =26 LMARG EQU 0 LEFT MARGIN FOR PRINTER =25 P6883 EQU 1 6883 PRINTER DK43 EJECT ******************************************************************* * * * DECLARATIONS OF DATA AND EQUATES * * ******************************************************************* * * TABLE OF PRINTER TYPES * PRTTAB EQU * DATA /0004 NUMBER OF PRINTERTYPES DATA 'TT',0 GTP DATA 'LL',2 LINE PRINTER DATA 'GG',4 GP 74 DATA 'CC',6 COPY 80 * * DEFAULT VALUES FOR DIFF. PRINTERS * BYTE1= NUMBER OF LINES/PAGE * BYTE2= NUMBER OF CHAR./LINE * PRTLEN DATA /2382 GTP DATA /2382 LP DATA /2382 GP 74 DATA /2382 COPY 80 IFF LMARG=0 . =25 LMARGT EQU * NO. OF POSITIONS IN LEFT MARGIN =25 DATA 0 GTP =25 DATA 0 LP =25 DATA 3 GP74 =25 DATA 0 COPY80 =25 XIF . =25 * =24 IFF BASWRI=1 . =36 PRBFL EQU 132 PRINTER BUFFER LENGTH =24 =BUFL-2 (IN DATXXX) =24 XIF . =36 IFT BASWRI=1 . =36 PRBFL EQU 256 PRINTER BUFFER LENGTH =36 =BUFL IN DATXXX =36 XIF . =36 * * LINE LENGTHS FROM WCC * LINLEN DATA /0028,/4050 40, 64 AND 80 CHAR/LINE * * EQUATES FOR ECB HANDLING * ECBBA EQU 2 BUFFER ADDRESS ECBRL EQU 4 REQUESTED LENGTH ECBEL EQU 6 EFFECTIVE LENGTH ECBRC EQU 8 RETURN CODE ECBCW EQU 10 CONTROL WORD * * PRINTER MODES * LOCAL EQU 0 LOCAL MODE SHARED EQU 2 SHARED MODE * * PRINTER STATUS IN PRTMOD * PRTERR EQU /4000 PRINTER ERROR * * COPY INTERNAL STATUS IN A10 * NXTCHA EQU /8000 GET NEXT CHAR. ENDPRT EQU /4000 END PRINTING NTONLY EQU /2000 NOT ONLY SPACES CRREC EQU /1000 CR RECEIVED FFCCH EQU /0800 FF CCH IND. =36 NOEMLF EQU /0400 NO EXTRA LINE FEED(EM) DK38 * * RELATIVE POS. IN ECB-BLOCK * IC EQU 2 INTERTASK * * SCREEN SIZE * LBVDU EQU 1920 * * RECEIVE STATUS * LICREC EQU /2000 . =1 * * LOCAL EQUATES * SO EQU /0E 'SHIFT OUT' SI EQU /0F 'SHIFT IN' EJECT * * RELATIVE ADDRESSES IN * TERMINAL WORKBLOCK * BVDU EQU 2 SCREEN BUFFER WCC EQU BVDU+1950 WCC LINCNT EQU WCC+4 LINE COUNTER DCLENG EQU LINCNT+2 LENGTH OF RECEIVED BUFFER PRTID EQU DCLENG+6 PRINTER TASKID PRTTYP EQU PRTID+2 PRINTER TYPE MAIN EQU PRTTYP+4 WHAT DC LINE ECBBLK EQU MAIN+6 ECB BLOCK BUFPNT EQU ECBBLK+14 BUFFER POINTER REGI EQU BUFPNT+2 SAVE AREA PRTMOD EQU REGI+32 PRINTER MODE ECBPRT EQU PRTMOD+4 PRINTER ECB ECBICR EQU ECBPRT+6 INTERTASK READ ECB ECBICW EQU ECBICR+2 INTERTASK WRITE ECB ECBDC EQU ECBICW+2 ECB DC ECBDC1 EQU ECBDC ECB DC LINE 1 ECBDC2 EQU ECBDC1+2 ECB DC LINE 2 IFF SNA=1 . =24 PRCCCT EQU ECBDC2+2 CHARACTER COUNTER =24 XIF . =24 IFT SNA=1 . =24 PRCCCT EQU ECBDC+14 CHARACTER COUNTER =24 XIF . =24 PRBA EQU PRCCCT+2 PRINTER BUFFER ADDRESS =24 PRLMAR EQU PRBA+2 NO. OF POS IN LEFT MARGIN =25 * * RELATIVE ADDRESSES IN * COMMON WORKBLOCK * IFF TEST=1 TSKTAB EQU 26 DEVICE TABLE =17 XIF IFT TEST=1 TSKTAB EQU 221 . =17 XIF EJECT ******************************************************************* * * * PRINT MAIN ROUTINE PRINTER * * * ******************************************************************* PRINT EQU * CF A14,INIT INIT ROUTINE IFF SNA=1 . =15 XIF . =15 IFT SNA=1 CF A14,OPINIT OPEN CONNECTION INITIATE RF(N) PRI100 DC NOT PRESENT CF A14,OPSYS OPEN SYSTEM XIF IFF SNA=1 CF A14,OPEN OPEN RF(N) PRI100 NO DC INVOLVED LDKL A8,20 LKM DATA 6 CF A14,TSTPRT GET PRINTER STATUS DK42 CF A14,CONCT CONNECT PASSIVE IFT NBRLIN=2 . =17 LDK A1,1 CONNECT FOR SECOND LINE =17 XRS A1,MAIN,A11 . =17 CF A14,CONCT . =17 LDK A1,1 . =17 XRS A1,MAIN,A11 INDICATE FIRST LINE AGAIN =17 XIF . =17 IFF SNA=1 . =17 CF A14,SETTYM SET REQUEST TIMEOUT =18 XIF LDK A1,SHARED ALWAYS SHARED IN BSC ST A1,PRTMOD,A11 LDK A4,0 CLEAR A4 DK42 LD A2,PRTID,A11 GET CURRENT STATUS DK42 ANK A2,/FF SUK A2,/30 SLL A2,2 LD A3,+6,A13 LDK A1,TSKTAB ADR A3,A1 ADR A3,A2 LC A4,+3,A3 STATUS TO A4 DK42 RF(Z) PRI200 WAS OPERABLE, GO ON DK42 PRI100 EQU * CF A14,TSTPRT TEST HARDWARE ANK A4,/1 OPERABLE? DK42 RF(NZ) PRI150 NO, WAIT AWHILE DK42 LD* A1,ECBDC,A11 ERROR DURING DC PRINTING? RF(NN) PRI200 NO, SKIP STATUS LDK A1,0 SET STATUS = DEVICE END DK42 CF A14,SETSTA DK42 IFT NBRLIN=2 LDK A1,1 STATUS TO SECOND LINE DK42 XRS A1,MAIN,A11 DK42 LDK A1,0 . DK42 CF A14,SETSTA . DK42 LDK A1,1 RESET TO LINE ONE DK42 XRS A1,MAIN,A11 . DK42 XIF RF PRI200 CONTINUE DK42 PRI150 EQU * LDKL A8,50 WAIT 5 SECONDS DK42 LKM DATA 6 RB PRI100 DK42 PRI200 EQU * CF A14,IOACT ACTIVATE IN CURRENT MODE LDKL A7,ECBBLK ADR A7,A11 LKM DATA 7 MULTIPLE WAIT CF A14,IOCPL COMPLET IN CURRENT MODE LD A1,PRTMOD,A11 ANKL A1,PRTERR PRINTER ERROR? RB(Z) PRI200 NO XRS A1,PRTMOD,A11 RB PRI100 TRY TO FIX IT EJECT ********************************************************************* * * * IOACT ACTIVATE IN CURRENT MODE * * ********************************************************************* IOACT EQU * LDK A4,0 LD A1,PRTMOD,A11 SHARED OR LOCAL? RF(Z) IOAC20 LOCAL ADK A4,1 ADD NUMBER OF WAITS LD A2,ECBBLK+4,A11 REQUEST OUTSTANDING ALREADY? RF(NZ) IOAC10 YES CM MAIN,A11 INDICATE LINE 1 CF A14,TSTMES TEST MESSAGE ST A8,ECBBLK+4,A11 IOAC10 EQU * IFT NBRLIN=2 ADK A4,1 ADD MORE WAITS LD A2,ECBBLK+6,A11 ALREADY? RF(NZ) IOAC20 YES IM MAIN,A11 INDICATE LINE 2 CF A14,TSTMES TEST MESSAGE ST A8,ECBBLK+6,A11 XIF IOAC20 EQU * ADK A4,1 LD A2,ECBBLK+2,A11 ALREADY? RF(NZ) IOAC30 YES CF A14,ICPRED READ INTERTASK ST A8,ECBBLK+2,A11 IOAC30 EQU * ST A4,ECBBLK,A11 NUMBER OF WAITS RTN A14 EJECT ********************************************************************* * * * IOCPL COMPLETE IN CURRENT MODE * * ********************************************************************* IOCPL EQU * CM MAIN,A11 CLEAR MF FLAG DK39 CW A8,ECBBLK+2,A11 INTERTASK? RF(NE) IOCP10 NO CM ECBBLK+2,A11 CF A14,ICPINP MAKE HARDCOPY RF IOCP90 IOCP10 EQU * CW A8,ECBBLK+4,A11 DC LINE 1? IFT NBRLIN=2 RF(NE) IOCP20 NO XIF IFF NBRLIN=2 RF(NE) IOCP90 NO FORGET IT XIF CM ECBBLK+4,A11 CM MAIN,A11 INDICATE LINE 1 RF IOCP30 IFT NBRLIN=2 IOCP20 EQU * CW A8,ECBBLK+6,A11 DC LINE 2? RF(NE) IOCP90 NO CM ECBBLK+6,A11 IM MAIN,A11 INDICATE LINE 2 XIF IOCP30 EQU * CF A14,DCPINP TAKE CARE OF DC IOCP90 EQU * RTN A14 EJECT *************************************************************** * * * DCPINP DC PRINTER INPUT * * * *************************************************************** DCPINP EQU * CF A14,ICABOR ABORT LOCAL HARD COPY LDR A7,A7 ALREADY COMPLETED? RF(Z) DCP100 NO CF A14,ICPINP TAKE CARE OF THAT FIRST DCP100 EQU * LD A8,ECBDC,A11 IFT NBRLIN=2 LD A1,MAIN,A11 LINE 1 RF(Z) DCP150 YES LD A8,ECBDC2,A11 DCP150 EQU * XIF IFT SNA=1 LD A1,ECBRC,A8 OK? ANKL A1,/701 OK? RF(NZ) DCP500 NO STOP IT XIF CF A14,GETBUF GET BUFFER LDR A3,A8 CF A14,READW READ FIRST BUFFER ANK A1,3 ERROR? RF(NZ) DCP400 NO LDR A8,A12 CF A14,RELBUF RELEASE BUFFER RF DCP500 DCP400 EQU * SUR A10,A10 RESET INTERNAL UNPACK STATUS IFT SNA=1 . =1 ANK A1,2 . =1 RF(Z) DCP450 . =1 ORKL A10,LICREC . =1 DCP450 EQU * . =1 XIF . =1 LD A1,ECBEL,A8 ST A1,DCLENG,A11 SAVE LENGTH ST A12,BUFPNT,A11 SAVE BUFFER ADDRESS IFT SNA=1 CF A14,GETBUF GET ANOTHER BUFFER LDR A3,A8 CF A14,READNW READ WITH NO WAIT XIF CF A14,UNPACK UPDATE SCREEN BUFFER DCP500 EQU * IFF SNA=1 LDK A1,0 CF A14,SETSTA SET DEVICE END XIF RTN A14 EJECT **************************************************************** * * * ICPINP INTERTASK INPUT * * * **************************************************************** ICPINP EQU * CF A14,COPP MAKE HARDCOPP ST A1,REGI,A11 RETURN CODE TO TERMINAL CF A14,ICPWRT WRITE INTERTASK RTN A14 EJECT ****************************************************************** * * * ICPRED INTERTASK READ * * * ****************************************************************** ICPRED EQU * LD A8,ECBICR,A11 CF A14,ICSET SET NO TIMEOUT LDK A1,0 NOT ADDRESSED READ LDKL A3,BVDU ADR A3,A11 LDKL A2,LBVDU+/20 CF A14,ICREAD READ INTERTASK RTN A14 EJECT ******************************************************************** * * * ICPWRT WRITE INTERTASK * * * ******************************************************************** ICPWRT EQU * LD A8,ECBICW,A11 CF A14,ICSET SET NO TIMEOUT LD A1,ECBICR,A11 LD A1,ECBCW,A1 GET TASKID RF(Z) ICPW90 NOT THERE LDKL A3,REGI RETURN CODE ADR A3,A11 LDK A2,2 LENGTH CF A14,ICWRT WRITE INTERTASK ICPW90 EQU * RTN A14 EJECT ************************************************************* * * * ICABOR INTERTASK ABORT * * * ************************************************************* ICABOR EQU * LDK A7,0 CM ECBBLK+IC,A11 LD A8,ECBICR,A11 LKM DATA 10 RTN A14 EJECT ********************************************************************* * * * COPP COPY SCREEN BUFFER TO PRINTER * * * ********************************************************************* * REGISTERS * * A2= CHAR. * A3= SCREEN BUFFER POINTER * A4= REL. SCREEN BUFFER ADDRESS * A5= LINE LENGTH * A6= CURRENT ATTRIBUTE * A8= ECB BUFFER POINTER * A9= ECB BUFFER INDEX * A10= INTERNAL STATUS * A11= TASK BLOCK BASE * A13= ECB BASE * ********************************************************************* COPP EQU * . =2 LD A8,ECBPRT,A11 CM ECBRL,A8 RESET PRINT LENGTH =3 LDK A1,0 LDK A6,0 RESET ATTRIBUTE CF A14,ATMASB SEARCH ATTRIBUTE BACKWARDS CM LINCNT,A11 RESET LINE COUNTER LD A1,WCC,A11 ANK A1,/38 MASK RELEVANT LDR A5,A1 ANK A1,8 START PRINT? ABL(Z) COP950 NO FORGET IT =19 SRL A5,4 LC A5,LINLEN,A5 GET LINE LENGTH LDR A5,A5 NL,EM AND CR DET. LENGTH? RF(NZ) COP100 NO LD A1,PRTTYP,A11 GET MAX LINE LENGTH LC A5,PRTLEN+1,A1 COP100 EQU * LDKL A3,BVDU ADR A3,A11 IFT BASWRI=1 . =24 LDR A1,A8 . =24 LD A8,PRBA,A11 PRINTER BUFFER ADDRESS =24 ST A8,ECBBA,A1 STORE IN ECB =24 AD A8,PRLMAR,A11 ALLOW LEFT MARG/CR =25 CM PRCCCT,A11 CLEAR BUFFER CHARACTER COUNTER =36 XIF . =24 IFF BASWRI=1 . =24 LD A8,ECBBA,A8 CMR A8 RESET CONTROL CHAR. ADKL A8,2 XIF . =24 SUR A9,A9 LDK A2,0 LDK A4,0 SUR A10,A10 RESET STATUS COP200 EQU * CWK A4,LBVDU ALL PRINTED? RF(NL) COP850 YES CWR A9,A5 LINE FULL? RF(L) COP400 NO CF A14,PRLINE PRINT LINE LDR A1,A1 PRINTER ERROR? RF(NZ) COP900 YES COP400 EQU * LCR A2,A3 GET CHAR. ANK A2,/FF RF(Z) COP650 NULL CHAR. CCK A2,/8000 ATTRIBUTE? RF(L) COP500 NO LDR A6,A2 GET NEW ATTRIBUTE RF COP650 COP500 EQU * CCK A2,/2020 ORDER? RF(L) COP550 YES ANKL A10,/FFFF-CRREC RESET CR RCV =3 RF COP600 COP550 EQU * CF A14,GETTAB GET ORDERINDEX CFR A14,A1 TAKE CARE OF ORDER LDR A1,A1 PRINTER ERROR? RF(NZ) COP900 YES LDR A1,A10 GET STATUS RF(N) COP800 GET NEXT CHAR. SLL A1,1 RF(N) COP850 END COP600 EQU * LDR A1,A6 CHECK IF NONPRINT ANK A1,/C XRK A1,/C RF(Z) COP650 NONPRINT ORKL A10,NTONLY INIDICATE NOT ONLY NOT RF COP700 COP650 EQU * LDK A2,/20 REPLACE WITH SPACE COP700 EQU * IFF TRANAT=0 . =4 LC A2,CONNAT,A2 TRANSFORM NAT.CHAR =4 XIF . =4 SCR A2,A8 ADKL A9,1 ADKL A8,1 CCK A2,/2020 SPACE? =3 RF(E) COP800 YES, DON'T UPDATE LENGTH =3 LD A1,ECBPRT,A11 GET ECB =3 ST A9,ECBRL,A1 UPDATE LAST POS. NOT SPACE =3 COP800 EQU * ANKL A10,/FFFF-NXTCHA RESET TAKE NEXT CHAR =3 ADK A3,1 ADK A4,1 RB COP200 COP850 EQU * IFF BASWRI=1 . =24 LDR A9,A9 SOMETHING LEFT TO PRINT? RF(Z) COP950 NO! =19 CF A14,PRLINE PRINT LAST LINE ANKL A10,ENDPRT END MESS.? RF(Z) COP900 NO STOP IT ORKL A10,NTONLY INDICATE PRINTABLE CF A14,PRLINE EXTRA LINE FEED XIF . =24 IFT BASWRI=1 . =24 LDR A9,A9 SOME TEXT LEFT TO PRINT? =24 RF(Z) COP860 NO! =24 CF A14,PRLINE PRINT TEXT =24 COP860 EQU * . =24 IFF SCS=1 . =26 LDR A1,A10 TEST END MESS. DK38 ANKL A1,ENDPRT DK38 RF(Z) COP870 DK38 ANKL A10,NOEMLF TEST IF EXTRA LF NECESS. DK38 RF(NZ) COP870 NO, SKIP IT DK38 ORKL A10,NTONLY INDICATE PRINTABLE =24 CF A14,PRLINE EXTRA LINEFEED =24 XIF . =26 IFT BASWRI=1 . =26 COP870 EQU * . =24 CF A14,PRCCH CONTROL CH:S TO PRINTER =24 XIF . =24 COP900 EQU * LDR A1,A1 PRINTER FAILED? RF(Z) COP950 NO LD A2,WCC,A11 . =32 CWK A2,/38 LOCAL HARDCOPY? =32 RF(E) COP910 YES. SKIP PRINTING =32 COP902 EQU * CF A14,TSTPRT WAIT UNTIL PRINTER OPERABLE =32 ANK A4,1 OPERABLE? DK42 RF(Z) COP905 YES, RETRY DK42 LDKL A8,50 NO, WAIT 5 SECONDS DK42 LKM DATA 6 RB COP902 COP905 EQU * ABL COPP RESUME PRINTING =34 COP910 EQU * . =32 LDKL A2,PRTERR INDICATE ERROR ORS A2,PRTMOD,A11 COP950 EQU * RTN A14 EJECT ************************************************************************ * * TABLE FOR PRINTERORDERS * ************************************************************************ PRTORD EQU * DATA /0004 NUMBER OF ORDER CODES DATA /0A0A,NL,NL,NL,NL NEW LINE DATA /0C0C,FFDUM,FFVAL,FFVAL,FFDUM FORM FEED DATA /0D0D,CR,CR,CR,CR CARR. RETURN DATA /1919,EM,EM,EM,EM END MESSAGE DATA INVAL INVALID ORDER CODE EJECT **************************************************************************** * * * NL NEW LINE * * * **************************************************************************** NL EQU * ORKL A10,NXTCHA+NTONLY GET NEXT CHAR. ADK A3,1 GET NEXT CHAR. DK38 LCR A1,A3 DK38 ANK A1,/FF MASK IT DK38 CWK A1,/19 END MESS.? DK38 RF(E) NL005 YES, FLAG IT DK38 ANKL A10,/FFFF-NOEMLF NO, CLEAR FLAG DK38 RF NL010 DK38 NL005 EQU * DK38 ORKL A10,NOEMLF INDICATE NO LF DK38 NL010 EQU * DK38 SUK A3,1 RESTORE POINTER DK38 CF A14,PRLINE PRINT LINE AFTER NEW LINE . =DK RTN A14 EJECT ********************************************************************** * * * FFDUM SIMULATED FORM FEED * * * ********************************************************************** FFDUM EQU * CF A14,FFCHK CHECK IF FORM FEED IS VALID LDR A1,A1 VALID? RF(NZ) FFD400 NO LDK A7,0 RESET LD A1,PRTTYP,A11 TYPE OF PRINTER LC A7,PRTLEN,A1 PAGE SIZE FFD100 EQU * CW A7,LINCNT,A11 NEW PAGE? RF(L) FFD200 YES BUT TO MANY RF(E) FFD300 YES FINISHED ORKL A10,NTONLY ST A7,REGI,A11 SAVE CF A14,PRLINE ADVANCE ONE LINE LD A7,REGI,A11 RESTORE LDR A1,A1 PRINTER ERROR? RF(NZ) FFD500 YES RB FFD100 FFD200 EQU * NGR A1,A7 ADS A1,LINCNT,A11 TAKE AWAY ONE PAGE RB FFD100 FFD300 EQU * CM LINCNT,A11 TOP OF PAGE LDK A2,/20 REPLACE FF WITH SPACE FFD400 EQU * LDK A1,0 RETURN CODE FFD500 EQU * RTN A14 EJECT ********************************************************************* * * * FFVAL FORM FEED * * * ********************************************************************* FFVAL EQU * CF A14,FFCHK CHECK IF FF VALID LDR A1,A1 VALID? RF(NZ) FFV200 NO . =36 IFF BASWRI=1 . =30 LDK A1,/31 FF FOR STANDARD WRITE =30 SC A1,-1,A8 STORE FF CONTROL CHAR. XIF . =24 IFT BASWRI=1 . =24 ORKL A10,FFCCH IND. FF CCH =36 CF A14,PRLINE PRINT LINE =36 XIF . =24 ORKL A10,NXTCHA . =DK CM LINCNT,A11 TOP OF PAGE FFV200 EQU * LDK A1,0 RETURN CODE RTN A14 EJECT ********************************************************************** * * * CR CARRIAGE RETURN * * * ********************************************************************** CR EQU * LDR A1,A6 GET ATTRIBUTE ANK A1,/C XRK A1,/C NONPRINT FIELD? RF(Z) CR100 YES LD A1,WCC,A11 ANK A1,/30 FORMATTED? RF(NZ) CR100 NO ORKL A10,NTONLY+CRREC CR RECEIVED CR100 EQU * LDK A2,/20 REPLACE WITH SPACE LDK A1,0 RETURN CODE RTN A14 EJECT ********************************************************************* * * * EM END MESSAGE * * * ******************************************************************** EM EQU * ORKL A10,ENDPRT END PRINTING LDK A1,0 RETURN CODE RTN A14 EJECT ****************************************************************** * * * INVAL INVALID PRINTER ORDER * * * ****************************************************************** * * ALSO HANDLING: * DUP & FM CHARACTERS * INVAL EQU * LDR A1,A2 SAVE CHAR =37 CF A14,RFMDUP REPLACE IF DUP OR FM =37 SUR A1,A2 REPLACED? =37 RF(NZ) INVA10 YES! =37 NO! I.E. INVALID ORDER =37 LDK A2,/20 REPLACE WITH SPACE INVA10 EQU * . =37 ORKL A10,NTONLY NOT ONLY LDK A1,0 RETURN CODE RTN A14 EJECT ***************************************************************** * * * FFCHK CHECK IF FF IS VALID * * * ***************************************************************** FFCHK EQU * LD A1,WCC,A11 ANK A1,/30 XRK A1,/30 FORMATTED? RF(NZ) FFCH10 YES BUT NOT AS LOCAL HARDCOPY LD A1,WCC,A11 ANK A1,/40 LOCAL HARD COPY? RF(Z) FFCH20 YES, FF NOT ALLOWED FFCH10 EQU * LDR A9,A9 FF ALLOWED RF(Z) FFCH30 NOT LDR A1,A10 ANKL A1,CRREC CR RECEIVED? RF(NZ) FFCH30 YES FFCH20 EQU * LDK A2,/20 REPLACE WITH SPACE LDK A1,1 RETURN CODE RF FFCH40 FFCH30 EQU * ANKL A10,/FFFF-CRREC RESET CR RCV =3 LDR A9,A9 EMPTY LINE RF(Z) FFCH35 YES CF A14,PRLINE PRINT LINE FFCH35 EQU * LDK A1,0 RETURN CODE FFCH40 EQU * ORKL A10,NTONLY NOT ONLY RTN A14 EJECT **************************************************************** * * * PRLINE PRINT LINE * * * **************************************************************** PRLINE EQU * LD A8,ECBPRT,A11 LDR A1,A10 ANKL A1,NTONLY ONLY RUBB.? RF(NZ) PRL050 NO LD A1,WCC,A11 LDR A2,A1 ANK A1,/30 XRK A1,/30 HRADCOPY? RF(NZ) PRL200 NO ANK A2,/40 HARDCOPY????? RF(NZ) PRL200 NO PRL050 EQU * ANKL A10,/FFFF-NTONLY RESET NOT ONLY SPACES RCV =3 IFF BASWRI=1 . =24 LDKL A9,2 ADD CONTROL CHAR. TO LENGTH =3 ADS A9,ECBRL,A8 . =3 LDK A7,/06 PRINT LKM DATA 1 XIF . =24 IFT BASWRI=1 . =24 LD A1,ECBRL,A8 TEXT TO PRINT? =24 RF(Z) PRL070 NO! JUST CONTROL CH =24 EJECT HANDLING A TEXT LINE =36 PREPARE LINE. FIRST LEFT MARGIN =36 IFF LMARG=0 . =36 LDK A7,/20 FILL LEFT MARGIN WITH SPACE =36 LD A1,PRLMAR,A11 . =36 AD A1,ECBBA,A8 . =36 SUK A1,1 . =36 PRL055 EQU * . =36 SCR A7,A1 . =36 SUK A1,1 . =36 CW A1,ECBBA,A8 FINISHED? =36 RB(G) PRL055 NO! =36 XIF . =36 IFT BASWRI=1 . =36 . =36 LDK A7,/0D CR CCH =36 SC* A7,ECBBA,A8 CR CCH FIRST IN BUFFER =36 IM LINCNT,A11 ANOTHER LINE =24 LDK A1,/0A LF CCH =24 LD A7,ECBRL,A8 . =24 AD A7,ECBBA,A8 . =24 AD A7,PRLMAR,A11 ALLOW FOR LEFT MARG/CR =25 SCR A1,A7 LF CCH LAST IN BUF =25 . =35 CALCULATE LINE LENGTH =36 LDK A1,1 ALLOW FOR LF =36 AD A1,ECBRL,A8 ALLOW FOR TEXT =36 AD A1,PRLMAR,A11 ALLOW FOR LEFT MARGIN =36 ADS A1,PRCCCT,A11 NO. OF CH:S TO PRINT =36 ADS A1,ECBBA,A8 UPDATE POINTER TO BUFFER =36 EJECT . =36 PRL060 EQU * ENOUGH SPACE FOR ANOTHER LINE? =36 LDKL A1,PRBFL BUFFER LENGTH =36 SU A1,PRCCCT,A11 USED PART OF BUFFER =36 SUR A1,A5 MAX. LINE LENGTH =36 SU A1,PRLMAR,A11 LEFT MARGIN =36 RF(G) PRL200 ENOUGH SPACE. DON'T PRINT =36 . =36 PRL065 EQU * PRINT BUFFER =36 LD A1,PRCCCT,A11 . =36 ST A1,ECBRL,A8 REQ. LENGTH =36 LD A1,PRBA,A11 . =36 ST A1,ECBBA,A8 BUFFER ADDRESS =36 IFT P6883=1 LDR* A1,A11 6883 PRINTER? CWK A1,'L1' TID = L1 = 6883 RF(NE) PRL067 NO, NORMAL BASIC WRITE LDK A7,/07 ORDER - BAS. WRT W/ CONV. RF PRL069 XIF PRL067 EQU * LDK A7,/05 BASIC WRITE =24 PRL069 EQU * LKM . =24 DATA 1 . =24 CM PRCCCT,A11 CLEAR CHARACTER COUNTER =24 RF PRL090 . =24 EJECT HANDLING A CONTROL CHARACTER =36 PRL070 EQU * STORE CCH IN BUFFER =24 IM LINCNT,A11 ANOTHER LINE =24 LDK A7,/0A LF CCH =24 LDR A1,A10 . =36 ANKL A1,FFCCH FORM FEED? =36 RF(Z) PRL075 NO =36 LDK A7,/0C YES. FF CCH =36 ANKL A10,/FFFF-FFCCH RESET FF IND. =36 PRL075 EQU * . =36 SC* A7,ECBBA,A8 CCH TO BUFFER =36 IM ECBBA,A8 STEP BUFFER ADDRESS =36 IM PRCCCT,A11 STEP NO. OF CH:S IN BUFFER =36 ADKL A8,1 STEP BUFFER POINTER =36 RB PRL060 CHECK IF END OF BUFFER =36 EJECT . =36 PRL090 EQU * . =24 XIF . =24 LDK A1,100 NUMBER OF DELAYS DK41 PRL100 EQU * LDKL A8,1 WAIT FOR A WHILE LKM DATA 6 LD A8,ECBPRT,A11 LDR* A2,A8 PRINT COMPL.? RF(N) PRL150 YES SUK A1,1 MORE TO WAIT FOR? RB(NZ) PRL100 YES LKM DATA 10 ABORT . =27 LDK A1,1 INDICATE ERROR =27 RF PRL300 PRL150 EQU * LKM DATA 2 RESYNCHRONIZE IFF BASWRI=1 . =24 IM LINCNT,A11 ANOTHER LINE CM ECBRL,A8 RESET PRINT LENGTH =3 XIF . =36 LD A1,ECBRC,A8 OK? ANKL A1,/2011 PAPER OUT/HARDWARE T-O/NOT OP? =31 RF(NZ) PRL300 YES! =23 PRL200 EQU * IFT BASWRI=1 . =24 CM ECBRL,A8 RESET PRINT LENGTH =36 LD A8,ECBBA,A8 SET BUFFER POINTER =36 AD A8,PRLMAR,A11 ALLOW FOR LEFT MARG/CR =25 XIF . =24 IFF BASWRI=1 . =24 LD A8,ECBBA,A8 GET BUFFER ADDRESS CMR A8 RESET CONTROL CHAR. XIF . =24 SUR A9,A9 IFF BASWRI=1 . =24 ADKL A8,2 XIF . =24 LDK A1,0 RETURN CODE RF PRL900 . =6 PRL300 EQU * LD A2,PRTID,A11 GET PRINTER TASKID =6 ANK A2,/FF . =6 SUK A2,/30 . =6 SLL A2,2 . =6 LD A3,+6,A13 COMMON BLOCK BASE =6 ADK A3,TSKTAB . =6 ADR A3,A2 . =6 SC A1,+3,A3 SET PRINTER STATUS =6 PRL900 EQU * . =6 RTN A14 IFT BASWRI=1 . =24 EJECT . =24 ************************************************************************ * * PRCCH - SEND BUFFER WITH CONTROL CH:S TO PRINTER * ************************************************************************ * PRCCH EQU * . =24 LD A1,PRCCCT,A11 ANYTHING TO SEND? =24 RB(Z) PRL900 NO! RETURN =24 LD A8,ECBPRT,A11 ECB ADDRESS =24 RB PRL065 SEND CH:S TO PRINTER =36 XIF . =24 EJECT ******************************************************************* * * * INIT INIT ROUTINE * * * ******************************************************************* INIT EQU * CF A14,COMINI COMMON INIT CF A14,ECBINI INIT OF ECB:S LCR A2,A1 SLL A2,8 LC A2,+1,A1 ST A2,PRTID,A11 SAVE WHOLE TASKID LCR A2,A1 GET TYPE OF PRINTER AND MAKE INDEX LD A7,PRTTAB NUMBER OF TYPES LDKL A1,PRTTAB+2 START OF PRINTER TABLE INI100 EQU * CCR A2,A1 CONVERT TYPE TO INDEX RF(E) INI200 ADK A1,4 SUK A7,1 ILLEGAL ID? RB(NZ) INI100 NO LDKL A1,* ST A1,REGI,A11 LKM DATA 3 FORGET IT INI200 EQU * LD A1,+2,A1 ST A1,PRTTYP,A11 SAVE PRINTER TYPE * * IF TID =< 'L1',SELECT FILE CODE '80' * THE LINE PRINTER...... * CF A14,SELPFC * IFT BASWRI=1 . =24 LD A2,ECBPRT,A11 PRINTER ECB ADDRESS =24 LD A2,ECBBA,A2 PRINTER BUFFER ADDRESS =24 ST A2,PRBA,A11 SAVE IT IN WORK AREA =24 LDK A2,1 . =25 ST A2,PRLMAR,A11 ALLOW FOR CR =25 IFF LMARG=0 LEFT MARGIN FOR PRINTER =25 LD A1,LMARGT,A1 . =25 ADS A1,PRLMAR,A11 SAVE VALUE IN WORK AREA =25 XIF . =24 RTN A14 EJECT ***************************************************************** * * * TSTPRT TEST HARDWARE * * * ***************************************************************** TSTPRT EQU * . =6 LD A8,ECBPRT,A11 LDK A7,/80 TEST STATUS TSTP10 EQU * LKM DATA 1 LD A4,ECBRC,A8 . =6 ANKL A4,/2011 PAPER OUT/HARDWARE T-O/NOT OP? =31 RF(Z) TSTP20 NO! =31 LDK A4,1 YES. INDICATE ERROR =31 TSTP20 EQU * . =31 . =6 LD A2,PRTID,A11 . =6 ANK A2,/FF SUK A2,/30 SLL A2,2 LD A3,+6,A13 LDK A1,TSKTAB ADR A3,A1 ADR A3,A2 . =6 SC A4,+3,A3 INDICATE STATUS IN DEV TABLE =6 . =6 . =6 . =6 . =6 TSTP90 EQU * RTN A14 EJECT ******************************************************************* * * * GETTAB GET ORDER INDEX * * * ******************************************************************* GETTAB EQU * LD A7,PRTORD NUMBER OF VALID ORDER CODES LDKL A1,PRTORD+2 ORDERTABLE BASE GETT10 EQU * CCR A2,A1 CONVERT ORDER CODE TO ADDRESS RF(E) GETT20 AD A1,PRTTAB AD A1,PRTTAB ADK A1,2 SUK A7,1 ORDER FOUND? RF(Z) GETT30 NO INVALID RB GETT10 TRY AGAIN GETT20 EQU * ADK A1,2 LD A2,PRTTYP,A11 ADR A1,A2 GETT30 EQU * LDR* A1,A1 RTN A14 EJECT * * SELECTION OF PRINTER FILE CODE * FC=30, LP100, FC=80, LINE PRINTER * SELPFC EQU * LDR* A1,A11 GET TASK ID LDR A2,A1 SAVE IT ANKL A1,/FF00 MASK LETTER CWK A1,/4C00 ='L'? RF(E) SELP05 YES. RF SELP90 NO, QUIT. SELP05 EQU * CWK A2,/4C31 ='L1'? RF(G) SELP90 NO, QUIT LD A2,ECBPRT,A11 GET PRINTER ECB LDK A1,/80 OVER WRITE ORIG. FC SC A1,+1,A2 SELP90 EQU * RTN A14 END