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

⟦963e4bf9e⟧

    Length: 14090 (0x370a)
    Notes: pts_type(SC)
    Names: »DE70ST.SC«

Derivation

└─⟦48601905a⟧ Bits:30009668 Philips computer tape "600121"
    └─⟦this⟧ »S:DE/DE70ST.SC« 
└─⟦d2a299635⟧ Bits:30009698 Philips computer tape "600415"
    └─⟦this⟧ »S:DE/DE70ST.SC« 

PTS(SC)

	IDENT	DE70ST	REL 10.0 80-04-11 
			80-03-24/DALI
	DDUM	DEDDIV
	PDIV 
	ENTRY	DE70ST 
 ENTRY DEAP7A 
* 
*        EXTERNAL REFERENCES TO SCREEN
* 
	EXT	DECLRA 
 EXT DECLRS 
 EXT DECLRN 
 EXT DERR 
	EXT	DEPMSK FETCH THE KEYSWITCHES 
 EXT OPCL OPEN/CLOSE FILEROUTINE
 EXT DECONV USER OR STANDARDCODED 
			CONVERSION ROUTINE 
 EXT DELAST WRITE AND READ ON LAST
			ROW OF DISPLAY.
 EXT DERROR WRITE AND READ A KEY ON 
			LAST ROW OF THE DISPLAY
 EXT DEOPBC OPEN BATCH
 EXT DEPOOL POOLHANDLING
 EXT DERECS READ RECORDROUTINE
 EXT DEPRUT SET PROGRAMNUMBER 
 EXT ATTDB ATTACH DESCRIPTORBLOCK 
 EXT DEDISC FILE HANDLING 
* 
	EXT	RESTOR RESTOR WORKBLOCK
			AND DESCRIPTORADRESSES 
 EXT EMPTYT 
  EXT UPDBOL
 EXT UPDBIN 
 EXT GETIND 
 EXT DEANOK NOT OK RET FROM APPL
 EXT DEAOK0 OK RET FROM APPL
* 
 INCLUDE DELITT 
 EJECT
* 
* FOLLOWING DATAITEMS ARE USED FOR CONVERSION WITH DECONV 
* STSAVE(W3)        HOLDING THE DEVICE-TYPE 
* STSAVE(W4)        HOLDING THE FILE-NAME 
* 
* PERF DECONV,<FC1>,<FC2>,<RETCODE> 
* 
*             <FC1> = 1    TRANSMIT 
*                   = 2    RECEIVE
*                   = 3    TO OTHER MEDIA 
*             <FC2> = 1    OPEN CONVERSION
*                   = 2    BATCHHEAD ATTACHED 
*                   = 3    DATARECORD ATTACHED
*                   = 4    BALANCE ATTACHED 
*                   = 5    CLOSE CONVERSION 
*         <RETCODE> = 0    NO ERRORS DETECTED 
*                  /= 0    ERROR DETECTED 
*                   > 0    WRITE ERROR MESSAGE
*                   =-1    GET NEXT BATCH,WRITE ACCUMULATORS
*                   =-2    MAKE BALANCE CURRENT 
*                   =-3    GET CURRENT BATCH FROM BEGINNING 
*                   =-4    RETURN FROM CONVERSION 
*                   =-5    DELETE CURRENT BATCH 
* 
* THE FORMAL PARAMETERS <FC1> AND <FC2> MAY NOT BE
* UPDATED WITHIN THE DECONV PROCEDURE.
* 
	EJECT
********************************************* 
* START OF CONVERSION. HANDLE PRORAMSCREEN- 
* LAYOUTS 70,71 CONVERSION MODE.
* THESE ROUTINES USE THE DENTER-SCREEN. 
********************************************* 
DE70ST	PROC 
 MOVE JOBNAME,HEX00 
 MOVE BATCH,HEX00 
 CBNE BIN2,W0,DEEN10 JUMP IF NOT PRNUM 70 
DEST00
	SET	BOOL1	PART OF FORMAT DISPLAY 
DEST10
 TBT BOOL2,DEST20 JUMP IF NOT 70
	ATTFMT	F70ST 
 B DEST30 
