.TITLE LIST ;MULTI-COLUMN LISTER ; CHANGE THE VERSON NUMBER! .SBTTL DEFINITIONS .IDENT /781117/ ;MODIFIED BY GCE ;TO OMIT FORM FEED ON FIRST .OPEN, REMOVE ";" IN NEXT LINE ; NOFF1=0 ;THIS VERSION TABS 8 COLUMNS AND ALLOWS LINE TRUNCATION BY "/TR" ;HEADER CAN BE OMITTED BY /NH SWITCH R0=%0 R1=%1 R2=%2 R3=%3 R4=%4 R5=%5 SP=%6 PC=%7 SPACE=40 XCR=15 XLF=12 XFF=14 ;THE FOLLOWING TWO SYMBOLS ARE ONLY USED TO SET BUFFER SIZES. ;THEY REPRESENT THE MAXIMUM PAGE SIZE ;FOR WHICH THE PROGRAM WILL WORK WITHOUT ERROR. THE OUTPUT PAGE ;SIZE MAY BE LESS THAN OR EQUAL TO THE SIZE SPECIFIED. MAXWID=164. ;MAXIMUM # PRINTABLE CHARACTERS IN OUTPUT LINE ;I.E., NOT COUNTING TRAILING CR, LF MAXLIN=66. ;MAXIMUM # LINES ON A PAGE .MCALL CSI$,FSRSZ$,GCMLB$,GCMLD$;RSX11D MACROS .MCALL CSI$1,CSI$2,RCML$,GCML$,OPEN$R,OPEN$W .MCALL CLOSE$,GET$,PUT$ .MCALL FDBDF$,FDAT$A,FDRC$A,FDOP$A;FDB MACROS CSI$ CSBLK: .BLKB C.SIZE .EVEN FSRSZ$ 5 ;5 FILES AT A TIME MAX CMD: GCMLB$ 1,LST,,1 GCMLD$ ;DEFINE OFFSETS TO ERROR BYTES GCMLD$ ;DEFINE OFFSETS .MACRO WRITE LINK,BUFF MOV BUFF,-(SP) ;STACK LINE BUFFER ADR MOV LINK,-(SP) ;STACK LINK BLOCK ADR BIT #SW.RL,SWITCH ;WANT CONSTANT LENGTH RECORDS? BEQ .+6 ; NO JSR PC,COPYRL ; YES, PAD BUFFER JSR PC,RSXWRT ;WRITE VIA RSX CMP (SP)+,(SP)+ ;CLEAN STACK DECB ROLL ;COUNT LINE .ENDM ;RSX11D WRITING SUBROUTINE, CALLED AS FOR A DOS WRITE. ;DECODES COMAND AND FIXES BUFFER HEADER A LA DOS. ;N.B.--TREATS A READ OF A ZERO LENGTH RECORD AS A FLAG ;THAT ENDFILE HAS BEEN SEEN, FOR LACK OF A BETTER WAY TO ;DO IT. .PSECT CODE,RO RSXWRT: MOV R0,-(SP) CLR -(SP) ;FIND SOME MORE WORK SPACE MOV 10(SP),R0 ;BUFFER HDR ADDR OF CALL MOV 4(R0),@SP ;SIZE OF BUFFER (NEEDED FOR OUTPUT) SUB #2,@SP ;NO CRLF OUT. ADD #6,10(SP) ;POINT PAST HEADER TO DATA OR TO ;POINTER TO DATA DUMP=4 ;DOS DUMP MODE BIT BIT #DUMP,2(R0) ;IS IT DUMP MODE? BEQ 1$ ;NO, 10(SP) IS DATA ADDR MOV @10(SP),10(SP) ;YES, GET DATA ADDR NOW 1$: PUT$ 6(SP),10(SP),(SP),ERR1 ;WRITE THE DATA TST (SP)+ ;RESTORE STACK MOV (SP)+,R0 ;AND CALL R0 RTS PC ;(THO' NOT COND CODES) ; ;RSXRED--READ A BUFFER WITH FDB ON STACK INSTEAD OF DOS LINK ;OTHERWISE USES DOS BUFFER HEADER JUNK ; SETS CORRECT DOS BITS. RSXRED: MOV R0,-(SP); ;GET A REG TO USE CLR -(SP) ;AND A CELL ON STACK MOV 10(SP),R0 ;CALL BUFFER HDR BICB #100,3(R0) ;CLEAR EOF INDICATOR MOV @R0,@SP ;ADDR OF MAX SIZE ADD #6,10(SP) ;POINTER DATA OR ADDR OF DATA BIT #DUMP,2(R0) ;TEST DUMP MODE BEQ 1$ ;NOT DUMP MODE; 10(SP) IS DATA ADDR MOV @10(SP),10(SP) ;DUMP MODE. GET DATA ADDR TO STACK 1$: MOV R0,-(SP) ;NEED R0 AFTER READ SO SAVE IT ;IN CASE GET$ SCREWS IT UP. GET$ 10(SP),12(SP),2(SP) BCC 3$ ;CHECK EOF CMPB #IE.EOF,F.ERR(R0) ;SEE IF EOF BNE 3$ ;IF NOT, IGNORE ERR MOV @SP,R0 ;ELSE RETRIEVE POINTER BISB #100,3(R0) 3$: MOV (SP)+,R0 ;RESTORE BUFHDR POINTER MOV 6(SP),-(SP) ;FDB POINTER ADD #F.NRBD,@SP ;ADDR OF BYTE COUNT READ MOV @0(SP),@SP ;GET # BYTES READ MOV @SP,4(R0) ;SAVE IN BUFFER HDER MOV (SP)+,(SP) ;GET ADDR OF END ADD 10(SP),(SP) ;OF DATA MOV R5,-(SP) ;USE R5 A SEC... MOV 10(SP),R5 ;FDB ADDR BITB #3,F.RATT(R5) ;SEE IF INTERNAL C.C. FILE (AS PIP DIRECTORY) BNE 11$ ;NO, SO OUR TERMINATORS OUGHT TO BE OK. ;IF INTERNAL CARRIAGE CONTROL HAS LEADING CRLF, MAKE IT NULLS. REST OF LST ;EXPECTS TRAILING TERMINATORS, NOT LEADING ONES... MOV 12(SP),R5 ;START OF DATA ADDRESS CMPB (R5),#16 ;TERMINATOR? BHIS 2$ ;NO CMPB @R5,#11 ;TAB AND LOWER STAY OK BLOS 2$ CLRB @R5 ;YES, NULL IT. 2$: INC R5 CMPB (R5),#16 ;CHECK 2ND CHAR AS TERMINATOR TOO BHIS 11$ CMPB @R5,#11 ;TEST BELOW AND ABOVE BLOS 11$ CLRB @R5 ;IF TERMINATOR MAKE IT NULL 11$: ;IF SKIPPING LETTERS ON INPUT, NULL OUT N CHARS AT START OF LINE. BIT #SW.SL,SWITCH ;SKIPPING CHARS ON INPUT? BEQ 21$ ;NO, NO ACTION MOV R5,-(SP) ;SAVE R4,R5 MOV R4,-(SP) MOV SKPLTR,R5 ;CHARS TO SKIP BGT 22$ CLR R5 ;DEFAULT TO 0 IF NEGATIVE 22$: CMP R5,4(R0) ;DON'T NULL MORE THAN WE READ BLO 23$ ;IF OK, BRANCH MOV 4(R0),R5 ;R5 HAS # TO NULL (FLUSHED ON OUTPUT) 23$: MOV 16(SP),R4 ;ADDR OF START OF DATA 24$: CLRB (R4)+ ;NULL A BYTE DEC R5 BGT 24$ ;DO ALL THAT WHICH WAS ASKED MOV (SP)+,R4 ;RESTORE R4,R5 MOV (SP)+,R5 ; 21$: MOV (SP)+,R5 ;RESTORE R5 ; ADD CODE TO PERMIT /MS COMPRESS SPACES SWITCH (NULL ALL BUT 1ST OF ; MULTIPLE SPACES BIT #SW.MS,SWITCH ;NULLING MULTIPLE SPACES? BEQ 30$ ;NO, BRANCH MOV R5,-(SP) MOV R4,-(SP) ;YES, SAVE A FEW REGS TO USE HERE MOV R2,-(SP) MOV R3,-(SP) MOV 4(R0),R3 ;GET # CHARS WE READ IN MOV 20(SP),R4 ;AND ADDRESS OF START OF LINE READ CLR R5 ;LAST CHARACTER READ STORAGE HERE... 32$: MOVB (R4)+,R2 ;GET A CHARACTER CMPB R2,#40 ;A SPACE? BNE 33$ ;NO CMPB R5,#40 ;WAS LAST A SPACE? BNE 33$ ;NO, SAVE LAST AND GET NEXT CHARACTER ; LAST CHARACTER WAS A SPACE AND SO IS THIS ONE...NULL THIS ONE CLRB -1(R4) ;NULL SECOND AND LATER SPACES... 33$: MOV R2,R5 ;SAVE LAST CHARACTER SEEN DEC R3 ;COUNT DOWN TILL END BGT 32$ ;DONE WHEN NO MORE CHARS LEFT 31$: MOV (SP)+,R3 ;GET BACK REGS MOV (SP)+,R2 MOV (SP)+,R4 MOV (SP)+,R5 30$: MOVB #15,@0(SP) ;PUT IN CRLF INC @SP MOVB #12,@(SP)+ ADD #4,4(R0) ;ADJUST # BYTES READ COUNTER MOV (SP)+,R0 RTS PC .PSECT DATA,RW .MCALL FDOF$L,FCSBT$,FDBDF$,FDRC$A,FDAT$A,NMBLK$ .MCALL CSI$1,CSI$2,OPEN$R,OPEN$W .MCALL CSI$SW,CSI$ND,CSI$SV FDOF$L ;LOCAL OFFSET DEFS FCSBT$ ;DEFINE BIT NAMES KBIFDB: FDBDF$ ;KB INPUT FDB FDRC$A ,BUF,MAXWID ; DTIFDB: FDBDF$ ;DATA INPUT FDB FDRC$A ,BUF,MAXWID ;DATA ADDR DTOFDB: FDBDF$ ;DATA OUTPUT FDB FDRC$A ,BUFA,MAXWID ;BUFFER FDAT$A R.VAR,,MAXWID ;FILE CHARACTERISTICS .MCALL NBOF$L NBOF$L ;LOCALLY DEFINED NAMEBLK OFSETS KBIFNB: NMBLK$ KBICMD,LST,,TI,0 DTIFNB: NMBLK$ DATA,TMP,,SY,0 DTOFNB: NMBLK$ DATA,LST,,SY,0 ;DEFAULT FILENAME BLOCKS .SBTTL COMMAND STRING PROCESSING .MCALL FINIT$ SPSAV: .WORD 0 ;STACK POINTER SAVE .PSECT CODE,RO LIST: ;INIT & OPEN MOV SP,SPSAV FINIT$ TRY: ;PROMPT HERE ANG GET COMMAND LINE MOV SPSAV,SP ;RESET SP (QUICK; DIRTY) ; FINIT$ CLR SWITC2 CLR SWITCH ;RESET SWITCHES TO DEFAULTS ; ADD RUNTIME FDB INITIALISE ROUTINES .MCALL FDAT$R,FDRC$R,FDOP$R,FDBF$R FDAT$R #DTIFDB,#R.VAR,#FD.CR,#MAXWID,#-2,#-5 FDAT$R #DTOFDB,#R.VAR,#FD.CR,#MAXWID+4,#-2,#-5 FDRC$R #DTIFDB,,#BUF,#MAXWID+4 FDRC$R #DTOFDB,,#BUF,#MAXWID+4 CLR CMAX ;TO 0 COL CLR ROLL0 CLR PADW MOVB #'!,SEPCHR ;SEPARATOR CHARACTER IS INITIALLY "!" ;LEAVE PAGE SIZES ALONE GCML$ #CMD ;USE RSX FACILITY BCC 47$ RCML$ #CMD .MCALL EXIT$S EXIT$S ;LEAVE WHEN SEE EOF 47$: TSTB CMD+G.ERR ;SEE IF ERROR ON READ BPL 48$ EXIT$S ;EXIT TASK ON I/O ERR IN CMD 48$: .IF DF NOFF1 ;OMIT FF ON OUTPUT MOVB #1,OPENLP ;DEVICE OPEN .ENDC ;AS OPEN WILL DO IT ; ISSUE CSI COMMANDS AND OPEN FILES HERE. ;(LOSE IF FILES DON'T EXIST!) MOV #CMD+G.CMLD,R0 ;LEN, ADDR OF STRING READ IN MOV @R0,R1 ;LENGTH MOV 2(R0),R2 ;ADDR CSI$1 #CSBLK,R2,R1 ;COMPRESS OUT SPACES, TABS, ETC. ;NOW PROCESS I/O SPECIFICATIONS. ;NO WILD-CARDS HERE! DTIDSP=C.DSDS+CSBLK DTODSP=DTIDSP ;NOW GET INPUT SPECS AND SWITCHES ; CSI$2 #CSBLK,INPUT,#SWTBL .SBTTL PROCESS (INPUT) SWITCHES DTODSP=DTIDSP MOV #DTIFDB,R0 MOV R0,R1 MOV R0,R2 MOV #DTIFNB,R3 ;SET UP FOR .PARSE ADD #F.DSPT,R2 ADD #F.FNB,R1 JSR PC,.PARSE ;FILL IN DEFAULTS OPEN$R #DTIFDB,#3,#DTIDSP,,#BUF,#MAXWID,ERR1;OPEN INPUT LU3 TST (R3)+ ;PTR TO NEXT # WORDS TO FOLLOW CSI$2 #CSBLK,OUTPUT ;GET OUTPUT FIRST DTIDSP=C.DSDS+CSBLK DTODSP=DTIDSP MOV #DTOFDB,R0 MOV R0,R1 MOV R0,R2 MOV #DTOFNB,R3 ;SET UP FOR .PARSE ADD #F.DSPT,R2 ADD #F.FNB,R1 JSR PC,.PARSE ;FILL IN DEFAULTS OPEN$W #DTOFDB,#4,#DTODSP,,#BUFA,#MAXWID,SCRAM ;OUT LU4 .PAGE .SBTTL CHECK LIMITS ;SET UP VALUES FROM WHATEVER WAS ENTERED MOV LINSIZ,SW.WID MOV CMAX,SW.COL MOV PAGSIZ,SW.LEN MOV ROLL0,SW.ROL MOV PADW,SW.RLN INTERP: JSR R5,LIMITS ;PROCESS VALUE .WORD SW.WID,SW.WI,MAXWID,MINWID,LINSIZ JSR R5,LIMITS ;PROCESS VALUE .WORD SW.LEN,SW.LE,MAXLIN,5.,PAGSIZ JSR R5,LIMITS ;PROCESS VALUE .WORD SW.COL,SW.CO,18.,0,CMAX JSR R5,LIMITS ;PROCESS VALUE .WORD SW.ROL,SW.RO,MAXLIN,5.,ROLL0 JSR R5,LIMITS ;PROCESS VALUE .WORD SW.RLN,SW.RL,MAXWID,MINWID,PADW .SBTTL CORRECT PAGE SIZE FOR HEADER, ETC MOVB PAGSIZ,LMAX ;PAGE SIZE WITH HEADER DECB LMAX ;1 LINE FOR FF BIT #SW.NH,SWITCH ;OMIT HEADER? BNE 1$ ; YES DECB LMAX ; NO, BLANK LINE IN HEADER 1$: .SBTTL COMPUTE COLUMN WIDTHS MOV #1,R4 ;COL # CLR R2 BISB LINSIZ,R2 ;LINE LENGTH MOV #WIDTH,R3 ;ADR FOR COL 1 2$: MOV R4,SDIV1 ;GET MAX WIDTH MOV R2,DDIV1 CLR DDIV2 JSR R5,IDIV MOV DDIV1,R0 MOV DDIV2,R1 ;GET RESULT MOVB R0,(R3)+ ;SAVE IT INC R4 ;ANOTHER COL PER PAGE SUB #2,R2 ;2 CHAR PER DIVIDER CMP #19.,R4 ;DONE ALL? (TABLE ALLOWS UP TO 20.) BHIS 2$ ; NO, DO NEXT .SBTTL PROCESS FORM FEED MOVB #XFF,FORM+6 ;ASSUME FF BIT #SW.ED,SWITCH ;WANT ^D? BEQ 3$ ; NO MOVB #4,FORM+6 ; YES, ^D 3$: .SBTTL DATA FILE PROCESSING .SBTTL CREATE LIST HEADER MOV #DASH,R3 ;HEADER BUFFER ADR MOV R3,R0 ;GET COPY MOVB LINSIZ,R2 ;LINE LENGTH FILL: MOVB #'-,(R0)+ ;DASHES TO HEADER DECB R2 BNE FILL MOV R3,R0 ;BACK AT LEFT MOV #VERSON,R1 ;VERSION # AT LEFT MOV #VERLEN,R2 FILLV: MOVB (R1)+,(R0)+ ;VERSION TO HEADER DEC R2 BGT FILLV MOVB #SPACE,(R0)+ BISB LINSIZ,R2 ;RIGHT SIDE ADD #2,R2 ;COUNT CR LF MOV R2,HEADER+4 ;ACTUAL BYTE COUNT ADD R3,R2 ;PT TO END+1 MOV #TALSIZ,R0 ;SIZE OF RIGHT INFO MOV #TAIL,R1 ;RIGHT SIDE INFO 1$: MOVB -(R1),-(R2) ;COPY RIGHT SIDE DEC R0 BGT 1$ INC R2 ;LOCATION FOR DATE JSR PC,RSAV MOV #Z22$,R5 ;OUTPUT ADDR JSR PC,CVTDT ;CONVERT DATE TO ASCII JSR PC,RRES ;POP REGS AGAIN MOV R0,-(SP) MOV R1,-(SP) MOV R2,-(SP) MOV #9.,R0 MOV #Z22$,R1 23$: MOVB (R1)+,(R2)+ DEC R0 BNE 23$ ;COPY TEXT BR Z24$ .PSECT DATA,RW Z22$: .ASCII /04-JUL-76/;DUMMY DATE FOR NOW .EVEN .PSECT CODE,RO Z24$: MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 ;RESTORE REGS USED ADD #20,R2 ;FOR PAGE # (TENS) MOV R2,PAGEAD ;SAVE IT BISB WIDTH+1,R0 ;CENTER-1 SUB #7,R0 ;START OF NAME ADD #DASH,R0 ;PTR TO IT MOV R0,-(SP) ;FILL IN DUMMY NAME TOO FOR STARTERS MOV R1,-(SP) MOV R2,-(SP) ;PUT IN FILENAME FROM FILENAME BLK MOV #DTIFDB,R1 ;FDB ADD #F.FNB,R1 ;OFFSET TO FNB MOV R1,-(SP) ;SAVE ADD #N.FNAM,R1 ;6 BYTES OF NAME MOV #Z32$,R2 MOV R0,-(SP) MOV (R1)+,R0 JSR PC,RADUP ADD #3,R2 MOV (R1)+,R0 JSR PC,RADUP ADD #3,R2 ;GET LAST 3 CHARS OF NAME MOV (R1)+,R0 ;RAD50 JSR PC,RADUP ;CONVERT TO ASCII MOV (SP)+,R0 MOV (SP)+,R1 ADD #N.FTYP,R1 ADD #4,R2 MOV R0,-(SP) MOV @R1,R0 JSR PC,RADUP MOV (SP)+,R0 MOV #13.,R2 ;FILNAM.EXT MOV #Z32$,R1 ;DUMMY NAME 33$: MOVB (R1)+,(R0)+ DEC R2 BNE 33$ BR Z34$ .PSECT DATA,RW Z32$: .ASCII /FILNAME .EXT/ .EVEN .PSECT CODE,RO Z34$: MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 ADD #6,R0 ADD #4,R0 .SBTTL PROCESS AN INPUT PAGE .SBTTL INITIALIZE ZOTGO: CLR PAGEN ;LAST PAGE # MOV #2,R2 ;CONSTANT CLRB EOD ;MORE IN FILE CLR OVRFLO ;NO COLUMN OVERFLOW CLRB VAR ;ASSUME # COLS SPECIFIED DECB CMAX ;MAP 1-10. TO 0-9 MOVB CMAX,R0 ;GET FOR INDEX BGE 1$ ;# SPECIFIED INCB VAR ;VARIABLE # COLS MOVB #18.,CMAX ;MAXIMUM OF 18. COLS CLR R0 ;USE SINGLE COL MAX 1$: MOVB WIDTH(R0),WIDE ;WIDTH BEFORE TRUNCATION .SBTTL NEXT PAGE NEWPAG: MOVB WIDTH,AVAIL ;FOR VARIABLE # COLS CLRB AVAIL+1 MOV #L,PL ;FIRST LINE IN MOV #C,PCO ; FIRST COL MOV #BLOCK,R4 ;SET PAGE BUFFER PTR CLRB COL ;TO COUNT COLS .SBTTL NEXT COLUMN NEWCOL: CLRB LINE ;TO COUNT UP # LINES ON PAGE MOV R4,@PL ;SAVE PTR TO COLUMN HEAD CLRB MAX ;LONGEST LINE FOR VAR # COLS .SBTTL NEXT LINE NEWLIN: JSR PC,READL ;GET NEXT LINE CMPB R3,MAX ;THIS LONGEST IN COL? BLOS 4$ ; NO MOVB R3,MAX ;SET NEW MAX TSTB VAR ;VARIABLE # COLS? BEQ 4$ ; NO, SKIP FOLLOWING JUNK .PAGE CMPB R3,AVAIL ;STILL FIT ON PAGE? BLOS 4$ ; YES MOV @PL,PP ;SAVE COL HEAD FOR NEXT PAGE JSR PC,PRINT ;PRINT PAGE ;SET NEW PAGE VARIABLES CLRB COL ;NO COLS ON NEW PAGE MOV #L,PL ;SET PL TO FIRST COL MOV #C,PCO ;RESET COLUMN INDEX MOV #BLOCK,R4 ;SET PTR TO PAGE BUFFER MOV R4,L ;SET PTR TO FIRST COL ALSO MOVB WIDTH,AVAIL ;# CHAR POSITIONS LEFT CLRB AVAIL+1 ;COPY EXTRA LINES TO BUFFER TOP MOVB LINE,R5 ;# LINES ON PAGE INC R5 MOV PP,R1 ;PTR TO FIRST LINE IN BUFFER 1$: MOVB (R1)+,R3 ;GET LINE CHARACTER COUNT MOVB R3,(R4)+ ; & COPY IT BEQ 3$ ;SKIP IF EMPTY LINE 2$: MOVB (R1)+,(R4)+ ;COPY LINE DECB R3 BNE 2$ ;0 TO 256, NOT -128 TO 127 3$: DECB R5 ;ONE LESS LINE BGT 1$ ;COPY REST OF LINES 4$: INCB LINE ;ANOTHER LINE ON PAGE CMPB LINE,LMAX ;MORE FIT? BLT NEWLIN ; YES CLR R0 BISB MAX,R0 ;LONGEST LENGTH IN COL MOVB R0,@PCO ;SAVE IT INC PCO ;MOVE PTRS TO NEXT COL ADD R2,PL ; FOR NEXT TIME INCB COL ;ONE LESS COLUMN CMPB COL,CMAX ;MORE COLS ON PAGE? BGT 5$ ; NO, PAGE FULL ADD R2,R0 ;# CHARS REQUIRED TO LIST COL SUB R0,AVAIL ;# CHARS LEFT ON PAGE BGT 6$ ;PAGE FULL .PAGE .SBTTL OUTPUT A PAGE 5$: JSR PC,PRINT ;PRINT FULL PAGE TSTB EOD ;MORE? BEQ NEWPAG ; YES BR DONE 6$: TSTB EOD ;MORE? BEQ NEWCOL ; YES JSR PC,PRINT ;PRINT FULL PAGE BR DONE ERTXT: .ASCII /LST--ERROR IN FILE PROCESSING/ ERSIZ=.-ERTXT .EVEN ERR1: NOP ERR2: NOP .MCALL QIOW$S QIOW$S #IO.WVB,#5,#5,,,,<#ERTXT,#ERSIZ,#40> TST (SP)+ ;JUNK CALL VIA JSR PC. .SBTTL COMPLETION PROCESSING .SBTTL CLOSE INPUT FILE DONE: CLOSE$ #DTIFDB,SCRAM ;CLOSE & RELEASE BCS SCRAM ;CAN'T CLOSE--EXIT. .SBTTL CLOSE OUTPUT FILE CLOSE$ #DTOFDB,SCRAM ;CLOSE & RELEASE BCS SCRAM ;IF CLOSE FAILS, LEAVE .IF NDF,ONCEO. JMP TRY .ENDC SCRAM: EXIT$S ;LEAVE. LIST DOESN'T RE-INITIALIZE CORRECTLY. .SBTTL SUBROUTINES .SBTTL LIMITS: CHECK ON SWITCH VALUES ; JSR R5,LIMITS ; .WORD ADR OF VALUE ENTERED (IN SWITCH TABLE) ; .WORD SWITCH BIT ; .WORD MAXIMUM VALUE ; .WORD MINIMUM VALUE ; .WORD ADR OF BYTE VARIABLE LIMITS: MOV @(R5)+,R0 ;LAST SPECIFIED VALUE BIT (R5)+,SWITCH ;SWITCH SPECIFIED? BNE 1$ ; YES TST (R5)+ ;SKIP MAX VALUE BR 3$ ; & USE LAST VALUE 1$: CMP (R5)+,R0 ;CHECK MAX BHIS 2$ ; OK MOV -2(R5),R0 ;CLAMP HI 2$: CMP (R5),R0 ;CHECK MIN BLOS 3$ ; OK MOV (R5),R0 ;CLAMP LO 3$: TST (R5)+ ;PT TO VARIABLE PTR MOVB R0,@(R5)+ ;SET VALUE INTO VARIABLE RTS R5 ;LEAVE .SBTTL COPYRL: PAD LINES TO SAME LENGTH COPYRL: MOV R0,-(SP) ;SAVE REGS MOV R1,-(SP) MOV R2,-(SP) MOV #BUFOUT,R0 ;PAD INTO BUFOUT CMP R0,6+2+2(SP) ;USING BUFOUT? BEQ 2$ ; YES, DON'T HAVE TO COPY MOV 6+2+2(SP),R1 ;GET BUFFER HEADER ADR MOV R0,6+2+2(SP) ; & REPLACE WITH BUFOUT ADD #4,R0 ;PT TO ACTUAL BYTE COUNT ADD #4,R1 MOV (R1)+,R2 ;DATA LENGTH CMP #MAXWID+2,R2 ;TOO LONG? BHIS 10$ ; NO MOV #MAXWID+2,R2 ; YES, CLAMP AT BUFFER SIZE 10$: MOV R2,(R0)+ ;COPY IT 1$: MOVB (R1)+,(R0)+ ;COPY BUFFER DEC R2 BGT 1$ 2$: MOV #BUFOUT+4,R0 ;PT TO BYTE COUNT CLR R2 BISB PADW,R2 ;GET TOTAL WIDTH ADD #2,R2 ;FOR CR, LF MOV (R0),R1 ;CURRENT LENGTH (INC. CR, LF) MOV R2,(R0) ;SET CONSTANT LENGTH ADD R1,R0 ;PT TO CR SUB R1,R2 ;AMOUNT TO PAD BGT 3$ ; MUST PAD ADD R2,R0 ;TRUNCATE BR 4$ 3$: MOVB #SPACE,(R0)+ ;PAD DEC R2 BGT 3$ ; MORE 4$: .IIF DF,VRSATK,MOVB #'!,-1(R0) ;VERSATEK MUST HAVE NON-BLANK AT END MOVB #XCR,(R0)+ ;INSERT CR MOVB #XLF,(R0)+ ; & LF MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RTS PC .SBTTL READL: READ A LINE READL: MOV R4,CHRCNT ;CHARACTER COUNT BYTE PTR CLR R3 ;CHAR COUNT MOV OVRFLO,R1 ;PNT TO NEXT CHAR IN LINE BEQ 1$ ; NO OVERFLOW .SBTTL FINISH LAST LINE OVERFLOW, IF ANY MOVB #'>,-(R1) ;PUT "-->" IN PLACE MOVB #'-,-(R1) MOVB #'-,-(R1) CLR OVRFLO ;CLEAR OVERFLOW FLAG BR 2$ ;HAVE LINE WITH R1 SET .SBTTL READ NEXT INPUT LINE 1$: MOV #BUFIN,-(SP) ;PUSH BUF HDR MOV #DTIFDB,-(SP) ;PUSH FDB JSR PC,RSXRED ;READ (GET) DATA CMP (SP)+,(SP)+ ;RESTORE STACK BITB #100,BUFIN+3 ;EOD? BNE EOT ; YES MOV #BUF,R1 ;SET R1 TO PT TO NEW LINE 2$: .PAGE CLRB (R4)+ ;ZERO CHARACTER COUNT BYTE MOV #10,R5 ;SET FIRST TAB STOP .SBTTL PROCESS NEXT CHARACTER NEXTC: MOVB (R1),R0 ;GET NEXT CHAR BEQ IGNORE ;IGNORE NULLS BIT #SW.UC,SWITCH ;CASE TRANSLATION NEEDED? BEQ CKSPC ;NO. BITB #100,(R1) ;IF 100 BIT ON, THEN 40 BIT OFF IF SPEC. BEQ CKSPC BICB #40,(R1) ;CONVERT LOWER TO UPPER CASE CKSPC: CMP #40,R0 ;SEE IF SPECIAL BLOS MOVE ; NO, COPY CHARACTER SUB #15,R0 BEQ EOL ;CR BGT CONTROL ;OUTPUT ^X ADD R2,R0 BGT FF ;FF BEQ EOL ;VT ADD R2,R0 BGT EOL ;LF BLT CONTROL ;001-010 BIT #SW.CT,SWITCH ;WANT TO KEEP TABS? BEQ TAB ; YES MOVB #SPACE,(R1) ;REPLACE TAB WITH SPACE BR MOVE .SBTTL CONTROL CHARACTER CONTROL:BISB #100,(R1) ;FORCE PRINTABLE MOVB #'^,(R4)+ ;INSERT ^ CHARACTER BR SPEC .SBTTL IGNORE CHARACTER IGNORE: INC R1 BR NEXTC .SBTTL FORM FEED FF: BIT #SW.FF,SWITCH ;WANT TO KEEP FFS? BEQ EOL ; NO TSTB LINE ;AT TOP OF COLUMN? BEQ EOL ; YES, DON'T BLANK WHOLE COLUMN BR E1 ;YES, FILL COLUMN WITH BLANK LINES .PAGE .SBTTL TAB TAB0: ADD #10,R5 ;MOVE TO NEXT TAB STOP TAB: CMP R3,R5 ;AT TAB STOP? BGE TAB0 ;MOVE TO NEXT INC R1 ;SKIP TAB IN INPUT LINE TAB1: MOVB #SPACE,(R4)+ ;FILL WITH SPACES INC R3 ;COUNT CHARACTER CMPB R3,WIDE ;MORE FIT IN LINE? BHIS TOWIDE ; NO, FULL CMPB R3,R5 ;AT TAB STOP? BLO TAB1 ; NO, GET ANOTHER SPACE BR NEXTC .SBTTL UNINTERESTING MOVE: MOVB (R1)+,(R4)+ ;COPY CHARACTER SPEC: INC R3 ;COUNT CHARACTER CMPB R3,WIDE ;MORE FIT IN LINE? BLO NEXTC ; YES, GET NEXT .SBTTL CHECK FOR COLUMN OVERFLOW TOWIDE: BIT #SW.TR,SWITCH ;WANT TO TRUNCATE LINES? BNE EOL ; YES, END LINE NOW CMPB #XCR,(R1) ;IF AT CR BEQ EOL ; NO OVERFLOW MOV R1,OVRFLO ;SAVE NEXT CHARACTER PTR/SET FLAG .SBTTL LINE FEED - END OF LINE EOL: MOVB R3,@CHRCNT ;INSERT LINE BYTE COUNT RTS PC .SBTTL END OF INPUT FILE EOT: INCB EOD ;REMEMBER SAW EOD E1: CLRB (R4)+ ;FILL REST COLUMN WITH INCB LINE CMPB LINE,LMAX ;NEED MORE? BLO E1 ; YES E2: RTS PC .PAGE .SBTTL WRITE A PAGE .SBTTL FIND COLUMN PADDING WIDTHS PRINT: MOVB COL,R3 ;ACTUAL # COLUMNS TSTB VAR ;VARIABLE # COLS? BEQ 2$ ; NO MOV R3,SDIV1 MOV AVAIL,DDIV1 ;FIND # EXTRA CHARACTERS PER COLUMN CLR DDIV2 JSR R5,IDIV MOV DDIV1,R0 MOV DDIV2,R1 1$: MOVB C-1(R3),R1 ;GET COL WIDTH ADD R0,R1 ;ADD # EXTRA CHARS MOVB R1,C-1(R3) ;UPDATE # DEC R3 BGT 1$ BR 3$ 2$: MOVB WIDE,C-1(R3) ; DEC R3 BGT 2$ 3$: .SBTTL SETUP & OUTPUT APPROPRIATE HEADER INC PAGEN ;GET PAGE # JSR PC,RSAV ;SAVE REGS MOV PAGEN,R0 ;GET # TO CONVERT JSR PC,BIN2D ;CONVERT IT JSR PC,RRES ;POP REGS AGAIN MOV PAGEAD,-(SP) ;PTR TO TENS DIGIT DEC @SP ;MAKE IT POINT AT HUNDREDS CMPB ZZ+2,#'0 ;ZERO? BNE 100$ ;NO MOVB #40,ZZ+2 ;YES, REPLACE WITH SPACE 100$: MOVB ZZ+2,@(SP) ;IN ANY CASE, COPY HUNDREDS DIGIT INC @SP ;PASS HUNDREDS DIGIT;POINT TO TENS MOVB ZZ+3,-(SP) ;COPY TENS DIGIT CMPB #'0,(SP) ;IF NOT 0, BNE 4$ ; KEEP IT MOVB #SPACE,(SP) ;REPLACE WITH SPACE 4$: MOVB (SP)+,@(SP) ;INSERT TENS CHARACTER INC (SP) ;PT TO UNITS MOVB ZZ+4,@(SP)+ ;COPY UNITS DIGIT CMP PAGEN,#1 ;ALLOW 1ST PAGE TO BE ;WRITTEN IN ANY CASE BLE LETGO BIT #SW.PA,SWITCH ;/PAUSE OPTION ON? BEQ LETGO ;NO, FORGET IT. ;PUT A WAIT ON READING CONSOLE HERE. GCML$ #CMD,#PAUSES,#PAULEN BR X54$ PAUSES: .ASCII <15><12>/LIST PAUSE>/ PAULEN=.-PAUSES ;LET MACRO FIGURE OUT HOW LONG STRING IS! .EVEN X54$: BCC LETGO RCML$ #CMD ;RESET LEVEL JMP DONE ;EXIT IF ^Z ON PAUSE LETGO: .PAGE BIT #SW.RO,SWITCH ;ROLL PAPER? BEQ 9$ ; NO MOV #BUFOUT+4,R5 ;PT TO ACTUAL BYTE COUNT MOVB LINSIZ,(R5) ;SET IT TO FULL WIDTH MOV (R5),-(SP) ;SAVE COUNT ADD #2,(R5)+ ; FOR CR, LF 10$: MOVB #'=,(R5)+ ;CREATE PAGE DIVIDER DEC (SP) ; MORE? BGT 10$ ; YES TST (SP)+ ;DROP COUNTER MOVB #XCR,(R5)+ ;INSERT CR MOVB #XLF,(R5)+ ; & LF MOVB ROLL0,ROLL ;SET PAGE LENGTH WRITE #DTOFDB,#BUFOUT ;WRITE DIVIDER WRITE #DTOFDB,#SKIP ; & SKIP A LINE BR 11$ ;SKIP PAGED JUNK 9$: .IF DF NOFF1 TSTB OPENLP ;FIRST TIME? BNE 4$ ; YES, OMIT FF .IFTF BIT #SW.NP,SWITCH ;NO PAGE SEPARATORS? BNE 46$ WRITE #DTOFDB,#FORM 46$: .IFT 4$: CLRB OPENLP ;NO LONGER FIRST TIME .ENDC 11$: BIT #,SWITCH ;OMIT HEADER? BNE 5$ ; YES WRITE #DTOFDB,#HEADER ;WRITE HEADER WRITE #DTOFDB,#SKIP ; & SKIP A LINE 5$: .SBTTL FORM & OUTPUT LINES MOVB LMAX,R5 ;COUNT DOWN # LINES MOVB COL,-(SP) ;SAVE # COLS ON PAGE NEWL: MOV #L,PL ;START AT FIRST COL MOV #C,PCO MOVB (SP),COL ;# COLS ON PAGE MOV #BUFA,R1 ;PT TO OUTPUT LINE BUFFER .PAGE NEWC: MOV @PL,R4 ;PT TO LINE IN COL CLR R0 BISB (R4)+,R0 ;# CHAR IN LINE MOV R0,R3 ;SAVE IT FOR PADDING BEQ 2$ ;LINE EMPTY 1$: MOVB (R4)+,(R1)+ ;COPY CHARACTER DEC R0 BGT 1$ ; AND DO NEXT 2$: MOV R4,@PL ;SAVE PTR TO NEXT LINE IN COL DECB COL ;ONE LESS COL TO DO BEQ CRLF ;DONE BISB @PCO,R0 ;GET COL WIDTH FOR PAD SUB R3,R0 ;# SPACES REQ'D 3$: MOVB #SPACE,(R1)+ DEC R0 BGE 3$ ;EXTRA SPACE FOR DIVIDER BIT #SW.SC,SWITC2 ;SEPARATOR CHARACTER SPECIFIED? BEQ 102$ ;NO, SEE IF BLANK WANTED BIT #SW.BS,SWITC2 ;SPECIFIED SEPARATOR AND BLANK? BEQ 100$ ;NO ; BOTH /SC AND /BL SWITCHES SET. REMOVE EXTRA BLANK AND USE CHAR. DEC R1 ;**** EXPERIMENTAL *** FORGET EXTRA BLANK ;IF USING BLANK AS SEPARATOR. BR 100$ 102$: BIT #SW.BS,SWITC2 ;WANT BLANK AS SEPARATOR? BEQ 100$ ;NO MOVB #40,(R1)+ BR 101$ ;YES. FILL IT IN 100$: MOVB SEPCHR,(R1)+ ;NO, FILL IN SEPARATOR (INITIALLY "!") ; MOVB #'!,(R1)+ 101$: ADD R2,PL ;MOVE TO NEXT COL INC PCO BR NEWC CRLF: MOVB #XCR,(R1)+ MOVB #XLF,(R1)+ SUB #BUFOUT+6,R1 ;GET LINE LENGTH MOV R1,BUFOUT+4 ;SET ACTUAL BYTE COUNT WRITE #DTOFDB,#BUFOUT DECB R5 ;MORE LINES? BGT NEWL ; YES MOVB (SP)+,COL ;CLEAN STACK BIT #SW.RO,SWITCH ;ROLL PAPER? BEQ 2$ ; NO 1$: TSTB ROLL ;NEED ANOTHER LINE? BLE 2$ ; NO WRITE #DTOFDB,#SKIP BR 1$ 2$: RTS PC .PSECT DATA,RW .SBTTL WRITE COMMAND MESSAGE .SBTTL FILE CONTROL BLOCKS SEPCHR: .WORD "!! ;SEPARATOR CHARACTER FOR COLUMNS BUFIN: .WORD MAXWID .WORD 20 .WORD 0 BUF: .BLKB MAXWID+2 .SBTTL LINE BUFFERS LPBK: .WORD MAXWID+2,4,0,0 PDIBUF: .WORD 2,0,2 ;CHARACTERS FOR USER TO TYPE .BLKW 2 ;IF /PAUSE REQUESTED BUFOUT: .WORD MAXWID+2 .WORD 20 .WORD 0 BUFA: .BLKB MAXWID+2+2 ;(SAFTEY) .PAGE .SBTTL VARIABLES COL: .BYTE 0 ;COLUMN COUNTER .EVEN CMAX: .WORD 0 ;MAX # COLS .EVEN ;LINE MUST BE EVEN LINE: .BYTE 0 ;COUNT DOWN LINES LMAX: .BYTE 0 ;# TEXT LINES/PAGE .EVEN PAGSIZ: .WORD 60. ;CURRENT # LINES PER PAGE(INCL. HEADER) .EVEN LINSIZ: .WORD 130. ;# PRINT POSITIONS (EXCL. CR, LF) MAX: .BYTE 0 ;MAX # CHAR IN COL SO FAR VAR: .BYTE 0 ;NZ => VARIABLE # COLS .EVEN ;WIDE MUST BE EVEN, ; NOTE HIGH BYTE USUALLY 0 WIDE: .BYTE 0 ;MAX # CHARACTERS PER COLUMN EOD: .BYTE 0 ;NZ => SAW EOD ROLL0: .WORD 56. ;LINE PER ROLL PAGE ROLL: .BYTE 0 ;LINES LEFT TO GO .EVEN PADW: .WORD 132. ;RECORD LENGTH FOR /RL SKPLTR: .WORD 0 ;# INPUT LETTERS TO SKIP IF /SL:NNN ASKED .IF DF,NOFF1 OPENLP: .BYTE 0 ;0 => DOING FIRST FILE .ENDC .EVEN AVAIL: .WORD 0 ;# FREE CHARACTER POSITIONS REMAINING ON PAGE CHRCNT: .WORD 0 ;PTR TO LINE BYTE COUNT BYTE OVRFLO: .WORD 0 ;NZ IS ADR OF NEXT CHAR IN OVERFLOW LINE PAGEAD: .WORD 0 ;PTR TO PAGE TENS IN HEADER PAGEN: .WORD 0 ;LAST PAGE # ZZ: .ASCII /00001/<0> ;FOR DECIMAL ASCII PP: .WORD 0 ;SAVE FOR @PL(I+1) PL: .WORD 0 ;PTR TO CURRENT L PCO: .WORD 0 ;PTR TO CURRENT C L: .BLKW 20. ;ADR OF FIRST LINE OF ITH COLUMN IN BLOCK C: .BLKB 20. ;WIDTH OF ITH COLUMN ;TABLE OF FIXED COLUMN WIDTHS WIDTH: .BLKB 20. ; ENTRY I IS: MAXWID+2-<2*I>/2 .PAGE .EVEN DDIV1: .WORD 0 ;VAR FOR DEVIDE ROUTINE DDIV2: .WORD 0 SDIV1: .WORD 0 SMUL1: .WORD 0 ;VAR FOR MUL ROUTINE DMUL1: .WORD 0 SAVE: .WORD 0 ;MULTIPLY / DIVIDE ROUTINE .SBTTL SWITCHES .EVEN SWITC2: .WORD 0 ;MORE SWITCH FLAGS SW.SC=1 ;SEPARATOR CHARACTER SW.BS=2 ;BLANK SEPARATE SWITCH: .WORD 0 ;SWITCH FLAGS SW.MAX=40000 ;LEFTMOST SWITCH BIT SW.MS=40000 ;REMOVE MULTIPLE SPACES (MAKE SINGLE SPACES) IF /MS ;SWITCH SET SW.SL=20000 ;SKIP LETTERS /SL:NNN TO SKIP NNN CHARS ON INPUT ;IN EACH RECORD SW.NP=10000 ;NO PAGES (NO FORMFEED OR HEADER) SW.UC=4000 ;CONVERT LOWER TO UPPER CASE .WORD "UC,0 SW.RL=2000 ;FIXED LENGTH LINES .WORD "RL,132. SW.RLN=.-2 SW.RO=1000 ;ROLL PAPER .WORD "RO,56. SW.ROL=.-2 SW.CT=400 ;CHANGE TAB TO SPACE .WORD "CT,0 ;NO ARGS SW.ED=200 ;USE ^D INSTEAD OF FF .WORD "ED,0 SW.PA=100 ;PAUSE OPTION .WORD "PA,0 SW.WI= 40 ;WIDTH OPTION .WORD "WI,127. SW.WID=.-2 SW.LE= 20 ;LENGTH OPTION .WORD "LE,60. SW.LEN=.-2 SW.CO= 10 ;# COLUMNS .WORD "CO,0. SW.COL=.-2 SW.FF =4 ;RETAIN FF OPTION .WORD "FF,0 SW.NH =2 ;NO HEADER OPTION .WORD "NH,0 SW.TR =1 ;TRUNCATE OPTION .WORD "TR,0 .EVEN .PSECT CODE,RO SWTBL: CSI$SW UC,SW.UC,SWITCH ;UPPER CASE /UC SWITCH CSI$SW RL,SW.RL,SWITCH,,,RLTBL ; /RL:NNNNN CSI$SW RO,SW.RO,SWITCH,,,ROTBL; /RO:NNNNN CSI$SW CT,SW.CT,SWITCH ;COMPRESS TABS /CT CSI$SW ED,SW.ED,SWITCH ; /ED CSI$SW PA,SW.PA,SWITCH ;/PAUSE (NYA) CSI$SW WI,SW.WI,SWITCH,,,WITBL ;/WI:NNN CSI$SW LE,SW.LE,SWITCH,,,LETBL ;/LE:NNN CSI$SW CO,SW.CO,SWITCH,,,COTBL ;/CO:N CSI$SW FF,SW.FF,SWITCH ;/FF CSI$SW NH,SW.NH,SWITCH ;/NH NO HDR CSI$SW TR,SW.TR,SWITCH ;/TRUNCATE COL CSI$SW NP,SW.NP,SWITCH ;/NP NO PAGE SEPARATORS CSI$SW SL,SW.SL,SWITCH,,,SLTBL ;/SL:NNN SKIP LETTERS CSI$SW MS,SW.MS,SWITCH ;/MS MAKE MULTIPLE SPACES SINGLE SP'S CSI$SW SC,SW.SC,SWITC2,,,SCTBL ;/CS:CHAR FILL IN COLUMN SEPARATOR CHR CSI$SW BS,SW.BS,SWITC2 ;/BS BLANK SEPARATOR FOR COLUMNS CSI$ND ;END TABLE CSI$SV DECIMAL,PADW,2,RLTBL CSI$SV DECIMAL,ROLL0,2,ROTBL CSI$SV DECIMAL,LINSIZ,2,WITBL CSI$SV DECIMAL,PAGSIZ,2,LETBL CSI$SV DECIMAL,CMAX,2,COTBL CSI$SV DECIMAL,SKPLTR,2,SLTBL CSI$SV ASCII,SEPCHR,1,SCTBL CSI$ND .PSECT DATA,RW .PAGE .SBTTL TEXT STRINGS L3: .WORD LL3 .BYTE 15,12,0,0,0,0,0 VERSON: .ASCII /LIST-11 VR3.20/ VERLEN=.-VERSON .BYTE XCR,XLF LL3=.-L3-2 .EVEN .IF EQ,1 ;NEVER TRUE THAT 1=0 !! L4: .WORD LL4 .ASCII <0><0><0>/#/<13> LL4=.-L4-2 .EVEN L5: .WORD LL5 .ASCII <15><12>/*/<13> ;STANDARD PROMPT LL5=.-L5-2 .ENDC .EVEN HEADER: .WORD MAXWID+2,0,0 DASH: .BLKB MAXWID+2 PAGE: .ASCII / XX-XXX-XX PAGE XX /<15><12> TAIL: TALSIZ=TAIL-PAGE MINWID=10.*6 .IF LT MINWID-VERLEN MINWID=VERLEN .ENDC .IF LT MINWID-TALSIZ MINWID=TALSIZ .ENDC .EVEN FORM: .WORD 3,0,3 ;FORM FEED .BYTE 14,15,12 ;OR ^D IF /ED .EVEN SKIP: .WORD 3,0,3 ;CR LF .BYTE SPACE,XCR,XLF .SBTTL PAGE BUFFER .EVEN BLOCK: .BLKB <*MAXLIN> ; PCO -> C, PL -> L ; C CONTAINS WIDTH OF CURRENT COLUMN ; L CONTAINS ADDRESS IN BLOCK OF START OF CURRENT LINE ; BLOCK CONTAINS PACKED LINES: ; FIRST BYTE IS # CHARACTERS TO FOLLOW ; FOLLOWED BY CHARACTERS FROM LINE .PSECT CODE,RO IDIV: JSR PC,RSAV MOV #SDIV1,R1 MOV #DDIV1,R0 JSR PC,DIVD JSR PC,RRES RTS R5 IMUL: JSR PC,RSAV MOV #SMUL1,R1 MOV #DMUL1,R0 JSR PC,MULT JSR PC,RRES RTS R5 RSAV: MOV R0,-(SP) ;SAVE REGISTERS MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) JMP @12.(SP) RRES: MOV (SP)+,12.(SP) ;STORE RETURN ADDRESS MOV (SP)+,R5 ;RESTORE REGISTERS MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RTS PC ; PDP-11 FLOATING POINT PACKAGE ; INTEGER MULTIPLY ; INTEGER DIVIDE ; ; MODULES INCLUDED: ; 1. MUL ; 2. DIV ; ; ; ; R0 = %0 R1 = %1 R2 = %2 R3 = %3 R4 = %4 R5 = %5 SP = %6 PC = %7 MULT: MOV @R0,R5 ;PICK UP THE MULTIPLIER MOV @R1,R1 ;PICK UP THE MULTIPLICAND CLR R3 ;ZIP-ZAP-ZOWIE AND SWOSH CLR R4 TST R5 BGE .+6 ;-> ;TEST SIGN AND CHANGE IF NECESSARY NEG R5 ; I ;CHANGE SIGN INC R3 ; I ;REMEMBER THE ORIGINAL SIGN TST R1 ;<- ;TEST THE OTHER WORD BGE .+6 ;-> SAME TEST AS BEFORE NEG R1 ; I ;NEGATE TO CHANGE THE SIGN DEC R3 ; I ;USE THE OPPOSITE SIGN MANAGEMENT MOV #21,R2 ;<- ;SET UP THE CYCLE COUNTER M.ML1: CLC ;CLEAR CARRY FOR ROTATES ROR R4 ;SHIFT MULTIPLIER AND PARTIAL PRODUCT ROR R5 BCC .+4 ;-> ;CHECK AND SEE IF AN ADDITION IS NEEDED ADD R1,R4 ; I ;ADD MULTIPLIER TO PARTIAL PRODUCT DEC R2 ;<- ;DECREMENT COUNTER BGT M.ML1 ;BREANCH IF MORE TO DO TST R3 ;TEST SIGN CHANGE WORD BEQ .+10 ;-> ;BRANCH AROUND THE ADJUSTMENT NEG R4 ; I NEG R5 ; I SBC R4 ; I ;DO A DOUBLE PRECISION NEGATION MOV R5,(R0)+;<- MOV R4,@R0 ;MOVE THE PRODUCT TO DESTINATION RTS PC ;RETURN TO THE CALLER DIVD: CLR -(SP) ;SET UP A SIGN CONTROL WORD MOV (R0)+,R3 ;PICK UP THE MOV (R0)+,R2 ;DOUBLE PRECISION DIVIDEND BGE .+14 ;-> ;CHECK THE SIGN DECB 1(SP) ; I ;KEEP TRACK OF THE ORIGINAL NEG R2 ; I ;SIGN AND NEGATE NEG R3 ; I ;THE ORIGINAL NUMBER SBC R2 ; I MOV (R1)+,R4;<- ;PICK UP THE DIVISOR BEQ M.DVV ;DIVISION BY ZERO IS A NO-NO BGT .+6 ;-> ;CHECK THE SIGN INC @SP ; I ;AND KEEP TRACK AS ABOVE NEG R4 ; I MOV R4,R5 ;<- ;MOVE THE DIVISOR AND NEG R5 ;NEGATE FOR THE ALGORITHM ADD R5,R2 ;PREFORM THE INITIAL SUBTRACTION BCS M.DVV ;CARRY SET IS AN OVERFLOW MOV #20,-(SP) ;SET UP A COUNTER CLR -(SP) ;THIS IS A LASTING CARRY BIT M.DV1: ROL R3 ;ROTATE ONE LEFT ROL R2 TST @SP ;CHECK THE LAST CARRY BEQ M.DV2 ;IF ZERO ADD ELSE SUBTRACT CLR @SP ;CLEAR THE CARRY ADD R5,R2 ;DO ONE MORE STEP BR M.DV3 M.DV2: ADD R4,R2 ;-2N+N=N FOR THIS STEP M.DV3: ADC @SP ;KEEP IT A WHILE BEQ .+4 ;-> ;IF ZERO OMIT UPDATE INC R3 ; I ;NO CARRY POSSIBLE DEC 2(SP) ;<- ;DECREMENT COUNTER BGT M.DV1 ;BRANCH IF MORE TO DO ROR R3 ;SEE ABOUT THE LAST CYCLE BCS M.DV4 ;OMIT CORRECTION IF ONE ADD R4,R2 ;CORRECT REMAINDER CLC M.DV4: ROL R3 ;REPLACE THE LAST BIT CMP (SP)+,(SP)+ ;POP TWO WORDS TST @SP ;TEST FOR REMAINDER CHANGES BGE .+12 ;-> ;OMIT IF POSITVE NEG R2 ; I ;NEGATE REMAINDER CLRB 1(SP) ; I ;CLEAR SIGN DEC @SP ; I ;BUT DO A GOOD JOB ON QUOTIENT CMP #100000,R3;<- ;TEST FOR THE BUG IN THE ALGORITHM BLO M.DVV ;EXIT WITH ERROR OF TOO BIG BEQ M.DVC ;CHECK FOR OVERFLOW M.DV6: TST (SP)+ ;TEST FOR QUOTIENT ADJUSTMENT BEQ M.DV5 ;IF ZERO NONE NEEDED NEG R3 ;NEGATE QUOTIENT M.DV5: MOV R2,-(R0) ;MOVE REMAINDER MOV R3,-(R0) ;THEN QUOTIENT TO DEST. RTS PC M.DVV: TST (SP)+ ;REMOVE SIGN WORD SEV ;SET OVERFLOW RTS PC M.DVC: TST (SP) ;TEST FOR NEGATIVE BEQ M.DVV ;IF POSITIVE THEN OOPS! BR M.DV6 ;IF NEGATIVE OK ; ROUTINES TO HANDLE DATE AND BINARY TO ASCII UTILITY ; CONVERSIONS RADTBL: .ASCII / ABCDEFGHIJKLMNOPQRSTUVWXYZ.$?0123456789/ .EVEN ;RAD50 CHARACTER SET TABLE RADUP: MOV R0,-(SP) ;R0 CONTAINS RADPACKED CODE ON ENTRY MOV R1,-(SP) MOV R2,-(SP) ;R2 HAS ADDR TO PUT ASCII IN MOV R3,-(SP) MOV #3,R3 ;3 CHARS ADD #3,R2 ;TRANSLATE RIGHT TO LEFT 1$: MOV R0,R1 ;PUT # IN ODD REG CLR R0 CLC DIV #50,R0 ;DIVIDE TO GET REMAIND. IN R1, QUOT IN R0 MOVB RADTBL(R1),-(R2) ;STICK INTO USER AREA SOB R3,1$ ;DO ALL 3 CHARS MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RTS PC BIN2D: JSR PC,RSAV ;SAVE REGS MOV #5,R4 ;CONVERT ENTRY R0 TO 5 ASCII NUMBERS MOV #ZZ+5,R3 ;IN ZZ, IN DECIMAL FOR PAGE # 1$: MOV R0,R1 ;R0 HAS NUMBER, R3 HAS OUTPUT CLR R0 CLC DIV #12,R0 ;DIVIDE BY 10 TO GET DIGIT ADD #60,R1 ;ADD ASCII ZONES MOVB R1,-(R3) SOB R4,1$ JSR PC,RRES ;PUT REGS BACK RTS PC ; ;DATE CONVERTING ROUTINES ; MONTHS: .ASCII /-FOO-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV/ .ASCII /-DEC-FOO/ .EVEN .PSECT DATA,RW TIMBUF: TIMYR: .WORD 0;YEAR TIMMON: .WORD 0 TIMDA: .WORD 0 ;DAY OF MONTH .BLKW 5 ;OTHER JUNK .PSECT CODE,RO CVTDT: JSR PC,RSAV .MCALL GTIM$S GTIM$S #TIMBUF ;GET DATE, TIME, ETC. AND ;SAVE ASCII DATE STUFF IN AREA POINTED AT ;BY ENTRY R5. MOV R5,R2 ;PREPARE FOR DAY FIRST MOV TIMDA,R0 ;CONVERT DAY JSR PC,NUM ;TO 2 ASCII DIGITS MOV TIMMON,R1 ASL R1 ASL R1 ;MULT MONTH BY 4 ADD #MONTHS,R1 ;GET ADDR OF 4 ASCII CHARS ADD #2,R5 ;POINT R5 PAST DAY .REPT 4 MOVB (R1)+,(R5)+ .ENDR MOVB #'-,(R5)+ ;ADD A SECOND "-" AFTER MONTH MOV R5,R2 MOV TIMBUF,R0 ;YEAR-1900 JSR PC,NUM ;CONVERT ASCII JSR PC,RRES ;PUT REGS BACK RTS PC ;THAT'S ALL ; ;NUMBER CONVERT SUB TO GIVE 2 ASCII DIGITS FROM ENTRY R0 ;PUTTING RESULT WHERE R2 POINTS NUM: JSR PC,RSAV MOV R0,R1 CLR R0 DIV #12,R0 ;DIV ON EVEN REG ADD #60,R0 ADD #60,R1 ;ADD ASCII TO QUOT AND REM MOVB R0,(R2)+ MOVB R1,(R2)+ ;PUT OUT # JSR PC,RRES RTS PC .END LIST