*       @(#)getchar.sa  1.2     *
         TTL       Get a Single Character from a Pascal Text File
GETCHAR  IDNT      1,0       Get a Single Char from a Pascal Text file
         SECTION   9
*
*  In the Calling Pascal Program declare
*       FUNCTION getchar(VAR fil: text): char; FORWARD
*
*  Register Usage:
*       D0 - Error code returned from IOS
*       D1 - Current component pointer of text file
*       D2 - Copy of original function/options
*       D3 - Copy of original starting address of buffer
*       D4 - Copy of original ending address of buffer
*       A0 - Address of IOS parameter block
*       A1 - Address of Pascal file parameter block
*       A2 - Address of Pascal file pointer
*       A4 - Return address
 
FUNCTION EQU       8            IOS function
BUFSTART EQU       20           Address of start of buffer
BUFEND   EQU       24           Address of end of buffer
*
IOS      EQU       2            Trap number for IOS
ERRTRAP  EQU       14           Trap number for an error
ERRNUM   EQU       2            The error number
READFUNC EQU       $00010428    Read, no format

         XDEF      GETCHAR

GETCHAR  MOVE.L    (A7)+,A4                     Save the return address
         MOVE.L    (A7)+,A2                     Get address of file pointer
         MOVE.L    (A2),D1                      Get component pointer
         MOVE.L    4(A2),A1                     Get address of parameter block
         MOVE.L    FUNCTION(A1),D2              Save old function/options
         MOVE.L    #READFUNC,FUNCTION(A1)       Set up new function/options
         MOVEM.L   BUFSTART(A1),D3-D4           Save old address
         MOVE.L    A7,BUFSTART(A1)              Substitute new start address
         MOVE.L    A7,BUFEND(A1)                Substitute new end address
         LEA       FUNCTION(A1),A0              Call the...
         TRAP      #IOS
         MOVEM.L   D3-D4,BUFSTART(A1)           Restore the old address
         MOVE.L    D2,FUNCTION(A1)              Restore the old function/options
         MOVE.B    (A7),1(A7)                   Replicate the byte read
         TST.B     D0                           Check for an error
         BEQ.S     GETRET                       OK
         TRAP      #ERRTRAP
         DC.W      ERRNUM                       I/O error
GETRET   JMP       (A4)                         Return
         END
 
