File: DIABLO.PA of Disk: Disks/MyPDP/m8-backup-rka1-rkb1
(Source file text)
/ DIABLO HS HANDLER V40 / / / / / / / / / /COPYRIGHT (C) 1980 BY DATAPLAN GMBH, LAUDA, BRD / / / / / / / / / / /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DATAPLAN GMBH. /DATAPLAN GMBH ASSUMES NO RESPONSIBILITY FOR ANY ERRORS THAT MAY APPEAR /IN THIS DOCUMENT. / /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED /(WITH INCLUSION OF DATAPLAN'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DATAPLAN. / /DATAPLAN GMBH ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY /OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DATAPLAN. / / / / / / / / / / /W.V.D.MARK, DP CONSULTING, ZUERICH, SWITZERLAND /1-JAN-80 DBVERSION="M&77 *0 -1 DEVICE DIAB;DEVICE LPT;1040;DBL&177+4000;ZBLOCK 2 DEVC= 37 /DEVICE CODE TRANSMIT (UPPER) LMAR= 0 /LEFT MARGIN RMAR= 164 /RIGHT MARGIN FF= 0 /ASCII FORMFEED =14 TABW= 10 /TAB LENGTH .GE.1 VMI= 10 /VERTICAL MOTION INDEX HMI= 14 /HORIZONTAL MOTION INDEX DTYP= 0 /0 FOR TYPE 1610 /NUMBER OF LINES ON PAGE FOR TYPE 1640 /110 = 72 LINES, 102=66 , 63=51 DCDIAB=DEVC^10 TSFX= 6001+DCDIAB /SKIP ON FLAG TLSX= 6006+DCDIAB /LOAD DBL BUFFER KSFX= 6001+DCDIAB-10 KRBX= 6006+DCDIAB-10 KIEX= 6005+DCDIAB-10 *200 DBLM32, -32 / * DTERMC, FF /FORMS OR NO * DBLWC, 0 / * DBLCA, 0 / * DB7700, 7700 / * PDBLNK, 0 /GETS ADRESS OF PAGE 2 * TAD I DBL / R/W BIT TO LINK * L AND DB7700 / * I CMA /TREAT 0 PG CNT AS 0 WD CNT N DCA DBLWC /SAVE -(DBLWD COUNT+1) * K DB70, 70 / * DCA DBLEOF /INITIALIZE EOF * DBL177, 177 / * DBL214, RDF /DON'T MOVE THIS CODE *** TAD DBLCIF / M DCA DBLXIT /SAVE CIF CDF RETRN FIELD U TAD I DBL / S AND DB70 / T TAD DBCDF / DCA DBLCDF / N ISZ DBL /PT TO BUFFER O TAD I DBL /GET BUFFER ADDRESS T DCA DBLCA /SAVE BUFFER PTR ISZ DBL /PT TO BLOCK # C TAD I DBL /GET IT H ISZ DBL /POINT TO ERROR RETURN G SNL JMP DBLERR /CAN'T READ FROM DBL DBM140, SZA CLA JMP DBLELP KIEX /INT DISABLE JMS I PDBLNK /INIT SNA /MORE INIT? JMP DBLELP /NO JMS DBPRNT /PRINT IT JMP .-4 /BACK FOR MORE DBLELP, JMS DBPRNT /PRINT 3RD CHAR OF DOUBLEWORD ISZ DBLWC JMP DBLLP /GET 3 MORE CHARS SKP CLA DBLCTZ, TAD DTERMC /YES, TREAT LIKE CTZ JMS DBPRNT /OUTPUT FORM FEED IF EOF SEEN (EOT OF LV8) ISZ DBL /BUMP TO NORMAL RETURN DBLXIT, HLT /RESTORE FIELDS JMP I DBL /EXIT /UNPACKING LOOP - USES A SHIFT REGISTER METHOD TO GET THE /THIRD CHARACTER IN EACH DOUBLEWORD. DBLLP, STL /GUARD BIT OF SHIFT REGISTER DBROTL, RTL RTL SPA /DO WE HAVE 8 BITS SHIFTED IN? JMP DBLELP DCA DBLEOF /SAVE SHIFT REGISTER TAD I DBLCA JMS DBPRNT /PRINT A CHAR TAD I DBLCA ISZ DBLCA /BUMP INPUT POINTER DB7400, 7400 /PROTECT ISZ AND DB7400 CLL RAL TAD DBLEOF /SHIFT HIGH 4 BITS INTO JMP DBROTL /SHIFT REGISTER DBLERR, STL CLA RAR /PUT 4000 IN AC JMP DBLXIT /AND TAKE ERROR RETURN /CHAR PRINT ROUTINE DBPRNT, 0 /ETX-ACK PRINT ROUTINE AND DBL177 DBLCDF, HLT SNA JMP I DBPRNT /IGNORE NULLS TAD DBLM32 /IS IT AN EOF? (32) SNA JMP DBLCTZ /YES, GET OUT TAD DB32 /RESTORE TLSX /PUT CHAR IN DBL BUFFER DBCTCL, JMS DBCCHK /CHECK FOR CTRL C TSFX JMP DBCTCL /WAIT FOR FLAG ISZ DBLCNT /BUFFER OUT? JMP I DBPRNT /NO TAD DBBSIZ /RESET BUFFER COUNT DCA DBLCNT /TO OPTIMAL VALUE CLA STL IAC RAL /SEND ETX TLSX TSFX JMP .-1 /WHY NOT CALL 'DBPRNT'? CLA CLL /BE CONSERVATIVE DBWAIT, KSFX /ACK RECEIVED? JMP DBTIME /TIMOUT KRBX /CLEAR FLAG AND CHECK AND DBL177 TAD DBM6 /IS IT REALLY ACK? SZA CLA JMP DBWAIT /MAYBE OUTSTANDING DBTMEX, TAD DB7400 DCA DBOUTR /RESET TO 6 SECS JMP I DBPRNT /OK; GO ON DBTIME, ISZ DBZERO JMP DBWAIT /24MS WAIT LOOP JMS DBCCHK /CHECK ON CTRLC ISZ DBOUTR JMP DBWAIT /6 SEC WAIT LOOP JMP DBTMEX /ACK GOT LOST DBCCHK, 0 /CHECK FOR CTRL C DB7600, 7600 /CLEAR AC TAD DB7600 KRS TAD DB175 /CHECK FOR ^C FROM CONSOLE SNA CLA KSF /WITH FLAG UP JMP I DBCCHK DBLCIF, CDF CIF 0 JMP I DB7600 /YES, RETURN TO OS/8 DB175, 175 /CTRL C MASK DECIMAL DBLCNT, -48 /DIABLO BUFFER COUNT DBBSIZ, -48 /INITIAL " " OCTAL DBM6, -6 /ACK DBZERO, 0 /TIMOUT DBOUTR, -400 / " ZBLOCK 371-. DBL, DBVERSION /NORMAL ENTRY POINT JMP .+4 DB32, 32 DBLEOF, 0 DBCDF, CDF 0 CLA STL RAR JMS PDBLNK PAGE DBINIT, 0 JMP DBARGS DBVMI, VMI+1 /6 LINES/INCH=10 DBHMI, HMI+1 /10 PITCH=14,12 PITCH=12 DBLMAR, LMAR+1 DBRMAR, RMAR+1 DBTABW, TABW DBLPAG, DTYP DBLFF, 0 /INITIAL FF OR NOT DBPOS, 0 DBARGS, CDF 0 TAD DBCORT SZA CLA /FIRST CALL? JMP I DBCORT /YES ; COROUTINIZE CLA STL IAC RAL /FIRST ETX FOR OVERLAP JMS DBCORT /CALL COROUTINE JMS DBESC /BLACK RIBBON "B /ESC B JMS DBESC /FORWARD PRINTING "5 /ESC 5 TAD DBVMI /LOAD VMI JMS DBESC 36 /ESC RS (N) CLA IAC /ABSOLUTE TAB POS 0 JMS DBESC 11 /ESC HT (N) TAD DBHMI /LOAD HMI JMS DBESC 37 /ESC US (N) TAD DBLPAG JMS DBESC /SET PAGE HEIGHT 14 /ESC FF (N) TAD DBLFF SZA /DID WE WANT INITIAL FF? JMS DBCORT /YES PRINT FORM FEED JMS DBESC /GRAPHICS OFF "4 /ESC 4 JMS DBESC /CLEAR ALL TABS "2 /ESC 2 TAD DBLMAR /GO TO LEFT MARGIN JMS DBESC 11 JMS DBESC /DEFINE LEFT MARGIN "9 /ESC 9 TAD DBRMAR /GO TO RIGHT MARGIN JMS DBESC 11 JMS DBESC /DEFINE RIGHT MARGIN "0 /ESC 0 TAD (15 /RETURN TO LEFT MARGIN JMS DBCORT /CR DCA DBPOS /FOR TAB OVERFLOW DBTABL, TAD DBTABW CIA DCA DBESC /SET WIDTH COUNT TAD (40 /GO THERE WITH SPACES JMS DBCORT ISZ DBESC /ARRIVED? JMP .-3 /NO JMS DBESC /SET TAB "1 /ESC 1 TAD DBTABW TAD DBPOS DCA DBPOS TAD DBPOS CIA TAD DBRMAR /OVER RIGHT MARGIN? SMA CLA JMP DBTABL /NO; MORE TABS TAD (15 JMS DBCORT /RETURN AGAIN JMP I DBINIT /END SIGNAL WITH AC=0 DBESC, 0 /SUB FOR ESCAPE SEQUENCES MQL /SAVE NUMERIC PART TAD (33 /ESC JMS DBCORT /SEND ESC TAD I DBESC /GET SPECIFIER ISZ DBESC JMS DBCORT /SEND IT MQA /GET NUMERIC IF ANY SZA JMS DBCORT /DO NOT SEND 0: MEANS END JMP I DBESC DBCORT, 0 JMP I DBINIT /WHAT? IS THAT ALL? $$$