|
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: 17366 (0x43d6)
Notes: pts_type(SC)
Names: »FUNCTN.SC«
└─⟦efe3a1cfc⟧ Bits:30009667 Philips computer tape "600113"
└─⟦this⟧ »TOSSWORK/FUNCTN.SC«
IDENT FUNCTN REL 8.2 78-09-15 870172840820 * ******************************************* * * PHILIPS TERMINAL SYSTEM PTS * * FUNCTN = TOSS FUNCTIONS * * * * * * ******************************************* * * * THIS MODULE CONTAINS TOSS FUNCTIONS. * THESE ARE : * * T:ADD(C) DECIMAL ADDITION * * T:SUB(C) DECIMAL SUBTRACTION * * T:CMP(C) COMPARISON * * T:CPA(C) ABSOLUTE COMPARISON * * T:MOV(C) MOVE * * * T:MOV CONTAINS THE FOLLOWING ROUTINES : * * PCK PACK FROM ASCII TO BCD * * UPK UNPACK FROM BCD TO ASCII * * MVC MOV TO ASCII/BCD FROM ASCII/BCD * * EJECT * * * * TOSS FUNCTIONS ARE CALLED BY FOLLOWING SEQUENCE : * * CF A14,LABEL * BYTE EL1,EL2 * * LABEL = ENTRYPOINT IN CALLED FUNCTION * (T:ADD,T:SUB,T:CMP,T:MOV) * * EL1 = ELEMENT ADDRESS OF RESULT OPERAND(FIRST OPERAND) * * EL2 = ELEMENT ADDRESS OF SECOND OPERAND * * EJECT * * ************ * ENTRIES: * ************ * ENTRY T:ADD DECIMAL ADDITION ENTRY T:ADDC ENTRY T:SUB DECIMAL SUBTRACTION ENTRY T:SUBC ENTRY T:CMP COMPARISON ENTRY T:CMPC ENTRY T:CPA COMPARE ABSOLUTE ENTRY T:CPAC ENTRY T:MOV MOVE ENTRY T:MOVC ENTRY T:OPA,T:OP1 ENTRY T:OPS ENTRY RETMMM ENTRY M:ADD,M:SUB,M:CMP,M:CPA ENTRY M:MOV,M:OPA,M:OPS * * * OVERLY EQU 0 * *************************************************** * WORKING AREAS USED BY THE DIFFERENT SUBROUTINES * *************************************************** * T:OP1 EQU * DATA 0 LENGTH 2-COMPLEMENTED * * T:OP2 DATA 0 LENGTH 2-COMPLEMENTED * * EJECT * * SUBTRACTION AND ADDITION * *************** * SUBTRACTION * *************** M:SUB EQU * IFT OVERLY=1 LDK A2,/80 XRS A2,2,A14 RF T:SUB XIF T:SUBC ADKL A13,1 T:SUB LDK A2,6 INDICATE SUBTRACTION RF ADD050 * ************ * ADDITION * ************ M:ADD EQU * IFT OVERLY=1 LDK A2,/80 XRS A2,2,A14 RF T:ADD XIF T:ADDC ADKL A13,1 T:ADD LDK A2,0 INDICATE ADDITION ADD050 EQU * SC A2,SAVE+1 SAVE INDICATOR ST A13,ARG1 SAVE A13 LD* A7,4,A14 GET ARGUMENT ST A7,ARG STORE ARGUMENT FOR COMP IFT OVERLY=0 CF A14,T:CPA COMPARE ABSOLUTE XIF IFT OVERLY=1 CF A14,M:CPA XIF ARG DATA 0 ARGUMENT LDKL A13,0 ARG1 EQU *-2 LDR A2,A7 COPY RESULT INDICATOR CF A14,GETOPS GET ELEMENT PARAMETERS LDR A1,A2 COPY RESULT INDICATOR LDR A9,A6 GET POINTER TO OP1 SAVE LDK A2,0 RESTORE A2 * LDK A5,0 CLEAR A5 LDK A3,0 CLEAR A3 LCR A5,A9 GET 1:ST BYTE OP1 LCR A3,A10 GET 1:ST BYTE OP2 LDR A4,A5 COPY A5 LDR A6,A3 COPY A3 ANK A5,/F GET SIGN OP1 LDR A7,A5 GET SIGN TO A7 ANK A3,/F GET SIGN OP2 ANK A6,/F0 MASK OUT 1:ST DIGIT OP2 SUK A6,/F0 RF(Z) ADD060 JUMP IF BLANK ADK A6,/F0 RESTORE DIGIT ADD060 ANK A4,/F0 MASK OUT 1:ST DIGIT OP1 SUK A4,/F0 RF(Z) ADD070 JUMP IF BLANK ADK A4,/F0 RESTORE DIGIT ADD070 EQU * XRR A5,A3 EXCLUSIVE OR WITH SIGNS XRR A2,A5 EXCLUSIVE OR WITH SIGNS AND INDICATOR RF(Z) ADD078 JUMP IF EQUAL SIGNS NGR A4,A4 NEGATE A4 XRR A2,A1 EXVLUSIVE OR WITH COMP. RESULT SRC A2,2 SHIFT BIT 14 TO SIGN RF(P) ADD076 JUMP IF OP2 ABSOLUTE GREATER THAN OP1 NGR A6,A6 NEGATE A6 NGR A4,A4 NEGATE A4 LDR A1,A2 SLL A1,1 RF(N) ADD078 JUMP IF OP1 ABSOLUTE GREATER THAN OP2 LDK A7,/B LOAD PLUS SIGN RF ADD078 ADD076 XRK A7,6 INVERT SIGN ADD078 LDK A1,0 CLEAR CARRY * ************************ * ADDITION/SUBTRACTION * ************************ * ADDSUB EQU * ADR A4,A1 ADD CARRY LDK A1,1 INDICATE CARRY ADR A4,A6 ADD CARRY AND LEFT DIGITS RF(N) ADD200 JUMP IF NEGATIVE SUK A4,/A0 RF(NN) ADD100 JUMP IF CARRY LDK A1,0 NO CARRY ADD080 ADK A4,/A0 RESTORE DIGIT ADD100 ADR A7,A4 GET BOTH DIGITS TO A7 ADD105 SCR A7,A9 STORE 2 DIGITS SUKL A9,1 DECREMENT POINTER OP1 SUKL A10,1 DECREMENT POINTER OP2 IM T:OP1 INCREMENT INDEX RF(NN) RETMMM * ADD150 LCR A4,A9 A4=BYTE OP1 LDK A6,0 CLEAR A6 IM T:OP2 INCREMENT INDEX FOR OP2 RF(NN) ADD160 JUMP IF END OF ELEMENT LCR A6,A10 A6=BYTE OP2 ADD160 LDR A7,A4 COPY A4 ANK A7,/F GET RIGHT DIGIT SUK A7,/F RF(Z) *+4 JUMP IF BLANK ADK A7,/F RESTORE DIGIT ANK A4,/F0 GET LEFT DIGIT SUK A4,/F0 RF(Z) *+4 JUMP IF BLANK ADK A4,/F0 RESTORE DIGIT LDR A5,A6 COPY A6 ANK A6,/F0 GET LEFT DIGIT SUK A6,/F0 RF(Z) *+4 JUMP IF BLANK ADK A6,/F0 RESTORE DIGIT ANK A5,/F GET RIGHT DIGIT SUK A5,/F RF(Z) *+4 JUMP IF BLANK ADK A5,/F RESTORE DIGIT LDR A2,A2 RF(Z) ADD170 JUMP IF ADD RF(N) ADD165 JUMP IF OP2 NOT GREATER THAN OP1 NGR A4,A4 NEGATE A4 NGR A7,A7 NEGATE A7 RF ADD170 ADD165 NGR A5,A5 NEGATE A5 NGR A6,A6 NEGATE A6 * ADD170 ADR A7,A1 ADD WITH CARRY LDK A1,/10 INDICATE CARRY ADR A7,A5 ADD CARRY AND RIGHT DIGITS RF(N) ADD220 JUMP IF NEGATIVE SUK A7,/A RB(NN) ADDSUB JUMP IF CARRY LDK A1,0 NO CARRY ADD180 ADK A7,/A RESTORE DIGIT RB ADDSUB * ADD200 NGR A1,A1 NEGATE CARRY RB ADD080 * ADD220 NGR A1,A1 NEGATE CARRY RB ADD180 * EJECT * * * GET ELEMENT PARAMETERS * * INPUT: A7=M,N IN RIGHT BYTE * OUTPUT: A6=SIGN ADDRESS * A5=ADDRESS WITHIN DISCRIPTION BLOCK * A4=USED * A1=ELEMENT LENGTH IN BYTES 2-COMPLEMENTED *************************************************** * M:OPA EQU * IFT OVERLY=1 LDK A1,/80 XRS A1,2,A14 XIF T:OPA LDR A4,A7 LDR A5,A7 ANK A5,/F0 A5=Z * 16 SRL A5,2 Z * 4 ADR A5,A13 DISPLACEMENT ADDRESS LD A6,2,A5 BASE ADDRESS LDR* A5,A5 GET ADDRESS TO DB ANK A4,/F MASK OUT N SLL A4,1 N * 2 ADR A5,A4 ADDRESS WITHIN DB LDR* A1,A5 ANKL A1,/FFF MASK OUT DISPLACEMENT ADR A6,A1 ELEMENT ADDRESS SUK A6,1 ELEMENT ADDRESS RIGHTMOST LDR A4,A4 RF(Z) OPA100 JUMP IF N=0 LD A4,-2,A5 GET DISPLACEMENT FOR N-1 ANKL A4,/FFF MASK OUT DISPLACEMENT OPA100 SUR A1,A4 GET LENGTH NGR A1,A1 NEGATE LENGTH RF RETMMM EJECT ******************************************************* * GET ELEMENT PARAMETERS FOR 2 OPERANDS * AND ADJUST RETURN ADDRESS ON STACK * * INPUT : A7 =OP1,OP2 * OUTPUT: T:OP1 = NEG LENGTH OF OP1 * T:OP2 =NEG LENGTH OF OP2 * A1 =NEG LENGTH OP1 * A3 =PACKING FORM OP2 * A5 =DESCRIPTOR ADDRESS OP1 * A6 =POINTER OP1 * A10 =POINTER OP2 * ******************************************************* * GETOPS EQU * LD* A7,8,A14 GET ARGUMENT LDK A1,2 ADS A1,8,A14 ADJUST RETURN ADDRESS M:OPS EQU * IFT OVERLY=1 LDK A1,/80 XRS A1,2,A14 XIF T:OPS EQU * LDR A1,A13 COPY A13 ANKL A13,/FFFE MASK AWAY CONSTANT INDICATION ST A13,ARG2 SAVE A13 SRC A1,1 RF(NN) GET010 JUMP IF NOT TCA COMMON LD A13,-2,A13 GET ADDRESS TO TCACOM GET010 EQU * IFT OVERLY=0 CF A14,T:OPA GET PARAMETERS FOR OP2 XIF IFT OVERLY=1 CF A14,M:OPA PARAMETERS FOR OP2 XIF LDKL A13,0 ARG2 EQU *-2 LDR A10,A6 A10=POINTER OP2 ST A1,T:OP2 STORE NEG LENGTH OP2 LDR* A3,A5 GET PACKING FORM IN BIT 0 ECR A7,A7 CHANGE BYTES IFT OVERLY=0 CF A14,T:OPA GET PARAMETERS FOR OP1 XIF IFT OVERLY=1 CF A14,M:OPA XIF ST A1,T:OP1 STORE NEG LENGTH OP1 IFT OVERLY=0 RETMMM RTN A14 XIF IFT OVERLY=1 RETMMM STR A1,A14 LD A1,2,A14 ANK A1,/80 RF(E) RETMMF LDR* A1,A14 DATA /C0FF RETMMF LDR* A1,A14 RTN A14 XIF EJECT * * MOVE * ******************************** * M:MOV EQU * IFT OVERLY=1 LDK A1,/80 XRS A1,2,A14 RF T:MOV XIF T:MOVC ADKL A13,1 * T:MOV EQU * CF A14,GETOPS GET ELEMENT PARAMETERS LDR A4,A1 A4=LENGTH 2-COMPLEMENTED LD A2,T:OP2 GET LENGTH OF OP2 2-COMPL. LDR A7,A10 GET POINTER OP2 XRR* A3,A5 RF(NN) MVC JUMP IF EQUAL PACKING FORM LDR* A3,A5 GET PACKING FORM FOR OP1 RF(N) UPK JUMP IF ASCII EJECT * * PACK *********** * PCK LDK A1,/B LOAD PLUS SIGN PCK040 LDK A3,/F0 LOAD BLANK AND ZERO ADK A2,1 INCREMENT INDEX RF(P) PCK050 JUMP IF END OF ELEMENT LCR A3,A7 GET BYTE FROM OP2 SUK A3,/30 RF(NN) PCK045 JUMP IF NOT SPACE LDK A3,/F LOAD BLANK PCK045 SLL A3,4 SHIFT TO LEFT POSITION PCK050 ADR A1,A3 GET 2 DIGITS IN THE RIGHT BYTE SCR A1,A6 STORE BYTE IN OP1 ADK A4,1 STEP UP INDEX RB(NN) RETMMM SUK A6,1 DECREMENT POINTER OP1 SUK A7,1 DECREMENT POINTER OP2 LDK A1,/F LOAD BLANK ADK A2,1 INCREMENT INDEX FOR OP2 RB(P) PCK040 JUMP IF END OF ELEMENT LCR A1,A7 GET BYTE FROM OP2 SUK A1,/30 RF(NN) PCK060 JUMP IF NOT SPACE LDK A1,/F LOAD BLANK PCK060 SUK A7,1 DECREMENT POINTER FOR OP2 RB PCK040 EJECT * * MOVE CHARACTER BY CHARACTER ***************************** * MVC EQU * LDK A3,0 LOAD HEX ZERO MVC020 EQU * LDR* A5,A5 GET PACKING FORM RF(N) MVC050 JUMP IF ASCII LDK A3,/FF LOAD BLANKS MVC050 LDR A1,A3 GET FILLER TO A1 ADK A2,1 INCREMENT INDEX FOR OP2 RF(P) MVC100 JUMP IF END OF ELEMENT LCR A1,A7 GET BYTE FROM OP2 MVC100 SCR A1,A6 STORE BYTE IN OP1 SUK A7,1 DECREMENT POINTER OP2 SUK A6,1 DECREMENT POINTER OP1 ADK A4,1 STEP UP INDEX RB(N) MVC050 JUMP IF NOT FINISHED RETUR RB RETMMM EJECT * * UNPACK ************ * UPK LDK A1,0 CLEAR A1 LDR A2,A2 RF(NN) UPK070 JUMP IF END OF OP2 LCR A1,A7 GET BCD-DIGITS SRL A1,4 SHIFT OUT SIGN SUK A1,/F RF(Z) UPK060 JUMP IF BLANK ADK A1,/1F UPK060 ADK A1,/20 MAKE ASCII DIGIT OR BLANK UPK070 SCR A1,A6 STORE ASCII SUK A6,1 DECREMENT POINTER OP1 SUK A7,1 DECREMENT POINTER OP2 ADK A4,1 INCREMENT INDEX RB(NN) RETUR JUMP IF FINISHED LDK A1,0 CLEAR A1 ADK A2,1 INCREMENT INDEX FOR OP2 RF(NN) UPK110 JUMP IF END OF ELEMENT LCR A1,A7 GET DIGITS FROM OP2 ANK A1,/F GET RIGHT DIGIT SUK A1,/F RF(Z) UPK100 JUMP IF BLANK ADK A1,/1F UPK100 ADK A1,/20 MAKE ASCII DIGIT OR BLANK UPK110 SCR A1,A6 STORE ASCII SUK A6,1 DECREMENT POINTER OP1 ADK A4,1 INCREMENT INDEX RB(N) UPK JUMP IF NOT FINISHED RB RETMMM * EJECT * * COMPARISON OF 2 BCD ELEMENTS ************************************* * M:CPA EQU * IFT OVERLY=1 LDK A1,/80 XRS A1,2,A14 RF T:CPA XIF T:CPAC ADKL A13,1 T:CPA EQU * ABSOLUTE COMPARISON LDR A9,A14 INDICATE ABS. COMP RF COMP * M:CMP EQU * IFT OVERLY=1 LDK A1,/80 XRS A1,2,A14 RF T:CMP XIF T:CMPC ADKL A13,1 T:CMP EQU * COMP. INCLUSIVE SIGNS SUR A9,A9 INDICATE NORMAL COMP COMP LDKL A8,/EC08 A8=CWR A4,A2 CF A14,GETOPS GET ELEMENT PARAMETERS LDK A7,0 INDICATE EQUAL LCR A4,A6 GET 1:ST BYTE FROM OP1 LCR A2,A10 GET 1:ST BYTE FROM OP2 LDR A3,A4 COPY A4 LDR A5,A2 COPY A2 ANK A3,/F GET SIGN OP1 ANK A5,/F GET SIGN OP2 ANK A4,/F0 GET LEFT DIGIT ANK A2,/F0 GET LEFT DIGIT LDR A9,A9 RF(NZ) CMP100 JUMP IF ABSOLUTE COMPARISON SUR A3,A5 RF(N) CMP150 JUMP IF OP1 GT OP2 RF(P) CMP160 JUMP IF OP1 LT OP2 SUK A5,/B RF(Z) CMP100 JUMP IF PLUS SIGNS LDKL A8,/EA10 A8=CWR A2,A4 CMP100 SUK A4,/FF RF(Z) CMP110 JUMP IF 2 BLANKS ADK A4,/F RF(NN) CMP110 JUMP IF 1 BLANK (LEFTMOST) ADK A4,/F0 RESTORE DIGITS CMP110 SUK A2,/FF RF(Z) CMP120 JUMP IF 2 BLANKS ADK A2,/F RF(NN) CMP120 JUMP IF 1 BLANK (LEFTMOST) ADK A2,/F0 RESTORE DIGITS CMP120 EXR A8 COMPARE RF(G) CMP140 JUMP IF GREATER RF(E) CMP130 JUMP IF EQUAL LDK A7,2 INDICATE LESS CMP130 SUK A6,1 DECREMENT POINTER SUKL A10,1 DECREMENT POINTER ADK A1,1 INCREMENT INDEX RF(NN) CMP170 LCR A4,A6 GET BYTE FROM OP 1 LDK A2,0 IM T:OP2 INCREMENT INDEX RB(NN) CMP100 JUMP IF END OF ELEMENT LCR A2,A10 GET BYTE FROM OP2 RB CMP100 * * GREATER THAN **************** * CMP140 LDK A7,1 INDICATE GREATER THAN RB CMP130 * * OP1 + AND OP2 - ***************** * CMP150 LDK A7,1 INDICATE GREATER THAN RF CMP170 * * OP1 - AND OP2 + ****************** * CMP160 LDK A7,2 INDICATE LESS THAN CMP170 LC A6,2,A14 PSW ANK A6,/FC ORR A6,A7 SC A6,2,A14 PSW COND UPD RB RETUR * END