Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

)CLEAR
)WSID SF2VX4

.DL CSET ASDRIVER FNAME;.BXIO;.BXTRAP;COMPONENT;COMPLIST;F;.BXPP
"
"  THIS FUNCTION IS THE DRIVER FOR TRANSFERRING /AS FILES.
"
" THE RIGHT ARGUMENT SPECIFIES THE NAME OF THE FILE.  THE LEFT ARGUMENT
" SPECIFIES THE CHARACTER SET OF THE FILE: 1 FOR TTY, 2 FOR APL.
"
 .BXIO_1
 .BXTRAP_'.GORDERR'
 .BXPP_18
 F_'A' OUTFILE FNAME
"
 .GO(0.NEICHAN_.BXASS FNAME,'/AS')/L1
 1 WRITE '" *** ERROR ASSIGNING INPUT FILE:  ',FNAME
 .GOEND
L1:0 WRITE 'WS.USCHAN_.BXASS ''',F,'/AS'''
 COMPLIST_.IOCOMPONENT_0
 CSET_3#CSET
"
"  NOW BOTH FILES ARE ASSIGNED AND THE VARIABLES ARE INITIALIZED.  WE NOW LOOP
"  OVER THE FILE, CALLING ISREAD TO GET THE NEXT COMPONENT, THEN CALLING WRITEVAR
"  TO DUMP IT TO THE OUTPUT FILE.  WE REPEAT UNTIL EOF IS REACHED.
"
LOOP:
 .GO(WRITEIT,DONE,RDERR)[1+ASREAD CSET]
WRITEIT:'RECORD' WRITEVAR 'RECORD'
 .BXAI_.BXEX 'RECORD'
 0 WRITE 'RECORD.OQ[',(.FMCSET),']WS.USCHAN'
 .GOLOOP
RDERR:1 WRITE '" *** ERROR ',(4^.BXERROR),' READING FROM FILE ',FNAME,' RECORD ',.FMCOMPONENT
 1 WRITE '" ',4.DA(.NG1+.BXERROR.IO.BXAV[102])^.BXERROR
DONE:
"  ALL DONE
 0 WRITE '.BXDAS WS.USCHAN'
END:1 WRITE '" ALL DONE WITH INPUT FILE:  ',FNAME,' /AS'
 .BXAI_.BXDAS ICHAN,OCHAN
.DL


.DL Z_ASREAD MODE;.BXTRAP
"  THIS FUNCTION READS THE NEXT COMPONENT FROM AN /AS FILE.
"  IT IS PASSED THE MODE TO READ IN.
"  IT USES THE CHANNEL FROM THE GLOBAL ICHAN TO READ FROM.
"  THE COMPONENT IS LEFT IN THE GLOBAL RECORD.
"  THE GLOBAL COMPONENT IS SET TO ONE, TO INDICATE ASREAD WAS CALLED.
"
"  IF AN ERROR OCCURS, 2 IS RETURNED.
"  IF EOF OCCURS (0 75 .RO 0), 1 IS RETURNED.
"  IF ALL GOES OK, 0 IS RETURNED.
"
 .BXTRAP_'.GO ERR'
 COMPONENT_COMPONENT+1
 .GO(2.NE.RO.RORECORD_.IQ[MODE]ICHAN)/Z_0
 Z_&/ 0 75 =.RORECORD
 .GO0
ERR:Z_2
 .GO0
.DL


.DL BSDRIVER FNAME;.BXIO;.BXTRAP;COMPONENT;COMPLIST;F;.BXPP
"
"  THIS FUNCTION IS THE DRIVER FOR TRANSFERRING /BS FILES.
"
" THE /BS FILE SPECIFIED BY FNAME WILL BE CONVERTED TO A /IS FILE ON THE
" VAX SINCE THERE IS NO EQUIVALENT TO BS.   ALL COMPONENTS ARE ASSUMED
" TO HAVE HEADERS.
"
 .BXIO_1
 .BXTRAP_'.GORDERR'
 .BXPP_18
 F_'B' OUTFILE FNAME
"
 .GO(0.NEICHAN_.BXASS FNAME,'/BS')/L1
 1 WRITE '" *** ERROR ASSIGNING INPUT FILE:  ',FNAME
 .GOEND
L1:0 WRITE 'WS.USCHAN_.BXASS ''',F,'/IS'''
 COMPLIST_.IOCOMPONENT_0
