CONSTSTRING (13) VSN="16 AUG 79 3"
EXTERNALROUTINESPEC RDINT(INTEGERNAME I)
EXTERNALROUTINESPEC RSTRG(STRINGNAME S)
EXTERNALROUTINESPEC PROMPT(STRING (15) S)
!
RECORDFORMAT PARMF(INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6)
!
EXTERNALROUTINESPEC DPON(RECORDNAME P)
EXTERNALROUTINESPEC DOUT(RECORDNAME P)
EXTERNALROUTINESPEC DPOFF(RECORDNAME P)
? SYSTEMROUTINESPEC PHEX(INTEGER I)
? SYSTEMSTRINGFNSPEC ITOS(INTEGER N)
!
CONSTINTEGER GPC DEST=X'00300000'
CONSTINTEGER ALLOC=4, DE ALLOC=5, EXEC CHAIN=10
!
CONSTINTEGER GETEPAGE DEST=X'50000'
CONSTINTEGER RETURNEPAGE DEST=X'60000'
? CONSTSTRING (1) SNL = "
"
!
INTEGERFN GET MNEMONIC(STRING (255) MNEM)
INTEGER I,J,IMNEM
IMNEM=0; I=3
IF MNEM = "" THEN MNEM = "LP"
IF MNEM = "LP" THEN MNEM = "LP0"
CYCLE J=LENGTH(MNEM),-1,1
BYTEINTEGER(ADDR(IMNEM)+I)=BYTEINTEGER(ADDR(MNEM)+J)
I=I-1
REPEAT
RESULT =IMNEM
END ; ! GET MNEMONIC
EXTERNALROUTINE LOAD LP REP(STRING (255) PARMS)
CONSTINTEGERARRAY LP96REP(0:95)=C
X'F0F1F2F3',X'F4F5F6F7',X'F8F94B60',X'7B6B614E',X'C1C2C3E9',
X'C4E4E2E3',X'C7C57DC8',X'D1D2D85C',X'D4D5D6D7',X'D9C9C6D3',
X'E5E6E7E8',X'7E4D505D',X'4C6D3F6E',X'5B7A7C4F',X'6C5E7F6F',
X'4AE05F5A',X'A8A979F0',X'81828384',X'85868788',X'89919293',
X'94959697',X'9899A2A3',X'A4A5A6A7',X'C06AA1D0',
X'F0F1F2F3',X'F4F5F6F7',X'F8F94B60',X'7B6B614E',X'C1C2C3E9',
X'C4E4E2E3',X'C7C57DC8',X'D1D2D85C',X'D4D5D6D7',X'D9C9C6D3',
X'E5E6E7E8',X'7E4D505D',X'4C6D3F6E',X'5B7A7C4F',X'6C5E7F6F',
X'4AE05F5A',X'A8A979F0',X'81828384',X'85868788',X'89919293',
X'94959697',X'9899A2A3',X'A4A5A6A7',X'C06AA1D0',
X'F0F1F2F3',X'F4F5F6F7',X'F8F94B60',X'7B6B614E',X'C1C2C3E9',
X'C4E4E2E3',X'C7C57DC8',X'D1D2D85C',X'D4D5D6D7',X'D9C9C6D3',
X'E5E6E7E8',X'7E4D505D',X'4C6D3F6E',X'5B7A7C4F',X'6C5E7F6F',
X'4AE05F5A',X'A8A979F0',X'81828384',X'85868788',X'89919293',
X'94959697',X'9899A2A3',X'A4A5A6A7',X'C06AA1D0',
X'F0F1F2F3',X'F4F5F6F7',X'F8F94B60',X'7B6B614E',X'C1C2C3E9',
X'C4E4E2E3',X'C7C57DC8',X'D1D2D85C',X'D4D5D6D7',X'D9C9C6D3',
X'E5E6E7E8',X'7E4D505D',X'4C6D3F6E',X'5B7A7C4F',X'6C5E7F6F',
X'4AE05F5A',X'A8A979F0',X'81828384',X'85868788',X'89919293',
X'94959697',X'9899A2A3',X'A4A5A6A7',X'C06AA1D0'
CONSTINTEGERARRAY LP384REP(0:95)= C
X'F0F1F2F3',X'F4F5F6F7',X'F8F94B9C',X'7B6B614E',
X'C1C2C3E9',X'C4E4E2E3',X'C7C57DC8',X'D1D2D85C',
X'D4D5D6D7',X'D9C9C6D3',X'E5E6E7E8',X'7E4D505D',
X'6C5E7F6F',X'4AE05F5A',X'4C6D3F6E',X'5B7A7C4F',
X'81828384',X'85868788',X'89919293',X'F0F1F2F3',
X'F4F5F6F7',X'F8F94B60',X'94959697',X'9899A2A3',
X'A4A5A6A7',X'A8A979F0',X'9EADEFCA',X'7B6B614E',
X'C1C2C3E9',X'C4E4E2E3',X'C7C57DC8',X'D1D2D85C',
X'D4D5D6D7',X'D9C9C6D3',X'E5E6E7E8',X'7E4D505D',
X'6C5E7F6F',X'4AB7A05A',X'F0F1F2F3',X'F4F5F6F7',
X'F8F94B60',X'4CF08B6E',X'5B7A7C4F',X'C06AA1D0',
X'9A6D749B',X'FCEAAFED',X'ACAB8F8E',X'8DB5B4B3',
X'787776DC',X'DDDEDFB8',X'B9BABBB0',X'7B6B614E',
X'C1C2C3E9',X'C4E4E2E3',X'C7C57DC8',X'D9C9C6D3',
X'D1D2D85C',X'F0F1F2F3',X'F4F5F6F7',X'F8F94B60',
X'D4D5D6D7',X'E5E6E7E8',X'7E4D505D',X'6C5E7F6F',
X'4AE05F5A',X'4CF08B6E',X'5B7A7C4F',X'A8A979F0',
X'81828384',X'85868788',X'89919293',X'94959697',
X'9899A2A3',X'A4A5A6A7',X'B1B2FAFB',X'C1C2C3E9',
X'F0F1F2F3',X'F4F5F6F7',X'F8F94B60',X'7B6B614E',
X'C4E4E2E3',X'C7C57DC8',X'D9C9C6D3',X'D1D2D85C',
X'D4D5D6D7',X'E5E6E7E8',X'7E4D505D',X'6C5EDBCB',
X'4AB7A05A',X'4CF08B6E',X'5B7A7C4F',X'EBBC75BD',
X'8CAEBFBE',X'B6AAFDFE',X'9DEE80DA',X'C06D6AD0'
!
ROUTINESPEC FIRE CHAIN
!
RECORDFORMAT RCBF(INTEGER LIMFLAGS,LSTBA,LB BYTES,LBA,AL BYTES, C
ALA,INITWORD,SLOTNO)
RECORDNAME RCB(RCBF)
!
? CONSTSTRING (19)ARRAY ALLMS(0:2)=C
"Successful", "Bad param(?)", "Already allocated"
!
RECORDFORMAT ALEF(INTEGER BYTES,ADDR)
INTEGERNAME INIT0 LB,LOAD REP LB,INIT LB,WRITE CONTROL LB,NEWPAGE LB
INTEGERNAME READ PROPS LB
RECORDNAME AL0,AL2,AL4(ALEF)
RECORD P(PARMF)
INTEGER FAD,REP ADDR,SNO,DEV ENT AD,J,CDEX,AUTOTHROW BIT,INIT ADDR
INTEGER CART,K,RBYTES,I,REPLEN,IX,CH,IMNEM
INTEGER FORM STYLE
INTEGER REPERTOIRE ADDR,REPERTOIRE LEN,LINES PER PAGE,PROP DAT ADDR
STRING (255) S
RECORDFORMAT ENTFORM(INTEGER C
SER, PTSM, PROPADDR, SECS SINCE, CAA, GRCB AD, LBA, ALA, C
STATE, RESP0, RESP1, SENSE1, SENSE2, SENSE3, SENSE4, C
REPSNO, BASE, ID, DLVN, MNEMONIC, C
ENTSIZE, PAW, USAW0, URCB AD, SENSDAT AD, LOGMASK, TRTAB AD, C
UA SIZE, UA AD, TIMEOUT,PROPS0,PROPS1)
!
RECORDNAME D(ENTFORM)
!
RECORDFORMAT PROPF(BYTEINTEGER SIX,DEVNO,SPEED REP,FORM STYLE, C
FINAL LINE, OPTION CART)
RECORDNAME PROPS(PROPF)
!
OWNBYTEINTEGERARRAYFORMAT BIFT(0:383)
BYTEINTEGERARRAYNAME REP,TRTAB
PRINTSTRING("VSN ")
PRINTSTRING(VSN)
NEWLINE
! ALLOCATE THE DEVICE
IMNEM=GET MNEMONIC(PARMS)
P=0
P_DEST=GPC DEST ! ALLOC
P_P1=IMNEM
P_P2=1; ! PON RESPONSES
DPON(P)
DPOFF(P)
? PRINTSTRING("Allocate reply = ".ITOS(P_P1).SNL)
? IF 0<=P_P1<=2 THEN PRINTSTRING(ALLMS(P_P1)) AND NEWLINE
RETURN IF P_P1#0
SNO=P_P2
DEV ENT AD=P_P3
!
PROMPT("Set Autothrow? ")
RSTRG(S) UNTIL S="Y" OR S="YES" OR S="N" OR S="NO"
AUTOTHROW BIT=0
IF S="Y" OR S="YES" THEN AUTOTHROW BIT=X'00000004'
!
!NOW GET A PAGE
P=0
P_DEST=GETEPAGE DEST
DOUT(P)
CDEX=P_P2
FAD=P_P4
REPADDR=FAD+128
!
! If the device has been powered off, initialisation data is lost, so we need
! to re-initialise. Setting "no auto-throw" is not enough to eliminate
! auto-throw - you have to do a write-control to set "lines-per-page"
! as well. EXTRAORDINARY !!
!
! Layout of the (public) page
! OFFSET(BYTES) LENGTH(BYTES)
! 0 RCB 32
! 52 INIT0 LB 4
! 56 READ PROP DATA LB 4
! 60 NEWPAGE LB 4
! 64 LOAD REP LB 4
! 68 INIT LB 4
! 72 WRITE-CONTROL LB 4
! 76 AL0-1 8
! 84 AL2-3 8
! 92 AL4-5 8
! 100 INIT DATA 4
! 104 PROPERTIES DATA 8
! 128 LP 384
!
! INITIALISE RCB ETC.
INIT0 LB==INTEGER(FAD+52)
READ PROPS LB==INTEGER(FAD+56)
NEWPAGE LB==INTEGER(FAD+60)
LOAD REP LB==INTEGER(FAD+64)
INIT LB==INTEGER(FAD+68)
WRITE CONTROL LB==INTEGER(FAD+72)
AL0==RECORD(FAD+76)
AL2==RECORD(FAD+84)
AL4==RECORD(FAD+92)
!
INIT ADDR=FAD+100
PROP DAT ADDR=FAD+104
PROPS==RECORD(PROP DAT ADDR)
!
RCB==RECORD(FAD+0)
RCB=0
RCB_LIMFLAGS=X'00004000'; ! trusted RCB - to do the initialise
RCB_LB BYTES=4
RCB_LBA=ADDR(INIT0 LB)
RCB_AL BYTES=24
RCB_ALA=ADDR(AL0)
!
INIT0 LB= X'80F00002'
READ PROPS LB=X'00F00E04'; ! short-block, long block, X & Y conditions suppressed
NEWPAGE LB= X'82F0030C'; ! write literal data X'C'=form feed
LOAD REP LB= X'80F02500'; ! Load repertoire, command chain
INIT LB= X'80F00102'; ! initialise
!
AL0_BYTES=384
AL0_ADDR=REPADDR
AL2_BYTES=4
AL2_ADDR=INIT ADDR
AL4_BYTES=8
AL4_ADDR=PROP DAT ADDR
!
INTEGER(INIT ADDR)=0; ! suppress all secondary bits from setting primary
!
!--------------- Fire INITIALISE command ------------------
? PRINTSTRING("INITIALISE Command".SNL)
FIRE CHAIN
!
!
RCB_LBA=ADDR(READ PROPS LB)
!--------------- Fire SEND PROPERTIES command ------------------
? PRINTSTRING("SEND PROPS Command".SNL)
FIRE CHAIN
!
FORM STYLE=PROPS_FORM STYLE
LINES PER PAGE=(FORM STYLE>>4)*10 + FORM STYLE&15
IF LINES PER PAGE<20 START
PROMPT("Lines per page:")
RDINT(LINES PER PAGE)
FINISH
WRITE CONTROL LB=X'82F00500' ! (LINES PER PAGE - 1); ! write-control, literal data
CART=PROPS_OPTION CART&15
? PRINTSTRING("Cartridge set = ".ITOS(CART).SNL)
UNLESS 1<=CART<=5 START
! SELECT REPERTOIRE
PRINTSTRING("Repertoires available:
1 96-Char
2 48-Char
3 384-Char
4 64-Char
5 96-Char
")
PROMPT("Repertoire no: ")
RDINT(CART) UNTIL 1<=CART<=5
IF CART = 1 THEN CART = 5
FINISH
! COPY THE REPERTOIRE CHARACTERS FROM REQUIRED ARRAY ABOVE.
K=ADDR(LP96REP(0))
RBYTES=96
IF CART=2 THEN RBYTES=48
IF CART=3 THEN K=ADDR(LP384REP(0)) AND RBYTES=384
IF CART=4 THEN RBYTES=64
! 5 OR ANYTHING ELSE IN FACT
REPERTOIRE ADDR=K
REPERTOIRE LEN=RBYTES
!
! Move repertoire into the page (from REPADDR)
I=0
WHILE I<384 CYCLE ; ! Repertoire buffer must be filled with 384 bytes
J=K; ! TO START OF RELEVANT ARRAY
WHILE J<K+RBYTES CYCLE
INTEGER(REPADDR+I)=INTEGER(J)
I=I+4; J=J+4
REPEAT
REPEAT
!
! Now make up the EBCDIC-EBCDIC translate table in the device entry.
D==RECORD(DEV ENT AD)
REP==ARRAY(REPERTOIRE ADDR,BIFT)
REPLEN=REPERTOIRE LEN
TRTAB==ARRAY(D_TRTAB AD,BIFT)
IF CART=0 START
CYCLE IX=0,1,255; TRTAB(IX)=IX; REPEAT
FINISH ELSE START
CYCLE IX=0,1,255
CH=X'07'; ! DELETE CHARACTER (IGNORED BY PRINTER)
J=0
WHILE J<REPLEN CYCLE
IF IX=REP(J) THEN CH=IX AND EXIT
J=J+1
REPEAT
! Insert 'format effectors' at own values
! and also turn LF(X'25') into NEWLINE(X'15')
IF IX=X'15' THEN CH=X'15'
IF IX=X'25' THEN CH=X'15'
IF IX=X'0C' THEN CH=X'0C'
IF IX=X'0D' THEN CH=X'0D'
IF IX=X'40' THEN CH=X'40'; ! SPACE
! If value IX was not found in repertoire (CH still X'07'),
! was it a lower=case letter? If so, change it to upper case,
! (We do not search to see if the upper case letter is in the
! repertoire - surely it is).
IF CH=X'07' AND C
(X'81'<=IX<=X'89' OR X'91'<=IX<=X'99' OR C
X'A2'<=IX<=X'A9') THEN CH=IX ! X'40'
TRTAB(IX)=CH
REPEAT
FINISH ; ! CART NON-ZERO
RCB_LB BYTES=4
RCB_LBA=ADDR(NEWPAGE LB)
!---------------- Fire NEWPAGE command -------------------
? PRINTSTRING("NEWPAGE Command".SNL)
FIRE CHAIN
!
!
RCB_LB BYTES=4
RCB_LBA=ADDR(LOAD REP LB)
!---------------- Fire LOAD-REP command -------------------
? PRINTSTRING("LOAD REP Command".SNL)
FIRE CHAIN
!
!
RCB_LB BYTES=4
RCB_LBA=ADDR(INIT LB)
INTEGER(INIT ADDR)=X'0000FC10' ! AUTOTHROW BIT; ! initialise data
!---------------- Fire INIT command -------------------
? PRINTSTRING("INITIALISE Command".SNL)
FIRE CHAIN
!
RCB_LB BYTES=4
RCB_LBA=ADDR(WRITE CONTROL LB)
!---------------- Fire WRITE CONTROL command -------------------
? PRINTSTRING("WRITE CONTROL Command".SNL)
FIRE CHAIN
!
! Now return page
P=0
P_DEST=RETURNEPAGE DEST
P_P2=CDEX
DPON(P)
! De=-allocate
P=0
P_DEST=GPC DEST ! DE ALLOC
P_P1=IMNEM
DOUT(P)
? PRINTSTRING("De-allocate reply =".ITOS(P_P1).SNL)
RETURN
ROUTINE FIRE CHAIN
RECORD P(PARMF)
INTEGER RESP0,RESP1
P=0
P_DEST=GPC DEST ! EXEC CHAIN
P_SRCE=1<<31
P_P1=ADDR(RCB)
P_P2=SNO
P_P3=1<<4 ! 3; ! PAWFN<<4 ! SAWFLAGS
DOUT(P)
IF P_P1#0 START
PRINTSTRING("Fire Chain Reply =")
WRITE(P_P1,1); NEWLINE
FINISH
POFF0:
DPOFF(P)
RESP0=P_P1
RESP1=P_P2
? PRINTSTRING("RESP0=")
? PHEX(RESP0)
? NEWLINE
IF (RESP0>>16)&255=X'10' THEN -> POFF0; ! Attention response
END ; ! FIRE CHAIN
END ; ! LOAD LP REP
EXTERNALROUTINE DE ALLOCATE(STRING (255) PARMS)
RECORD P(PARMF)
P=0
P_P1=GPC DEST ! DE ALLOC
P_P1=GET MNEMONIC(PARMS)
DPON(P)
DPOFF(P)
PRINTSTRING("Deallocate reply =")
WRITE(P_P1,2)
NEWLINE
END ; ! DE ALLOCATE
ENDOFFILE