DEST20
 IB BIN2,DEST21,DEST22
DEST21			PROGRAM 71 
 ATTFMT F71ST 
 B DEST30 
DEST22			PROGRAM 72 
 ATTFMT F72ST 
DEST30
	SET	DEPROMPT	PROMPT-TEXTS DISPLAY
DEST50
	CLEAR	DECHANGE 
 TBT BOOL2,DEST55 
 PERF DECLRA
 B DEST60 
DEST55
 PERF DECLRS
DEST60
 IB DEBINW2,DE70CA,DE70RE,DE70EN	CAN,RET,ENT
	MOVE	DEBINW4,W0
DE70ER
 CLEAR DOOL3
 BNZ D70ER2 
 MOVE BIN3,DEBINW4
 PERF OPCL,W4 
 MOVE DEBINW4,BIN3
D70ER2
 PERF DERR
	B	DEST60 
* 
* CANCEL-KEY PRESSED
* 
DE70CA
	CLEAR	DEPROMPT 
	B	DEST50 
* 
* RETURN-KEY PRESSED
* 
DE70RE
 CLEAR DOOL3 DATAENTERING ON USERFILE 
 PERF OPCL,W4 CLOSE USERFILE
 BNERR DERE20 
 MOVE DEBINW1,W0
 PERF DERROR,DEKTAB6
	IB	DEBINW2,DERE55,DERE55 
DERE20
 TBT BOOL2,DERE50 IF SET NOT FRMT 70
 MOVE BIN2,W1 RETURN FROM THIS MODE 
 MOVE BIN1,W0 
DERE30
	RET
DERE50
 CLEAR BOOL2 CHANGE TO FRMT 70
 CLEAR BOOL1
 MOVE BIN1,W7 
 MUL BIN1,W10 
 MOVE PRNUM,BIN1
DERE55
	PERF	DEPRUT,PRNUM,BIN1,BIN2
	PERF	DEPMSK
 B DEST10 
 EJECT
**************************************
* THIS IS THE MAINLOOP IN CONVERSION MODE 
* THESE ROUTINES USE THE DENTER-SCREEN
**************************************
* 
* ENTER-KEY PRESSED 
* 
DE70EN
 TBT BOOL2,DEOPEN 
DEEN10
 CBNE BIN1,W7,DERE30
 CLEAR BOOL3 PROGRAM 72 
 IB BIN2,DEEN20,DEEN15
 B DEST00 
DEEN15
 SET BOOL3 PROGRAM 72 
DEEN20
 SET BOOL2
 CLEAR BOOL1 PART OF FORMAT 
 B DEST20 
DEOPEN
 IB BIN2,DE71ST,DE72ST,DE73ST 
 EJECT
DE71ST			START OF DATACOMM
DE72ST
 MOVE WORK(W8),W0 USED FOR CHECKING OF
			PART CONVERSION. 
			0 = THE WHOLE USERFILE 
			1 = ALL BATCHES IN THIS JOB
			2 = THIS JOB,THIS BATCH
 CALL EMPTYT,JOBNAME LOOK IF JOBNAME
 BNZ CO7110 NO JOBNAME
 MOVE WORK(W8),W1 
CO7110
 CALL EMPTYT,BATCH LOOK IF BATCHNAME
 BNZ CO7130 NO BATCHNAME
 CBE WORK(W8),W1,CO7120 
 MOVE DEBINW4,W5 JOBNAME NOT ENTERED
 GETFLD 0,W2,DEBINW3
 B DE70ER 
CO7120
 MOVE WORK(W8),W2 
CO7130
 IB WORK(W8),CO7140,CO7150
 PERF DELAST,W12,DEKTAB8
 B CO7145 
CO7140
 PERF DELAST,W13,DEKTAB8
CO7145
	CBE	DEBINW2,W1,DE70CA	JUMP ON CANCEL-KEY 
CO7150
 MOVE DEBINW2,W0
 PERF DEOPBC,DEBINW2
 IB DEBINW2,CO7160,CO7160,DE70RE,DE70ER 
CO7160
 SET SOOL2 IF SET LINE IS OPEN
 BNZ CO7161 