"
"  NOW BOTH FILES ARE ASSIGNED AND THE VARIABLES ARE INITIALIZED.  WE NOW LOOP
"  OVER THE FILE, CALLING BSREAD TO GET THE NEXT COMPONENT, THEN CALLING WRITEVAR
"  TO DUMP IT TO THE OUTPUT FILE.  WE REPEAT UNTIL EOF IS REACHED.
"
LOOP:
 .GO(WRITEIT,DONE,RDERR)[1+BSREAD]
WRITEIT:'RECORD' WRITEVAR 'RECORD'
 .BXAI_.BXEX 'RECORD'
 0 WRITE 'RECORD.OQWS.USCHAN'
 .GOLOOP
RDERR:1 WRITE '" *** ERROR ',(4^.BXERROR),' READING FROM FILE ',FNAME,' RECORD ',.FMCOMPONENT
 1 WRITE '" ',4.DA(.NG1+.BXERROR.IO.BXAV[102])^.BXERROR
DONE:
"  ALL DONE
 0 WRITE '.BXDAS WS.USCHAN'
END:1 WRITE '" ALL DONE WITH INPUT FILE:  ',FNAME,' /BS'
 .BXAI_.BXDAS ICHAN,OCHAN
.DL


.DL Z_BSREAD;.BXTRAP
"  THIS FUNCTION READS THE NEXT COMPONENT FROM AN /BS FILE.
"  IT USES THE CHANNEL FROM THE GLOBAL ICHAN TO READ FROM.
"  THE COMPONENT IS LEFT IN THE GLOBAL RECORD.
"  THE GLOBAL COMPONENT IS SET TO ONE, TO INDICATE ISREAD WAS CALLED.
"
"  IF AN ERROR OCCURS, 2 IS RETURNED.
"  IF EOF OCCURS (NEXT WORD TO READ > NUMBER OF WORDS IN FILE), 1 IS RETURNED.
"  IF ALL GOES OK, 0 IS RETURNED.
"
 .BXTRAP_'.GO ERR'
 COMPONENT_COMPONENT+1
" TEST FOR END OF FILE
 .GO(Z_>/(.BXFLS ICHAN)[2 3])/0
 RECORD_.IQICHAN
 .GOZ_0
ERR:Z_2
 .GO0
.DL


.DL DADRIVER FNAME;.BXIO;.BXTRAP;COMPONENT;COMPLIST;F;.BXPP
"
"  THIS FUNCTION IS THE DRIVER FOR TRANSFERRING /DA FILES.
"
"  IT IS CALLED WITH A SINGLE ARGUMENT, THE NAME OF THE FILE TO BE TRANSFERRED.
"
 .BXIO_1
 .BXTRAP_'.GORDERR'
 .BXPP_18
 F_'D' OUTFILE FNAME
"
 .GO(0.NEICHAN_.BXASS FNAME,'/DI')/L1
 1 WRITE '" *** ERROR ASSIGNING INPUT FILE:  ',FNAME
 .GOEND
L1:COMPONENT_0
"
"  NOW TRY AND READ A RECORD.  THIS IS DONE TO ENSURE THAT THE FILE IS A
"  /DA FILE BEFORE WE WRITE ANYTHING OUT.
 .BXAI_.IQ[1]ICHAN
 0 WRITE 'WS.USCHAN_.BXASS ''',F,'/DA'''
"
"   NOW SET UP THE GLOBAL COMPLIST, WHICH IS A VECTOR CONTAINING THE INDICES OF
"   ALL EXISTING COMPONENTS.
 COMPLIST_,(.BXFCM ICHAN)[;1]
"
"  NOW BOTH FILES ARE ASSIGNED AND THE VARIABLES ARE INITIALIZED.  WE NOW LOOP
"  OVER THE FILE, CALLING DAREAD TO GET THE NEXT COMPONENT, THEN CALLING WRITEVAR
"  TO DUMP IT TO THE OUTPUT FILE.  WE REPEAT UNTIL EOF IS REACHED.
"
LOOP:
 .GO(WRITEIT,DONE,RDERR)[1+DAREAD]
WRITEIT:'RECORD' WRITEVAR 'RECORD'
 .BXAI_.BXEX 'RECORD'
 0 WRITE 'RECORD .OQ[',(.FMCOMPONENT),'] WS.USCHAN'
 .GOLOOP
RDERR:1 WRITE '" *** ERROR ',(4^.BXERROR),' READING FROM FILE ',FNAME,' COMPONENT ',.FMCOMPONENT
 1 WRITE '" ',4.DA(.NG1+.BXERROR.IO.BXAV[102])^.BXERROR
