DataMuseum.dk

Presents historical artifacts from the history of:

Philips Data Systems

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Philips Data Systems

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - metrics - download

⟦51511afac⟧ 

    Length: 13976 (0x3698)
    Notes: pts_type(SC)
    Names: »GETLRN.SC«

Derivation

└─⟦f350e1b7a⟧ Bits:30009678 Philips computer tape "600219"
    └─⟦this⟧ »PTSDEMO/GETLRN.SC«

PTS(SC)

	IDENT	GETLRN	READ LRN IN VTOC
* 
*********************************************************************** 
* 
*     TO GET THE LRN OF A STANDARD FILE 
* 
*     CALL GETLRN,FILENAME,1,VOLNAME,LRN,ERCOD
* 
*     TO UPDATE THE LRN OF A STANDARD FILE. 
* 
*     CALL PUTLRN,DATAITEM1,VAL1,VOL1,(VOL2,..),LRN,ERROR 
* 
*     THE CONTENTS OF THE ITEMS IS: 
*      DATAITEM1 : FILE NAME
*      VAL1      : NR OF VOLUMES
* 
*********************************************************************** 
* 
* 
************************************************* 
*   E N T R I E S   A N D   E X T E R N A L S   * 
************************************************* 
* 
	ENTRY	GETLRN 
	ENTRY	PUTLRN 
* 
	EXTRN	I:EVA0 
	EXTRN	I:RT1
	EJECT
**************************************************************************
* 
*     THIS ROUTINE IS TO GET THE LRN
* 
**************************************************************************
* 
GETLRN	EQU	*
	CF	A14,LRN 
	LDR	A1,A1	ERROR CODE 
	RF(NZ)	WRONG 
	LD	A4,22,A4	GET LRN
	CF	A14,I:EVA0	ADRESS LRN IN CRDEIT 
	STR	A4,A9	STORE LRN
	LDK	A1,0	OK
	RF	AFHAND
	EJECT
**************************************************************
* 
*      THIS ROUTINE IS THE PUTLRN.
* 
*************************************************************** 
* 
PUTLRN	EQU	*
	CF	A14,LRN 
	LDR	A1,A1
	RF(NZ)	WRONG 
	CF	A14,I:EVA0
	LDR*	A3,A9 
	ST	A3,22,A4	-STORE RECORD NUMBER.
	CF	A14,WRITE	-WRITE THE LRN. 
	RF	AFHAND
WRONG	EQU	* 
	ADKL	A12,2	ADJUST PROGRAM POINTER
* 
AFHAND	EQU	*
	LDR	A1,A1	-IS IT OKE.? 
	RF(Z)	COMSEG 
	RF	GETRC 
* 
	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.
********************************************* 
*   C O M S E G 
*   COMMON EXIT PART FOR ALL FUNCTIONS. 
********************************************* 
COMSEG	EQU	*
	LDR	A4,A1
	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	*
	LD	A2,2,A13	CHECK CONDITION REGISTER 
	SC	A1,-2,A2
	CM	FREE	-FREE. 
	ABL	I:RT1
	EJECT
* 
********************************************************* 
* 
*    STANDARD ROUTINES FOR THE GETLRN.
* 
* 
LRN	EQU	* 
	CF	A14,STANDRD	-GET FILENAME + VOLUME NAME 
	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
* 
	EJECT
* 
INIT1	EQU	* 
	LDK	A1,0 
	ST	A1,RETCOD	-INIT RETURN CODE 
	LDK	A1,/E8	FIRST FILE CODE 
	ST	A1,ECB	STORE IN ECB 
	LDKL	A2,/100	LENGTH
	ST	A2,ECB+4	-RECORD LENGTH 
	RTN	A14
* 
INIT2	EQU	* 
	LDK	A2,0	VTOC IN SECTOR 0
	ST	A2,SECNR+2	-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,/FA	-IS IT FA ? 
	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
* 
* 
	EJECT
***************************************** 
*    CHECK VOLUME NAME. 
***************************************** 
* 
CHKVLN	EQU	*
	LD	A2,ECB+2	-BUFFER ADRS.
	ST	A2,C:STOR	-ROUTINE COMPARE
	LDK	A3,1	-PRESET NUMBER OF CHECKS
	LDKL	A4,WORK+8	-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 
* 
	EJECT
* 
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
********************************* 
*   GET NEXT ECB. 
********************************* 
* 
* 
NXTECB	EQU	*
	LDKL	A2,BUFFE2 
	ST	A2,ECB+2	-SAVE BUFFER2 ADRES. 
	LD	A6,BUFFER+10	-FREE SPACE TABLE
	ADK	A6,1 
	LD	A3,BUFFER+6	-GET VTOC SECTORS.
	ADR	A3,A6	-LAST VTOC SECTOR. 
	RTN	A14
* 
* 
* 
	EJECT
**********************************************
*    SEARCH FILENAME IN THE -VTOC-. 
**********************************************
* 
* 
SEARCH	EQU	*
	LDKL	A4,WORK	-ADRES FILE NAME. 
	ST	A4,C:STOR	STORE IN ROUTINE COMPAR 
	LDKL	A4,BUFFE2	-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+256	-END OF SECTOR.
	RB(2)	LABEL2	-NO GET BACK. 
OKE	RTN	A14 
* 
	EJECT
* 
* 
************************************
*   READ SECTOR OF THE VTOC.
************************************
* 
* 
VTOC	EQU	*
	ST	A6,SECNR+2	-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,I:EVA0	ADDRESS FILENAME 
	LDK	A4,8	BYTES TO MOVE 
	LDK	A3,0	REPLACEMENT IN WORK 
	CF	A14,A:MOVE	MOVE FILENAME TO WORK
	LDK	A3,0	CLEAR A3
	LCR	A3,A12	FETCH NUMBER OF VOLUMES 
	ADKL	A12,1	INCREASE PROGRAMPOINTER 
	LDR	A7,A3	-SAVE REGISTER.
	LDK	A6,0 
ST:01	EQU	* 
	CF	A14,VOLNAM
	ADK	A6,1 
	SUK	A7,1 
	RB(NZ)	ST:01 
	RTN	A14
* 
* 
* 
	EJECT
**************************************
*   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
******************************************
*  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,8	-VOLUME ENTRY.
	ADR	A3,A1	-ADD INDEX.
	LDK	A4,6	-LENGTH 
	CF	A14,A:MOVE	-MOVE VOLUME 
	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 WORK.
***************************************************** 
* 
* 
A:MOVE	EQU	*
	LDKL	A1,WORK	ADDRESS WORKFIELD 
	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
	EJECT
* 
* 
************************************************************************
* 
*              D I S C R I P T O R     B L O C K
* 
* 
FREE	DATA	0 
BLOCK	EQU	* 
	DATA	BUFFER
	DATA	BUFFE2
WORK	DATA	0 
	RES	6
ECB	DATA	0
	DATA	0 
	DATA	0 
	DATA	0 
	DATA	0	-RETURN CODE. 
SECNR	DATA	0	-SECTOR NUMBER.
	DATA	0	CONTROL WORD 2
RETCOD	DATA	0 
BUFFER	EQU	*
	RES	128
BUFFE2	EQU	*
	RES	128
* 
* 
* 
	END

Full view