;PASCAL DIRECT INPUT INTERFACE ROUTINES - RM-800317;                                         CT-800514;;;*********************************************************************; AVAIL - TEST IF NEXT CHARACTER AVAILABLE;; FUNCTION AVAIL: BOOLEAN;;*********************************************************************;AVAIL::LHLD    SPIL       MOV     A,M       MVI     C,0       ANA     A       JZ      AVAI1       INR     CAVAI1: POP     H       ;RETURN ADDRESS TO PASCAL       POP     D       POP     D       POP     D       POP     D       PUSH    B       ;LOGICAL VALUE       PCHL;;;*********************************************************************; NEXT - WAIT FOR AND GET NEXT CHARACTER;; FUNCTION NEXT: CHAR;;*********************************************************************;NEXT:: LHLD    SPIL    ;ADDRESS OF DIRECT INPUT SEMAPHORE       MOV     B,H       MOV     C,L       CALL    WAIT;       LHLD    BPIL       MOV     E,M       MVI     D,0       INX     H       MOV     A,M       INR     A       JNZ     NEXT1;       INX     H       MOV     A,M       INX     H       MOV     H,M       MOV     L,ANEXT1: SHLD    BPIL;       POP     H       ;RETURN ADDRESS TO PASCAL INTERPRETER       POP     B       POP     B       POP     B       POP     B       PUSH    D       ;FUNCTION VALUE       PCHL;;;*********************************************************************; SETUP - INITIALIZE DIRECT INPUT;; PROCEDURE SETUP( VAR BUFFER: PACKED ARRAY( 1..LENGTH ) OF CHAR;;                  LENGTH: INTEGER );;*********************************************************************;SETUP::POP     B       ;RETURN ADDRESS TO INTERPRETER       POP     D       ;BUFFER LENGTH       POP     H       ;BUFFER POINTER       PUSH    B       ;RETURN ADDRESS TO INTERPRETER       PUSH    H       ;BUFFER POINTER       SHLD    BPIL;       MOV     B,H       MOV     C,L       DCR     E       ;LAST 3 CHARACTERS OF BUFFER USED FOR OVERHEAD       DCR     E       DCR     EG1:    MVI     M,0     ;ZERO REMAINDER OF BUFFER       INX     H       DCR     E       JNZ     G1;       MVI     M,0FF   ;SET UP BUFFER STOP CHARACTER       INX     H       MOV     M,C     ; AND POINTER TO START OF BUFFER       INX     H       MOV     M,B;       LXI     H,6     ;GET AREA FOR SEMAPHORE       CALL    ALLOC       MOV     A,D     ;SEE IF WE GOT ANYTHING AT ALL       ORA     E       JZ      GERR;       XCHG       PUSH    H       ;POINTER TO START OF SEMAPHORE AREA       SHLD    SPIL       MOV     A,E     ;NUMBER OF CHARACTERS ALLOCATED       STA     SLEN       MVI     E,6     ;LENGTH OF SEMAPHOREG2:    MVI     M,0     ;ZERO SEMAPHORE AREA       INX     H       DCR     E       JNZ     G2;       CALL    F]INI   ;GET A MESSAGE BUFFER       MVI     M,9     ;DEFINE DIRECT INPUT OPCODE       INX     H       INX     H       POP     B       ;POINTER TO SEMAPHORE       MOV     M,C       INX     H       MOV     M,B;       LXI     B,4       DAD     B       POP     B       ;BUFFER POINTER       MOV     M,C       INX     H       MOV     M,B;       LHLD    CSEMA       MOV     B,H       MOV     C,L       XCHG       CALL    SEND    ;DEFINE DIRECT INPUT;       RET;;GERR:  POP     H       ;CLEAR STACK       MVI     A,-#10       STA     IORSLT  ;SET IORESULT       RET;;;*********************************************************************; FINIS - CANCEL DIRECT INPUT CONDITION;; PROCEDURE FINIS;;*********************************************************************;FINIS::CALL    F]INI   ;GET A MESSAGE BUFFER       PUSH    D       MVI     M,7     ;DEFINE BREAK SEMAPHORE       INX     H       INX     H       LXI     B,OPMES ;OPERATOR COMMUNICATION MAIN SEMAPHORE       MOV     M,C       INX     H       MOV     M,B       LXI     B,4       DAD     B       LXI     D,TMPIL ;PUT POINTER TO TERMINAL AREA INTO MESSAGE       MVI     B,2       CALL    MOVE       LHLD    CSEMA       MOV     B,H       MOV     C,L       POP     H       CALL    SEND    ;DEFINE BREAK SEMAPHORE (CANCEL DIRECT INPUT);       LHLD    SPIL    ;DEALLOCATE SEMAPHORE AREA       XCHG       LDA     SLEN       MOV     L,A       MVI     H,0       CALL    DELOC;       RET;;;BPIL:  DS      2       ;ADDRESS WHERE NEXT CHARACTER WILL BE PLACEDSPIL:  DS      2SLEN:  DS      1;;       END