|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 23020 (0x59ec)
Notes: pts_type(SC)
Names: »FILES.SC«
└─⟦f350e1b7a⟧ Bits:30009678 Philips computer tape "600219"
└─⟦this⟧ »PTSDEMO/FILES.SC«
IDENT FILES SEP 80,SEBE,BSO APELDOORN
*
*
*
*
***********************************************************************
*
* F I L E S
* ***************
*
* THIS MODULE PROVIDES AN CREDIT INTERFACE TO HANDLE THE TOSS
* UTILITIES. ALL THE ROUTINES ARE IN ASSEMBLER.
*
* THE INTERFACE IS CALLED UPON THE FOLLOWING MANNERS :
*
*
* 1) TO CREATE A STANDARD FILE
*
* CALL CRFS,DATAITEM1,VAL1,VOL1(,VOL2,..),DATE,RECL,NOREC,
* BF,NOIND,KEY,ERROR
*
* DATAITEM1 CONTAINS THE FILE NAME.(MUST BE 8 CHAR.)
* VAL1 CONTAINS THE NUMBER OF VOLUMES.
* VOL(1-4) REPRESENTS DATAITEMS IN WICH THE VOLUMENAMES
* ARE PLACED (EACH ONE MUST BE 6 CHAR.)
* DATE A STRING ITEM WITH THE SYSTEM DATE.
* BF REPRESENTS THE BLOCKINGS FACTOR. (IN BINAIRY).
* RECL IS A BINAIRY WITH THE RECORD LENGTH.
* NOREC IS A BINAITY WITH THE NUMBER OF RECORDS.
* NOIND REPRESENTS THE NUMBER OF INDEX FILES.
* KEY REPRESENTS A DATAITEM IN WICH THE KEYADRES IS PLACED.
* ERROR THIS FIELD CONTAINS THE ERROR NUMBER.
*
*
* 2) TO DELETE A STANDARD FILE.
*
* CALL DLFS,DATAITEM1,VAL1,VOL1,(VOL2..),ERROR
*
* THE CONTENS OF THE ITEMS IS THE SAME AS WITH A CREATE FILE.
*
*
***********************************************************************
*
* SEE NEXT PAGE.
*
EJECT
*
***********************************************************************
*
*
* 3) TO GET THE LRN OF A STANDARD FILE.
*
* CALL GETLRN,DATAITEM1,VAL1,VOL1,(VOL2,..),LRN,ERROR
*
* LRN CONTAINS THE LAST RECORD NUMBER OF A FILE
* AFTER THE CALL GETLRN IS PERFORMED SUCCESFULL.
*
* THE CONTENS OF THE OTHER ITEMS IS THE SAME AS WITH A
* CREATE FILE.
*
*
* 4) TO UPDATE THE LRN OF A STANDARD FILE.
*
* CALL PUTLRN,DATAITEM1,VAL1,VOL1,(VOL2,..),LRN,ERROR
*
* THE CONTENS OF THE ITEMS IS THE SAME AS WITH A
* CALL GETLRN, BUT IN THIS CASE THE LRN IS UPDATED
* AT THE RIGTH PLACE IN THE -VTOC-.
*
*
* 5) SOME ROUTINES TO GET THE SPECIALITIES FROM A FILE.
* ALL THESE ROUTINES ARE THE SAME AS THE GETLRN.
*
* CALL GET...,DATAITEM1,VAL1,VOL1,(VOL2,..),...,ERROR
*
* GETRL RECORD LENGTH.
* GETEL FILE EXTENSION LENGTH.
* GETBF BLOCKINGS FACTOR.
* GETNIF NUMBER OF INDEX FILES.
* GETKA KEY ADDRESS.
*
*
* 6) COPY FILE TO FILE.
*
* CALL CFF,FILEIN,VOL1,FILEOUT,VOL2,ERROR
*
* FILEIN CONTAINS THE NAME OF THE INPUT FILE.
* FILEOUT CONTAINS THE NAME OF THE OUTPUT FILE.
* VOL1 CONTAINS THE VOLUME NAME OF INPUTFILE.
* VOL2 CONTAINS THE VOLUME NAME OF OUTPUTFILE.
*
*
* BY : SEBE KRUIJER.
***********************************************************************
*
EJECT
*
*************************************************
* E N T R I E S A N D E X T E R N A L S *
*************************************************
*
ENTRY CRFS
ENTRY DLFS
ENTRY A:PPC
ENTRY A:EVA -ROUTINE FOR I:EVA0.
ENTRY GETLRN
ENTRY PUTLRN
ENTRY CFF
ENTRY GETRL
ENTRY GETEL
ENTRY GETBF
ENTRY GETNIF
ENTRY GETKA
*
*
EXTRN I:EVA0
EXTRN I:RT1
EXTRN CRFILE
EXTRN DLFILE
EXTRN COPFIL
EJECT
*
*********************************************************
*
* C R E A T E A S T A N D A R D F I L E
*
*
CRFS EQU *
CF A14,STANDRD -STANDARD FILE BLOCK.
CF A14,TEKST -FILL DATE RET. PERIOD.
CF A14,A:EVA
ST A3,BLOCK+50 -RECORD LENGTH.
CF A14,A:EVA
ST A3,BLOCK+56 -NO OF RECORDS.
CF A14,A:EVA -HAAL BLOCKINGSFACTOR.
SC A3,BLOCK+49 -STORE
CF A14,A:EVA
SLL A3,8 -NIF TO 1E BYTE.
ST A3,BLOCK+54
CF A14,A:EVA -GET KEYADRES.
ST A3,BLOCK+52
CF A14,STORE -SAVE REG 11 .. 13
LDKL A12,BLOCK -BLOCK ADRES.
CF A14,CRFILE -THE CREATE
RF CFFEND -TO COMMON SEGMENT
*
*
****************************************************************
*
* D E L E T E A S T A N D A R D F I L E
*
*
DLFS EQU *
CF A14,STANDRD STANDARD PARAM.
CF A14,STORE STORE REGISTERS.
LDKL A12,BLOCK
CF A14,DLFILE -DELETE THE FILE.
RF CFFEND
*
*
***************************************************************
EJECT
*
*
***************************************************************
*
* THIS ROUTINE IS TO GET THE LAST RECORD NUMBER FROM
* THE -VTOC-.
*
***************************************************************
*
GETLRN EQU *
CF A14,LRN
LDR A1,A1
RF(NZ) AFHAND
LD A4,22,A4 -GET LRN NR.
GETAF EQU *
CF A14,I:EVA0
STR A4,A9 STORE LAST REC NUMBER
LDK A1,0 -INDICATION OK.
AFHAND EQU *
LDK A2,2
ADS A2,REG12 -NIEUWE A12
LDR A1,A1 -IS IT OKE.?
RF(Z) COMSEG
RF GETRC
*
*
**************************************************************
*
* THIS ROUTINE IS THE PUTLRN.
*
***************************************************************
*
PUTLRN EQU *
CF A14,LRN
LDR A1,A1
RB(NZ) AFHAND
CF A14,A:EVA
ST A3,22,A4 -STORE RECORD NUMBER.
CF A14,WRITE -WRITE THE LRN.
*
RB AFHAND
*
EJECT
*
***************************************************
* GET THE RECORD LENGTH.
***************************************************
*
GETRL EQU *
CF A14,LRN -SOME STANDARDS.
LDR A1,A1
RB(NZ) AFHAND -OKE ??
LD A4,24,A4 -THE RECORD LENGTH.
RB GETAF
*
*****************************************
* GET THE EXTENSION LENGTH.
*****************************************
*
GETEL EQU *
CF A14,LRN
LDR A1,A1 -OKE ??
RB(NZ) AFHAND
LD A4,14,A4 -THE EXTENSION LENGTH.
RB GETAF
*
****************************************
* GET THE BLOCKINGS FACTOR.
****************************************
*
GETBF EQU *
CF A14,LRN -STANDARDS.
LDR A1,A1
RB(NZ) AFHAND
LD A4,26,A4 -THE BLOCKINGS FACTOR.
SRL A4,8 -TO 2E BYTE.
RB GETAF
*
*****************************************
* GET THE NUMBER OF INDEX FILES.
*****************************************
*
GETNIF EQU *
CF A14,LRN
LDR A1,A1 -OKE ??
RB(NZ) AFHAND
LD A4,36,A4 -THE NUMBER.
SLL A4,8
SRL A4,8 -TO THE 2E BYTE.
RB GETAF
EJECT
*
*
******************************************
* GET THE KEY ADDRESS.
******************************************
*
GETKA EQU *
CF A14,LRN
LDR A1,A1 -OKE ??
RB(NZ) AFHAND
LD A4,38,A4 -THE KEY ADDRESS.
RB GETAF
*
*
******************************************
* COPY FILE TO FILE.
******************************************
*
CFF EQU *
CF A14,QUEUE -SYSTEM FREE.
CF A14,INIT
CF A14,ASROUT -ASSIGN FILES.
CF A14,ASROUT
LD A1,FC1 -FC1 := C0.
SUK A1,2
ST A1,FC1
LDK A2,0
ST A2,BLOCK+4 INIT BLOCK.
ADK A2,1
ST A2,BLOCK+8
LD A3,FC1A2 -THE FILE CODES.
ST A3,BLOCK+6 -IN THE BLOCK.
CF A14,STORE
LDKL A12,BLOCK -BLOCK ADDRESS.
CF A14,COPFIL -COPY ROUTINE.
CFFEND EQU *
RF COMSEG
*
EJECT
*
*
********************************************
* THE ASSIGN ROUTINE.
* THE FILE CODE IS INCREASED.
********************************************
*
ASROUT EQU *
CF A14,I:EVA0 -A FILENAME.
LDK A4,8 -BYTES TO MOVE.
LDK A3,6 -FROM BYTE 6.
CF A14,A:MOVE
CF A14,I:EVA0 -A VOLUME NAME.
LDK A4,6
LDK A3,14
CF A14,A:MOVE
LDKL A8,ASSBLK -ADDRESS BLOCK.
LDK A7,0 -NORMAL ASSIGN.
LD A1,FC1 FILE CODE.
STR A1,A8 -TO BLOCK.
IM FC1
LKM
DATA 15 -THE ASSIGN.
RTN A14
*
*
EJECT
*
***************************************
* G E T R E T U R N C O D E
***************************************
*
GETRC EQU *
LD A2,RETCOD
LDR A1,A2 -RETURN CODE IN A1
ANKL A1,/028E -I/O ERROR ??
RF(NZ) COMSEG -IN A1 FOUT.
LDR A1,A2 -WAIT.
ANK A1,/20 -FILE NAME UNKNOWN.
RF(NZ) COMSEG -IN A1 AL WRONG.
LDR A1,A2
ANK A1,1 -DISK NOT OPERABLE.
RF(NZ) COMSEG
LDR A1,A2 -VOLUME NAME UNKNOWN.
RF COMSEG
*
*
*********************************************
* C O M S E G
*
* COMMON EXIT PART FOR ALL FUNCTIONS.
*********************************************
*
*
COMSEG EQU *
LDR A4,A1
CF A14,RESTOR -RESTORE A11,..A13
CF A14,I:EVA0
STR A4,A9
LDK A1,0 -PRESET COND. REG.
LDR A4,A4 -TJEK ON STATUS.
RF(Z) CON0
LDK A1,2 -ERROR.
CON0 EQU *
CF A14,KONDIT
CM FREE -FREE.
ABL I:RT1
EJECT
*
*********************************************************
*
* STANDARD ROUTINES FOR THE GETLRN.
*
*
LRN EQU *
CF A14,STANDRD -GET FILENAME + VOLUME NAME
CF A14,STORE
CF A14,INIT1 -FC--> E9, REC LENGTH--> 410
VOLG CF A14,INIT2 -BUFADRES + SECNR.
CF A14,GETVOL -GET VOLUME.
LDR A1,A1
RF(NZ) ENDLRN -NOT OPERABLE
CF A14,NXTECB -ADJUST THE ECB.
CF A14,VTOC -SEARCH THE VTOC.
LDR A1,A1
RF(NZ) ENDLRN -I/O ERROR
LDR A8,A8 -FILE NOT IN VTOC.
RB(Z) VOLG
ENDLRN EQU *
RTN A14
*
*
INIT1 EQU *
LDK A1,0
ST A1,RETCOD -INIT RETURN CODE
LDK A1,/E8
ST A1,ECB
LDKL A2,/19A
ST A2,ECB+4 -RECORD LENGTH
RTN A14
*
INIT2 EQU *
LDK A2,0
ST A2,SECNR -SECTOR NUMBER.
LDKL A2,BUFFER
ST A2,ECB+2 -BUFFER ADRES
LDK A1,1
RTN A14
EJECT
*
***************************************
* GET THE VOLUME NAME.
***************************************
*
*
GETVOL EQU *
ADS A1,ECB -STORE FILECODE
LC A1,ECB+1
SUK A1,/F4 -IS IT F4 ?
RF(Z) VOLABSEN
CF A14,READ
LDR A1,A1
RF(NZ) NEXTVOL
CF A14,CHKVLN -CHECK VOLUME NAME.
LDR A1,A1
RF(NZ) NXVOL -NEXT VOLUME
RTN A14
NXVOL EQU *
LDK A1,/40 -VOLUME NAME UNKNOWN.
ORS A1,RETCOD
NEXTVOL LDK A1,1 -FILECODE 1 UP.
RB GETVOL -ONES MORE.
VOLABSEN LDK A1,2
RTN A14
*
*
*
EJECT
*
*
********************************************************
* I / O R O U T I N E S .
********************************************************
*
*
READ EQU *
LDK A7,/91 -PHYSICAL READ.
RF IODISC
*
*
WRITE EQU *
LDK A7,/95 -PHYSICAL WRITE.
RF IODISC
*
*
*
* CHECK THE RETURN CODE.
*
IODISC EQU *
LDK A2,1 -INDICATION RETRY.
LDKL A8,ECB
RETRY LKM
DATA 1
LD A1,8,A8 -RETURN CODE.
RF(Z) EOREAD
SUK A2,1 -RETRY ??
RB(Z) RETRY
ORS A1,RETCOD -STORE TOTAL RETURN CODE
EOREAD EQU *
RTN A14
*
*
**************************************************************
* CHECK CONDITION REGISTER.
**************************************************************
*
KONDIT EQU *
LD A2,2,A13
SC A1,-2,A2
RTN A14
*
*
*
A:EVA EQU *
CF A14,I:EVA0
LDR* A3,A9
RTN A14
*
EJECT
*
*
*****************************************
* CHECK VOLUME NAME.
*****************************************
*
CHKVLN EQU *
LD A2,ECB+2 -BUFFER ADRS.
ADK A2,2 -POINTER IN BUFFER.
ST A2,C:STOR -ROUTINE COMPARE
LDK A3,1 -PRESET NUMBER OF CHECKS
LDKL A4,BLOCK+16 -BASIC VOLUME NAME
LABEL EQU *
LDK A1,6
CF A14,COMPAR -CHECK THE NAME
LDR A1,A1
RF(Z) EINDE
ADK A3,1 -NEXT NAME
CWR A6,A3 -ALL VOLUMES HAD ??
RF(N) EINDE
ADK A4,6 -ADJUST POINTER.
RB LABEL
EINDE RTN A14
*
*
COMPAR EQU *
LDK A5,0
ADR A4,A1 -THE CORRECT POINTER ?
C:LOOP SUK A1,1
SUK A4,1
LCR A5,A4 -CHAR IN A5.
CC A5,0,A1 -COMPARE CHAR.
C:STOR EQU *-2 -SAVE ADRES ITEM
RF(NZ) NOTSAME -NOT EQUAL
LDR A1,A1
RB(NZ) C:LOOP
RTN A14
NOTSAME EQU *
SUR A4,A1 -GET POINTER BACK
LDK A1,2
RTN A14
*
EJECT
*
*********************************
* GET NEXT ECB.
*********************************
*
*
NXTECB EQU *
LDKL A2,BUFFE2
ST A2,ECB+2 -SAVE BUFFER2 ADRES.
LD A6,BUFFER+12 -FREE SPACE TABLE
ADK A6,1
LD A3,BUFFER+8 -GET VTOC SECTORS.
ADR A3,A6 -LAST VTOC SECTOR.
RTN A14
*
*
*
**********************************************
* SEARCH FILENAME IN THE -VTOC-.
**********************************************
*
*
SEARCH EQU *
LDKL A4,BLOCK+8 -ADRES FILE NAME.
ST A4,C:STOR STORE IN ROUTINE COMPAR
LDKL A4,BUFFE2+2 -BEGIN VTOC RECORD.
LABEL2 LDK A1,8
CF A14,COMPAR -CHECK FILENAMES
LDR A1,A1
RF(Z) OKE -SAME ??
ADK A4,42 -NEXT VTOC RECORD.
CWK A4,BUFFE2+420 -END OF SECTOR.
RB(2) LABEL2 -NO GET BACK.
OKE RTN A14
*
EJECT
*
*
************************************
* READ SECTOR OF THE VTOC.
************************************
*
*
VTOC EQU *
ST A6,SECNR -STORE SECTOR NUMBER
CF A14,READ -READ SECTOR
LDR A1,A1
RF(NZ) ERRREAD -ERROR ?
CF A14,SEARCH -SEARCH FILE NAME.
LDR A1,A1
RF(Z) FOUND -FOUND ??
ADK A6,1 -NO NEXT ONE
CWR A3,A6 -END OF SECTOR ?
RB(NZ) VTOC -NO NEXT VTOC SECTOR.
LDK A1,/20 -FILENAME UNKNOWN
ORS A1,RETCOD -STORE RETURN CODE.
LDK A1,0
LDKL A8,0 -NOT PRESENT.
ERRREAD RTN A14
*
*
FOUND EQU *
LDK A1,0
RTN A14
*
*
EJECT
*
*
*************************************
* STANDARD SUB ROUTINE.
*************************************
*
*
STANDRD EQU *
CF A14,QUEUE
CF A14,INIT
CF A14,FILNAM
CF A14,A:PPC
LDR A7,A3 -SAVE REGISTER.
LDK A6,0
ST:01 EQU *
CF A14,VOLNAM
ADK A6,1
SUK A7,1
RB(NZ) ST:01
LDKL A1,/5353
SC A1,BLOCK+6 -STORE IN PARAM BLOCK.
RTN A14
*
*
*
**************************************
* SUB ROUTINE : QUEUE.
*
* THIS IS TO SHEDULE THE TASK UNTILL
* THE ENTRY IS OMITTED.
***************************************
*
*
QUEUE EQU *
LD A1,FREE -IS OMITTED ??
RF(Z) Q:RTN -OKAY IF ZERO.
LKM
DATA 0
RB QUEUE
Q:RTN EQU *
IM FREE -INDICATE USED.
RTN A14
*
*
EJECT
*
*
*****************************************
* THIS ROUTINE IS TO COPY THE USER
* FILENAME TO THE DISCRIPTOR BLOCK.
******************************************
*
*
FILNAM EQU *
CF A14,I:EVA0
LDK A4,8 -BYTES TO MOVE.
LDK A3,8 -FROM BYTE 8 IN BLOCK.
CF A14,A:MOVE
RTN A14
*
*
******************************************
* THIS ROUTINE IS TO MOVE THE VOLUME
* NAME TO THE DISCRIPTOR BLOCK.
*
* REG. A7 CONTAINS THE INDEX OF THE VOLUME NAME.
******************************************
*
*
VOLNAM EQU *
CF A14,I:EVA0
LDR A1,A6 -GET INDEX.
SLL A1,1 -MUL BY 2.
ADR A1,A6 -ADD VALUE.
SLL A1,1 -MUL BY 2 --> 6 X.
LDK A3,16 -VOLUME ENTRY.
ADR A3,A1 -ADD INDEX.
LDK A4,6 -LENGTH
CF A14,A:MOVE -MOVE VOLUME
RTN A14
*
*
*************************************************
* ROUTINE TO GET A CONSTANT VALUE FROM THE
* USER DATA DIVISION AND TO UPDATE THE
* PROGRAM POINTER.
*************************************************
*
*
A:PPC EQU *
LDK A3,0
LCR A3,A12
ADKL A12,1
RTN A14
EJECT
*
*
****************************************************
* ROUTINE TO MOVE CORE FROM USER TO THE
* DISCRIPTOR BLOCK.
*
* REG. A9 CONTAINS THE USER CORE ADRES.
* REG. A4 CONTAINS THE LENGTH
* REG. A3 CONTAINS THE ENTRY IN THE BLOCK.
*****************************************************
*
*
A:MOVE EQU *
LDKL A1,BLOCK -DISCRIPTOR BLOCK
ADR A1,A3 -ENTRY IN BLOCK
ST A1,DISCRIPT
ST A9,ADRES -USER ADRES.
LDK A1,0
M:LOOP EQU *
SUK A4,1 -EVERY THING MOVED ??
RF(N) M:END
LC A1,0,A4
ADRES EQU *-2
SC A1,0,A4
DISCRIPT EQU *-2
RB M:LOOP
M:END EQU *
RTN A14
*
*
******************************************************
* ROUTINE TO MOVE DATE AND RETENTION PERIOD
* FROM USER BUFFER TO DISCRIPTOR BLOCK.
*******************************************************
*
*
TEKST EQU *
CF A14,I:EVA0
LDK A4,15 LENGTH TEXT.
LDK A3,40 ENTRY IN BLOCK.
CF A14,A:MOVE
RTN A14
*
*
EJECT
*
*
******************************************************
* THIS ROUTINE IS TO INIT THE DISCRIPTOR BLOCK
* ON TO SPACES.
******************************************************
*
INIT EQU *
LDKL A1,/2020 -SPACES.
LDK A2,50
I:LOOP EQU *
ST A1,BLOCK+6,A2
SUK A2,2
RB(NN) I:LOOP -END OF BUFFER ??
LDK A1,0
ST A1,BLOCK+54 -NUMBER OF INDEX FILES --> 0
RTN A14
*
*
FREE DATA 0
FC1 DATA /01C0
FC1A2 DATA /C0C1
*
************************************************
* ROUTINE TO SAVE REGISTERS.
************************************************
*
STORE EQU *
ST A11,REG11
ST A12,REG12
ST A13,REG13
RTN A14
*
*
************************************************
* ROUTINE TO GET BACK THE SAVED REGISTERS.
************************************************
*
RESTOR EQU *
LDKL A11,0
REG11 EQU *-2
LDKL A12,0
REG12 EQU *-2
LDKL A13,0
REG13 EQU *-2
RTN A14
*
DATA 'TM','P-'
EJECT
*
*
************************************************************************
*
* D I S C R I P T O R B L O C K
*
*
BLOCK EQU *
DATA BUFFER
DATA BUFFE2
ASSBLK DATA 0
RES 16
ECB DATA 0
DATA 0
DATA 0
DATA 0
DATA 0 -RETURN CODE.
SECNR DATA 0 -SECTOR NUMBER.
RETCOD DATA 0
BUFADR DATA 0
DATA 0
*
*
*
************************************************************************
*
* C R E A T E A N D D E L E T E B U F F E R
*
*
*
DATA 0
DATA /4141
BUFFER EQU *
RES 205
BUFFE2 EQU *
RES 205
*
*
*
END