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