DONE:
"  ALL DONE
 0 WRITE '.BXDAS WS.USCHAN'
END:1 WRITE '" ALL DONE WITH INPUT FILE:  ',FNAME,' /DA'
 T_.BXDAS ICHAN,OCHAN
.DL


.DL Z_DAREAD;.BXTRAP
"  THIS FUNCTION READS THE NEXT COMPONENT FROM AN /DA FILE.
"  IT USES THE CHANNEL FROM THE GLOBAL ICHAN TO READ FROM.
"  IT USES 1^COMPLIST FOR THE INDEX OF THE COMPONENT TO READ.  IF
"  COMPLIST IS EMPTY, IT RETURNS 0 (EOF).  THE COMPONENT IS LEFT
"  IN THE GLOBAL RECORD.  THE GLOBAL COMPONENT IS SET TO THE INDEX
"  OF THE COMPONENT READ, AND THE FIRST ELEMENT OF COMPLIST IS DROPPED.
"
"  IF AN ERROR OCCURS, 2 IS RETURNED.
"  IF EOF OCCURS (COMPLIST EMPTY), 1 IS RETURNED.
"  IF ALL GOES OK, 0 IS RETURNED.
"
 .BXTRAP_'.GO ERR'
 .GO((Z_1)>.ROCOMPLIST)/0
 COMPONENT_1^COMPLIST
 COMPLIST_1.DACOMPLIST
 .GO(2.NE.RO.RORECORD_.IQ[COMPONENT]ICHAN)/Z_0
 Z_&/ 0 75 =.RORECORD
 .GO0
ERR:Z_2
 .GO0
.DL


.DL ISDRIVER FNAME;.BXIO;.BXTRAP;COMPONENT;COMPLIST;F;.BXPP
"
"  THIS FUNCTION IS THE DRIVER FOR TRANSFERRING /IS FILES.
"
"  IT IS CALLED WITH A SINGLE ARGUMENT, THE NAME OF THE FILE TO BE TRANSFERRED.
"
 .BXIO_1
 .BXTRAP_'.GORDERR'
 .BXPP_18
 F_'I' OUTFILE FNAME
"
 .GO(0.NEICHAN_.BXASS FNAME,'/IS')/L1
 1 WRITE '" *** ERROR ASSIGNING INPUT FILE:  ',FNAME
 .GOEND
L1:0 WRITE 'WS.USCHAN_.BXASS ''',F,'/IS'''
 COMPLIST_.IOCOMPONENT_0
"
"  NOW BOTH FILES ARE ASSIGNED AND THE VARIABLES ARE INITIALIZED.  WE NOW LOOP
"  OVER THE FILE, CALLING ISREAD TO GET THE NEXT COMPONENT, THEN CALLING WRITEVAR
"  TO DUMP IT TO THE OUTPUT FILE.  WE REPEAT UNTIL EOF IS REACHED.
"
LOOP:
 .GO(WRITEIT,DONE,RDERR)[1+ISREAD]
WRITEIT:'RECORD' WRITEVAR 'RECORD'
 .BXAI_.BXEX 'RECORD'
 0 WRITE 'RECORD.OQWS.USCHAN'
 .GOLOOP
RDERR:1 WRITE '" *** ERROR ',(4^.BXERROR),' READING FROM FILE ',FNAME,' RECORD ',.FMCOMPONENT
 1 WRITE '" ',4.DA(.NG1+.BXERROR.IO.BXAV[102])^.BXERROR
DONE:
"  ALL DONE
 0 WRITE '.BXDAS WS.USCHAN'
END:1 WRITE '" ALL DONE WITH INPUT FILE:  ',FNAME,' /IS'
 .BXAI_.BXDAS ICHAN,OCHAN
.DL


.DL Z_ISREAD;.BXTRAP
"  THIS FUNCTION READS THE NEXT COMPONENT FROM AN /IS FILE.
"  IT USES THE CHANNEL FROM THE GLOBAL ICHAN TO READ FROM.
"  THE COMPONENT IS LEFT IN THE GLOBAL RECORD.
"  THE GLOBAL COMPONENT IS SET TO ONE, TO INDICATE ISREAD WAS CALLED.
"
"  IF AN ERROR OCCURS, 2 IS RETURNED.
"  IF EOF OCCURS (0 75 .RO 0), 1 IS RETURNED.
"  IF ALL GOES OK, 0 IS RETURNED.
"
 .BXTRAP_'.GO ERR'
 COMPONENT_COMPONENT+1
 .GO(2.NE.RO.RORECORD_.IQICHAN)/Z_0
 Z_&/ 0 75 =.RORECORD
 .GO0