CO716A
 PERF DECONV,BIN5,W1,DEBINW4 OPEN CONVERSION
	MOVE	WORK(W7),W1	SAVE TYPE 
	CBE	DEBINW4,W0,CO7161	JUMP IF OKEY 
	B	ERRCO1	JUMP ON ERROR 
CO7161
 IB WORK(W8),CO7170,CO7186
CO7162			SEND WHOLE FILE
 MOVE BATCH,HEX00 
 PERF DEDISC,W21 GET NEXT JOBNAME 
 BOK CO7164 
 CBNE DEBINW4,W9,CO7183 
 B RETUBC WHOLE FILE SEND 
CO7164
 PERF DEPOOL,W6,PJOBCUR,DEBINW3,STRG10A 
CO7166
 PERF DEPOOL,W6,PINACC,DEBINW3,STRG10A
 PERF DEPOOL,W6,PINDFR,DEBINW3,STRG10A
CO7170
 MOVE STSAVE(W4),BATCH SAVE BATCHNAME 
 MOVE BIN3,=W'34' GET NEXT BATCHNAME
 CALL RESTOR,W0,W4,PWBDB4 RESTORE RBUF WB10 
 PERF DEDISC,BIN3 
 BOK CO7180 
 CBNE DEBINW4,W9,CO7183 NOT 'NOT FOUND' 
 IB WORK(W8),RETUBC JUMP IF ONE JOB 
 B CO7162 GET NEXT JOB
CO7175
 PERF DEPOOL,W6,PINACC,DEBINW3,STRG10A
 PERF DEPOOL,W6,PINDFR,DEBINW3,STRG10A
CO7180
 MOVE BCDI21(W3),W0 SET WANTED RECNO = 0
 PERF DERECS,W11
 BOK CO7186 
 CBG DEBINW4,W11,ERRCO2 ERROR 
 CBL DEBINW4,W8,CO7182
 CBNE DEBINW4,W10,CO7184
CO7183
 B ERRCO2 ERROR 
CO7182
 CBNE DEBINW4,W4,ERRCO2 
CO7184
 IB WORK(W8),CO7185,ERRCO2
CO7185
 B CO7166 GET NEXT BATCH
CO7186
 PERF DERECS,W5 GET CURRENT 
 BNOK ERRCO2
 CBNE BIN3,W10,CONVNO 
 IB WORK(W8),CO7166,RETUBC EMPTY BATCH
CONVNO
 CBNE NUMBER,=D'0',CONVE1 JUMP IF NOT BATCHHEAD 
CONVE0
 PERF DECONV,BIN5,W2,DEBINW4 BATCHHEAD
	MOVE	WORK(W7),W2	SAVE TYPE 
 CBNE DEBINW4,W0,ERRCO1 JUMP IF NOT OKEY
CONVE1 MOVE DEBINW4,NUMBER CURRENT REC.NUMBER 
 CBE DEBINW4,BDPOIN(W2),CONVE2 JUMP IF LAST 
 ADD BCDI21(W3),=D'1' INCREASE WANTED RECNO 
 PERF DERECS,W4 GET NEXT RECORD 
 BNOK ERRCO2 JUMP IF NOT OKEY 
CONVEA
 PERF DECONV,BIN5,W3,DEBINW4 DATARECORD 
	MOVE	WORK(W7),W3	SAVE TYPE 
 CBNE DEBINW4,W0,ERRCO1 JUMP IF NOT OKEY
 B CONVE1 
CONVE2
 MOVE DEINPUT,HEX00 
 COPY DEINPUT,W0,W6,FORTAB(W21),W0 BALANCEFORMAT
 MOVE FRMTPNTR,SYMREC(W11)
CONVEF
 PERF DEDISC,W10 GET FORMAT 
 BOK CONVE3 
 CBNE DEBINW4,W13,ERRCO2 NO WORKSPACE 
 CBE PINDFR,W0,ERRCO2 NO CURR. FORMAT 
 PERF DEPOOL,W6,PINDFR,BIN14,STRG10A
 ATTFMT FFETCH ATTACH DUMMYFORMAT 
 DISPLAY 0,W1,W0
 THOME
 MOVE FORMAT,HEX00
 B CONVEF 
