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 / PSTAT.SRC < prev    next >
Text File  |  1999-04-05  |  1KB  |  58 lines
  1. ;PRINTS STATEMENT NUMBER IF TRACES OR EXT.ERROR MESSAGES ON
  2. ;
  3.     NAME PSTAT
  4.     ENTRY .PSTAT,.DIGIT
  5.     EXT .STMTMSG,.TXTYP,.CO,.CRLF
  6. ;
  7. MODMSG:    DBS    ' -- Module '
  8. .PSTAT:    PUSH    H        ;SAVE HEAP POINTER
  9.     LXI    H,MODMSG    ;PRINT ' -- Module ';
  10.     PUSH    B        ;STATEMENT NUMBER -> HL
  11.     CALL    .TXTYP
  12.     POP    H
  13.     PUSH    H
  14.     MOV    A,H        ;GET BYTE WITH THE HIGH FOUR BITS
  15.     ANI    0F0H        ;ELIMINATE LOW FOUR BITS
  16.     RAR
  17.     RAR            ;MOVE 4 HIGH BITS INTO 4 LOW BITS
  18.     RAR
  19.     RAR
  20.     MOV    L,A        ;INTO L REGISTER
  21.     XRA    A
  22.     MOV    H,A        ;ZERO H REGISTER
  23.     LXI    D,10        ;DO TENS DIGIT
  24.     CALL    .DIGIT
  25.     LXI     D,1        ;DO ONES DIGIT
  26.     CALL    .DIGIT
  27.     POP    H        ;STMT NUMBER
  28.     PUSH    H
  29.     MOV    A,H        ;ELIMINATE MODULE # FROM STMT NUMBER
  30.     ANI    0FH
  31.     MOV    H,A
  32.     PUSH    H
  33.     LXI    H,.STMTMSG    ;PRINT ', statement '
  34.     CALL    .TXTYP
  35.     POP    H
  36.     LXI    D,1000        ;DO THOUSANDS .DIGIT
  37.     CALL    .DIGIT
  38.     LXI    D,100        ;DO HUNDREDS  .DIGIT
  39.     CALL    .DIGIT
  40.     LXI    D,10        ;DO TENS .DIGIT
  41.     CALL    .DIGIT
  42.     LXI    D,1        ;DO ONES .DIGIT
  43.     CALL    .DIGIT
  44.     LXI    H,.CRLF        ;POINT TO CRLF
  45.     CALL    .TXTYP        ;PRINT IT
  46.     POP    B        ;RESTORE STATEMENT NUMBER
  47.     POP    H        ;RESTORE HEAP POINTER
  48.     XRA    A        ;CLEAR ACC
  49.     RET
  50. ;
  51. .DIGIT:    MVI    C,'0'-1        ;INITIALIZE ASCII COUNTER
  52.     XRA    A        ;CLEAR CARRY
  53. DIG1:    INR    C        ;BUMP COUNTER
  54.     DSBC    D        ;TRY ANOTHER SUBTRACTION
  55.     JRNC    DIG1        ;KEEP IT UP WHILE POSITIVE RESULT
  56.     DAD    D        ;ELSE MAKE RESULT +IVE
  57.     JMP    .CO        ;PRINT CHAR AND RETURN TO CALLER
  58.