|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 5088 (0x13e0)
Notes: Mikados TextFile, Mikados_K
Names: »NEXT«
└─⟦38ff28550⟧ Bits:30004682 Pascal Standard Assembler til MIKADOS
└─ ⟦this⟧ »NEXT«
;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 C
AVAI1: 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,A
NEXT1: 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 E
G1: 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 SEMAPHORE
G2: 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 PLACED
SPIL: DS 2
SLEN: DS 1
;
;
END