File: HEXBOX.PA of Tape: Various/System-Tapes/s5
(Source file text)
/HEXABOX HANDLER FOR OS/8 /W.V.D.MARK, ETHZ, ZUERICH, SWITZERLAND /27-FEB-1978 *0 -1 DEVICE HEXB;DEVICE HEX;400;HEXA&177+4000;ZBLOCK 2 /TWO-PAGE HEXABOX HANDLER FOR OS/8 V3C. /ON INPUT, RECOGNIZES .EOJ.,.EOR., ^C. /.EOJ. MEANS END OF INPUT, INSERT ^Z IN BUFFER, / PAD WITH ZEROES. /^C MEANS ABORT JOB, RETURN TO OS/8 VIA LOC 7600 TO SAVE CORE AND PRINT "^C" /ON OUTPUT RECOGNIZES ^C, ^O, ^S, ^Q FROM KEYBOARD /^C CAUSES JOB TO ABORT, RETURN TO OS/8 VIA LOCATION 7600 / TO SAVE CORE AND PRINT "^C" /^O STOPS OUTPUT TO BOX AND GOES TO EOF /^S CAUSES THE HANDLER TO STOP SENDING TO BOX /^Q RESUMES HANDLER SENDING / ^S AND ^Q ARE IGNORED IN OTHER CASES HEXVER= "B&77 MPARAM= 7643 DI00= 6554 DI01= 6555 /DIGITAL INPUT DOOP= 6514 /DIGITAL OUTPUT DCEP= 6543 /DIGITAL PULSE -- FBSF= 6541 /SKIP ON FLAG -- FBCF= 6542 /CLEAR FLAG -- / -- AC=4000: OUTPUT / -- AC=2000: INPUT /CROSS PAGE LINKAGE: /THIS CODE MUST BE ABLE TO LOAD INTO ANY TWO PAGES OF CORE /THE ENTRY POINT IS AT THE NEXT LOCATION TO THE END OF THE FIRST PAGE /AT THE END OF THE FIRST PAGE WE JMS TO HLINK, /THIS LEAVES THE ADDRESS OF THE FIRST LOCATION OF THE NEXT PAGE /IN LOCATION 'HLINK' . THIS JUST HAPPENS TO BE THE ADDRESS /OF HEXGCH. /HEXPCH AND HEXGCH SHARE THE SAME ENTRY POINT. /IF IT IS CALLED WITH A 0 LINK, IT IS A CALL TO HEXGCH, /IF IT IS CALLED WITH A NON-ZERO LINK, IT IS A CALL TO HEXPCH. /HEXGCH HAS ONE RETURN FOR EVERYTHING.(^Z CODED) /HEXPCH TAKES RETURN 1 IF IT WANTS THE HANDLER TO GO AWAY, /I.E IF IT SAW A ^Z, ELSE RETURN 2. *200 HLINK, 0 /GETS ADDRESS OF HEXPCH (START OF NEXT PAGE) STL CLA RAR /4000 TAD I HEXA /RETRIEVE FUNCTION WORD, BUT PUT R/W BIT IN LINK AND K3700 /EXTRACT NUMBER OF DOUBLE-WORDS TO TRANSFER CMA /GET COUNT+1 DCA BUFSIZ /STORE AWAY RDF /FIND OUT THE USER'S DATA FIELD TAD CIFCDF /FORM OUR EXIT CIF CDF DCA HEXIT /STORE AWAY FOR EXIT ROUTINE TAD K70 /GET FUNCTION WORD AND I HEXA /ISOLATE FIELD OF BUFFER TAD HEXCDF /FORM CDF TO FIELD OF BUFFER DCA HEXDBF /STORE WHERE IT WILL BE USEFUL /AT SAME TIME, INITIALIZE HEXEOF ISZ HEXA /POINT TO BUFFER ADDRESS TAD I HEXA /AND GET IT DCA HEXBUF /AND SAVE IT ISZ HEXA /POINT TO BLOCK # TAD I HEXA /GET BLOCK NUMBER ISZ HEXA /POINT TO ERROR RETURN SZA CLA /INITIALIZING? JMP HEXDBF /NO SNL /OUTPUT? JMP HEXDBF /NO STL CLA IAC RTR /MASK A&B WITH 6000 CDF 10 /YES-DETERMINE TRANSMISSION TYPE AND I DPARAM /GET SWITCHES FROM MONITOR HEXCDF, CDF 0 CLL RTL RAL SZA CMA /NOW:A=-3,B=-2,OTHER=0. TAD ALPHD /D FOR DISPLAY IS DEFAULT DCA OUTTYP /FOR ARGUMENT TAD OUTTYP DCA TYP /FOR STRING STL /SET LINK FOR OUTPUT SHIFT, /OUTPUT SHIFT REGISTER HEXEOF, /0 IF SAW LF OR ^Z AND WISH TO PAD BUFFER WITH 0'S HEXDBF, HLT /CDF BUFFER FIELD JMP HEXEND DPARAM, MPARAM ALPHD, "D /LINK MUST BE SET FIRST TIME THROUGH HERE. /IT ACTS AS A GUARD BIT IN THE SHIFT REGISTER HEXLP, SNL CLA /LINK=1 MEANS OUTPUT JMP HEXGET /INPUT IS FROM HEXBOX ROTL, RTL RTL SPA /DO WE HAVE 8 BITS SHIFTED IN? JMP HELP DCA SHIFT /SAVE SHIFT REGISTER TAD I HEXBUF JMS HEXOUT /SEND A CHARACTER TAD I HEXBUF ISZ HEXBUF /BUMP INPUT POINTER K7400, 7400 /PROTECT ISZ AND K7400 CLL RAL TAD SHIFT /SHIFT HIGH ORDER 4 BITS INTO JMP ROTL /SHIFT REGISTER HELP, JMS HEXOUT /SEND 3RD CHARACTER OF DOUBLE-WORD STL /***KLUDGE HEXEND, ISZ BUFSIZ /DONE? JMP HEXLP /NOT YET HEX, TAD HEXEOF /IF INPUT AND WE WERE PADDING WITH 0'S FOR ^Z SZA CLA /TAKE SOFT ERROR EXIT HEXRTN, ISZ HEXA /POINT TO NORMAL RETURN /CAN'T GET ERROR OR END-OF-FILE ON OUTPUT HEXIT, HLT /RETURN TO USER'S FIELD JMP I HEXA /RETURN TO USER BUFSIZ, 0 HEXBUF, 0 K70, 70 K377, 377 HEXOUT, 0 /NEVER CALL HEXPCH WITH ZERO AC AND K377 STL /LINK=1 MEANS OUTPUT JMS I HLINK /CALL HEXPCH OUTTYP, "D /8-BIT TYPE ARGUMENT BASE, JMP HEXRTN /GO AWAY, WE SAW A .EOJ. JMP I HEXOUT /RETURN HEXGET, TAD BUFSIZ CLL RAL /CONVERT DOUBLE-WORDS TO WORDS DCA BUFSIZ /SET SIZE OF BUFFER TSTEND, TAD HEXEOF SNA CLA JMP ZERO CLL /LINK=0 MEANS INPUT JMS I HLINK /CALL HEXGCH TO GET A CHARACTER AND K377 ZERO, DCA I HEXBUF / GOT CHARACTER /STORE AWAY TEMPORARILY /USING USER'S BUFFER AS A TEMP LOCATION TAD I HEXBUF /GET BACK CHARACTER TAD M232 /-^Z SNA DCA HEXEOF TAD K17 /^Z-LF-1 DCA TMP ISZ HEXBUF K17, 17 ISZ BUFSIZ /IS BUFFER FULL? SKP JMP HEX ISZ TMP /WAS LAST CHAR A LF? JMP TSTEND /NO DCA HEXEOF /YES, SET "PAD WITH 0'S" FLAG ISZ HEXA /POINT TO NORMAL RETURN /LF IS NOT AN ERROR OR END-OF-FILE JMP ZERO /REJOIN PROCESSING M232, -232 K3700, 3700 CIFCDF, CIF CDF 0 TMP, 0 FFSTR=TMP ". "E "O "R ". TYP, "D 215 212 0 CTZSTR, ". "E "O "I ". 215 212 0 ZBLOCK 376-. HEXA, HEXVER /ENTRY POINT TO HANDLER JMS HLINK /SET UP CROSS PAGE LINKAGE IFNZRO HEXA-376 <ENTERR,QQQQ> PAGE /HEXGCH: GETS A CHAR FROM HEXBOX / IF GOT .EOJ., IT SETS HEXEOF FLAG / LEAVES IT IN AC IN 8-BIT /HEXPCH: SENDS CHAR IN AC TO HEXBOX / IGNORES NULLS / HANDLES TABS CORRECTLY /MUST BE AT TOP OF PAGE HEXPCH, /ENTRY POINT TO HEX SEND ROUTINE HEXGCH, 0 /ENTRY POINT TO HEX RECEIVE ROUTINE SNL JMP HXGCH /ZERO LINK-MEANT CALL TO HEXGCH DCA HCHAR RDF TAD .+2 DCA DFBUF /SAVE DATA FIELD CDF 0 TAD I HEXPCH TAD (-"B SNA CLA JMP BIN TAD HCHAR AND (177 TAD (200 /FORCE ON PARITY BIT FOR ASCII DCA HCHAR BIN, JMS TTYTST TAD (203-223 /NO SZA /^S? H232, JMP OFF /NO, GO CHECK ON ^O TTCTLQ, JMS TTYTST TAD (203-221 /NOTHING ELSE MATTERS UNTIL ^Q SZA CLA /^Q? JMP TTCTLQ /NO, SUSPEND OUTPUTTING KCC /YES, REMOVE ^Q FROM BUFFER K7, 7 OFF, TAD (223-217 /^O? ISZ HEXPCH /GO TO 'BASE' ADRESS SNA CLA JMP DFBUF-1 /YES, GO BACK AND EMPTY BUFFER TAD HCHAR TAD (-216 K100, CLL TAD K5 SZA /TAB? JMP NOTAB HEXTAB, TAD K240 JMS HEXTMX TAD TABCTR AND K7 SZA CLA JMP HEXTAB ISZ HEXPCH DFBUF, HLT /RESET TO BUFFER DF JMP I HEXPCH K240, 240 NOTAB, SNL CLA JMP NORM STA CLL DCA TABCTR NORM, TAD HCHAR TAD (-232 /^Z? SNA JMP CTZOUT /YES-SEND .EOI. ISZ HEXPCH TAD (232-214 /FF? SNA JMP FFOUT /YES-SEND .EOR. TAD (214 JMS HEXTMX JMP DFBUF FFOUT, TAD (FFSTR-CTZSTR /STRINGS ARE IN FIRST PAGE CTZOUT, TAD (CTZSTR-BASE TAD HEXPCH /RELOCATE DCA HCHAR STRLOP, TAD I HCHAR SNA JMP DFBUF /0 IS END OF STRING JMS HEXTMX ISZ HCHAR JMP STRLOP HXGCH, CLA STL RTR /AC=2000 JMS WAIT DI01 /STATUS SNA JMP OK AND K100 /.EOJ. BIT SNA CLA JMP HXGCH /IGNORE PROTOCOL TAD H232 /.EOJ.=^Z SKP OK, DI00 /DATA JMP I HEXGCH TABCTR, 0 /ONLY FOR TAB HEXTMX, 0 DOOP /SET DATA-LINES CLA STL RAR /AC=4000 JMS WAIT ISZ TABCTR K5, 5 HX7600, 7600 JMP I HEXTMX WAIT, 0 DCEP /REQUEST WLOOP, DCA MASK /KEEP CHANNEL JMS TTYTST /CHECK FOR CTRL C WHILE WAITING CLA TAD MASK /CHANNEL BACK FBSF /READY? JMP WLOOP /LOOP AND CHECK FBCF /CLEAR JMP I WAIT MASK, 0 HCHAR, 0 /TTYTST: READS KEYBOARD STATICALLY AND RESPONDS TO ^C / OTHERWISE RETURNS CHAR (8-BIT) MINUS 203 IN AC. / IF FLAG IS NOT UP, IT RETURNS A 1. TTYTST, 0 TAD HX7600 /OR CHAR IN KRS TAD (-7603 /-7603=175 KSF CLA IAC /STUFF IN BUFFER IS UNRELIABLE IF FLAG ISN'T UP SZA JMP I TTYTST CIF CDF 0 /BRANCH TO OS/8 MONITOR AT 07600 JMP I HX7600 /IT WILL PRINT "^C" FOR CHAR IN BUFFER PAGE $