************************************************************************* * * * SPOOL.S * * * * PURPOSE: * * * * Maps argument lists from user programs and from * * the runtime library into a format acceptable for * * a FORTRAN generated spool subroutine. * * * * METHOD: * * * * 1. from this file: remove the code between the two * * comments STARTINSERT, ENDINSERT. * * 2. compile your modified version of spool.for * * "f77 -jr spool.for" * * DO NOT MODIFY the argument list of spool.for unless * * you intend to modify this file as well! * * 3. Using the system editor, remove the assembler END * * directive from the file spool.asm (from step 2) * * 4. insert the file spool.asm (from step 3) between * * the two comment lines STARTINSERT, ENDINSERT. * * 5. assemble and link * * "/c/assem spool.s -o spool.o" * * "/c/alink spool.o to spool.sub" * * * * USAGE: * * * * see the file spool.for, the documentation 'SPOOL', and * * the PROGRAM STATEMENT - ELIST in the Absoft FORTRAN * * reference manual. * * * ************************************************************************* * * Copyright (C) 1986 - ABSOFT Corporation Royal Oak, Michigan 48072 * * Edit history: * * 31 Mar 86 file created for Tektronix 4404 AIS with UniFLEX JAK * 03 Apr 86 converted to AMIGA JAK * 07 Apr 86 added 'who' argument setting to simplfy spool.for JAK * * * equates from f77sys: * A7RST EQU 46 * ENTRY STACK RESET ADDRESS PRI EQU $50 * PRINTER FROM PROGRAM STATEMENT SWI EQU $54 * SWITCHES FROM PROGRAM STATEMENT COP EQU $56 * COPIES FROM PROGRAM STATEMENT LPP EQU $5C * LPP FROM PROGRAM STATEMENT WID EQU $5D * WIDTH FROM PROGRAM STATEMENT FILE EQU $84 * POINTER TO FILE DDB ..SPOOL BRA.S USER * ENTRY FOR CALLS FROM FORTRAN BSR MKFORK * ENTRY FOR CALLS FROM RUNTIME LIBRARY LINK A6,#-26 * BUFFER SPACE MOVE.W #6,-(A7) * LENGTH 'PRINTER' NAME MOVE.W #55,-(A7) * LENGTH 'FILE' NAME MOVEA.L FILE(A0),A1 * LOAD ADDRESS FILE DDB LEA 26(A1),A1 * INDEX THE FILENAME MOVE.L A1,-(A7) * SET ADDRESS OF FILENAME LEA -6(A6),A2 * LOAD ADDRESS PRINTER UNPACKING BUFFER MOVE.L A2,-(A7) * SET ADDRESS 'PRINTER' MOVEQ #0,D7 MOVE.W PRI(A0),D7 * LOAD FIRST WORD PACKED NAME BSR UNPACK * UNPACK IT MOVEQ #0,D7 MOVE.W PRI+2(A0),D7 * SECOND WORD PRINTER NAME BSR UNPACK LEA -6(A6),A2 MOVEQ #0,D1 MOVE.W SWI(A0),D1 * SWITCHES SPECIFIED? BNE.S RUN1 * YES --> SET THEM MOVEQ #36,D1 * NO, USE THE DEFAULTS RUN1: BSR.S SETARG MOVE.W COP(A0),D1 * NUMBER OF COPIES SPECIFIED? BNE.S RUN2 * YES --> SET COPIES MOVEQ #1,D1 * NO, DEFAULT = 1 COPY RUN2: BSR.S SETARG MOVE.B LPP(A0),D1 * LINES PER PAGE SPECIFIED BNE.S RUN3 * YES --> SET LPP MOVEQ #66,D1 * NO, DEFAULT = 66 RUN3: BSR.S SETARG MOVE.B WID(A0),D1 BSR.S SETARG MOVEQ #1,D1 * SET 'who' to RUNTIME LIBRARY BSR.S SETARG BSR.S USER1 * EXECUTE SPOOL ADDA.W #32,A7 * POP ARGS UNLK A6 * RELINQUISH LOCAL STORAGE RTS * - set: set up an argument for calling a FORTRAN subroutine SETARG: MOVEA.L (A7)+,A3 * LOAD RETURN ADDRESS MOVE.L D1,-(A2) * SET VALUE OF ARGUMENT MOVE.L A2,-(A7) * SET ADDRESS OF ARGUMENT MOVEQ #0,D1 * CLEAR ARG REGISTER FOR NEXT USE JMP (A3) * RTS USER: BRA ARGS * REFORMAT ARGLIST TO FULL LIST * following code was generated by compiling a FORTRAN subroutine with the * 'jr' options (don't forget to remove the "end" directive,if any): USER1: * STARTINSERT---insert spool.s ( <--'f77 +jr spool.for') below this line--- XDEF .SPOOL .SPOOL: MOVE.L #L00001-L00002,D1 L00002: LEA L00002(PC,D1.L),A1 LINK A6,#-64 MOVEA.L A7,A3 * subroutine spool(file,printer,switch,copies,lpp,width,who) * CR = 13 MOVE.B #13,62(A3) * LF = 10 MOVE.B #10,63(A3) * inquire(file=trim(file),size=kx,exist=exist) LEA 100(A0),A1 MOVEQ #78,D4 L00003: CLR.L (A1)+ DBF D4,L00003 MOVEA.L 32(A6),A1 MOVEQ #0,D1 MOVE.W 36(A6),D1 LEA (A1),A1 MOVEQ #0,D5 JSR 24(A4) JSR 356(A4) LEA 1326(A0),A1 MOVE.L D5,D1 JSR 28(A4) CLR.B (A1) LEA 52(A3),A1 MOVE.L A1,192(A0) LEA 4(A3),A1 MOVE.L A1,128(A0) JSR 60(A4) * if ((.not.exist).or.(kx=0)) RETURN MOVE.L 4(A3),D0 NOT.L D0 MOVE.L D0,-(A7) MOVE.L 52(A3),D0 TST.L D0 SEQ D0 EXT.W D0 EXT.L D0 OR.L (A7)+,D0 BEQ.L L00004 UNLK A6 RTS L00004: * pr = printer ; if (pr=" ") pr=DEFPRNTR MOVEA.L 28(A6),A1 MOVEQ #0,D1 MOVE.W 38(A6),D1 LEA (A1),A1 MOVEQ #0,D5 JSR 24(A4) MOVEQ #20,D1 LEA 8(A3),A1 JSR 28(A4) MOVEQ #20,D1 MOVEQ #0,D5 LEA 8(A3),A1 JSR 24(A4) BSR.S L00005 DC.B 32,0 L00005: MOVEA.L (A7)+,A1 MOVEQ #1,D1 JSR 24(A4) JSR 344(A4) SEQ D0 EXT.W D0 EXT.L D0 BEQ.L L00006 MOVEQ #0,D5 BSR.S L00007 DC.B 80,82,84,58,82,65,87,0 L00007: MOVEA.L (A7)+,A1 MOVEQ #7,D1 JSR 24(A4) MOVEQ #20,D1 LEA 8(A3),A1 JSR 28(A4) L00006: * lp = lpp ; if (lp<=6) lp = 66 ! minimum page = 6 lines MOVEA.L 16(A6),A1 MOVE.L (A1),D0 MOVE.L D0,36(A3) SUBQ.L #6,D0 SLE D0 EXT.W D0 EXT.L D0 BEQ.L L00008 MOVE.L #66,36(A3) L00008: * wi = width ; if (wi<0) wi = 0 ! no width adjustments MOVEA.L 12(A6),A1 MOVE.L (A1),D0 MOVE.L D0,32(A3) TST.L D0 SLT D0 EXT.W D0 EXT.L D0 BEQ.L L00009 CLR.L 32(A3) L00009: * sl = switch .and.(delete+headers+FFend+noformat) MOVEQ #20,D0 MOVEQ #64,D1 ADD.L D1,D0 ADD.L #32768,D0 MOVEA.L 24(A6),A1 MOVE.L (A1),D1 AND.L D1,D0 MOVE.L D0,28(A3) * if (sl = 0) sl = delete+no_head+FFend TST.L D0 SEQ D0 EXT.W D0 EXT.L D0 BEQ.L L00010 MOVEQ #36,D0 MOVEQ #64,D1 ADD.L D1,D0 MOVE.L D0,28(A3) L00010: * if ((wi<>0).and.(wi<66)) sl = sl .and.(.not.headers) MOVE.L 32(A3),D0 TST.L D0 SNE D0 EXT.W D0 EXT.L D0 MOVE.L D0,-(A7) MOVE.L 32(A3),D0 MOVEQ #66,D1 CMP.L D1,D0 SLT D0 EXT.W D0 EXT.L D0 AND.L (A7)+,D0 BEQ.L L00011 MOVEQ #16,D0 NOT.L D0 MOVE.L 28(A3),D1 AND.L D1,D0 MOVE.L D0,28(A3) L00011: * if ((lp=66).and.(headers.and.sl)) then MOVE.L 36(A3),D0 MOVEQ #66,D1 CMP.L D1,D0 SEQ D0 EXT.W D0 EXT.L D0 MOVE.L D0,-(A7) MOVEQ #16,D0 MOVE.L 28(A3),D1 AND.L D1,D0 MOVE.L D0,D1 MOVE.L (A7)+,D0 AND.L D1,D0 BEQ.L L00012 * lpp = 66 ! no adjustment for defaults MOVEA.L 16(A6),A1 MOVE.L #66,(A1) * elseif (headers.and.sl) then BRA.L L00013 L00012: MOVEQ #16,D0 MOVE.L 28(A3),D1 AND.L D1,D0 BEQ.L L00014 * lp = lp - 3 ! room for footer and header SUBQ.L #3,36(A3) * elseif (lp=66) then ! no header with default... BRA.L L00013 L00014: MOVE.L 36(A3),D0 MOVEQ #66,D1 CMP.L D1,D0 SEQ D0 EXT.W D0 EXT.L D0 BEQ.L L00015 * lp = 72 ! ...lpp, make lpp 72 MOVE.L #72,36(A3) * endif L00015: L00013: * DO (copies times) MOVEA.L 20(A6),A1 MOVE.L (A1),D0 MOVE.L D0,D6 BRA.L L00018 L00016: * open(IN,file=file,form="unformatted",status="old") LEA 100(A0),A1 MOVEQ #78,D4 L00020: CLR.L (A1)+ DBF D4,L00020 MOVEQ #1,D0 MOVE.W D0,202(A0) MOVEA.L 32(A6),A1 MOVEQ #0,D1 MOVE.W 36(A6),D1 LEA (A1),A1 MOVEQ #0,D5 JSR 24(A4) LEA 1326(A0),A1 MOVE.L D5,D1 JSR 28(A4) CLR.B (A1) MOVEQ #0,D5 BSR.S L00021 DC.B 117,110,102,111,114,109,97,116,116,101,100,0 L00021: MOVEA.L (A7)+,A1 MOVEQ #11,D1 JSR 24(A4) MOVE.B (A5),140(A0) MOVE.B 1(A5),141(A0) ADDA.L D5,A5 MOVE.B #100,-(A5) MOVE.B #108,-(A5) MOVE.B #111,-(A5) MOVEQ #3,D1 MOVE.L D1,D5 MOVE.B (A5),196(A0) MOVE.B 1(A5),197(A0) ADDA.L D5,A5 JSR 40(A4) * open(OUT,file=pr,form="unformatted",status="new") LEA 100(A0),A1 MOVEQ #78,D4 L00022: CLR.L (A1)+ DBF D4,L00022 MOVEQ #2,D0 MOVE.W D0,202(A0) MOVEQ #20,D1 MOVEQ #0,D5 LEA 8(A3),A1 JSR 24(A4) LEA 1326(A0),A1 MOVE.L D5,D1 JSR 28(A4) CLR.B (A1) MOVEQ #0,D5 BSR.S L00023 DC.B 117,110,102,111,114,109,97,116,116,101,100,0 L00023: MOVEA.L (A7)+,A1 MOVEQ #11,D1 JSR 24(A4) MOVE.B (A5),140(A0) MOVE.B 1(A5),141(A0) ADDA.L D5,A5 MOVE.B #119,-(A5) MOVE.B #101,-(A5) MOVE.B #110,-(A5) MOVEQ #3,D1 MOVE.L D1,D5 MOVE.B (A5),196(A0) MOVE.B 1(A5),197(A0) ADDA.L D5,A5 JSR 40(A4) * if ((sl.and.noformat)<>0) then ! for unformatted, pure... MOVE.L 28(A3),D0 MOVE.L #32768,D1 AND.L D1,D0 TST.L D0 SNE D0 EXT.W D0 EXT.L D0 BEQ.L L00024 * read(IN,iostat=kx) c ! ...byte stream, just copy LEA 100(A0),A1 MOVEQ #78,D4 L00026: CLR.L (A1)+ DBF D4,L00026 MOVEQ #1,D0 MOVE.W D0,202(A0) LEA 52(A3),A1 MOVE.L A1,148(A0) PEA 56(A3) PEA $00000001 MOVE.L #262145,-(A7) MOVEQ #1,D5 JSR 36(A4) ADDA.W #12,A7 * do while (kx=0) ! ...IN to OUT L00027: MOVE.L 52(A3),D0 TST.L D0 SEQ D0 EXT.W D0 EXT.L D0 BEQ.L L00030 * write(OUT) c LEA 100(A0),A1 MOVEQ #78,D4 L00031: CLR.L (A1)+ DBF D4,L00031 MOVEQ #2,D0 MOVE.W D0,202(A0) MOVE.L A5,-(A7) PEA 56(A3) PEA $00000001 MOVE.L #262145,-(A7) ST 210(A0) MOVEQ #1,D5 JSR 32(A4) ADDA.W #12,A7 MOVEA.L (A7)+,A5 * read(IN,iostat=kx) c LEA 100(A0),A1 MOVEQ #78,D4 L00032: CLR.L (A1)+ DBF D4,L00032 MOVEQ #1,D0 MOVE.W D0,202(A0) LEA 52(A3),A1 MOVE.L A1,148(A0) PEA 56(A3) PEA $00000001 MOVE.L #262145,-(A7) MOVEQ #1,D5 JSR 36(A4) ADDA.W #12,A7 * repeat BRA.L L00027 L00030: * else ! formatted output BRA.L L00025 L00024: * pn = 1 ! page number = 1 MOVE.L #1,40(A3) * ln = 0 ! line number = 0 CLR.L 44(A3) * cc = 0 ! column zero CLR.L 48(A3) * if (sl.and.headers) then MOVE.L 28(A3),D0 MOVEQ #16,D1 AND.L D1,D0 BEQ.L L00033 * call outhd(pn,file) MOVEM.L D6/A5,-(A7) SUBQ.W #4,A7 PEA 40(A3) MOVEA.L 32(A6),A1 PEA (A1) MOVE.W 36(A6),10(A7) MOVE.L #.OUTHD-L00035,D1 L00035: JSR L00035(PC,D1.L) ADDA.W #12,A7 MOVEM.L (A7)+,D6/A5 MOVEA.L A7,A3 * ln = 3 ! outhd puts out 3 lines MOVE.L #3,44(A3) * endif L00033: L00034: * do L00036: * READ(IN,iostat=kx) c ! transfer data and filter... LEA 100(A0),A1 MOVEQ #78,D4 L00040: CLR.L (A1)+ DBF D4,L00040 MOVEQ #1,D0 MOVE.W D0,202(A0) LEA 52(A3),A1 MOVE.L A1,148(A0) PEA 56(A3) PEA $00000001 MOVE.L #262145,-(A7) MOVEQ #1,D5 JSR 36(A4) ADDA.W #12,A7 * 100 if (kx<>0) exit ! ...until end of file L00041: MOVE.L 52(A3),D0 TST.L D0 SNE D0 EXT.W D0 EXT.L D0 BEQ.L L00042 BRA.L L00039 L00042: * if(c=CR.or.c=LF) then MOVE.B 56(A3),D0 EXT.W D0 EXT.L D0 MOVE.B 62(A3),D1 EXT.W D1 EXT.L D1 CMP.L D1,D0 SEQ D0 EXT.W D0 EXT.L D0 MOVE.L D0,-(A7) MOVE.B 56(A3),D0 EXT.W D0 EXT.L D0 MOVE.B 63(A3),D1 EXT.W D1 EXT.L D1 CMP.L D1,D0 SEQ D0 EXT.W D0 EXT.L D0 OR.L (A7)+,D0 BEQ.L L00043 * if(endlin(c,who,cc,pn,ln,wi,lp)) then MOVEM.L D6/D7/A5,-(A7) SUBA.W #14,A7 PEA 56(A3) MOVEA.L 8(A6),A1 PEA (A1) PEA 48(A3) PEA 40(A3) PEA 44(A3) PEA 32(A3) PEA 36(A3) MOVE.L #.ENDLIN-L00045,D1 L00045: JSR L00045(PC,D1.L) ADDA.W #42,A7 MOVEM.L (A7)+,D6/D7/A5 MOVEA.L A7,A3 TST.L D0 BEQ.L L00046 * if (sl.and.headers) then MOVE.L 28(A3),D0 MOVEQ #16,D1 AND.L D1,D0 BEQ.L L00048 * write(OUT) CR,LF,CR,LF,CR,LF ! soft form feed LEA 100(A0),A1 MOVEQ #78,D4 L00050: CLR.L (A1)+ DBF D4,L00050 MOVEQ #2,D0 MOVE.W D0,202(A0) MOVE.L A5,-(A7) PEA 62(A3) PEA $00000001 MOVE.L #262145,-(A7) PEA 63(A3) PEA $00000001 MOVE.L #262145,-(A7) PEA 62(A3) PEA $00000001 MOVE.L #262145,-(A7) PEA 63(A3) PEA $00000001 MOVE.L #262145,-(A7) PEA 62(A3) PEA $00000001 MOVE.L #262145,-(A7) PEA 63(A3) PEA $00000001 MOVE.L #262145,-(A7) ST 210(A0) MOVEQ #6,D5 JSR 32(A4) ADDA.W #72,A7 MOVEA.L (A7)+,A5 * ln = 3 ! outhd puts out 3 lines MOVE.L #3,44(A3) * call outhd(pn,file) MOVEM.L D6/D7/A5,-(A7) SUBQ.W #4,A7 PEA 40(A3) MOVEA.L 32(A6),A1 PEA (A1) MOVE.W 36(A6),10(A7) MOVE.L #.OUTHD-L00051,D1 L00051: JSR L00051(PC,D1.L) ADDA.W #12,A7 MOVEM.L (A7)+,D6/D7/A5 MOVEA.L A7,A3 * if (c<>0) then ! flush any look ahead MOVE.B 56(A3),D0 EXT.W D0 EXT.L D0 TST.L D0 SNE D0 EXT.W D0 EXT.L D0 BEQ.L L00052 * write(OUT) c ! character from endlin LEA 100(A0),A1 MOVEQ #78,D4 L00054: CLR.L (A1)+ DBF D4,L00054 MOVEQ #2,D0 MOVE.W D0,202(A0) MOVE.L A5,-(A7) PEA 56(A3) PEA $00000001 MOVE.L #262145,-(A7) ST 210(A0) MOVEQ #1,D5 JSR 32(A4) ADDA.W #12,A7 MOVEA.L (A7)+,A5 * cc = 1 MOVE.L #1,48(A3) * endif L00052: L00053: * endif L00048: L00049: * endif L00046: L00047: * else BRA.L L00044 L00043: * write(OUT) c ! output the character LEA 100(A0),A1 MOVEQ #78,D4 L00055: CLR.L (A1)+ DBF D4,L00055 MOVEQ #2,D0 MOVE.W D0,202(A0) MOVE.L A5,-(A7) PEA 56(A3) PEA $00000001 MOVE.L #262145,-(A7) ST 210(A0) MOVEQ #1,D5 JSR 32(A4) ADDA.W #12,A7 MOVEA.L (A7)+,A5 * cc = cc + 1 ! count it ADDQ.L #1,48(A3) * if((cc>=wi).and.(wi<>0))then ! full line? MOVE.L 48(A3),D0 CMP.L 32(A3),D0 SGE D0 EXT.W D0 EXT.L D0 MOVE.L D0,-(A7) MOVE.L 32(A3),D0 TST.L D0 SNE D0 EXT.W D0 EXT.L D0 AND.L (A7)+,D0 BEQ.L L00056 * do while((c<>10).and.(c<>13)) L00058: MOVE.B 56(A3),D0 EXT.W D0 EXT.L D0 MOVEQ #10,D1 CMP.L D1,D0 SNE D0 EXT.W D0 EXT.L D0 MOVE.L D0,-(A7) MOVE.B 56(A3),D0 EXT.W D0 EXT.L D0 MOVEQ #13,D1 CMP.L D1,D0 SNE D0 EXT.W D0 EXT.L D0 AND.L (A7)+,D0 BEQ.L L00061 * read(IN,iostat=kx) c ! yes, truncate the line LEA 100(A0),A1 MOVEQ #78,D4 L00062: CLR.L (A1)+ DBF D4,L00062 MOVEQ #1,D0 MOVE.W D0,202(A0) LEA 52(A3),A1 MOVE.L A1,148(A0) PEA 56(A3) PEA $00000001 MOVE.L #262145,-(A7) MOVEQ #1,D5 JSR 36(A4) ADDA.W #12,A7 * if (kx<>0) exit MOVE.L 52(A3),D0 TST.L D0 SNE D0 EXT.W D0 EXT.L D0 BEQ.L L00063 BRA.L L00061 L00063: * repeat BRA.L L00058 L00061: * GOTO 100 BRA.L L00041 * endif L00056: L00057: * endif L00044: * repeat BRA.L L00036 L00039: * if (FFend.and.sl)write(OUT)char(12) ! trailing Form feed MOVEQ #64,D0 MOVE.L 28(A3),D1 AND.L D1,D0 BEQ.L L00064 LEA 100(A0),A1 MOVEQ #78,D4 L00065: CLR.L (A1)+ DBF D4,L00065 MOVEQ #2,D0 MOVE.W D0,202(A0) MOVE.L A5,-(A7) MOVEQ #12,D0 MOVE.B D0,-(A5) MOVEQ #1,D1 MOVE.L D1,D5 MOVE.L A5,-(A7) PEA $00000001 MOVE.W D5,-(A7) MOVE.W #1,-(A7) ST 210(A0) MOVEQ #1,D5 JSR 32(A4) ADDA.W #12,A7 MOVEA.L (A7)+,A5 L00064: * close(IN) LEA 100(A0),A1 MOVEQ #78,D4 L00066: CLR.L (A1)+ DBF D4,L00066 MOVEQ #1,D0 MOVE.W D0,202(A0) JSR 44(A4) * close(OUT) LEA 100(A0),A1 MOVEQ #78,D4 L00067: CLR.L (A1)+ DBF D4,L00067 MOVEQ #2,D0 MOVE.W D0,202(A0) JSR 44(A4) * endif ! formatted/unformatted IF L00025: * Repeat ! next copy L00018: SUBQ.L #1,D6 BGE.L L00016 L00019: * if (delete.and.sl) then ! if deletion flag set.. MOVEQ #4,D0 MOVE.L 28(A3),D1 AND.L D1,D0 BEQ.L L00068 * open(IN,file=file,status="old") ! ...delete the input file LEA 100(A0),A1 MOVEQ #78,D4 L00070: CLR.L (A1)+ DBF D4,L00070 MOVEQ #1,D0 MOVE.W D0,202(A0) MOVEA.L 32(A6),A1 MOVEQ #0,D1 MOVE.W 36(A6),D1 LEA (A1),A1 MOVEQ #0,D5 JSR 24(A4) LEA 1326(A0),A1 MOVE.L D5,D1 JSR 28(A4) CLR.B (A1) MOVE.B #100,-(A5) MOVE.B #108,-(A5) MOVE.B #111,-(A5) MOVEQ #3,D1 MOVE.L D1,D5 MOVE.B (A5),196(A0) MOVE.B 1(A5),197(A0) ADDA.L D5,A5 JSR 40(A4) * close(IN,status="delete") LEA 100(A0),A1 MOVEQ #78,D4 L00071: CLR.L (A1)+ DBF D4,L00071 MOVEQ #1,D0 MOVE.W D0,202(A0) MOVEQ #0,D5 BSR.S L00072 DC.B 100,101,108,101,116,101 L00072: MOVEA.L (A7)+,A1 MOVEQ #6,D1 JSR 24(A4) MOVE.B (A5),196(A0) MOVE.B 1(A5),197(A0) ADDA.L D5,A5 JSR 44(A4) * endif L00068: L00069: * return ! from spool UNLK A6 RTS * end L00001: DC.W 0 DC.W 0 XDEF .ENDLIN .ENDLIN: MOVE.L #L00073-L00074,D1 L00074: LEA L00074(PC,D1.L),A1 LINK A6,#-10 MOVEA.L A7,A3 * logical function endlin(c,who,cc,pn,ln,wi,lp) * endlin = .not.NEWPAG ! default endlin to not a new page MOVEQ #-1,D0 NOT.L D0 MOVE.L D0,(A3) * CR = 13 ! integer*4 to integer*1 MOVE.B #13,5(A3) * co = 0 ! nothing in look-a-head buffer CLR.B 4(A3) * if (who=USER) then ! called by user? MOVEA.L 28(A6),A1 MOVE.L (A1),D0 TST.L D0 SEQ D0 EXT.W D0 EXT.L D0 BEQ.L L00075 * if (c=10) write(OUT) CR ! yes, if necessary LF to CRLF MOVEA.L 32(A6),A1 MOVE.B (A1),D0 EXT.W D0 EXT.L D0 MOVEQ #10,D1 CMP.L D1,D0 SEQ D0 EXT.W D0 EXT.L D0 BEQ.L L00077 LEA 100(A0),A1 MOVEQ #78,D4 L00078: CLR.L (A1)+ DBF D4,L00078 MOVEQ #2,D0 MOVE.W D0,202(A0) MOVE.L A5,-(A7) PEA 5(A3) PEA $00000001 MOVE.L #262145,-(A7) ST 210(A0) MOVEQ #1,D5 JSR 32(A4) ADDA.W #12,A7 MOVEA.L (A7)+,A5 L00077: * write(OUT) c LEA 100(A0),A1 MOVEQ #78,D4 L00079: CLR.L (A1)+ DBF D4,L00079 MOVEQ #2,D0 MOVE.W D0,202(A0) MOVE.L A5,-(A7) MOVEA.L 32(A6),A1 PEA (A1) PEA $00000001 MOVE.L #262145,-(A7) ST 210(A0) MOVEQ #1,D5 JSR 32(A4) ADDA.W #12,A7 MOVEA.L (A7)+,A5 * elseif (c=13) then BRA.L L00076 L00075: MOVEA.L 32(A6),A1 MOVE.B (A1),D0 EXT.W D0 EXT.L D0 MOVEQ #13,D1 CMP.L D1,D0 SEQ D0 EXT.W D0 EXT.L D0 BEQ.L L00080 * write(OUT) c ! put out the CR LEA 100(A0),A1 MOVEQ #78,D4 L00081: CLR.L (A1)+ DBF D4,L00081 MOVEQ #2,D0 MOVE.W D0,202(A0) MOVE.L A5,-(A7) MOVEA.L 32(A6),A1 PEA (A1) PEA $00000001 MOVE.L #262145,-(A7) ST 210(A0) MOVEQ #1,D5 JSR 32(A4) ADDA.W #12,A7 MOVEA.L (A7)+,A5 * read(IN,iostat=i) c ! look ahead, part of a pair (CRLF)? LEA 100(A0),A1 MOVEQ #78,D4 L00082: CLR.L (A1)+ DBF D4,L00082 MOVEQ #1,D0 MOVE.W D0,202(A0) LEA 6(A3),A1 MOVE.L A1,148(A0) MOVEA.L 32(A6),A1 PEA (A1) PEA $00000001 MOVE.L #262145,-(A7) MOVEQ #1,D5 JSR 36(A4) ADDA.W #12,A7 * if (i<>0) return ! no, end of file --> return MOVE.L 6(A3),D0 TST.L D0 SNE D0 EXT.W D0 EXT.L D0 BEQ.L L00083 MOVE.L (A3),D0 UNLK A6 RTS L00083: * if (c=10) then MOVEA.L 32(A6),A1 MOVE.B (A1),D0 EXT.W D0 EXT.L D0 MOVEQ #10,D1 CMP.L D1,D0 SEQ D0 EXT.W D0 EXT.L D0 BEQ.L L00084 * write(OUT) c ! yes, write it out LEA 100(A0),A1 MOVEQ #78,D4 L00086: CLR.L (A1)+ DBF D4,L00086 MOVEQ #2,D0 MOVE.W D0,202(A0) MOVE.L A5,-(A7) MOVEA.L 32(A6),A1 PEA (A1) PEA $00000001 MOVE.L #262145,-(A7) ST 210(A0) MOVEQ #1,D5 JSR 32(A4) ADDA.W #12,A7 MOVEA.L (A7)+,A5 * else BRA.L L00085 L00084: * co = c ! no, save char in look-a-head buffer MOVEA.L 32(A6),A1 MOVE.B (A1),D0 MOVE.B D0,4(A3) * endif L00085: * else BRA.L L00076 L00080: * write(OUT) c ! LF generated by unit 6 ouput LEA 100(A0),A1 MOVEQ #78,D4 L00087: CLR.L (A1)+ DBF D4,L00087 MOVEQ #2,D0 MOVE.W D0,202(A0) MOVE.L A5,-(A7) MOVEA.L 32(A6),A1 PEA (A1) PEA $00000001 MOVE.L #262145,-(A7) ST 210(A0) MOVEQ #1,D5 JSR 32(A4) ADDA.W #12,A7 MOVEA.L (A7)+,A5 * endif L00076: * cc = 0 ! reset line character counter MOVEA.L 24(A6),A1 CLR.L (A1) * ln = ln + 1 ! count the line MOVEA.L 16(A6),A1 ADDQ.L #1,(A1) * if (ln>=lp) then ! full page? MOVE.L (A1),D0 MOVEA.L 8(A6),A1 CMP.L (A1),D0 SGE D0 EXT.W D0 EXT.L D0 BEQ.L L00088 * ln = 0 ! - reset line counter MOVEA.L 16(A6),A1 CLR.L (A1) * endlin = NEWPAG ! - flag new page MOVE.L #-1,(A3) * elseif(co<>0) then BRA.L L00089 L00088: MOVE.B 4(A3),D0 EXT.W D0 EXT.L D0 TST.L D0 SNE D0 EXT.W D0 EXT.L D0 BEQ.L L00090 * write(OUT) co ! no - flush any the look ahead LEA 100(A0),A1 MOVEQ #78,D4 L00091: CLR.L (A1)+ DBF D4,L00091 MOVEQ #2,D0 MOVE.W D0,202(A0) MOVE.L A5,-(A7) PEA 4(A3) PEA $00000001 MOVE.L #262145,-(A7) ST 210(A0) MOVEQ #1,D5 JSR 32(A4) ADDA.W #12,A7 MOVEA.L (A7)+,A5 * endif L00090: L00089: * c = co ! return any saved character MOVE.B 4(A3),D0 EXT.W D0 EXT.L D0 MOVEA.L 32(A6),A1 MOVE.B D0,(A1) * end MOVE.L (A3),D0 UNLK A6 RTS L00073: DC.W 0 DC.W 0 XDEF .OUTHD .OUTHD: MOVE.L #L00092-L00093,D1 L00093: LEA L00093(PC,D1.L),A1 LINK A6,#-94 MOVEA.L A7,A3 * subroutine outhd(pn,file) * CR = 13 ; LF = 10 MOVE.B #13,92(A3) MOVE.B #10,93(A3) * call date(mm,dd,yy) MOVEM.L A0/A4/A5,-(A7) SUBQ.W #6,A7 PEA 80(A3) PEA 84(A3) PEA 88(A3) MOVEQ #3,D0 MOVE.L #.DATE-L00094,D1 L00094: JSR L00094(PC,D1.L) ADDA.W #18,A7 MOVEM.L (A7)+,A0/A4/A5 MOVEA.L A7,A3 * write(hbuf,1) file,mm,dd,yy,pn ! create the header LEA 100(A0),A1 MOVEQ #78,D4 L00095: CLR.L (A1)+ DBF D4,L00095 LEA (A3),A1 MOVE.L A1,132(A0) MOVE.W #80,208(A0) LEA L00096(PC),A1 MOVE.L A1,136(A0) MOVE.L A5,-(A7) MOVEA.L 8(A6),A1 PEA (A1) PEA $00000001 MOVE.L #65556,-(A7) PEA 80(A3) PEA $00000001 MOVE.L #262148,-(A7) PEA 84(A3) PEA $00000001 MOVE.L #262148,-(A7) PEA 88(A3) PEA $00000001 MOVE.L #262148,-(A7) MOVEA.L 12(A6),A1 PEA (A1) PEA $00000001 MOVE.L #524292,-(A7) ST 210(A0) MOVEQ #5,D5 JSR 32(A4) ADDA.W #60,A7 MOVEA.L (A7)+,A5 * write(OUT) CR,LF,trim(hbuf),CR,LF,CR,LF ! out the header LEA 100(A0),A1 MOVEQ #78,D4 L00097: CLR.L (A1)+ DBF D4,L00097 MOVEQ #2,D0 MOVE.W D0,202(A0) MOVE.L A5,-(A7) PEA 92(A3) PEA $00000001 MOVE.L #262145,-(A7) PEA 93(A3) PEA $00000001 MOVE.L #262145,-(A7) MOVEQ #80,D1 MOVEQ #0,D5 LEA (A3),A1 JSR 24(A4) JSR 356(A4) MOVE.L A5,-(A7) PEA $00000001 MOVE.W D5,-(A7) MOVE.W #1,-(A7) PEA 92(A3) PEA $00000001 MOVE.L #262145,-(A7) PEA 93(A3) PEA $00000001 MOVE.L #262145,-(A7) PEA 92(A3) PEA $00000001 MOVE.L #262145,-(A7) PEA 93(A3) PEA $00000001 MOVE.L #262145,-(A7) ST 210(A0) MOVEQ #7,D5 JSR 32(A4) ADDA.W #84,A7 MOVEA.L (A7)+,A5 * pn = pn + 1 ! we're on next page MOVEA.L 12(A6),A1 MOVE.L (A1),D0 MOVE.L #1065353216,D1 JSR 72(A4) MOVE.L D0,(A1) * 1 format('File ',a20,5x, BRA.L L00098 L00096: DC.B 38,0,5,70,105,108,101,32,22,0,20,0,1,30 DC.B 0,5,38,0,11,80,114,105,110,116,101,100,32,111 DC.B 110,32,4,0,2,2,0,1,54,0,2,38,0,1 DC.B 47,4,0,2,2,0,1,56,30,0,6,38,0,5 DC.B 80,97,103,101,32,4,0,4,1,0,1,0 L00098: * end UNLK A6 RTS L00092: DC.W 0 DC.W 0 * ENDINSERT --------------------------------------------------------------- * * - args: routine to create a full argument structure from a partial * argument list. * * full list corresponds to: * * call spool(file,printer,switch,copies,lpp,width) * * where file and printer are strings and must have their length supplied. * ARGS: MOVE.L D0,D6 * ANY ARGUMENTS? BNE ARG1 * YES ARGBAD: RTS * ERROR --> BACK TO CALLER ARG1: CMPI.B #6,D0 * LEGAL NUMBER ARGS? BGT.S ARGBAD * NO, TOO MANY BSR.S MKFORK * LEGAL NUMBER OF ARGS, LETS FORK MOVE.L D6,D7 * ANOTHER COPY OF ARGUMENT COUNT LSL.L #2,D0 * TIMES 4 (POINTER STORAGE) LEA 4(A7,D0),A3 * BASE OF ARG ADDRESS LIST (+4) MOVEA.L A3,A2 * BASE LENGTH STORAGE LINK A6,#-(12+26) * LENGTH & VALUE STORAGE MOVEA.L A7,A1 * GET A POINTER TO BASE OF STORAGE ARG2: MOVE.L -(A3),-(A7) * COPY ADDRESS ARG MOVE.W (A2)+,(A1)+ * COPY LENGTH ARG SUB.W #1,D6 * ANY MORE? BNE.S ARG2 * YES --> ARG2, DO IT AGAIN LEA -26(A6),A3 * LOAD ADDRESS VALUE STORAGE CMPI.B #2,D7 * PRINTER SPECIFIED? BGE.S ARG3 * YES MOVE.L A3,-(A7) * SET ADDRESS 'PRINTER' MOVE.L #$20202020,(A3)+ * MAKE 'PRINTER' BLANKS MOVE.W #$2020,(A3)+ MOVE.W #6,(A1)+ * SET LENGTH ARG3: CMPI.B #3,D7 * 'SWITCH' SPECIFIED BGE.S ARG4 * YES BSR.S DEFAULT ARG4: CMPI.B #4,D7 * 'COPIES' SPECIFIED? BGE.S ARG5 * YES BSR.S DEFAULT ARG5: CMPI.B #5,D7 * 'LPP' SPECIFIED? BGE.S ARG6 * YES BSR.S DEFAULT ARG6: CMPI.B #6,D7 * 'WIDTH' SPECIFIED? BGE.S ARG7 * YES BSR.S DEFAULT ARG7: BSR.S DEFAULT * SET 'who' to USER BSR USER1 * DO IT! ADDA.W #28,A7 * POP ARG ADDRESSES UNLK A6 * RELINQUISH LOCAL STORAGE RTS * BACK TO FORTRAN DEFAULT: MOVEA.L (A7)+,A2 * GET RETURN ADDRESS MOVE.L A3,-(A7) * SET ADDRESS ARGUMENT MOVE.L #0,(A3)+ * SET VALUE ARGUMENT JMP (A2) * RTS * * - fork the process so printing goes on in the background. * If an error occurs, it is not directed, we just return to the parent. * A0 is preserved for FORTRAN, d0 for local 'args' routine. * MKFORK: RTS * NOP for Amigados * * - RAD50 unpacking routine for PRINTER name set in PROGRAM statement * UNPACK: DIVU #@3100,D7 * DIVIDE OUT FIRST CHARACTER BSR.S UP1 * UNBIAS IT DIVU #@50,D7 * DIVIDE OUT SECOND CHARACTER BSR UP1 UP1: MOVEQ #32,D6 * SPACE BIAS TST.W D7 * SPACE? BEQ.S UP2 * YES MOVEQ #96,D6 * LOWER CASE ALPHA BIAS CMPI.W #26,D7 * ALPHA? BLS.S UP2 * YES MOVEQ #18,D6 * NUMERIC BIAS UP2: ADD.B D6,D7 MOVE.B D7,(A2)+ CLR.W D7 * PREPARE FOR NEXT CHARACTER SWAP D7 RTS * * FORTRAN subroutine to return the date in three INTEGER*4 variables * * Calling Sequence: CALL DATE(MM,DD,YY) * * * AmigaDOS returns the number of days since 01/01/78. The system * date is extracted using a translation of the following julian * routine: * * n = days+28431 * ny = (4*n-1)/1461 * nd = (4*n+3-1461*ny)/4 * nm = (5*nd-3)/153 * nd = (5*nd+2-153*nm)/5 * if (nm>=10) goto 2 * nm = nm+3 * goto 3 * 2 nm = nm-9 * ny = ny+1 * 3 continue * * * Edit history: * * 20 Feb 86 file created PAJ * DATESTAMP EQU -192 .DATE: MOVEM.L A0/A6,-(A7) MOVEA.L -20(A0),A6 * pointer to "dos.library" SUBA.W #12,A7 * allocate a buffer for return values MOVE.L A7,D1 * set pointer to buffer JSR DATESTAMP(A6) * fill the buffer MOVE.L (A7)+,D1 * load number of days ADDA.W #8,A7 * skip minutes and ticks MOVEM.L (A7)+,A0/A6 * * - register assignments * * D0 = nm * D1 = nd * D2 = ny * ADDI.L #28431,D1 * time+28431 LSL.L #2,D1 MOVE.L D1,D2 SUBQ.L #1,D2 DIVU #1461,D2 ANDI.L #$0000FFFF,D2 ADDQ.L #3,D1 MOVE.L D2,D4 MULU #1461,D4 SUB.L D4,D1 LSR.L #2,D1 MOVE.L D1,D4 LSL.L #2,D1 ADD.L D4,D1 * 5*nd MOVE.L D1,D0 SUBQ.L #3,D0 DIVU #153,D0 ANDI.L #$0000FFFF,D0 ADDQ.L #2,D1 MOVE.L D0,D4 MULU #153,D4 SUB.L D4,D1 DIVU #5,D1 ANDI.L #$0000FFFF,D1 CMPI.L #10,D0 BGE.S L1 ADDQ.L #3,D0 * nm = nm+3 BRA.S L2 * goto 3 L1: SUBI.L #9,D0 * nm = nm-9 ADDQ.L #1,D2 * ny = ny+1 * * - set return values * L2: MOVEA.L 12(A7),A1 * address of mm MOVE.L D0,(A1) MOVEA.L 8(A7),A1 * address of dd MOVE.L D1,(A1) MOVEA.L 4(A7),A1 * address of yy MOVE.L D2,(A1) RTS END