ERR:Z_2
 .GO0
.DL


.DL Z_T OUTFILE FNAME;F;I;DEV;PPN;TYP
"     MAKE SURE APLNNN IS DEFINED
 .XQ(0=.BXNC 'APLNNN')/'APLNNN_0'
"     REMOVE LEADING BLANKS
 F_(.OR\F.NE' ')/F_FNAME
"     REMOVE TRAILING BLANKS
 F_(.RV.OR\.RVF.NE' ')/F
"     PICK UP DEVICE: NAME IF PRESENT
 DEV_(I_.RV.OR\.RVF=':')/F
"     REMOVE DEVICE: NAME IF PRESENT
 F_(.NTI)/F
"     GET [PPN] IF PRESENT
 PPN_(I_(.RV.OR\.RVI)&.OR\I_F.EP'[]')/F
"     REMOVE [PPN] IF PRESENT
 F_(.NTI)/F
"     CHANGE , TO . IF PRESENT
 .XQ(','.EPF)/'F[(<\F='','')/.IO.ROF]_''.'''
"     GET . TYP IF PRESENT
 TYP_(I_.OR\F='.')/F
"     REMOVE . TYP OF PRESENT
 F_(.NTI)/F
"     OUTPUT FILE IS NAME . T2V WHERE T IS D, A, I, B
 OCHAN_.BXASS F,',',T,'2V/AS'
  1 WRITE '" BUILDING ',(.BXASS OCHAN),' ',.FM.BXTS