CONVE3
 MOVE FORMAT,FORTAB(W21) BALANCE NAME 
 CALL ATTDB,BPOOL(PINDFR),W6,W10
 MOVE BIN16,FLIND(W1) 
 ATTFMT BPOOL(BIN16)
CONVEB
 PERF DECONV,BIN5,W4,DEBINW4 BALANCE
	MOVE	WORK(W7),W4	SAVE TYPE 
 CBNE DEBINW4,W0,ERRCO1 
CONVE4
 CALL RESTOR,W0,W4,PWBDB4 RESTORE RBUF WB10 
	CBE	PINACC,W0,CONVEC 
 CLEAR BDAACT 
 CALL UPDBIN,BDSTAT 
 PERF DEDISC,W18 WRITE ACCUMULATORS 
 BNOK ERRCO2
CONVEC
	MOVE	DEBINW2,W0
 IB WORK(W8),CONVE5,RETUBC
CONVE5
 B CO7166 GET NEXT BATCH
DELCUR			DELETE CURRENT BATCH 
 CALL RESTOR,W0,W4,PWBDB4 RESTORE RBUF WB10 
 MOVE BIN13,=W'27'
 PERF DEDISC,BIN13 DELETE BATCH 
 BNOK ERRCO1
 MOVE BATCH,STSAVE(W4)
 B CONVEC 
ERRCO1
 CBG DEBINW4,W0,ERRCO3
	MUL	DEBINW4,=W'-1' 
	IB	DEBINW4,CONVE4,CONVE2	JUMP ON NEGATIV ERROR-CODE	C
		CO7175,RETUBC,DELCUR
ERRCO3
	PERF	DERROR,DEKTABS
	MOVE	DEBINW4,W0	ZEROIZE ERRORMESS
	IB	DEBINW2,ERRCLR,CONVE4,RETUBC	CLR CAN RET
ERRCLR
	IB	WORK(W7),CO716A,CONVE0,CONVEA,CONVEB	JUMP CLR DEP TYPE
 CLEAR SOOL2
ERRCO2
	PERF	DERROR,DEKTABS
	IB	DEBINW2,ERRCO2,CONVE4 
RETUBC
RETBC2 PERF DEPOOL,W6,PINDFR,DEBINW3,STRG10A
 PERF DEPOOL,W6,PJOBCUR,DEBINW3,STRG10A 
 CALL RESTOR,W0,W16,PWBDB4 RESTORE ORIGINATE ADRESSES TO
			WORKBLOCKS AND DESCRIPTORS 
	CBE	PINACC,W0,RETBC3 
 CLEAR BDAACT 
 CALL UPDBIN,BDSTAT 
 PERF DEDISC,W18 WRITE ACCUMULATORS 
 PERF DEPOOL,W6,PINACC,DEBINW3,STRG10A
RETBC3
 CLEAR SOOL2 CONVERSION OPEN
 BZ RETBC4
 PERF DECONV,BIN5,W5,DEBINW4
RETBC4
	CLEAR	DOOL3
	PERF	DEPRUT,PRNUM,BIN1,BIN2
 PERF OPCL,W4 CLOSE USERFILE
 BOK DEST20 
* 
DE73ST
 B DEST55 
	PEND 
 EJECT
* 
*     APPL-VALUE HANDLING ROUTINE 
* 
DEAP7A PROC 
 IB DEBINW3,DEA71 
 B DEANOK ILLEGAL APPL-VALUE
* 
* APPL-VALUE = 1(101) OUTPUT:BIN6 = FILECODE
*                            BIN5 = <FC>,FUNCTION-CLASS 
* 
DEA71 
 CALL GETIND,DEVTYP,DEBIN1,DEBIN2 GET LENGTH
 MOVE DEBIN2,W0 
DEA71A
 MOVE DEBIN3,DEBIN2 
 MATCH DEVTYP,DEBIN3,W3,DEINPUT,W0,W3 
 BOK DEA71B 
 ADD DEBIN2,W5 GET NEXT DEVICE
 CBE DEBIN2,DEBIN1,DEA71E LAST DEVICE 
 B DEA71A 
