; -*- MIDAS -*-

TITLE Call me an elevator

a=1
b=2
c=3
d=4
e=5
t=10
tt=11
j=14
p=17

DEFINE SYSCAL OP,ARGS
	.CALL  [SETZ ? sixbit /OP/ ? args ((SETZ))]
TERMIN

ttyo=13
chaosi=14
chaoso=15

.INSRT SYSTEM;CHSDEF >

packet:	block %CPMXW

DEFINE TYPE &string
       movei t,<.length string>
       move tt,[440700,,[ascii string]]
       syscal SIOT,[%climm,,ttyo ? tt ? t]
         .lose %lsfil
TERMIN

go:	syscal OPEN,[%clbit,,.uao\%tjdis ? %climm,,ttyo ? [sixbit /TTY/]]
	  .lose %lsfil
	syscal CHAOSO,[%climm,,chaosi ? %climm,,chaoso]
	  .lose %lsfil
	movei t,%corfc		   ;Prepare to RFC
	dpb t,[$cpkop packet]
	movei t,6		   ;six bytes of data
	dpb t,[$cpknb packet]
	movei t,2026		   ;AI is the destination
	dpb t,[$cpkda packet]
	move a,[440700,,[asciz /DOOR /]]
	move b,[441000,,packet+%cpkdt]
datlop:	ildb t,a		   ;get a character
	jumpe t,chkjcl		   ;break out of loop on NUL
	idpb t,b		   ;put the data in the packet
	jrst datlop		   ;get more

chkjcl:	.break 12,[..rjcl,,jclbuf] ;get JCL
	move j,[440700,,jclbuf]
jcloop:	ildb t,j		   ;get the first character, if any
	caie t,40
	  cain t,^I
	    jrst jcloop
	caie t,"E		   ;if it's E, check TTY num to get floor
	  cain t,"e		   ;  ("e too!)
	    jrst haktty
	cail t,"a		   ;Is it lower-case?
	  subi t,40		   ;  uppercasify
gotit:	idpb t,b		   ;put it in the packet
	syscal PKTIOT,[%climm,,chaoso ? %climm,,packet]
	  .lose %lsfil
	syscal PKTIOT,[%climm,,chaosi ? %climm,,packet]	;get answer
	  .lose %lsfil
	ldb t,[$cpkop packet]	   ;get opcode of reply
	cain t,%coans		   ;Is it an ANS?
	  jrst done		   ;  yes, all OK!
	type /ALost.  Reason = "/
	move a,[441000,,packet+%CPKDT00]	   ;ptr to data area
	ldb b,[$cpknb packet]	   ;# of bytes to type
	jumpe b,[ type /none"./
		  .logout 1,]
errlop:	ildb t,a		   ;get character of error message
	.iot ttyo,t		   ;type it
	sojg b,errlop		   ;and loop till end

	type /"./
	.logout 1,

done:	type /AThe deed is done!/
	.logout 1,


haktty:	.suset [.rcnsl,,t]
IRP	x,,[21,22,23,26,27,30,31,32,33,34]
	cain t,x
	  jrst 8th
TERMIN
IRP	x,,[0,23]
	cain t,x
	  jrst 9th
TERMIN
	type /ACan't do it, sorry./
	.logout 1,

8th:	movei t,"8		   ;Call it to the 8th floor
	jrst gotit		   ;go send it

9th:	movei t,"9		   ;Call it to the 9th floor
	jrst gotit		   ;go send the packet


JCLBUF:	block 100
	-1
END GO