home *** CD-ROM | disk | FTP | other *** search
/ norge.freeshell.org (192.94.73.8) / 192.94.73.8.tar / 192.94.73.8 / pub / computers / cpm / alphatronic / PASCALZ4.ZIP / D3 / OUTPT.SRC < prev    next >
Text File  |  1999-04-05  |  11KB  |  557 lines
  1. ;WRITE AND WRITELN ROUTINES
  2. ;
  3.     NAME OUTPT
  4.     ENTRY .WRTEL,.WRITE,L109,L111
  5.     EXT .CO,.BYTOT,.ADDRCK,.ERRTMF,.POPHDB,.PUSHBD,.HPERR
  6.     include deflt.src
  7.     include fctmac.src
  8. ;
  9.     IF    COMPILER    ;Compiler never calls RBLOCK
  10. .RBLOCK:
  11.     ELSE
  12.     EXT    .RBLOCK
  13.     ENDIF
  14. ;
  15. ;
  16. ;WRITELN WRITES THE PARAMETER LIST TO THE SPECIFIED
  17. ;OUTPUT FILE, SETS THE END OF FILE FLAG,
  18. ;AND APPENDS A CARRIAGE RETURN AND LINE FEED
  19. ;TO TERMINATE THE CURRENT LINE 
  20.  
  21. SYSLOC    EQU    5    ;SYSTEM LOCATIONS
  22. ; THIS LABEL IS USED BY THE COMPILER
  23.  
  24. L109:
  25. .WRTEL:    PUSH    X    ;SAVE X
  26.     CALL    PNTR
  27.     PUSH    X    ;SAVE BEGINNING
  28. ;IDENTIFY THE FILE TYPE
  29.     MOV    B,0(X) 
  30.     CMP    B
  31.     JRNZ    CONSOL
  32. ;NON-CONSOLE FILE
  33.     CALL    BUFADR
  34. ;SET BUFFER FLAGS
  35.     BSET    0,M    ;SET EOLN
  36.     INX    H
  37.     INX    H
  38.     INX    H    ;HL POINTS TO OPSYS BUFFER
  39.     JMPR    TEXT
  40.  
  41. ;CONSOLE FILE
  42. ;ALL CONSOLE FILES MUST BE TEXT
  43. CONSOL:    MOV    H,A
  44.     MOV    L,A
  45.  
  46. ;TEXT FILE
  47. TEXT:    CALL    TXTFIL
  48.  
  49. ;APPEND THE CARRIAGE RETURN AND LINE FEED
  50. ADDCR:    MVI    C,CR
  51.     CALL    PRINT
  52.     MVI    C,LF
  53.     CALL    PRINT
  54. ;CLEAN UP STACK AND RETURN
  55. CLEAN:    POP    H    ;BEGINNING OF LIST
  56.     INX    H
  57.     POP    X    ;RESTORE OLD X
  58.     POP    D    ;RETURN ADDRESS
  59.     SPHL        ;REMOVE LIST FROM STACK
  60.     XCHG        ;RETURN ADDRESS
  61.     PCHL
  62.  
  63. ;WRITE WRITES THE PARAMETER LIST TO THE SPECIFIED
  64. ;OUTPUT FILE, SETS THE END OF FILE FLAG, RESETS THE
  65. ;END OF LINE FLAG, AND SETS THE WRITE INDICATER FLAG
  66.  
  67. L111:
  68. .WRITE:    PUSH    X    ;SAVE X
  69.     CALL    PNTR
  70.     PUSH    X    ;SAVE BEGINNING
  71. ;IDENTIFY FILE TYPE
  72.     MOV    B,0(X)
  73.     CMP    B
  74.     JRNZ    CONSO2
  75. ;NON- CONSOLE FILE
  76.     CALL    BUFADR
  77. ;SET BUFFER FLAGS
  78.     RES    0,M    ;RESET EOLN
  79.     INX    H
  80.     INX    H
  81.     INX    H
  82. ;TEST FOR NON-TEXT FILE
  83.     XRA    A
  84.     CMP    B
  85.     JNZ    NONTXT
  86.     JMPR    TEXT2
  87.  
  88. ;CONSOLE FILE
  89. ;ALL CONSOLE FILES MUST BE TEXT FILES
  90. CONSO2:    MOV    H,A
  91.     MOV    L,A
  92.  
  93. ;TEXTFILE
  94. TEXT2:    CALL    TXTFIL
  95. ;CLEAN UP STACK AND RETURN
  96.     JR    CLEAN    ;CLEAN UP AND RETURN
  97.  
  98. ;PNTR SETS UP THE POINTERS FOR WRITING
  99. PNTR:    EXX        ; DO STACK CHECKING SINCE WRITE'S CAN PUSH A LOT
  100.             ; OF DATA ON THE STACK
  101.     PUSH    H    ; HEAP POINTER
  102.     EXX
  103.     POP    D
  104.     LXI    H,-MARGIN
  105.     DAD    S    ; IS HL BELOW HEAP POINTER?
  106.     DSUB    D
  107.     JC    .HPERR    ; YES - OVERFLOW
  108.     LXI    X,SYSLOC
  109.     DADX    S
  110.     DADX    B    ;X POINTS TO START OF LIST
  111.     MOV    D,B
  112.     MOV    E,C    ;COUNT IN DE
  113.     RET
  114.  
  115. ;BUFADR PUTS THE BUFFER ADDRESS IN HL FOR NON-CONSOLE FILES
  116. BUFADR:    LXI    B,-8
  117.     XCHG
  118.     DAD    B    ;SKIP 8 BYTES OF FILE INFO.
  119.     XCHG
  120.     PUSH    D    ;BYTE COUNT
  121.     DADX    B
  122.     MOV    B,7(X)    ;FILE TYPE
  123.     MOV    H,6(X)    ;FILE BUFFER ADDRESS
  124.     MOV    L,5(X)
  125.     PUSH    B    ;SAVE FILE TYPE
  126.     PUSH    H
  127.     BIT    2,M    ;IS FILE DECLARED AS AN OUTPUT FILE?
  128.     JRNZ    OUTSET    ;YES
  129.     PUSH    Y
  130.     PUSH    H    ;FBA    
  131.     XRA    A
  132.     MOV    H,A    
  133.     MOV    L,A
  134.     CALL     .ADDRCK    ;SEARCH OUTPUT FILE LIST FOR BUFFER ADDRESS
  135.     JNC    .ERRTMF    ;TOO MANY OUTPUT FILES OPEN
  136.     POP    H
  137.     MOV    A,H    ;STOREE OUTPUT FBA
  138.     STAX    B
  139.     DCX    B    
  140.     MOV    A,L
  141.     STAX    B
  142.     POP    Y    ;BUFFER NOW IN LIST AS OUTPUT FILE
  143. OUTSET:    MOV    A,2(X)    ;CHECK FOR ZERO RECORD NUMBER
  144.     MOV    E,1(X)
  145.     ORA    E
  146.     JRZ    SEQTST    ;ZERO, SEQUENTIAL WRITE
  147. RWPREP:    MOV    D,2(X)    ;RECORD NUMBER IN DE
  148.     MOV    H,4(X)    ;RECORD SIZE
  149.     MOV    L,3(X)
  150.     POP    B    ;FILE BUFFER ADDR.
  151.     PUSH    B
  152.     MVI    A,1    ;INDICATE A WRITE OPERATION
  153.     CALL    .RBLOCK    ;PERFORM RANDOM WRITE
  154.     POP    H    ;FBA
  155.     BSET    4,M    ;SET 'RANDOMLY ACCESSED' BIT
  156.     JR    RCLN1
  157. RCLN:    POP    H    ;FBA
  158. RCLN1:    POP    B    ;FILE TYPE
  159.     BSET    2,M    ;SET 'WRITTEN TO' BIT - OUTPUT FILE
  160.     POP    D    ;BYTE COUNT
  161.     RET
  162. SEQTST:    POP    H
  163.     PUSH    H
  164.     BIT    4,M    ;HAS RANDOM OPERATION OCCURRED
  165.     JRZ    RCLN    ;NO RANDOM OPS. ON THIS FILE.TREAT AS SEQ.
  166.     JR    RWPREP    ;TREAT AS RANDOM
  167. ;
  168. ;PROCESS PARAMETER LIST
  169. ;THE ODD WORDS IDENTIFY THE PARAMETER TYPE
  170. ;0-FILE,1-BOOLEAN,2-INTEGER,3-CHARACTER,4-SCALAR,5-NON-TEXT,
  171. ;6-FLOATING POINT,7-STRING
  172. ;THE EVEN WORDS ARE THE VALUE OF THE PARAMETER
  173. ;TEST FOR THE END OF LIST
  174.  
  175. TXTFIL:    MOV    A,D
  176.     ORA    E
  177.     RZ        ;LIST EXHAUSTED:RETURN
  178. NXTPAR:    XRA    A    ;CLEAR A
  179.     MOV    B,0(X)
  180.     DCX    X    ;POINTER
  181.     DCX    D    ;BYTE COUNT
  182.     DCR    B
  183.     CZ    BOOL    ;BOOLEAN
  184.     DCR    B
  185.     CZ    INTEG    ;INTEGER
  186.     DCR    B
  187.     CZ    CHAR    ;CHARACTER
  188.     DCR    B
  189.     CZ    SCALAR    ;SCALAR
  190.     DCR    B
  191.     DCR    B
  192.     DCR    B
  193.     CZ    STRING    ;STRING
  194.     JMPR    TXTFIL
  195.  
  196. ;SCALARS ARE PRINTED BY CALCULATING THE ADDRESS AND PRINTING
  197. ;THE SYMBOLIC NAME OF THE SCALAR
  198. SCALAR:    LXI    B,-4    ;FIX...
  199.     DADX    B    ;....PARAMETER LIST POINTER
  200.     XCHG
  201.     DAD    B    ;....BYTE COUNT
  202.     PUSH    H    ;SAVE BYTE COUNT
  203.     PUSH    D    ;SAVE FILE POINTER
  204.     MOV    C,4(X)    ;MINIMUM SYMBOL LENGTH
  205.     MOV    L,3(X)    ;GET SCALAR VALUE
  206.     MOV    H,A    ;IN THE HL PAIR
  207.     DAD    H    ;X2
  208.     DAD    H    ;X4
  209.     DAD    H    ;X8  SYMBOLS ARE 8 CHARS EACH
  210.     MOV    D,2(X)    ;GET HIGH BYTE OF BASE-100H ADDRESS
  211.     MOV    E,1(X)    ;GET LOW BYTE
  212.     DAD    D    ;CALCULATE ADDR OF THIS SYMBOL
  213.     PUSH    H    ;SAVE ADDRESS
  214.     MOV    B,A    ;ZERO B REG.
  215. SCLR1:    MOV    A,M    ;FIND NUMBER OF CHARS. IN SCALAR
  216.     CPI    ' '    ;END OF SCALAR?
  217.     JRZ    SCLR2    ;YES
  218.     INR    B    ;NO, INCREMENT CHAR. COUNTER
  219.     INX    H    ;BUMP SYMBOL POINTER
  220.     BIT    3,B    ;8 CHARS. YET?
  221.     JRZ    SCLR1    ;NO
  222. ;CALCULATE NUMBER OF SPACES TO PRINT FOR MINIMUM FIELD WIDTH
  223. SCLR2:    POP    H    ;VAR. ADDR.
  224.     IF    COMPILER
  225.     JR     SCLR4    ;COMPILER SCALARS ALL HAVE FIELD LENGTH OF 1
  226.     ELSE
  227.     MOV    A,C    ;FIELD LENGTH
  228.     SUB    B    ;LESS NUMBER OF CHARS.
  229.     JRZ    SCLR4    ;NO SPACES TO PRINT
  230.     JRC    SCLR4
  231.     MOV    D,B    ;SAVE NUMBER OF CHARS.
  232.     MOV    B,A    ;NUMBER OF SPACES
  233.     XTHL        ;HL <- FBA
  234.     MVI    C,' '
  235. SCLR3:    CALL    PRINT
  236.     DJNZ    SCLR3    ;PRINT LEADING SPACES
  237. ;PRINT CHARACTERS
  238.     MOV    B,D    ;NUMBER OF CHARS.
  239.     XTHL        ;SCALAR ADDR. IN HL
  240.     ENDIF
  241. SCLR4:    MOV    C,M    ;CHAR INTO C
  242.     XTHL        ;SWITCH POINTERS
  243.     CALL    PRINT    ;PRINT IT
  244.     XTHL        ;SWITCH POINTERS
  245.     INX    H    ;NEXT CHAR
  246.     DJNZ    SCLR4
  247.     POP    H
  248.     POP    D
  249.     RET
  250. ;
  251. ;CHARACTER OUTPUTS A CHARACTER STRING TO THE FILE
  252. CHAR:    MOV    B,-2(X)        ;VARIABLE LENGTH
  253.     MOV    A,0(X)        ;MINIMUM FIELD LENGTH
  254.     SUB    B        ;FIGURE HOW MUCH PADDING
  255.     DCX    X        ;BUMP POINTER AND COUNTER
  256.     DCX    X
  257.     DCX    D
  258.     DCX    D
  259.     JRZ    CHAR2        ;NO PADDING NEEDED
  260.     JRC    CHAR2
  261.     MOV    B,A        ;PADDING COUNT
  262.     MVI    C,' '
  263. CHAR1:    CALL    PRINT        ;PRINT SPACES
  264.     DJNZ    CHAR1
  265.     MOV    B,0(X)        ;VARIABLE LENGTH, AGAIN
  266. CHAR2:    DCX    X
  267.     DCX    D
  268.     MOV    C,0(X)        ;GET NEXT CHARACTER
  269.     CALL    PRINT
  270.     DJNZ    CHAR2        ;DO FOR ALL CHARACTERS IN THE STRING
  271.     DCX    X
  272.     DCX    D
  273.     RET
  274.  
  275. ;BOOLEAN PRINTS EITHER TRUE OR FALSE
  276. ;RIGHT JUSTIFIED IN A FIELD OF THE SIZE SPECIFIED IN THE BYTE
  277. ;OF THE PARAMETER LIST
  278.  
  279. BOOL:
  280.     IF    NOT COMPILER    ;DON'T USE WITH COMPILER
  281.     DCX    X
  282.     DCX    X
  283.     DCX    D
  284.     DCX    D
  285.     PUSH    D    ;SAVE BYTE COUNT
  286.     CMP    1(X)    ;GET VALUE
  287.     MOV    A,2(X)    ;GET FIELD SIZE
  288.     LXI    B,4    ;LENGTH OF 'TRUE'
  289.     LXI    D,TRUE    ;ACTUAL MESSAGE
  290.     JRC    ISTRUE
  291.     XCHG
  292.     DAD    B    ;NOT TRUE...
  293.     XCHG
  294.     INR    C    ;POINT TO 'FALSE'
  295. ISTRUE:    SUB    C    ;COMPUTE PADDING
  296.     JRZ    FIT1B    ;NO PADDING NEEDED
  297.     JRC    FIT1B
  298.     MOV    B,A    ;B <- NUMBER OF LEADING SPACES
  299.     MOV    A,C    ;SAVE NUMBER OF CHARS. IN A
  300.     EXAF
  301.     MVI    C,' '
  302. BLANKS:    CALL    PRINT    ;PRINT PADDING
  303.     DJNZ    BLANKS
  304.     EXAF
  305.     MOV    C,A    ;A <- NUMBER OF CHARS.
  306. FIT1B:    MOV    B,C
  307. FIT1A:    LDAX    D    ;GET CHARACTER
  308.     MOV    C,A
  309.     CALL    PRINT    ;PRINT IT
  310.     INX    D    ;BUMP POINTER
  311.     DJNZ    FIT1A
  312.     POP    D    ;RESTORE BYTE COUNT
  313.     RET
  314.  
  315. TRUE:    DB    'TRUE'
  316.     DB    'FALSE'
  317.     ENDIF
  318. ;
  319. ;STRING WRITES A CHAR STRING AND FILLS TO THE MINIMUM FIELD LENGTH IF 
  320. ;NECESSARY
  321. ;
  322. STRING:
  323.     IF    NOT COMPILER    ;Compiler doesn't need this
  324.     MOV    B,-3(X)    ;ACTUAL LENGTH
  325.     MOV    A,0(X)    ;MIN FIELD LENGTH
  326.     DCX    X    ;BYTE POINTER
  327.     DCX    X
  328.     DCX    X
  329.     DCX    D    ;BYTE COUNTER
  330.     DCX    D
  331.     DCX    D
  332.     MOV    C,1(X)    ;LOW BYTE OF SIZE=MAXLENGTH+1
  333.     DCR    C    ;C <- MAX LENGTH
  334.     PUSH    B    ;SAVE MAX. LENGTH(C) AND ACTUAL LENGTH(B)
  335.     SUB    B    ;CALCULATE PADDING IF ANY
  336.     JRZ    STPRNT    ;NONE NEEDED
  337.     JRC    STPRNT
  338.     MOV    B,A    ;PAD TO FILL OUT MIN. FIELD LENGTH
  339.     MVI    C,' '
  340. SFILL:    CALL    PRINT
  341.     DJNZ    SFILL
  342. STPRNT:    POP    B    ;B <- ACT. LENGTH, C<- MAX LENGTH
  343.     XRA    A
  344.     CMP    B    ;CHECK FOR ZERO LENGTH STRIN
  345.     JRZ    STRZRO
  346.     PUSH    B    ;SAVE ACTUAL LENGTH AND MAXIMUM LENGTH
  347. STRPT1:    DCX    D
  348.     DCX    X
  349.     MOV    C,0(X)    ;GET NEXT CHAR.
  350.     CALL    PRINT
  351.     DJNZ    STRPT1    ;DO FOR ALL CHARS IN STRING
  352.     POP    B    ;B <- ACT LENGTH, C<- MAX LENGTH
  353. STRZRO:    MOV    A,C
  354.     SUB    B
  355.     JRZ    STSKP    ;NO UNUSED BYTES
  356.     MOV    B,A    ;NUMBER OF UNUSED BYTES
  357. STSKIP:    DCX    X    ;SKIP UNUSED BYTES
  358.     DCX    D
  359.     DJNZ    STSKIP
  360. STSKP:    DCX    X
  361.     DCX    D
  362.     RET
  363.     ENDIF
  364.  
  365. ;INTEGER OUTPUTS THE INTEGER RIGHT JUSTIFIED
  366. ;IN THE FIELD WIDTH SPECIFIED BY THE NEXT BYTE
  367. ;IN THE PARAMETER LIST.  IF THE NUMBER IS TOO 
  368. ;BIG FOR THE FIELD, THE FIELD IS EXTENDED ON 
  369. ;THE RIGHT.
  370.  
  371. INTEG:    DCX    D
  372.     DCX    D
  373.     DCX    D
  374.     PUSH    D    ;BYTE COUNTER
  375.     MOV    D,-1(X)    ;GET VALUE
  376.     MOV    E,-2(X)
  377.     PUSH    X
  378.     POP    B
  379.     LXI    X,-6    ;RESERVE STACK SPACE FOR DIGIT STRING
  380.     DADX    S
  381.     SPIX
  382.     PUSH    H    ;FILE BUFFER ADDRESS
  383.     PUSH    B    ;PARAMETER LIST POINTER
  384.     LXI    B,5
  385.     DADX    B    ;DIGIT STRING POINTER
  386.     BIT    7,D    ;TEST SIGN
  387.     JRZ    POSNUM
  388.     MVI    0(X),'-';NEGATIVE NUMBER
  389.     DCX    X
  390.     XRA    A    ;CLEAR CARRY
  391.     MOV    H,A
  392.     MOV    L,A
  393.     MOV    B,A
  394.     DSBC    D
  395.     JMPR    NUM
  396.  
  397. POSNUM:    XCHG        ;POSITIVE NUMBER
  398.     MOV    0(X),A    ;ZERO SIGN BYTE
  399.     DCX    X
  400. NUM:    MOV    C,A    ;ZERO CHARACTER COUNT
  401.     LXI    D,10000
  402.     CALL    FIGURE
  403.     LXI    D,1000
  404.     CALL    FIGURE
  405.     LXI    D,100
  406.     CALL    FIGURE
  407.     LXI    D,10
  408.     CALL    FIGURE
  409.     MOV    B,L    ;LAST DIGIT
  410.     CALL    ADIGIT
  411.     MOV    B,A
  412.     DADX    B
  413.     INX    X    ;X POINTS TO THE SIGN
  414.     MOV    A,0(X)
  415.     CPI    '-'
  416.     JRNZ    CHK0
  417.     INR    C
  418.     JMPR    NEGA
  419.  
  420. CHK0:    CMP    C
  421.     JRNZ    POSN
  422.     MVI    0(X),'0'    ;OUTPUT A ZERO
  423.     INR    C
  424.     JMPR    NEGA
  425.  
  426. POSN:    DCX    X
  427. NEGA:    MOV    B,C
  428.     POP    H
  429.     MOV    A,M    ;GET FIELD  LENGTH
  430.     XTHL        ;FILE BUFFER ADDRESS
  431. ;            ;SAVE PARAMETER LIST POINTER
  432.     SUB    B
  433.     JRC    PERFIT    ;EXTEND THE FIELD TO MATCH
  434.     JRZ    PERFIT    ;FIELD MATCHES
  435.     MOV    D,A
  436.     MVI    C,' '    ;PAD THE NUMBER TO MATCH THE FIELD
  437. PAD:    CALL    PRINT
  438.     DCR    D
  439.     JRNZ    PAD
  440. PERFIT:    MOV    C,0(X)    ;PRINT THE DIGIT STRING
  441.     CALL    PRINT
  442.     DCX    X
  443.     DJNZ    PERFIT
  444. ;NUMBER IS PRINTED CLEANUP MESS AND RETURN
  445.     POP    X    ;RESTORE LIST POINTER
  446.     DCX    X
  447.     DCX    X
  448.     DCX    X
  449.     XCHG        ;REMOVE DIGIT STRING FROM STACK
  450.     LXI    H,6
  451.     DAD    S
  452.     SPHL
  453.     XCHG
  454.     POP    D    ;RESTORE PARAMETER BYTE COUNTER
  455.     XRA    A    ;CLEAR A
  456.     RET
  457.  
  458. ;FIGURE COUNTS HOW MANY TIMES DE GOES INTO HL
  459. FIGURE:    XRA    A    ;CLEAR CARRY
  460.     DCR    B
  461. CONT:    INR    B    ;COUNTER
  462.     DSBC    D
  463.     JRNC    CONT
  464. TOOFAR:    DAD    D    ;PUT BACK LAST TRY
  465.  
  466. ;ADIGIT ADDS A DIGIT TO THE STRING ON THE STACK
  467. ;IF THE FIRST NON-ZERO DIGIT HAS BEEN
  468. ;ENCOUNTERED. IT ALSO INCREMENTS THE DIGIT COUNTER.
  469.  
  470. ADIGIT:    CMP    B
  471.     JRNZ    NUDIG
  472.     CMP    C    ;DIGIT IS A 0
  473.     RZ        ;FIRST DIGIT
  474. NUDIG:    MVI    A,30H    ;ASCII
  475.     ADD    B
  476.     MOV    0(X),A    ;ADD DIGIT TO STRING
  477.     DCX    X
  478.     INR    C    ;DIGIT COUNTER
  479.     XRA    A
  480.     MOV    B,A
  481.     RET
  482.  
  483.  
  484. ;NONTXT OUTPUTS A DATA STREAM TO A NON-TEXT DISK FILE
  485. NONTXT:
  486.     PUSH    H    ;SAVE FILE BUFFER ADDRESS
  487. NONTX1:    LXI    B,-4    ;UPDATE PARAMETER POINTER
  488.     DADX    B
  489.     XCHG
  490.     DAD    B
  491.     XCHG
  492.     MOV    H,2(X)    ;GET BYTE COUNT
  493.     MOV    L,1(X)
  494. NTLP:    MOV    C,0(X)    ;GET NEXT DATA BYTE
  495.     DCX    X    ;POINTER
  496.     DCX    H    ;BYTE COUNT
  497.     DCX    D    ;PARAMETER COUNT
  498.     XTHL
  499.     CALL    DIS    ;TO THE DATA
  500.     XTHL
  501.     MOV    A,H    ;DONE?
  502.     ORA    L
  503.     JRNZ    NTLP
  504.     MOV    A,D    ;END OF PARAMETER LIST
  505.     ORA    E    ;ALL PARAMETERS ARE EITHER TEXT OR NON-TEXT
  506.     JRNZ    NONTX1
  507.     POP    H    ;FILE BUFFER COUNT
  508.     JMP    CLEAN
  509.  
  510. ;BUFFER ADDRESS IS NON-ZERO AND TO THE CONSOLE CRT
  511. ;IF THE FILE BUFFER ADDRESS IS ZERO.
  512.  
  513. PRINT:    XRA    A    ;KEEP THE A-REG A ZERO
  514.     CMP    H
  515.     JRNZ    DIS
  516.     CMP    L
  517.     JRNZ    DIS
  518.     CALL    .CO    ;CONSOLE
  519.     XRA    A
  520.     RET
  521.  
  522. DIS:    DCX    H
  523.     DCX    H
  524.     DCX    H    ;FBA
  525.     BIT    7,M    ;CONSOLE FLAG SET? (CON:)
  526.     JRZ    DIS1    ;NO
  527.     CALL    .CO    ;YES, CON:
  528.     XRA    A
  529.     INX    H
  530.     INX    H
  531.     INX    H    ;FCB
  532.     RET
  533. DIS1:    BIT    6,M    ;LISTING DEVICE? (LST:)
  534.     INX    H
  535.     INX    H
  536.     INX    H    :FCB
  537.     JZ    DIS2    ;NO
  538. ; OUTPUT TO PRINTER
  539.     XRA    A
  540.     CALL    .PUSHBD    ;SAVE ALL REGS.
  541.     MOV    E,C
  542.     MVI    C,5    ;CP/M LIST OUTPUT FUNCTION
  543.     CPM        
  544.     JMP    .POPHDB
  545. ; OUTPUT TO DISK    
  546. DIS2:    CALL    .BYTOT    ;DISK FILE
  547.     MVI    A,0
  548.     RNC
  549.     DCX    H
  550.     DCX    H
  551.     DCX    H
  552.     BSET    1,M    ;EOF FLAG SET INDICATES DISC WRITE ERROR
  553.     INX    H
  554.     INX    H
  555.     INX    H
  556.     RET
  557.