job BIGPRINT/TAPE ctl 6611 * BIGPRINT/TAPE * PROGRAM BY ED THELEN * MODIFIED BY DAN MCINNIS APRIL 1,2008 * ADDED SENSE SWITCH CONTROLS AND CONTROL CARDS * SS B OFF - WRITE TO TAPE ON - SKIP TAPE WRITING * SS C OFF - PRINT ON - SKIP PRINTING * SS D OFF - PUNCH ON - SKIP PUNCHING * SS E OFF - SS NAME CARDS ON - DON'T SS NAME CARDS * CONTROL CARD - COL 1 END OF BLURB CARDS OR * END OF NAME CARDS GO TO PROGRAM END * CONTROL CARD $ HALT AND THEN STOP PRINTING AND PUNCHING * CONTROL CARD ? HALT PRESS RUN TO RESTART * CONTROL CARD = HALT AND THEN CHANGE TO LONG TAPE RECORDS INBUF DS 1 * ORG 87 X1 DSA 0 * index register 1 ORG 92 X2 DSA 0 * index register 2 ORG 97 X3 DSA 0 * index register 3 * ORG 201 * START PRINT OUTPUT AREA PRNTA DC 1 PRNTA1 DC 1 PRNTA2 DC 1 PRNTA3 DC 1 PRNTA4 DC 1 * * ------------------------------------------------------------- ORG 335 * START ORIGINAL PROGRAM AREA PICKUP DCW 000 START2 CS 80 * CLEAR WORD MARKS FROM CARD READ H * HALT TO CHECK PAPER AND TAPE SW 001 * SET WORD MARK B LOADTS * CALL SUB TO READ TEXT UNTIL - R * READ DATE CARD MCW 25,DATE25 * PUT IT IN A SAFE PLACE RDGEST BSS SKIPC1,C * IF C SWITCH ON SKIP PAPER SKIP CC 1 * TOP OF FORM SKIPC1 R * READ GUEST CARD BSS SKST,E * SKIP STACKER SELECT SS 1 * GUEST CARD IN STACKER 1 SKST C LMINUS,001 * IS FIRST COL MINUS? BE NEND * YES, STOP C LQUES,001 BE DOQUES C L1DOL,001 * IS IT A DOLLAR CARD BE DODOL * GO SET DODOL SWITCH C L1EQU,001 * IS IT EQUAL CARD BE DOEQU * GO SET EQU SWITCH BSS NEND,A * TEST FOR LAST CARD C DOLSW,ONE1 * IS DOLLAR SWITCH ON BE SKIPPU * SKIP PUNCH BSS SKIPPU,D * SKIP PUNCHING LCA 080,180 * P * PUNCH GUEST CARD * NEW TOP OF FORM * GUEST CARD IMAGE IN CARD READ AREA SKIPPU B BIGPRT * CALL SUB TO PROCESS GUEST CARD & VISITED * DOUBLE SIZE CONTROL IS RETURNED AS ZERO OK * MCW L1V0,DOUBLE * SET FOR SINGLE SIZE BIG PRINT MCW DATE25,WORK * PRINT DATE LINE B PRINTS MCW LINE3,WORK B PRINTS MCW LINE4,WORK B PRINTS BSS SKIPC2,C * SKIP PAPER TOP OF FORM IF SS C ON CC 1 * TOP OF FORM SKIPC2 B PNTTXT * PRINT TEXT DATA FROM MEMORY B RDGEST * AND GOTO NEXT GUEST CARD * NEND SS 1 BSS SKIPC3,C * SKIP TOP OF FORM IF SS C ON CC 1 * TOP OF FORM SKIPC3 BSS NOREW,B * IF NOT SSB REWIND TAPE RWD 1 * REWIND TAPE - HOPEFULLY HSPEED NOREW H 111 * MAKE WORD MARK * * LOAD TEXT CARD PAIRS INTO MEMORY, SETTING INDEX LIMIT AT END LOADTS SBR LOADTX&3 * SET RETURN ADDRESS NOP MCW L3V65,X3 * 65=>X3 * SET UP INDEX PUT AWAY MCW L3V000,TXLIM * SET UP LIMIT CS 80 * CLEAR CARD INPUT AREA SW 001 LOADC R * READ 1ST CARD OF PAIR C LMINUS,001 * HAS IT A LEADING - ? BE LOADTX * YES, EXIT C P3V130,TXLIM BE LOADC * 16,000 NEAR FULL, SKIP TIL - SIGN A L3V001,TXLIM * ADD 1 TO LINE COUNT MCW 065,TXTSTR&X3 * MOVE 65 CHAR OF CARD IMAGE TO STORE MA L3V65,X3 * INCREMENT PUT AWAY INDEX R * READ 2ND CARD OF PAIR C LMINUS,001 * HAS IT A LEADING - ? BE LOADTX * YES, EXIT MCW 065,TXTSTR&X3 * MOVE 65 CHAR OF CARD IMAGE TO STORE MA L3V65,X3 * INCREMENT PUT AWAY INDEX B LOADC LOADTX B 000 * RETURN FROM SUBROUTINE L3V65 DCW 065 LMINUS DCW @-@ * * * BIG PRINT SUBROUTINE BIGPRT SBR BIGPTX&3 * SET RETURN ADDRESS MCW L1V1,DOUBLE * MCW L3V000,PICKUP * INITIALIZE PICKUP MCW BLANKS,WORK * BLANK WORK AREA, FOR 1ST NAME MCW PICKUP,X1 * START SCAN MCW L3V000,X2 * START PUTAWAY BIGPTA MCW 1&X1,PCHAR * MOVE 1ST CHAR OF 1ST NAME MCW PCHAR,WORK-24&X2 * A ONE3,X1 A ONE3,X2 C L3V012,X2 * TOO MANY? BE BIGPTB * YES, PRINT C L1VBL,PCHAR * WAS IT BLANK BU BIGPTA BIGPTB MCW X1,PICKUP B PRINTS * MCW BLANKS,WORK * BLANK WORK AREA, FOR 2ND NAME MCW L1VBL,BIGLST * SHOW NO CHARS IN LAST NAME MCW PICKUP,X1 * START SCAN MCW L3V002,X2 * START PUTAWAY BIGPTC MCW 1&X1,PCHAR * MOVE 1ST CHAR OF LAST NAME MCW PCHAR,WORK-24&X2 * A ONE3,X1 C X1,L3VO79 * DON'T SCAN PAST END OF CARD BE BIGPTD * YES, TERMINATE C L1VBL,BIGLST * IF IN LAST NAME, DON'T EAT BLANKS BU BIGNET C L1VBL,PCHAR * BLANK BE BIGPTC * YES, EAT LEADING BLANKS BIGNET MCW PCHAR,BIGLST * A ONE3,X2 C L3V012,X2 * TOO MANY? BU BIGPTC BIGPTD MCW X1,PICKUP B PRINTS * PRINT LAST NAME BIGPTX B 000 * SUBROUTINE RETURN BIGLST DCW 1 * ------------------------------------------------------------- * * NOW WE PRINT THAT BABY OUT :-)) * PROPOSED FORMAT * 2 * 0 1 2 3 4 5 6 * 12345678901234567890123456789012345678901234567890123456789012345678 * PRINTS SBR PRINTX&3 * set return address MCW ZERO3,WROW * initialize print row counter PRINT1 MCW ZERO3,WCOL * initialize work character pick up MCW L3V000,PCOL * initialize output index CS 332 * clear printer area CS SW 201 PRINT2 MCW WCOL,X1 * prepare to pick up next char to process MCW WORK-24&X1,PCHAR * and get it A ONE3,WCOL * process character into INDX MCW L3V0BB,INDXLO * iniialize three char INDX C L1VCMA,PCHAR * is it a comma, low already zeroed BU PCXA * MCW L1V3,INDXMD B PC5 * done PCXA C L1VDOT,PCHAR * is it a period, low already zeroed BU PCXB * MCW L1V1,INDXMD B PC5 * done PCXB C L1VMIN,PCHAR * is it a bar, minus BU PCXC MCW L1V2,INDXMD B PC5 * done PCXC MN PCHAR,INDXLO * move numerical 8421 C PCHAR,ZERO1 * branch if PCHAR <> ZERO BU PC1 MCW L1V4,INDXMD * force index 40 MCW ZERO1,INDXLO B PC5 * zero processed PC1 C L1VZ,PCHAR * branch if PCHAR <= 0 BH PC5 C L1VS,PCHAR * branch if PCHAR < S BL PC2 A ONE1,INDXMD PC2 C L1VJ,PCHAR * branch if PCHAR < J BL PC3 A ONE1,INDXMD PC3 C L1VA,PCHAR * branch if PCHAR < A BL PC4 A ONE1,INDXMD PC4 C C L1VZ,PCHAR * branch if PCHAR in range BE PC5 BL PC5 MCW ZERO3,INDXLO * form blank MCW L1VBL,PCHAR * print blank PC5 NOP * dummy - START MPY BY 14 MCW INDXLO,WORK3 * times 1 A INDXLO,WORK3 * times 2 A INDXLO,WORK3 * times 3 A INDXLO,WORK3 * times 4 A INDXLO,WORK3 * times 5 A INDXLO,WORK3 * times 6 A INDXLO,WORK3 * times 7 A WORK3,WORK3 * times 14 MCW WORK3,INDXLO * back into position - tidy?? A WROW,INDXLO * make INDEX+(2*WROW) A WROW,INDXLO * make INDEX+(2*WROW) A TWO3,INDXLO * add element size * prepare to output MCW PCOL,X3 * output column MCW INDXLO,X1 * pickup proper mask MCW CODEA&X1,MASK2 * * --------------------------------- MCW L3V000,X2 * set up bit select index LOOP1 C BITSEL&X2,MASK2 * do compare BL L2 MCW PCHAR,WCHAR * yes, print special S BITSEL&X2,MASK2 * fix mask MN MASK2,NOZONE MCW NOZONE,MASK2 B L3 L2 MCW L1VBL,WCHAR L3 A L3V002,X2 * go to next bit MCW WCHAR,PRNTA&X3 * print proper character A L3V001,X3 C L1V0,DOUBLE *are we going double? BE L4 * no MCW WCHAR,PRNTA&X3 * print proper character A L3V001,X3 * L4 C L3V009,X2 BL LOOP1 A L3V001,X3 C L1V0,DOUBLE BE L5 A L3V001,X3 L5 MCW X3,PCOL *save column pointer C L3V132,X3 * BL PRINT2 * W *write the print area to the printer - SIMH blanks col 2? B TAPE C L1V0,DOUBLE *are we going double? BE L6 * no * W *write the print area to the printer COMMENTED OUT B TAPE L6 A ONE3,WROW * increment row counter C L3V007,WROW BL PRINT1 * do another row CS 332 * clear printer area CS SW 201 * W *write the print area to the printer - SIMH blanks col 2? B TAPE PRINTX B 0 *** RETURN TO CALL DCW 0 TAPE SBR RTN1&3 BSS SKIP,C C DOLSW,ONE1 * DOLLAR SWITCH IS ON BE SKIP C L1EQU,001 BE SKIP W SKIP BSS RTN1,B LGPM LCA GPMK,333 WT 1,1 RTN1 B 0 DCW 0 DODOL SBR RTN2&3 * SET DON'T PRINT SWITCH LCA ONE1,DOLSW * SET SWITCH TO 1 H * HALT FOR PRESENTOR RTN2 B 0 DCW 0 DOEQU SBR RTN3&3 * SET LONG TAPE RECORD SWITCH LCA LNOP,LGPM * PUT NOP IN SET GROUP MARK LOC H * HALT FOR PRESNETOR RTN3 B 0 DOQUES SBR RTN4&3 H * HALT AND THEN RETURN RTN4 B 0 * * START PRINT TEXT STUFF, 130 COL (65 X 2) UNTIL LIMIT - * MUST HAVE ONE LINE PNTTXT SBR PNTTXX&3 * SET UP RETURN NOP MCW P3V130,X3 * SET UP INDEX FETCH MCW L3V000,X2 * INITIALIZE LINE COUNTER CS 332 * CLEAR TOP OF PRINT AREA SW 201 * ASSURE WORD MARK AT BEGIN PRINT AREA * TOP OF FORM HERE?? PNTCYC C X2,TXLIM BE PNTTXX MCW TXTSTR&X3,330 * MOVE 130 CHAR * W * WRITE TO PRINTER COMMENTED OUT B TAPE * MODIFICATION FOR TAPE MA P3V130,X3 * ADD LENGTH TO FETCH A L3V001,X2 * INCREMENT LINE COUNTER B PNTCYC * AND LOOP MORE PNTTXX B 000 * RETURN FROM SUBROUTINE P3V130 DCW 130 * * * * * GENERAL PARAMETER AREA DOUBLE DCW 0 * ZERO PRINTS SINGLE SIZE * * * * work areas for PRINTS DCW @WCOL:@ WCOL DCW 000 * pickup index from input area DCW @WROW:@ WROW DCW 000 DCW @PCHAR:@ PCHAR DCW 0 WCHAR DCW 0 DCW @INDX:@ INDXHI DCW 1 * fabricate the fancy index INDXMD DC 1 INDXLO DC 1 * INDX EQU INDXLO DCW @MASK2:@ MASK2 DCW @00@ * 2 character mask DCW @WORK3:@ WORK3 DCW 000 DCW @PCOL:@ PCOL DCW 000 DCW @ZERO3@ ZERO3 DCW 000 ZERO1 DCW 0 ONE3 DCW 001 ONE1 DCW 1 TWO3 DCW 002 FIVE3 DCW 005 TWO4S2 DCW 16 TWO3S2 DCW 08 TWO2S2 DCW 04 TWO1S2 DCW 02 ONE2 DCW 01 NOZONE DCW 0 L1V1 DCW @1@ L3V000 DCW @000@ L3V012 DCW @012@ L1VBL DCW @ @ L3V002 DCW @002@ L1V0 DCW @0@ L3V0BB DCW @0 @ L1VCMA DCw @,@ L1V3 DCW @3@ L1VDOT DCW @.@ L1VMIN DCW @-@ L1DOL DCW @$@ L1EQU DCW @=@ L1V2 DCW @2@ L1V4 DCW @4@ L1VZ DCW @Z@ L1VS DCW @S@ L1VJ DCW @J@ L1VA DCW @A@ L3V001 DCW @001@ L3V009 DCW @009@ L3V132 DCW @132@ L3V007 DCW @007@ L3VO79 DCW @079@ DOLSW DCW 0 LNOP DCW @N@ LQUES DCW @?@ BITSEL DCW 16 DCW 08 DCW 04 DCW 02 DCW 01 DCW 00 * * * NEW VARIABLES TXLIM DCW @000@ * TEXT INDEX LIMIT * 1234567890123456789012345 DATE25 DCW @0000000000000000000000000@ * SAVE DATE 25 LONG * * * * WORKING AREAS * ORG 1750 * 1234567890123456789012345678 WORKA DS 0 DS 0 * WORK AREA FOR STRING 25 LONG WORK DCW @0000000000000000000000000@ * * Ron Mak says that blanks process as zeros * * 0 1 2 3 4 * 1234567890123456789012345678901234567890 BLANKS DCW @ @ * SET WORK TO BLANKS LINE3 DCW @VISITED THE COMPUTER @ LINE4 DCW @ HISTORY MUSEUM @ * BCD collating sequence A .lt. Z .lt. 0 .lt. 9 .lt. B * MASK IS 14 CHR BA8421 CODEA DS 0 DC @00000000000000@ DC @04120404040414@ DC @14170102030431@ DC @31020402010114@ DC @02061018310202@ DC @31163001011714@ DC @06081630171714@ DC @31010204080808@ DC @14171714171714@ DC @14171715010212@ DC @00000000001212@ DC @14171717311717@ DC @30171730171730@ DC @14171616161714@ DC @24181717171824@ DC @31161630161631@ DC @31161630161616@ DC @14171623171715@ DC @17171731171717@ DC @14040404040414@ DC @00000031000000@ DC @07020202021812@ DC @17182224221817@ DC @16161616161631@ DC @17272121171717@ DC @17172521191717@ DC @14171717171714@ DC @30171730161616@ DC @14171717212213@ DC @30171730201817@ DC @00000000120408@ DC @00010203041600@ DC @15161614010130@ DC @31040404040404@ DC @17171717171714@ DC @17171717171004@ DC @17171721212110@ DC @17171004101717@ DC @17171710040404@ DC @31010204081631@ DC @14171921251714@ DCW @123456789012345678901234567890@ ORG 2700 GPMK DCW @"@ * GROUP MARK TXTSTR DCW @0@ * NEW LAST CARD IN DECK, TRANSFER ADDRESS END START2 * NEW LAST CARD IN DECK, TRANSFER ADDRESS