DEA71B
 ADD DEBIN3,W3 ADJUST FOR FILECODE
 XCOPY BIN6,W1,W1,DEVTYP,DEBIN3 SAVE FILECODE 
 ADD DEBIN3,W1 ADJUST FOR <FC>
 XCOPY BIN5,W1,W1,DEVTYP,DEBIN3 SAVE <FC> 
 B DEAOK0 
DEA71E
 MOVE DEBINW4,W9 NOT FOUND
 B DEANOK 
 PEND 
	EJECT
* 
*        FORMATS
* 
F70ST	FRMT
	FSL
 FTEXT '70 '
 FCOPY =C'CONVERSION'	$$
	FNL
	FCOPY	=C'PROGRAM:' 
 FKI 9,MINL=2,MAXL=2,ME,NEOI,APPL=1 
 FMEL 'XX',PRNUM
	FBF	BOOL1,F70OUT 
	FNL
 FLINK F72S 
F70OUT
	FMEND
F72ST	FRMT
	FSL
 FLINK F71S 
	FNL
 FLINK F71UV
 FNL
 FLINK F71JOB 
 FTAB 20
 FLINK F71BAT 
 FLINK F71END 
 FMEND
F71ST FRMT
 FSL
 FLINK F72S 
	FNL
 FLINK F71UV
 FNL
 FLINK F71JOB 
 FTAB 20
 FLINK F71BAT 
 FNL
 FLINK F72DEV 
 FLINK F71END 
 FMEND
F71S FRMT 
 FTEXT '71 '
 FCOPY =C'CONVERSION' 
 FILLR ' ',1
 FCOPY =C'VIA'
 FILLR ' ',1
 FCOPY =C'DATA COMM'
 FMEND
F72S FRMT 
 FTEXT '71 '
 FCOPY =C'CONVERSION' 
 FILLR ' ',1
 FCOPY =C'TO' 
 FILLR ' ',1
 FCOPY =C'OTHER MEDIA'
 FMEND
F73S FRMT 
 FTEXT '73 '
 FCOPY =C'BATCH LINKING'
 FMEND
F71UV FRMT
	FCOPY	=C'UNIT' 
 FTEXT ':U' 
 FKI 7,MINL=1,MAXL=1,NEOI,ME,APPL=2 
 FMEL 'X',USERFILE
 FTAB 20
	FCOPY	=C'VOLUME' 
	FILLR	':',1
 FINP 27
 FCOPY TABLE
 FMEND
F71JOB FRMT 
	FCOPY	=C'JOB'
	FCOPY	=C'NAME' 
	FILLR	':',1
 FKI 9,ALPHA,MINL=1,MAXL=6,NEOI,APPL=3,DUPL=STSAVE(W1)
	FCOPY	JOBNAME
 FMEND
F71BAT FRMT 
	FCOPY	=C'BATCH'
	FCOPY	=C'NAME' 
	FILLR	':',1
 FKI 30,ALPHA,MINL=1,MAXL=6,NEOI,APPL=4,DUPL=STSAVE(W2) 
	FCOPY	BATCH
	FMEND
F71END FRMT 
 FNL
 FKI 1
 FCOPY HEX00
 FMEND
F72DEV FRMT 
 FCOPY =C'DEVICE '
 FILLR ':',1
 FKI 9,ALPHA,MINL=2,MAXL=3,NEOI,ME,APPL=101 
 FCOPY STSAVE(W3) 
 FTAB 20
 FCOPY =C'FILE' 
 FILLR '-',1
 FCOPY =C'NAME' 
 FILLR ':',1
 FKI 32,ALPHA,MAXL=6,NEOI 
 FCOPY STSAVE(W4) 
 FMEND
FFETCH FRMT 
 FSL
 FTEXT 'FETCHING FORMAT:' 
 FCOPY DEINPUT
 FTEXT ' FROM DISC.'
 FNL
 FKI 1,ALPHA
 FCOPY HEX00
 FMEND
* 
	END

Full view