"     RETURN VAX FILE NAME
 .GO(0=.ROI_(0.NE.RODEV,PPN)/'APL',(,'ZI3'$APLNNN_APLNNN+1),':')/L
 1 WRITE '" *** ''',DEV,PPN,'''',' REPLACED BY ''',I,''''
L:Z_I,F,(0.NE.ROTYP)/'.',1.DATYP
.DL


.DL A WRITE B ; .BXPW
"  THE WRITE FUNCTION DOES ANY NECESSARY TRANSLATION FROM APLSF'S
"  []AV TO VAX APL'S []AV.  THE TRANSLATE TABLE AVMAT IS 512 BY 3
"  WITH THE KEY OVERSTRIKE FOR EACH []AV CODE.  CODES THAT ARE NOT
"  TRIPLES ARE PADDED WITH ASCII NULLS WHICH ARE STRIPPED BEFORE
"  OUTPUT.
"
"  IF THE RIGHT ARGUMENT IS EMPTY, NOTHING IS WRITTEN ANYWHERE.  IF
"  THE LEFT ARGUMENT = 1, THE RIGHT ARGUMENT IS DISPLAYED ON THE
"  TERMINAL BEFORE IT IS TRANSLATED VIA AVMAT AND WRITTEN TO CHANNEL 2.
"
"  OUTPUT RECORD LENGTH IS 255 == MAX FOR VAX
 .GO(0.EP.ROB_,B)/0
 .XQ A/'.BX_B'
 B_,AVMAT[.BXAV.IOB;]
 .BXPW _ 255
 .BXAI_((B.NE1^.BXCTRL)/B).OQ[5]OCHAN
.DL


.DL WV.Z@ONAME WRITEVAR WV.Z@NAME;WV.Z@C;WV.Z@D;WV.Z@I;WV.Z@Q;WV.Z@R;WV.Z@T
"
"  THIS FUNCTION WRITES A VARIABLE OUT TO A )INPUT FILE SUCH THAT WHEN
"  THE INPUT FILE IS READ, THE VARIABLE IS RESTORED.  THE RIGHT ARGUMENT
"  SPECIFIES THE NAME OF THE VARIABLE IN THE CURRENT WORKSPACE.  THE
"  LEFT ARGUMENT SPECIFIES THE NAME THAT THE VARIABLE IS TO BE RESTORED
"  TO (MOSTLY FOR WRITING OUT SYSTEM VARIABLES).
"
"  ASSUMES .BXIO == 1 AND .BXPP == 18
"
"  GET THE SHAPE.  IF IT WILL NOT FIT ON ONE LINE, PUT IT INTO A
"  VARIABLE FIRST.
"
 .LDRANK_.FMWV.Z@D_.EP'.RO',WV.Z@NAME
 .GO(100>.RO.LDRANK)/WV.Z@L1A
 .LD.LDRANK_WV.Z@D
 '.LD.LDRANK' WRITEVAR '.LD.LDRANK'
 .LD.LDRANK_''
 .LDRANK_'.LD.LDRANK'
 .GOWV.Z@L1
WV.Z@L1A:.XQ(0=.ROWV.Z@D)/'.LDRANK_'''''''''''''
"
"  GET THE RAVEL OF THE VARIABLE AND THEN EXPUNGE THE VARIABLE TO REGAIN
"  THE MEMORY
"
WV.Z@L1:.XQ'WV.Z@D_,',WV.Z@NAME
 .BXAI_.BXEX WV.Z@NAME
"
"  GET THE TYPE OF THE VARIABLE, DO SOME INITS, THEN BRANCH
"
"  MAXIMUM NUMBER OF CHARACTERS PER FORMATTED DATA ELEMENT ON OUTPUT LINE:
"  TYPE = 1 : INTEGER => 18 DIGITS + BLANK + .NG       == 22
"       = 2 : BOOLEAN =>  1        + BLANK             ==  2
"       = 4 : D-FLOAT => 18        + BLANK + .NG + .NG == 25
"       = 5 : CHAR    =>  3          (NO BLANKS)       ==  3
"
"  USE MAXIMUM LINE LENGTH == 240 SO RECORD WON'T WRAP
 WV.Z@I_(.FL240% 22 2 1 25 3 1)[WV.Z@T_1^,(0 2 *18).EN1^(1^WV.Z@D).BXCOQ 1]
 WV.Z@C_0
 .GO(WV.Z@T=5)/WV.Z@L2
"
"  HERE IS WHERE WE HANDLE NUMERIC ARRAYS.  PRINT WARNING IF AN INTEGER
"  IN THIS ARRAY MUST BE REPRESENTED AS FLOATING ON THE VAX
"
 0 WRITE 'A.US_.IO0'
 .GO(0=.ROWV.Z@D)/WV.Z@FIN
 1 WRITE (((.NG1+2*32).OR.<.ABWV.Z@D)&1=WV.Z@T)/'" *** BIG INTEGER IN ',WV.Z@NAME
"
"  NOW, SINCE THE VECTOR IS NOT EMPTY, WE WRITE RECORDS THAT WILL BUILD UP
"  THE VECTOR BY CATENATION.
"
WV.Z@L3:WV.Z@T_.FMWV.Z@D[WV.Z@C+.IO([email protected](.ROWV.Z@D)-WV.Z@C)]
 WV.Z@T[.OMWV.Z@T='-']_'.NG'
0 WRITE 'A.US_A.US,',WV.Z@T
 .GO((.ROWV.Z@D)>WV.Z@C_WV.Z@C+WV.Z@I)/WV.Z@L3
 .GOWV.Z@FIN

"
"  HERE IS WHERE WE HANDLE CHARACTER ARRAYS.
"  .BXASCII[40] == QUOTE GETS TURNED INTO A .BXAV QUOTE
"
WV.Z@L2:0 WRITE 'A.US_'''''
 .GO(0=.ROWV.Z@D)/WV.Z@FIN
 WV.Z@D[.OMWV.Z@D=.BXASCII[40]]_''''
"
"  NOW, IF THE VECTOR IS NOT EMPTY WE WRITE RECORDS THAT WILL BUILD UP
"  THE VECTOR BY CATENATION.  QUOTES MUST BE DOUBLED.
"
WV.Z@L4:WV.Z@Q_WV.Z@D[WV.Z@[email protected](.ROWV.Z@D)-WV.Z@C]
 WV.Z@Q_WV.Z@Q[WV.Z@T[.GUWV.Z@T_(.IO.ROWV.Z@Q),.OMWV.Z@Q='''']]
 0 WRITE 'A.US_A.US,''',WV.Z@Q,''''
 .GO((.ROWV.Z@D)>WV.Z@C_WV.Z@C+WV.Z@I)/WV.Z@L4
"
"  NOW WE WRITE A RECORD THAT RESHAPES THE REBUILT VECTOR INTO ITS ORIGINAL
"  SHAPE.
"
WV.Z@FIN:0 WRITE WV.Z@ONAME,'_',.LDRANK,'.ROA.US'
.DL


)COPY SF2VX1 AVMAT
)SAVE